Subversion Repositories tendra.SVN

Rev

Rev 5 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5 Rev 6
Line -... Line 1...
-
 
1
/*
-
 
2
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
-
 
3
 * All rights reserved.
-
 
4
 *
-
 
5
 * Redistribution and use in source and binary forms, with or without
-
 
6
 * modification, are permitted provided that the following conditions are met:
-
 
7
 *
-
 
8
 * 1. Redistributions of source code must retain the above copyright notice,
-
 
9
 *    this list of conditions and the following disclaimer.
-
 
10
 * 2. Redistributions in binary form must reproduce the above copyright notice,
-
 
11
 *    this list of conditions and the following disclaimer in the documentation
-
 
12
 *    and/or other materials provided with the distribution.
-
 
13
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
-
 
14
 *    may be used to endorse or promote products derived from this software
-
 
15
 *    without specific, prior written permission.
-
 
16
 *
-
 
17
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
-
 
18
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-
 
19
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-
 
20
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
-
 
21
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-
 
22
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-
 
23
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-
 
24
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-
 
25
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-
 
26
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-
 
27
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 
28
 *
-
 
29
 * $Id$
-
 
30
 */
1
/*
31
/*
2
    		 Crown Copyright (c) 1997
32
    		 Crown Copyright (c) 1997
3
 
33
 
4
    This TenDRA(r) Computer Program is subject to Copyright
34
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
35
    owned by the United Kingdom Secretary of State for Defence
Line 103... Line 133...
103
#include "procrectypes.h"
133
#include "procrectypes.h"
104
#include "f64.h"
134
#include "f64.h"
105
#include "eval.h"
135
#include "eval.h"
106
#include "basicread.h"
136
#include "basicread.h"
107
 
137
 
108
extern void globalise_name PROTO_S ((dec*));
138
extern void globalise_name(dec*);
109
extern  procrec * procrecs;
139
extern  procrec * procrecs;
110
 
140
 
111
long  G_number = 64;		/* to give choice of .sdata or data */
141
long  G_number = 64;		/* to give choice of .sdata or data */
112
 
142
 
113
int   data_lab = 33;
143
int   data_lab = 33;
114
 
144
 
115
int next_data_lab
145
int next_data_lab
116
    PROTO_Z ()
146
(void)
117
{	/*  anonymous label in data space - $$n in assember o/p */
147
{	/*  anonymous label in data space - $$n in assember o/p */
118
        return data_lab++;
148
        return data_lab++;
119
}
149
}
120
 
150
 
121
int next_dlab_sym
151
int next_dlab_sym
122
    PROTO_Z ()
152
(void)
123
{	/* as above - but also gives it a symno for .G output */
153
{	/* as above - but also gives it a symno for .G output */
124
        symnofordata (data_lab);
154
        symnofordata(data_lab);
125
  return data_lab++;
155
  return data_lab++;
126
}
156
}
127
 
157
 
128
 
158
 
129
/* various pieces of info for outputting data depending on shape */
159
/* various pieces of info for outputting data depending on shape */
Line 150... Line 180...
150
maxmin
180
maxmin
151
 
181
 
152
finds the data size from the range of an integer shape
182
finds the data size from the range of an integer shape
153
**************************************************************/
183
**************************************************************/
154
mm maxmin
184
mm maxmin
155
    PROTO_N ( (s) )
-
 
156
    PROTO_T ( shape s )
185
(shape s)
157
{
186
{
158
  switch (name (s)) {
187
  switch (name(s)) {
159
    case scharhd:
188
    case scharhd:
160
      return scmm;
189
      return scmm;
161
    case ucharhd:
190
    case ucharhd:
162
      return uscmm;
191
      return uscmm;
163
    case swordhd:
192
    case swordhd:
Line 183... Line 212...
183
outputs the label parameter if non negative else interprets it
212
outputs the label parameter if non negative else interprets it
184
to be an index into the externals and outputs the identifier.
213
to be an index into the externals and outputs the identifier.
185
**************************************************************/
214
**************************************************************/
186
 
215
 
187
void outlab
216
void outlab
188
    PROTO_N ( (l) )
-
 
189
    PROTO_T ( int l )
217
(int l)
190
{
218
{
191
  if (l >= 0) {
219
  if (l >= 0) {
192
    fprintf (as_file, "$$%d", l);
220
    fprintf(as_file, "$$%d", l);
193
  }
221
  }
194
  else {
222
  else {
195
    char *extname = main_globals[-l - 1] -> dec_u.dec_val.dec_id;
223
    char *extname = main_globals[-l - 1] -> dec_u.dec_val.dec_id;
196
    fprintf (as_file, "%s", extname);
224
    fprintf(as_file, "%s", extname);
197
  }
225
  }
198
}
226
}
199
 
227
 
200
 
228
 
201
 
229
 
202
 
230
 
203
 
231
 
204
/***************************************************************
232
/***************************************************************
205
evalone
233
evalone
206
 
234
 
207
This procedure outputs all non-pack expressions and puts in label
235
This procedure outputs all non-pack expressions and puts in label
208
values for the pack exps (putting new label numbers into their number
236
values for the pack exps (putting new label numbers into their number
209
fields) which it accumulates for later application in the ptr parameter
237
fields) which it accumulates for later application in the ptr parameter
210
of evalone. This is done to cope with the fact that the exp to evaluated
238
of evalone. This is done to cope with the fact that the exp to evaluated
211
may contain pack operations which are graph-like .
239
may contain pack operations which are graph-like .
212
***************************************************************/
240
***************************************************************/
213
long  evalexp
241
long  evalexp
214
    PROTO_N ( (e) )
-
 
215
    PROTO_T ( exp e )
242
(exp e)
216
{
243
{
217
  switch (name(e)) {
244
  switch (name(e)) {
218
    case  val_tag: case null_tag: case top_tag:{
245
    case  val_tag: case null_tag: case top_tag:{
219
	if (name(sh(e)) == offsethd && al2(sh(e)) >= 8) {
246
	if (name(sh(e)) == offsethd && al2(sh(e)) >= 8) {
220
		return (no(e)>>3);
247
		return(no(e) >>3);
221
	}
248
	}
222
        return (no (e));
249
        return(no(e));
223
    }
250
    }
224
    case bitf_to_int_tag:
251
    case bitf_to_int_tag:
225
      {
252
      {
226
	return evalexp (son (e));
253
	return evalexp(son(e));
227
      }
254
      }
228
    case int_to_bitf_tag:
255
    case int_to_bitf_tag:
229
      {
256
      {
230
	ash a;
257
	ash a;
231
	long  w = evalexp (son (e));
258
	long  w = evalexp(son(e));
232
	a = ashof (sh (e));
259
	a = ashof(sh(e));
233
	if (a.ashalign != 1) {
260
	if (a.ashalign != 1) {
234
	  failer ("should be align 1");
261
	  failer("should be align 1");
235
	}
262
	}
236
	if (a.ashsize != 32) {
263
	if (a.ashsize != 32) {
237
	  w &= ((1 << a.ashsize) - 1);
264
	  w &= ((1 << a.ashsize) - 1);
238
	}
265
	}
239
	return w;
266
	return w;
240
      }
267
      }
241
    case not_tag:
268
    case not_tag:
242
      {
269
      {
243
	return (~evalexp (son (e)));
270
	return(~evalexp(son(e)));
244
      }
271
      }
245
    case and_tag:
272
    case and_tag:
246
      {
273
      {
247
	return (evalexp (son (e)) & evalexp (bro (son (e))));
274
	return(evalexp(son(e)) & evalexp(bro(son(e))));
248
      }
275
      }
249
    case or_tag:
276
    case or_tag:
250
      {
277
      {
251
	return (evalexp (son (e)) | evalexp (bro (son (e))));
278
	return(evalexp(son(e)) | evalexp(bro(son(e))));
252
      }
-
 
253
    case xor_tag:
-
 
254
      {
-
 
255
	return (evalexp (son (e)) ^ evalexp (bro (son (e))));
-
 
256
      }
279
      }
257
 
-
 
258
    case shr_tag:
280
    case xor_tag:
259
      {
281
      {
-
 
282
	return(evalexp(son(e))^ evalexp(bro(son(e))));
-
 
283
      }
-
 
284
 
-
 
285
    case shr_tag:
-
 
286
      {
260
	return (evalexp (son (e)) >> evalexp (bro (son (e))));
287
	return(evalexp(son(e)) >> evalexp(bro(son(e))));
261
      }
288
      }
262
 
289
 
263
    case shl_tag:
290
    case shl_tag:
264
      {
291
      {
265
	return (evalexp (son (e)) << evalexp (bro (son (e))));
292
	return(evalexp(son(e)) << evalexp(bro(son(e))));
266
      }
293
      }
267
 
294
 
268
    case concatnof_tag:
295
    case concatnof_tag:
269
      {
296
      {
270
	ash a;
297
	ash a;
271
	long  wd = evalexp (son (e));
298
	long  wd = evalexp(son(e));
272
	a = ashof (sh (son (e)));
299
	a = ashof(sh(son(e)));
273
	return (wd | (evalexp (bro (son (e))) << a.ashsize));
300
	return(wd | (evalexp(bro(son(e))) << a.ashsize));
274
      }
301
      }
275
 
302
 
276
    case clear_tag:
303
    case clear_tag:
277
      {
304
      {
278
	ash a;
305
	ash a;
279
	a = ashof (sh (e));
306
	a = ashof(sh(e));
280
	if (a.ashsize > 32)
307
	if (a.ashsize > 32)
281
	  failer ("clearshape");
308
	  failer("clearshape");
282
	return 0;
309
	return 0;
283
      }
310
      }
284
   case env_offset_tag:
311
   case env_offset_tag:
285
   case general_env_offset_tag: {
312
   case general_env_offset_tag: {
286
   	return frame_offset(son(e));
313
   	return frame_offset(son(e));
Line 289... Line 316...
289
	exp tg = son(son(e));
316
	exp tg = son(son(e));
290
	procrec * pr = &procrecs[no(son(tg))];
317
	procrec * pr = &procrecs[no(son(tg))];
291
	return((pr->frame_size+pr->callee_size) >> 3);
318
	return((pr->frame_size+pr->callee_size) >> 3);
292
   }
319
   }
293
   case offset_add_tag:{
320
   case offset_add_tag:{
294
    	return (evalexp(son(e))+evalexp(bro(son(e))));
321
    	return(evalexp(son(e)) +evalexp(bro(son(e))));
295
   }
322
   }
296
   case offset_max_tag:{
323
   case offset_max_tag:{
297
    	return (max(evalexp(son(e)),evalexp(bro(son(e)))));
324
    	return(max(evalexp(son(e)),evalexp(bro(son(e)))));
298
   }
325
   }
299
   case offset_pad_tag:{
326
   case offset_pad_tag:{
300
	return( rounder(evalexp(son(e)), shape_align(sh(e))));
327
	return(rounder(evalexp(son(e)), shape_align(sh(e))));
301
   }
328
   }
302
   case offset_mult_tag:{
329
   case offset_mult_tag:{
303
    	return (evalexp(son(e))*evalexp(bro(son(e))));
330
    	return(evalexp(son(e))*evalexp(bro(son(e))));
304
   }
331
   }
305
   case offset_div_tag:case offset_div_by_int_tag:{
332
   case offset_div_tag:case offset_div_by_int_tag:{
306
    	return (evalexp(son(e))/evalexp(bro(son(e))));
333
    	return(evalexp(son(e)) /evalexp(bro(son(e))));
307
   }
334
   }
308
   case offset_subtract_tag:{
335
   case offset_subtract_tag:{
309
    	return (evalexp(son(e))-evalexp(bro(son(e))));
336
    	return(evalexp(son(e)) -evalexp(bro(son(e))));
310
   }
337
   }
311
   case offset_negate_tag: {
338
   case offset_negate_tag: {
312
	return (- evalexp(son(e)));
339
	return(- evalexp(son(e)));
313
   }
340
   }
314
    default:
341
    default:
315
      failer ("tag not in evalexp");
342
      failer("tag not in evalexp");
316
  }
343
  }
317
  return 0;
344
  return 0;
318
}
345
}
319
 
346
 
320
void set_align
347
void set_align
321
    PROTO_N ( (al) )
-
 
322
    PROTO_T ( int al )
348
(int al)
323
{
349
{
324
	if (al<16) return;
350
	if (al<16) return;
325
	if (as_file)
351
	if (as_file)
326
	  fprintf (as_file, "\t.align%s\n",
352
	  fprintf(as_file, "\t.align%s\n",
327
	      (al == 16) ? " 1" :
353
	     (al == 16)? " 1" :
328
	      ((al == 32) ? " 2" :
354
	     ((al == 32)? " 2" :
329
		((al == 64) ? " 3" : " 0")));
355
		((al == 64)? " 3" : " 0")));
330
	out_value (0, ialign, (al == 16) ? 1 :
356
	out_value(0, ialign,(al == 16)? 1 :
331
	    ((al == 32) ? 2 :
357
	   ((al == 32)? 2 :
332
	      ((al == 64) ? 3 : 0)), 0);
358
	     ((al == 64)? 3 : 0)), 0);
333
 
359
 
334
}
360
}
335
 
361
 
336
int eval_al
362
int eval_al
337
    PROTO_N ( (s) )
-
 
338
    PROTO_T ( shape s )
363
(shape s)
339
{
364
{
340
	if (shape_align(s)!=1) return shape_align(s);
365
	if (shape_align(s)!=1) return shape_align(s);
341
	if (shape_size(s) <=8) return 8;
366
	if (shape_size(s) <=8) return 8;
342
	if (shape_size(s) <=16) return 16;
367
	if (shape_size(s) <=16) return 16;
343
	return 32;
368
	return 32;
344
}
369
}
345
 
370
 
346
void oneval
371
void oneval
347
    PROTO_N ( (val, al, rep) )
-
 
348
    PROTO_T ( int val X int al X int rep )
372
(int val, int al, int rep)
349
{
373
{
350
	char *as = (al <= 8) ? "\t.byte %ld :%ld\n"
374
	char *as = (al <= 8)? "\t.byte %ld :%ld\n"
351
	:     ((al <= 16) ? "\t.half %ld :%ld\n"
375
	:    ((al <= 16)? "\t.half %ld :%ld\n"
352
	  :     "\t.word %ld :%ld\n");
376
	  :     "\t.word %ld :%ld\n");
353
	set_align(al);
377
	set_align(al);
354
	if (as_file)
378
	if (as_file)
355
	  fprintf (as_file, as, val, rep);
379
	  fprintf(as_file, as, val, rep);
356
	out_value (0, (al <= 8) ? ibyte : ((al <= 16) ? ihalf : iword), val, rep);
380
	out_value(0,(al <= 8)? ibyte :((al <= 16)? ihalf : iword), val, rep);
357
}
381
}
358
 
382
 
359
 
383
 
360
 
384
 
361
void evalone
385
void evalone
362
    PROTO_N ( (e, rep) )
-
 
363
    PROTO_T ( exp e X long rep )
386
(exp e, long rep)
364
{
387
{
365
				/* outputs constant expression e, rep
388
				/* outputs constant expression e, rep
366
				   times;  */
389
				   times;  */
367
  ash a;
390
  ash a;
368
  a = ashof (sh (e));
391
  a = ashof(sh(e));
369
  switch (name (e)) {
392
  switch (name(e)) {
370
 
393
 
371
    case string_tag:
394
    case string_tag:
372
      {
395
      {
373
        long char_size = props(e);
396
        long char_size = props(e);
374
	long  strsize = shape_size(sh(e))/char_size;
397
	long  strsize = shape_size(sh(e)) /char_size;
375
	char *st = nostr(e);
398
	char *st = nostr(e);
376
	long  strs = shape_size(sh(e))>>3;
399
	long  strs = shape_size(sh(e)) >>3;
377
	int   i,j;
400
	int   i,j;
378
	if (rep != 1 && as_file)
401
	if (rep != 1 && as_file)
379
	  fprintf (as_file, "\t.repeat %ld\n", rep);
402
	  fprintf(as_file, "\t.repeat %ld\n", rep);
380
	set_align(char_size);
403
	set_align(char_size);
381
	if (as_file) {
404
	if (as_file) {
382
	  for (j=0; j< strsize; ) {
405
	  for (j=0; j< strsize;) {
383
	    switch(char_size) {
406
	    switch (char_size) {
384
	      case 8: fprintf (as_file, "\t.byte "); break;
407
	      case 8: fprintf(as_file, "\t.byte "); break;
385
	      case 16: fprintf (as_file, "\t.half "); break;
408
	      case 16: fprintf(as_file, "\t.half "); break;
386
	      case 32: fprintf (as_file, "\t.word "); break;
409
	      case 32: fprintf(as_file, "\t.word "); break;
387
	    }
410
	    }
388
	    for (i = j; i < strsize && i-j < 8; i++) {
411
	    for (i = j; i < strsize && i-j < 8; i++) {
389
	      switch (char_size) {
412
	      switch (char_size) {
390
	        case 8:fprintf (as_file, "0x%x ", st[i]); break;
413
	        case 8:fprintf(as_file, "0x%x ", st[i]); break;
391
	        case 16:fprintf (as_file, "0x%x ", ((short *)st)[i]); break;
414
	        case 16:fprintf(as_file, "0x%x ",((short *)st)[i]); break;
392
	        case 32:fprintf (as_file, "0x%lx ", ((long *)st)[i]); break;
415
	        case 32:fprintf(as_file, "0x%lx ",((long *)st)[i]); break;
393
	      }
416
	      }
394
	    }
417
	    }
395
	    j =i;
418
	    j =i;
396
	    fprintf (as_file, "\n");
419
	    fprintf(as_file, "\n");
397
	  }
420
	  }
398
	}
421
	}
399
	if (rep != 1 && as_file)
422
	if (rep != 1 && as_file)
400
	  fprintf (as_file, "\t.endr\n");
423
	  fprintf(as_file, "\t.endr\n");
401
	out_chars (0, iascii, strs, rep);
424
	out_chars(0, iascii, strs, rep);
402
	out_data (st, strs);
425
	out_data(st, strs);
403
	return;
426
	return;
404
      }
427
      }
405
    case real_tag:
428
    case real_tag:
406
      {
429
      {
407
	r2l   n;
430
	r2l   n;
408
	int i;
431
	int i;
409
	n = real2longs_IEEE(&flptnos[no (e)], (a.ashsize>32)?1:0);
432
	n = real2longs_IEEE(&flptnos[no(e)],(a.ashsize>32)?1:0);
410
	set_align(a.ashalign);
433
	set_align(a.ashalign);
411
	for(i=0; i<rep; i++) {
434
	for (i=0; i<rep; i++) {
412
		if (BIGEND) {
435
		if (BIGEND) {
413
			if(a.ashsize>32)  oneval(n.i2, 32, 1);
436
			if (a.ashsize>32) oneval(n.i2, 32, 1);
414
			oneval(n.i1, 32, 1);
437
			oneval(n.i1, 32, 1);
415
		}
438
		}
416
		else {
439
		else {
417
              		oneval(n.i1, 32, 1);
440
              		oneval(n.i1, 32, 1);
418
          		if(a.ashsize>32) oneval(n.i2, 32, 1);
441
          		if (a.ashsize>32)oneval(n.i2, 32, 1);
419
		}
442
		}
420
        }
443
        }
421
	return;
444
	return;
422
      }
445
      }
423
    case null_tag: case top_tag:
446
    case null_tag: case top_tag:
424
      no (e) = 0;
447
      no(e) = 0;
425
    case val_tag:
448
    case val_tag:
426
      {
449
      {
427
	if (shape_size(sh(e)) > 32) {
450
	if (shape_size(sh(e)) > 32) {
428
		flt64 temp;
451
		flt64 temp;
429
		int ov;
452
		int ov;
430
		int i;
453
		int i;
431
		if (isbigval(e)) {
454
		if (isbigval(e)) {
432
			temp = flt_to_f64(no(e), 0, &ov);
455
			temp = flt_to_f64(no(e), 0, &ov);
433
		}
456
		}
434
		else {
457
		else {
435
			temp.big = (is_signed(sh(e)) && no(e)<0)?-1:0;
458
			temp.big = (is_signed(sh(e)) && no(e) <0)?-1:0;
436
			temp.small = no(e);
459
			temp.small = no(e);
437
		}
460
		}
438
		for(i=0; i<rep; i++) {
461
		for (i=0; i<rep; i++) {
439
			oneval(temp.small, 32, 1);
462
			oneval(temp.small, 32, 1);
440
			oneval(temp.big, 32, 1);
463
			oneval(temp.big, 32, 1);
441
		}
464
		}
442
		return;
465
		return;
443
	}
466
	}
Line 450... Line 473...
450
      {
473
      {
451
	exp dc = son(e);
474
	exp dc = son(e);
452
	dec * globdec= brog(dc);/* must be global name */
475
	dec * globdec= brog(dc);/* must be global name */
453
	char *nm = globdec -> dec_u.dec_val.dec_id;
476
	char *nm = globdec -> dec_u.dec_val.dec_id;
454
	long symdef = globdec ->dec_u.dec_val.sym_number;
477
	long symdef = globdec ->dec_u.dec_val.sym_number;
455
	if (!isvar(dc) && son(dc) != nilexp
478
	if (!isvar(dc) && son(dc)!= nilexp
456
		&& name(son(dc)) != proc_tag && name(son(dc)) != general_proc_tag
479
		&& name(son(dc))!= proc_tag && name(son(dc))!= general_proc_tag
457
		&& no(e)==0
480
		&& no(e) ==0
458
		&& shape_size(sh(e)) == shape_size(sh(son(dc)))  ) {
481
		&& shape_size(sh(e)) == shape_size(sh(son(dc)))) {
459
		evalone(son(dc), rep);
482
		evalone(son(dc), rep);
460
		return;
483
		return;
461
	}
484
	}
462
  	set_align(32);
485
  	set_align(32);
463
	if (as_file) {
486
	if (as_file) {
464
	  if (no (e) == 0) {
487
	  if (no(e) == 0) {
465
	    fprintf (as_file, "\t.word %s : %ld\n", nm, rep);
488
	    fprintf(as_file, "\t.word %s : %ld\n", nm, rep);
466
	  }
489
	  }
467
	  else {
490
	  else {
468
	    fprintf (as_file, "\t.word %s + %d :%ld\n", nm, no (e) / 8, rep);
491
	    fprintf(as_file, "\t.word %s + %d :%ld\n", nm, no(e) / 8, rep);
469
	  }
492
	  }
470
	}
493
	}
471
	out_value (symnos[symdef], iword, no (e) / 8, rep);
494
	out_value(symnos[symdef], iword, no(e) / 8, rep);
472
	return;
495
	return;
473
      }
496
      }
474
    case compound_tag:  {
497
    case compound_tag:  {
475
	exp tup = son (e);
498
	exp tup = son(e);
476
	unsigned long val;
499
	unsigned long val;
477
	bool first_bits=1;
500
	bool first_bits=1;
478
	long bits_start =0;
501
	long bits_start =0;
479
	long offs =0;
502
	long offs =0;
480
 
503
 
481
	if (rep != 1)
504
	if (rep != 1)
482
	  failer ("CAN'T REP TUPLES");
505
	  failer("CAN'T REP TUPLES");
483
	set_align(a.ashalign);
506
	set_align(a.ashalign);
484
 
507
 
485
 
508
 
486
	for(;;) {
509
	for (;;) {
487
	     ash ae;
510
	     ash ae;
488
	     ae = ashof(sh(bro(tup)));
511
	     ae = ashof(sh(bro(tup)));
489
	     offs = no(tup);
512
	     offs = no(tup);
490
	     if (ae.ashalign == 1) {
513
	     if (ae.ashalign == 1) {
491
		unsigned long vb = evalexp(bro(tup));
514
		unsigned long vb = evalexp(bro(tup));
492
		if (ae.ashsize != 32) {
515
		if (ae.ashsize != 32) {
493
		  vb = vb & ((1<<ae.ashsize)-1);
516
		  vb = vb & ((1<<ae.ashsize) -1);
494
		}
517
		}
495
                if (first_bits) {
518
                if (first_bits) {
496
		     val = 0;
519
		     val = 0;
497
                     first_bits=0;
520
                     first_bits=0;
498
                }
521
                }
499
 
522
 
500
                if (offs - bits_start +ae.ashsize > 32) {
523
                if (offs - bits_start +ae.ashsize > 32) {
501
                   if (BIGEND) {
524
                   if (BIGEND) {
502
                      for(;;) {
525
                      for (;;) {
503
                              oneval(val>>24, 8, 1);
526
                              oneval(val>>24, 8, 1);
504
                              val <<=8;
527
                              val <<=8;
505
                              bits_start+=8;
528
                              bits_start+=8;
506
                              if (offs-bits_start < 8) break;
529
                              if (offs-bits_start < 8)break;
507
                      }
530
                      }
508
                   }
531
                   }
509
                   else {
532
                   else {
510
                     for(;;) {
533
                     for (;;) {
511
                        oneval(val &255, 8,1);
534
                        oneval(val &255, 8,1);
512
                        val >>= 8;
535
                        val >>= 8;
513
                        bits_start += 8;
536
                        bits_start += 8;
514
                        if (offs - bits_start  < 8)
537
                        if (offs - bits_start  < 8)
515
                                 break;
538
                                 break;
Line 520... Line 543...
520
                if (offs - bits_start +ae.ashsize <= 32) {
543
                if (offs - bits_start +ae.ashsize <= 32) {
521
                     if (BIGEND) {
544
                     if (BIGEND) {
522
			val |= (vb << (32 -offs+bits_start-ae.ashsize));
545
			val |= (vb << (32 -offs+bits_start-ae.ashsize));
523
		     }
546
		     }
524
		     else {
547
		     else {
525
                     	val |= (vb <<(offs-bits_start));
548
                     	val |= (vb << (offs-bits_start));
526
		     }
549
		     }
527
                }
550
                }
528
                else {
551
                else {
529
                   failer("Constant bitfield does not fit into 32 bits");
552
                   failer("Constant bitfield does not fit into 32 bits");
530
                }
553
                }
531
	     }
554
	     }
532
	     else {
555
	     else {
533
	     	if (!first_bits) {
556
	     	if (!first_bits) {
534
		    first_bits=1;
557
		    first_bits=1;
535
		    if (BIGEND) {
558
		    if (BIGEND) {
536
		   	for(;;) {
559
		   	for (;;) {
537
		   		oneval(val>>24, 8, 1);
560
		   		oneval(val>>24, 8, 1);
538
		   		val <<=8;
561
		   		val <<=8;
539
		   		bits_start+=8;
562
		   		bits_start+=8;
540
		   		if (offs-bits_start <= 0) break;
563
		   		if (offs-bits_start <= 0)break;
541
		   	}
564
		   	}
542
		     }
565
		     }
543
		     else {
566
		     else {
544
                       for(;;) {
567
                       for (;;) {
545
                          oneval(val &255, 8,1);
568
                          oneval(val &255, 8,1);
546
                          val >>=8;
569
                          val >>=8;
547
                          bits_start += 8;
570
                          bits_start += 8;
548
                          if ( offs - bits_start  <=0)
571
                          if (offs - bits_start  <=0)
549
                                   break;
572
                                   break;
550
                       }
573
                       }
551
                     }
574
                     }
552
	  	}
575
	  	}
553
		while (bits_start < offs) {
576
		while (bits_start < offs) {
Line 558... Line 581...
558
		bits_start += shape_size(sh(bro(tup)));
581
		bits_start += shape_size(sh(bro(tup)));
559
	     }
582
	     }
560
 
583
 
561
	     if (last(bro(tup))) {
584
	     if (last(bro(tup))) {
562
	     	     offs += ae.ashsize;
585
	     	     offs += ae.ashsize;
563
		     offs = (offs+7)&~7;
586
		     offs = (offs+7) &~7;
564
		     for(;!first_bits;) {
587
		     for (;!first_bits;) {
565
                      if (BIGEND) {
588
                      if (BIGEND) {
566
                            oneval(val>>24, 8, 1);
589
                            oneval(val>>24, 8, 1);
567
                            val <<=8;
590
                            val <<=8;
568
                            bits_start+=8;
591
                            bits_start+=8;
569
                            if (offs-bits_start<= 0) break;
592
                            if (offs-bits_start<= 0)break;
570
                       }
593
                       }
571
                       else {
594
                       else {
572
                            oneval(val &255, 8,1);
595
                            oneval(val &255, 8,1);
573
                            val >>= 8;
596
                            val >>= 8;
574
                            bits_start +=8;
597
                            bits_start +=8;
575
                            if ( offs - bits_start <=0)
598
                            if (offs - bits_start <=0)
576
                                     break;
599
                                     break;
577
                       }
600
                       }
578
		     }
601
		     }
579
		     Assert(a.ashsize >= offs);
602
		     Assert(a.ashsize >= offs);
580
		     while (a.ashsize > offs) { /* pad out unions etc */
603
		     while (a.ashsize > offs) { /* pad out unions etc */
Line 590... Line 613...
590
 
613
 
591
   case nof_tag: {
614
   case nof_tag: {
592
   	exp s = son(e);
615
   	exp s = son(e);
593
	if (s==nilexp) return;
616
	if (s==nilexp) return;
594
	if (rep != 1)
617
	if (rep != 1)
595
	  failer ("CAN'T REP TUPLES");
618
	  failer("CAN'T REP TUPLES");
596
   	set_align(a.ashalign);
619
   	set_align(a.ashalign);
597
   	for(;;) {
620
   	for (;;) {
598
   		evalone(s,1);
621
   		evalone(s,1);
599
   		if (last(s)) return;
622
   		if (last(s)) return;
600
   		s = bro(s);
623
   		s = bro(s);
601
   	}
624
   	}
602
   }
625
   }
Line 609... Line 632...
609
             int n;
632
             int n;
610
             for (n = rep*no(e); n > 0; n--) {
633
             for (n = rep*no(e); n > 0; n--) {
611
             	evalone(son(e), 1);
634
             	evalone(son(e), 1);
612
             }
635
             }
613
        }
636
        }
614
	else evalone (son (e), rep * no (e));
637
	else evalone(son(e), rep * no(e));
615
	return;
638
	return;
616
      }
639
      }
617
 
640
 
618
    case concatnof_tag:
641
    case concatnof_tag:
619
      {
642
      {
620
	if (a.ashalign == 1) {
643
	if (a.ashalign == 1) {
621
	  long  ee = evalexp (e);
644
	  long  ee = evalexp(e);
622
	  exp dad = father(e);
645
	  exp dad = father(e);
623
	  ash abits;
646
	  ash abits;
624
	  abits = ashof(sh(dad));
647
	  abits = ashof(sh(dad));
625
	  oneval(ee, abits.ashalign, rep);
648
	  oneval(ee, abits.ashalign, rep);
626
	}
649
	}
627
	else {
650
	else {
628
	  if (rep != 1)
651
	  if (rep != 1)
629
	    failer ("CAN'T REP concat");
652
	    failer("CAN'T REP concat");
630
	  evalone (son (e), 1);
653
	  evalone(son(e), 1);
631
	  evalone (bro (son (e)), 1);
654
	  evalone(bro(son(e)), 1);
632
	}
655
	}
633
	return;
656
	return;
634
      }
657
      }
635
 
658
 
636
    case clear_tag:
659
    case clear_tag:
637
      {
660
      {
638
	int s = eval_al(sh(e));
661
	int s = eval_al(sh(e));
639
	if (as_file)
662
	if (as_file)
640
	  fprintf (as_file, "\t.space %ld\n", (s>>3) * rep);
663
	  fprintf(as_file, "\t.space %ld\n",(s>>3)* rep);
641
	out_value (0, ispace, (s>>3) * rep, 1);
664
	out_value(0, ispace,(s>>3)* rep, 1);
642
	return;
665
	return;
643
      }
666
      }
644
 
667
 
645
 
668
 
646
 
669
 
Line 655... Line 678...
655
    case general_env_offset_tag:
678
    case general_env_offset_tag:
656
   case env_size_tag: case offset_add_tag: case offset_max_tag:
679
   case env_size_tag: case offset_add_tag: case offset_max_tag:
657
   case offset_pad_tag: case offset_mult_tag: case offset_div_tag:
680
   case offset_pad_tag: case offset_mult_tag: case offset_div_tag:
658
   case offset_div_by_int_tag: case offset_subtract_tag: case offset_negate_tag:
681
   case offset_div_by_int_tag: case offset_subtract_tag: case offset_negate_tag:
659
      {
682
      {
660
	long  ee = evalexp (e);
683
	long  ee = evalexp(e);
661
	oneval(ee, eval_al(sh(e)) , rep);
684
	oneval(ee, eval_al(sh(e)), rep);
662
	return;
685
	return;
663
      }
686
      }
664
   case seq_tag:
687
   case seq_tag:
665
      {
688
      {
666
	if (name(son(son(e))) == prof_tag && last(son(son(e))))
689
	if (name(son(son(e))) == prof_tag && last(son(son(e))))
667
	   { evalone(bro(son(e)),rep); return;}
690
	   { evalone(bro(son(e)),rep); return;}
668
      }		/* otherwise drop through to failure */
691
      }		/* otherwise drop through to failure */
669
 
692
 
670
 
693
 
671
    default:
694
    default:
672
      failer ("tag not in evaluated");
695
      failer("tag not in evaluated");
673
 
696
 
674
  }				/* end switch */
697
  }				/* end switch */
675
}
698
}
676
 
699
 
677
 
700
 
Line 685... Line 708...
685
variable.
708
variable.
686
 
709
 
687
*****************************************************************/
710
*****************************************************************/
688
 
711
 
689
instore evaluated
712
instore evaluated
690
    PROTO_N ( (e, l, dc) )
-
 
691
    PROTO_T ( exp e X long l X dec * dc )
713
(exp e, long l, dec * dc)
692
{
714
{
693
 
715
 
694
  int   lab = (l == 0) ? next_dlab_sym ()
716
  int   lab = (l == 0)? next_dlab_sym()
695
  				: (l< 0)? l: -l;
717
  				:(l< 0)? l: -l;
696
  int   lab0 = lab;
718
  int   lab0 = lab;
697
  ash a;
719
  ash a;
698
  instore isa;
720
  instore isa;
699
  exp z = e;
721
  exp z = e;
700
 
722
 
Line 702... Line 724...
702
  isa.b.offset = 0;
724
  isa.b.offset = 0;
703
  isa.b.base = lab0;
725
  isa.b.base = lab0;
704
 
726
 
705
 
727
 
706
  if (name (e) == clear_tag) {/* uninitialised global */
728
  if (name (e) == clear_tag) {/* uninitialised global */
707
    int   size = (ashof (sh (e)).ashsize + 7) >> 3;
729
    int   size = (ashof(sh(e)).ashsize + 7) >> 3;
708
    bool temp = (l == 0 ||
730
    bool temp = (l == 0 ||
709
	(main_globals[-lab - 1] -> dec_u.dec_val.dec_id)[0] == '$');
731
	(main_globals[-lab - 1] -> dec_u.dec_val.dec_id)[0] == '$');
710
    if (dc != (dec*)0) globalise_name(dc);
732
    if (dc != (dec*)0)globalise_name(dc);
711
    if (as_file) {
733
    if (as_file) {
712
      fprintf (as_file, (temp) ? "\t.lcomm\t" : "\t.comm\t");
734
      fprintf(as_file,(temp)? "\t.lcomm\t" : "\t.comm\t");
713
      outlab (lab);
735
      outlab(lab);
714
      fprintf (as_file, " %d\n", size);
736
      fprintf(as_file, " %d\n", size);
715
    }
737
    }
716
    out_value ((lab >= 0) ? tempsnos[lab - 32] : symnos[-lab - 1],
738
    out_value((lab >= 0)? tempsnos[lab - 32]: symnos[-lab - 1],
717
	(temp) ? ilcomm : icomm, size, 1);
739
	(temp)? ilcomm : icomm, size, 1);
718
 
740
 
719
    return isa;
741
    return isa;
720
  }
742
  }
721
 
743
 
722
 
744
 
723
    a = ashof (sh (z));
745
    a = ashof(sh(z));
724
    if (a.ashsize <= G_number) {
746
    if (a.ashsize <= G_number) {
725
      if (as_file)
747
      if (as_file)
726
	fprintf (as_file, "\t.sdata\n");
748
	fprintf(as_file, "\t.sdata\n");
727
      out_common (0, isdata);
749
      out_common(0, isdata);
728
    }
750
    }
729
    else {
751
    else {
730
      if (as_file)
752
      if (as_file)
731
	fprintf (as_file, "\t.data\n");
753
	fprintf(as_file, "\t.data\n");
732
      out_common (0, idata);
754
      out_common(0, idata);
733
    }
755
    }
734
    set_align(a.ashalign);   /* I think this is unnecessary ? bug in as */
756
    set_align(a.ashalign);   /* I think this is unnecessary ? bug in as */
735
    if (dc != (dec*)0) globalise_name(dc);
757
    if (dc != (dec*)0)globalise_name(dc);
736
    if (as_file) {
758
    if (as_file) {
737
      outlab (lab);
759
      outlab(lab);
738
      fprintf (as_file, ":\n");
760
      fprintf(as_file, ":\n");
739
    }
761
    }
740
    out_common ((lab > 0) ? tempsnos[lab - 32] : symnos[-lab - 1], ilabel);
762
    out_common((lab > 0)? tempsnos[lab - 32]: symnos[-lab - 1], ilabel);
741
    evalone (z, 1);
763
    evalone(z, 1);
742
 
764
 
743
  return isa;
765
  return isa;
744
}
766
}