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 
/* 	$Id: eval.c,v 1.1.1.1 1998/01/17 15:55:59 release Exp $	 */
32 
 
33 
#ifndef lint
34 
static char vcid[] = "$Id: eval.c,v 1.1.1.1 1998/01/17 15:55:59 release Exp $";
35 
#endif /* lint */
36 
 
37 
/*
38 
$Log: eval.c,v $
39 
 * Revision 1.1.1.1  1998/01/17  15:55:59  release
40 
 * First version to be checked into rolling release.
41 
 *
42 
 * Revision 1.11  1996/02/15  09:52:38  john
43 
 * Added offset constructions
44 
 *
45 
 * Revision 1.10  1995/08/30  16:14:28  john
46 
 * Fix for new string_tag
47 
 *
48 
 * Revision 1.9  1995/08/21  08:44:13  john
49 
 * Changed include files
50 
 *
51 
 * Revision 1.8  1995/07/27  09:36:52  john
52 
 * Reformatting & changes for spec 4.0
53 
 *
54 
 * Revision 1.7  1995/05/23  10:56:11  john
55 
 * Changes for 64 bit support
56 
 *
57 
 * Revision 1.6  1995/05/16  10:47:33  john
58 
 * Changes for spec 3.1
59 
 *
60 
 * Revision 1.5  1995/04/10  14:12:57  john
61 
 * Minor changes
62 
 *
63 
 * Revision 1.4  1995/04/07  11:02:02  john
64 
 * Re-arranged the assembler output routines
65 
 *
66 
 * Revision 1.3  1995/04/04  08:17:46  john
67 
 * Fixed evaluation of compounds containing bitfields
68 
 *
69 
 * Revision 1.2  1995/03/29  14:01:22  john
70 
 * Changes to keep tcheck happy
71 
 *
72 
 * Revision 1.1.1.1  1995/03/23  10:39:06  john
73 
 * Entered into CVS
74 
 *
75 
 * Revision 1.16  1995/03/23  10:03:54  john
76 
 * Added support for scheduler + fixes for AVS
77 
 *
78 
 * Revision 1.15  1995/01/31  14:21:53  john
79 
 * Minor change
80 
 *
81 
 * Revision 1.14  1995/01/26  13:39:07  john
82 
 * Various portability improvements
83 
 *
84 
 * Revision 1.13  1995/01/20  13:43:12  john
85 
 * Added default case to oneval
86 
 *
87 
 * Revision 1.12  1995/01/12  15:14:43  john
88 
 * Removed dead code
89 
 *
90 
*/
91 
 
92 
/*
93 
  eval.c
94 
  This file contains functions which output data to the assembler
95 
  file.  The parameters are an exp and an index into the table of
96 
  externals.
97 
*/
98 
 
99 
#include "config.h"
100 
#include "xalloc.h"
101 
#include "addresstypes.h"
102 
#include "common_types.h"
103 
#include "tags.h"
104 
#include "expmacs.h"
105 
#include "exp.h"
106 
#include "exptypes.h"
107 
#include "maxminmacs.h"
108 
#include "shapemacs.h"
109 
#include "flpttypes.h"
110 
#include "flpt.h"
111 
#include "main.h"
112 
#include "frames.h"
113 
#include "reg_defs.h"
114 
#include "output.h"
115 
#include "fbase.h"
116 
#include "f64.h"
117 
#include "cross.h"
118 
#include "pseudo.h"
119 
#include "ibinasm.h"
120 
#include "out_ba.h"
121 
#include "syms.h"
122 
#include "shape_range.h"  /* provides definitions of
123 
			     scmm_max,scmm_min, etc. */
124 
#include "inst_fmt.h"
125 
#include "eval.h"
126 
#include "fail.h"
127 
 
128 
#if DO_SCHEDULE
129 
#include "scheduler.h"
130 
#endif
131 
#include "procrecs.h"
132 
 
133 
/*
134 
  storage types
135 
*/
136 
char *s_byte="byte";
137 
char *s_word="word";
138 
char *s_long="long";
139 
char *s_quad="quad";
140 
 
141 
 
142 
/*
143 
   The current alignment of the program
144 
*/
145 
int current_alignment=-1;
146 
 
147 
 
148 
long  G_number = 64;		/* to give choice of .sdata or data */
149 
 
150 
int   data_lab = 33;
151 
 
152 
/* anonymous label in data space - $$n in assember o/p */
153 
int next_data_lab
154 
    PROTO_Z ()
155 
{
156 
  return data_lab++;
157 
}
158 
 
159 
 
160 
/* as above-but also gives it a symno for .G output */
161 
int next_dlab_sym
162 
    PROTO_Z ()
163 
{
164 
  symnofordata (data_lab);
165 
  return data_lab++;
166 
}
167 
 
168 
 
169 
/* various pieces of info for outputting data depending on shape */
170 
mm scmm = {
171 
  scmm_max, scmm_min, "\t.byte %ld :%ld\n"
172 
};
173 
mm uscmm = {
174 
  uscmm_max,uscmm_min, "\t.byte %ld :%ld\n"
175 
};
176 
mm shmm = {
177 
  shmm_max,shmm_min, "\t.word %ld :%ld\n"
178 
};
179 
mm ushmm = {
180 
  ushmm_max,ushmm_min, "\t.word %ld :%ld\n"
181 
};
182 
mm swmm = {
183 
  swmm_max,swmm_min, "\t.long %ld :%ld\n"
184 
};
185 
mm uswmm = {
186 
  uswmm_max,uswmm_min,"\t.long %ld :%ld\n"
187 
};
188 
 
189 
mm u64mm = {
190 
  u64mm_max,u64mm_min,"\t.quad %ld :%ld\n"
191 
};
192 
 
193 
mm s64mm = {
194 
  s64mm_max,s64mm_min, "\t.quad %ld :%ld\n"
195 
};
196 
 
197 
 
198 
 
199 
/*
200 
   maxmin
201 
 
202 
   finds the data size from the range of an integer shape
203 
*/
204 
mm maxmin
205 
    PROTO_N ( ( s ) )
206 
    PROTO_T ( shape s )
207 
{
208 
  switch (name (s)) {
209 
  case scharhd:
210 
    return scmm;
211 
  case ucharhd:
212 
    return uscmm;
213 
  case swordhd:
214 
    return shmm;
215 
  case uwordhd:
216 
    return ushmm;
217 
  case slonghd:
218 
    return swmm;
219 
  case ulonghd:
220 
    return uswmm;
221 
  case s64hd:
222 
    return s64mm;
223 
  case u64hd:
224 
    return u64mm;
225 
  default:
226 
    return uswmm;
227 
  }
228 
}
229 
 
230 
 
231 
/*
232 
  outlab
233 
  outputs the label parameter if non negative else interprets it
234 
  to be an index into the externals and outputs the identifier.
235 
*/
236 
 
237 
char *outlab
238 
    PROTO_N ( ( l ) )
239 
    PROTO_T ( int l )
240 
{
241 
#if DO_SCHEDULE
242 
  char * res = (char*)xcalloc(20,sizeof(char));
243 
#else
244 
  char * res = (char*)NULL;
245 
#endif
246 
  if (l >= 0) {
247 
#if !DO_SCHEDULE
248 
    (void)fprintf (as_file, "$$%d", l);
249 
#else
250 
    (void)sprintf(res,"$$%d",l);
251 
#endif
252 
  }
253 
  else {
254 
    char *extname = main_globals[-l - 1] -> dec_u.dec_val.dec_id;
255 
#if !DO_SCHEDULE
256 
    (void)fprintf (as_file, "%s", extname);
257 
#else
258 
    (void)sprintf (res, "%s", extname);
259 
#endif
260 
  }
261 
  return res;
262 
}
263 
 
264 
char  fltrepr[120];
265 
 
266 
void output_data_records
267 
    PROTO_N ( ( strng,str,size ) )
268 
    PROTO_T ( char *strng X char *str X int size )
269 
{
270 
  int pos = 0;
271 
  Assert(size>0);
272 
  Assert(!strng);
273 
  while(size>0){
274 
    output_data((char*)NULL,
275 
		out_data(str,min(size,binasm_record_length)));
276 
    pos += binasm_record_length;
277 
    size -= binasm_record_length;
278 
  }
279 
  return;
280 
}
281 
 
282 
 
283 
 
284 
 
285 
/*
286 
   This function outputs an IEEE format floating point number
287 
*/
288 
void outfloat
289 
    PROTO_N ( ( e,rep,a ) )
290 
    PROTO_T ( exp e X int rep X ash a )
291 
{
292 
  INT64 val;
293 
#if DO_SCHEDULE
294 
  char * outline = (char*)xcalloc(80,sizeof(char));
295 
#endif
296 
  int fv = name(sh(e)) - shrealhd;
297 
  r2l ieeeflt;
298 
  ieeeflt = real2longs_IEEE(&flptnos[no(e)],fv);
299 
  switch(fv){
300 
    case 0:
301 
    if(as_file){
302 
#if !DO_SCHEDULE
303 
      outstring("\t.long ");
304 
      outhex(ieeeflt.i1);
305 
      outstring(" : ");
306 
      outint(rep);
307 
      outstring("\t# .s floating");
308 
      outstring("\n");
309 
#else
310 
      outass("\t.long ");
311 
      sprintf(outline,"0x%08x",ieeeflt.i1);
312 
      outass(outline);
313 
      outass(" : ");
314 
      sprintf(outline,"%d",rep);
315 
      outass(outline);
316 
      outass("\t# .s floating\n");
317 
#endif
318 
    }
319 
#if DO_SCHEDULE
320 
    output_data(outass((char*)NULL),out_value(0,ilong,ieeeflt.i1,rep));
321 
#else
322 
    out_value(0,ilong,make_INT64(0,ieeeflt.i1),rep);
323 
/*    out_value(0,ilong,ieeeflt.i1,rep);*/
324 
#endif
325 
    break;
326 
    case 1:
327 
    if(as_file){
328 
#if !DO_SCHEDULE
329 
      outstring("\t.quad ");
330 
      outhex(ieeeflt.i2);
331 
      outhexlow(ieeeflt.i1);
332 
      outstring(" : ");
333 
      outint(rep);
334 
      outstring("\t# .t floating");
335 
      outstring("\n");
336 
#else
337 
      outass("\t.quad ");
338 
      sprintf(outline,"0x%08x%08x",ieeeflt.i2,ieeeflt.i1);
339 
      outass(outline);
340 
      outass(" : ");
341 
      sprintf(outline,"%d",rep);
342 
      outass(outline);
343 
      outass("\t# .t floating\n");
344 
#endif
345 
    }
346 
/*    val = ((long)ieeeflt.i2<<32) + (unsigned)ieeeflt.i1;*/
347 
    val = make_INT64(ieeeflt.i2,(unsigned)ieeeflt.i1);
348 
#if !DO_SCHEDULE
349 
    out_value(0,iquad,val,rep);
350 
#else
351 
    output_data(outass((char*)NULL),out_value(0,iquad,val,rep));
352 
#endif
353 
    break;
354 
    default:
355 
    failer("invalid floating variety\n");
356 
  }
357 
#if DO_SCHEDULE
358 
  free(outline);
359 
#endif
360 
  return;
361 
}
362 
 
363 
/*
364 
  evaluate the exp 'e' and return the resulting value
365 
*/
366 
INT64 evalexp
367 
    PROTO_N ( ( e ) )
368 
    PROTO_T ( exp e )
369 
{
370 
 
371 
  switch (name(e)) {
372 
    case  val_tag : {
373 
      if(al2(sh(e))>=8 && name(sh(e)) == offsethd) {
374 
	return INT64_shift_right(flt64_to_INT64(exp_to_f64(e)),3,1);
375 
      }
376 
      return flt64_to_INT64(exp_to_f64(e));
377 
    }
378 
    case bitf_to_int_tag : {
379 
      return evalexp (son (e));
380 
    }
381 
    case int_to_bitf_tag : {
382 
      ash a;
383 
      INT64  w = evalexp (son (e));
384 
      a = ashof (sh (e));
385 
      if (a.ashalign != 1) {
386 
	failer ("should be align 1");
387 
      }
388 
      if(a.ashsize!=64){
389 
	w = INT64_and(w,INT64_subtract(INT64_shift_left(make_INT64(0,1),
390 
							a.ashsize,1),
391 
				       make_INT64(0,1),1));
392 
      }
393 
      return w;
394 
    }
395 
    case not_tag: {
396 
      return (INT64_not(evalexp (son (e))));
397 
    }
398 
    case and_tag: {
399 
      return (INT64_and(evalexp(son(e)),evalexp(bro(son(e)))));
400 
    }
401 
    case or_tag: {
402 
      return (INT64_or(evalexp(son(e)),evalexp(bro(son(e)))));
403 
    }
404 
    case xor_tag: {
405 
      return (INT64_xor(evalexp(son(e)),evalexp(bro(son(e)))));
406 
    }
407 
    case shr_tag: {
408 
      return (INT64_shift_right(evalexp(son(e)),
409 
				low_INT64(evalexp(bro(son(e)))),1));
410 
    }
411 
    case shl_tag: {
412 
      return (INT64_shift_left(evalexp(son(e)),
413 
			       low_INT64(evalexp(bro(son(e)))),1));
414 
    }
415 
    case concatnof_tag: {
416 
      ash a;
417 
      INT64 wd = evalexp (son (e));
418 
      a = ashof (sh (son (e)));
419 
      return (INT64_or(wd,
420 
		       INT64_shift_left(evalexp(bro(son(e))),a.ashsize,1)));
421 
    }
422 
    case clear_tag: {
423 
      ash a;
424 
      a = ashof (sh (e));
425 
      if (a.ashsize > REG_SIZE)
426 
	failer ("clearshape");
427 
      return zero_int64;
428 
    }
429 
    case general_env_offset_tag :
430 
    case env_offset_tag : {
431 
      return make_INT64(0,frame_offset(son(e)));
432 
    }
433 
    case env_size_tag : {
434 
      exp tg = son(son(e));
435 
      procrec *pr = &procrecs[no(son(tg))];
436 
      return (pr->frame_size+pr->callee_size)>>3;
437 
    }
438 
    case offset_add_tag : {
439 
      return (evalexp(son(e)) + evalexp(bro(son(e))));
440 
    }
441 
    case offset_max_tag : {
442 
      return max(evalexp(son(e)),evalexp(bro(son(e))));
443 
    }
444 
    case offset_pad_tag : {
445 
      return rounder(evalexp(son(e)),shape_align(sh(e))>>3);
446 
    }
447 
    case offset_mult_tag : {
448 
      return evalexp(son(e))*evalexp(bro(son(e)));
449 
    }
450 
    case offset_div_tag :
451 
    case offset_div_by_int_tag : {
452 
      return evalexp(son(e))/evalexp(bro(son(e)));
453 
    }
454 
    case offset_subtract_tag : {
455 
      return evalexp(son(e)) - evalexp(bro(son(e)));
456 
    }
457 
    case offset_negate_tag : {
458 
      return -evalexp(son(e));
459 
    }
460 
 
461 
    default:
462 
    failer ("tag not in evalexp");
463 
  }
464 
  return zero_int64;
465 
}
466 
 
467 
 
468 
/*
469 
  This function outputs values to the assembler file.  The
470 
  alignment of the last value to be output is retained and,
471 
  if it differs from the current one, a new alignment is set.
472 
*/
473 
void oneval
474 
    PROTO_N ( ( val,al,rep ) )
475 
    PROTO_T ( INT64 val X int al X int rep )
476 
{
477 
  char *store_type;
478 
  char * outline = (char*)NULL;
479 
  static int lastal = -1;
480 
  unsigned int bval;
481 
  if(al!=lastal){
482 
    set_align(al);
483 
    lastal=al;
484 
  }
485 
  switch(al){
486 
  case 8:
487 
    store_type=s_byte;
488 
    bval = ibyte;
489 
    break;
490 
  case 16:
491 
    store_type=s_word;
492 
    bval = iword;
493 
    break;
494 
  case 32:
495 
    store_type=s_long;
496 
    bval = ilong;
497 
    break;
498 
  case 64:
499 
    store_type=s_quad;
500 
    bval = iquad;
501 
    break;
502 
  default:
503 
    store_type=s_long;
504 
    bval = ilong;
505 
    break;
506 
  }
507 
  if(as_file){
508 
#if !DO_SCHEDULE
509 
    (void)fprintf(as_file,"\t.%s ",store_type);
510 
    out_INT64(val);
511 
    (void)fprintf(as_file," :%d\n",rep);
512 
#else
513 
    outline = (char*)xcalloc(30,sizeof(char));
514 
    sprintf(outline,"\t.%s %ld :%d\n",store_type,val,rep);
515 
#endif
516 
  }
517 
#if DO_SCHEDULE
518 
  output_data(outline,out_value(0,bval,val,rep));
519 
#else
520 
  out_value(0,bval,val,rep);
521 
#endif
522 
  return;
523 
}
524 
 
525 
 
526 
INT64 bits_list
527 
    PROTO_N ( ( val ) )
528 
    PROTO_T ( int val )
529 
{
530 
  int loop;
531 
  INT64 result=make_INT64(0,0);
532 
/*  Assert (val <=31);*/
533 
  Assert (val <=64);
534 
  for(loop=0;loop<val;++loop){
535 
    result = INT64_shift_left(result,1,1);
536 
    result = INT64_or(result,make_INT64(0,1));
537 
#if 0
538 
    result <<=1;
539 
    result |= 1;
540 
#endif
541 
  }
542 
  return result;
543 
}
544 
 
545 
 
546 
 
547 
/*
548 
  Outputs the expression 'e', rep times.
549 
*/
550 
void evalone
551 
    PROTO_N ( ( e,rep ) )
552 
    PROTO_T ( exp e X int rep )
553 
{
554 
  ash a;
555 
  int overflow;
556 
  if (e == nilexp) return;
557 
  a = ashof (sh (e));
558 
  switch (name (e)) {
559 
  case string_tag: {
560 
    long char_size = props(e);
561 
    long  strsize = shape_size(sh(e))/char_size;
562 
    char *st = nostr(e);
563 
    long  strs = shape_size(sh(e))>>3;
564 
    int   i,j;
565 
    int hex_output=0;
566 
#if DO_SCHEDULE
567 
    char * outline = (char*)xcalloc(80,sizeof(char));
568 
#endif
569 
    if (rep != 1 && as_file){
570 
#if !DO_SCHEDULE
571 
      (void)fprintf (as_file, "\t.repeat %d\n", rep);
572 
#else
573 
      (void)sprintf(outline,"\t.repeat %d\n",rep);
574 
      outass(outline);
575 
#endif
576 
    }
577 
    set_align(a.ashalign);
578 
    if(as_file){
579 
      if(strsize<256 && (char_size ==8)){
580 
#if !DO_SCHEDULE
581 
	(void)fprintf(as_file,"\t.ascii\t\"");
582 
#else
583 
	outass("\t.ascii\t\"");
584 
#endif
585 
	for(j=0;j<strsize;++j){
586 
	  if(st[j]>=32 && st[j]<0x7f && (!hex_output)){
587 
	    if(st[j]=='\"'){
588 
#if !DO_SCHEDULE
589 
	      (void)fprintf(as_file,"\\\"");
590 
#else
591 
	      outass("\\\"");
592 
#endif
593 
	    }
594 
	    else if(st[j]=='\\'){
595 
#if !DO_SCHEDULE
596 
	      (void)fprintf(as_file,"\\\\");
597 
#else
598 
	      outass("\\\\");
599 
#endif
600 
	    }
601 
	    else{
602 
#if !DO_SCHEDULE
603 
	      (void)fprintf(as_file,"%c",st[j]);
604 
#else
605 
	      (void)sprintf(outline,"%c",st[j]);
606 
	      outass(outline);
607 
#endif
608 
	    }
609 
	  }
610 
	  else{
611 
#if !DO_SCHEDULE
612 
	    (void)fprintf(as_file,"\\X%x",st[j]&0xff);
613 
#else
614 
	    (void)sprintf(outline,"\\X%x",st[j]&0xff);
615 
	    outass(outline);
616 
#endif
617 
	    hex_output=1;
618 
	  }
619 
	 }
620 
#if !DO_SCHEDULE
621 
	(void)fprintf(as_file,"\"\n");
622 
#else
623 
	outass("\"\n");
624 
#endif
625 
      }
626 
      else{
627 
	for (j=0; j< strsize; ) {
628 
	  switch(char_size) {
629 
	  case 8:{
630 
#if !DO_SCHEDULE
631 
	    (void)fprintf (as_file, "\t.byte ");
632 
#else
633 
	    outass("\t.byte ");
634 
#endif
635 
	    break;
636 
	  }
637 
	  case 16:{
638 
#if !DO_SCHEDULE
639 
	    (void)fprintf (as_file, "\t.word ");
640 
#else
641 
	    outass("\t.word ");
642 
#endif
643 
	    break;
644 
	  }
645 
	  case 32:{
646 
#if !DO_SCHEDULE
647 
	    (void)fprintf (as_file, "\t.long ");
648 
#else
649 
	    outass("\t.long ");
650 
#endif
651 
	    break;
652 
	  }
653 
	  case 64:{
654 
#if !DO_SCHEDULE
655 
	    (void)fprintf (as_file, "\t.quad ");
656 
#else
657 
	    outass("\t.quad ");
658 
#endif
659 
	    break;
660 
	  }
661 
	  }
662 
	  for (i = j; i < strsize && i-j < 8; i++) {
663 
	    switch (char_size) {
664 
	    case 8:
665 
#if !DO_SCHEDULE
666 
	      (void)fprintf (as_file, "0x%x ", st[i]&0xff);
667 
#else
668 
	      sprintf(outline,"0x%x ", st[i]&0xff);
669 
	      outass(outline);
670 
#endif
671 
	      break;
672 
	    case 16:
673 
#if !DO_SCHEDULE
674 
	      (void)fprintf (as_file, "0x%x ", ((unsigned short *)st)[i]);
675 
#else
676 
	      (void)sprintf (outline, "0x%x ", ((unsigned short *)st)[i]);
677 
	      outass(outline);
678 
#endif
679 
	      break;
680 
	    case 32:
681 
#if !DO_SCHEDULE
682 
	      (void)fprintf (as_file, "0x%x ", ((int *)st)[i]);
683 
#else
684 
	      (void)sprintf (outline, "0x%x ", ((int *)st)[i]);
685 
	      outass(outline);
686 
#endif
687 
	      break;
688 
	    case 64:{
689 
	      flt64 bigint;
690 
	      bigint = flt_to_f64(((flpt*)st)[i],is_signed(sh(e)),&overflow);
691 
#if !DO_SCHEDULE
692 
	      out_INT64(flt64_to_INT64(bigint));outstring(" ");
693 
#else
694 
	      sprintf(outline,"%ld ",flt64_to_INT64(bigint));
695 
	      outass(outline);
696 
#endif
697 
	      break;
698 
	    }
699 
	    }
700 
	  }
701 
	  j =i;
702 
#if DO_SCHEDULE
703 
	  outass("\n");
704 
#else
705 
	  (void)fprintf (as_file, "\n");
706 
#endif
707 
	}
708 
      }
709 
    }
710 
#if !DO_SCHEDULE
711 
    out_chars(0,iascii,strs,rep);
712 
#else
713 
    output_data(outass((char*)NULL),out_chars(0,iascii,strs,rep));
714 
#endif
715 
    if(char_size == 64){
716 
      /* replace the float indexes used to represent the array */
717 
      char * newst = (char*)xcalloc(strs,sizeof(char));
718 
      int i;
719 
      for(i=0;i<strsize;++i){
720 
	((INT64*)newst)[i] = flt64_to_INT64(flt_to_f64(((flpt*)st)[i],
721 
						       is_signed(sh(e)),
722 
						       &overflow));
723 
      }
724 
#if DO_SCHEDULE
725 
      output_data_records((char*)NULL,newst,strs);
726 
#else
727 
      out_data(newst,strs);
728 
#endif
729 
    }
730 
    else{
731 
#if DO_SCHEDULE
732 
      output_data_records((char*)NULL,st,strs);
733 
      output_data((char*)NULL,out_data(st,strs));
734 
#else
735 
      out_data(st,strs);
736 
#endif
737 
    }
738 
    return;
739 
  }
740 
  case real_tag: {
741 
    outfloat(e,rep,a);
742 
    return;
743 
  }
744 
  case null_tag:
745 
    no (e) = 0;
746 
    FALL_THROUGH
747 
  case val_tag: {
748 
    if(isbigval(e)){
749 
      oneval(flt64_to_INT64(exp_to_f64(e)),a.ashalign,rep);
750 
    }
751 
    else{
752 
      if((al2(sh(e)) >= 8) && (name(sh(e)) == offsethd)){
753 
	no(e) = no(e)>>3;
754 
      }
755 
      if(is_signed(sh(e))){
756 
	oneval(make_INT64(0,no(e)),a.ashalign,rep);
757 
      }
758 
      else{
759 
	oneval(make_INT64(0L,(unsigned)uno(e)),a.ashalign,rep);
760 
      }
761 
    }
762 
    return;
763 
    }
764 
  case name_tag: {
765 
    dec * globdec= brog(son (e));/* must be global name */
766 
    char *nm = globdec -> dec_u.dec_val.dec_id;
767 
    long symdef = globdec ->dec_u.dec_val.sym_number;
768 
    char *storage_type;
769 
    int storage_id;
770 
    char * outline = (char*)NULL;
771 
    switch(a.ashalign){
772 
      case 8:
773 
      storage_type = s_byte;
774 
      storage_id = ibyte;
775 
      break;
776 
      case 16:
777 
      storage_type = s_word;
778 
      storage_id = iword;
779 
      break;
780 
      case 32:
781 
      storage_type = s_long;
782 
      storage_id = ilong;
783 
      break;
784 
      case 64:
785 
      storage_type = s_quad;
786 
      storage_id = iquad;
787 
      break;
788 
    }
789 
    set_align(a.ashalign);
790 
    if (as_file) {
791 
#if DO_SCHEDULE
792 
      outline = (char*)xcalloc(40,sizeof(char));
793 
#endif
794 
      if (no (e) == 0) {
795 
#if !DO_SCHEDULE
796 
	(void)fprintf (as_file, "\t.%s %s : %d\n", storage_type,nm, rep);
797 
#else
798 
	(void)sprintf (outline, "\t.%s %s : %d\n", storage_type,nm, rep);
799 
#endif
800 
      }
801 
      else {
802 
#if !DO_SCHEDULE
803 
	(void)fprintf (as_file, "\t.%s %s + %d :%d\n", storage_type,
804 
			nm, no (e) / 8, rep);
805 
#else
806 
	(void)sprintf (outline, "\t.%s %s + %d :%d\n", storage_type,
807 
			nm, no (e) / 8, rep);
808 
#endif
809 
      }
810 
    }
811 
#if DO_SCHEDULE
812 
    output_data(outline,out_value(symnos[symdef],storage_id,no(e)/8,rep));
813 
#else
814 
    out_value(symnos[symdef],storage_id,make_INT64(0,no(e)/8),rep);
815 
#endif
816 
    return;
817 
   }
818 
  case compound_tag:  {
819 
    exp tup = son (e);
820 
    INT64 val;
821 
    bool first_bits=1;
822 
    long bits_start =0;
823 
    long offs =0;
824 
    if (rep != 1)
825 
      failer ("CAN'T REP TUPLES");
826 
    set_align(a.ashalign);
827 
    for(;;) {
828 
      ash ae;
829 
      ae = ashof(sh(bro(tup)));
830 
      offs = no(tup);
831 
      if (ae.ashalign == 1) {
832 
	INT64 vb = evalexp(bro(tup));
833 
	if (first_bits) {
834 
	  val = INT64_and(vb,bits_list(ae.ashsize));
835 
	  /*val = vb & bits_list(ae.ashsize);*/
836 
	  bits_start =offs;
837 
	  first_bits=0;
838 
	}
839 
	else
840 
	  if (offs - bits_start +ae.ashsize <= REG_SIZE) {
841 
	    val = INT64_or(val,
842 
		      INT64_shift_left(
843 
				       INT64_and(vb,bits_list(ae.ashsize)),
844 
				       offs-bits_start,1)
845 
			   );
846 
	    /*val |= ((vb&bits_list(ae.ashsize)) <<(offs-bits_start));*/
847 
	  }
848 
	  else {
849 
	    if (BIGEND) {
850 
	      for(;;) {
851 
		oneval(INT64_shift_right(val,24,1),8,1);
852 
		/*oneval(val>>24, 8, 1);*/
853 
		val = INT64_shift_left(val,8,1);
854 
		/*val <<=8;*/
855 
		bits_start+=8;
856 
		if (offs-bits_start <= 0) break;
857 
	      }
858 
	    }
859 
	    else {
860 
	      for(;;) {
861 
		oneval(INT64_and(val,make_INT64(0,255)),8,1);
862 
		/*oneval(val &255, 8,1);*/
863 
		/*val >>= 8;*/
864 
		val = INT64_shift_right(val,8,1);
865 
		bits_start += 8;
866 
		if (offs - bits_start  <=0)
867 
		  break;
868 
	      }
869 
	    }
870 
	    val = vb;
871 
	  }
872 
      }
873 
      else {
874 
	if (!first_bits) {
875 
	  first_bits=1;
876 
	  if (BIGEND) {
877 
	    for(;;) {
878 
	      oneval(INT64_shift_right(val,24,1),8,1);
879 
	      /*oneval(val>>24, 8, 1);*/
880 
	      val = INT64_shift_left(val,8,1);
881 
	      /*val <<=8;*/
882 
	      bits_start+=8;
883 
	      if (offs-bits_start <= 0) break;
884 
	    }
885 
	  }
886 
	  else {
887 
	    for(;;) {
888 
	      oneval(INT64_and(val,make_INT64(0,255)),8,1);
889 
	      /*oneval(val &255, 8,1);*/
890 
	      val = INT64_shift_right(val,8,1);
891 
	      /*val >>=8;*/
892 
	      bits_start += 8;
893 
	      if ( offs - bits_start  <=0)
894 
		break;
895 
	    }
896 
	  }
897 
	}
898 
	evalone(bro(tup),1);
899 
      }
900 
      if (last(bro(tup))) {
901 
	offs += ae.ashsize;
902 
	for(;!first_bits;) {
903 
	  if (BIGEND) {
904 
	    oneval(INT64_shift_right(val,24,1),8,1);
905 
	    /*oneval(val>>24, 8, 1);*/
906 
	    val = INT64_shift_left(val,8,1);
907 
	    /*val <<=8;*/
908 
	    bits_start+=8;
909 
	    if (offs-bits_start<= 0) break;
910 
	  }
911 
	  else {
912 
	    oneval(INT64_and(val,make_INT64(0,255)),8,1);
913 
	    /*oneval(val &255, 8,1);*/
914 
	    val = INT64_shift_right(val,8,1);
915 
	    /*val >>= 8;*/
916 
	    bits_start +=8;
917 
	    if ( offs - bits_start <=0)
918 
	      break;
919 
	  }
920 
	}
921 
	while (a.ashsize > offs) { /* pad out unions etc */
922 
	  oneval(make_INT64(0,0),8,1);
923 
/*	  oneval(0,8,1);*/
924 
	  offs+=8;
925 
	}
926 
	return;
927 
      }
928 
      tup = bro(bro(tup));
929 
    }
930 
  }
931 
  case nof_tag: {
932 
    exp s = son(e);
933 
    if (rep != 1)
934 
      failer ("CAN'T REP TUPLES");
935 
    set_align(a.ashalign);
936 
    if (s == nilexp) return;
937 
    for(;;) {
938 
      evalone(s,1);
939 
      if (last(s)) return;
940 
      s = bro(s);
941 
    }
942 
  }
943 
  case ncopies_tag: {
944 
    if (name(son(e)) == compound_tag || name(son(e)) == concatnof_tag ||
945 
	name(son(e)) == nof_tag) {
946 
      int n;
947 
      for (n = rep*no(e); n > 0; n--) {
948 
	evalone(son(e), 1);
949 
      }
950 
    }
951 
    else evalone (son (e), rep * no (e));
952 
    return;
953 
  }
954 
  case concatnof_tag: {
955 
    if (a.ashalign == 1) {
956 
      INT64 ee = evalexp(e);
957 
      /*long  ee = evalexp (e);*/
958 
      exp dad = father(e);
959 
      ash abits;
960 
      abits = ashof(sh(dad));
961 
      oneval(ee, abits.ashalign, rep);
962 
    }
963 
    else {
964 
      if (rep != 1)
965 
	failer ("CAN'T REP concat");
966 
      evalone (son (e), 1);
967 
      evalone (bro (son (e)), 1);
968 
    }
969 
    return;
970 
  }
971 
  case clear_tag: {
972 
    char * outline;
973 
    if (as_file){
974 
#if !DO_SCHEDULE
975 
      (void)fprintf (as_file, "\t.space %d\n",((a.ashsize+7)>>3) * rep);
976 
#else
977 
      outline = (char*)xcalloc(20,sizeof(char));
978 
      sprintf(outline,"\t.space %d\n",((a.ashsize+7)>>3) * rep);
979 
#endif
980 
    }
981 
#if DO_SCHEDULE
982 
    output_data(outline,out_value(0,ispace,((a.ashsize+7)>>3)+rep,1));
983 
#else
984 
    out_value (0, ispace, make_INT64(0,((a.ashsize + 7) >> 3) * rep), 1);
985 
#endif
986 
    return;
987 
  }
988 
    case not_tag :
989 
    case and_tag :
990 
    case or_tag :
991 
    case shl_tag :
992 
    case shr_tag :
993 
    case bitf_to_int_tag :
994 
    case int_to_bitf_tag :
995 
    case general_env_offset_tag :
996 
    case env_offset_tag :
997 
    case env_size_tag :
998 
    case offset_add_tag :
999 
    case offset_max_tag :
1000 
    case offset_pad_tag :
1001 
    case offset_mult_tag :
1002 
    case offset_div_tag :
1003 
    case offset_div_by_int_tag :
1004 
    case offset_subtract_tag :
1005 
    case offset_negate_tag : {
1006 
#if 1
1007 
      INT64 ee = evalexp (e);
1008 
      oneval(ee, a.ashalign, rep);
1009 
#endif
1010 
      return;
1011 
    }
1012 
#if 1
1013 
  case chvar_tag: {
1014 
    sh(son(e)) = sh(e);
1015 
    evalone(son(e),1);
1016 
    alphawarn("Dubious change variety\n");
1017 
    return;
1018 
  }
1019 
#endif
1020 
  default:
1021 
    failer ("tag not in evaluated");
1022 
  }				/* end switch */
1023 
}
1024 
 
1025 
 
1026 
/*
1027 
  evaluated
1028 
 
1029 
  This outputs data from the evaluated exp into either .sdata
1030 
  or .data depending on size and labels this data either with
1031 
  either id in main_globals or an anonymous label derived from l.
1032 
  The result is the instore "address" of the constant. A negative
1033 
  l implies that this is the initialisation of a global variable.
1034 
*/
1035 
instore evaluated
1036 
    PROTO_N ( ( e,l ) )
1037 
    PROTO_T ( exp e X int l )
1038 
{
1039 
 
1040 
  int   lab = (l == 0) ? next_dlab_sym ()
1041 
    : (l< 0)? l: -l;
1042 
  int   lab0 = lab;
1043 
#if DO_SCHEDULE
1044 
  char * outline = (char*)xcalloc(80,sizeof(char));
1045 
#endif
1046 
  ash a;
1047 
  instore isa;
1048 
  exp z = e;
1049 
 
1050 
  isa.adval = 0;
1051 
  isa.b.offset = 0;
1052 
  isa.b.base = lab0;
1053 
  if (name (e) == clear_tag) {/* uninitialised global */
1054 
    int   size = (ashof (sh (e)).ashsize + 7) >> 3;
1055 
    bool temp = (l == 0 ||
1056 
		 (main_globals[-lab - 1] -> dec_u.dec_val.dec_id)[0] == '$');
1057 
    if (as_file) {
1058 
#if !DO_SCHEDULE
1059 
      (void)fprintf (as_file, (temp) ? "\t.lcomm\t" : "\t.comm\t");
1060 
      outlab(lab);
1061 
#else
1062 
      outass((temp)?"\t.lcomm\t":"\t.comm\t");
1063 
      outass(outlab(lab));
1064 
#endif
1065 
#if !DO_SCHEDULE
1066 
      (void)fprintf (as_file, " %d\n", size);
1067 
#else
1068 
      sprintf(outline," %d\n",size);
1069 
      outass(outline);
1070 
#endif
1071 
    }
1072 
#if DO_SCHEDULE
1073 
    output_data(outass((char*)NULL),out_value((lab>=0)?tempsnos[lab-32]:
1074 
				  symnos[-lab-1],(temp)?ilcomm:icomm,size,1));
1075 
 
1076 
#else
1077 
    out_value((lab>=0)?tempsnos[lab-32]:symnos[-lab-1],(temp)?ilcomm:icomm,
1078 
	      make_INT64(0,size),1);
1079 
#endif
1080 
    return isa;
1081 
  }
1082 
  a = ashof (sh (z));
1083 
  if (a.ashsize <= G_number) {
1084 
    if (as_file){
1085 
#if DO_SCHEDULE
1086 
      outline = (char*)xcalloc(20,sizeof(char));
1087 
      (void)sprintf(outline, "\t.sdata\n");
1088 
#else
1089 
      (void)fprintf (as_file, "\t.sdata\n");
1090 
#endif
1091 
    }
1092 
#if DO_SCHEDULE
1093 
    output_data(outline,out_common(0,isdata));
1094 
#else
1095 
    out_common(0,isdata);
1096 
#endif
1097 
  }
1098 
  else {
1099 
    if (as_file){
1100 
#if DO_SCHEDULE
1101 
      outline = (char*)xcalloc(20,sizeof(char));
1102 
      (void)sprintf(outline, "\t.data\n");
1103 
#else
1104 
      (void)fprintf (as_file, "\t.data\n");
1105 
#endif
1106 
    }
1107 
#if DO_SCHEDULE
1108 
    output_data(outline,out_common(0,idata));
1109 
#else
1110 
    out_common(0,idata);
1111 
#endif
1112 
  }
1113 
  if (as_file) {
1114 
#if DO_SCHEDULE
1115 
    outline = outlab(lab);
1116 
    strcat(outline,":\n");
1117 
#else
1118 
    (void)outlab (lab);
1119 
    (void)fprintf (as_file, ":\n");
1120 
#endif
1121 
  }
1122 
#if DO_SCHEDULE
1123 
  output_data(outline,out_common((lab>0)?tempsnos[lab-32]:symnos[-lab-1],
1124 
				 ilabel));
1125 
#else
1126 
  out_common((lab>0)?tempsnos[lab-32]:symnos[-lab-1],ilabel);
1127 
#endif
1128 
  if(as_file){
1129 
#if !DO_SCHEDULE
1130 
    fprintf(as_file,"\t.align 3\n");
1131 
    fprintf(as_file,"\t.align 0\n");
1132 
#endif
1133 
  }
1134 
#if DO_SCHEDULE
1135 
  output_instruction(class_null,"\t.align 3\n",out_value(0,ialign,3,0));
1136 
  output_instruction(class_null,"\t.align 0\n",out_value(0,ialign,0,0));
1137 
#else
1138 
  out_value(0,ialign,make_INT64(0,3),0);
1139 
  out_value(0,ialign,make_INT64(0,0),0);
1140 
#endif
1141 
  current_alignment=8;
1142 
  evalone (z, 1);
1143 
  return isa;
1144 
}
1145 
 
1146 
 
1147 
 
1148 
 
1149 
 
1150 
 
1151 
 
1152 
 
1153 
 
1154