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 14... Line 44...
14
        reproduced upon any copies or amended versions of it;
44
        reproduced upon any copies or amended versions of it;
15
 
45
 
16
        (2) Any amended version of it shall be clearly marked to
46
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
47
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
48
        for the relevant amendment or amendments;
19
 
49
 
20
        (3) Its onward transfer from a recipient to another
50
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
51
        party shall be deemed to be that party's acceptance of
22
        these conditions;
52
        these conditions;
23
 
53
 
24
        (4) DERA gives no warranty or assurance as to its
54
        (4) DERA gives no warranty or assurance as to its
Line 65... Line 95...
65
 * Revision 1.6  1995/08/04  08:29:15  pwe
95
 * Revision 1.6  1995/08/04  08:29:15  pwe
66
 * 4.0 general procs implemented
96
 * 4.0 general procs implemented
67
 *
97
 *
68
 * Revision 1.5  1995/03/10  17:45:13  pwe
98
 * Revision 1.5  1995/03/10  17:45:13  pwe
69
 * collection of signed/unsigned small bitfields
99
 * collection of signed/unsigned small bitfields
70
 *
100
 *
71
 * Revision 1.4  1995/02/20  13:37:19  pwe
101
 * Revision 1.4  1995/02/20  13:37:19  pwe
72
 * correct alignment within n_of bitfield
102
 * correct alignment within n_of bitfield
73
 *
103
 *
74
 * Revision 1.3  1995/02/20  12:19:21  pwe
104
 * Revision 1.3  1995/02/20  12:19:21  pwe
75
 * alignment within n_of bitfield
105
 * alignment within n_of bitfield
76
 *
106
 *
77
 * Revision 1.2  1995/01/30  12:56:07  pwe
107
 * Revision 1.2  1995/01/30  12:56:07  pwe
78
 * Ownership -> PWE, tidy banners
108
 * Ownership -> PWE, tidy banners
79
 *
109
 *
80
 * Revision 1.1  1994/10/27  14:15:22  jmf
110
 * Revision 1.1  1994/10/27  14:15:22  jmf
81
 * Initial revision
111
 * Initial revision
82
 *
112
 *
83
 * Revision 1.1  1994/07/12  14:30:23  jmf
113
 * Revision 1.1  1994/07/12  14:30:23  jmf
84
 * Initial revision
114
 * Initial revision
85
 *
115
 *
86
**********************************************************************/
116
**********************************************************************/
87
 
117
 
88
 
118
 
89
#include "config.h"
119
#include "config.h"
90
#include "common_types.h"
120
#include "common_types.h"
91
 
121
 
92
#include "tags.h"
122
#include "tags.h"
93
#include "basicread.h"
123
#include "basicread.h"
Line 117... Line 147...
117
 
147
 
118
/* PROCEDURES */
148
/* PROCEDURES */
119
 
149
 
120
 
150
 
121
static void outsize
151
static void outsize
122
    PROTO_N ( (n) )
-
 
123
    PROTO_T ( int n )
152
(int n)
124
{
153
{
125
  switch ((n+7)/8) {
154
  switch ((n+7) /8) {
126
    case 1:
155
    case 1:
127
	outbyte();
156
	outbyte();
128
	break;
157
	break;
129
    case 2:
158
    case 2:
130
	outshort();
159
	outshort();
Line 136... Line 165...
136
  return;
165
  return;
137
}
166
}
138
 
167
 
139
 
168
 
140
long  evalexp
169
long  evalexp
141
    PROTO_N ( (e) )
-
 
142
    PROTO_T ( exp e )
170
(exp e)
143
{
171
{
144
  switch (name(e)) {
172
  switch (name(e)) {
145
    case  val_tag:
173
    case  val_tag:
146
    case null_tag:
174
    case null_tag:
147
    case top_tag:
175
    case top_tag:
148
      {
176
      {
149
	if (name(sh(e)) == offsethd && al2(sh(e)) >= 8) {
177
	if (name(sh(e)) == offsethd && al2(sh(e)) >= 8) {
150
		return (no(e)>>3);
178
		return(no(e) >>3);
151
	}
179
	}
152
        return (no (e));
180
        return(no(e));
153
      }
181
      }
154
    case bitf_to_int_tag:
182
    case bitf_to_int_tag:
155
      {
183
      {
156
	return evalexp (son (e));
184
	return evalexp(son(e));
157
      }
185
      }
158
    case int_to_bitf_tag:
186
    case int_to_bitf_tag:
159
      {
187
      {
160
	long  w = evalexp (son (e));
188
	long  w = evalexp(son(e));
161
	if (shape_align(sh(e)) != 1) {
189
	if (shape_align(sh(e))!= 1) {
162
	  failer ("should be align 1");
190
	  failer("should be align 1");
163
	}
191
	}
164
	if (shape_size(sh(e)) != 32) {
192
	if (shape_size(sh(e))!= 32) {
165
	  w &= ((1 << shape_size(sh(e))) - 1);
193
	  w &= ((1 << shape_size(sh(e))) - 1);
166
	}
194
	}
167
	return w;
195
	return w;
168
      }
196
      }
169
    case not_tag:
197
    case not_tag:
170
      {
198
      {
171
	return (~evalexp (son (e)));
199
	return(~evalexp(son(e)));
172
      }
200
      }
173
    case and_tag:
201
    case and_tag:
174
      {
202
      {
175
	return (evalexp (son (e)) & evalexp (bro (son (e))));
203
	return(evalexp(son(e)) & evalexp(bro(son(e))));
176
      }
204
      }
177
    case or_tag:
205
    case or_tag:
178
      {
206
      {
179
	return (evalexp (son (e)) | evalexp (bro (son (e))));
207
	return(evalexp(son(e)) | evalexp(bro(son(e))));
180
      }
208
      }
181
    case xor_tag:
209
    case xor_tag:
182
      {
210
      {
183
	return (evalexp (son (e)) ^ evalexp (bro (son (e))));
211
	return(evalexp(son(e))^ evalexp(bro(son(e))));
184
      }
212
      }
185
 
213
 
186
    case shr_tag:
214
    case shr_tag:
187
      {
215
      {
188
	return (evalexp (son (e)) >> evalexp (bro (son (e))));
216
	return(evalexp(son(e)) >> evalexp(bro(son(e))));
189
      }
217
      }
190
 
218
 
191
    case shl_tag:
219
    case shl_tag:
192
      {
220
      {
193
	return (evalexp (son (e)) << evalexp (bro (son (e))));
221
	return(evalexp(son(e)) << evalexp(bro(son(e))));
194
      }
222
      }
195
 
223
 
196
    case concatnof_tag:
224
    case concatnof_tag:
197
      {
225
      {
198
	long  wd = evalexp (son (e));
226
	long  wd = evalexp(son(e));
199
	return (wd | (evalexp (bro (son (e))) << shape_size(sh(son(e)))));
227
	return(wd | (evalexp(bro(son(e))) << shape_size(sh(son(e)))));
200
      }
228
      }
201
 
229
 
202
    case clear_tag:
230
    case clear_tag:
203
      {
231
      {
204
	if (shape_size(sh(e)) <= 32)
232
	if (shape_size(sh(e)) <= 32)
205
	  return 0;
233
	  return 0;
206
	break;
234
	break;
207
      }
235
      }
208
    case env_offset_tag:
236
    case env_offset_tag:
209
      {
237
      {
210
	if (name(son(e)) == 0)
238
	if (name(son(e)) == 0)
211
   	  return (no(son(e)) / 8);
239
   	  return(no(son(e)) / 8);
212
	break;
240
	break;
213
      }
241
      }
214
    case env_size_tag:
242
    case env_size_tag:
215
      {
243
      {
216
	dec * et = brog(son(son(e)));
244
	dec * et = brog(son(son(e)));
217
	if (et -> dec_u.dec_val.processed)
245
	if (et -> dec_u.dec_val.processed)
218
	  return (et -> dec_u.dec_val.index);
246
	  return(et -> dec_u.dec_val.index);
219
	break;
247
	break;
220
      }
248
      }
221
    case offset_add_tag:
249
    case offset_add_tag:
222
      {
250
      {
223
    	return (evalexp(son(e))+evalexp(bro(son(e))));
251
    	return(evalexp(son(e)) +evalexp(bro(son(e))));
224
      }
252
      }
225
    case offset_max_tag:
253
    case offset_max_tag:
226
      {
254
      {
227
	long a = evalexp(son(e));
255
	long a = evalexp(son(e));
228
	long b = evalexp(bro(son(e)));
256
	long b = evalexp(bro(son(e)));
229
    	return (a > b ? a : b);
257
    	return(a > b ? a : b);
230
      }
258
      }
231
    case offset_pad_tag:
259
    case offset_pad_tag:
232
      {
260
      {
233
	return( rounder(evalexp(son(e)), shape_align(sh(e)) / 8));
261
	return(rounder(evalexp(son(e)), shape_align(sh(e)) / 8));
234
      }
262
      }
235
    case offset_mult_tag:
263
    case offset_mult_tag:
236
      {
264
      {
237
    	return (evalexp(son(e))*evalexp(bro(son(e))));
265
    	return(evalexp(son(e))*evalexp(bro(son(e))));
238
      }
266
      }
239
    case offset_div_tag:
267
    case offset_div_tag:
240
    case offset_div_by_int_tag:
268
    case offset_div_by_int_tag:
241
      {
269
      {
242
    	return (evalexp(son(e))/evalexp(bro(son(e))));
270
    	return(evalexp(son(e)) /evalexp(bro(son(e))));
243
      }
271
      }
244
    case offset_subtract_tag:
272
    case offset_subtract_tag:
245
      {
273
      {
246
    	return (evalexp(son(e))-evalexp(bro(son(e))));
274
    	return(evalexp(son(e)) -evalexp(bro(son(e))));
247
      }
275
      }
248
    case offset_negate_tag:
276
    case offset_negate_tag:
249
      {
277
      {
250
	return (- evalexp(son(e)));
278
	return(- evalexp(son(e)));
251
      }
279
      }
252
    case seq_tag:
280
    case seq_tag:
253
      {
281
      {
254
	if (name(son(son(e))) == prof_tag && last(son(son(e))))
282
	if (name(son(son(e))) == prof_tag && last(son(son(e))))
255
	   return (evalexp(bro(son(e))));
283
	   return(evalexp(bro(son(e))));
256
	break;
284
	break;
257
      }
285
      }
258
    case cont_tag:
286
    case cont_tag:
259
      {
287
      {
260
	if (PIC_code && name(son(e)) == name_tag && isglob(son(son(e)))
288
	if (PIC_code && name(son(e)) == name_tag && isglob(son(son(e)))
261
		&& son(son(son(e))) != nilexp
289
		&& son(son(son(e)))!= nilexp
262
		&& !(brog(son(son(e))) -> dec_u.dec_val.dec_var))
290
		&& !(brog(son(son(e))) -> dec_u.dec_val.dec_var))
263
	   return (evalexp(son(son(son(e)))));
291
	   return(evalexp(son(son(son(e)))));
264
	break;
292
	break;
265
      }
293
      }
266
  }
294
  }
267
  failer(BAD_VAL);
295
  failer(BAD_VAL);
268
  return (0);
296
  return(0);
269
}
297
}
270
 
298
 
271
 
299
 
272
/* outputs a value */
300
/* outputs a value */
273
static void evalval
301
static void evalval
274
    PROTO_N ( (e) )
-
 
275
    PROTO_T ( exp e )
302
(exp e)
276
{
303
{
277
  int e_size = shape_size(sh(e));
304
  int e_size = shape_size(sh(e));
278
  unsigned char  n = name (e);
305
  unsigned char  n = name(e);
279
  int ov;
306
  int ov;
280
 
307
 
281
  if (n == val_tag) {
308
  if (n == val_tag) {
282
    int k = (name(sh(e)) == offsethd && al2(sh(e)) != 1)
309
    int k = (name(sh(e)) == offsethd && al2(sh(e))!= 1)
283
                  ? no(e)/8 : no(e);
310
                  ? no(e) /8 : no(e);
284
    flt64 x;
311
    flt64 x;
285
    if (isbigval(e)) {
312
    if (isbigval(e)) {
286
      x = flt_to_f64(k, is_signed(sh(e)), &ov);
313
      x = flt_to_f64(k, is_signed(sh(e)), &ov);
287
      k = x.small;
314
      k = x.small;
288
    }
315
    }
289
    switch (e_size) {
316
    switch (e_size) {
290
      case 8:
317
      case 8:
291
	outn ((long)k & 0xff);
318
	outn((long)k & 0xff);
292
	break;
319
	break;
293
      case 16:
320
      case 16:
294
	outn ((long)k & 0xffff);
321
	outn((long)k & 0xffff);
295
	break;
322
	break;
296
      case 32:
323
      case 32:
297
	outn ((long)k);
324
	outn((long)k);
298
	break;
325
	break;
299
      case 64:
326
      case 64:
300
	outn ((long)k);
327
	outn((long)k);
301
	outs (", ");
328
	outs(", ");
302
	if (isbigval(e)) {
329
	if (isbigval(e)) {
303
	  SET (x);
330
	  SET(x);
304
	  outn((long)x.big);
331
	  outn((long)x.big);
305
	} else
332
	} else
306
	if (is_signed(sh(e)) && k < 0)
333
	if (is_signed(sh(e)) && k < 0)
307
	  outn((long)-1);
334
	  outn((long) -1);
308
	else
335
	else
309
	  outn((long)0);
336
	  outn((long)0);
310
	break;
337
	break;
311
      default:
338
      default:
312
	outn((long)k);
339
	outn((long)k);
313
	break;
340
	break;
314
    };
341
    };
315
    return;
342
    return;
316
  };
343
  };
317
 
344
 
318
  if (n == real_tag) {
345
  if (n == real_tag) {
319
    outreal (e);
346
    outreal(e);
320
    return;
347
    return;
321
  };
348
  };
322
 
349
 
323
  if (n == reff_tag && name(son(e)) == name_tag && isglob(son(son(e)))) {
350
  if (n == reff_tag && name(son(e)) == name_tag && isglob(son(son(e)))) {
324
    outopenbr();
351
    outopenbr();
325
    outs (brog (son (son (e))) -> dec_u.dec_val.dec_id);
352
    outs(brog(son(son(e))) -> dec_u.dec_val.dec_id);
326
    outs (" + ");
353
    outs(" + ");
327
    outn ((long)(no (e) + no (son (e))) / 8);
354
    outn((long)(no(e) + no(son(e))) / 8);
328
    outclosebr();
355
    outclosebr();
329
    return;
356
    return;
330
  };
357
  };
331
 
358
 
332
  if (n == name_tag) {
359
  if (n == name_tag) {
333
    if (no (e) != 0) {
360
    if (no(e)!= 0) {
334
      outopenbr();
361
      outopenbr();
335
      outs (brog (son (e)) -> dec_u.dec_val.dec_id);
362
      outs(brog(son(e)) -> dec_u.dec_val.dec_id);
336
      outs (" + ");
363
      outs(" + ");
337
      outn ((long)no (e) / 8);
364
      outn((long)no(e) / 8);
338
      outclosebr();
365
      outclosebr();
339
    }
366
    }
340
    else
367
    else
341
      outs (brog (son (e)) -> dec_u.dec_val.dec_id);
368
      outs(brog(son(e)) -> dec_u.dec_val.dec_id);
342
    return;
369
    return;
343
  };
370
  };
344
 
371
 
345
  {
372
  {
346
    int k = evalexp (e);
373
    int k = evalexp(e);
347
    switch (e_size) {
374
    switch (e_size) {
348
      case 8:
375
      case 8:
349
	outn ((long)k & 0xff);
376
	outn((long)k & 0xff);
350
	break;
377
	break;
351
      case 16:
378
      case 16:
352
	outn ((long)k & 0xffff);
379
	outn((long)k & 0xffff);
353
	break;
380
	break;
354
      case 32:
381
      case 32:
355
	outn ((long)k);
382
	outn((long)k);
356
	break;
383
	break;
357
      default:
384
      default:
358
	outn((long)k);
385
	outn((long)k);
359
	break;
386
	break;
360
    };
387
    };
Line 364... Line 391...
364
 
391
 
365
 
392
 
366
 
393
 
367
/* auxiliary for evalaux */
394
/* auxiliary for evalaux */
368
static  void clear_out
395
static  void clear_out
369
    PROTO_N ( (n, isconst, al) )
-
 
370
    PROTO_T ( int n X int isconst X int al )
396
(int n, int isconst, int al)
371
{
397
{
372
  if (n == 0)
398
  if (n == 0)
373
     return;
399
     return;
374
 
400
 
375
  if (isconst) {
401
  if (isconst) {
376
    while (al >= 32 && n >= 4) {
402
    while (al >= 32 && n >= 4) {
377
      outlong();
403
      outlong();
378
      outs ("0");
404
      outs("0");
379
      outnl ();
405
      outnl();
380
      n -= 4;
406
      n -= 4;
381
    };
407
    };
382
    while (n > 0) {
408
    while (n > 0) {
383
      outbyte();
409
      outbyte();
384
      outs ("0");
410
      outs("0");
385
      outnl ();
411
      outnl();
386
      --n;
412
      --n;
387
    };
413
    };
388
  }
414
  }
389
  else {
415
  else {
390
    outs (".set .,.+");
416
    outs(".set .,.+");
391
    outn ((long)n);
417
    outn((long)n);
392
    outnl ();
418
    outnl();
393
  };
419
  };
394
 
420
 
395
  return;
421
  return;
396
}
422
}
397
 
423
 
398
/* does the work of outputting of constants recursively */
424
/* does the work of outputting of constants recursively */
399
static void evalaux
425
static void evalaux
400
    PROTO_N ( (e, isconst, al) )
-
 
401
    PROTO_T ( exp e X int isconst X int al )
426
(exp e, int isconst, int al)
402
{
427
{
403
  int e_size = shape_size(sh(e));
428
  int e_size = shape_size(sh(e));
404
  unsigned char  n = name (e);
429
  unsigned char  n = name(e);
405
 
430
 
406
  if (n == compound_tag) {		/* output components in turn */
431
  if (n == compound_tag) {		/* output components in turn */
407
    int work = 0;
432
    int work = 0;
408
    exp offe;
433
    exp offe;
409
    exp val;
434
    exp val;
410
    int bits_left = 0;
435
    int bits_left = 0;
411
    int crt_off = 0;
436
    int crt_off = 0;
412
    int off, offn, sz, nx, i;
437
    int off, offn, sz, nx, i;
413
 
438
 
414
    if (son(e) == nilexp)
439
    if (son(e) == nilexp)
415
      return;
440
      return;
416
 
441
 
417
    offe = son(e);
442
    offe = son(e);
418
 
443
 
Line 422... Line 447...
422
       val = bro(offe);
447
       val = bro(offe);
423
       if (bits_left &&
448
       if (bits_left &&
424
            off >= (crt_off + 8))
449
            off >= (crt_off + 8))
425
         {
450
         {
426
	    outbyte();
451
	    outbyte();
427
	    outn ((long)work & 0xff);
452
	    outn((long)work & 0xff);
428
            outnl();
453
            outnl();
429
            crt_off += 8;
454
            crt_off += 8;
430
            work = 0;
455
            work = 0;
431
            bits_left = 0;
456
            bits_left = 0;
432
         };
457
         };
433
 
458
 
434
       if (off < crt_off)
459
       if (off < crt_off)
435
              failer(CPD_ORDER);
460
              failer(CPD_ORDER);
436
       if (off >= (crt_off + 8))
461
       if (off >= (crt_off + 8))
437
           {
462
           {
438
              clear_out((off-crt_off)/8, isconst, al);
463
              clear_out((off-crt_off) /8, isconst, al);
439
              crt_off = off & -8;
464
              crt_off = off & -8;
440
           };
465
           };
441
 
466
 
442
       if (name(sh(val)) != bitfhd)
467
       if (name(sh(val))!= bitfhd)
443
         {
468
         {
444
           evalaux(val, isconst, (crt_off + al) & 56);
469
           evalaux(val, isconst,(crt_off + al) & 56);
445
           crt_off += shape_size(sh(val));
470
           crt_off += shape_size(sh(val));
446
         }
471
         }
447
       else
472
       else
448
         {
473
         {
449
           offn = off - crt_off;
474
           offn = off - crt_off;
450
           sz = shape_size(sh(val));
475
           sz = shape_size(sh(val));
451
           nx = (name(val)==int_to_bitf_tag) ? no(son(val)) : no(val);
476
           nx = (name(val) ==int_to_bitf_tag)? no(son(val)): no(val);
452
           work += nx << offn;
477
           work += nx << offn;
453
           bits_left = offn+sz;
478
           bits_left = offn+sz;
454
           if ((offn + sz) <= 32)
479
           if ((offn + sz) <= 32)
455
              { while ((offn+sz) >= 8)
480
              { while ((offn+sz) >= 8)
456
                 {
481
                 {
457
	           outbyte();
482
	           outbyte();
458
	           outn ((long)work & 0xff);
483
	           outn((long)work & 0xff);
459
                   outnl();
484
                   outnl();
460
                   crt_off += 8;
485
                   crt_off += 8;
461
                   work >>= 8;
486
                   work >>= 8;
462
                   offn -= 8;
487
                   offn -= 8;
463
                   bits_left = offn+sz;
488
                   bits_left = offn+sz;
Line 467... Line 492...
467
           else
492
           else
468
            {
493
            {
469
              for (i=0; i<4; ++i)
494
              for (i=0; i<4; ++i)
470
                 {
495
                 {
471
	           outbyte();
496
	           outbyte();
472
	           outn ((long)work & 0xff);
497
	           outn((long)work & 0xff);
473
                   outnl();
498
                   outnl();
474
                   crt_off += 8;
499
                   crt_off += 8;
475
                   work >>= 8;
500
                   work >>= 8;
476
                   offn -= 8;
501
                   offn -= 8;
477
                   bits_left = offn+sz;
502
                   bits_left = offn+sz;
Line 483... Line 508...
483
       if (last(val))   /* CLEAR OUT SHAPE size_shape(e) - crt_off */
508
       if (last(val))   /* CLEAR OUT SHAPE size_shape(e) - crt_off */
484
        {
509
        {
485
          if (bits_left)
510
          if (bits_left)
486
            {
511
            {
487
	       outbyte();
512
	       outbyte();
488
	       outn ((long)work & 0xff);
513
	       outn((long)work & 0xff);
489
               outnl();
514
               outnl();
490
               crt_off += 8;
515
               crt_off += 8;
491
            };
516
            };
492
          clear_out((shape_size(sh(e)) - crt_off)/8, isconst,
517
          clear_out((shape_size(sh(e)) - crt_off) /8, isconst,
493
			8);
518
			8);
494
          return;
519
          return;
495
        };
520
        };
496
       offe = bro(val);
521
       offe = bro(val);
497
     };
522
     };
Line 514... Line 539...
514
       };
539
       };
515
 
540
 
516
      for (j = i; goon && j < i + 10; ++j) {
541
      for (j = i; goon && j < i + 10; ++j) {
517
        switch (props(e))
542
        switch (props(e))
518
         {
543
         {
519
           case 8: outn ((long) s[j]); break;
544
           case 8: outn((long)s[j]); break;
520
           case 16: outn ((long) ((short*)(void*)s)[j]); break;
545
           case 16: outn((long)((short*)(void*)s)[j]); break;
521
		/* the pun to short* is correct: jmf */
546
		/* the pun to short* is correct: jmf */
522
           case 32: outn ((long) ((int*)(void*)s)[j]); break;
547
           case 32: outn((long)((int*)(void*)s)[j]); break;
523
		/* the pun to int* is correct: jmf */
548
		/* the pun to int* is correct: jmf */
524
	   case 64: {
549
	   case 64: {
525
	     flt64 x;
550
	     flt64 x;
526
	     int ov;
551
	     int ov;
527
	     x = flt_to_f64(((int*)(void*)s)[j], 0, &ov);
552
	     x = flt_to_f64(((int*)(void*)s)[j], 0, &ov);
528
	     outn((long)x.small); outs (", "); outn((long)x.big);
553
	     outn((long)x.small); outs(", "); outn((long)x.big);
529
	   };
554
	   };
530
         };
555
         };
531
	--goon;
556
	--goon;
532
	if (goon && j < i + 9)
557
	if (goon && j < i + 9)
533
	  outs (", ");
558
	  outs(", ");
534
      };
559
      };
535
      outnl ();
560
      outnl();
536
    };
561
    };
537
    return;
562
    return;
538
  };
563
  };
539
 
564
 
540
  if (n == res_tag) {
565
  if (n == res_tag) {
541
    int  nb;
566
    int  nb;
542
    nb = shape_size(sh(son(e))) / 8;
567
    nb = shape_size(sh(son(e))) / 8;
543
    clear_out (nb, isconst, shape_align(sh(son(e))));
568
    clear_out(nb, isconst, shape_align(sh(son(e))));
544
    return;
569
    return;
545
  };
570
  };
546
 
571
 
547
  if (n == ncopies_tag) {
572
  if (n == ncopies_tag) {
548
    int  m = no (e);
573
    int  m = no(e);
549
    int  sz, i;
574
    int  sz, i;
550
    exp val = son(e);
575
    exp val = son(e);
551
    while ( name ( val ) == ncopies_tag ) {
576
    while (name(val) == ncopies_tag) {
552
	m *= no ( val ) ;
577
	m *= no(val);
553
	val = son ( val ) ;
578
	val = son(val);
554
    }
579
    }
555
    sz = shape_size(sh(val)) / 8;
580
    sz = shape_size(sh(val)) / 8;
556
    if ((name(val) == null_tag ||
581
    if ((name(val) == null_tag ||
557
	 name(val) == val_tag) && !isbigval(val) && no(val) == 0)
582
	 name(val) == val_tag) && !isbigval(val) && no(val) == 0)
558
      clear_out (m * sz, isconst, shape_align(sh(val)));
583
      clear_out(m * sz, isconst, shape_align(sh(val)));
559
    else {
584
    else {
560
      for (i = 0; i < m; i++)
585
      for (i = 0; i < m; i++)
561
	evalaux(val, isconst, al);
586
	evalaux(val, isconst, al);
562
    }
587
    }
563
    return;
588
    return;
Line 572... Line 597...
572
      {
597
      {
573
        evalaux(t, isconst, al);
598
        evalaux(t, isconst, al);
574
        if (last(t))
599
        if (last(t))
575
          return;
600
          return;
576
        t = bro(t);
601
        t = bro(t);
577
        dot_align((shape_align(sh(t))<=8) ? 1 : shape_align(sh(t))/8);
602
        dot_align((shape_align(sh(t)) <=8)? 1 : shape_align(sh(t)) /8);
578
      };
603
      };
579
   };
604
   };
580
 
605
 
581
  if (n == concatnof_tag) {
606
  if (n == concatnof_tag) {
582
    evalaux (son (e), isconst, al);
607
    evalaux(son(e), isconst, al);
583
    evalaux (bro (son (e)), isconst, (al +shape_size(son(e))) & 63);
608
    evalaux(bro(son(e)), isconst,(al +shape_size(son(e))) & 63);
584
    return;
609
    return;
585
  };
610
  };
586
 
611
 
587
  if (n == clear_tag)
612
  if (n == clear_tag)
588
   {
613
   {
589
     int sz = shape_size ( sh ( e ) ) / 8;
614
     int sz = shape_size(sh(e)) / 8;
590
     clear_out (sz, isconst, al);
615
     clear_out(sz, isconst, al);
591
     return;
616
     return;
592
   };
617
   };
593
 
618
 
594
  if (n == chvar_tag && shape_size(sh(e)) == shape_size(sh(son(e)))) {
619
  if (n == chvar_tag && shape_size(sh(e)) == shape_size(sh(son(e)))) {
595
    sh(son(e)) = sh(e);
620
    sh(son(e)) = sh(e);
596
    evalaux(son(e), isconst, al);
621
    evalaux(son(e), isconst, al);
597
    return;
622
    return;
598
  };
623
  };
599
 
624
 
600
 
625
 
601
  outsize(e_size);
626
  outsize(e_size);
602
  evalval(e);
627
  evalval(e);
603
  outnl();
628
  outnl();
604
  return;
629
  return;
605
}
630
}
606
 
631
 
607
/* output a constant of given label number
632
/* output a constant of given label number
608
   cname, or identifier s cname==-1 means
633
   cname, or identifier s cname==-1 means
609
   use s */
634
   use s */
610
void evaluate
635
void evaluate
611
    PROTO_N ( (c, cname, s, isconst, global, diag_props) )
-
 
612
    PROTO_T ( exp c X int cname X char *s X int isconst X int global X diag_global * diag_props )
636
(exp c, int cname, char *s, int isconst, int global, diag_global * diag_props)
613
{
637
{
614
  int al = shape_align(sh(c));
638
  int al = shape_align(sh(c));
615
 
639
 
616
  if (global && cname == -1) {
640
  if (global && cname == -1) {
617
    outs (".globl ");
641
    outs(".globl ");
618
    outs (s);
642
    outs(s);
619
    outnl ();
643
    outnl();
620
  };
644
  };
621
 
645
 
622
  if (name(sh(c)) == realhd ||
646
  if (name(sh(c)) == realhd ||
623
        (name(sh(c)) == nofhd && ptno(sh(c)) == realhd) ||
647
       (name(sh(c)) == nofhd && ptno(sh(c)) == realhd) ||
624
      shape_size(sh(c)) >= 512)
648
      shape_size(sh(c)) >= 512)
625
    al = 64;
649
    al = 64;
626
 
650
 
627
  if (al <= 8)
651
  if (al <= 8)
628
    dot_align(4);
652
    dot_align(4);
629
  else
653
  else
630
    dot_align(al/8);
654
    dot_align(al/8);
631
 
655
 
632
  if (diag_props)
656
  if (diag_props)
633
#ifdef NEWDWARF
657
#ifdef NEWDWARF
634
    DIAG_VAL_BEGIN (diag_props, global, cname, s);
658
    DIAG_VAL_BEGIN(diag_props, global, cname, s);
635
#else
659
#else
636
    diag_val_begin(diag_props, global, cname, s);
660
    diag_val_begin(diag_props, global, cname, s);
637
#endif
661
#endif
638
 
662
 
639
  if (cname == -1) {
663
  if (cname == -1) {
640
    outs (s);
664
    outs(s);
641
  }
665
  }
642
  else {
666
  else {
643
    outs(local_prefix);
667
    outs(local_prefix);
644
    outn ((long)cname);
668
    outn((long)cname);
645
  };
669
  };
646
 
670
 
647
  outs (":");
671
  outs(":");
648
  outnl();
672
  outnl();
649
 
673
 
650
  evalaux (c, isconst, al);
674
  evalaux(c, isconst, al);
651
 
675
 
652
  if (global)
676
  if (global)
653
    eval_postlude(s, c);
677
    eval_postlude(s, c);
654
 
678
 
655
  outnl ();
679
  outnl();
656
 
680
 
657
  if (diag_props) {
681
  if (diag_props) {
658
#ifdef NEWDWARF
682
#ifdef NEWDWARF
659
    DIAG_VAL_END (diag_props);
683
    DIAG_VAL_END(diag_props);
660
#else
684
#else
661
    diag_val_end(diag_props);
685
    diag_val_end(diag_props);
662
#endif
686
#endif
663
  }
687
  }
664
 
688