Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
2
    Copyright (c) 1993 Open Software Foundation, Inc.
3
 
4
 
5
    All Rights Reserved
6
 
7
 
8
    Permission to use, copy, modify, and distribute this software
9
    and its documentation for any purpose and without fee is hereby
10
    granted, provided that the above copyright notice appears in all
11
    copies and that both the copyright notice and this permission
12
    notice appear in supporting documentation.
13
 
14
 
15
    OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING
16
    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
17
    PARTICULAR PURPOSE.
18
 
19
 
20
    IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR
21
    CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
22
    LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,
23
    NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
24
    WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
25
*/
26
 
27
/*
28
    		 Crown Copyright (c) 1997
29
 
30
    This TenDRA(r) Computer Program is subject to Copyright
31
    owned by the United Kingdom Secretary of State for Defence
32
    acting through the Defence Evaluation and Research Agency
33
    (DERA).  It is made available to Recipients with a
34
    royalty-free licence for its use, reproduction, transfer
35
    to other parties and amendment for any purpose not excluding
36
    product development provided that any such use et cetera
37
    shall be deemed to be acceptance of the following conditions:-
38
 
39
        (1) Its Recipients shall ensure that this Notice is
40
        reproduced upon any copies or amended versions of it;
41
 
42
        (2) Any amended version of it shall be clearly marked to
43
        show both the nature of and the organisation responsible
44
        for the relevant amendment or amendments;
45
 
46
        (3) Its onward transfer from a recipient to another
47
        party shall be deemed to be that party's acceptance of
48
        these conditions;
49
 
50
        (4) DERA gives no warranty or assurance as to its
51
        quality or suitability for any purpose and DERA accepts
52
        no liability whatsoever in relation to any use to which
53
        it may be put.
54
*/
55
 
56
 
57
 
58
/**********************************************************************
59
$Author: release $
60
$Date: 1998/02/04 15:48:56 $
61
$Revision: 1.2 $
62
$Log: makecode.c,v $
63
 * Revision 1.2  1998/02/04  15:48:56  release
64
 * Added OSF copyright message.
65
 *
66
 * Revision 1.1.1.1  1998/01/17  15:55:57  release
67
 * First version to be checked into rolling release.
68
 *
69
 * Revision 1.5  1996/11/18  15:50:18  pwe
70
 * correct alias with bitfields, and case odds
71
 *
72
 * Revision 1.4  1996/10/15  15:59:19  pwe
73
 * local_alloc_check with unused result
74
 *
75
 * Revision 1.3  1996/10/14  17:31:51  pwe
76
 * include called callees in env_size
77
 *
78
 * Revision 1.2  1996/10/04  16:02:16  pwe
79
 * add banners and mod for PWE ownership
80
 *
81
**********************************************************************/
82
 
83
 
84
#include "config.h"
85
#include "memtdf.h"
86
#include "codegen.h"
87
#include "geninst.h"
88
 
89
#include "myassert.h"
90
#include "maxminmacs.h"
91
#include "comment.h"
92
#include "muldvrem.h"
93
#include "proc.h"
94
#include "flags.h"
95
#include "translat.h"
96
#include "eval.h"
97
 
98
#include "makecode.h"
99
#include "frames.h"
100
#include "stack.h"
101
#include "label_ops.h"
102
#include "instruct.h"
103
#include "installglob.h"
104
#include "externs.h"
105
#include "tempdecs.h"
106
#include "diag_fns.h"
107
#include "oprators.h"
108
#include "record_bit.h"
109
#include "mask.h"
110
#include "error.h"
111
#include "f64.h"
112
#ifdef DEBUG_POWERTRANS
113
#include "pp.h"
114
#endif
115
bool cr0_set;
116
 
117
where nowhere;	/* no particular destination, init in translat.c */
118
 
119
/* Function declarations */
120
void move_dlts PROTO_S ((int,int,int,int));/* Used by movecont_tag */
121
void move_dgts PROTO_S ((int,int,int,int));/* Used by movecont_tag */
122
int regfrmdest PROTO_S ((where *,space));
123
freg fregfrmdest PROTO_S ((bool,where *,space));
124
 
125
static int get_next_mlv_number PROTO_S ((void));
126
void adjust_to_size PROTO_S ((int,int,int,int,int));
127
 
128
 
129
 
130
/* branch table, branch code to instruction */
131
 
132
 
133
static Instruction_P branch_tab[] ={
134
  &INSTRUCTION_I_NIL,  /* not used */
135
  &INSTRUCTION_i_ble,  /* 1 */
136
  &INSTRUCTION_i_blt,  /* 2 */
137
  &INSTRUCTION_i_bge,  /* 3 */
138
  &INSTRUCTION_i_bgt,  /* 4 */
139
  &INSTRUCTION_i_bne,  /* 5 */
140
  &INSTRUCTION_i_beq   /* 6 */
141
};
142
 
143
 
144
#define branches(i)	(branch_tab[i])
145
 
146
 
147
						    /*  1  2  3  4  5  6 */
148
/* used to invert TDF tests */			    /* le lt ge gt ne eq */
149
prop notbranch[] = 
150
{
151
  0,				/* NOT USED */
152
  4,				/* opposite of le is gt */
153
  3,				/* opposite of lt is ge */
154
  2,				/* opposite of ge is lt */
155
  1,				/* opposite of gt is le */
156
  6,				/* opposite of ne is eq */
157
  5				/* opposite of eq is ne */
158
};
159
						    /*  1  2  3  4  5  6 */
160
/* used to change TDF test when args commuted */    /* le lt ge gt ne eq */
161
prop combranch[] = 
162
{ 
163
  0,				/* NOT USED */
164
  3,				/* reverse of le is ge */
165
  4,				/* reverse of lt is gt */
166
  1,				/* reverse of ge is le */
167
  2,				/* reverse of gt is lt */
168
  5,				/* reverse of ne is ne */
169
  6				/* reverse of eq is eq */
170
};
171
 
172
 
173
static void testsigned PROTO_N ((r,lower,upper,lab)) PROTO_T (int r X long lower X long upper X long lab)
174
{
175
  int creg1=next_creg();
176
  int creg2=next_creg();
177
  cmp_ri_ins(i_cmp,r,lower,creg1);
178
  bc_ins(i_blt,creg1,lab,UNLIKELY_TO_JUMP);
179
  cmp_ri_ins(i_cmp,r,upper,creg2);
180
  bc_ins(i_bgt,creg2,lab,UNLIKELY_TO_JUMP);
181
  return;
182
}
183
static void testusigned PROTO_N ((r,maxval,lab)) PROTO_T (int r X long maxval X long lab)
184
{
185
  int creg=next_creg();
186
  cmp_ri_ins(i_cmpl,r,maxval,creg);
187
  bc_ins(i_bgt,creg,lab,UNLIKELY_TO_JUMP);
188
  return;
189
}
190
 
191
 
192
/* find the last test in sequence e which is a branch to second, if any, otherwise nil */
193
static exp testlast PROTO_N ((e,second)) PROTO_T (exp e X exp second)
194
{
195
  if (name(e) == test_tag && pt(e) == second)
196
  {
197
    return (e);
198
  }
199
  if (name(e) == seq_tag)
200
  {
201
 
202
    if (name(bro(son(e))) == test_tag && pt(bro(son(e))) == second)
203
    {
204
      /* is the last one of the sequence a test_tag pointing to second */
205
      return bro(son(e));
206
    }
207
    else if (name(bro(son(e))) == top_tag)
208
    {
209
      exp list = son(son(e));
210
      /* find the penultimate exp of the seq_tag */
211
      for (;;)
212
      {
213
	if (last(list))
214
	{
215
	  if (name(list) == test_tag && pt(list) == second)
216
	  {
217
	    return list;
218
	  }
219
	  else
220
	  {
221
	    return 0;
222
	  }
223
	}
224
	else
225
	{
226
	  list = bro(list);
227
	}
228
      }
229
    }
230
  }
231
  return 0;
232
}
233
 
234
 
235
 
236
/* Does e, or components of e contain a bitfield? */
237
/* +++ should detect this earlier and record in props(e) once-and-for-all */
238
static int has_bitfield PROTO_N ((e)) PROTO_T (exp e)
239
{
240
  if (e == nilexp)
241
    return 0;
242
 
243
  switch (name(e))
244
  {
245
  case compound_tag:
246
    {
247
 
248
      /*
249
       * (compound_tag <offset> <initialiser> ... )
250
       */
251
      /* look at alignment of initialisers */
252
      e = bro(son(e));
253
      while (1)
254
      {
255
	if (has_bitfield(e))
256
	  return 1;		/* found bitfield */
257
 
258
	if (last(e))
259
	  return 0;		/* all done, no bitfield */
260
 
261
	e = bro(bro(e));	/* try next initialiser */
262
      }
263
      /*NOTREACHED*/
264
  default:
265
      {
266
	shape s = sh(e);
267
 
268
	FULLCOMMENT4("has_bitfield: compound field sz=%d als=%d,%d,%d",
269
		shape_size(s), shape_align(s), al1(s), al2(s));
270
	return shape_size(s) != 0 && (shape_align(s) == 1 || al1(s) == 1 || al2(s) == 1);
271
      }
272
    }
273
  }
274
  /*NOTREACHED*/
275
}
276
 
277
 
278
/* Convert all NON-bitfields from byte-offsets back to bit-offsets, so
279
 * the compound can be output correctly by eval().
280
 * Permanently undoes the needscan.c:scan() case val_tag:.
281
 *
282
 * NB must do this EXACTLY ONCE.
283
 */
284
static void fix_nonbitfield PROTO_N ((e)) PROTO_T (exp e)
285
{
286
  if (name(e) == compound_tag)
287
  {
288
    e = son(e);
289
    while (1)
290
    {
291
      if (name(e) == val_tag && name(sh(e)) == offsethd && al2(sh(e)) >= 8)
292
	  no(e) = no(e) << 3;	/* fix it */
293
 
294
      fix_nonbitfield(bro(e));	/* recursively fix the rest of the struct */
295
 
296
      if (last(bro(e)))
297
	  return;		/* all done */
298
 
299
      e = bro(bro(e));		/* next offset */
300
    }
301
  }
302
  /*NOTREACHED*/
303
}
304
 
305
 
306
 
307
/*
308
 * Some functions to build and maintain a queue of conditional branch
309
 * instuctions, so the generation of these instructions can be delayed.
310
 * This is so the compare instruction will not immediately follow
311
 * compare, thus reducing RS/6000 compare..branch delays.
312
 * No side effecting instructions should be emitted while
313
 * branches are queued.  Currently only used with case_tag.
314
 */
315
 
316
/* params of bc_ins() */
317
typedef struct
318
{
319
  Instruction_P branch;	
320
  int	creg;
321
  int	lab;
322
} bc_info;
323
 
324
 
325
 
326
#define	NQUEUE			3	/* any number < nmumber
327
					 * next_creg() manages (0,1,6,7) */
328
#if !do_case_transforms
329
static bc_info bqueue[NQUEUE];
330
 
331
static int bqueuepos;		/* next free slot in queue */
332
 
333
 
334
static void clear_branch_queue PROTO_Z ()
335
{
336
  int i;
337
 
338
  bqueuepos = 0;
339
 
340
  for (i = 0; i < NQUEUE; i++)
341
  {
342
    bqueue[i].branch = I_NIL;
343
    bqueue[i].creg = -1;
344
  }
345
}
346
 
347
 
348
static void issue_bc_ins PROTO_N ((i)) PROTO_T (int i)
349
{
350
  ASSERT(i >= 0 && i < NQUEUE);
351
  bc_ins(bqueue[i].branch, bqueue[i].creg, bqueue[i].lab,LIKELY_TO_JUMP);
352
}
353
 
354
 
355
static void queue_bc_ins PROTO_N ((ins,creg,lab)) PROTO_T (Instruction_P ins X int creg X int lab)
356
{
357
  int i;
358
 
359
  COMMENT2("queue_bc_ins(%s,%d,lab)", (int)ins, creg);
360
 
361
#ifdef DO_ASSERT
362
  /* check there is not a queued instruction using same creg (now corrupted) */
363
  for (i = 0; i < NQUEUE; i++)
364
    ASSERT(bqueue[i].creg != creg);
365
#endif
366
 
367
  i = bqueuepos;
368
 
369
  ASSERT(i >= 0 && i < NQUEUE);
370
 
371
  /* if queue full, clear one entry */
372
  if (bqueue[i].branch != I_NIL)
373
    issue_bc_ins(i);
374
 
375
  bqueue[i].branch = ins;
376
  bqueue[i].creg = creg;
377
  bqueue[i].lab = lab;
378
 
379
  bqueuepos++;
380
  if (bqueuepos == NQUEUE)
381
    bqueuepos = 0;		/* roll around to zero */
382
}
383
 
384
static void flush_branch_queue PROTO_Z ()
385
{
386
  int i;
387
 
388
  i = bqueuepos;
389
 
390
  do
391
  {
392
    if (bqueue[i].branch != I_NIL)
393
      issue_bc_ins(i);
394
 
395
    i++;
396
    if (i == NQUEUE)
397
      i = 0;			/* roll around to zero */
398
  } while (i != bqueuepos);
399
 
400
  clear_branch_queue();
401
}
402
#endif
403
 
404
#if do_case_transforms
405
static void case_tag_code PROTO_N ((caseint_reg,e,sp)) PROTO_T (int caseint_reg X exp e X space sp)
406
{
407
 
408
  long u;
409
  long l;
410
  long n;
411
  exp z=bro(son(e));
412
  exp zt=z;
413
  int endlab = new_label();	/* +++ often another jump at endlab */
414
  int veclab = next_data_lab();
415
  char *veclabname;
416
  baseoff zeroveclab;
417
  int mr = getreg(sp.fixed);	/* no need to guardreg(caseint_reg) as mr not
418
				 * used until after lase use of caseint_reg */
419
 
420
  l=no(zt);
421
  while(bro(zt)!=nilexp)
422
  {
423
    zt=bro(zt);
424
  }
425
  u = (son(zt)==nilexp) ? no(zt) : no(son(zt));
426
 
427
 
428
  zeroveclab.offset = 0;
429
  zeroveclab.base = veclab;
430
 
431
  if (l >= 0 && l <= 4)
432
  {
433
    /* between 0 and 4 dummy table entries used to avoid subtract */
434
    rir_ins(i_sl, caseint_reg, 2, mr);
435
    n = 0;
436
  }
437
  else
438
  {
439
    /* subtract to index jump vector */
440
    rir_ins(i_a, caseint_reg,-l, mr);
441
    rir_ins(i_sl, mr, 2, mr);
442
    n = l;
443
  }
444
  /* delayed branch */
445
  set_ins(zeroveclab, R_TMP0);
446
  ld_rr_ins(i_l, mr, R_TMP0, mr);
447
  rrr_ins(i_a, mr, R_TMP0, mr);
448
  mt_ins(i_mtctr, mr);
449
  z_ins(i_bctr);
450
 
451
  /* .toc entry for veclab */
452
  fprintf(as_file, "\t.toc\n");
453
  veclabname = ext_name(veclab);
454
  fprintf(as_file, "T.%s:\t.tc\t%s[TC],%s\n", veclabname, veclabname, veclabname);
455
  fprintf(as_file, "\t.csect\t[PR]\n");
456
 
457
  /* build the jump vector, can be to .text or .data */
458
  fprintf(as_file, "%s:\n", veclabname);
459
  for (;;)
460
  {
461
    for (; no(z) != n; n++)
462
    {
463
      fprintf(as_file, "\t.long\tL.%d-%s\n", endlab, veclabname);
464
    }
465
    u = (son(z) == nilexp) ? n : no(son(z));
466
    for (; u+1 != n; n++)	/* comparison independent of sign */
467
    {
468
	fprintf(as_file, "\t.long\tL.%d-%s\n", no(son(pt(z))), veclabname);
469
      }
470
    if (last(z))
471
    {
472
      break;
473
    }
474
    z = bro(z);
475
  }
476
  set_label(endlab);
477
  return;
478
}
479
 
480
 
481
 
482
#else
483
static void case_tag_code PROTO_N ((caseint_reg,e,sp)) PROTO_T (int caseint_reg X exp e X space sp)
484
{
485
  mm lims;
486
  exp z = bro(son(e));
487
  exp zt = z;
488
  long n;
489
  long l;
490
  long u = 0x80000000;
491
  unsigned long approx_range;	/* max(u-l, 0x7fffffff) avoiding overflow */
492
  bool use_jump_vector;
493
 
494
  ASSERT(name(e) == case_tag);
495
 
496
  /* calculate crude criterion for using jump vector or branches */
497
  l = no(zt);
498
  for (n = 1;; n++)
499
  {
500
    if (u + 1 != no(zt) && son(zt) != nilexp)
501
    {
502
      n++;
503
    }
504
    if (last(zt))
505
    {
506
      u = (son(zt) != nilexp) ? no(son(zt)) : no(zt);
507
      break;
508
    }
509
    if (son(zt) != nilexp)
510
    {
511
      u = no(son(zt));
512
    }
513
    else
514
    {
515
      if (u + 1 == no(zt))
516
	u += 1;
517
    }
518
 
519
    zt = bro(zt);
520
  }
521
 
522
 
523
  /* now l is lowest controlling value, u is highest and n is number of cases */
524
 
525
  if (u - l < 0)
526
    approx_range = 0x7fffffff;	/* u-l overflowed into -ve, use huge */
527
  else
528
    approx_range = ( unsigned long ) ( u - l );
529
 
530
  if (approx_range < 16)
531
  {
532
    /* small jump vector needed, decide on instuctions executed only */
533
#define	MTCR_B_DELAY		4	/* fixed point mtctr..bctr delay */
534
#define	BR_TAKEN_DELAY		3	/* fixed point branch taken delay */
535
    unsigned jump_vector_cnt = ((l >= 0 && l <= 4) ? 8 + MTCR_B_DELAY : 9 + MTCR_B_DELAY);
536
 
537
    unsigned cmp_jmp_step_cnt = 2 + (!IMM_SIZE(l)) + (!IMM_SIZE(u));
538
 
539
    /* cmp & jmp, delay slot filled plus possibly load of large consts */
540
    /* +++ assume default used as often as case, is this good ??? */
541
    unsigned default_weight = 1;/* likelyhood of default against single case */
542
    unsigned total_case_test_chain_cnt =
543
	((((n + 1) * cmp_jmp_step_cnt) * n) / 2) + BR_TAKEN_DELAY;
544
    unsigned default_test_chain_cnt =
545
	(n * cmp_jmp_step_cnt);
546
    unsigned average_test_chain_cnt =
547
	(total_case_test_chain_cnt + (default_test_chain_cnt * default_weight)) / (n + default_weight);
548
 
549
    use_jump_vector = jump_vector_cnt <= average_test_chain_cnt;
550
    FULLCOMMENT2("case_tag small jump vector: jump_vector_cnt=%d average_test_chain_cnt=%d",
551
		 jump_vector_cnt, average_test_chain_cnt);
552
  }
553
  else
554
  {
555
 
556
    /*
557
     * space-time product criterion for jump vector instead of tests and
558
     * branches
559
     */
560
    unsigned long range_factor = approx_range + 9;
561
    unsigned long n_factor = ((unsigned long) n * n) / 2;
562
 
563
    use_jump_vector = range_factor <= n_factor;
564
  }
565
 
566
  COMMENT4("case_tag: n=%d l,u=%d,%d approx_range=%d", n, l, u, approx_range);
567
  if (is_signed(sh(son(e)))) {
568
    ASSERT ( l <= u ) ;
569
  } else {
570
    ASSERT ( (unsigned long) l <= (unsigned long) u ) ;
571
  }
572
  ASSERT(n >= 0);
573
 
574
  if (use_jump_vector)
575
  {
576
    /* use jump vector */
577
    int endlab = new_label();	/* +++ often another jump at endlab */
578
    int veclab = next_data_lab();
579
    char *veclabname;
580
    baseoff zeroveclab;
581
    int creg = next_creg();
582
    int mr = getreg(sp.fixed);	/* no need to guardreg(caseint_reg) as mr not
583
				 * used until after lase use of caseint_reg */
584
 
585
    zeroveclab.offset = 0;
586
    zeroveclab.base = veclab;
587
 
588
    if (l >= 0 && l <= 4)
589
    {
590
      /* between 0 and 4 dummy table entries used to avoid subtract */
591
      cmp_ri_ins(i_cmpl, caseint_reg, u + 1, creg);
592
      /* branch later, to reduce compare..barnch delay */
593
      rir_ins(i_sl, caseint_reg, 2, mr);
594
      n = 0;
595
    }
596
    else
597
    {
598
      /* subtract to index jump vector */
599
      rir_ins(i_a, caseint_reg,-l, mr);
600
      cmp_ri_ins(i_cmpl, mr, u - l + 1, creg);
601
      /* branch later, to reduce compare..branch taken delay */
602
      rir_ins(i_sl, mr, 2, mr);
603
      n = l;
604
    }
605
 
606
    /* delayed branch */
607
    bc_ins(i_bge, creg, endlab,UNLIKELY_TO_JUMP);
608
 
609
    set_ins(zeroveclab, R_TMP0);
610
 
611
    ld_rr_ins(i_l, mr, R_TMP0, mr);
612
    rrr_ins(i_a, mr, R_TMP0, mr);
613
 
614
    mt_ins(i_mtctr, mr);
615
    z_ins(i_bctr);
616
 
617
    /* .toc entry for veclab */
618
    fprintf(as_file, "\t.toc\n");
619
    veclabname = ext_name(veclab);
620
    fprintf(as_file, "T.%s:\t.tc\t%s[TC],%s\n", veclabname, veclabname, veclabname);
621
    fprintf(as_file, "\t.csect\t[PR]\n");
622
 
623
    /* build the jump vector, can be to .text or .data */
624
    fprintf(as_file, "%s:\n", veclabname);
625
    for (;;)
626
    {
627
      for (; no(z) != n; n++)
628
      {
629
	fprintf(as_file, "\t.long\tL.%d-%s\n", endlab, veclabname);
630
      }
631
      u = (son(z) == nilexp) ? n : no(son(z));
632
      for (; u+1 != n; n++)
633
      {
634
	fprintf(as_file, "\t.long\tL.%d-%s\n", no(son(pt(z))), veclabname);
635
      }
636
      if (last(z))
637
	break;
638
      z = bro(z);
639
    }
640
 
641
    set_label(endlab);
642
    return;
643
  }
644
  else
645
  if (is_signed(sh(son(e)))) {
646
    /* use branches - tests are ordered */
647
    int endlab = 0;
648
    lims = maxmin(sh(son(e)));
649
    clear_branch_queue();
650
 
651
    for (;;)
652
    {
653
      int lab = no(son(pt(z)));
654
      int creg = next_creg();
655
 
656
      long l = no(z);
657
      if (son(z) == nilexp)
658
      {
659
	/* only single test required */
660
	cmp_ri_ins(i_cmp, caseint_reg, l, creg);
661
	queue_bc_ins(i_beq, creg, lab);
662
	if (l == lims.maxi)
663
	  lims.maxi -= 1;
664
	else if (l == lims.mini)
665
	  lims.mini += 1;
666
      }
667
      else if (u = no(son(z)), l > lims.mini)
668
      {
669
	if (u >= lims.maxi)
670
	{
671
	  /* have already tested lower */
672
	  cmp_ri_ins(i_cmp, caseint_reg, l, creg);
673
	  queue_bc_ins(i_bge, creg, lab);
674
	  lims.maxi = l - 1;
675
	}
676
	else
677
	{
678
	  int creg2;
679
 
680
	  if (endlab == 0)
681
	    endlab = new_label();
682
 
683
	  cmp_ri_ins(i_cmp, caseint_reg, l, creg);
684
	  queue_bc_ins(i_blt, creg, endlab);
685
 
686
	  /*
687
	   * Note, must queue first bc_ins before second cmp_ins,
688
	   * which may use a creg already in the queue.
689
	   */
690
	  creg2 = next_creg();
691
	  cmp_ri_ins(i_cmp, caseint_reg, u, creg2);
692
	  queue_bc_ins(i_ble, creg2, lab);
693
 
694
	  lims.mini = u + 1;
695
	}
696
      }
697
      else if (u < lims.maxi)
698
      {
699
	/* lower is <= lower limit of shape */
700
	cmp_ri_ins(i_cmp, caseint_reg, u, creg);
701
	queue_bc_ins(i_ble, creg, lab);
702
	lims.mini = u + 1;
703
      }
704
      else
705
      {
706
	/* upper is >= upper limit of shape */
707
	flush_branch_queue();
708
	uncond_ins(i_b, lab);
709
      }
710
      if (last(z))
711
      {
712
	flush_branch_queue();
713
	if (endlab != 0)
714
	{
715
	  set_label(endlab);
716
	}
717
	return;
718
      }
719
      z = bro(z);
720
    }
721
  }
722
  else {
723
    /* unsigned, use branches - tests are ordered */
724
    int endlab = 0;
725
    unsigned long maxi;
726
    unsigned long mini;
727
    lims = maxmin(sh(son(e)));
728
    maxi = (unsigned)lims.maxi;
729
    mini = (unsigned)lims.mini;
730
    clear_branch_queue();
731
 
732
    for (;;)
733
    {
734
      int lab = no(son(pt(z)));
735
      int creg = next_creg();
736
 
737
      unsigned long l = no(z);
738
      if (son(z) == nilexp)
739
      {
740
	/* only single test required */
741
	cmp_ri_ins(i_cmpl, caseint_reg, l, creg);
742
	queue_bc_ins(i_beq, creg, lab);
743
	if (l == maxi)
744
	  maxi -= 1;
745
	else if (l == mini)
746
	  mini += 1;
747
      }
748
      else if (u = no(son(z)), l > mini)
749
      {
750
	if (u >= maxi)
751
	{
752
	  /* have already tested lower */
753
	  cmp_ri_ins(i_cmpl, caseint_reg, l, creg);
754
	  queue_bc_ins(i_bge, creg, lab);
755
	  maxi = l - 1;
756
	}
757
	else
758
	{
759
	  int creg2;
760
 
761
	  if (endlab == 0)
762
	    endlab = new_label();
763
 
764
	  cmp_ri_ins(i_cmpl, caseint_reg, l, creg);
765
	  queue_bc_ins(i_blt, creg, endlab);
766
 
767
	  /*
768
	   * Note, must queue first bc_ins before second cmp_ins,
769
	   * which may use a creg already in the queue.
770
	   */
771
	  creg2 = next_creg();
772
	  cmp_ri_ins(i_cmpl, caseint_reg, u, creg2);
773
	  queue_bc_ins(i_ble, creg2, lab);
774
 
775
	  mini = u + 1;
776
	}
777
      }
778
      else if (u < maxi)
779
      {
780
	/* lower is <= lower limit of shape */
781
	cmp_ri_ins(i_cmpl, caseint_reg, u, creg);
782
	queue_bc_ins(i_ble, creg, lab);
783
	mini = u + 1;
784
      }
785
      else
786
      {
787
	/* upper is >= upper limit of shape */
788
	flush_branch_queue();
789
	uncond_ins(i_b, lab);
790
      }
791
      if (last(z))
792
      {
793
	flush_branch_queue();
794
	if (endlab != 0)
795
	{
796
	  set_label(endlab);
797
	}
798
	return;
799
      }
800
      z = bro(z);
801
    }
802
  }
803
}
804
#endif
805
 
806
/*
807
 * Evaluate and generate the compare instruction for a test_tag,
808
 * and return a bcinfo describing the conditional branch required.
809
 */
810
static bc_info make_test_tag_cmp PROTO_N ((e,sp)) PROTO_T (exp e X space sp)
811
{
812
  exp l = son(e);
813
  exp r = bro(l);
814
  shape shl = sh(l);
815
  bc_info bcinfo;
816
 
817
  bcinfo.lab = (ptno(e) < 0) ? -ptno(e) : no(son(pt(e)));
818
					/* see frig in cond_tag */
819
  /* generate compare */
820
  if (is_floating(name(sh(l))))
821
  {
822
    /* float test */
823
    int a1;
824
    int a2;
825
    space nsp;
826
 
827
    if (IsRev(e))
828
    {
829
      a2 = freg_operand(r, sp, getfreg(sp.flt));
830
      nsp = guardfreg(a2, sp);
831
      a1 = freg_operand(l, nsp, getfreg(nsp.flt));
832
    }
833
    else
834
    {
835
      a1 = freg_operand(l, sp, getfreg(sp.flt));
836
      nsp = guardfreg(a1, sp);
837
      a2 = freg_operand(r, nsp, getfreg(nsp.flt));
838
    }
839
 
840
    bcinfo.creg = next_creg();
841
    rrf_cmp_ins(i_fcmpo, a1, a2, bcinfo.creg);
842
  }
843
  else
844
  {
845
    /* int test */
846
    bool sgned = is_signed(shl);
847
    int a1;
848
    int a2;
849
    Instruction_P cmp;
850
 
851
    cmp = sgned ? i_cmp : i_cmpl;
852
 
853
    cr0_set = 0;
854
    /* cr0_set is needed since l could be tracked by reg tracking and there
855
       fore not coded. In this case cr0_set should remain 0 */
856
    a1 = reg_operand(l, sp);
857
    if (record_bit_set(l) && cr0_set==1)
858
    {
859
      bcinfo.creg = 0;
860
      /* no need to generate the compare */
861
    }
862
    else
863
    {
864
      if (name(r) == val_tag)
865
      {
866
	bcinfo.creg = next_creg();
867
	cmp_ri_ins(cmp, a1, no(r), bcinfo.creg);
868
      }
869
      else
870
      {
871
	space nsp;
872
	nsp = guardreg(a1, sp);
873
	a2 = reg_operand(r, nsp);
874
	bcinfo.creg = next_creg();
875
	cmp_rr_ins(cmp, a1, a2, bcinfo.creg);
876
      }
877
    }
878
  }
879
  cr0_set = 0;
880
  bcinfo.branch = branches(test_number(e));
881
  return bcinfo;
882
}
883
 
884
/*
885
 * Produce code for expression e, putting its result in dest using t-regs
886
 * given by sp. If non-zero, exitlab is the label of where the code is to
887
 * continue.
888
 */
889
makeans make_code PROTO_N ((e,sp,dest,exitlab)) PROTO_T (exp e X space sp X where dest X int exitlab)
890
{
891
  long constval=0;
892
  makeans mka;
893
  static long exp_num = 0;  /* count of exps in order of evaluation */
894
 
895
  /*
896
   * A heuristic to estimate if conditional branch is close enough for
897
   * bc instruction, which can branch +-8k words.  Tests indicate
898
   * 13500 exp nodes generate 8k words of instructions.
899
   * We play safe and allow 1 instruction per exp.
900
   */
901
#define TEST_TAG_NEAR_BRANCH(e)	(ptno(e) < 0 || absval(ptno(son(pt(e)))-exp_num) < 8192)
902
 
903
 tailrecurse:
904
  exp_num++;
905
  mka.lab = exitlab;
906
  mka.regmove = NOREG;
907
 
908
  switch (name(e))
909
  {
910
  /*
911
   * Procedure related code selection is handled by make_XXX_tag_code()
912
   * functions in proc.c.
913
   */
914
   case proc_tag:		/* procedure definition */
915
   case general_proc_tag:
916
    {
917
      exp_num = 0;
918
      make_proc_tag_code(e, sp);
919
      return mka;
920
    }
921
/*****************************************************************************/
922
   case ident_tag:		/* ident/param definition within proc */
923
    {
924
      return make_ident_tag_code(e, sp, dest, exitlab);
925
    }
926
/*****************************************************************************/
927
   case untidy_return_tag:
928
   case res_tag:			/* procedure result */
929
    {
930
      make_res_tag_code(e, sp);
931
      return mka;
932
    }
933
/*****************************************************************************/
934
   case apply_tag:		/* procedure call */
935
    {
936
      return make_apply_tag_code(e, sp, dest, exitlab);
937
    }
938
/*****************************************************************************/
939
   case clear_tag:
940
    {
941
      if (dest.answhere.discrim == insomereg)
942
      {
943
	/*
944
	 * Must choose a fixed register to contain answer to clear
945
	 */
946
	int *sr = someregalt(dest.answhere);
947
 
948
	if (*sr != -1){fail("somereg *2");}
949
	*sr = getreg(sp.fixed);
950
	setregalt(dest.answhere, *sr);
951
      }
952
      else if(dest.answhere.discrim==insomefreg)
953
      {
954
	/*
955
	 * Must choose a float register to contain answer to clear
956
	 */
957
	somefreg sfr;
958
	freg fr;
959
 
960
	sfr = somefregalt(dest.answhere);
961
	if (*sfr.fr != -1){fail("somefreg *2");}
962
	*sfr.fr = getfreg(sp.flt);
963
	fr.fr = *sfr.fr;
964
	fr.dble = sfr.dble;
965
	setfregalt(dest.answhere, fr);
966
      }
967
 
968
      return mka;
969
    }
970
/*****************************************************************************/
971
   case seq_tag:
972
    {
973
      exp t = son(son(e));
974
 
975
      for (;;)
976
      {
977
	exp next = (last(t)) ? (bro(son(e))) : bro(t);
978
 
979
	if (name(next) == goto_tag)	/* gotos end sequences */
980
	{
981
	  make_code(t, sp, nowhere, no(son(pt(next))));
982
	}
983
	else
984
	{
985
	  code_here(t, sp, nowhere);
986
	}
987
	if (last(t))
988
	{
989
	  exp l = bro(son(e));		/* last exp of sequence */
990
 
991
	  if (name(sh(t)) == bothd && name(l) == res_tag &&
992
	      (name(son(l)) == clear_tag || name(son(l)) == top_tag))
993
	  {
994
	    /*
995
	     * res_tag that cannot be reached.  Eg an extra one inserted at
996
	     * end of proc.  Skip it.
997
	     */
998
	     COMMENT("make_code seq_tag: unreachable res_tag");
999
	     return mka;
1000
	  }
1001
	  else
1002
	  {
1003
	    return make_code(l, sp, dest, exitlab);
1004
	  }
1005
	}
1006
	t = bro(t);
1007
      }
1008
    }				/* end seq */
1009
/*****************************************************************************/
1010
   case cond_tag:
1011
    {
1012
      exp first = son(e);
1013
      exp second = bro(son(e));
1014
      exp test;
1015
 
1016
      if (dest.answhere.discrim==insomereg)
1017
      {
1018
	/*
1019
	 * Must choose a fixed register to contain answer to cond 
1020
	 */
1021
	int *sr = someregalt(dest.answhere);
1022
 
1023
	if (*sr != -1){fail("somereg *2");}
1024
	*sr = getreg(sp.fixed);
1025
	setregalt(dest.answhere, *sr);
1026
      }
1027
      else if (dest.answhere.discrim==insomefreg)
1028
      {
1029
	/*
1030
	 * Must choose a float register to contain answer to cond 
1031
	 */
1032
	somefreg sfr;
1033
	freg fr;
1034
 
1035
	sfr = somefregalt(dest.answhere);
1036
	if (*sfr.fr != -1){fail("somefreg *2");}
1037
	*sfr.fr = getfreg(sp.flt);
1038
	fr.fr = *sfr.fr;
1039
	fr.dble = sfr.dble;
1040
	setfregalt(dest.answhere, fr);
1041
      }
1042
 
1043
      /* 
1044
       * A few optimisations for cond_tag 
1045
       */
1046
      if (name(first) == goto_tag && pt(first) == second)
1047
      {
1048
	/* first is goto second */
1049
	no(son(second)) = 0;
1050
	return make_code(second, sp, dest, exitlab);
1051
      }
1052
#if 0 /* could we do this better to prevent long branch problem?*/
1053
      else if (name(second) == labst_tag && name(bro(son(second))) == top_tag)
1054
      {
1055
	/* second is empty */
1056
 
1057
	int endl = (exitlab == 0) ? new_label() : exitlab;
1058
 
1059
	no(son(second)) = endl;
1060
	make_code(first, sp, dest, endl);
1061
	mka.lab = endl;
1062
	return mka;
1063
      }
1064
#endif
1065
      else if (name(second) == labst_tag && name(bro(son(second))) == goto_tag)
1066
      {
1067
	/* second is goto */
1068
	exp g = bro(son(second));
1069
 
1070
	no(son(second)) = no(son(pt(g)));
1071
	return make_code(first, sp, dest, exitlab);
1072
      }
1073
 
1074
      test = testlast(first, second);
1075
      if (test != nilexp && TEST_TAG_NEAR_BRANCH(test))
1076
      {
1077
	/* effectively an empty then part */
1078
	int l = (exitlab != 0) ? exitlab : new_label();
1079
 
1080
	ptno(test) = -l;	/* make test jump to exitlab - see test_tag: */
1081
	settest_number(test,obranch(test_number(test)));
1082
	/* settest_number preserves the Rev bit */
1083
	no(son(second)) = new_label();
1084
	make_code(first, sp, dest, l);
1085
	make_code(second, sp, dest, l);
1086
	mka.lab = l;
1087
	return mka;
1088
      }
1089
      else
1090
      {
1091
	int fl;
1092
	int l;
1093
 
1094
	no(son(second)) = new_label();
1095
	fl = make_code(first, sp, dest, exitlab).lab;
1096
	l = (fl != 0) ? fl : ((exitlab != 0) ? exitlab : new_label());
1097
	if (name(sh(first)) != bothd)
1098
	{
1099
	  uncond_ins(i_b, l);
1100
	}
1101
	make_code(second, sp, dest, l);
1102
	clear_all();
1103
	mka.lab = l;
1104
	return mka;
1105
      }
1106
    }	
1107
/*****************************************************************************/
1108
   case labst_tag:
1109
    {
1110
      ptno(son(e)) = exp_num;	/* update estimate made in scan() */
1111
      if (no(son(e)) != 0)
1112
      {
1113
	clear_all();
1114
	set_label(no(son(e)));
1115
 
1116
	if (is_loaded_lv(e) && p_save_all_sregs)
1117
	{
1118
	  /* It is long jumpabble to (potentially)*/
1119
	  if(p_has_tp)
1120
	  {
1121
	    /* restore tp */
1122
	    baseoff saved_tp;
1123
	    saved_tp.base = R_FP;
1124
	    saved_tp.offset = 0;
1125
	    ld_ro_ins(i_l,saved_tp,R_TP);comment("restore TP using FP");
1126
	  }
1127
	  if (p_has_saved_sp)
1128
	  {
1129
	    /* Variable frame size */
1130
	    get_sp_from_stack();
1131
	  }
1132
	  else 
1133
	  {
1134
	    /* Fixed frame size */
1135
	    rir_ins(i_a,R_FP, - p_frame_size , R_SP);
1136
	  }
1137
	}
1138
 
1139
      }
1140
      return make_code(bro(son(e)), sp, dest, exitlab);
1141
    }				/* end labst */
1142
/*****************************************************************************/
1143
  case rep_tag:
1144
    {
1145
      exp first = son(e);
1146
      exp second = bro(first);
1147
 
1148
      code_here(first,sp,nowhere);
1149
      ASSERT(name(second)==labst_tag);
1150
      no(son(second)) = new_label();
1151
#if 1
1152
      if (architecture != POWERPC_CODE)
1153
      {
1154
	exp last_test;      
1155
	/*
1156
	 * Rearrange test and branch instructions
1157
	 * to reduce RS/6000 branch delays 
1158
	 */
1159
	/* look for last test_tag of repeat exp */
1160
	last_test = bro(son(second));	/* under labst_tag */
1161
	/* dive down sequences */
1162
	while (name(last_test) == seq_tag)
1163
	{
1164
	  last_test = bro(son(last_test));
1165
	}
1166
 
1167
 
1168
	if (!diagnose && name(last_test) == test_tag)
1169
	{
1170
	  /* we found a test_tag, is it simple and jumps to rep_tag? */
1171
 
1172
	  if (ptno(last_test) >= 0 && pt(last_test) == second 
1173
	      && TEST_TAG_NEAR_BRANCH(last_test))
1174
	  {
1175
	    /*
1176
	     * It jumps to head of repeat.  Generate code out of
1177
	     * order to reduce RS/6000 branch delays.  RS/6000
1178
	     * assumes fall-through conditional branches are
1179
	     * most common and speculatively executes non-branch
1180
	     * instructions ahaead.  Rearrange as follows:
1181
	     *
1182
	     *		b	start_of_rep_lab
1183
	     *	end_rep_test_lab:
1184
	     *		<reversed test_tag conditonal branch to end_rep_lab>
1185
	     *	start_of_rep_lab:
1186
	     #		<rest of rep>
1187
	     *		<reversed test_tag conditonal test>
1188
	     *		b	end_rep_test_lab
1189
	     *	end_rep_lab:
1190
	     */
1191
	    static int rep_org_labnos = 0;
1192
	    int rep_org_lab = 0;
1193
	    int end_rep_test_lab = new_label();
1194
	    int start_of_rep_lab = no(son(second));	/* labst_tag label */
1195
	    int end_rep_lab = (exitlab == 0) ? new_label() : exitlab;
1196
	    bc_info bcinfo;
1197
 
1198
	    COMMENT("make_code rep_tag: last exp is rep_tag test_tag - evaluate out of order");
1199
 
1200
	    /* labst_tag label should be in use */
1201
	    ASSERT(start_of_rep_lab!=0);
1202
 
1203
	    /* allocate new label number for use with .org: L.R%d and L.S%d */
1204
	    rep_org_lab = ++rep_org_labnos;
1205
 
1206
	    uncond_ins(i_b, start_of_rep_lab);
1207
 
1208
	    set_label(end_rep_test_lab);
1209
 
1210
	    /* use .org to leave gap for brought forward bc ins */
1211
	    fprintf(as_file, "L.R%d:\n", rep_org_lab);
1212
	    fprintf(as_file, "\t.org\t$+4\t# loop bc ins\n");
1213
 
1214
	    /* we will do test_tag ourselves, nuke it out of loop */
1215
	    name(last_test) = top_tag;
1216
 
1217
	    /* set_label(start_of_rep_lab) done by labst_tag */
1218
 
1219
	    mka = make_code(second, sp, dest, exitlab);
1220
 
1221
	    /* reverse test, jump to end_rep_lab */
1222
	    ptno(last_test) = -end_rep_lab;
1223
	    settest_number(last_test,obranch(test_number(last_test)));
1224
	    /* generate compare */
1225
	    bcinfo = make_test_tag_cmp(last_test, sp);
1226
 
1227
	    uncond_ins(i_b, end_rep_test_lab);
1228
 
1229
	    if (end_rep_lab != exitlab)
1230
	      set_label(end_rep_lab);
1231
 
1232
	    /* fill in gap above with bc_ins */
1233
	    fprintf(as_file, "L.S%d:\n", rep_org_lab);
1234
	    fprintf(as_file, ".org\tL.R%d\t# loop bc ins\n", rep_org_lab);
1235
	    bc_ins(bcinfo.branch, bcinfo.creg, bcinfo.lab,UNLIKELY_TO_JUMP);
1236
 
1237
	    /* .org back */
1238
	    fprintf(as_file, ".org\tL.S%d\n", rep_org_lab);
1239
 
1240
	    return mka;
1241
	  }
1242
 
1243
	}
1244
      }
1245
#endif 
1246
      /*
1247
       * We could not find last simple test_tag, must be complicated.
1248
       * Don't bother to move tests around.
1249
       * +++ handle cond_tag for more complex terminating condition.
1250
       */
1251
      return make_code(second, sp, dest, exitlab);
1252
    }				/* end rep */
1253
/*****************************************************************************/
1254
  case goto_tag:
1255
    {
1256
      exp gotodest = pt(e);
1257
      int lab;
1258
#if 0 
1259
/* This would be a lovely optimisation, however silly people give me test
1260
   programs with L1:goto L1 so I despair */
1261
      while (name(bro(son(gotodest)))==goto_tag)
1262
      {
1263
	/* goto to goto optimisation */
1264
	gotodest = pt(bro(son(gotodest)));
1265
      }
1266
#endif	    
1267
      lab = no(son(gotodest));
1268
      clear_all();
1269
      if (last(e)==0 || name(bro(e))!=seq_tag || last(bro(e)) ||
1270
	  bro(bro(e)) != gotodest) 
1271
      {
1272
	uncond_ins (i_b, lab);
1273
      }/* otherwise dest is next in sequence */
1274
      return mka;
1275
    }				/* end goto */
1276
/*****************************************************************************/
1277
  case test_tag:
1278
    {
1279
      bc_info bcinfo;
1280
      int branch_prediction=LIKELY_TO_JUMP;
1281
 
1282
      if(no(e)!=1000 && no(e)>=0 && no(e)<=100)
1283
      {
1284
	branch_prediction = (no(e)>=50)?UNLIKELY_TO_JUMP:LIKELY_TO_JUMP;
1285
      }
1286
      try_record_bit(e);
1287
      if (TEST_TAG_NEAR_BRANCH(e))
1288
      {
1289
	/* 
1290
	 * Estimate close enough for bc_ins
1291
	 */
1292
	bcinfo = make_test_tag_cmp(e, sp);
1293
	bc_ins(bcinfo.branch, bcinfo.creg, bcinfo.lab,branch_prediction);
1294
      }
1295
      else
1296
      {
1297
	int newlab = new_label();
1298
	int oldlab = no(son(pt(e)));
1299
 
1300
	/*
1301
	 * Branch is too far away so we reverse branch to new label 
1302
	 * and use an unconditional branch to the target destination
1303
	 */
1304
	ptno(e) = -newlab;
1305
	settest_number(e,obranch(test_number(e)));
1306
	bcinfo = make_test_tag_cmp(e, sp);
1307
	bc_ins(bcinfo.branch, bcinfo.creg, bcinfo.lab,1-branch_prediction);
1308
	uncond_ins(i_b, oldlab);	/* unconditional far jump OK */
1309
	set_label(newlab);
1310
      }
1311
      return mka;
1312
    }				/* end test */
1313
/*****************************************************************************/
1314
   case ass_tag:
1315
   case assvol_tag:
1316
    {
1317
      exp lhs = son(e);
1318
      exp rhs = bro(lhs);
1319
      where assdest;
1320
      space nsp;
1321
      int contreg = NOREG;
1322
      int hdrhs = name(sh(rhs));
1323
      bool is_float = is_floating(hdrhs);
1324
 
1325
      /* +++ lose chvar_tag on rhs if no result, remember to invalidate reg */
1326
      /* +++ remove name(e)==ass_tag tests now assbits_tag has gone */
1327
 
1328
      if (name(e) == assvol_tag)
1329
      {
1330
	/*
1331
	 * Assign to volatile location.
1332
	 * Disable register-location tracing. +++ is this really needed ???
1333
	 * Disable peep-hole optimisation (when implemented)
1334
	 */
1335
	COMMENT("make_code: Assign to volatile");
1336
	clear_all();
1337
      }
1338
 
1339
      if (name(e) == ass_tag && APPLYLIKE(rhs) &&
1340
	  ((is_float) || valregable(sh(rhs))))
1341
      {
1342
	where apply_res;
1343
	/* This is not an optimisation this is necessary */
1344
	/* Since if we have a procedure call doing the locate will make a pointer which
1345
	   will be trashed in the call*/
1346
	if (is_float)
1347
	{
1348
	  freg frg;
1349
	  COMMENT("make_code: ass_tag: apply result special handling:float");
1350
	  frg.fr = FR_RESULT;
1351
	  frg.dble = (hdrhs != shrealhd);
1352
	  setfregalt(apply_res.answhere, frg);
1353
	}
1354
	else
1355
	{
1356
	  COMMENT("make_code: ass_tag: apply result special handling:fixed");
1357
	  setregalt(apply_res.answhere, R_RESULT);
1358
	}
1359
	apply_res.ashwhere = ashof(sh(rhs));
1360
 
1361
	code_here(rhs, sp, apply_res);
1362
	nsp = guard(apply_res, sp);
1363
 
1364
	assdest = locate(lhs, nsp, sh(rhs), 0);
1365
 
1366
	move(apply_res.answhere, assdest, nsp.fixed, 1);
1367
	/* The evaluation of an assignment is the rhs so 
1368
	   we move the rhs to dest as well */
1369
	move(apply_res.answhere, dest, nsp.fixed, 1);
1370
	clear_dep_reg(lhs);
1371
 
1372
#if 0
1373
	/* +++ remember that R_RESULT is lhs */
1374
	if (!is_float)
1375
	{
1376
	  keepcont(lhs,R_RESULT);
1377
	}
1378
#endif
1379
	return mka;
1380
      }
1381
 
1382
#ifndef NO_REGREG_ST
1383
      /* see if we can use [reg+reg] addressing for this store */
1384
      if (name(lhs) == addptr_tag)
1385
      {
1386
	exp addptr_sons = son(lhs);
1387
	ash a;
1388
	int ashsize;
1389
	a = ashof(sh(rhs));
1390
	ashsize = a.ashsize;
1391
 
1392
	if (last(bro(addptr_sons))
1393
	    && a.ashalign == ashsize
1394
	    && (ashsize==8 || ashsize==16 || ashsize==32 || is_float))
1395
	{
1396
	  int lhs_addptr_reg;
1397
	  int rhs_addptr_reg;
1398
	  ans aa;
1399
 
1400
	  COMMENT("make_code ass_tag: store suitable for [reg+reg] addressing");
1401
 
1402
	  lhs_addptr_reg = reg_operand(addptr_sons, sp);
1403
	  nsp = guardreg(lhs_addptr_reg, sp);
1404
	  rhs_addptr_reg = reg_operand(bro(addptr_sons), nsp);
1405
	  nsp = guardreg(rhs_addptr_reg, nsp);
1406
 
1407
	  if (is_float)
1408
	  {
1409
	    freg dfreg;
1410
 
1411
	    dfreg.fr = freg_operand(rhs, nsp, getfreg(nsp.flt));
1412
	    dfreg.dble = ashsize == 64;
1413
 
1414
	    stf_rr_ins((dfreg.dble?i_stfd:i_stfs),dfreg.fr,lhs_addptr_reg,rhs_addptr_reg);
1415
	    setfregalt(aa, dfreg);
1416
	  }
1417
	  else
1418
	  {
1419
	    int assreg;
1420
	    if(dest.answhere.discrim==inreg && 
1421
	       !IS_R_NO_REG(regalt(dest.answhere)))
1422
	    {
1423
	      assreg = regalt(dest.answhere);
1424
	      reg_operand_here(rhs,nsp,assreg);
1425
	    }
1426
	    else
1427
	    {
1428
	      assreg= reg_operand(rhs, nsp);
1429
	    }
1430
	    st_rr_ins(i_st_sz(ashsize), assreg, lhs_addptr_reg, rhs_addptr_reg);
1431
 
1432
	    setregalt(aa, assreg);
1433
	  }
1434
 
1435
	  move(aa, dest, sp.fixed, 1);		/* +++ nsp.fixed ? */
1436
 
1437
	  clear_dep_reg(lhs);
1438
	  return mka;
1439
	}
1440
      }
1441
#endif
1442
 
1443
      assdest = locate(lhs, sp, sh(rhs), 0);
1444
      nsp = guard(assdest, sp);
1445
      FULLCOMMENT("make_code: ass_tag: located lhs");
1446
      if (name(e) == ass_tag
1447
	  && assdest.answhere.discrim == notinreg
1448
	  && assdest.ashwhere.ashsize == assdest.ashwhere.ashalign)
1449
      {
1450
	instore is;
1451
 
1452
	is = insalt(assdest.answhere);
1453
	if (!is.adval)
1454
	{			/* this is an indirect assignment, so make it
1455
				 * direct by loading pointer into reg  (and
1456
				 * remember it) */
1457
	  int r = getreg(nsp.fixed);
1458
 
1459
	  ld_ins(i_l, is.b, r);
1460
	  nsp = guardreg(r, nsp);
1461
	  is.adval = 1;
1462
	  is.b.base = r;
1463
	  is.b.offset = 0;
1464
	  setinsalt(assdest.answhere, is);
1465
	  keepexp(lhs, assdest.answhere);
1466
	}
1467
      }
1468
 
1469
#if 1
1470
      if (name(e) == ass_tag && is_float && assdest.answhere.discrim == notinreg)
1471
      {
1472
	/*
1473
	 * Ensure floating point values assigned using floating point regs so
1474
	 * floating point reg tracking works better. move() uses fixed regs
1475
	 * for mem to mem, so must pre-load to floating point reg.
1476
	 */
1477
	int f = freg_operand(rhs, nsp, getfreg(nsp.flt));
1478
	freg frg;
1479
	ans aa;
1480
 
1481
	frg.fr = f;
1482
	frg.dble = (hdrhs != shrealhd);
1483
	setfregalt(aa, frg);
1484
	nsp = guardfreg(f, nsp);
1485
	move(aa, assdest, nsp.fixed, 1);
1486
	move(aa, dest, nsp.fixed, 1);
1487
	clear_dep_reg(lhs);
1488
	/* +++ frg in mka */
1489
	return mka;
1490
      }
1491
#endif
1492
 
1493
      contreg = code_here(rhs, nsp, assdest);
1494
      /* evaluate source into assignment destination .... */
1495
 
1496
 
1497
      /* ... and move it into dest - could use assignment as value */
1498
 
1499
      switch (assdest.answhere.discrim)
1500
      {
1501
      case inreg:
1502
	{
1503
	  int a = regalt(assdest.answhere);
1504
 
1505
	  keepreg(rhs, a);
1506
	  /* remember that source has been evaluated into a */
1507
	  clear_dep_reg(lhs);
1508
	  /* forget register dependencies on destination */
1509
	  move(assdest.answhere, dest, nsp.fixed, 1);
1510
	  break;
1511
	}
1512
      case infreg:
1513
	{
1514
	  freg frg;
1515
	  int r;
1516
 
1517
	  frg = fregalt(assdest.answhere);
1518
	  r = frg.fr + 32;
1519
	  if (frg.dble)
1520
	  {
1521
	    r = -r;
1522
	  };
1523
	  keepreg(rhs, r);
1524
	  /* remember that source has been evaluated into a */
1525
	  clear_dep_reg(lhs);
1526
	  /* forget register dependencies on destination */
1527
	  move(assdest.answhere, dest, nsp.fixed, 1);
1528
	  break;
1529
	}
1530
 
1531
       case notinreg:
1532
	{
1533
	  if (contreg != NOREG && name(e) == ass_tag)
1534
	  {
1535
	    ans aa;
1536
	    space nnsp;
1537
 
1538
	    if (contreg > 0 && contreg < 31)
1539
	    {
1540
	      setregalt(aa, contreg);
1541
	      nnsp = guardreg(contreg, sp);
1542
	    }
1543
	    else
1544
	    {
1545
	      freg frg;
1546
 
1547
	      frg.fr = absval(contreg) - 32;
1548
	      frg.dble = (contreg < 0);
1549
	      nnsp = nsp;
1550
	      setfregalt(aa, frg);
1551
	    }
1552
	    move(aa, dest, nnsp.fixed, 1);
1553
	    clear_dep_reg(lhs);/* Apply fix here from rw 27/10/94*/
1554
	    /* forget register dependencies on destination */
1555
#if 0
1556
	    if (name(lhs) == name_tag || !dependson(lhs, 0, lhs))
1557
 
1558
	      /*
1559
	       * remember that dest contains source, provided that it is not
1560
	       * dependent on it
1561
	       */
1562
#endif
1563
#if 1
1564
	    if ( name ( lhs ) == name_tag ) {
1565
	      exp dc = son ( lhs ) ;
1566
	      if ( son ( dc ) != nilexp ) dc = son ( dc ) ;
1567
	      if ( shape_size ( sh ( dc ) ) ==
1568
		  shape_size ( sh ( rhs ) ) ) {
1569
		keepcont ( lhs, contreg ) ;
1570
	      }
1571
	    } else if ( !dependson ( lhs, 0, lhs ) )
1572
#endif	
1573
	    {
1574
	      keepcont(lhs, contreg);
1575
	    }
1576
	    return mka;
1577
	  }
1578
	  clear_dep_reg(lhs);
1579
	  /* forget register dependencies on destination */
1580
	  move(assdest.answhere, dest, nsp.fixed, 1);
1581
	  break;
1582
	}
1583
      case insomereg:
1584
	  {
1585
	    clear_dep_reg(lhs);
1586
	    /* forget register dependencies on destination */
1587
	    move(assdest.answhere, dest, guard(assdest, sp).fixed, 1);
1588
	    break;
1589
	  }
1590
      default:
1591
	  fail("make_code: unexpected answhere in assign");
1592
      }				/* end sw on answhere */
1593
 
1594
      return mka;
1595
    }				/* end ass */
1596
/*****************************************************************************/
1597
  case compound_tag:
1598
    {
1599
      exp t;
1600
      space nsp;
1601
      instore str;
1602
      int r;
1603
 
1604
      if (has_bitfield(e))
1605
      {
1606
	/*
1607
	 * Take the easy way out for bitfields, copy a constant.
1608
	 * +++ This only works for C, which does not permit non-const
1609
	 * expressions here.
1610
	 */
1611
	ans aa;
1612
 
1613
	COMMENT("make_code: compound containing bitfield");
1614
 
1615
	/* assume struct is small, set up data constant and move */
1616
 
1617
	fix_nonbitfield(e);		/* ensure all offsets are bit-offsets,
1618
					 * as evaluated_const() expects */
1619
 
1620
	setinsalt(aa, evaluated_const(e));
1621
	mka.regmove = move(aa, dest, sp.fixed, 0);
1622
 
1623
	return mka;
1624
      }
1625
 
1626
      nsp = sp;
1627
      t = son(e);
1628
      switch (dest.answhere.discrim)
1629
      {
1630
      case notinreg:
1631
	{
1632
	  str = insalt(dest.answhere);	/* it should be !! */
1633
	  if (!str.adval)
1634
	  {
1635
	    int r = getreg(sp.fixed);
1636
 
1637
	    nsp = guardreg(r, sp);
1638
	    ld_ins(i_l, str.b, r);
1639
	    str.adval = 1;
1640
	    str.b.base = r;
1641
	    str.b.offset = 0;
1642
	  }
1643
	  for (;;)
1644
	  {
1645
	    where newdest;
1646
	    instore newis;
1647
 
1648
	    newis = str;
1649
	    newis.b.offset += no(t);
1650
 
1651
	    FULLCOMMENT4("make_code compound_tag: name(t)=%d no(t)=%d al2=%d offset=%d",
1652
		name(t), no(t), al2(sh(t)), newis.b.offset);
1653
	    ASSERT(name(t) == val_tag && al2(sh(t)) >= 8);
1654
 
1655
	    setinsalt(newdest.answhere, newis);
1656
	    newdest.ashwhere = ashof(sh(bro(t)));
1657
 
1658
	    code_here(bro(t), nsp, newdest);
1659
 
1660
	    if (last(bro(t)))
1661
	      return mka;
1662
 
1663
	    t = bro(bro(t));
1664
	  }
1665
	}
1666
#if 1	/* we need in reg compound for ptr type conversion via regs */
1667
      case insomereg:
1668
	{
1669
	  int *sr = someregalt(dest.answhere);
1670
 
1671
	  if (*sr != -1)
1672
	  {
1673
	    fail("Somereg *2");
1674
	  }
1675
	  *sr = getreg(sp.fixed);
1676
	  setregalt(dest.answhere, *sr);
1677
	  /* FALLTHROUGH */
1678
	}
1679
      case inreg:
1680
	{
1681
	  code_here(bro(t), sp, dest);
1682
	  r = regalt(dest.answhere);
1683
	  ASSERT(name(t) == val_tag);
1684
	  if (no(t) != 0)
1685
	    rir_ins(i_sl, r, ((al2(sh(t)) >= 8) ? (no(t) << 3) : no(t)), r);
1686
	  nsp = guardreg(r, sp);
1687
	  while (!last(bro(t)))
1688
	  {
1689
	    int z;
1690
 
1691
	    t = bro(bro(t));
1692
	    ASSERT(name(t) == val_tag);
1693
	    z = reg_operand(bro(t), nsp);
1694
	    if (no(t) != 0)
1695
	    {
1696
	      rir_ins(i_sl, z, ((al2(sh(t)) >= 8) ? (no(t) << 3) : no(t)), z);
1697
	    }
1698
	    rrr_ins(i_or, r, z, r);
1699
	  }
1700
	  return mka;
1701
	}
1702
#endif
1703
      default:
1704
	fail("no compounds in float reg");
1705
      }
1706
    }				/* end tup */
1707
/*****************************************************************************/
1708
  case nof_tag:
1709
  case concatnof_tag:
1710
    {
1711
      exp t = son(e);
1712
      space nsp;
1713
      instore str;
1714
      int r, disp = 0;
1715
#if 1
1716
      if(t==nilexp)
1717
	return mka;
1718
#endif
1719
      nsp = sp;
1720
      switch (dest.answhere.discrim)
1721
      {
1722
      case notinreg:
1723
	{
1724
	  str = insalt(dest.answhere);	/* it should be !! */
1725
	  if (!str.adval)
1726
	  {
1727
	    int r = getreg(sp.fixed);
1728
 
1729
	    nsp = guardreg(r, sp);
1730
	    ld_ins(i_l, str.b, r);
1731
	    str.adval = 1;
1732
	    str.b.base = r;
1733
	    str.b.offset = 0;
1734
	  }
1735
	  for (;;)
1736
	  {
1737
	    where newdest;
1738
	    instore newis;
1739
 
1740
	    newis = str;
1741
	    newis.b.offset += disp;
1742
	    setinsalt(newdest.answhere, newis);
1743
	    newdest.ashwhere = ashof(sh(t));
1744
	    code_here(t, nsp, newdest);
1745
	    if (last(t))
1746
	    {
1747
	      return mka;
1748
	    }
1749
	    disp += (rounder(shape_size(sh(t)), shape_align(sh(bro(t)))) >> 3);
1750
	    t = bro(t);
1751
	  }
1752
	}
1753
      case insomereg:
1754
	{
1755
	  int *sr = someregalt(dest.answhere);
1756
 
1757
	  if (*sr != -1)
1758
	  {
1759
	    fail("Somereg *2");
1760
	  }
1761
	  *sr = getreg(sp.fixed);
1762
	  setregalt(dest.answhere, *sr);
1763
	  /* ,... */
1764
	}
1765
      case inreg:
1766
	{
1767
	  code_here(t, sp, dest);
1768
	  r = regalt(dest.answhere);
1769
	  nsp = guardreg(r, sp);
1770
	  while (!last(t))
1771
	  {
1772
	    int z;
1773
 
1774
	    disp += rounder(shape_size(sh(t)), shape_align(sh(bro(t))));
1775
	    t = bro(t);
1776
	    z = reg_operand(t, nsp);
1777
	    if (disp != 0)
1778
	    {
1779
	      rir_ins(i_sl, z, disp, z);
1780
	    }
1781
	    rrr_ins(i_or, r, z, r);
1782
	  }
1783
	  return mka;
1784
	}
1785
      default:
1786
	fail("No Tuples in freg");
1787
      }
1788
    }
1789
/*****************************************************************************/
1790
  case ncopies_tag:
1791
    {
1792
      exp t = son(e);
1793
      space nsp;
1794
      instore str;
1795
      int i, r, disp = 0;
1796
      int no_of_copies = no(e);
1797
      nsp = sp;
1798
 
1799
      switch (dest.answhere.discrim)
1800
      {
1801
       case notinreg:
1802
	{
1803
	  str = insalt(dest.answhere);	/* it should be !! */
1804
	  if (!str.adval)
1805
	  {
1806
	    int r = getreg(sp.fixed);
1807
 
1808
	    nsp = guardreg(r, sp);
1809
	    ld_ins(i_l, str.b, r);
1810
	    str.adval = 1;
1811
	    str.b.base = r;
1812
	    str.b.offset = 0;
1813
	  }
1814
	  for (i = 1; i <= no_of_copies; i++)
1815
	  {
1816
	    where newdest;
1817
	    instore newis;
1818
 
1819
	    newis = str;
1820
	    newis.b.offset += disp;
1821
	    setinsalt(newdest.answhere, newis);
1822
	    newdest.ashwhere = ashof(sh(t));
1823
	    code_here(t, nsp, newdest);
1824
	    disp += (rounder(shape_size(sh(t)), shape_align(sh(t))) >> 3);
1825
	  }
1826
	  return mka;
1827
	}
1828
      case insomereg:
1829
	{
1830
	  int *sr = someregalt(dest.answhere);
1831
 
1832
	  if (*sr != -1)
1833
	  {
1834
	    fail("Somereg *2");
1835
	  }
1836
	  *sr = getreg(sp.fixed);
1837
	  setregalt(dest.answhere, *sr);
1838
	  /*FALLTHROUGH*/
1839
	}
1840
      case inreg:
1841
	{
1842
	  code_here(t, sp, dest);
1843
	  r = regalt(dest.answhere);
1844
	  nsp = guardreg(r, sp);
1845
	  for (i = 1; i <= no_of_copies; i++)
1846
	  {
1847
	    int z;
1848
 
1849
	    disp += rounder(shape_size(sh(t)), shape_align(sh(t)));
1850
	    z = reg_operand(t, nsp);
1851
	    if (disp != 0)
1852
	    {
1853
	      rir_ins(i_sl, z, disp, z);
1854
	    }
1855
	    rrr_ins(i_or, r, z, r);
1856
	  }
1857
	  return mka;
1858
	}
1859
      default:
1860
	fail("no compounds in float reg");
1861
      }
1862
    }
1863
/*****************************************************************************/
1864
   case diagnose_tag:
1865
    {
1866
      output_diag(dno(e), 0, e);
1867
      mka = make_code(son(e), sp, dest, exitlab);
1868
      output_end_scope(dno(e), e);
1869
      return mka;
1870
    }
1871
/*****************************************************************************/
1872
  case solve_tag:
1873
    {
1874
      exp m = bro(son(e));
1875
      int l = exitlab;
1876
 
1877
      if(dest.answhere.discrim==insomereg)
1878
      {
1879
	/* Choose register for fixed result */
1880
	int *sr = someregalt(dest.answhere);
1881
	if (*sr != -1){fail("somereg *2");}
1882
	*sr = getreg(sp.fixed);
1883
	setregalt(dest.answhere, *sr);
1884
      }
1885
      else if (dest.answhere.discrim==insomefreg)
1886
      {
1887
	/* Choose register for float result */
1888
	somefreg sfr;
1889
	freg fr;
1890
	sfr = somefregalt(dest.answhere);
1891
	if (*sfr.fr != -1) { fail ("somefreg *2"); }
1892
	*sfr.fr = getfreg(sp.flt);
1893
	fr.fr = *sfr.fr;
1894
	fr.dble = sfr.dble;
1895
	setfregalt(dest.answhere, fr);
1896
      }
1897
 
1898
      /* Set up all the labels in the component labst_tags */
1899
      for (;;)
1900
      {
1901
	no(son(m)) = new_label();
1902
	if (last(m))
1903
	{
1904
	  break;
1905
	}
1906
	m = bro(m);
1907
      }
1908
      m = son(e);
1909
 
1910
      /* Evaluate all the component statements */
1911
      for (;;)
1912
      {
1913
	int fl = make_code(m, sp, dest, l).lab;
1914
 
1915
	clear_all();
1916
	if (fl != 0)
1917
	{
1918
	  l = fl;
1919
	}
1920
	if (!last(m))
1921
	{
1922
	  /* jump to end of solve */
1923
	  if (l == 0)
1924
	  {
1925
	    l = new_label();
1926
	  }
1927
	  if (name(sh(m)) != bothd)
1928
	  {
1929
	    uncond_ins(i_b, l);
1930
	  }
1931
	}
1932
	if (last(m))
1933
	{
1934
	  mka.lab = l;
1935
	  return mka;
1936
	};
1937
	m = bro(m);
1938
      }
1939
    }				/* end solve */
1940
/*****************************************************************************/
1941
  case case_tag:
1942
    {
1943
      exp control = son(e);
1944
      int control_reg;
1945
      control_reg = reg_operand(control,sp);
1946
      case_tag_code(control_reg, e, sp);
1947
      return mka;
1948
    }				/* end case */
1949
/*****************************************************************************/
1950
  case plus_tag:
1951
    {
1952
      if (!optop(e))
1953
      {
1954
	mka.regmove = plus_error_treatment(e,sp,dest);
1955
      }  
1956
      else
1957
      {
1958
	if (isrecordbit(e))
1959
	{
1960
	  mka.regmove = comm_op(e, sp, dest, i_a_cr);
1961
	  cr0_set = 1;
1962
	}
1963
	else
1964
	{
1965
	  mka.regmove = comm_op(e, sp, dest, i_a);
1966
	}
1967
      }
1968
      return mka;
1969
    }				/* end plus */
1970
/*****************************************************************************/
1971
   case chvar_tag:
1972
    {
1973
      exp arg = son(e);			/* source of chvar, adjusted below   */
1974
      int size_e = shape_size(sh(e));	/* size of result                    */
1975
      int to = name(sh(e));		/* to hd                             */
1976
      int from;				/* from hd                           */
1977
      int sreg;			        /* source reg                        */
1978
      int dreg;  			/* dest reg, or temp for memory dest */
1979
      bool inmem_dest;		        /* is dest in memory ? */
1980
 
1981
 
1982
      /*
1983
       * For a series of chvar_tags, do large to small in one go 
1984
       */
1985
      while (name(arg) == chvar_tag && 
1986
	     ashof(sh(arg)).ashsize >= size_e && NO_ERROR_TREATMENT(arg))
1987
      {
1988
	COMMENT1("make_code chvar_tag: skipping intermediate shape %d",name(sh(arg)));
1989
	arg = son(arg);
1990
      }
1991
 
1992
      if (ERROR_TREATMENT(e))
1993
      {
1994
	mka.regmove = chvar_error_treatment(e,sp,dest);
1995
	return mka;
1996
      }
1997
 
1998
 
1999
      from = name(sh(arg));
2000
      if ( from == to ||
2001
	  to == slonghd ||
2002
	  to == ulonghd ||
2003
	  (to == uwordhd && from == ucharhd) ||
2004
	  (to == swordhd && (from == scharhd || from == ucharhd)) ||
2005
	  (to>=slonghd)
2006
	  )
2007
      {
2008
	/* 
2009
	 * No changes required, so just move handling dest insomereg well 
2010
	 */
2011
	ans aa;
2012
 
2013
	COMMENT("make_code chvar_tag: no change");
2014
	switch (dest.answhere.discrim)
2015
	{
2016
	 case inreg:
2017
	  sreg = regalt(dest.answhere);
2018
	  if (!IS_R_NO_REG(sreg))
2019
	  {
2020
	    reg_operand_here(arg, sp, sreg);
2021
	    break;
2022
	  }
2023
	  /* result being voided, treat as default */
2024
	  /*FALLTHROUGH*/
2025
 
2026
	 default:
2027
	  sreg = reg_operand(arg, sp);
2028
	}
2029
 
2030
	setregalt(aa, sreg);
2031
	mka.regmove = move(aa, dest, sp.fixed, is_signed(sh(e)) );
2032
	return mka;
2033
      }
2034
 
2035
      switch (dest.answhere.discrim)
2036
      {
2037
      case inreg:
2038
	{
2039
	  /* +++ if same size, paste down signed/unsigned to op */
2040
	  /* +++ paste down and adjust address as per big-endian */
2041
	  /* +++ for big-endians, use locate() */
2042
 
2043
	  sreg = reg_operand(arg, sp);
2044
	  dreg = regalt(dest.answhere);
2045
	  if (IS_R_NO_REG(dreg))
2046
	    return mka;		/* dest void */
2047
	  inmem_dest = 0;
2048
	  break;
2049
	}
2050
 
2051
      case insomereg:
2052
	{
2053
	  int *dr = someregalt(dest.answhere);
2054
 
2055
	  COMMENT("make_code chvar_tag: dest insomereg");
2056
	  sreg = reg_operand(arg, sp);
2057
	  dreg = getreg(sp.fixed);
2058
	  *dr = dreg;
2059
	  inmem_dest = 0;
2060
	  break;
2061
	}
2062
 
2063
      default:
2064
	{
2065
	  sreg = reg_operand(arg, sp);
2066
	  dreg = getreg(sp.fixed);
2067
	  inmem_dest = 1;
2068
	}
2069
      }
2070
 
2071
      COMMENT2("make_code chvar_tag: shape %d to %d", from, to);
2072
 
2073
      if (inmem_dest && size_e <= shape_size(sh(arg)))
2074
      {
2075
	/* going to smaller sized memory, store will truncate */
2076
	ans aa;
2077
 
2078
	setregalt(aa, sreg);
2079
	sp=guardreg(sreg,sp);
2080
	move(aa, dest, sp.fixed, 1);
2081
	return mka;
2082
      }
2083
 
2084
      ASSERT(from != to);		/* done above */
2085
 
2086
      /* shorten to type if needed */
2087
      adjust_to_size(from,sreg,to,dreg,NO_ERROR_JUMP);
2088
      if (inmem_dest)
2089
      {
2090
	ans aa;
2091
 
2092
	setregalt(aa, dreg);
2093
	sp=guardreg(dreg,sp);
2094
	move(aa, dest, sp.fixed, 1);
2095
      }
2096
      else
2097
      {
2098
	mka.regmove = dreg;
2099
      }
2100
 
2101
      return mka;
2102
    }				/* end chvar */
2103
/*****************************************************************************/
2104
   case minus_tag:
2105
    {
2106
      if(ERROR_TREATMENT(e))
2107
      {
2108
	mka.regmove = minus_error_treatment(e,sp,dest);
2109
      }
2110
      else
2111
      {
2112
	mka.regmove = non_comm_op(e, sp, dest, i_s);
2113
      }
2114
      return mka;
2115
    }				/* end minus */
2116
/*****************************************************************************/
2117
   case mult_tag:
2118
   case offset_mult_tag:
2119
    {
2120
      bool sgned = is_signed(sh(e));
2121
      if (ERROR_TREATMENT(e))
2122
      {
2123
	mka.regmove = mult_error_treatment(e,sp,dest);
2124
      }
2125
      else
2126
      {
2127
	mka.regmove = do_mul_comm_op(e, sp, dest, sgned);
2128
      }
2129
      return mka;
2130
    }
2131
/*****************************************************************************/
2132
   case div0_tag:
2133
   case div1_tag:
2134
   case div2_tag:
2135
   case offset_div_by_int_tag:
2136
   case offset_div_tag:
2137
    {
2138
      bool sgned = is_signed(sh(e));
2139
 
2140
      mka.regmove = do_div_op(e, sp, dest, sgned);
2141
      return mka;
2142
    }				/* end div */
2143
/*****************************************************************************/
2144
   case mod_tag:
2145
   case rem0_tag:
2146
   case rem2_tag:
2147
    {
2148
      bool sgned = is_signed(sh(e));
2149
 
2150
      mka.regmove = do_rem_op(e, sp, dest, sgned);
2151
      return mka;
2152
    }				/* end rem */
2153
/*****************************************************************************/
2154
  case neg_tag:
2155
  case offset_negate_tag:
2156
    {
2157
      if (ERROR_TREATMENT(e))
2158
      {
2159
	mka.regmove = neg_error_treatment(e,sp,dest);
2160
      }
2161
      else
2162
      {
2163
	int r = reg_operand(son(e),sp);
2164
	int destr = regfrmdest(&dest,sp);
2165
	space nsp;
2166
	ans aa;
2167
 
2168
	nsp = guardreg(destr,sp);
2169
	rr_ins(i_neg, r, destr);
2170
#if 0
2171
  tidyshort(destr, e);
2172
#endif
2173
	setregalt(aa,destr);
2174
	mka.regmove = move(aa,dest,nsp.fixed,1);
2175
	return mka;
2176
      }
2177
      return mka;
2178
    }				/* end neg */
2179
/*****************************************************************************/
2180
   case abs_tag:
2181
    {
2182
      if (ERROR_TREATMENT(e))
2183
      {
2184
	mka.regmove = abs_error_treatment(e,sp,dest);
2185
        return mka;
2186
      }
2187
      else
2188
      {
2189
	int r = reg_operand(son(e),sp);
2190
	int destr = regfrmdest(&dest,sp);
2191
	space nsp;
2192
	ans aa;
2193
 
2194
	nsp = guardreg(destr,sp);
2195
	rr_ins(i_abs, r, destr);
2196
#if 0
2197
  tidyshort(destr, e);
2198
#endif
2199
	setregalt(aa,destr);
2200
	mka.regmove = move(aa,dest,nsp.fixed,1);
2201
	return mka;
2202
      }
2203
    }
2204
/*****************************************************************************/
2205
  case shl_tag:
2206
  case shr_tag:
2207
    {
2208
      exp s = son(e);
2209
      exp b = bro(s);
2210
      int a;
2211
      int d;
2212
      ans aa;
2213
      space nsp;
2214
      bool sgned = is_signed(sh(e));
2215
      Instruction_P shift_ins;
2216
      bool record_bit = isrecordbit(e);
2217
 
2218
 
2219
#if 1
2220
      int sz = shape_size(sh(s));
2221
#if 0
2222
      bool lded = ((name (s) == name_tag && regofval (s) >= 100)
2223
		   || (name (s) == cont_tag &&
2224
		       (name (son (s)) != name_tag || regofval (son (s)) > 0)
2225
		       )
2226
		   ); 
2227
#endif
2228
      bool signok = (sz == 32); /* better safe than sorry for the time being */
2229
      if(name(son(e))==shl_tag && shape_size(sh(son(s)))!=32)
2230
      {
2231
	signok=1;
2232
      }
2233
#endif
2234
      if (ERROR_TREATMENT(e))
2235
      {
2236
	fail("Unexpected error treatment for shl");
2237
      }
2238
      if(name(s)==and_tag && name(b)==val_tag &&
2239
	 name(bro(son(s)))==val_tag &&
2240
	 is_a_mask(no(bro(son(s)))) &&
2241
	 shape_size(sh(e))==32)
2242
      {
2243
	unsigned int mask= (unsigned int)no(bro(son(s)));
2244
	int mask_left = left_of_mask(mask);
2245
	int rotation_left;
2246
	bool use_rlinm_ins = 0;
2247
 
2248
	if (name(e)==shl_tag)
2249
	{
2250
	  int shift_left = no(b);
2251
	  mask = mask<<shift_left;
2252
	  rotation_left = shift_left;
2253
	  use_rlinm_ins = 1;
2254
	}
2255
	else
2256
	{
2257
	  if (mask_left == 31 && is_signed(sh(e)))
2258
	  {
2259
	    use_rlinm_ins = 0;
2260
	    /* sign extension */
2261
	  }
2262
	  else
2263
	  {
2264
	    int shift_right = no(b);
2265
	    mask = mask>>shift_right;
2266
	    rotation_left = 32 - shift_right;
2267
	  }
2268
	}
2269
 
2270
	if (use_rlinm_ins==1)
2271
	{
2272
	  a = reg_operand(son(s),sp);
2273
	  d = regfrmdest(&dest,sp);
2274
 
2275
	  if(isrecordbit(e))
2276
	  {
2277
	    rlinm_ins(i_rlinm_cr,a,rotation_left,mask,d);
2278
	  }
2279
	  else
2280
	  {
2281
	    rlinm_ins(i_rlinm,a,rotation_left,mask,d);
2282
	  }
2283
	  setregalt(aa,d);
2284
	  move(aa,dest,sp.fixed,0);
2285
	  return mka; 
2286
	}
2287
      }
2288
 
2289
      a = reg_operand(s, sp);
2290
 
2291
      if (!signok && name(e)==shr_tag) 
2292
      {
2293
	/* 
2294
	 * If doing a shift right we must sign extend 
2295
	 * or truncate prior to shifting
2296
	 */
2297
	adjust_to_size(ulonghd,a,name(sh(e)),a,NO_ERROR_JUMP);
2298
      }
2299
      if (name(e) == shr_tag)
2300
      {
2301
	if(record_bit==1)
2302
	{
2303
	  shift_ins = (sgned) ? i_sra_cr : i_sr_cr;
2304
	  cr0_set = 1;
2305
	}
2306
	else
2307
	{
2308
	  shift_ins = (sgned) ? i_sra : i_sr;
2309
	}
2310
      }
2311
      else
2312
      {
2313
	shift_ins = i_sl;
2314
      }
2315
      nsp = guardreg(a, sp);
2316
      d = regfrmdest(&dest,nsp);
2317
 
2318
      if (name(b) == val_tag)
2319
      {
2320
	/* Only defined for shifts by 0..31 */
2321
	int n = no(b);
2322
	int n31 = n & 31;
2323
 
2324
	if (n == 0)
2325
	{
2326
	  mov_rr_ins(a, d);comment("shift by zero so just move");
2327
	}
2328
	else if (n == n31)
2329
	{
2330
	  rir_ins(shift_ins, a, n, d);	/* usual case */
2331
	}
2332
	else
2333
	{			/* Undefined, produce same effect as if */
2334
	  ld_const_ins(0, d);	/* not a constant,0 */
2335
	}				
2336
      }
2337
      else
2338
      {
2339
	int ar = reg_operand(b, nsp);
2340
	rrr_ins(shift_ins, a, ar, d);
2341
      }
2342
      if(!signok && name(e)==shl_tag)
2343
      {
2344
	/* 
2345
	 * If doing a shift left we must sign extend 
2346
	 * or truncate after the shift
2347
	 */
2348
	adjust_to_size(ulonghd,d,name(sh(e)),d,NO_ERROR_JUMP);
2349
      }
2350
      setregalt(aa, d);
2351
      move(aa, dest, nsp.fixed, 1);
2352
      mka.regmove = d;
2353
      return mka;
2354
    }				/* end shl, shr */
2355
/*****************************************************************************/
2356
   case minptr_tag:
2357
   case make_stack_limit_tag:
2358
    {
2359
      mka.regmove = non_comm_op(e, sp, dest, i_s);
2360
      return mka;
2361
    }
2362
/*****************************************************************************/
2363
   case fplus_tag:
2364
    {
2365
      mka.regmove =
2366
	fop(e, sp, dest, is_single_precision(sh(e)) ? i_fa : i_fa);
2367
      return mka;
2368
    }
2369
/*****************************************************************************/
2370
  case fminus_tag:
2371
    {
2372
      mka.regmove =
2373
	fop(e, sp, dest, is_single_precision(sh(e)) ? i_fs : i_fs);
2374
      return mka;
2375
    }
2376
/*****************************************************************************/
2377
  case fmult_tag:
2378
    {
2379
      mka.regmove =
2380
	fop(e, sp, dest, is_single_precision(sh(e)) ? i_fm : i_fm);
2381
      return mka;
2382
    }
2383
/*****************************************************************************/
2384
  case fdiv_tag:
2385
    {
2386
      mka.regmove =
2387
	fop(e, sp, dest, is_single_precision(sh(e)) ? i_fd : i_fd);
2388
      return mka;
2389
    }
2390
/*****************************************************************************/
2391
  case fneg_tag:
2392
    {
2393
      mka.regmove =
2394
	fmop(e, sp, dest, is_single_precision(sh(e)) ? i_fneg : i_fneg);
2395
      return mka;
2396
    }
2397
/*****************************************************************************/
2398
  case fabs_tag:
2399
    {
2400
      mka.regmove =
2401
	fmop(e, sp, dest, is_single_precision(sh(e)) ? i_fabs : i_fabs);
2402
      return mka;
2403
    }
2404
/*****************************************************************************/
2405
  case float_tag:
2406
    {
2407
      exp in = son(e);
2408
      int f = (dest.answhere.discrim == infreg) ?
2409
		fregalt(dest.answhere).fr :
2410
		getfreg(sp.flt);
2411
      freg frg;
2412
      ans aa;
2413
      bool from_sgned = is_signed(sh(in));
2414
 
2415
      frg.fr = f;
2416
      frg.dble = is_double_precision(sh(e));
2417
 
2418
      if (from_sgned)
2419
      {
2420
	/* signed 32 bit to real */
2421
	int r = reg_operand(in, sp);
2422
	int f1 = getfreg(guardfreg(f, sp).flt);
2423
 
2424
	ld_const_ins(0x43300000, R_TMP0);
2425
	st_ro_ins(i_st, R_TMP0, mem_temp(0));comment(NIL);
2426
	ld_const_ins(0x80000000, R_TMP0);
2427
	st_ro_ins(i_st, R_TMP0, mem_temp(4));comment(NIL);
2428
	ldf_ro_ins(i_lfd, mem_temp(0), f);
2429
	rir_ins(i_xor, r, 0x80000000, R_TMP0);
2430
	st_ro_ins(i_st, R_TMP0, mem_temp(4));comment(NIL);
2431
	ldf_ro_ins(i_lfd, mem_temp(0), f1);
2432
	rrrf_ins(i_fs, f1, f, f);
2433
      }
2434
      else
2435
      {
2436
	/* unsigned 32 bit to real */
2437
	int r = reg_operand(in, sp);
2438
	int f1 = getfreg(guardfreg(f, sp).flt);
2439
 
2440
	ld_const_ins(0x43300000, R_TMP0);
2441
	st_ro_ins(i_st, R_TMP0, mem_temp(0));comment(NIL);
2442
	ld_const_ins(0x0, R_TMP0);
2443
	st_ro_ins(i_st, R_TMP0, mem_temp(4));comment(NIL);
2444
	ldf_ro_ins(i_lfd, mem_temp(0), f);
2445
	st_ro_ins(i_st, r, mem_temp(4));comment(NIL);
2446
	ldf_ro_ins(i_lfd, mem_temp(0), f1);
2447
	rrrf_ins(i_fs, f1, f, f);
2448
      }
2449
 
2450
      setfregalt(aa, frg);
2451
      move(aa, dest, sp.fixed, 1);
2452
      mka.regmove = (frg.dble) ? -(f + 32) : (f + 32);
2453
      return mka;
2454
    }
2455
/*****************************************************************************/
2456
  case chfl_tag:
2457
    {
2458
      int to = name(sh(e));
2459
      int from = name(sh(son(e)));
2460
      bool dto = (to != shrealhd);
2461
      bool dfrom = (from != shrealhd);
2462
 
2463
      if (dto==dfrom)
2464
      {
2465
	/* no change in representation */
2466
	return make_code(son(e), sp, dest, exitlab);
2467
      }
2468
      else
2469
      {
2470
	freg frg;
2471
	ans aa;
2472
	where w;
2473
 
2474
	frg = fregfrmdest(dfrom,&dest,sp);
2475
	setfregalt(aa, frg);
2476
	w.answhere = aa;
2477
	w.ashwhere = ashof(sh(son(e)));
2478
	code_here(son(e), sp, w);
2479
	if ( to==shrealhd )
2480
	{
2481
	  if (ERROR_TREATMENT(e))
2482
	  {
2483
	    chfl_error_treatment(e,frg.fr);
2484
	  }
2485
	  else
2486
	  {
2487
	    rrf_ins(i_frsp,frg.fr,frg.fr);
2488
	  }
2489
	}
2490
	frg.dble = dto;
2491
	setfregalt(aa, frg);
2492
	move(aa, dest, sp.fixed, 1);
2493
	mka.regmove = (frg.dble) ? -(frg.fr + 32) : (frg.fr + 32);
2494
	return mka;
2495
      }
2496
    }
2497
/*****************************************************************************/
2498
  case and_tag:
2499
    {
2500
      exp arg1 = son(e);
2501
      exp arg2 = bro(arg1);
2502
 
2503
      if (name(arg2)==val_tag &&
2504
	  is_a_mask(no(arg2)) &&
2505
	  shape_size(sh(e))==32 &&
2506
	  (name(arg1)==shl_tag || name(arg1)==shr_tag) &&
2507
	  name(bro(son(arg1)))==val_tag)
2508
      {
2509
	unsigned int mask = (unsigned int)no(arg2);
2510
	int mask_left = left_of_mask(mask);
2511
	int mask_right = right_of_mask(mask);
2512
	bool use_rlinm_ins = 0;
2513
	long rotation_left;
2514
 
2515
	if (name(arg1)==shl_tag)
2516
	{
2517
	  int shift_left = no(bro(son(arg1)));
2518
	  if (shift_left<=mask_right)
2519
	  {
2520
	    rotation_left = shift_left;
2521
	    use_rlinm_ins=1;
2522
	  }
2523
	}
2524
	else if (name(arg1)==shr_tag )
2525
	{
2526
	  int shift_right = no(bro(son(arg1)));
2527
	  if (shift_right<=(31-mask_left))
2528
	  {
2529
	    rotation_left = 32 - shift_right;
2530
	    use_rlinm_ins=1;
2531
	  }
2532
	}
2533
 
2534
	if (use_rlinm_ins==1)
2535
	{
2536
	  int r = reg_operand(son(arg1),sp);
2537
	  int dr = regfrmdest(&dest,sp);
2538
	  ans aa;
2539
 
2540
	  if(isrecordbit(e))
2541
	  {
2542
	    rlinm_ins(i_rlinm_cr,r,rotation_left,mask,dr);
2543
	  }
2544
	  else
2545
	  {
2546
	    rlinm_ins(i_rlinm,r,rotation_left,mask,dr);
2547
	  }
2548
	  setregalt(aa,dr);
2549
	  move(aa,dest,sp.fixed,0);
2550
	  return mka;
2551
	}
2552
      }
2553
 
2554
 
2555
 
2556
      if(isrecordbit(e))
2557
      {
2558
	mka.regmove = comm_op(e, sp, dest, i_and_cr);
2559
	cr0_set = 1;
2560
      }
2561
      else
2562
      {
2563
	mka.regmove = comm_op(e, sp, dest, i_and);
2564
      }
2565
 
2566
      return mka;
2567
    }
2568
/*****************************************************************************/
2569
  case or_tag:
2570
    {
2571
      mka.regmove = comm_op(e, sp, dest, i_or);
2572
      return mka;
2573
    }
2574
/*****************************************************************************/
2575
  case xor_tag:
2576
    {
2577
      mka.regmove = comm_op(e, sp, dest, i_xor);
2578
      return mka;
2579
    }
2580
/*****************************************************************************/
2581
  case not_tag:
2582
    {
2583
      /* i_not is a pseudo instruction expanded to sfi dest,-1,src */
2584
      int a1=reg_operand(son(e),sp);
2585
      ans aa;
2586
      int d=regfrmdest(&dest,sp);
2587
 
2588
      rr_ins(i_not,a1,d);
2589
      adjust_to_size(ulonghd,d,name(sh(e)),d,NO_ERROR_JUMP);
2590
      setregalt(aa,d);
2591
      move(aa,dest,guardreg(d,sp).fixed,1);
2592
      mka.regmove =d ;
2593
 
2594
      return mka;
2595
    }
2596
/*****************************************************************************/
2597
  case cont_tag:
2598
  case contvol_tag:
2599
    {
2600
      if (name(e) == contvol_tag)
2601
      {
2602
	/*
2603
	 * Load contents of volatile location. Diasble register-location
2604
	 * tracing. Disable peep-hole optimisation (not possible with POWER
2605
	 * assembler).
2606
	 */
2607
	COMMENT("make_code: Load volatile");
2608
	clear_all();
2609
      }
2610
      /*
2611
       * Check to see if we can use 
2612
       * [reg+reg] addressing for this load 
2613
       */
2614
      if (name(son(e)) == addptr_tag)
2615
      {
2616
	shape cont_shape = sh(e);
2617
	int cont_size = shape_size(cont_shape);
2618
	int cont_align = shape_align(cont_shape);
2619
	exp addptr_sons = son(son(e));
2620
	bool is_float = is_floating(name(cont_shape));
2621
 
2622
	if (last(bro(addptr_sons))
2623
	    && cont_align == cont_size
2624
	    && (cont_size==8 || cont_size==16 || cont_size==32 || is_float))
2625
	{
2626
	  int lhsreg;
2627
	  int rhsreg;
2628
	  bool sgned = (cont_size >= 32) || is_signed(cont_shape);
2629
	  ans aa;
2630
 
2631
	  COMMENT("make_code: load suitable for [reg+reg] addressing");
2632
 
2633
	  lhsreg = reg_operand(addptr_sons, sp);
2634
	  rhsreg = reg_operand(bro(addptr_sons), guardreg(lhsreg, sp));
2635
 
2636
	  if (is_float)
2637
	  {
2638
	    freg dfreg;
2639
 
2640
	    if (dest.answhere.discrim == infreg)
2641
	    {
2642
	      dfreg = fregalt(dest.answhere);
2643
	    }
2644
	    else
2645
	    {
2646
	      dfreg.fr = getfreg(sp.flt);
2647
	    }
2648
	    dfreg.dble = (cont_size==64);
2649
	    ldf_rr_ins((dfreg.dble?i_lfd :i_lfs), lhsreg, rhsreg, dfreg.fr);
2650
	    setfregalt(aa, dfreg);
2651
	  }
2652
	  else
2653
	  {
2654
	    int dreg = regfrmdest(&dest,sp);
2655
 
2656
	    ld_rr_ins(i_ld_sz(cont_size,sgned), lhsreg, rhsreg, dreg);
2657
	    if (sgned && cont_size==8)
2658
	    {
2659
	      /* No load signed byte instruction, so propagate sign
2660
	       */
2661
	      adjust_to_size(ulonghd,dreg,scharhd,dreg,NO_ERROR_JUMP);
2662
	    }
2663
	    setregalt(aa, dreg);
2664
	  }
2665
 
2666
	  mka.regmove = move(aa, dest, sp.fixed, sgned);
2667
	  if (name(e) == contvol_tag)
2668
	    mka.regmove = NOREG;
2669
	  return mka;
2670
	}
2671
      }
2672
    }
2673
    /*FALLTHROUGH*/
2674
   case name_tag:
2675
   case field_tag:
2676
   case reff_tag:
2677
   case addptr_tag:
2678
   case subptr_tag:
2679
    {
2680
      where w;
2681
      bool sgned;
2682
      int dr = (dest.answhere.discrim == inreg) ? dest.answhere.val.regans : 0;
2683
      w = locate(e, sp, sh(e), dr);		/* address of arg */
2684
      sgned = (w.ashwhere.ashsize >= 32) || is_signed(sh(e));
2685
      /* +++ load real into float reg, move uses fixed reg */
2686
      mka.regmove = move(w.answhere, dest, (guard(w, sp)).fixed, sgned);
2687
      if (name(e) == contvol_tag)
2688
	mka.regmove = NOREG;
2689
      return mka;
2690
    }				/* end cont */
2691
/*****************************************************************************/
2692
  case string_tag:
2693
  case real_tag:
2694
    {
2695
      instore isa;
2696
      ans aa;
2697
      bool sgned = ((ashof(sh(e)).ashsize >= 32) || is_signed(sh(e)));
2698
 
2699
      /*
2700
       * Place constant in appropriate data segment 
2701
       */
2702
      isa = evaluated_const(e);
2703
      setinsalt(aa, isa);
2704
      mka.regmove = move(aa, dest, sp.fixed, sgned);
2705
      return mka;
2706
    }				/* end eval */
2707
/*****************************************************************************/
2708
  case val_tag:
2709
    {
2710
      int size = shape_size(sh(e));
2711
 
2712
 
2713
      if ( size == 64 )
2714
      {
2715
        /* could be evaluating into nowhere so check
2716
           to see it is trying to evaluate into a genuine place */
2717
        if(dest.answhere.discrim==notinreg)
2718
        {
2719
          flt64 temp;
2720
          int ov;
2721
          int r = getreg(sp.fixed);
2722
          space nsp;
2723
          ans aa;
2724
          if (isbigval(e)) {
2725
	  temp = flt_to_f64(no(e), 0, &ov);
2726
          }
2727
          else {
2728
            temp.big = (is_signed(sh(e)) && no(e)<0)?-1:0;
2729
            temp.small = no(e);
2730
          }
2731
          nsp = guardreg(r, sp);
2732
          ld_const_ins(temp.small,r);
2733
          setregalt(aa,r);
2734
          dest.ashwhere.ashsize = 32;
2735
          dest.ashwhere.ashalign = 32;
2736
          move(aa,dest,nsp.fixed,1);
2737
          ld_const_ins(temp.big,r);
2738
          ASSERT(dest.answhere.discrim==notinreg);
2739
          dest.answhere.val.instoreans.b.offset+=4;
2740
          move(aa,dest,nsp.fixed,1);
2741
        }
2742
 
2743
	return mka; 	
2744
      }
2745
      else  if (no(e) == 0)
2746
      {
2747
	goto moveconst_zero;
2748
      }
2749
      else
2750
      {
2751
	if (size == 32 || !is_signed(sh(e)))
2752
	{
2753
	  /* 32 bit size or unsigned */
2754
	  constval = no(e);
2755
	}
2756
	else if (size == 8)
2757
	{
2758
	  constval = no(e) & 255;
2759
	  constval -= (constval & 128) << 1;
2760
	}
2761
	else if (size == 16)
2762
	{
2763
	  constval = no(e) & 65535;
2764
	  constval -= (constval & 32768) << 1;
2765
	}
2766
	else
2767
	{
2768
	  fail("make_code val_tag: unexpected bit size");
2769
	}
2770
	goto moveconst;
2771
      }
2772
    }
2773
/*****************************************************************************/
2774
    case top_tag:
2775
    case prof_tag:
2776
    {
2777
      return mka;
2778
    }
2779
/*****************************************************************************/
2780
  case null_tag:
2781
    {
2782
      goto moveconst_zero;
2783
    }
2784
/*****************************************************************************/
2785
  case round_tag:
2786
    {
2787
      int sfr;
2788
      int destr;
2789
      ans aa;
2790
      bool changed_mode = 0;
2791
      bool call_fctiwz =0;
2792
      int ifr = getfreg(sp.flt);
2793
 
2794
      sfr = freg_operand(son(e), sp, getfreg(sp.flt));
2795
      /* Doesn't matter if sfr and ifr same */
2796
      switch(round_number(e))
2797
      {
2798
        case R2ZERO:call_fctiwz=1;break;
2799
        case R2NEAR:break;
2800
        case R2PINF:mtfsb1_ins(30);mtfsb0_ins(31);changed_mode=1;break;
2801
        case R2NINF:mtfsb1_ins(30);mtfsb1_ins(31);changed_mode=1;break;
2802
        case 4: break;
2803
        default: fail("Unknown rounding mode");break;
2804
      }
2805
      /* can use fctiw command */
2806
 
2807
      destr=regfrmdest(&dest,sp);
2808
      rrf_ins(call_fctiwz?i_fctiwz:i_fctiw,sfr,ifr);
2809
      stf_ins(i_stfd,ifr,mem_temp(0));
2810
      ld_ro_ins(i_l,mem_temp(4),destr);comment(NIL);
2811
 
2812
      if(changed_mode)
2813
      {
2814
	/* put it back to round_to_nearest */
2815
	mtfsb0_ins(30);mtfsb0_ins(31);
2816
      }
2817
      adjust_to_size(ulonghd,destr,name(sh(e)),destr,NO_ERROR_JUMP);
2818
      setregalt(aa, destr);     
2819
      mka.regmove = move(aa, dest, sp.fixed, 1);
2820
      return mka;
2821
    }
2822
/*****************************************************************************/
2823
     case int_to_bitf_tag:
2824
    {
2825
      int r;
2826
      int size_res = shape_size(sh(e));
2827
      int size_op = shape_size(sh(son(e)));
2828
      ans aa;
2829
      space nsp;
2830
 
2831
      r = reg_operand(son(e), sp);
2832
 
2833
      COMMENT2("make_code int_to_bitf_tag: size %d -> %d", size_op, size_res);
2834
 
2835
      /* maybe this not needed if going to memory +++ */
2836
      if (size_res != size_op && size_res != 32)
2837
      {
2838
	int destr;
2839
 
2840
	switch (dest.answhere.discrim)
2841
	{
2842
	case inreg:
2843
	  {
2844
	    destr = regalt(dest.answhere);
2845
	    break;
2846
	  }
2847
	default:
2848
	  {
2849
	    destr = getreg(sp.fixed);
2850
	  }
2851
	}
2852
 
2853
	rir_ins(i_and, r, (1 << size_res) - 1, destr);
2854
	r = destr;
2855
      }
2856
 
2857
      /* r is appropriately truncated operand */
2858
 
2859
      nsp = guardreg(r, sp);
2860
      setregalt(aa, r);
2861
      move(aa, dest, nsp.fixed, 0);
2862
      return mka;
2863
    }
2864
/*****************************************************************************/
2865
  case bitf_to_int_tag:
2866
    {
2867
      ash a;
2868
      int r;
2869
      where w;
2870
      bool src_sgned = name(sh(son(e))) & 1;
2871
      bool target_sgned = name(sh(e)) & 1;
2872
 
2873
      a = ashof(sh(son(e)));
2874
      switch (dest.answhere.discrim)
2875
      {
2876
      case inreg:
2877
	{
2878
	  r = regalt(dest.answhere);
2879
	  break;
2880
	}
2881
      default:
2882
	{
2883
	  r = getreg(sp.fixed);
2884
	}
2885
      }
2886
 
2887
      setregalt(w.answhere, r);
2888
      w.ashwhere = a;
2889
      code_here(son(e), sp, w);
2890
 
2891
      COMMENT1("make_code bitsint_tag: size=%d", a.ashsize);
2892
 
2893
      if (a.ashsize != 32 && src_sgned != target_sgned)
2894
      {
2895
	/* propogate/correct sign bits */
2896
	/* +++ make move() handle this by pasting sign down */
2897
	ash atarget;
2898
	atarget = ashof(sh(e));
2899
 
2900
	COMMENT4("make_code bitsint_tag: adjusting to sign/size %d/%d -> %d/%d",
2901
		src_sgned, a.ashsize,
2902
		target_sgned, atarget.ashsize);
2903
 
2904
	if (target_sgned)
2905
	{
2906
	  if (32 - a.ashsize == 16)
2907
	  {
2908
	    rr_ins(i_exts, r, r);
2909
	  }
2910
	  else
2911
	  {
2912
	    rir_ins(i_sl, r, 32 - a.ashsize, r);
2913
	    rir_ins(i_sra, r, 32 - a.ashsize, r);
2914
	  }
2915
	}
2916
	else
2917
	{
2918
	  rir_ins(i_and, r, ((1 << a.ashsize) - 1), r);
2919
	}
2920
      }
2921
 
2922
      move(w.answhere, dest, guardreg(r, sp).fixed, 0);
2923
      keepreg(e, r);
2924
      return mka;
2925
    }
2926
/*****************************************************************************/
2927
   case movecont_tag:
2928
    {
2929
      exp szarg = bro(bro(son(e)));
2930
      int dr,sr,szr;
2931
      int lout=new_label();
2932
      int creg=next_creg();
2933
      space nsp;
2934
      int bytemove;
2935
      where w;
2936
 
2937
      sr = getreg(sp.fixed);
2938
      setregalt(w.answhere, sr);
2939
      w.ashwhere = ashof(sh(son(e)));
2940
      make_code( son(e), sp, w, 0);
2941
      nsp = guardreg(sr,sp);
2942
      dr = getreg(nsp.fixed);
2943
      setregalt(w.answhere, dr);
2944
      make_code( bro(son(e)), nsp, w, 0);
2945
      nsp = guardreg(dr,nsp);
2946
      w.ashwhere = ashof(sh(bro(bro(son(e)))));
2947
      szr = getreg(nsp.fixed);
2948
      setregalt(w.answhere, szr);
2949
      (void)make_code(szarg, nsp, w, 0);
2950
      nsp = guardreg(szr, nsp);
2951
      bytemove = (al2(sh(szarg))>>3);
2952
#if 0
2953
      clear_dep_reg(son(e));
2954
      clear_dep_reg(bro(son(e)));
2955
#else
2956
      clear_all();
2957
#endif
2958
      if(name(szarg) != val_tag || no(szarg) == 0) {
2959
	cmp_ri_ins(i_cmp, szr, 0, creg);
2960
	bc_ins(i_beq, creg, lout,UNLIKELY_TO_JUMP);
2961
      }	
2962
      if (isnooverlap(e)) {
2963
	move_dlts(dr,sr,szr, bytemove);
2964
      }
2965
      else {
2966
	int gtlab = new_label();
2967
	int creg2 = next_creg();
2968
	cmp_rr_ins(i_cmp, dr, sr,creg2);
2969
	bc_ins(i_bgt, creg2, gtlab,LIKELY_TO_JUMP);
2970
	move_dlts(dr,sr,szr, bytemove);
2971
	uncond_ins(i_b, lout);
2972
	set_label(gtlab);
2973
	move_dgts(dr,sr,szr, bytemove);
2974
      }  	
2975
      set_label(lout);
2976
      return mka;
2977
    }
2978
 
2979
/*****************************************************************************/
2980
   case offset_pad_tag:
2981
    {
2982
      int r;
2983
      int v;
2984
      ans aa;	
2985
      if (al2(sh(son(e))) >= al2(sh(e))) 
2986
      {
2987
	if (al2(sh(e)) != 1 || al2(sh(son(e))) == 1) 
2988
	{
2989
	  /*
2990
	   * Is already aligned correctly, 
2991
	   * whether as bit or byte-offset
2992
	   */
2993
	  e = son(e); goto tailrecurse;
2994
	}
2995
	r = regfrmdest(&dest, sp);
2996
	v = reg_operand(son(e), sp);
2997
	rir_ins(i_sl,  v, 3 ,r);  
2998
      }
2999
      else {
3000
	int al = (al2(sh(son(e)))==1)?al2(sh(e)):(al2(sh(e))/8);
3001
	r = regfrmdest(&dest, sp);
3002
	v = reg_operand(son(e), sp); 
3003
	rir_ins(i_a, v, al-1, r);
3004
	rir_ins(i_and, r, -al ,r);
3005
	if (al2(sh(son(e)))==1) 
3006
	{ /* 
3007
	   * operand is bit-offset,
3008
	   * byte-offset required 
3009
	   */
3010
	  rir_ins(i_sra, r, 3 ,r);
3011
	}
3012
      }
3013
      setregalt(aa,r);
3014
      mka.regmove = move(aa, dest, guardreg(r,sp).fixed, 0);
3015
      return mka;
3016
    }
3017
/*****************************************************************************/
3018
 
3019
   case min_tag:
3020
   case max_tag:
3021
   case offset_max_tag:
3022
    {
3023
      ans aa;
3024
      int left;
3025
      int right;
3026
      int r=regfrmdest(&dest, sp);
3027
      int creg;
3028
      int lab;
3029
 
3030
      space nsp;
3031
      if (IsRev(e))
3032
      {
3033
	right=reg_operand(bro(son(e)),sp);
3034
	nsp=guardreg(right,sp);
3035
	left=reg_operand(son(e),nsp);
3036
      }
3037
      else
3038
      {
3039
	left=reg_operand(son(e),sp);
3040
	nsp=guardreg(left,sp);
3041
	right=reg_operand(bro(son(e)),nsp);
3042
      }
3043
      creg = next_creg();
3044
      lab = new_label();
3045
      cmp_rr_ins(i_cmp,left,right,creg);
3046
      mov_rr_ins(left,r);comment(NIL);
3047
      if(name(e)==min_tag)
3048
      {
3049
	bc_ins(i_blt,creg,lab,LIKELY_TO_JUMP);
3050
      }
3051
      else
3052
      {
3053
	bc_ins(i_bgt,creg,lab,LIKELY_TO_JUMP);  
3054
      }
3055
      mov_rr_ins(right,r);comment(NIL);
3056
      set_label(lab);
3057
      setregalt(aa,r);
3058
      move(aa, dest,guardreg(r,sp).fixed , 0);
3059
      mka.regmove = r;
3060
      return mka;
3061
    }
3062
/*****************************************************************************/
3063
   case offset_add_tag:
3064
    {
3065
      /*
3066
       * byte offset + bit offset 
3067
       * all others converted to plus_tag by needscan
3068
       * The byte offset must be converted into bits for
3069
       * the addition
3070
       */
3071
      exp byte_offset = son(e);
3072
      exp bit_offset = bro(byte_offset);
3073
      int destr = regfrmdest(&dest,sp);
3074
      int byte_offset_reg = reg_operand(byte_offset, sp);
3075
      int bit_offset_reg;
3076
      space nsp;
3077
      ans aa;
3078
      nsp = guardreg(destr, sp);
3079
 
3080
      rir_ins( i_sl , byte_offset_reg , 3 , destr);
3081
      if ( name(bit_offset)==val_tag )
3082
      {
3083
	if( no(bit_offset)!=0 )
3084
	{
3085
	  rir_ins(i_a, destr , no(bit_offset) , destr);
3086
	}
3087
      }
3088
      else 
3089
      {
3090
	bit_offset_reg = reg_operand(bit_offset, nsp);
3091
	rrr_ins(i_a, destr , bit_offset_reg , destr);
3092
      }
3093
      setregalt(aa, destr);
3094
      mka.regmove = move(aa, dest, nsp.fixed, 0);
3095
      return mka;
3096
    }
3097
/*****************************************************************************/
3098
   case offset_subtract_tag: 
3099
    { 
3100
     /*
3101
      * bit offset - byte offset
3102
      * all others converted to minus_tag by needscan
3103
      */
3104
     exp bit_offset = son(e);
3105
     exp byte_offset = bro(bit_offset);
3106
     int destr = regfrmdest(&dest, sp) ;
3107
     int byte_offset_reg = reg_operand(byte_offset, sp);
3108
     int bit_offset_reg;
3109
     space nsp;
3110
     ans aa;
3111
     nsp = guardreg( destr,sp);
3112
 
3113
     rir_ins(i_sl, byte_offset_reg , 3 , destr);
3114
     if(name(bit_offset)==val_tag)
3115
     {
3116
       if(no(bit_offset)!=0)
3117
       {
3118
	 rir_ins(i_s,destr,no(bit_offset),destr);
3119
       }
3120
     }
3121
     else
3122
     {
3123
       bit_offset_reg = reg_operand(bit_offset, nsp);
3124
       rrr_ins(i_s, destr, bit_offset_reg, destr);
3125
     }
3126
     setregalt(aa, destr);
3127
     mka.regmove = move(aa, dest, nsp.fixed, 0);
3128
     return mka;
3129
   }
3130
/*****************************************************************************/
3131
   case current_env_tag:
3132
    {
3133
      int r=regfrmdest(&dest, sp);
3134
      ans aa;
3135
      if(p_has_fp)
3136
      {
3137
       	mov_rr_ins(R_FP,r);comment("move FP to register");
3138
      }
3139
      else
3140
      {
3141
	/* If we don't have a frame pointer we give the location
3142
	   of where the frame pointer would be anyway */
3143
	rir_ins(i_a , R_SP, p_frame_size , r );
3144
      }
3145
      setregalt(aa, r);
3146
      mka.regmove = move(aa, dest, sp.fixed, 0);
3147
      return mka;
3148
    }
3149
/*****************************************************************************/
3150
   case env_offset_tag:
3151
    {
3152
      /* NOTE: env_offset works in conjunction with current_env.
3153
	 So it must be consistent with current env */
3154
      constval = frame_offset(son(e));
3155
      goto moveconst;
3156
    }
3157
/*****************************************************************************/
3158
   case goto_lv_tag:
3159
    {
3160
      int r = reg_operand(son(e),sp);
3161
 
3162
      mt_ins(i_mtctr, r);
3163
      z_ins(i_bctr);
3164
      clear_all();
3165
      return mka;
3166
    }
3167
/*****************************************************************************/
3168
   case make_lv_tag:
3169
    {
3170
      int r = regfrmdest(&dest,sp);
3171
      int next_mlv_number = get_next_mlv_number();
3172
      ans aa;
3173
      long marked_label= no(son(pt(e)));
3174
 
3175
      fprintf(as_file,"\t.toc\n");
3176
      fprintf(as_file,"T.make_lv%d:\t.tc\tL.%d[TC],L.%d\n",
3177
	      next_mlv_number,(int)marked_label,(int)marked_label);
3178
      fprintf(as_file, "\t.csect\t[PR]\n");
3179
      fprintf(as_file, "\t%s\t%d,T.make_lv%d(2)\n",
3180
	      get_instruction(i_l),r,next_mlv_number);
3181
      clear_reg(r);
3182
      setregalt(aa,r);
3183
      move(aa,dest, guardreg(r,sp).fixed, 0);
3184
      mka.regmove = r;
3185
      return mka;
3186
    }
3187
/*****************************************************************************/
3188
   case long_jump_tag:
3189
    {
3190
     int fp = reg_operand(son(e), sp);
3191
     int labval = reg_operand(bro(son(e)), sp);
3192
     /* 
3193
      * Long jumps are always done through the frame pointer 
3194
      * since you cannot tell whether or not you are going in
3195
      * to a proc which needs a frame pointer or not
3196
      * so it is made sure that any procedure that has
3197
      * make_local_lv and current_env is forced to have a
3198
      * frame pointer.
3199
      */
3200
     FULLCOMMENT("long_jump");
3201
     mov_rr_ins(fp,R_FP);comment("move register to FP");
3202
     mt_ins(i_mtctr, labval);
3203
     z_ins(i_bctr);
3204
     clear_all();
3205
     return mka;
3206
   }
3207
/*****************************************************************************/
3208
   case alloca_tag:
3209
    {
3210
      int dreg = regfrmdest(&dest,sp);
3211
      ans aa;
3212
      int xdreg = (IS_R_TMP(dreg) && checkalloc(e)) ? getreg (sp.fixed) : dreg;
3213
 
3214
      ASSERT(p_has_alloca);
3215
      ASSERT(p_has_fp);
3216
 
3217
 
3218
 
3219
      if(name(son(e))==val_tag)
3220
      {
3221
	/* allocate constant number of bytes on stack*/
3222
	int no_of_bytes = ALLOCA_ALIGNMENT(no(son(e)));
3223
	if(checkalloc(e))
3224
	{
3225
	  rir_ins(i_a,R_SP,-(long)no_of_bytes,xdreg);
3226
	}
3227
	else
3228
	{
3229
	  rir_ins(i_a,R_SP,-(long)no_of_bytes,R_SP);
3230
	}
3231
      }
3232
      else
3233
      {
3234
	int nreg = reg_operand(son(e),sp);
3235
	/* adjust to correct alignment, i.e mul of 8 */
3236
	rir_ins(i_a,nreg,7,R_TMP0);
3237
	rir_ins(i_and,R_TMP0,~7,R_TMP0);
3238
	if (checkalloc(e))
3239
	{
3240
	  rrr_ins(i_sf,R_TMP0,R_SP,xdreg);
3241
	}
3242
	else
3243
	{
3244
	  rrr_ins(i_sf,R_TMP0,R_SP,R_SP);
3245
	}
3246
 
3247
      }
3248
      if (checkalloc(e))
3249
      {
3250
	baseoff b;
3251
	int cr;
3252
	int slab;
3253
	b = find_tg("__TDFstacklim");
3254
	cr = next_creg();
3255
 
3256
	slab = get_stack_overflow_lab();
3257
	ld_ins(i_l,b,R_TMP0);
3258
	cmp_rr_ins(i_cmp,xdreg,R_TMP0,cr);
3259
	bc_ins(i_blt,cr,slab,UNLIKELY_TO_JUMP);
3260
	mov_rr_ins(xdreg,R_SP);comment(NIL);
3261
      }
3262
 
3263
 
3264
 
3265
      if (p_args_and_link_size==0)
3266
      {
3267
	mov_rr_ins(R_SP,dreg);comment(NIL);
3268
      }
3269
      else
3270
      {
3271
	rir_ins(i_a, R_SP, p_args_and_link_size,dreg);
3272
      }
3273
      if(p_has_back_chain)
3274
      {
3275
	save_back_chain_using_frame_pointer();
3276
      }
3277
      if(p_has_saved_sp)
3278
      {
3279
	save_sp_on_stack();
3280
      }
3281
      setregalt(aa,dreg);
3282
      move(aa,dest,guardreg(dreg,sp).fixed,0);
3283
      return mka;
3284
    }
3285
/*****************************************************************************/
3286
   case last_local_tag:
3287
    {
3288
      int r = regfrmdest(&dest, sp);
3289
      ans aa;
3290
      /* The last pointer returned by alloca is placed into r */
3291
 
3292
      if(p_args_and_link_size !=0)
3293
      {
3294
	rir_ins(i_a, R_SP, p_args_and_link_size, r);
3295
      }
3296
      else
3297
      {
3298
	mov_rr_ins( R_SP , r );comment(NIL);
3299
      }
3300
      setregalt(aa, r);
3301
      mka.regmove = move(aa, dest, sp.fixed, 1);
3302
      return mka;
3303
    }
3304
/*****************************************************************************/
3305
   case local_free_all_tag:
3306
    {
3307
      if(p_has_alloca)
3308
      {
3309
	/* The stack pointer is returned to how it was before
3310
	   any calls to alloca were made */
3311
	rir_ins(i_a , R_FP,- p_frame_size ,R_SP);
3312
	if (p_has_back_chain)
3313
	{
3314
	  save_back_chain_using_frame_pointer();
3315
	}
3316
	if(p_has_saved_sp)
3317
	{
3318
	  save_sp_on_stack();
3319
	}
3320
      }
3321
      return mka;
3322
    }
3323
/*****************************************************************************/
3324
   case local_free_tag:
3325
    {
3326
      int r;
3327
      int off;
3328
      space nsp;
3329
 
3330
      ASSERT(p_has_alloca);
3331
      r = reg_operand(son(e), sp); 
3332
      /* r is a pointer returned by alloca
3333
	 off is the number of bytes to free up */
3334
      if (name(bro(son(e)))==val_tag)
3335
      {
3336
	int displacement=ALLOCA_ALIGNMENT(no(bro(son(e))));
3337
	displacement -= p_args_and_link_size;
3338
	if(displacement!=0)
3339
	{
3340
	  rir_ins(i_a,r,displacement,R_SP);
3341
	}
3342
	else
3343
	{
3344
	  mov_rr_ins(r,R_SP);comment(NIL);
3345
	}
3346
      }
3347
      else
3348
      {    
3349
	nsp=guardreg(r,sp);
3350
	off = reg_operand(bro(son(e)),nsp);
3351
 
3352
	rir_ins(i_a,off,7,off);
3353
	rir_ins(i_and,off,~7,off);
3354
	rrr_ins(i_a,r,off,R_SP);
3355
	if (p_args_and_link_size !=0)
3356
	{
3357
	  rir_ins(i_a , R_SP , - p_args_and_link_size , R_SP);
3358
	}
3359
      }
3360
      if(p_has_back_chain)
3361
      {
3362
	save_back_chain_using_frame_pointer();
3363
      }
3364
      if(p_has_saved_sp)
3365
      {
3366
	save_sp_on_stack();
3367
      }
3368
      return mka;
3369
    }
3370
/*****************************************************************************/
3371
/* SPEC 3.1 constructions */
3372
/**************************/
3373
   case locptr_tag:
3374
    {
3375
      /* this is the only way of accessing callers in a general proc 
3376
       when calculating general_env_offset using current_env */
3377
      int destr = regfrmdest(&dest,sp);
3378
      int pr = reg_operand(son(e),sp);
3379
      space nsp;
3380
      baseoff b;
3381
      ans aa;
3382
      b.base = pr;
3383
      b.offset = 0; /* R_TP lives where R_FP is for general proc */
3384
      ld_ro_ins(i_l,b,destr);comment("locptr:get TP using FP");
3385
      setregalt(aa,destr);
3386
      nsp = guardreg(destr,sp);
3387
      mka.regmove = move(aa,dest,nsp.fixed,0);
3388
      return mka;
3389
    }
3390
/*****************************************************************************/
3391
   case apply_general_tag:		/* procedure call */
3392
    {
3393
      return make_apply_general_tag_code(e, sp, dest, exitlab);
3394
    }
3395
/*****************************************************************************/
3396
   case tail_call_tag:
3397
    {
3398
      make_tail_call_tag_code(e,sp);
3399
      return mka;
3400
    }
3401
/*****************************************************************************/
3402
   case make_callee_list_tag:
3403
    {
3404
      make_callee_list_tag_code(e,sp);
3405
      return mka;
3406
    }    
3407
/*****************************************************************************/
3408
   case same_callees_tag:
3409
    {
3410
      make_same_callees_tag_code(e,sp);
3411
      return mka;
3412
    }
3413
/*****************************************************************************/
3414
   case make_dynamic_callee_tag:
3415
    {
3416
      make_dynamic_callee_tag_code(e,sp);
3417
      return mka;
3418
    }
3419
/*****************************************************************************/
3420
   case caller_name_tag:
3421
    {
3422
      return mka;
3423
    }
3424
/*****************************************************************************/
3425
   case return_to_label_tag:
3426
    {
3427
      make_return_to_label_tag_code(e,sp);
3428
      return mka;
3429
    }
3430
/*****************************************************************************/
3431
   case set_stack_limit_tag:
3432
    {
3433
      baseoff b;
3434
      int r = reg_operand(son(e),sp);
3435
      b = find_tg("__TDFstacklim");
3436
      st_ins(i_st,r,b);
3437
      return mka;
3438
    }
3439
/*****************************************************************************/
3440
   case env_size_tag:
3441
    {
3442
      exp tg = son(son(e));
3443
      procrec * pr = &procrecs[no(son(tg))];
3444
      constval = ((pr->frame_size)>>3) + pr->max_callee_bytes;
3445
      goto moveconst;
3446
    }
3447
/*****************************************************************************/
3448
   case trap_tag:
3449
    {
3450
      do_trap(e);
3451
      return mka;
3452
    }
3453
/*****************************************************************************/
3454
   default:
3455
    fail("TDF construct not done yet in make_code");
3456
  }				/* end outer switch */
3457
  ASSERT(0);			/* should have return/goto from switch */
3458
#ifdef DEBUG_POWERTRANS
3459
  showme(e,0,1);
3460
#endif
3461
  /*NOTREACHED*/
3462
 
3463
 
3464
 moveconst_zero:
3465
  constval = 0;
3466
 moveconst:
3467
  {
3468
    int r = regfrmdest(&dest,sp);
3469
    ans aa;
3470
    FULLCOMMENT1("load constval = %d",constval);
3471
    ld_const_ins(constval, r);
3472
    setregalt(aa, r);
3473
    move(aa, dest, guardreg(r, sp).fixed, 1);
3474
    mka.regmove = r;
3475
    return mka;
3476
  }
3477
}				/* end make_code */
3478
 
3479
void move_dlts PROTO_N ((dr,sr,szr,bytemove)) PROTO_T (int dr X int sr X int szr X int bytemove ) 
3480
  /* move szr bytes to dr from sr (using R_TMP0)- either nooverlap or dr<=sr */
3481
{
3482
  baseoff sr_baseoff;
3483
  baseoff dr_baseoff;
3484
  int lin = new_label();
3485
 
3486
  sr_baseoff.base = sr;
3487
  sr_baseoff.offset = 1;
3488
  dr_baseoff.base = dr;
3489
  dr_baseoff.offset = 1;
3490
  /* +++ could do this word at a time? */
3491
  rir_ins(i_a,sr,-1,sr);               /* ai     sr,sr,-1 */
3492
  rir_ins(i_a,dr,-1,dr);               /* ai     dr,dr,-1 */
3493
  mt_ins(i_mtctr,szr);                 /* mtctr  szr      */
3494
  set_label(lin);                      /* L.???           */
3495
  ld_ro_ins(i_lbzu,sr_baseoff,R_TMP0); /* lbzu   0,1(sr)  */comment(NIL);
3496
  st_ro_ins(i_stbu,R_TMP0,dr_baseoff); /* stbu   0,1(dr)  */comment(NIL);
3497
  uncond_ins(i_bdn, lin);              /* bdn    L.???    */
3498
  rrr_ins( i_sf, szr , sr ,sr );       /* sf     sr,szr,sr*/
3499
  rir_ins( i_a , sr , 1, sr);          /* ai     sr,sr,1  */
3500
  rrr_ins( i_sf, szr , dr ,dr );       /* sf     dr,szr,dr*/
3501
  rir_ins( i_a ,dr , 1, dr );          /* ai     dr,dr,1  */
3502
  return;
3503
}
3504
 
3505
void move_dgts PROTO_N ((dr, sr, szr, bytemove)) PROTO_T (int dr X int sr X int szr X int bytemove)
3506
	/* move szr bytes to dr from sr (using R_TMP0) with overlap and dr>sr */
3507
{ 
3508
  baseoff sr_baseoff;
3509
  baseoff dr_baseoff;
3510
  int lin = new_label();
3511
 
3512
  sr_baseoff.base = sr;
3513
  sr_baseoff.offset = -1;
3514
  dr_baseoff.base = dr;
3515
  dr_baseoff.offset = -1;
3516
  /* +++ could do this word at a time? */
3517
  rrr_ins(i_a,sr,szr,sr);              /* a      sr,szr,sr */
3518
  rrr_ins(i_a,dr,szr,dr);              /* a      dr,szr,dr */
3519
  mt_ins(i_mtctr,szr);                 /* mtctr  szr       */
3520
  set_label(lin);                      /* L.???            */
3521
  ld_ro_ins(i_lbzu,sr_baseoff,R_TMP0); /* lbzu   0,-1(sr)  */comment(NIL);
3522
  st_ro_ins(i_stbu,R_TMP0,dr_baseoff); /* stbu   0,-1(dr)  */comment(NIL);
3523
  uncond_ins(i_bdn, lin);              /* bdn    L.???     */
3524
  return;
3525
}
3526
 
3527
int regfrmdest PROTO_N ((dest, sp)) PROTO_T(where * dest X space sp ) 
3528
{
3529
  switch (dest->answhere.discrim) {
3530
   case inreg: 
3531
    {
3532
      return regalt (dest->answhere);
3533
 
3534
    }
3535
   default: 
3536
    {
3537
      return getreg (sp.fixed);
3538
    }
3539
  }
3540
}	
3541
freg fregfrmdest PROTO_N ((dble,dest,sp)) PROTO_T (bool dble X where * dest X space sp )
3542
{
3543
  freg fr;
3544
 
3545
  switch (dest->answhere.discrim)
3546
  {
3547
   case infreg:
3548
    {
3549
      fr = fregalt(dest->answhere);
3550
      fr.dble = dble;
3551
      return fr;
3552
    }
3553
   default:
3554
    {
3555
      fr.dble = dble;
3556
      fr.fr = getfreg(sp.flt);
3557
      return fr;
3558
    }
3559
 
3560
  }
3561
}
3562
 
3563
static int get_next_mlv_number PROTO_Z ()
3564
{
3565
  static next_lv_number=0;
3566
  next_lv_number++;
3567
  return next_lv_number;
3568
}
3569
 
3570
 
3571
 
3572
void adjust_to_size PROTO_N ((src_shpe,sreg,dest_shpe,dreg,trap)) PROTO_T ( int src_shpe X int sreg X int dest_shpe X int dreg X int trap) 
3573
{
3574
 
3575
/*                 
3576
 
3577
 
3578
                      d   e   s   t
3579
 
3580
                  s   u   s   u   s   u
3581
                  c   c   w   w   l   l
3582
                  h   h   o   o   o   o
3583
                  a   a   r   r   n   n
3584
		  r   r   d   d   g   g
3585
 
3586
      schar       0   X   0   X   0   0
3587
      uchar       X   0   0   0   0   0
3588
 s    sword       X   X   0   X   0   0
3589
 r    uword       X   X   X   0   0   0
3590
 c    slong       X   X   X   X   0   0
3591
      ulong       X   X   X   X   0   0
3592
   */
3593
  /* Perform the options on the above table */
3594
  if( src_shpe == dest_shpe || 
3595
      dest_shpe == slonghd  || 
3596
      dest_shpe == ulonghd  || 
3597
      (src_shpe == scharhd && dest_shpe == swordhd) || 
3598
      (src_shpe == ucharhd && dest_shpe != scharhd) )
3599
  {
3600
    /* Do no adjustment */
3601
    if(sreg!=dreg)
3602
    {
3603
      mov_rr_ins(sreg,dreg);comment(NIL);
3604
    }
3605
    return;
3606
  }
3607
 
3608
 
3609
  if(trap==NO_ERROR_JUMP)
3610
  {
3611
    switch(dest_shpe)
3612
    {
3613
     case scharhd:
3614
      if(architecture==POWERPC_CODE)
3615
      {
3616
	rr_ins(i_extsb,sreg,dreg);
3617
      }
3618
      else
3619
      {
3620
	rir_ins(i_sl, sreg, 24, dreg);
3621
	rir_ins(i_sra, dreg, 24, dreg);
3622
      }
3623
      break;
3624
     case ucharhd:
3625
      rir_ins(i_and, sreg, 0x000000ff, dreg);
3626
      break;
3627
     case swordhd:
3628
      rr_ins(i_exts, sreg, dreg);
3629
      break;
3630
     case uwordhd:
3631
      rir_ins(i_and, sreg, 0x0000ffff, dreg);
3632
      break;
3633
     case slonghd:
3634
     case ulonghd:
3635
      mov_rr_ins(sreg,dreg);comment(NIL);
3636
      break;
3637
     default:
3638
      fail("Unexpected integer shape in adjust_to_size");
3639
      break;
3640
    }
3641
  }
3642
  else
3643
  {
3644
    switch(dest_shpe)
3645
    {
3646
     case scharhd:
3647
      testsigned(sreg, -128, 127, trap);
3648
      if(sreg !=dreg){ mov_rr_ins(sreg,dreg);comment(NIL); }
3649
      break;
3650
     case ucharhd:
3651
      testusigned(sreg,255,trap);
3652
      if(sreg !=dreg){ mov_rr_ins(sreg,dreg);comment(NIL); }
3653
      break;
3654
     case swordhd:
3655
      testsigned(sreg,-0x8000,0x7fff,trap);
3656
      if(sreg !=dreg){ mov_rr_ins(sreg,dreg);comment(NIL); }
3657
      break;
3658
     case uwordhd:
3659
      testusigned(sreg,0xffff,trap);
3660
      if(sreg !=dreg){ mov_rr_ins(sreg,dreg);comment(NIL); }
3661
      break;
3662
     case slonghd:
3663
     case ulonghd:
3664
      mov_rr_ins(sreg,dreg);comment(NIL);
3665
      break;
3666
     default:
3667
      fail("Unexpected integer shape in adjust_to_size");
3668
      break;
3669
    }
3670
  }
3671
  return;
3672
}