Subversion Repositories tendra.SVN

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
/**********************************************************************
32 
$Author: release $
33 
$Date: 1998/01/17 15:57:25 $
34 
$Revision: 1.1.1.1 $
35 
$Log: standardsh.c,v $
36 
 * Revision 1.1.1.1  1998/01/17  15:57:25  release
37 
 * First version to be checked into rolling release.
38 
 *
39 
 * Revision 1.3  1995/08/21  16:00:58  currie
40 
 * put <stdlib> at top of headers
41 
 *
42 
 * Revision 1.2  1995/06/08  09:13:54  currie
43 
 * Added sigs to tokdecs/defs
44 
 *
45 
 * Revision 1.1  1995/04/07  14:29:07  currie
46 
 * Initial revision
47 
 *
48 
 * Revision 1.1  1995/04/07  14:29:07  currie
49 
 * Initial revision
50 
 *
51 
 * Revision 1.2  1994/07/21  10:36:36  currie
52 
 * Added banner
53 
 *
54 
***********************************************************************/
55 
#include "config.h"
56 
#include "util.h"
57 
#include "streams.h"
58 
#include "units.h"
59 
#include "encodings.h"
60 
#include "enc_nos.h"
61 
#include "defs.h"
62 
#include "errors.h"
63 
#include "standardsh.h"
64 
 
65 
 
66 
static Name * intshtok = (Name*)0;
67 
static Name * longshtok = (Name*)0;
68 
static Name * shortshtok = (Name*)0;
69 
static Name * charshtok = (Name*)0;
70 
static Name * uintshtok = (Name*)0;
71 
static Name * ulongshtok = (Name*)0;
72 
static Name * ushortshtok = (Name*)0;
73 
static Name * ucharshtok = (Name*)0;
74 
static Name * floatshtok = (Name*)0;
75 
static Name * doubleshtok = (Name*)0;
76 
 
77 
static TDFlist * extra_toks = (TDFlist *) 0;
78 
 
79 
 
80 
void select_tokdef_unit
81 
    PROTO_Z ()
82 
{
83 
  /* can define a token while in a token definition in shapes */
84 
  if (current_Unit != tokdef_unit) {
85 
  	SELECT_UNIT(tokdef_unit);
86 
  }
87 
  else {
88 
  	TDFlist * tl = MALLOC(TDFlist);
89 
  	tl->next = extra_toks;
90 
  	extra_toks = tl;
91 
  	current_TDF = &tl->t;
92 
  	INIT_TDF(current_TDF);
93 
  	current_Unit = tokdef_unit;
94 
  }
95 
}
96 
 
97 
 
98 
void add_extra_toks
99 
    PROTO_Z ()
100 
{
101 
	SELECT_UNIT(tokdef_unit);
102 
	while (extra_toks != (TDFlist *) 0) {
103 
		append_TDF(&extra_toks->t, 1);
104 
		INC_LIST;
105 
		extra_toks = extra_toks->next;
106 
	}
107 
}
108 
 
109 
 
110 
static void make_intsh
111 
    PROTO_N ( (issigned) )
112 
    PROTO_T ( Bool issigned )
113 
{
114 
	o_integer(o_var_limits(
115 
		  o_make_signed_nat(out_tdfbool(issigned),
116 
		   	out_tdfint32(UL((issigned)?MINSI:0)))
117 
		   ,
118 
		   o_make_signed_nat(out_tdfbool(0),
119 
		   	out_tdfint32(UL((issigned)?MAXSI:MAXUSI)) )
120 
		  )
121 
	);
122 
}
123 
 
124 
 
125 
static void make_longsh
126 
    PROTO_N ( (issigned) )
127 
    PROTO_T ( Bool issigned )
128 
{
129 
	o_integer(o_var_limits(
130 
		   o_make_signed_nat(out_tdfbool(issigned),
131 
		   	out_tdfint32(UL((issigned)?MINSL:0)))
132 
		   ,
133 
		   o_make_signed_nat(out_tdfbool(0),
134 
		   	out_tdfint32(UL((issigned)?MAXSL:MAXUSL)) )
135 
		  )
136 
	);
137 
}
138 
 
139 
 
140 
static void make_shortsh
141 
    PROTO_N ( (issigned) )
142 
    PROTO_T ( Bool issigned )
143 
{
144 
	o_integer(o_var_limits(
145 
		   o_make_signed_nat(out_tdfbool(issigned),
146 
		   	out_tdfint32(UL((issigned)?MINSS:0)))
147 
		   ,
148 
		   o_make_signed_nat(out_tdfbool(0),
149 
		   	out_tdfint32(UL((issigned)?MAXSS:MAXUSS)) )
150 
		  )
151 
	);
152 
}
153 
 
154 
 
155 
static void make_charsh
156 
    PROTO_N ( (issigned) )
157 
    PROTO_T ( Bool issigned )
158 
{
159 
	o_integer(o_var_limits(
160 
		   o_make_signed_nat(out_tdfbool(issigned),
161 
		   	out_tdfint32(UL((issigned)?MINSC:0)))
162 
		   ,
163 
		   o_make_signed_nat(out_tdfbool(0),
164 
		   	out_tdfint32(UL((issigned)?MAXSC:MAXUSC)) )
165 
		  )
166 
	);
167 
}
168 
 
169 
 
170 
static void make_floatsh
171 
    PROTO_Z ()
172 
{
173 
	o_floating(o_flvar_parms(
174 
		o_make_nat(out_tdfint32(UL(2))),
175 
		o_make_nat(out_tdfint32(UL(MANT_FLOAT))),
176 
		o_make_nat(out_tdfint32(UL(MINEXP_FLOAT))),
177 
		o_make_nat(out_tdfint32(UL(MAXEXP_FLOAT)))
178 
		   )
179 
	)
180 
}
181 
 
182 
 
183 
static void make_doublesh
184 
    PROTO_Z ()
185 
{
186 
	o_floating(o_flvar_parms(
187 
		o_make_nat(out_tdfint32(UL(2))),
188 
		o_make_nat(out_tdfint32(UL(MANT_DOUBLE))),
189 
		o_make_nat(out_tdfint32(UL(MINEXP_DOUBLE))),
190 
		o_make_nat(out_tdfint32(UL(MAXEXP_DOUBLE)))
191 
		   )
192 
	)
193 
}
194 
 
195 
 
196 
Name * tokforintsh
197 
    PROTO_N ( (issigned) )
198 
    PROTO_T ( Bool issigned )
199 
{
200 
  TDF * place = current_TDF;
201 
  int cu = current_Unit;
202 
  Name ** t = (issigned)?&intshtok:&uintshtok;
203 
  if ((*t) != (Name*)0) return (*t);
204 
  (*t) = MALLOC(Name);
205 
  select_tokdef_unit();
206 
  * (*t) = next_name(tok_ent);
207 
  o_make_tokdef(out_tdfint32(UL((*t)->unit_name)), {},
208 
	       o_token_def(o_shape, {;}, make_intsh(issigned))
209 
	       );
210 
  INC_LIST;
211 
  current_Unit = cu;
212 
  RESET_TDF(place);
213 
  return (*t);
214 
}
215 
 
216 
 
217 
Name * tokforlongsh
218 
    PROTO_N ( (issigned) )
219 
    PROTO_T ( Bool issigned )
220 
{
221 
  TDF * place = current_TDF;
222 
  int cu = current_Unit;
223 
  Name ** t = (issigned)?&longshtok:&ulongshtok;
224 
  if ((*t) != (Name*)0) return (*t);
225 
  (*t) = MALLOC(Name);
226 
  select_tokdef_unit();
227 
  * (*t) = next_name(tok_ent);
228 
  o_make_tokdef(out_tdfint32(UL((*t)->unit_name)), {},
229 
	        o_token_def(o_shape, {;}, make_longsh(issigned))
230 
	       );
231 
  INC_LIST;
232 
  current_Unit = cu;
233 
  RESET_TDF(place);
234 
  return (*t);
235 
}
236 
 
237 
 
238 
Name * tokforshortsh
239 
    PROTO_N ( (issigned) )
240 
    PROTO_T ( Bool issigned )
241 
{
242 
  TDF * place = current_TDF;
243 
  int cu = current_Unit;
244 
  Name ** t = (issigned)?&shortshtok:&ushortshtok;
245 
  if ((*t) != (Name*)0) return (*t);
246 
  (*t) = MALLOC(Name);
247 
  select_tokdef_unit();
248 
  * (*t) = next_name(tok_ent);
249 
  o_make_tokdef(out_tdfint32(UL((*t)->unit_name)), {},
250 
	       o_token_def(o_shape, {;}, make_shortsh(issigned))
251 
	       );
252 
  INC_LIST;
253 
  current_Unit = cu;
254 
  RESET_TDF(place);
255 
  return (*t);
256 
}
257 
 
258 
 
259 
Name * tokforcharsh
260 
    PROTO_N ( (issigned) )
261 
    PROTO_T ( Bool issigned )
262 
{
263 
  TDF * place = current_TDF;
264 
  int cu = current_Unit;
265 
  Name ** t = (issigned)?&charshtok:&ucharshtok;
266 
  if ((*t) != (Name*)0) return (*t);
267 
  (*t) = MALLOC(Name);
268 
  select_tokdef_unit();
269 
  * (*t) = next_name(tok_ent);
270 
  o_make_tokdef(out_tdfint32(UL((*t)->unit_name)), {},
271 
	       o_token_def(o_shape, {;}, make_charsh(issigned))
272 
	       );
273 
  INC_LIST;
274 
  current_Unit = cu;
275 
  RESET_TDF(place);
276 
  return (*t);
277 
}
278 
 
279 
 
280 
Name * tokforfloatsh
281 
    PROTO_Z ()
282 
{
283 
  TDF * place = current_TDF;
284 
  int cu = current_Unit;
285 
  Name ** t = &floatshtok;
286 
  if ((*t) != (Name*)0) return (*t);
287 
  (*t) = MALLOC(Name);
288 
  select_tokdef_unit();
289 
  * (*t) = next_name(tok_ent);
290 
  o_make_tokdef(out_tdfint32(UL((*t)->unit_name)), {},
291 
	       o_token_def(o_shape, {;}, make_floatsh())
292 
	       );
293 
  INC_LIST;
294 
  current_Unit = cu;
295 
  RESET_TDF(place);
296 
  return (*t);
297 
}
298 
 
299 
 
300 
Name * tokfordoublesh
301 
    PROTO_Z ()
302 
{
303 
  TDF * place = current_TDF;
304 
  int cu = current_Unit;
305 
  Name ** t = &doubleshtok;
306 
  if ((*t) != (Name*)0) return (*t);
307 
  (*t) = MALLOC(Name);
308 
  select_tokdef_unit();
309 
  * (*t) = next_name(tok_ent);
310 
  o_make_tokdef(out_tdfint32(UL((*t)->unit_name)), {},
311 
	       o_token_def(o_shape, {;}, make_doublesh())
312 
	       );
313 
  INC_LIST;
314 
  current_Unit = cu;
315 
  RESET_TDF(place);
316 
  return (*t);
317 
}