Warning: Attempt to read property "date" on null in /usr/local/www/websvn.planix.org/blame.php on line 247

Warning: Attempt to read property "msg" on null in /usr/local/www/websvn.planix.org/blame.php on line 247
WebSVN – tendra.SVN – Blame – //branches/tendra5/src/installers/80x86/common/spec_tok.c – Rev 2

Subversion Repositories tendra.SVN

Rev

Go to most recent revision | 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 
/* 80x86/spec_tok.c */
32 
 
33 
/**********************************************************************
34 
$Author: release $
35 
$Date: 1998/01/17 15:55:52 $
36 
$Revision: 1.1.1.1 $
37 
$Log: spec_tok.c,v $
38 
 * Revision 1.1.1.1  1998/01/17  15:55:52  release
39 
 * First version to be checked into rolling release.
40 
 *
41 
 * Revision 1.9  1997/10/10  18:25:29  pwe
42 
 * prep ANDF-DE revision
43 
 *
44 
 * Revision 1.8  1997/08/23  13:45:42  pwe
45 
 * initial ANDF-DE
46 
 *
47 
 * Revision 1.7  1997/03/20  16:24:07  pwe
48 
 * dwarf2
49 
 *
50 
 * Revision 1.6  1997/02/18  11:43:08  pwe
51 
 * NEWDIAGS for debugging optimised code
52 
 *
53 
 * Revision 1.5  1996/12/13  14:39:33  pwe
54 
 * prep NEWDIAGS
55 
 *
56 
 * Revision 1.4  1996/12/10  15:11:52  pwe
57 
 * prep NEWDIAGS
58 
 *
59 
 * Revision 1.3  1996/10/29  14:04:49  pwe
60 
 * remove inbuilt C promote etc, for inclusion of long long
61 
 *
62 
 * Revision 1.2  1995/01/30  12:56:52  pwe
63 
 * Ownership -> PWE, tidy banners
64 
 *
65 
 * Revision 1.1  1994/10/27  14:15:22  jmf
66 
 * Initial revision
67 
 *
68 
 * Revision 1.1  1994/07/12  14:41:50  jmf
69 
 * Initial revision
70 
 *
71 
**********************************************************************/
72 
 
73 
 
74 
#include "config.h"
75 
#include "common_types.h"
76 
#include "basicread.h"
77 
#include "tags.h"
78 
#include "exp.h"
79 
#include "expmacs.h"
80 
#include "diag_fns.h"
81 
#include "flags.h"
82 
#include "check.h"
83 
#include "me_fns.h"
84 
#include "externs.h"
85 
#include "installglob.h"
86 
#include "messages_r.h"
87 
#include "main_reads.h"
88 
#include "install_fns.h"
89 
#include "c_arith_type.h"
90 
#include "natmacs.h"
91 
#include "spec_tok.h"
92 
#include "dg_fns.h"
93 
 
94 
 
95 
/* intercepts specially defined tokens */
96 
 
97 
tokval special_token
98 
    PROTO_N ( (t, pars, sortcode, done) )
99 
    PROTO_T ( token t X bitstream pars X int sortcode X int * done )
100 
{
101 
  tokval tkv;
102 
  UNUSED(sortcode);
103 
 
104 
  if (t -> tok_name == (char*)0) {
105 
    SET(tkv); /* call looks at done to see if result is meaningful */
106 
    return tkv;
107 
  };
108 
 
109 
  if (!strcmp(t -> tok_name, "JMFprofile"))  {
110 
      nat n;
111 
      place old_place;
112 
      old_place = keep_place();
113 
      set_place(pars);
114 
      n = d_nat();
115 
 
116 
      set_place(old_place);
117 
      tkv.tk_exp = f_profile(n);
118 
      *done = 1;
119 
      return tkv;
120 
  };
121 
  if (!strcmp(t -> tok_name, "JMFinline"))  {
122 
      exp s;
123 
      place old_place;
124 
      old_place = keep_place();
125 
      set_place(pars);
126 
      IGNORE d_shape();
127 
      s = d_exp();
128 
      if (name(s) == apply_tag)
129 
	settoinline(s);
130 
      if (name(s) == ident_tag && name(son(s)) == clear_tag &&
131 
		name(bro(son(s))) == seq_tag &&
132 
		name(son(son(bro(son(s))))) == apply_tag)
133 
	settoinline(son(son(bro(son(s)))));
134 
 
135 
 
136 
      s = hold_check(s);
137 
 
138 
      set_place(old_place);
139 
      tkv.tk_exp = s;
140 
      *done = 1;
141 
      return tkv;
142 
  };
143 
  if (!strcmp(t -> tok_name, "~div"))  {
144 
      exp arg1, arg2;
145 
      place old_place;
146 
      old_place = keep_place();
147 
      set_place(pars);
148 
      arg1 = hold_check(d_exp());
149 
      arg2 = hold_check(d_exp());
150 
 
151 
      set_place(old_place);
152 
      tkv.tk_exp = me_b2(arg1, arg2, div0_tag);
153 
      *done = 1;
154 
      return tkv;
155 
  };
156 
  if (!strcmp(t -> tok_name, "~rem"))  {
157 
      exp arg1, arg2;
158 
      place old_place;
159 
      old_place = keep_place();
160 
      set_place(pars);
161 
      arg1 = hold_check(d_exp());
162 
      arg2 = hold_check(d_exp());
163 
 
164 
      set_place(old_place);
165 
      tkv.tk_exp = me_b2(arg1, arg2, rem0_tag);
166 
      *done = 1;
167 
      return tkv;
168 
  };
169 
#ifdef INBUILT_PROMOTE
170 
  if (!strcmp(t -> tok_name, "~arith_type")) {
171 
    int a, b;
172 
    place old_place;
173 
    signed_nat sn;
174 
    old_place = keep_place();
175 
    set_place(pars);
176 
    sn = d_signed_nat();
177 
    a = snatint(sn);
178 
    sn = d_signed_nat();
179 
    b = snatint(sn);
180 
    set_place(old_place);
181 
    snatint(sn) = arith_type(a, b);
182 
    tkv.tk_signed_nat = sn;
183 
    *done = 1;
184 
    return tkv;
185 
  };
186 
  if (!strcmp(t -> tok_name, "~promote")) {
187 
    int a;
188 
    place old_place;
189 
    signed_nat sn;
190 
    old_place = keep_place();
191 
    set_place(pars);
192 
    sn = d_signed_nat();
193 
    a = snatint(sn);
194 
    set_place(old_place);
195 
    snatint(sn) = promote(a);
196 
    tkv.tk_signed_nat = sn;
197 
    *done = 1;
198 
    return tkv;
199 
  };
200 
  if (!strcmp(t -> tok_name, "~sign_promote")) {
201 
    int a;
202 
    place old_place;
203 
    signed_nat sn;
204 
    old_place = keep_place();
205 
    set_place(pars);
206 
    sn = d_signed_nat();
207 
    a = snatint(sn);
208 
    set_place(old_place);
209 
    snatint(sn) = sign_promote(a);
210 
    tkv.tk_signed_nat = sn;
211 
    *done = 1;
212 
    return tkv;
213 
  };
214 
  if (!strcmp(t -> tok_name, "~convert")) {
215 
    int a;
216 
    place old_place;
217 
    signed_nat sn;
218 
    old_place = keep_place();
219 
    set_place(pars);
220 
    sn = d_signed_nat();
221 
    a = snatint(sn);
222 
    set_place(old_place);
223 
    tkv.tk_variety = convert((unsigned)a);
224 
    *done = 1;
225 
    return tkv;
226 
  };
227 
#endif
228 
  if (!strcmp(t -> tok_name, "~alloca"))  {
229 
      exp arg1;
230 
      place old_place;
231 
      old_place = keep_place();
232 
      set_place(pars);
233 
      arg1 = hold_check(d_exp());
234 
      set_place(old_place);
235 
      tkv.tk_exp = hold_check(me_u3(f_pointer(long_to_al(8)),
236 
			   arg1, alloca_tag));
237 
      *done = 1;
238 
      has_alloca = 1;
239 
      return tkv;
240 
  };
241 
 
242 
  if (!strcmp(t -> tok_name, "~exp_to_source") ||
243 
      !strcmp(t -> tok_name, "~diag_id_scope") ||
244 
      !strcmp(t -> tok_name, "~diag_type_scope") ||
245 
      !strcmp(t -> tok_name, "~diag_tag_scope")
246 
#ifdef NEWDIAGS
247 
	|| !strcmp(t -> tok_name, "~dg_exp")
248 
#endif
249 
     )  {
250 
 
251 
      place old_place;
252 
      old_place = keep_place();
253 
      set_place(pars);
254 
      tkv.tk_exp = hold_check(d_exp());
255 
      *done = 1;
256 
 
257 
      if (!diagnose)
258 
        {
259 
          set_place(old_place);
260 
          return tkv;
261 
        };
262 
 
263 
     if (!strcmp(t -> tok_name, "~exp_to_source"))
264 
       {
265 
#ifdef NEWDIAGS
266 
	tkv.tk_exp = read_exp_to_source (tkv.tk_exp);
267 
#else
268 
        diag_info * di = read_exp_to_source();
269 
        exp r = getexp(sh(tkv.tk_exp), nilexp, 0, tkv.tk_exp, nilexp,
270 
                   1, 0, diagnose_tag);
271 
        setfather(r, tkv.tk_exp);
272 
        dno(r) = di;
273 
        tkv.tk_exp = r;
274 
	crt_lno = natint(di -> data.source.end.line_no);
275 
	crt_charno = natint(di -> data.source.end.char_off);
276 
	crt_flnm = di -> data.source.beg.file->file.ints.chars;
277 
#endif
278 
        set_place(old_place);
279 
        return tkv;
280 
       };
281 
 
282 
     if (!strcmp(t -> tok_name, "~diag_id_scope"))
283 
       {
284 
#ifdef NEWDIAGS
285 
        tkv.tk_exp = read_diag_id_scope (tkv.tk_exp);
286 
#else
287 
        diag_info * di = read_diag_id_scope();
288 
        exp r = getexp(sh(tkv.tk_exp), nilexp, 0, tkv.tk_exp, nilexp,
289 
                   2, 0, diagnose_tag);
290 
        setfather(r, tkv.tk_exp);
291 
        dno(r) = di;
292 
        tkv.tk_exp = r;
293 
#endif
294 
        set_place(old_place);
295 
        return tkv;
296 
       };
297 
 
298 
     if (!strcmp(t -> tok_name, "~diag_type_scope"))
299 
       {
300 
#ifdef NEWDIAGS
301 
        tkv.tk_exp = read_diag_type_scope (tkv.tk_exp);
302 
#else
303 
        diag_info * di = read_diag_type_scope();
304 
        exp r = getexp(sh(tkv.tk_exp), nilexp, 0, tkv.tk_exp, nilexp,
305 
                   3, 0, diagnose_tag);
306 
        setfather(r, tkv.tk_exp);
307 
        dno(r) = di;
308 
        tkv.tk_exp = r;
309 
#endif
310 
        set_place(old_place);
311 
        return tkv;
312 
       };
313 
 
314 
     if (!strcmp(t -> tok_name, "~diag_tag_scope"))
315 
       {
316 
#ifndef NEWDIAGS
317 
        diag_info * di = read_diag_tag_scope();
318 
        exp r = getexp(sh(tkv.tk_exp), nilexp, 0, tkv.tk_exp, nilexp,
319 
                   4, 0, diagnose_tag);
320 
        setfather(r, tkv.tk_exp);
321 
        dno(r) = di;
322 
        tkv.tk_exp = r;
323 
#endif
324 
        set_place(old_place);
325 
        return tkv;
326 
       };
327 
 
328 
#ifdef NEWDIAGS
329 
     if (!strcmp(t -> tok_name, "~dg_exp"))
330 
       {
331 
        tkv.tk_exp = read_dg_exp (tkv.tk_exp);
332 
        set_place(old_place);
333 
        return tkv;
334 
       };
335 
#endif
336 
 
337 
  };
338 
 
339 
  if (!strncmp(t -> tok_name, "~asm", 4)) {
340 
    int prp;
341 
    exp arg1;
342 
    place old_place;
343 
    old_place = keep_place();
344 
    if (!strcmp(t -> tok_name, "~asm")) {
345 
      set_place(pars);
346 
      arg1 = hold_check (f_make_nof_int (ucharsh, d_string()));
347 
      prp = 1;
348 
    }
349 
    else {
350 
      if (!strcmp(t -> tok_name, "~asm_sequence"))
351 
	prp = 0;
352 
      else
353 
      if (!strcmp(t -> tok_name, "~asm_exp_input"))
354 
	prp = 2;
355 
      else
356 
      if (!strcmp(t -> tok_name, "~asm_exp_output"))
357 
	prp = 4;
358 
      else
359 
      if (!strcmp(t -> tok_name, "~asm_exp_address"))
360 
	prp = 8;
361 
      else
362 
	return tkv;
363 
      set_place(pars);
364 
      arg1 = hold_check (d_exp());
365 
    }
366 
    set_place(old_place);
367 
    tkv.tk_exp = getexp (f_top, nilexp, 0, arg1, nilexp, prp, 0, asm_tag);
368 
    setfather (tkv.tk_exp, arg1);
369 
    *done = 1;
370 
    return tkv;
371 
  }
372 
 
373 
  SET(tkv); /* call looks at done to see if result is meaningful */
374 
  return tkv;
375 
}