Subversion Repositories tendra.SVN

Rev

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

Rev 2 Rev 7
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 97... Line 127...
97
#include "weights.h"
127
#include "weights.h"
98
 
128
 
99
 
129
 
100
/* MACROS */
130
/* MACROS */
101
 
131
 
102
#define max(x,y) ((x>=y) ? (x) : (y))
132
#define max(x,y)((x>=y)?(x):(y))
103
 
133
 
104
#define wno 6
134
#define wno 6
105
 /* number of available registers */
135
 /* number of available registers */
106
#define wfno 7
136
#define wfno 7
107
 /* number of available floating point registers */
137
 /* number of available floating point registers */
Line 154... Line 184...
154
};
184
};
155
typedef struct elt  explist;
185
typedef struct elt  explist;
156
				/* list of identity declarations in force
186
				/* list of identity declarations in force
157
				   at this point */
187
				   at this point */
158
 
188
 
159
weights weightsv PROTO_S ( ( exp, explist * ) ) ;
189
weights weightsv(exp, explist *);
160
 
190
 
161
/* VARIABLES */
191
/* VARIABLES */
162
 
192
 
163
weights zeros, moveregs, cmpregs, divregs, applyregs;
193
weights zeros, moveregs, cmpregs, divregs, applyregs;
164
	/* init by init_weights */
194
	/* init by init_weights */
Line 167... Line 197...
167
 
197
 
168
 
198
 
169
/* PROCEDURES */
199
/* PROCEDURES */
170
 
200
 
171
static int no_side_aux
201
static int no_side_aux
172
    PROTO_N ( (e) )
-
 
173
    PROTO_T ( exp e )
202
(exp e)
174
{
203
{
175
  exp arg;
204
  exp arg;
176
  if (name(e)==name_tag || name(e)==env_offset_tag || name(e)==top_tag || son(e)==nilexp)
205
  if (name(e) ==name_tag || name(e) ==env_offset_tag || name(e) ==top_tag || son(e) ==nilexp)
177
    return 1;
206
    return 1;
178
  for (arg=son(e); ; arg=bro(arg))
207
  for (arg=son(e);; arg=bro(arg))
179
  {
208
  {
180
    if ((!is_a(name(arg)) && name(arg) != ident_tag) || !no_side_aux(arg))
209
    if ((!is_a(name(arg)) && name(arg)!= ident_tag) || !no_side_aux(arg))
181
      return 0;
210
      return 0;
182
    if (last(arg))
211
    if (last(arg))
183
      return 1;
212
      return 1;
184
  }
213
  }
185
}
214
}
186
 
215
 
187
 
216
 
188
/* test for guaranteed no side effect */
217
/* test for guaranteed no side effect */
189
/* simple assignment is permitted */
218
/* simple assignment is permitted */
190
int no_side
219
int no_side
191
    PROTO_N ( (e) )
-
 
192
    PROTO_T ( exp e )
220
(exp e)
193
{
221
{
194
  return ((is_a (name (e)) || name (e) == test_tag || name (e) == ass_tag ||
222
  return((is_a(name(e)) || name(e) == test_tag || name(e) == ass_tag ||
195
	   name (e) == testbit_tag || name (e) == ident_tag)
223
	   name(e) == testbit_tag || name(e) == ident_tag)
196
	&& no_side_aux (e));
224
	&& no_side_aux(e));
197
}
225
}
198
 
226
 
199
/* add two weight vectors */
227
/* add two weight vectors */
200
weights add_weights
228
weights add_weights
201
    PROTO_N ( (w1, w2) )
-
 
202
    PROTO_T ( weights w1 X weights w2 )
229
(weights w1, weights w2)
203
{
230
{
204
  weights r;
231
  weights r;
205
  float  wa,
232
  float  wa,
206
         wb;
233
         wb;
207
  int i;
234
  int i;
208
  for (i = 0; i < (wno + wfno); ++i) {
235
  for (i = 0; i < (wno + wfno); ++i) {
209
    wa = (w1.w_weights)[i];
236
    wa = (w1.w_weights)[i];
210
    wb = (w2.w_weights)[i];
237
    wb = (w2.w_weights)[i];
211
    (r.w_weights)[i] = wa + wb;
238
   (r.w_weights)[i] = wa + wb;
212
  };
239
  };
213
  r.booked = max (w1.booked, w2.booked);
240
  r.booked = max(w1.booked, w2.booked);
214
  r.flbooked = max (w1.flbooked, w2.flbooked);
241
  r.flbooked = max(w1.flbooked, w2.flbooked);
215
  return (r);
242
  return(r);
216
}
243
}
217
 
244
 
218
void init_weights
245
void init_weights
219
    PROTO_Z ()
246
(void)
220
{
247
{
221
		/* initialisation of constants */
248
		/* initialisation of constants */
222
  int  i;
249
  int  i;
223
  for (i = 0; i < (wno + wfno); ++i) {
250
  for (i = 0; i < (wno + wfno); ++i) {
224
    (zeros.w_weights)[i] = vzeros[i];
251
   (zeros.w_weights)[i] = vzeros[i];
225
    (moveregs.w_weights)[i] = vmoveregs[i];
252
   (moveregs.w_weights)[i] = vmoveregs[i];
226
    (cmpregs.w_weights)[i] = vcmpregs[i];
253
   (cmpregs.w_weights)[i] = vcmpregs[i];
227
    (divregs.w_weights)[i] = vdivregs[i];
254
   (divregs.w_weights)[i] = vdivregs[i];
228
    (applyregs.w_weights)[i] = vapplyregs[i];
255
   (applyregs.w_weights)[i] = vapplyregs[i];
229
  };
256
  };
230
  zeros.booked = -1;
257
  zeros.booked = -1;
231
  moveregs.booked = 1;
258
  moveregs.booked = 1;
232
  cmpregs.booked = 1;
259
  cmpregs.booked = 1;
233
  divregs.booked = 1;
260
  divregs.booked = 1;
Line 241... Line 268...
241
 
268
 
242
  return;
269
  return;
243
}
270
}
244
 
271
 
245
void markcall
272
void markcall
246
    PROTO_N ( (el) )
-
 
247
    PROTO_T ( explist * el )
273
(explist * el)
248
{
274
{
249
  explist * t = el;
275
  explist * t = el;
250
  while (t != (explist *) 0) {
276
  while (t != (explist *)0) {
251
    set_intnl_call (t -> wident);
277
    set_intnl_call(t -> wident);
252
    t = t -> etl;
278
    t = t -> etl;
253
  };
279
  };
254
}
280
}
255
 
281
 
256
/* mark all the declarations in the list
282
/* mark all the declarations in the list
257
   of currently active declarations, to
283
   of currently active declarations, to
258
   show that there is a call, movc3 etc.
284
   show that there is a call, movc3 etc.
259
   within their scope */
285
   within their scope */
260
void markmove
286
void markmove
261
    PROTO_N ( (el) )
-
 
262
    PROTO_T ( explist * el )
287
(explist * el)
263
{
288
{
264
  explist * t = el;
289
  explist * t = el;
265
  while (t != (explist *) 0) {
290
  while (t != (explist *)0) {
266
    set_intnl_call (t -> wident);
291
    set_intnl_call(t -> wident);
267
    t = t -> etl;
292
    t = t -> etl;
268
  };
293
  };
269
}
294
}
270
 
295
 
271
/* mark to show reg1 may be needed */
296
/* mark to show reg1 may be needed */
272
void markreg1
297
void markreg1
273
    PROTO_N ( (el) )
-
 
274
    PROTO_T ( explist * el )
298
(explist * el)
275
{
299
{
276
  explist * t = el;
300
  explist * t = el;
277
  while (t != (explist *) 0) {
301
  while (t != (explist *)0) {
278
    set_intnl_call (t -> wident);
302
    set_intnl_call(t -> wident);
279
    t = t -> etl;
303
    t = t -> etl;
280
  };
304
  };
281
}
305
}
282
 
306
 
283
 
307
 
284
/* work out weights for a declaration and
308
/* work out weights for a declaration and
285
   set up the break point to put in the no
309
   set up the break point to put in the no
286
   field of the declaration */
310
   field of the declaration */
287
wp max_weights
311
wp max_weights
288
    PROTO_N ( (size, locp, ws, isfl) )
-
 
289
    PROTO_T ( int size X float locp X weights ws X int isfl )
312
(int size, float locp, weights ws, int isfl)
290
{
313
{
291
  int  k = (size + 31) / 32;
314
  int  k = (size + 31) / 32;
292
  int  bk = 11;
315
  int  bk = 11;
293
  int bkset = 0;
316
  int bkset = 0;
294
  int  q;
317
  int  q;
295
  int  i;
318
  int  i;
296
  float * w = &(ws.w_weights)[(isfl) ? wno : 0];
319
  float * w = & (ws.w_weights)[(isfl)? wno : 0];
297
  wp res;
320
  wp res;
298
  float *pw = &((res.wp_weights).w_weights)[(isfl) ? wno : 0];
321
  float *pw = & ((res.wp_weights).w_weights)[(isfl)? wno : 0];
299
  int  bkd = (isfl) ? ws.flbooked : ws.booked;
322
  int  bkd = (isfl)? ws.flbooked : ws.booked;
300
  int  lwno = (isfl) ? wfno : wno;
323
  int  lwno = (isfl)? wfno : wno;
301
  res.wp_weights.booked = ws.booked;
324
  res.wp_weights.booked = ws.booked;
302
  res.wp_weights.flbooked = ws.flbooked;
325
  res.wp_weights.flbooked = ws.flbooked;
303
 
326
 
304
  for (i = 0; i < (wno + wfno); ++i)
327
  for (i = 0; i < (wno + wfno); ++i)
305
    ((res.wp_weights).w_weights)[i] = (ws.w_weights)[i];
328
   ((res.wp_weights).w_weights)[i] = (ws.w_weights)[i];
306
 
329
 
307
   {
330
   {
308
    float  loc = locp * k;
331
    float  loc = locp * k;
309
    q = -1;
332
    q = -1;
310
    for (i = 0; i < lwno; ++i) {
333
    for (i = 0; i < lwno; ++i) {
Line 337... Line 360...
337
    };
360
    };
338
  };
361
  };
339
 
362
 
340
 
363
 
341
  res.wp_break = bk;
364
  res.wp_break = bk;
342
  return (res);
365
  return(res);
343
}
366
}
344
 
367
 
345
 
368
 
346
/* see if we must use movc3?? */
369
/* see if we must use movc3?? */
347
weights try_mc3
370
weights try_mc3
348
    PROTO_N ( (e, ws, el) )
-
 
349
    PROTO_T ( exp e X weights ws X explist * el )
371
(exp e, weights ws, explist * el)
350
{
372
{
351
  int  sz = shape_size(sh(e));
373
  int  sz = shape_size(sh(e));
352
 
374
 
353
  if (sz <= 128)
375
  if (sz <= 128)
354
    return (ws);
376
    return(ws);
355
 
377
 
356
  markmove (el);
378
  markmove(el);
357
  return (add_weights (ws, moveregs));
379
  return(add_weights(ws, moveregs));
358
}
380
}
359
 
381
 
360
/* work out the weights for a list of exp.
382
/* work out the weights for a list of exp.
361
   usemc3 is 1 if movc3 may be used. */
383
   usemc3 is 1 if movc3 may be used. */
362
weights add_wlist
384
weights add_wlist
363
    PROTO_N ( (re, usemc3, el) )
-
 
364
    PROTO_T ( exp re X int usemc3 X explist * el )
385
(exp re, int usemc3, explist * el)
365
{
386
{
366
  weights wl1, wl2;
387
  weights wl1, wl2;
367
  if (re == nilexp)
388
  if (re == nilexp)
368
    return (zeros);
389
    return(zeros);
369
 
390
 
370
  wl1 = weightsv (re, el);
391
  wl1 = weightsv(re, el);
371
  if (usemc3)
392
  if (usemc3)
372
    wl1 = try_mc3 (re, wl1, el);
393
    wl1 = try_mc3(re, wl1, el);
373
 
394
 
374
  while (!last (re)) {
395
  while (!last(re)) {
375
    re = bro (re);
396
    re = bro(re);
376
    wl2 = weightsv (re, el);
397
    wl2 = weightsv(re, el);
377
    if (usemc3)
398
    if (usemc3)
378
      wl1 = add_weights (wl1, try_mc3 (re, wl2, el));
399
      wl1 = add_weights(wl1, try_mc3(re, wl2, el));
379
    else
400
    else
380
      wl1 = add_weights (wl1, wl2);
401
      wl1 = add_weights(wl1, wl2);
381
  };
402
  };
382
  return (wl1);
403
  return(wl1);
383
}
404
}
384
 
405
 
385
 
406
 
386
 
407
 
387
/* can the value defined by e be put in a register */
408
/* can the value defined by e be put in a register */
388
int regable
409
int regable
389
    PROTO_N ( (e) )
-
 
390
    PROTO_T ( exp e )
410
(exp e)
391
{
411
{
392
  unsigned char  n;
412
  unsigned char  n;
393
  shape sha = sh (son (e));
413
  shape sha = sh(son(e));
394
  n = name (sha);
414
  n = name(sha);
395
  if (isvis (e) || n == cpdhd || n == nofhd || n == s64hd || n == u64hd)
415
  if (isvis(e) || n == cpdhd || n == nofhd || n == s64hd || n == u64hd)
396
    return (0);
416
    return(0);
397
  if (all_variables_visible && isvar(e))
417
  if (all_variables_visible && isvar(e))
398
    return 0;
418
    return 0;
399
  return (1);
419
  return(1);
400
}
420
}
401
 
421
 
402
int isflsh
422
int isflsh
403
    PROTO_N ( (s) )
-
 
404
    PROTO_T ( shape s )
423
(shape s)
405
{
424
{
406
  unsigned char  n = name (s);
425
  unsigned char  n = name(s);
407
  return (n >= shrealhd && n <= doublehd);
426
  return(n >= shrealhd && n <= doublehd);
408
}
427
}
409
 
428
 
410
 
429
 
411
/* Work out weights and set break points
430
/* Work out weights and set break points
412
   scale is the expected number of times
431
   scale is the expected number of times
Line 416... Line 435...
416
   is computed in the no of the
435
   is computed in the no of the
417
   declaration. After the scan the break
436
   declaration. After the scan the break
418
   point is put into the no of the
437
   point is put into the no of the
419
   declaration */
438
   declaration */
420
weights weightsv
439
weights weightsv
421
    PROTO_N ( (e, el) )
-
 
422
    PROTO_T ( exp e X explist * el )
440
(exp e, explist * el)
423
{
441
{
424
  unsigned char  n = name (e);
442
  unsigned char  n = name(e);
425
  float old_scale;
443
  float old_scale;
426
  weights swl, bwl;
444
  weights swl, bwl;
427
 
445
 
428
  switch (n) {
446
  switch (n) {
429
    case name_tag: {
447
    case name_tag: {
430
	if (!isglob (son (e)))
448
	if (!isglob(son(e)))
431
	  fno (son (e)) += scale;/* add number of uses to the no field of
449
	  fno (son (e)) += scale;/* add number of uses to the no field of
432
				   the declaration */
450
				   the declaration */
433
	return (zeros);
451
	return(zeros);
434
      };
452
      };
435
    case make_lv_tag:
453
    case make_lv_tag:
436
        return zeros;
454
        return zeros;
437
    case ident_tag:
455
    case ident_tag:
438
       {
456
       {
439
	explist nel;
457
	explist nel;
440
	exp t = pt (e);
458
	exp t = pt(e);
441
	nel.wident = e;
459
	nel.wident = e;
442
	nel.etl = el;
460
	nel.etl = el;
443
	while (isvar (e) && !isvis (e) && t != nilexp) {
461
	while (isvar(e) && !isvis(e) && t != nilexp) {
444
	  if (!(last (t) && name (bro (t)) == cont_tag) &&
462
	  if (!(last(t) && name(bro(t)) == cont_tag) &&
445
              !(last(t) && name(bro(t)) == hold_tag) &&
463
              !(last(t) && name(bro(t)) == hold_tag) &&
446
	      !(last (bro (t)) && (name (bro (bro (t))) == ass_tag ||
464
	      !(last(bro(t)) && (name(bro(bro(t))) == ass_tag ||
447
		  name (bro (bro (t))) == assvol_tag
465
		  name(bro(bro(t))) == assvol_tag
448
		)))
466
		)))
449
	    setvis (e);
467
	    setvis(e);
450
	  t = pt (t);
468
	  t = pt(t);
451
	};
469
	};
452
 
470
 
453
	if (son (e) != nilexp) {
471
	if (son(e)!= nilexp) {
454
	  weights wdef, wbody;
472
	  weights wdef, wbody;
455
	  exp def = son (e);
473
	  exp def = son(e);
456
	  exp body = bro (def);
474
	  exp body = bro(def);
457
 
475
 
458
	  if (name(sh(def)) == u64hd || name(sh(def)) == s64hd)
476
	  if (name(sh(def)) == u64hd || name(sh(def)) == s64hd)
459
	    markreg1(el);
477
	    markreg1(el);
460
 
478
 
461
	  fno (e) = 0.0;	/* clear the accumulated value field */
479
	  fno (e) = 0.0;	/* clear the accumulated value field */
462
	  wbody = weightsv (body, &nel);
480
	  wbody = weightsv(body, &nel);
463
	  /* do body (which will add to the accumulated value field */
481
	  /* do body (which will add to the accumulated value field */
464
	  if (regable (e)) {
482
	  if (regable(e)) {
465
	    wp p;
483
	    wp p;
466
	    float  loc = fno (e);
484
	    float  loc = fno(e);
467
            if (has_intnl_call(e))
485
            if (has_intnl_call(e))
468
               loc += 2.0;
486
               loc += 2.0;
469
	    p = max_weights (shape_size(sh (def)),
487
	    p = max_weights(shape_size(sh(def)),
470
		(name (def) == name_tag && isusereg (e)) ? 1.0 : loc,
488
		(name(def) == name_tag && isusereg(e))? 1.0 : loc,
471
		wbody,
489
		wbody,
472
		isflsh (sh (def)));
490
		isflsh(sh(def)));
473
	    if (name (def) == clear_tag)
491
	    if (name(def) == clear_tag)
474
	      wdef = zeros;
492
	      wdef = zeros;
475
	    else {
493
	    else {
476
	      float  sp_scale = scale;
494
	      float  sp_scale = scale;
477
	      if (!isvar (e) &&
495
	      if (!isvar(e) &&
478
		  ((name (def) == name_tag && !isvar (son (def)) &&
496
		 ((name(def) == name_tag && !isvar(son(def)) &&
479
		      (!isglob (son (def))) && !isloadparam(def)
497
		     (!isglob(son(def))) && !isloadparam(def)
480
		    ) ||
498
		   ) ||
481
		    (name (def) == cont_tag &&
499
		   (name(def) == cont_tag &&
482
		      name (son (def)) == name_tag &&
500
		      name(son(def)) == name_tag &&
483
		      isvar (son (son (def))) &&
501
		      isvar(son(son(def))) &&
484
		      (!isglob (son (son (def)))) &&
502
		     (!isglob(son(son(def)))) &&
485
 
503
 
486
		      no_side (body)))) {
504
		      no_side(body)))) {
487
		if (isusereg (e)) {
505
		if (isusereg(e)) {
488
		  sp_scale = 8.0 * fno (e);
506
		  sp_scale = 8.0 * fno(e);
489
		}
507
		}
490
		else
508
		else
491
		  sp_scale = fno (e);
509
		  sp_scale = fno(e);
492
		p.wp_break = 0;
510
		p.wp_break = 0;
493
		p.wp_weights = wbody;
511
		p.wp_weights = wbody;
494
	      };
512
	      };
495
              old_scale = scale;
513
              old_scale = scale;
496
              scale = sp_scale;
514
              scale = sp_scale;
497
	      wdef =
515
	      wdef =
498
		weightsv (def, el);
516
		weightsv(def, el);
499
	      wdef = try_mc3 (def, wdef, el);
517
	      wdef = try_mc3(def, wdef, el);
500
              scale = old_scale;
518
              scale = old_scale;
501
	    };
519
	    };
502
	    no (e) = p.wp_break;/* set the break point */
520
	    no (e) = p.wp_break;/* set the break point */
503
	    return (add_weights (wdef, p.wp_weights));
521
	    return(add_weights(wdef, p.wp_weights));
504
	  };
522
	  };
505
 
523
 
506
	  if (name(sh(def)) == nofhd && ptno(sh(def)) == realhd &&
524
	  if (name(sh(def)) == nofhd && ptno(sh(def)) == realhd &&
507
		shape_size(sh(def)) >= 640)
525
		shape_size(sh(def)) >= 640)
508
	    useful_double = 1;
526
	    useful_double = 1;
509
 
527
 
510
	  if (name (def) == clear_tag)
528
	  if (name(def) == clear_tag)
511
	    wdef = zeros;
529
	    wdef = zeros;
512
	  else {
530
	  else {
513
	    wdef =
531
	    wdef =
514
		weightsv (def, el);
532
		weightsv(def, el);
515
	      wdef = try_mc3 (def, wdef, el);
533
	      wdef = try_mc3(def, wdef, el);
516
	  };
534
	  };
517
	  no (e) = 16;
535
	  no(e) = 16;
518
	  return (add_weights (wdef, wbody));
536
	  return(add_weights(wdef, wbody));
519
	};
537
	};
520
	return (zeros);
538
	return(zeros);
521
      };
539
      };
522
    case labst_tag: {
540
    case labst_tag: {
523
	explist nel;
541
	explist nel;
524
	weights wbody;
542
	weights wbody;
525
	nel.wident = e;
543
	nel.wident = e;
526
	nel.etl = el;
544
	nel.etl = el;
527
	old_scale = scale;
545
	old_scale = scale;
528
	wbody = weightsv (bro (son (e)), &nel);
546
	wbody = weightsv(bro(son(e)), &nel);
529
	scale = old_scale;
547
	scale = old_scale;
530
	return (wbody);
548
	return(wbody);
531
      };
549
      };
532
    case rep_tag: {
550
    case rep_tag: {
533
	swl = weightsv (son (e), el);
551
	swl = weightsv(son(e), el);
534
 
552
 
535
        old_scale = scale;
553
        old_scale = scale;
536
 
554
 
537
        if (scale < 1e30)
555
        if (scale < 1e30)
538
		scale = 20*scale;
556
		scale = 20*scale;
539
 
557
 
540
	bwl = weightsv (bro (son (e)), el);
558
	bwl = weightsv(bro(son(e)), el);
541
        scale = old_scale;
559
        scale = old_scale;
542
 
560
 
543
	return (add_weights (swl, bwl));
561
	return(add_weights(swl, bwl));
544
      };
562
      };
545
    case cond_tag:  {
563
    case cond_tag:  {
546
        old_scale = scale;
564
        old_scale = scale;
547
 
565
 
548
        scale = 0.5*scale;
566
        scale = 0.5*scale;
549
        swl = weightsv (son (e), el);
567
        swl = weightsv(son(e), el);
550
	bwl = weightsv (bro (son (e)), el);
568
	bwl = weightsv(bro(son(e)), el);
551
 
569
 
552
        scale = old_scale;
570
        scale = old_scale;
553
 
571
 
554
	return (add_weights (swl, bwl));
572
	return(add_weights(swl, bwl));
555
      };
573
      };
556
    case case_tag:
574
    case case_tag:
557
      return (weightsv (son (e), el));
575
      return(weightsv(son(e), el));
558
 
576
 
559
    case compound_tag:
577
    case compound_tag:
560
      return (add_wlist (son (e), 1, el));
578
      return(add_wlist(son(e), 1, el));
561
      /* may use movc3 for component */
579
      /* may use movc3 for component */
562
 
580
 
563
    case res_tag:
581
    case res_tag:
564
    case untidy_return_tag:
582
    case untidy_return_tag:
565
      return (weightsv (son (e), el));
583
      return(weightsv(son(e), el));
566
 
584
 
567
    case asm_tag:
585
    case asm_tag:
568
    case apply_tag:
586
    case apply_tag:
569
    case apply_general_tag:
587
    case apply_general_tag:
570
    case tail_call_tag:
588
    case tail_call_tag:
571
      {
589
      {
572
        if (name(sh(e)) != bothd && !builtinproc(e))
590
        if (name(sh(e))!= bothd && !builtinproc(e))
573
	  markcall (el);
591
	  markcall(el);
574
	return (add_weights (add_wlist (son (e), 0, el),
592
	return(add_weights(add_wlist(son(e), 0, el),
575
	      applyregs));
593
	      applyregs));
576
      };
594
      };
577
 
595
 
578
    case ass_tag:
596
    case ass_tag:
579
    case assvol_tag: {
597
    case assvol_tag: {
580
      /* may use movc3 for assigned value */
598
      /* may use movc3 for assigned value */
581
      unsigned char shn = name (sh (bro (son (e))));
599
      unsigned char shn = name(sh(bro(son(e))));
582
      weights temp;
600
      weights temp;
583
      temp = weightsv (bro (son (e)), el);
601
      temp = weightsv(bro(son(e)), el);
584
      if (shn == u64hd || shn == s64hd)
602
      if (shn == u64hd || shn == s64hd)
585
	markreg1 (el);
603
	markreg1(el);
586
      return (add_weights (weightsv (son (e), el),
604
      return(add_weights(weightsv(son(e), el),
587
	    try_mc3 (bro (son (e)), temp, el)
605
	    try_mc3(bro(son(e)), temp, el)
588
	  )
606
	 )
589
	);
607
	);
590
      };
608
      };
591
    case proc_tag:
609
    case proc_tag:
592
    case general_proc_tag: {
610
    case general_proc_tag: {
593
	IGNORE weightsv (son (e), (explist *) 0);
611
	IGNORE weightsv(son(e), (explist *)0);
594
	return (zeros);
612
	return(zeros);
595
      };
613
      };
596
    case movecont_tag:
614
    case movecont_tag:
597
      if (isnooverlap(e))
615
      if (isnooverlap(e))
598
        return (add_weights (add_wlist (son (e), 0, el), moveregs));
616
        return(add_weights(add_wlist(son(e), 0, el), moveregs));
599
      else {
617
      else {
600
        markcall(el);
618
        markcall(el);
601
        return (add_wlist (son (e), 0, el));
619
        return(add_wlist(son(e), 0, el));
602
      };
620
      };
603
    case val_tag:
621
    case val_tag:
604
    case real_tag:
622
    case real_tag:
605
    case env_offset_tag:
623
    case env_offset_tag:
606
      return (zeros);
624
      return(zeros);
607
 
625
 
608
    case test_tag:
626
    case test_tag:
609
     {weights wlarg;
627
     {weights wlarg;
610
      if (name(sh(son(e))) == s64hd || name(sh(son(e))) == u64hd)
628
      if (name(sh(son(e))) == s64hd || name(sh(son(e))) == u64hd)
611
	markreg1 (el);				/* use of reg0 can include reg1 */
629
	markreg1 (el);				/* use of reg0 can include reg1 */
612
      wlarg = add_wlist (son (e), 0, el);
630
      wlarg = add_wlist(son(e), 0, el);
613
      return (wlarg);
631
      return(wlarg);
614
     };
632
     };
615
    case prof_tag:
633
    case prof_tag:
616
      scale = no(e);
634
      scale = no(e);
617
      return zeros;
635
      return zeros;
618
 
636
 
619
    case alloca_tag:
637
    case alloca_tag:
620
     {if (checkalloc(e))
638
     {if (checkalloc(e))
621
	markreg1 (el);
639
	markreg1(el);
622
      return (add_wlist (son (e), 0, el));
640
      return(add_wlist(son(e), 0, el));
623
     };
641
     };
624
 
642
 
625
    default:
643
    default:
626
      if (sh(e) != nilexp &&
644
      if (sh(e)!= nilexp &&
627
		(name(sh(e)) == s64hd || name(sh(e)) == u64hd))
645
		(name(sh(e)) == s64hd || name(sh(e)) == u64hd))
628
	markreg1 (el);				/* use of reg0 can include reg1 */
646
	markreg1 (el);				/* use of reg0 can include reg1 */
629
      return (add_wlist (son (e), 1, el));
647
      return(add_wlist(son(e), 1, el));
630
  };
648
  };
631
}
649
}
632
 
650
 
633
void comp_weights
651
void comp_weights
634
    PROTO_N ( (e) )
-
 
635
    PROTO_T ( exp e )
652
(exp e)
636
{
653
{
637
  scale = 1.0;
654
  scale = 1.0;
638
  IGNORE weightsv (e, (explist *) 0);
655
  IGNORE weightsv(e,(explist *)0);
639
  return;
656
  return;
640
}
657
}