Subversion Repositories tendra.SVN

Rev

Rev 2 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
7 7u83 2
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
3
 * All rights reserved.
4
 *
5
 * Redistribution and use in source and binary forms, with or without
6
 * modification, are permitted provided that the following conditions are met:
7
 *
8
 * 1. Redistributions of source code must retain the above copyright notice,
9
 *    this list of conditions and the following disclaimer.
10
 * 2. Redistributions in binary form must reproduce the above copyright notice,
11
 *    this list of conditions and the following disclaimer in the documentation
12
 *    and/or other materials provided with the distribution.
13
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
14
 *    may be used to endorse or promote products derived from this software
15
 *    without specific, prior written permission.
16
 *
17
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
18
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
19
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
20
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
21
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
22
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
23
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
24
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
26
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
27
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
 *
29
 * $Id$
30
 */
31
/*
2 7u83 32
    		 Crown Copyright (c) 1997
33
 
34
    This TenDRA(r) Computer Program is subject to Copyright
35
    owned by the United Kingdom Secretary of State for Defence
36
    acting through the Defence Evaluation and Research Agency
37
    (DERA).  It is made available to Recipients with a
38
    royalty-free licence for its use, reproduction, transfer
39
    to other parties and amendment for any purpose not excluding
40
    product development provided that any such use et cetera
41
    shall be deemed to be acceptance of the following conditions:-
42
 
43
        (1) Its Recipients shall ensure that this Notice is
44
        reproduced upon any copies or amended versions of it;
45
 
46
        (2) Any amended version of it shall be clearly marked to
47
        show both the nature of and the organisation responsible
48
        for the relevant amendment or amendments;
49
 
50
        (3) Its onward transfer from a recipient to another
51
        party shall be deemed to be that party's acceptance of
52
        these conditions;
53
 
54
        (4) DERA gives no warranty or assurance as to its
55
        quality or suitability for any purpose and DERA accepts
56
        no liability whatsoever in relation to any use to which
57
        it may be put.
58
*/
59
 
60
 
61
/**********************************************************************
62
$Author: release $
63
$Date: 1998/01/17 15:56:06 $
64
$Revision: 1.1.1.1 $
65
$Log: new_code.c,v $
66
 * Revision 1.1.1.1  1998/01/17  15:56:06  release
67
 * First version to be checked into rolling release.
68
 *
69
 * Revision 1.39  1996/11/12  10:37:36  currie
70
 * cases with big unsigned
71
 *
72
Revision 1.38  1996/03/28 11:36:27  currie
73
minus unsigned with et
74
 
75
 * Revision 1.37  1996/03/14  17:09:02  currie
76
 * empty callers with postlude
77
 *
78
 * Revision 1.36  1996/01/30  12:36:31  currie
79
 * leaf vcallees with current_env
80
 *
81
 * Revision 1.35  1996/01/17  10:25:02  currie
82
 * tidy transformed idents of idents
83
 *
84
 * Revision 1.34  1996/01/10  17:59:28  currie
85
 * postlude uses in callees
86
 *
87
 * Revision 1.33  1996/01/09  12:00:48  currie
88
 * var callee par in reg
89
 *
90
 * Revision 1.32  1996/01/08  17:05:27  currie
91
 * current_env in depends_on
92
 *
93
 * Revision 1.31  1996/01/02  15:00:57  currie
94
 * return 64-bit const
95
 *
96
 * Revision 1.30  1995/12/08  11:20:06  currie
97
 * Constant offsets + allocaerr_lab
98
 *
99
 * Revision 1.29  1995/11/23  13:17:25  currie
100
 * Cache real consts + get text file name right in diags
101
 *
102
 * Revision 1.28  1995/10/31  17:46:10  currie
103
 * max-min register error
104
 *
105
 * Revision 1.27  1995/10/31  15:04:55  currie
106
 * div1 error
107
 *
108
 * Revision 1.26  1995/10/25  13:48:23  currie
109
 * change to position of .glob
110
 *
111
 * Revision 1.25  1995/10/23  11:18:25  currie
112
 * put in gpword for switches in PIC-code
113
 *
114
 * Revision 1.24  1995/10/20  10:48:01  currie
115
 * avs -slow + attempts to cheat buggy scheduler
116
 *
117
 * Revision 1.23  1995/10/06  14:46:26  currie
118
 * nops in round
119
 *
120
 * Revision 1.22  1995/09/26  09:00:54  currie
121
 * tail call errors in sieve
122
 *
123
 * Revision 1.21  1995/09/21  15:42:51  currie
124
 * silly reordering by as again
125
 *
126
 * Revision 1.20  1995/09/20  14:23:02  currie
127
 * callee-list blunder + fix for silliness in ultrix assembler
128
 *
129
 * Revision 1.19  1995/09/12  10:59:39  currie
130
 * gcc pedanttry
131
 *
132
 * Revision 1.18  1995/08/21  16:13:23  currie
133
 * var pars
134
 *
135
 * Revision 1.17  1995/08/16  16:06:58  currie
136
 * Shortened some .h names
137
 *
138
 * Revision 1.16  1995/08/15  12:20:24  currie
139
 * Dynamic callees!??
140
 *
141
 * Revision 1.15  1995/08/15  10:47:29  currie
142
 * Dynamic callees - protect parregs & link
143
 *
144
 * Revision 1.14  1995/08/15  09:19:29  currie
145
 * Dynamic callees + trap_tag
146
 *
147
 * Revision 1.13  1995/08/10  08:49:40  currie
148
 * var callee tail call
149
 *
150
 * Revision 1.12  1995/08/09  10:53:42  currie
151
 * apply_general bug
152
 *
153
 * Revision 1.11  1995/07/06  17:12:28  currie
154
 * tail call again
155
 *
156
 * Revision 1.10  1995/07/05  11:44:32  currie
157
 * Postlude names in bits!
158
 *
159
 * Revision 1.9  1995/07/05  08:42:40  currie
160
 * Various tail call bugs
161
 *
162
 * Revision 1.7  1995/07/03  15:31:55  currie
163
 * untidy call
164
 *
165
 * Revision 1.6  1995/07/03  10:09:32  currie
166
 * untidy return
167
 *
168
 * Revision 1.5  1995/06/29  16:30:19  currie
169
 * Tail call errors
170
 *
171
 * Revision 1.4  1995/06/28  12:15:24  currie
172
 * New make_stack_limit etc
173
 *
174
 * Revision 1.3  1995/05/05  08:13:01  currie
175
 * initial_value + signtures
176
 *
177
 * Revision 1.2  1995/04/19  16:10:37  currie
178
 * Unset variables - purify
179
 *
180
 * Revision 1.1  1995/04/13  09:08:06  currie
181
 * Initial revision
182
 *
183
***********************************************************************/
184
/* new_code.c
185
	This is the principal code producing module
186
****************************************************************/
187
 
188
#include "config.h"
189
#include "common_types.h"
190
#include "addrtypes.h"
191
#include "tags.h"
192
#include "expmacs.h"
193
#include "exp.h"
194
#include "exptypes.h"
195
#include "externs.h"
196
#include "loc_signal.h"
197
#include "maxminmacs.h"
198
#include "shapemacs.h"
199
#include "basicread.h"
200
#include "procrectypes.h"
201
#include "eval.h"
202
#include "move.h"
203
#include "operators.h"
204
#include "psu_ops.h"
205
#include "getregs.h"
206
#include "guard.h"
207
#include "locate.h"
208
#include "code_here.h"
209
#include "inst_fmt.h"
210
#include "mips_ins.h"
211
#include "handle_sregs.h"
212
#include "bitsmacs.h"
213
#include "labels.h"
214
#include "regexps.h"
215
#include "special.h"
216
#include "new_tags.h"
217
#include "out_ba.h"
218
#include "ibinasm.h"
219
#include "syms.h"
220
#include "flags.h"
221
#include "main.h"
222
#include "dump_distr.h"
223
#include "extratags.h"
224
#include "mipsdiags.h"
225
#include "frames.h"
226
#include "f64.h"
227
#include "regable.h"
228
#include "diag_fns.h"
229
#include "flpt.h"
230
#include "new_code.h"
231
 
232
extern  FILE * as_file;
233
extern int current_symno;
234
extern  procrec * procrecs;
235
 
236
long  fscopefile;
237
 
238
ans procans;
239
int   rscope_level;
240
int   rscope_label;
241
int   result_label = 0;
242
int   currentnop;
243
long max_args;
244
 
245
where nowhere;
246
 
247
static exp crt_proc;
248
 
249
bool NONEGSHIFTS = 1;
250
 
251
long aritherr_lab = 0;
252
long stackerr_lab = 0;
253
long allocaerr_lab = 0;
254
 
7 7u83 255
extern exp find_named_tg(char *, shape);
256
extern shape f_pointer(alignment);
257
extern alignment f_alignment(shape);
2 7u83 258
extern shape f_proc;
259
 
260
typedef struct{int dble; r2l r; instore ad;} rcache;
261
static rcache rca[16];
262
static int nca = 0;
263
 
264
void do_exception
7 7u83 265
(int e)
2 7u83 266
{
267
	baseoff b;
268
	b.base = 0; b.offset = e;
269
	ls_ins(i_li, 4,  b);
270
	b = boff(find_named_tg("__TDFhandler", f_pointer(f_alignment(f_proc))));
271
	ls_ins(i_lw, 25, b);
272
	br_ins(i_j, 25);
273
}
274
 
275
long trap_label
7 7u83 276
(exp e)
2 7u83 277
{
7 7u83 278
	if ((errhandle(e) &3) ==3) {
279
          	if (aritherr_lab==0)aritherr_lab = new_label();
2 7u83 280
          	return aritherr_lab;
281
        }
7 7u83 282
        else return no(son(pt(e)));
2 7u83 283
}
284
 
285
void dump_gp
7 7u83 286
(void)
2 7u83 287
{
288
	baseoff b;
289
	b.base = 29; b.offset = locals_offset>>3;
290
	ls_ins(i_sw, 28, b);
291
}
292
 
293
void reset_gp
7 7u83 294
(void)
2 7u83 295
{
296
	baseoff b;
297
	if (Has_vcallees) {
298
		b.base = local_reg;
7 7u83 299
		b.offset = (locals_offset - frame_size) >>3;
2 7u83 300
	}
301
	else
302
	if (Has_fp) {
303
		b.base = 30;
7 7u83 304
		b.offset = (locals_offset - frame_size - callee_size) >>3;
2 7u83 305
	}
306
	else {
307
		b.base = 29;
308
		b.offset = locals_offset>>3;
309
        }
310
	ls_ins(i_lw, 28, b);
311
}
312
 
313
bool unsafe
7 7u83 314
(exp e)
2 7u83 315
{		/*  usages of parameters which might be
316
				   vararg */
317
/*
318
  if (last (e))
319
    return (name (bro (e)) != cont_tag && name (bro (e)) != par_tag);
320
  if (last (bro (e)) && name (bro (bro (e))) == ass_tag)
321
    return 0;
322
  if (name (father (e)) == par_tag)
323
    return 0;
324
  if (last (bro (e)) && name (bro (bro (e))) == ident_tag) {
325
    exp u;
326
    if (isvar (bro (bro (e))))
327
      return 1;
328
    for (u = pt (bro (bro (e))); u != nilexp; u = pt (u)) {
329
      if (unsafe (u))
330
	return 1;
331
    }
332
    return 0;
333
  }
334
  return 1;
335
*/ failer("unsafe");
336
   return 1;
337
}
338
 
339
 
340
 
341
void checknan
7 7u83 342
(exp e, space sp)
2 7u83 343
{
344
           long trap = trap_label(e);
345
           int r1 = getreg(sp.fixed);
346
           int r2 = getreg(guardreg(r1, sp).fixed);
347
           cop_ins(i_cfc1, r1, 31);
348
	   rri_ins(i_and, r2, r1, 0x70); /* not including underflo - my choice */
349
	   rrr_ins(i_xor, r1, r1, r2);
350
	   cop_ins(i_ctc1, r1, 31);
351
	   condri_ins(i_bne, r2, 0, trap);
352
}
353
/*
354
char *usbranches (i)
355
	int i;
356
{
357
  switch (i) {
358
    case  1:
359
            return i_bleu;
360
    case 2:
361
      return i_bltu;
362
    case 3:
363
      return i_bgeu;
364
    case 4:
365
      return i_bgtu;
366
    case 5:
367
      return i_bne;
368
    case 6:
369
      return i_beq;
370
  }
371
}
372
*/
373
 
374
void testsigned
7 7u83 375
(int r, long lower, long upper, long lab)
2 7u83 376
{
377
	condri_ins(i_blt, r, lower, lab);
378
	condri_ins(i_bgt, r, upper, lab);
379
}
380
 
381
void testusigned
7 7u83 382
(int r, long maxval, long lab)
2 7u83 383
{
384
     	condri_ins(i_bgtu, r, maxval, lab);
385
}
386
 
387
/*
388
char *sbranches(i)
389
	int i;
390
{
391
  switch (i) {
392
    case  1:
393
            return i_ble;
394
    case 2:
395
      return i_blt;
396
    case 3:
397
      return i_bge;
398
    case 4:
399
      return i_bgt;
400
    case 5:
401
      return i_bne;
402
    case 6:
403
      return i_beq;
404
  }
405
}
406
*/
407
 
408
char * branches
7 7u83 409
(shape s, int i)
2 7u83 410
{
411
	int n = name(s);
412
	if (n == scharhd || n == swordhd || n == slonghd
413
		|| n == offsethd) {
414
          switch (i) {
415
            case  1:
416
                    return i_ble;
417
            case 2:
418
              return i_blt;
419
            case 3:
420
              return i_bge;
421
            case 4:
422
              return i_bgt;
423
            case 5:
424
              return i_bne;
425
            case 6:
426
              return i_beq;
427
          }
428
        }
429
        else {
430
  		switch (i) {
431
		    case  1:
432
		            return i_bleu;
433
		    case 2:
434
		      return i_bltu;
435
		    case 3:
436
		      return i_bgeu;
437
		    case 4:
438
		      return i_bgtu;
439
		    case 5:
440
		      return i_bne;
441
		    case 6:
442
		      return i_beq;
443
		  }
444
	}
445
	return i_beq;
446
}
447
 
448
/*
449
char *ussets
450
    PROTO_N ( (i) )
451
    PROTO_T ( int i )
452
{
453
  switch (i) {
454
    case  1:
455
      return i_sgtu;
456
    case 2:
457
      return i_sgeu;
458
    case 3:
459
      return i_sltu;
460
    case 4:
461
      return i_sleu;
462
    case 5:
463
      return i_seq;
464
    case 6:
465
      return i_sne;
466
  }
467
}
468
 
469
char *ssets
470
    PROTO_N ( (i) )
471
    PROTO_T ( int i )
472
{
473
  switch (i) {
474
    case  1:
475
            return i_sgt;
476
    case 2:
477
      return i_sge;
478
    case 3:
479
      return i_slt;
480
    case 4:
481
      return i_sle;
482
    case 5:
483
      return i_seq;
484
    case 6:
485
      return i_sne;
486
  }
487
}
488
*/
489
 
490
char * sets
7 7u83 491
(shape s, int i)
2 7u83 492
{
493
	int n = name(s);
494
	if (n == scharhd || n == swordhd || n == slonghd
495
		|| n == offsethd) {
496
		  switch (i) {
497
		    case  1:
498
		            return i_sgt;
499
		    case 2:
500
		      return i_sge;
501
		    case 3:
502
		      return i_slt;
503
		    case 4:
504
		      return i_sle;
505
		    case 5:
506
		      return i_seq;
507
		    case 6:
508
		      return i_sne;
509
		  }
510
	}
511
	else {
512
		  switch (i) {
513
		    case  1:
514
		            return i_sgtu;
515
		    case 2:
516
		      return i_sgeu;
517
		    case 3:
518
		      return i_sltu;
519
		    case 4:
520
		      return i_sleu;
521
		    case 5:
522
		      return i_seq;
523
		    case 6:
524
		      return i_sne;
525
		  }
526
	}
527
	return i_seq;
528
}
529
 
530
char *fbranches
7 7u83 531
(int i)
2 7u83 532
{
533
  switch (i) {
534
    case  1:
535
            return i_c_le_s;
536
    case 2:
537
      return i_c_lt_s;
538
    case 3:
539
      return i_c_lt_s;
540
    case 4:
541
      return i_c_le_s;
542
    case 5:
543
      return i_c_eq_s;
544
    case 6:
545
      return i_c_eq_s;
546
  }
547
  return i_c_eq_s;
548
}
549
 
550
char *fdbranches
7 7u83 551
(int i)
2 7u83 552
{
553
  switch (i) {
554
    case  1:
555
            return i_c_le_d;
556
    case 2:
557
      return i_c_lt_d;
558
    case 3:
559
      return i_c_lt_d;
560
    case 4:
561
      return i_c_le_d;
562
    case 5:
563
      return i_c_eq_d;
564
    case 6:
565
      return i_c_eq_d;
566
  }
567
  return i_c_eq_d;
568
}
569
 
570
long  notbranch[6] = {
571
  4, 3, 2, 1, 6, 5
572
};
573
 /* used to invert TDF tests */
574
 
575
int   bitsin
7 7u83 576
(long b)
2 7u83 577
{		/* counts the bits in b */
578
  int   n = 0;
579
  long  mask = 1;
580
  for (; b != 0;) {
7 7u83 581
    n += ((b & mask)!= 0)? 1 : 0;
2 7u83 582
    b &= ~mask;
583
    mask = mask << 1;
584
  }
585
  return n;
586
}
587
 
588
void move_dlts
7 7u83 589
(int dr, int sr, int szr, int mr, int bytemove)
2 7u83 590
{
591
	/* move szr bytes to dr from sr (use mr)- either nooverlap or dr<=sr */
592
	baseoff b;
593
	int lin = new_label();
594
 
595
	b.offset =0;
596
 	set_label(lin);
597
 	b.base = sr;
598
 	ls_ins((bytemove)?i_lb:i_lw, mr, b);
7 7u83 599
 	rri_ins(i_addu, sr, sr,(bytemove)?1:4);
2 7u83 600
 	b.base = dr;
601
 	ls_ins((bytemove)?i_sb:i_sw, mr, b);
7 7u83 602
 	rri_ins(i_addu, dr, dr,(bytemove)?1:4);
603
 	rri_ins(i_subu, szr, szr,(bytemove)?1:4);
2 7u83 604
 	condrr_ins(i_bne, szr, 0, lin);
605
}
606
 
607
void move_dgts
7 7u83 608
(int dr, int sr, int szr, int mr, int bytemove)
2 7u83 609
{
610
	/* move szr bytes to dr from sr (use mr) with overlap and dr>sr */
611
	baseoff b;
612
	int lin = new_label();
613
 
614
	b.offset = (bytemove)?-1:-4;
615
 
616
	rrr_ins(i_addu, dr,dr, szr);
617
	rrr_ins(i_addu, sr,sr, szr);
618
 	set_label(lin);
619
 	b.base = sr;
620
 	ls_ins((bytemove)?i_lb:i_lw, mr, b);
7 7u83 621
 	rri_ins(i_subu, sr, sr,(bytemove)?1:4);
2 7u83 622
 	b.base = dr;
623
 	ls_ins((bytemove)?i_sb:i_sw, mr, b);
7 7u83 624
 	rri_ins(i_subu, dr, dr,(bytemove)?1:4);
625
 	rri_ins(i_subu, szr, szr,(bytemove)?1:4);
2 7u83 626
 	condrr_ins(i_bne, szr, 0, lin);
627
}
628
 
629
void reset_tos
7 7u83 630
(void)
2 7u83 631
{
632
    	if (Has_tos) {
633
    		baseoff b;
634
    		b.base = 30;
635
    		b.offset = -8;
636
    		ls_ins(i_sw, 29, b);
637
    	}
638
}
639
 
640
exp testlast
7 7u83 641
(exp e, exp second)
2 7u83 642
{
643
  /* finds the last test in sequence e which is a branch to second, if
644
     any, otherwise nil */
7 7u83 645
  if (name(e) == test_tag && pt(e) == second) {
646
    return(e);
2 7u83 647
  }
7 7u83 648
  if (name(e) == seq_tag) {
649
    if (name(bro(son(e))) == test_tag && pt(bro(son(e))) == second) {
650
      return bro(son(e));
2 7u83 651
    }
652
    else
7 7u83 653
      if (name(bro(son(e))) == top_tag) {
654
	exp list = son(son(e));
2 7u83 655
	for (;;) {
7 7u83 656
	  if (last(list)) {
657
	    if (name(list) == test_tag && pt(list) == second) {
2 7u83 658
	      return list;
659
	    }
660
	    else {
661
	      return 0;
662
	    }
663
	  }
664
	  else {
7 7u83 665
	    list = bro(list);
2 7u83 666
	  }
667
	}
668
      }
669
  }
670
  return 0;
671
}
672
 
673
 
674
 
675
bool last_param
7 7u83 676
(exp e)
2 7u83 677
{
678
	if (!isparam(e)) return 0;
679
	e = bro(son(e));
7 7u83 680
    aa:	if (name(e) ==ident_tag && isparam(e)
681
		&& name(son(e))!= formal_callee_tag
2 7u83 682
		) return 0;
683
	if (name(e) == diagnose_tag) {
684
	    e = son(e); goto aa;
685
	}
686
	return 1;
687
}
688
 
689
int regfrmdest
7 7u83 690
(where * dest, space sp)
2 7u83 691
{
692
 	switch (dest->answhere.discrim) {
693
	  case inreg:
694
	    {
7 7u83 695
	      int r = regalt(dest->answhere);
2 7u83 696
	      if (r!=0) return r;
697
 
698
	    }
699
	  default:
700
	    {
7 7u83 701
	      return getreg(sp.fixed);
2 7u83 702
	    }
703
	}
704
}
705
 
706
space do_callers
7 7u83 707
(exp list, space sp)
2 7u83 708
{	int   disp =0;
709
	int   spar = 4;
710
	int   fpar = 6;
711
	bool hadfixed = 0;
712
 
713
	  for (;;) {		/* evaluate parameters in turn */
7 7u83 714
	    int   hd = name(sh(list));
2 7u83 715
	    instore is;
716
	    where w;
717
	    ash ap;
718
	    int paral;
719
	    int parsize;
720
	    exp par;
7 7u83 721
	    par = (name(list) ==caller_tag)?son(list):list;
722
	    ap = ashof(sh(list));
2 7u83 723
	    paral = (ap.ashalign < 32)?32:ap.ashalign;
724
	    parsize = ap.ashsize;
725
	    w.ashwhere = ap;
726
	    disp = rounder(disp,paral);
727
	    spar = 4+ (disp>>5);
728
	    is.b.base = 29;
729
	    is.b.offset = disp >> 3;
730
	    is.adval = 1;
731
	    if (disp>96) {spar =8; fpar = 8; }
732
 
733
	    if (is_floating(hd) && disp+parsize <= 128) {
734
	      freg frg;
735
	      ans ansfr;
736
	      frg.fr = fpar++;
7 7u83 737
	      frg.dble = (hd != shrealhd)? 1 : 0;
738
	      setfregalt(ansfr, frg);
2 7u83 739
	      w.answhere = ansfr;
7 7u83 740
	      code_here(par, sp, w);
2 7u83 741
	      /* eval parameter into floating parameter register */
742
	      sp = guardfreg(frg.fr, sp);
743
	      if (hadfixed) {
7 7u83 744
		  setregalt(w.answhere, spar);
745
		  move(ansfr, w, sp, 1);
2 7u83 746
		  sp = guardreg(spar, sp);
747
		  if (hd != shrealhd) { sp = guardreg(spar+1, sp); }
748
	      }
749
	    }
750
	    else
7 7u83 751
	    if (valregable(sh(list)) && disp+parsize <=128) {
2 7u83 752
		ans ansr;
7 7u83 753
		setregalt(ansr, spar);
2 7u83 754
		w.answhere = ansr;
755
		hadfixed = 1;
7 7u83 756
		code_here(par, sp, w);
2 7u83 757
		/* eval parameter into fixed parameter register */
7 7u83 758
		sp = guardreg(spar, sp);
2 7u83 759
	    }
760
	    else {
7 7u83 761
		setinsalt(w.answhere, is);
762
		code_here(par, sp, w);
2 7u83 763
		hadfixed = 1;
764
		/* eval parameter into argument space on stack */
765
		while (spar <= 7 && ap.ashsize >0) {
766
			/* copy (parts of) any struct results into parregs */
767
			ls_ins(i_lw, spar, is.b);
768
			sp =guardreg(spar++, sp);
769
			is.b.offset +=4;
770
			ap.ashsize-=32;
771
		}
772
	   }
773
 
7 7u83 774
	   if (name(list) == caller_tag) { no(list) = disp; }
2 7u83 775
 
776
	   disp+=parsize;
777
	   disp = rounder(disp, 32);
778
 
779
 
7 7u83 780
	   if (last(list)) return sp;
781
	   list = bro(list);
2 7u83 782
	  }			/* end for */
783
 
784
}
785
 
786
 
787
 
788
void load_reg
7 7u83 789
(exp e, int r, space sp)
2 7u83 790
{
791
	where w;
792
	w.ashwhere = ashof(sh(e));
793
	setregalt(w.answhere, r);
794
	code_here(e, sp, w);
795
}
796
 
797
static int diagPIClab;
798
 
799
typedef struct postl_ {exp pl; struct postl_ * outer; } postl_chain;
800
static postl_chain * old_pls;
801
 
802
void update_plc
7 7u83 803
(postl_chain * ch, int ma)
2 7u83 804
{
805
	while (ch != (postl_chain*)0) {
806
	  exp pl= ch->pl;
7 7u83 807
	  while (name(pl) ==ident_tag && name(son(pl)) ==caller_name_tag) {
808
		no(pl) += (ma<<1);
2 7u83 809
		pl = bro(son(pl));
810
	  }
811
	  ch = ch->outer;
812
	}
813
}
814
 
815
void do_callee_list
7 7u83 816
(exp e, space sp)
2 7u83 817
{
7 7u83 818
    	long x = ((no(e) >>3) +23) & ~7;
2 7u83 819
    	exp list = son(e);
820
    	instore is;
821
    	where w;
822
    	baseoff b;
823
    	long disp;
824
    	ash ap;
825
    	disp = 0;
826
    	rri_ins(i_subu, 29, 29, x);
827
    	b.base = 29; b.offset = x-4;
828
    	ls_ins(i_sw, 30, b);
829
 
830
	update_plc(old_pls, x<<3);
831
 
832
    	if (no(e)!= 0) {
7 7u83 833
    		for (;;) {
2 7u83 834
    			ap = ashof(sh(list));
835
    			disp = rounder(disp, ap.ashalign);
836
    			is.b.offset = disp>>3;
837
    			is.b.base = 29; is.adval = 1;
838
    			w.ashwhere = ap;
839
    			setinsalt(w.answhere, is);
840
    			code_here(list, sp, w);
841
    			disp = rounder(disp+ap.ashsize, 32);
7 7u83 842
    			if (last(list))break;
2 7u83 843
    			list = bro(list);
844
    		}
845
    	}
7 7u83 846
	update_plc(old_pls, - (x<<3));
2 7u83 847
}
848
 
849
exp find_ote
7 7u83 850
(exp e, int n)
2 7u83 851
{
852
	exp d = father(e);
7 7u83 853
	while (name(d)!=apply_general_tag)d = father(d);
2 7u83 854
	d = son(bro(son(d))); /* list otagexps */
7 7u83 855
	while (n !=0) { d = bro(d); n--;}
856
	Assert(name(d) ==caller_tag);
2 7u83 857
	return d;
858
}
859
 
860
makeans make_code
7 7u83 861
(exp e, space sp, where dest, int exitlab)
2 7u83 862
{
863
  /* produce code for expression e, putting its result in dest using
864
     t-regs given by sp. If non-zero, exitlab is the label of where the
865
     code is to continue */
866
  long  constval;
867
  makeans mka;
868
tailrecurse:
869
  mka.lab = exitlab;
870
  mka.regmove = NOREG;
871
 
872
 
873
 
7 7u83 874
  switch (name(e)) {
2 7u83 875
    case ident_tag:
876
      {
877
	where placew;
878
	int   r = NOREG;
879
	bool remember = 0;
880
 
881
 
882
 
883
 
884
	if (props (e) & defer_bit) {/* the tag of this declaration is
885
				   transparently identified with its
886
				   definition, without reserving more
887
				   space */
7 7u83 888
	  e = bro(son(e));
2 7u83 889
	  goto tailrecurse;
890
 
891
	}
892
 
893
 
894
 
895
	if (son (e) == nilexp) {/* I think this is historical - unused
896
				   tags are now removed cleanly */
897
	  placew = nowhere;
898
	}
899
        else
900
	if (name(son(e)) == caller_name_tag) {
901
		exp ote = find_ote(e,no(son(e)));
902
		long disp = no(ote);
7 7u83 903
		no(e) = (disp<<1) +29;
2 7u83 904
		placew = nowhere;
905
	}
906
	else {
907
	  ash a;
7 7u83 908
	  int   n = no(e);
909
	  a = ashof(sh(son(e)));
910
	  if ((props(e) & inreg_bits)!= 0) {
2 7u83 911
	    /* tag in some fixed pt reg */
912
	    if (n == 0) {	/* if it hasn't been already allocated
913
				   into a s-reg (or r2) allocate tag into
914
				   fixed t-reg ... */
915
	      int   s = sp.fixed;
916
	      if (props (e) & notparreg)/* ... but not a parameter reg */
917
		s |= 0xf0;
7 7u83 918
	      n = getreg(s);
919
	      no(e) = n;
2 7u83 920
	    }
7 7u83 921
	    setregalt(placew.answhere, n);
2 7u83 922
	  }
923
	  else
7 7u83 924
	    if ((props(e) & infreg_bits)!= 0) {
2 7u83 925
	      /* tag in some float reg */
926
	      freg frg;
927
	      if (n == 0) {	/* if it hasn't been already allocated
928
				   into a s-reg (or r0) allocate tag into
929
				   float-reg ... */
930
		int   s = sp.flt;
7 7u83 931
		if (props(e) & notparreg)
2 7u83 932
		  s |= 0xc0;
7 7u83 933
		n = getfreg(s);
934
		no(e) = n;
2 7u83 935
	      }
936
	      else
937
	      if (n == 16) {	/* result reg */
938
		  n = 0;
7 7u83 939
		  no(e) = 0;
2 7u83 940
	      }
941
 
942
 
943
	      frg.fr = n;
7 7u83 944
	      frg.dble = (a.ashsize == 64)? 1 : 0;
945
	      setfregalt(placew.answhere, frg);
2 7u83 946
	    }
947
	    else
7 7u83 948
	    if (isparam(e)) {
949
	      if (name(son(e))!=formal_callee_tag) {
2 7u83 950
	    	long n = (no(son(e)) + frame_size +callee_size)>>3 ; /* byte disp of params */
951
		instore is;
952
		is.adval =1;
7 7u83 953
		no(e) = ((no(son(e)) +frame_size+callee_size-locals_offset) <<1) +29+Has_fp;
2 7u83 954
		if ((!Has_no_vcallers ||
7 7u83 955
			(isvis(e) && props(son(e))!= 0)) && last_param(e)) {
2 7u83 956
		        /* vararg in reg ? */
7 7u83 957
			int r = rounder(no(son(e)) +shape_size(sh(son(e))), 32);
958
			while (r<=96) {
959
				is.b.offset = (r+ ((Has_fp)?0
960
						:frame_size+callee_size)) >>3;
2 7u83 961
				is.b.base = 29+Has_fp;
7 7u83 962
				ls_ins(i_sw, 4+ (r>>5), is.b);
2 7u83 963
				r+=32;
964
		        }
965
		}
7 7u83 966
		if (shape_size(sh(son(e))) ==0) {
2 7u83 967
			/* vararg ... param */
968
			e = bro(son(e));
969
			goto tailrecurse;
970
		}
7 7u83 971
		is.b.offset = (Has_fp)?(no(son(e)) >>3):n;
2 7u83 972
		is.b.base = 29 + Has_fp;
7 7u83 973
		if (BIGEND && props(son(e))!= 0 && shape_size(sh(son(e))) <32) {
974
			is.b.offset += (shape_size(sh(son(e))) ==8)?3:2;
2 7u83 975
			/* short promotions */
976
		}
977
		setinsalt(placew.answhere, is);
978
		remember =1;
979
	      }
980
	      else {
7 7u83 981
	      	no(e) = ((no(son(e)) +frame_size - locals_offset) <<1)
2 7u83 982
	      	        + ((Has_vcallees)?local_reg:30);
983
		placew = nowhere;
984
	      }
985
	    }
986
	    else {		/* allocate on stack */
987
	      int   base = n & 0x3f;
988
	      instore is;
989
	      is.b.base = base;
990
	      is.b.offset = (n - base) >> 4;
991
	      is.adval = 1;
7 7u83 992
	      if (base == 29) {
2 7u83 993
		is.b.offset += locals_offset >> 3;
994
	      }
995
	      else
7 7u83 996
	      if ((base==30 && Has_fp)) {
2 7u83 997
		is.b.offset += ((locals_offset-frame_size-callee_size) >> 3);
998
	      }
999
	      else
7 7u83 1000
	      if ((base == local_reg && Has_vcallees)) {
2 7u83 1001
		is.b.offset += ((locals_offset -frame_size) >> 3);
1002
	      }
7 7u83 1003
	      setinsalt(placew.answhere, is);
2 7u83 1004
	      remember = 1;
1005
	    }
1006
	  placew.ashwhere = a;
1007
	}
1008
        if (isparam(e)
1009
        	&& name(son(e))!=formal_callee_tag) {
1010
          exp se = son(e);
1011
          exp d = e;
1012
	   /* parameter fiddles */
7 7u83 1013
           if (props(se) == 0 && (props(d) & inanyreg)!=0) {
2 7u83 1014
                /* not originally in required reg */
1015
                ans a;
1016
                instore is;
1017
		is.b.base = 29 + Has_fp;
1018
		is.b.offset = (no(se) +
7 7u83 1019
                              ((Has_fp)?0:(frame_size+callee_size))) >>3;
2 7u83 1020
                is.adval = 0;
7 7u83 1021
		if (BIGEND && shape_size(sh(son(e))) <32) {
1022
			is.b.offset += (shape_size(sh(son(e))) ==8)?3:2;
2 7u83 1023
			/* short promotions */
1024
		}
1025
                setinsalt(a, is);
1026
                IGNORE move(a, placew, sp, is_signed(sh(se)));
1027
           }
1028
           else
7 7u83 1029
           if (props(se)!=0 && (props(d) & inanyreg) ==0) {
2 7u83 1030
                /* originally in reg and required in store */
1031
                ans a;
7 7u83 1032
                if (is_floating(name(sh(se)))) {
2 7u83 1033
                   freg fr;
1034
                   fr.fr = props(se);
7 7u83 1035
                   fr.dble = (name(sh(se))!= shrealhd);
2 7u83 1036
                   setfregalt(a, fr);
1037
                }
1038
                else { setregalt(a, props(se)); }
1039
                r = move(a, placew, sp, 0);
1040
           }
1041
           else
7 7u83 1042
           if (props(se)!=0 && props(se)!= no(d)) {
2 7u83 1043
                /* in wrong register */
1044
                int sr = no(d);
1045
                int tr = props(se);
7 7u83 1046
                if (is_floating(name(sh(se)))) {
1047
                   if ((fltdone & (3<< (sr<<1)))!= 0) {
1048
                        rrfp_ins((name(sh(se))!= shrealhd)? i_mov_d: i_mov_s,
1049
                                no(d) <<1, props(se) <<1);
2 7u83 1050
                   }
1051
                   else {
7 7u83 1052
                       props(se) = sr; no(d) = tr;
2 7u83 1053
                       sp = guardfreg(tr, sp);
1054
                       /* !? swopped and moved in  dump_tag !? */
1055
                   }
1056
                }
1057
                else {
7 7u83 1058
                   if ((fixdone & (1<<sr))!=0) {
1059
                        mon_ins(i_move, no(d), props(se));
2 7u83 1060
                   }
1061
                   else {
7 7u83 1062
                       props(se) = sr; no(d) = tr;
2 7u83 1063
                       sp = guardreg(tr,sp);
1064
                        /* !? swopped for dump_tag !? */
1065
                   }
1066
                }
1067
           }
1068
           /* maybe more about promotions */
1069
 
1070
        }
1071
        else
7 7u83 1072
        if (isparam(e) && name(son(e)) ==formal_callee_tag) {
2 7u83 1073
                exp se = son(e);
1074
          	exp d = e;
7 7u83 1075
        	if ((props(d) & inanyreg)!= 0) {
2 7u83 1076
        		/* callee parameter assigned to reg */
1077
        	ans a;
1078
                instore is;
1079
		if (Has_vcallees) {
1080
			is.b.base = local_reg;
7 7u83 1081
			is.b.offset = (no(se)) >>3;
2 7u83 1082
		}
1083
		else {
1084
			is.b.base = 30;
7 7u83 1085
                	is.b.offset = (no(se) - callee_size) >>3;
2 7u83 1086
		}
1087
                is.adval = 0;
1088
                setinsalt(a, is);
1089
                IGNORE move(a, placew, sp, is_signed(sh(se)));
1090
               }
1091
        }
1092
        else
7 7u83 1093
	  r = code_here(son(e), sp, placew);
2 7u83 1094
		/* evaluate the initialisation of tag, putting it into place
1095
	   		allocated ... */
1096
 
7 7u83 1097
	if (remember && r != NOREG && pt(e)!= nilexp && no(pt(e)) ==0
1098
	    && eq_sze(sh(son(e)), sh(pt(e)))) {
2 7u83 1099
	  /* ...if it was temporarily in a register, remember it */
7 7u83 1100
	  if (isvar(e)) {
1101
	    keepcont(pt(e), r);
2 7u83 1102
	  }
1103
	  else {
7 7u83 1104
	    keepreg(pt(e), r);
2 7u83 1105
	  }
1106
	}
1107
 
1108
 
7 7u83 1109
	sp =  guard(placew, sp);
1110
        e = bro(son(e));
2 7u83 1111
        goto tailrecurse;
1112
	/* and evaluate the body of the declaration */
1113
      }				/* end ident */
1114
 
1115
    case clear_tag: {
1116
 
1117
	return mka;
1118
      }
1119
 
1120
 
1121
 
1122
 
1123
 
1124
    case seq_tag:
1125
      {
7 7u83 1126
	exp t = son(son(e));
2 7u83 1127
	for (;;) {
7 7u83 1128
	  exp next = (last(t))?(bro(son(e))): bro(t);
2 7u83 1129
	  if (name (next) == goto_tag) {/* gotos end sequences */
7 7u83 1130
	    make_code(t, sp, nowhere, no(son(pt(next))));
2 7u83 1131
	  }
1132
	  else {
7 7u83 1133
	    code_here(t, sp, nowhere);
2 7u83 1134
	  }
7 7u83 1135
	  if (last(t)) {
1136
	    e = bro(son(e));
2 7u83 1137
	    goto tailrecurse;
1138
	  }
7 7u83 1139
	  t = bro(t);
2 7u83 1140
	}
1141
      }				/* end seq */
1142
 
1143
    case cond_tag:
1144
      {
7 7u83 1145
	exp first = son(e);
1146
	exp second = bro(son(e));
2 7u83 1147
	exp test;
1148
 
1149
	if (dest.answhere.discrim == insomereg) {
1150
	  /* must make choice of register to contain answer to cond */
7 7u83 1151
	  int  *sr = someregalt(dest.answhere);
2 7u83 1152
	  if (*sr != -1) {
7 7u83 1153
	    failer("Somereg *2");
2 7u83 1154
	  }
7 7u83 1155
	  *sr = getreg(sp.fixed);
1156
	  setregalt(dest.answhere, *sr);
2 7u83 1157
	}
1158
	else
1159
	if (dest.answhere.discrim == insomefreg) {
1160
	       somefreg sfr;
1161
	       freg fr;
1162
   	       sfr = somefregalt(dest.answhere);
7 7u83 1163
	       if (*sfr.fr != -1) { failer("Somefreg *2"); }
2 7u83 1164
	       *sfr.fr = getfreg(sp.flt);
1165
	       fr.fr = *sfr.fr;
1166
	       fr.dble = sfr.dble;
1167
	       setfregalt(dest.answhere, fr);
1168
	}
1169
 
7 7u83 1170
	if (name(first) == goto_tag && pt(first) == second) {
2 7u83 1171
	  /* first is goto second */
7 7u83 1172
	  no(son(second)) = 0;
1173
	  return make_code(second, sp, dest, exitlab);
2 7u83 1174
	}
1175
	else
7 7u83 1176
	    if (name(second) == labst_tag &&
1177
		name(bro(son(second))) == top_tag) {
2 7u83 1178
	      /* second is empty */
7 7u83 1179
	      int   endl = (exitlab == 0)? new_label(): exitlab;
1180
	      no(son(second)) = endl;
1181
	      make_code(first, sp, dest, endl);
2 7u83 1182
	      mka.lab = endl;
1183
	      return mka;
1184
	    }
1185
	    else
7 7u83 1186
	      if (name(second) == labst_tag &&
1187
		  name(bro(son(second))) == goto_tag) {
2 7u83 1188
		/* second is goto */
7 7u83 1189
		exp g = bro(son(second));
1190
		no(son(second)) = no(son(pt(g)));
1191
		return make_code(first, sp, dest, exitlab);
2 7u83 1192
	      }
1193
	if (test = testlast (first, second) /* I mean it */ ) {
1194
	  /* effectively an empty then part */
7 7u83 1195
	  int   l = (exitlab != 0)? exitlab : new_label();
2 7u83 1196
	  bool rev = IsRev(test);
1197
	  ptno(test) = -l;	/* make test jump to exitlab - see
1198
				   test_tag: */
7 7u83 1199
	  props(test) = notbranch[(props(test) &127) - 1];
2 7u83 1200
	   if (rev) { SetRev(test); }
1201
	  /* ... with inverse test */
7 7u83 1202
	  no(son(second)) = new_label();
1203
	  make_code(first, sp, dest, l);
1204
	  make_code(second, sp, dest, l);
2 7u83 1205
	  mka.lab = l;
1206
	  return mka;
1207
	}
1208
	else {
1209
	  int   fl;
7 7u83 1210
	  no(son(second)) = new_label();
1211
	  fl = make_code(first, sp, dest, exitlab).lab;
2 7u83 1212
 
1213
	  {
7 7u83 1214
	    int   l = (fl != 0)? fl :((exitlab != 0)? exitlab : new_label());
2 7u83 1215
/* Alteration 4 */
7 7u83 1216
	    if (name(sh(first))!= bothd || l == rscope_label)uncond_ins(i_b, l);
1217
	    make_code(second, sp, dest, l);
1218
	    clear_all();
2 7u83 1219
	    mka.lab = l;
1220
	    return mka;
1221
	  }
1222
	}
1223
      }				/* end cond */
1224
 
1225
    case labst_tag:
1226
      {
7 7u83 1227
	if (no(son(e))!= 0) {
1228
	   set_label(no(son(e)));
2 7u83 1229
	}
1230
	if (is_loaded_lv(e) && No_S) { /* can be target of long_jump; reset sp */
1231
		baseoff b;
1232
		b.base = 30;
1233
		if (Has_vcallees) {
1234
			b.offset = -12;
1235
			ls_ins(i_lw, local_reg, b);
1236
		}
1237
		if (Has_tos) {
1238
			b.offset = -8;
1239
			ls_ins(i_lw, 29, b);
1240
		}
1241
		else {
7 7u83 1242
			rri_ins(i_subu, 29, 30,(frame_size+callee_size) >>3);
2 7u83 1243
		}
1244
	}
7 7u83 1245
	e = bro(son(e));
2 7u83 1246
	goto tailrecurse;
1247
 
1248
      }				/* end labst */
1249
 
1250
    case rep_tag:
1251
      {
7 7u83 1252
	exp first = son(e);
1253
	exp second = bro(first);
2 7u83 1254
/* Alteration 1: adds this line :- */
1255
	code_here(first, sp, nowhere);
7 7u83 1256
	no(son(second)) = new_label();
2 7u83 1257
	e = second;
1258
	goto tailrecurse;
1259
 
1260
      }				/* end rep */
1261
 
1262
    case goto_tag:
1263
      {
1264
	exp gotodest = pt(e);
7 7u83 1265
	int   lab = no(son(gotodest));
1266
	clear_all();
2 7u83 1267
	if (!last(e) || name(bro(e))!=seq_tag || !last(bro(e)) ||
7 7u83 1268
	      last(bro(bro(e))) || bro(bro(bro(e)))!= gotodest) {
1269
	  uncond_ins(i_b, lab);
2 7u83 1270
	} /* dest is next in sequence */
1271
 
1272
	return mka;
1273
      }				/* end goto */
1274
 
1275
    case make_lv_tag: {
1276
    	int r = regfrmdest(&dest,sp);
1277
    	ans aa;
1278
    	condr_ins(i_la, r, no(son(pt(e))) ); /*???? */
1279
    	setregalt(aa,r);
1280
    	move(aa,dest, guardreg(r,sp), 0);
1281
    	mka.regmove = r;
1282
    	return mka;
1283
    }
1284
 
1285
    case long_jump_tag: {
1286
    	int fp = reg_operand(son(e), sp);
1287
    	int labval = reg_operand(bro(son(e)), sp);
1288
    	mon_ins(i_move, 30, fp);
1289
    	br_ins(i_j, labval);
1290
    	return mka;
1291
    }
1292
 
1293
    case max_tag: case min_tag: case offset_max_tag:
1294
      {
7 7u83 1295
	exp l = son(e);
1296
	exp r = bro(l);
2 7u83 1297
	shape shl = sh(l);
1298
	int a1, a2, d;
1299
	ans aa;
1300
	space nsp;
1301
	char * setins = sets(shl,3);
1302
	int lab = new_label();
1303
 
1304
	a1 = reg_operand(l, nsp);
1305
	nsp = guardreg(a1, sp);
1306
	d = regfrmdest(&dest, nsp);
7 7u83 1307
	if (d==a1)d = getreg(nsp.fixed);
2 7u83 1308
	nsp = guardreg(d, nsp);
7 7u83 1309
	if (name(r) == val_tag) {
1310
		 rri_ins(setins, d, a1, no(r));
2 7u83 1311
	}
1312
	else {
7 7u83 1313
	  	a2 = reg_operand(r, nsp);
1314
		if (d==a2)d = getreg(guardreg(a2,nsp).fixed);
1315
		rrr_ins(setins, d, a1, a2);
2 7u83 1316
	}
1317
 
1318
	setnoreorder();
1319
	condri_ins((name(e)!=min_tag)?i_beq:i_bne, d, 0, lab);
1320
	rrr_ins(i_addu, d, a1, 0);
7 7u83 1321
	if (name(r) ==val_tag) {
2 7u83 1322
		baseoff b;
1323
		b.base = 0;
1324
		b.offset = no(r);
1325
		ls_ins(i_li, d, b);
1326
	}
1327
	else rrr_ins(i_addu,d,a2, 0);
1328
	set_label_no_clear(lab);
1329
	setreorder();
1330
 
7 7u83 1331
	setregalt(aa, d);
1332
        move(aa, dest, guardreg(d, sp), 0);
2 7u83 1333
        mka.regmove = d;
1334
        return mka;
1335
 
1336
 
1337
      }
1338
 
1339
 
1340
    case absbool_tag: case maxlike_tag: case minlike_tag: case abslike_tag:
1341
      {
7 7u83 1342
	exp l = son(son(e));
1343
	exp r = bro(l);
1344
	shape shl = sh(l);
2 7u83 1345
	char *setins;
7 7u83 1346
	int   n = props(son(e));
2 7u83 1347
	int   d;
1348
	int   a1;
1349
	int   a2;
7 7u83 1350
	bool xlike = (name(e)!= absbool_tag);
2 7u83 1351
	ans aa;
1352
 
1353
	if (!xlike && name (l) == val_tag) {/* put literal operand on right */
1354
	  exp temp = l;
1355
	  l = r;
1356
	  r = temp;
1357
	  if (n <= 2) {
1358
	    n += 2;
1359
	  }
1360
	  else
1361
	    if (n <= 4) {
1362
	      n -= 2;
1363
	    }
1364
	}
1365
 
1366
	setins = sets(shl, n);
1367
	/* chose set instruction from test and shape */
1368
 
1369
	d = regfrmdest(&dest, sp);
1370
 
1371
	/* reg d will contain result of set (eventually) */
1372
 
7 7u83 1373
	a1 = reg_operand(l, sp);
2 7u83 1374
	if (xlike && a1==d) {
1375
		sp = guardreg(a1, sp);
1376
		d = getreg(sp.fixed);
1377
	}
7 7u83 1378
	if (name(r) == val_tag) {
1379
	  rri_ins(setins, d, a1, no(r));
2 7u83 1380
	}
1381
	else {
1382
	  space nsp;
7 7u83 1383
	  nsp = guardreg(a1, sp);
1384
	  a2 = reg_operand(r, nsp);
2 7u83 1385
	  if (xlike && a2==d) {
1386
	  	nsp = guardreg(a2, nsp);
1387
	  	d = getreg(nsp.fixed);
1388
	  }
7 7u83 1389
	  rrr_ins(setins, d, a1, a2);
2 7u83 1390
	}
7 7u83 1391
	if (name(e) ==maxlike_tag || name(e) ==minlike_tag) {
2 7u83 1392
		int l = new_label();
1393
		setnoreorder();
7 7u83 1394
		condri_ins((name(e) ==maxlike_tag)?i_bne:i_beq, d, 0, l);
2 7u83 1395
		rrr_ins(i_addu, d, a1, 0);
7 7u83 1396
		if (name(r) ==val_tag) {
2 7u83 1397
			baseoff b;
1398
			b.base = 0;
1399
			b.offset = no(r);
1400
			ls_ins(i_li, d, b);
1401
		}
1402
		else rrr_ins(i_addu,d,a2, 0);
1403
		set_label_no_clear(l);
1404
		setreorder();
1405
	}
1406
	else
7 7u83 1407
	if (name(e) ==abslike_tag) {
2 7u83 1408
		int l = new_label();
1409
		setnoreorder();
1410
		condri_ins(i_bne, d, 0, l);
1411
		rrr_ins(i_addu, d, a1, 0);
1412
		rrr_ins(i_subu, d, 0, a1);
1413
		set_label_no_clear(l);
1414
		setreorder();
1415
	}
1416
 
1417
 
1418
 
7 7u83 1419
        setregalt(aa, d);
1420
        move(aa, dest, guardreg(d, sp), 0);
2 7u83 1421
        mka.regmove = d;
1422
        return mka;
1423
 
1424
 
1425
      }				/* end absbool */
1426
 
1427
 
1428
    case test_tag:
1429
      {
7 7u83 1430
	exp l = son(e);
1431
	exp r = bro(l);
1432
	int   lab = (ptno(e) < 0)? -ptno(e): no(son(pt(e)));
2 7u83 1433
	/* see frig in cond_tag */
7 7u83 1434
	shape shl = sh(l);
2 7u83 1435
	char *branch;
1436
	int   n = (props (e)) & 127; /* could have Rev bit in props*/
1437
 
7 7u83 1438
	if (is_floating(name(sh(l)))) {
1439
	  bool dble = (name(shl)!= shrealhd)? 1 : 0;
2 7u83 1440
	  int   a1;
7 7u83 1441
	  char *branch = (n <= 2 || n == 6)? i_bc1t : i_bc1f;
1442
	  char *compare = (dble)? fdbranches(n): fbranches(n);
2 7u83 1443
	  /* choose branch and compare instructions */
1444
	  int   a2;
1445
	  space nsp;
1446
	  if (IsRev(e)) {
1447
		a2 = freg_operand(r, sp);
1448
		nsp = guardfreg(a2, sp);
1449
		a1 = freg_operand(l, nsp);
1450
	  }
1451
	  else {
1452
		a1 = freg_operand(l, sp);
1453
		nsp = guardfreg(a1, sp);
1454
		a2 = freg_operand(r, nsp);
1455
	  }
1456
 
7 7u83 1457
	  rrfpcond_ins(compare, a1 << 1, a2 << 1);
1458
	  br_ins(branch, lab);
2 7u83 1459
	  return mka;
1460
	}			/* end float test */
1461
	else {
1462
	  int   a1;
1463
	  int   a2;
1464
	  if (name (l) == val_tag) {/* put literal operand on right */
1465
	    exp temp = l;
1466
	    l = r;
1467
	    r = temp;
1468
	    if (n <= 2) {
1469
	      n += 2;
1470
	    }
1471
	    else
1472
	      if (n <= 4) {
1473
		n -= 2;
1474
	      }
1475
	  }
1476
	  branch = branches(shl, n);
1477
	  	/* choose branch instruction */
7 7u83 1478
	  a1 = reg_operand(l, sp);
1479
	  if (name(r) == val_tag) {
1480
	    condri_ins(branch, a1, no(r), lab);
2 7u83 1481
	  }
1482
	  else {
1483
	    space nsp;
7 7u83 1484
	    nsp = guardreg(a1, sp);
1485
	    a2 = reg_operand(r, nsp);
1486
	    condrr_ins(branch, a1, a2, lab);
2 7u83 1487
	  }
1488
 
1489
	  return mka;
1490
	}			/* end int test */
1491
      }				/* end test */
1492
 
1493
 
1494
    case ass_tag:
1495
    case assvol_tag:
1496
      {
7 7u83 1497
	exp lhs = son(e);
1498
	exp rhs = bro(lhs);
2 7u83 1499
	where assdest;
1500
	space nsp;
1501
	ash arhs;
1502
 
1503
	int   contreg = NOREG;
7 7u83 1504
	if (name(e) == assvol_tag) {
1505
	  clear_all();
1506
	  setvolatile();
2 7u83 1507
	}
1508
 
7 7u83 1509
	arhs = ashof(sh(rhs));
2 7u83 1510
 
1511
 
7 7u83 1512
	if (name(e) == ass_tag && name(rhs) == apply_tag &&
1513
	   (is_floating(name(sh(rhs))) || valregable(sh(rhs)))) {
2 7u83 1514
	  /* if source is simple proc call, evaluate it first and do
1515
	     assignment */
1516
	  ans aa;
7 7u83 1517
	  code_here(rhs, sp, nowhere);
1518
	  if (is_floating(name(sh(rhs)))) {
2 7u83 1519
	    freg frg;
1520
	    frg.fr = 0;
7 7u83 1521
	    frg.dble = (arhs.ashsize == 64)? 1 : 0;
1522
	    setfregalt(aa, frg);
2 7u83 1523
	  }
1524
	  else {
7 7u83 1525
	    setregalt(aa, 2);
2 7u83 1526
	    sp = guardreg(2,sp);
1527
	  }
7 7u83 1528
	  assdest = locate(lhs, sp, sh(rhs), 0);
1529
	  move(aa, assdest, sp, 1);
1530
	  clear_dep_reg(lhs);
2 7u83 1531
	  return mka;
1532
	}
1533
 
1534
 
7 7u83 1535
	assdest = locate(lhs, sp, sh(rhs), 0);
1536
	nsp = guard(assdest, sp);
2 7u83 1537
	/* evaluate 'address' of destination */
1538
 
7 7u83 1539
	if (name(e) == ass_tag
2 7u83 1540
	      && assdest.answhere.discrim == notinreg) {
1541
	    instore is;
7 7u83 1542
	    is = insalt(assdest.answhere);
2 7u83 1543
	    if (!is.adval) {	/* this is an indirect assignment, so make
1544
				   it direct by loading pointer into reg
1545
				   (and remember it) */
7 7u83 1546
	      int   r = getreg(sp.fixed);
1547
	      ls_ins(i_lw, r, is.b);
1548
	      nsp = guardreg(r, sp);
2 7u83 1549
	      is.adval = 1;
1550
	      is.b.base = r;
1551
	      is.b.offset = 0;
7 7u83 1552
	      setinsalt(assdest.answhere, is);
1553
	      keepexp(lhs, assdest.answhere);
2 7u83 1554
	    }
1555
	  }
1556
 
1557
 
7 7u83 1558
	contreg = code_here(rhs, nsp, assdest);
2 7u83 1559
	/* evaluate source into assignment destination .... */
1560
 
1561
 
1562
 
1563
	switch (assdest.answhere.discrim) {
1564
	  case inreg:
1565
	    {
7 7u83 1566
	      int   a = regalt(assdest.answhere);
1567
	      keepreg(rhs, a);
2 7u83 1568
	      /* remember that source has been evaluated into a */
7 7u83 1569
	      clear_dep_reg(lhs);
2 7u83 1570
	      /* forget register dependencies on destination */
1571
	      break;
1572
	    }
1573
	  case infreg:
1574
	    {
1575
	      freg frg;
1576
	      int   r;
7 7u83 1577
	      frg = fregalt(assdest.answhere);
2 7u83 1578
	      r = frg.fr + 32;
1579
	      if (frg.dble) {
1580
		r = -r;
1581
	      };
7 7u83 1582
	      keepreg(rhs, r);
2 7u83 1583
	      /* remember that source has been evaluated into a */
7 7u83 1584
	      clear_dep_reg(lhs);
2 7u83 1585
	      /* forget register dependencies on destination */
1586
	      break;
1587
	    }
1588
 
1589
	  case notinreg:
1590
	    {
7 7u83 1591
	      if (contreg != NOREG && name(e) == ass_tag) {
1592
		clear_dep_reg(lhs);
2 7u83 1593
		/* forget register dependencies on destination */
1594
 
1595
		if (name(lhs) == name_tag) {
1596
			exp dc = son(lhs);
1597
			exp u = pt(dc);
1598
			while (u != nilexp) {
1599
				/* loook through uses to find cont(name) */
7 7u83 1600
			   if (last(u) && no(u) ==no(lhs) && bro(u)!=nilexp &&
1601
				name(bro(u)) ==cont_tag &&
1602
				shape_size(sh(bro(u))) == shape_size(sh(rhs))) {
1603
				keepreg(bro(u), contreg);
2 7u83 1604
				break;
1605
			   }
1606
			   u = pt(u);
1607
			}
1608
			/* remember cont of name as in contreg */
1609
 
1610
		}
1611
		else
7 7u83 1612
		if (!dependson(lhs, 0, lhs)) {
2 7u83 1613
		  /* remember that dest contains source, provided that it
1614
		     is not dependent on it */
7 7u83 1615
		  keepcont(lhs, contreg);
2 7u83 1616
		}
1617
		return mka;
1618
	      }
7 7u83 1619
	      clear_dep_reg(lhs);
2 7u83 1620
	      /* forget register dependencies on destination */
1621
	      break;
1622
	    }
1623
	  case insomereg: case insomefreg:
1624
	      {
7 7u83 1625
		clear_dep_reg(lhs);
2 7u83 1626
		/* forget register dependencies on destination */
1627
 
1628
	      }
1629
	}			/* end sw on answhere */
1630
 
7 7u83 1631
	if (name(e) == assvol_tag)
1632
	  setnovolatile();
2 7u83 1633
	return mka;
1634
      }				/* end ass */
1635
 
1636
    case compound_tag:
1637
      {
7 7u83 1638
	exp t = son(e);
2 7u83 1639
	space nsp;
1640
	instore str;
1641
	int r;
1642
 
1643
	nsp = sp;
7 7u83 1644
	switch (dest.answhere.discrim) {
2 7u83 1645
	   case notinreg: {
1646
            str = insalt (dest.answhere);/* it should be !! */
1647
            if (!str.adval) {
7 7u83 1648
              int   r = getreg(sp.fixed);
1649
              nsp = guardreg(r, sp);
1650
              ls_ins(i_lw, r, str.b);
2 7u83 1651
              str.adval = 1;
1652
              str.b.base = r;
1653
              str.b.offset = 0;
1654
            }
1655
            for (;;) {
1656
              where newdest;
1657
              instore newis;
1658
              newis = str;
1659
              newis.b.offset += no(t);
1660
 
7 7u83 1661
              Assert(name(t) ==val_tag && al2(sh(t)) >= 8);
2 7u83 1662
 
1663
 
7 7u83 1664
              setinsalt(newdest.answhere, newis);
1665
              newdest.ashwhere = ashof(sh(bro(t)));
1666
              code_here(bro(t), nsp, newdest);
1667
              if (last(bro(t))) {
2 7u83 1668
                return mka;
1669
              }
7 7u83 1670
              t = bro(bro(t));
2 7u83 1671
            }
1672
          }
1673
          case insomereg: {
1674
            int * sr = someregalt(dest.answhere);
1675
            if (*sr != -1) {
7 7u83 1676
              failer("Somereg *2");
2 7u83 1677
            }
7 7u83 1678
            *sr = getreg(sp.fixed);
1679
            setregalt(dest.answhere, *sr);
2 7u83 1680
 	    /* ,... */
1681
          }
1682
          case inreg: {
1683
            code_here(bro(t), sp, dest);
1684
            r = regalt(dest.answhere);
7 7u83 1685
            Assert(name(t) ==val_tag);
1686
            if (no(t)!=0) {
1687
            	rri_ins(i_sll, r, r,(al2(sh(t)) >= 8)?(no(t) <<3):no(t));
2 7u83 1688
            }
1689
            nsp = guardreg(r, sp);
7 7u83 1690
            while (!last(bro(t))) {
2 7u83 1691
            	int z;
1692
            	t = bro(bro(t));
7 7u83 1693
            	Assert(name(t) ==val_tag);
2 7u83 1694
            	z = reg_operand(bro(t), nsp);
7 7u83 1695
            	if (no(t)!=0) {
1696
            		rri_ins(i_sll, z,z,(al2(sh(t)) >= 8)?(no(t) <<3):no(t));
2 7u83 1697
                }
1698
                rrr_ins(i_or, r, r, z);
1699
            }
1700
            return mka;
1701
          }
1702
          case insomefreg: {
1703
	       somefreg sfr;
1704
	       freg fr;
1705
   	       sfr = somefregalt(dest.answhere);
7 7u83 1706
	       if (*sfr.fr != -1) { failer("Somefreg *2"); }
2 7u83 1707
	       *sfr.fr = getfreg(sp.flt);
1708
	       fr.fr = *sfr.fr;
1709
	       fr.dble = sfr.dble;
1710
	       setfregalt(dest.answhere, fr);
1711
          }
1712
	  case infreg:{
1713
	    code_here(bro(t), sp, dest);
7 7u83 1714
	    if (!last(bro(t)) || name(t)!=val_tag || no(t)!=0) {
2 7u83 1715
	       failer("No Tuples in freg");
1716
	    }
1717
	    return mka;
1718
	  }
1719
        }
1720
 
1721
      }				/* end tup */
1722
 
1723
    case nof_tag: case concatnof_tag:
1724
   {
7 7u83 1725
	exp t = son(e);
2 7u83 1726
	space nsp;
1727
	instore str;
1728
	int r, disp = 0;
1729
 
1730
	if (t == nilexp) return mka;
1731
 
1732
	nsp = sp;
7 7u83 1733
	switch (dest.answhere.discrim) {
2 7u83 1734
	   case notinreg: {
1735
            str = insalt (dest.answhere);/* it should be !! */
1736
            if (!str.adval) {
7 7u83 1737
              int   r = getreg(sp.fixed);
1738
              nsp = guardreg(r, sp);
1739
              ls_ins(i_lw, r, str.b);
2 7u83 1740
              str.adval = 1;
1741
              str.b.base = r;
1742
              str.b.offset = 0;
1743
            }
1744
            for (;;) {
1745
              where newdest;
1746
              instore newis;
1747
              newis = str;
1748
              newis.b.offset += disp;
7 7u83 1749
              setinsalt(newdest.answhere, newis);
1750
              newdest.ashwhere = ashof(sh(t));
1751
              code_here(t, nsp, newdest);
1752
              if (last(t)) {
2 7u83 1753
                return mka;
1754
              }
7 7u83 1755
              disp+= (rounder(shape_size(sh(t)), shape_align(sh(bro(t)))) >>3);
2 7u83 1756
              t =bro(t);
1757
            }
1758
          }
1759
          case insomereg: {
1760
            int * sr = someregalt(dest.answhere);
1761
            if (*sr != -1) {
7 7u83 1762
              failer("Somereg *2");
2 7u83 1763
            }
7 7u83 1764
            *sr = getreg(sp.fixed);
1765
            setregalt(dest.answhere, *sr);
2 7u83 1766
 	    /* ,... */
1767
          }
1768
          case inreg: {
1769
            code_here(t, sp, dest);
1770
            r = regalt(dest.answhere);
1771
            nsp = guardreg(r, sp);
7 7u83 1772
            while (!last(t)) {
2 7u83 1773
            	int z;
1774
            	disp+=rounder(shape_size(sh(t)), shape_align(sh(bro(t))));
1775
            	t =bro(t);
1776
            	z = reg_operand(t, nsp);
7 7u83 1777
            	rri_ins(i_sll, z,z, disp);
2 7u83 1778
                rrr_ins(i_or, r, r, z);
1779
            }
1780
            return mka;
1781
          }
1782
	  default: failer("No Tuples in freg");
1783
        }
1784
 
1785
      }
1786
 
1787
      case ncopies_tag:
1788
   {
7 7u83 1789
	exp t = son(e);
2 7u83 1790
	space nsp;
1791
	instore str;
1792
	int i, r, disp = 0;
1793
 
1794
	nsp = sp;
7 7u83 1795
	switch (dest.answhere.discrim) {
2 7u83 1796
	   case notinreg: {
1797
            str = insalt (dest.answhere);/* it should be !! */
1798
            if (!str.adval) {
7 7u83 1799
              int   r = getreg(sp.fixed);
1800
              nsp = guardreg(r, sp);
1801
              ls_ins(i_lw, r, str.b);
2 7u83 1802
              str.adval = 1;
1803
              str.b.base = r;
1804
              str.b.offset = 0;
1805
            }
1806
            for (i=1;i<=no(e); i++) {
1807
              where newdest;
1808
              instore newis;
1809
              newis = str;
1810
              newis.b.offset += disp;
7 7u83 1811
              setinsalt(newdest.answhere, newis);
1812
              newdest.ashwhere = ashof(sh(t));
1813
              code_here(t, nsp, newdest);
1814
              disp+= (rounder(shape_size(sh(t)), shape_align(sh(t))) >>3);
2 7u83 1815
            }
1816
            return mka;
1817
          }
1818
          case insomereg: {
1819
            int * sr = someregalt(dest.answhere);
1820
            if (*sr != -1) {
7 7u83 1821
              failer("Somereg *2");
2 7u83 1822
            }
7 7u83 1823
            *sr = getreg(sp.fixed);
1824
            setregalt(dest.answhere, *sr);
2 7u83 1825
 	    /* ,... */
1826
          }
1827
          case inreg: {
1828
            code_here(t, sp, dest);
1829
            r = regalt(dest.answhere);
1830
            nsp = guardreg(r, sp);
7 7u83 1831
            for (i=1; i<=no(e); i++) {
2 7u83 1832
            	int z;
1833
            	disp+=rounder(shape_size(sh(t)), shape_align(sh(t)));
1834
            	z = reg_operand(t, nsp);
7 7u83 1835
            	rri_ins(i_sll, z,z, disp);
2 7u83 1836
                rrr_ins(i_or, r, r, z);
1837
            }
1838
            return mka;
1839
          }
1840
	  default: failer("No Tuples in freg");
1841
        }
1842
 
1843
      }
1844
 
1845
    case caller_tag: {
1846
    	e = son(e); goto tailrecurse;
1847
    }
1848
 
1849
 
1850
 
1851
    case apply_general_tag:
1852
    	{
1853
    	  exp fn = son(e);
1854
    	  exp cers = bro(fn);
1855
    	  exp cees = bro(cers);
1856
    	  exp pl = bro(cees);
1857
    	  space nsp;
1858
 
7 7u83 1859
    	  if (no(cers)!=0) { nsp = do_callers(son(cers),sp); }
2 7u83 1860
	  else { nsp = sp; }
1861
 
1862
    	  IGNORE make_code(cees, nsp, nowhere, 0);
1863
 
7 7u83 1864
    	  if (name(fn) == name_tag && name(son(fn)) == ident_tag
1865
	    && (son(son(fn)) == nilexp ||
1866
	        name(son(son(fn))) == proc_tag ||
1867
	     name(son(son(fn))) == general_proc_tag)) {
2 7u83 1868
	  /* the procedure can be entered directly */
7 7u83 1869
	  	extj_ins(i_jal, boff(son(fn)));
2 7u83 1870
	  }
1871
	  else
1872
	  if (PIC_code) {
1873
		/* have to get address of proc into r25 */
1874
		where w;
1875
		setregalt(w.answhere, 25);
1876
		w.ashwhere = ashof(sh(fn));
1877
		code_here(fn,sp,w);
1878
		br_ins(i_jal, 25);
1879
          }
1880
    	  else {			/* the address of the proc is evaluated
1881
				   and entered indirectly */
1882
	  clear_reg(31); /* can't use 31 as temp reg for jal */
7 7u83 1883
	  br_ins(i_jal, reg_operand(fn, guardreg(31,sp)));
2 7u83 1884
	}
7 7u83 1885
	if (PIC_code)reset_gp();
2 7u83 1886
	clear_all ();		/* forget all register memories */
1887
        { int hda = name(sh(e));
1888
	  ans aa;
7 7u83 1889
	  if (is_floating(hda)) {
2 7u83 1890
	    freg frg;
1891
	    frg.fr = 0;
1892
	    frg.dble = (hda != shrealhd);
7 7u83 1893
	    setfregalt(aa, frg);
1894
	    move(aa, dest, sp, 1);
2 7u83 1895
	    /* move floating point result of application to destination */
1896
	  }
1897
	  else {
7 7u83 1898
	    setregalt(aa, 2);
2 7u83 1899
	    mka.regmove = 2;
7 7u83 1900
	    move(aa, dest, sp, 1);
2 7u83 1901
	    /* move floating point result of application to destination */
1902
	  }
1903
	  /* else struct results are moved by body of proc */
1904
	}
1905
 
1906
	if (call_is_untidy(cees)) {
1907
		rri_ins(i_subu, 29, 29, max_args>>3);
1908
		reset_tos();
7 7u83 1909
		Assert(name(pl) ==top_tag);
2 7u83 1910
	}
1911
	else
7 7u83 1912
	if (postlude_has_call(e)) {
2 7u83 1913
		exp x = son(cers);
1914
		postl_chain p;
7 7u83 1915
		for (;x != nilexp ;) {
1916
			if (name(x) ==caller_tag) {
2 7u83 1917
				no(x) += max_args;
1918
			}
7 7u83 1919
			if (last(x))break;
2 7u83 1920
			x = bro(x);
1921
		}
1922
		mka.regmove = NOREG;
1923
		update_plc(old_pls, max_args);
1924
		p.pl = pl;
1925
		p.outer = old_pls;
1926
		old_pls = &p;
1927
		rri_ins(i_subu, 29, 29, max_args>>3);
1928
 		IGNORE make_code(pl, sp, nowhere, 0);
1929
		rri_ins(i_addu, 29, 29, max_args>>3);
1930
		old_pls = p.outer;
1931
		update_plc(old_pls, -max_args);
1932
	}
1933
	else
1934
		IGNORE make_code(pl, sp, nowhere, 0);
1935
 
1936
	return mka;
1937
    }
1938
 
1939
    case caller_name_tag: {
1940
    	return mka;
1941
    }
1942
 
1943
    case make_callee_list_tag: {
1944
 
7 7u83 1945
    	long x = ((no(e) >>3) +23) & ~7;
2 7u83 1946
	do_callee_list(e, sp);
1947
    	if (call_has_vcallees(e)) { rri_ins(i_addu, 30, 29, x);}
1948
    	return mka;
1949
/*
1950
	| 1st callee par	|	= sf on entry
1951
	| 2nd    "" 		|
1952
		.....
1953
  -16	| callers loc reg 23	| Has_vcallees	}
1954
  -12	| callees loc reg 23	| Has_vcallees	}  4 overhd wds
1955
  -8	| callees tos		| Has_tos	}
1956
  -4	| caller's fp = $30	|		}
1957
	 -----------------------
1958
	| caller pars		|   	= top of callers env
1959
	|			|		also $30 if var callees
1960
 
1961
*/
1962
    }
1963
    case same_callees_tag: {
1964
        baseoff b;
1965
        bool vc = call_has_vcallees(e);
1966
        space nsp;
1967
	exp bdy = son(crt_proc);
1968
 
7 7u83 1969
	while (name(bdy) ==dump_tag || name(bdy) ==diagnose_tag)bdy = son(bdy);
1970
	while (name(bdy) ==ident_tag && isparam(bdy)) {
2 7u83 1971
		/* make sure that current callees are in right place */
1972
	   exp sbdy = son(bdy);
7 7u83 1973
	   if (name(sbdy) ==formal_callee_tag && (props(bdy) &inanyreg)!=0
1974
			&& isvar(bdy)) {
2 7u83 1975
		baseoff b;
1976
		if (Has_fp) {
1977
			b.base = 30;
7 7u83 1978
			b.offset = (no(sbdy) -callee_size) >>3;
2 7u83 1979
		}
1980
		else {
1981
			b.base = 29;
7 7u83 1982
			b.offset = (no(sbdy) +frame_size) >>3;
2 7u83 1983
		}
7 7u83 1984
		if (is_floating(name(sh(sbdy)))) {
2 7u83 1985
			lsfp_ins((name(sh(sbdy))!=shrealhd)?i_s_d:i_s_s,
7 7u83 1986
					  no(bdy) <<1, b);
2 7u83 1987
		}
1988
		else ls_ins(i_sw, no(bdy), b);
1989
	    }
1990
	    bdy = bro(sbdy);
1991
	}
1992
 
1993
    	if (Has_vcallees) {
1994
    		/*  move [fp+16..local_reg] -> top of stack */
1995
 
1996
 
1997
    		int rsize = getreg(sp.fixed);
1998
    		int rsrce; int rdest;
1999
    		int t30;
2000
    		int le = new_label(); int lb = new_label();
2001
    		nsp = guardreg(rsize, sp);
2002
    		t30 = getreg(nsp.fixed); nsp = guardreg(t30, nsp);
2003
    		rsrce = getreg(nsp.fixed); nsp = guardreg(rsrce, nsp);
2004
    		rdest = getreg(nsp.fixed); nsp = guardreg(rdest, nsp);
2005
 
2006
    		mon_ins(i_move, t30, 29);
2007
    		rrr_ins(i_subu, rsize, 30, local_reg);
2008
    		rrr_ins(i_subu, 29,29, rsize);
2009
    		b.base = t30; b.offset = -4;
2010
    		ls_ins(i_sw, 30, b);
2011
    		rri_ins(i_subu, rsrce, 30, 16);
2012
    		rri_ins(i_subu, rdest, t30, 16);
2013
    		condrr_ins(i_beq, rdest, 29, le);
2014
    		set_label(lb);
2015
    		b.base = rsrce; b.offset = -4;
2016
    		ls_ins(i_lw, rsize, b);
2017
    		b.base = rdest;
2018
    		ls_ins(i_sw, rsize, b);
2019
    		rri_ins(i_subu, rsrce, rsrce, 4);
2020
    		rri_ins(i_subu, rdest, rdest, 4);
2021
    		condrr_ins(i_bne, rdest, 29, lb);
2022
    		set_label(le);
2023
    		if (vc) { mon_ins(i_move, 30, t30); }
2024
    	}
2025
    	else {
2026
    		int cs = (callee_size>>3);
2027
    		int i;
2028
    		int tr = getreg(sp.fixed);
2029
    		rri_ins(i_subu, 29,29, cs);
2030
    		b.base = 29; b.offset = cs-4;
2031
    		ls_ins(i_sw, 30, b);
7 7u83 2032
    		for (i = cs-16; i>0; i-=4) {
2 7u83 2033
    		        b.base = 30; b.offset = i-cs-4;
2034
    			ls_ins(i_lw, tr, b);
2035
    			b.base = 29; b.offset = i-4;
2036
    			ls_ins(i_sw, tr, b);
2037
    		}
2038
    		if (vc) { rri_ins(i_addu, 30, 29, cs); }
2039
    	}
2040
    	return mka;
2041
    }
2042
 
2043
 
2044
 
2045
    case make_dynamic_callee_tag: {
2046
    	bool vc = call_has_vcallees(e);
2047
    	int rptr;
2048
    	int rsize;
2049
    	int rdest;
2050
    	int tempreg;
2051
    	space nsp;
2052
    	baseoff b;
2053
    	int ls,le;
2054
	rptr = getreg(sp.fixed);
2055
	load_reg(son(e), rptr, sp);
2056
	nsp = guardreg(rptr, sp);
2057
	rsize = getreg(nsp.fixed);
2058
	load_reg(bro(son(e)), rsize, sp);
2059
	nsp = guardreg(rsize,nsp);
2060
	rdest = getreg(nsp.fixed);
2061
	nsp = guardreg(rdest,nsp);
2062
	tempreg = getreg(nsp.fixed);
2063
	rri_ins(i_addu, rdest, rsize, 7+16);
2064
	rri_ins(i_and, rdest,rdest, ~7);
2065
	b.base= 29; b.offset = -4;
2066
	ls_ins(i_sw, 30, b);
7 7u83 2067
	if (vc)mon_ins(i_move, 30, 29);
2 7u83 2068
	rrr_ins(i_subu, 29, 29, rdest);
2069
	rri_ins(i_addu, rdest, 29, 0);
2070
	ls = new_label();
2071
	le = new_label();
2072
	condrr_ins(i_ble, rsize, 0, le);
2073
	b.offset = 0;
2074
	set_label(ls);
2075
	b.base = rptr;
2076
	ls_ins(i_lw, tempreg, b);
2077
	b.base = rdest;
2078
	ls_ins(i_sw, tempreg, b);
2079
	rri_ins(i_addu, rdest, rdest, 4);
2080
	rri_ins(i_addu, rptr, rptr, 4);
2081
	rri_ins(i_subu, rsize, rsize, 4);
2082
	condrr_ins(i_bgt, rsize, 0, ls);
2083
	set_label(le);
2084
 
2085
        return mka;
2086
    }
2087
 
2088
    case tail_call_tag: {
2089
    	exp fn = son(e);
2090
    	exp cees = bro(fn);
7 7u83 2091
    	bool glob = (name(fn) == name_tag && name(son(fn)) == ident_tag
2092
	    		&& (son(son(fn)) == nilexp ||
2093
	        		name(son(son(fn))) == proc_tag ||
2094
	     			name(son(son(fn))) ==
2 7u83 2095
	     			general_proc_tag));
2096
	exp bdy = son(crt_proc);
2097
	int rptr; int rsz;
2098
	space nsp;
2099
	space xsp;
2100
	int temp_fn_reg;
2101
 
2102
	nsp=sp;
2103
	xsp=sp;
7 7u83 2104
    	if (name(cees) ==make_callee_list_tag) {
2 7u83 2105
    		do_callee_list(cees, sp);
2106
    	}
2107
 
2108
	xsp.fixed = 0x800000f0;
2109
	nsp.fixed |= 0x800000f0; /* don't use parregs or linkreg */
7 7u83 2110
    	if (name(cees) ==make_dynamic_callee_tag) {
2 7u83 2111
    		rptr = getreg(nsp.fixed);
2112
    		load_reg(son(cees),rptr,nsp);
2113
    		nsp = guardreg(rptr, nsp);
2114
		xsp = guardreg(rptr, xsp);
2115
    		rsz = getreg(nsp.fixed);
2116
    		load_reg(bro(son(cees)),rsz,nsp);
2117
    		nsp = guardreg(rsz, nsp);
2118
		xsp = guardreg(rsz,nsp);
2119
    	}
2120
    	if (PIC_code) {
2121
		temp_fn_reg = 25;
2122
		load_reg(fn,temp_fn_reg,nsp);
2123
	}
2124
	else
7 7u83 2125
    	if (!glob) {
2 7u83 2126
    		temp_fn_reg = getreg(nsp.fixed);
2127
    		load_reg(fn,temp_fn_reg,nsp);
2128
		nsp = guardreg(temp_fn_reg,nsp);
2129
		xsp = guardreg(temp_fn_reg,xsp);
2130
    	}
2131
 
2132
 
7 7u83 2133
	while (name(bdy) ==dump_tag || name(bdy) ==diagnose_tag)bdy = son(bdy);
2 7u83 2134
 
7 7u83 2135
	while (name(bdy) ==ident_tag && isparam(bdy)) {
2 7u83 2136
		/* make sure that current callers and callees are in right place */
2137
		exp sbdy = son(bdy);
2138
		baseoff b;
2139
		if (Has_fp) {
2140
			b.base = 30;
7 7u83 2141
			b.offset = no(sbdy) >>3;
2 7u83 2142
		}
2143
		else {
2144
			b.base = 29;
7 7u83 2145
			b.offset = (no(sbdy) +frame_size+callee_size) >>3;
2 7u83 2146
		}
7 7u83 2147
		if (name(sbdy) ==formal_callee_tag
2148
			&& name(cees) == same_callees_tag) {
2 7u83 2149
		   if ((props(bdy) &inanyreg)!=0) {
2150
			b.offset -= (callee_size>>3);
7 7u83 2151
			if (isvar(bdy)) {
2152
			  if (is_floating(name(sh(sbdy)))) {
2 7u83 2153
				lsfp_ins((name(sh(sbdy))!=shrealhd)?i_s_d:i_s_s,
7 7u83 2154
					  no(bdy) <<1, b);
2 7u83 2155
			  }
2156
			  else ls_ins(i_sw, no(bdy), b);
2157
			}
2158
		   }
2159
		}
2160
		else
2161
		if (props(sbdy) == 0 && (props(bdy) &inanyreg)!=0) {
2162
			/* should be instore; is in reg */
7 7u83 2163
			if (isvar(bdy)) {
2164
			  if (is_floating(name(sh(sbdy)))) {
2 7u83 2165
				lsfp_ins((name(sh(sbdy))!=shrealhd)?i_s_d:i_s_s,
7 7u83 2166
					  no(bdy) <<1, b);
2 7u83 2167
			  }
2168
			  else ls_ins(i_sw, no(bdy), b);
2169
			}
2170
		}
2171
		else
7 7u83 2172
		if (props(sbdy)!=0 && (props(bdy) & inanyreg) ==0) {
2 7u83 2173
		        /* should be in reg; is in store */
7 7u83 2174
	               if (!Has_no_vcallers && isvis(bdy) && last_param(bdy)) {
2175
				int i = no(sbdy) >>5;
2176
				for (; i<4; i++) {
2 7u83 2177
					ls_ins(i_lw, i+4, b);
2178
					b.offset +=4;
2179
				}
2180
			}
2181
			else
7 7u83 2182
			if (is_floating(name(sh(sbdy)))) {
2 7u83 2183
				lsfp_ins((name(sh(sbdy))!=shrealhd)?i_l_d:i_l_s,
7 7u83 2184
					  props(sbdy) <<1, b);
2 7u83 2185
			}
2186
			else ls_ins(i_lw, props(sbdy), b);
2187
 
2188
		}
2189
		else
7 7u83 2190
		if (props(sbdy)!=0 && props(sbdy)!= no(bdy)) {
2 7u83 2191
                	/* in wrong register */
7 7u83 2192
                	if (is_floating(name(sh(sbdy)))) {
2 7u83 2193
                		rrfp_ins((name(sh(sbdy))!=shrealhd)?i_mov_d:i_mov_s,
7 7u83 2194
                		          props(sbdy) <<1, no(bdy) <<1);
2 7u83 2195
                        }
2196
                        else mon_ins(i_move, props(sbdy), no(bdy));
2197
               }
2198
 
2199
 
2200
               bdy = bro(sbdy);
2201
        }
2202
 
2203
        restore_sregs(fixdone, fltdone);
2204
 
2205
 
7 7u83 2206
       if (name(cees) ==make_callee_list_tag) {
2 7u83 2207
       		/* copy from top of stack */
7 7u83 2208
       		int x = ((no(cees) >>3) +23) & ~7;
2 7u83 2209
       		int r = getreg(xsp.fixed);
2210
		int r1 = getreg(guardreg(r,xsp).fixed);
2211
       		int i;
2212
       		baseoff b;
7 7u83 2213
		int ncees = no(cees) >>3;
2214
		int rnc = (ncees+7) &~7;
2215
       		for (i= ncees; i > 0; i-=4) {
2 7u83 2216
		   int x = r;
2217
       		   b.base = 29; b.offset = i-4;
2218
       		   ls_ins(i_lw, r, b);
2219
       		   b.base = 30; b.offset = i-rnc-20;
2220
       		   ls_ins(i_sw, r, b);
2221
       		   r = r1; r1 = x;
2222
       		}
2223
    		/*
2224
 
2225
    		sp + 0: p1 ->   fp - 20: p1
2226
    		sp + 4: p2      fp - 24: p2
2227
    		sp + 8: p3      fp - 28: p3
2228
    			....
2229
    		*/
2230
 
2231
    		rri_ins(i_subu, 29, 30, x);
2232
 
2233
	}
2234
	else
7 7u83 2235
	if (name(cees) ==make_dynamic_callee_tag) {
2 7u83 2236
		/* rdest = fp-16;
2237
		   rsize = (rsize+23)&~7
2238
		   rsource = rptr + rsize
2239
		   while rsize>0
2240
		      [rdest-4] = [rsource-4];
2241
		      rdest-=4; rsource-=4; rsize-=4;
2242
		   sp = rdest;
2243
		*/
2244
		int rdest; int rsize = rsz;
2245
		int rsource = rptr; int tempr;
2246
		int le, ls;
2247
		baseoff b;
2248
		rdest = getreg(xsp.fixed);
2249
		nsp = guardreg(rdest, nsp);
2250
		tempr = getreg(xsp.fixed);
2251
		rri_ins(i_subu, rdest, 30, 16);
2252
		rri_ins(i_addu, rsize, rsize, 7);
2253
		rri_ins(i_and, rsize, rsize, ~7);
2254
		rrr_ins(i_addu, rsource, rsource, rsize);
2255
		le = new_label(); ls = new_label();
2256
		condrr_ins(i_ble, rsize, 0, le);
2257
		set_label(ls);
2258
		b.base = rsource; b.offset = -4;
2259
		ls_ins(i_lw, tempr, b);
2260
		b.base = rdest;
2261
		ls_ins(i_sw, tempr, b);
2262
		rri_ins(i_subu, rdest, rdest, 4);
2263
		rri_ins(i_subu, rsource, rsource, 4);
2264
		rri_ins(i_subu, rsize, rsize, 4);
2265
		condrr_ins(i_bgt, rsize, 0, ls);
2266
		set_label(le);
2267
		mon_ins(i_move, 29, rdest);
2268
 
2269
 
2270
	}
2271
	else {
2272
		if (Has_vcallees) {
2273
			mon_ins(i_move, 29, local_reg);
2274
		}
2275
		else
2276
		if (Has_fp) {
2277
			 rri_ins(i_subu, 29, 30, callee_size>>3);
2278
		}
2279
		else { /* this should only occur in initialisation procs */
7 7u83 2280
			rri_ins(i_addu, 29, 29,(frame_size+callee_size) >>3);
2 7u83 2281
		}
2282
 
2283
	}
2284
 
2285
        if (Has_vcallees) {
2286
	  	baseoff b;
2287
	  	b.base = 30;
2288
	  	b.offset = -16;
2289
	  	ls_ins(i_lw, local_reg, b); /* old l-reg in -16(30) */
2290
	}
2291
    	if (glob && !PIC_code) {
7 7u83 2292
    		extj_ins(i_j, boff(son(fn)));
2 7u83 2293
    	}
2294
    	else {
2295
    		br_ins(i_j, temp_fn_reg);
2296
 
2297
    	}
2298
    	clear_all();
2299
    	return mka;
2300
 
2301
 
2302
 
2303
    }
2304
 
2305
    case apply_tag:
2306
      {
7 7u83 2307
	exp fn = son(e);
2308
	exp par = bro(fn);
2 7u83 2309
	exp list = par;
7 7u83 2310
	exp dad = father(e);
2311
	bool tlrecurse = rscope_level == 0 && (name(dad) == res_tag) && props(dad);
2312
	int   hda = name(sh(e));
2 7u83 2313
	int disp;
2314
 
2315
	ash ansash;
2316
 
2317
 
2318
 
2319
	if ((disp = specialfn (fn)) > 0) {/* eg function is strlen */
7 7u83 2320
	  mka.lab = specialmake(disp, list, sp, dest, exitlab);
2 7u83 2321
	  return mka;
2322
	}
2323
 
7 7u83 2324
	ansash = ashof(sh(e));
2 7u83 2325
 
2326
	if (!last(fn)) {
2327
		sp = do_callers(list, sp);
2328
	}
2329
 
2330
 
7 7u83 2331
	if (name(fn) == name_tag && name(son(fn)) == ident_tag
2332
	    && (son(son(fn)) == nilexp || name(son(son(fn))) == proc_tag)) {
2 7u83 2333
	  /* the procedure can be entered directly */
2334
	  if (! tlrecurse) {
7 7u83 2335
	  	extj_ins(i_jal, boff(son(fn)));
2336
		if (PIC_code)reset_gp();
2 7u83 2337
	  }
2338
	  else {
2339
	  	if (Has_fp) {
2340
	  		baseoff b;
2341
	  		b.base = 30;
2342
	  		b.offset = -4;
2343
	  		restore_sregs(fixdone, fltdone);
2344
	  		mon_ins(i_move, 29, 30);
2345
	  		ls_ins(i_lw, 30, b);
2346
	  	}
2347
	  	else {
2348
	  		restore_sregs(fixdone, fltdone);
7 7u83 2349
	  		rri_ins(i_addu, 29, 29,(frame_size+callee_size) >>3);
2 7u83 2350
	  	}
7 7u83 2351
	  	extj_ins(i_j, boff(son(fn)));
2352
	  	if (as_file)fprintf(as_file," # Tail recursion\n");
2 7u83 2353
	  }
2354
 
2355
	}
2356
	else
2357
	if (PIC_code) {
2358
		/* have to get address of proc into r25 */
2359
		where w;
2360
		setregalt(w.answhere, 25);
2361
		w.ashwhere = ashof(sh(fn));
2362
		code_here(fn,sp,w);
2363
		br_ins(i_jal, 25);
2364
		reset_gp();
2365
        }
2366
	else {			/* the address of the proc is evaluated
2367
				   and entered indirectly */
2368
	  clear_reg(31); /* can't use 31 as temp reg for jal */
7 7u83 2369
	  br_ins(i_jal, reg_operand(fn, guardreg(31,sp)));
2 7u83 2370
	}
2371
	clear_all ();		/* forget all register memories */
2372
        {
2373
	  ans aa;
7 7u83 2374
	  if (is_floating(hda)) {
2 7u83 2375
	    freg frg;
2376
	    frg.fr = 0;
2377
	    frg.dble = (hda != shrealhd);
7 7u83 2378
	    setfregalt(aa, frg);
2379
	    move(aa, dest, sp, 1);
2 7u83 2380
	    /* move floating point result of application to destination */
2381
	  }
2382
	  else {
7 7u83 2383
	    setregalt(aa, 2);
2 7u83 2384
	    mka.regmove = 2;
7 7u83 2385
	    move(aa, dest, guardreg(2,sp), 1);
2 7u83 2386
	    /* move fixed point result of application to destination */
2387
	  }
2388
	  /* else struct results are moved by body of proc */
2389
	}
2390
	return mka;
2391
      }				/* end apply */
2392
 
2393
    case return_to_label_tag: {
2394
	int r = getreg(sp.fixed);
2395
	where w;
2396
	setregalt(w.answhere, r);
7 7u83 2397
	w.ashwhere = ashof(sh(son(e)));
2398
	code_here(son(e), sp, w);
2 7u83 2399
	clear_all();
2400
	if (Has_fp) {
2401
		baseoff b;
2402
		b.base = 30;
7 7u83 2403
		restore_sregs(fixdone, fltdone);
2 7u83 2404
		if (Has_vcallees) {
2405
			b.offset = -16;
2406
			ls_ins(i_lw, local_reg, b);
2407
		}
2408
		b.offset = -4;
2409
		mon_ins(i_move, 29, 30);
2410
		ls_ins(i_lw, 30, b);
2411
	}
2412
	else
2413
	if (frame_size !=0) {
7 7u83 2414
		restore_sregs(fixdone, fltdone);
2 7u83 2415
		/* restore dumped value of s-regs on entry */
7 7u83 2416
		rri_ins(i_addu, 29, 29, frame_size >> 3);
2 7u83 2417
		/* reset stack ptr */
2418
	}
2419
	uncond_ins(i_j, r);
2420
	return mka;
2421
    }
2422
 
2423
 
2424
 
2425
    case res_tag: case untidy_return_tag:
2426
      {
2427
	where w;
2428
	w.answhere = procans;
7 7u83 2429
	w.ashwhere = ashof(sh(son(e)));
2430
	code_here(son(e), sp, w);
2 7u83 2431
	/* evaluate result value */
2432
 
2433
	clear_all ();		/* clear all register memories */
2434
 
2435
	if (rscope_level == 0) {/* normal proc body */
2436
	  if (name(son(e)) == apply_tag && props(e)) return mka;
2437
	  				/* was a tail recursion */
2438
	  if (frame_size == 0
2439
		  && !Has_fp) {
7 7u83 2440
	    uncond_ins(i_j, 31);
2 7u83 2441
	  }
2442
	  else
7 7u83 2443
	  if (result_label != 0 && name(e) ==res_tag) {
2 7u83 2444
	  	uncond_ins(i_b, result_label);
7 7u83 2445
	  	if (as_file)fprintf(as_file, " # Return\n");
2 7u83 2446
	  }
2447
	  else{
7 7u83 2448
	      	if ((fixdone|fltdone) ==0) {
2 7u83 2449
	  		result_label = new_label();
2450
	  		set_label(result_label);
2451
	     	}
2452
	  	if (Has_fp) {
2453
	  		baseoff b;
2454
	  		b.base = 30;
7 7u83 2455
	  		restore_sregs(fixdone, fltdone);
2 7u83 2456
	  		if (Has_vcallees) {
2457
	  			b.offset = -16;
2458
	  			ls_ins(i_lw, local_reg, b);
2459
	  		}
2460
			b.offset = -4;
7 7u83 2461
	  		if (name(e) ==res_tag)mon_ins(i_move, 29, 30);
2 7u83 2462
	  		ls_ins(i_lw, 30, b);
2463
	  	}
2464
	  	else {
7 7u83 2465
                	restore_sregs(fixdone, fltdone);
2 7u83 2466
                	/* restore dumped value of s-regs on entry */
2467
                	if (frame_size != 0 && name(e) == res_tag) {
7 7u83 2468
                		rri_ins(i_addu, 29, 29, frame_size >> 3);
2 7u83 2469
                        }
2470
                	/* reset stack ptr */
2471
                }
2472
	      if (diagPIClab != 0) {
2473
		uncond_ins(i_b, diagPIClab);
2474
	      }
7 7u83 2475
	      else { uncond_ins(i_j, 31); }
2 7u83 2476
	    }
2477
	}
2478
	else {			/* inlined result */
7 7u83 2479
	  if (rscope_label == 0)rscope_label = new_label();
2 7u83 2480
	  if (rscope_label != exitlab) {
7 7u83 2481
	    uncond_ins(i_b, rscope_label);
2 7u83 2482
	  }
2483
	}
2484
	return mka;
2485
      }				/* end result */
2486
 
2487
    case diagnose_tag: {
2488
    	output_diag(dno(e), 0,e);
7 7u83 2489
    	mka = make_code(son(e), sp, dest, exitlab);
2 7u83 2490
	output_end_scope(dno(e),e);
2491
	return mka;
2492
    }
2493
 
2494
    /*
2495
	removed in version 3.0
2496
     case rscope_tag:
2497
      {
2498
 
2499
	  ans old_procans;
2500
	  int   old_rscope_label = rscope_label;
2501
	  if (dest.answhere.discrim == insomereg) {
2502
 
2503
	    int  *sr = someregalt (dest.answhere);
2504
	    if (*sr != -1) {
2505
	      failer ("Somereg *2");
2506
	    }
2507
	    *sr = getreg (sp.fixed);
2508
	    setregalt (dest.answhere, *sr);
2509
	  }
2510
	  else
2511
	  if (dest.answhere.discrim == insomefreg) {
2512
	       somefreg sfr;
2513
	       freg fr;
2514
   	       sfr = somefregalt(dest.answhere);
2515
	       if (*sfr.fr != -1) { failer ("Somefreg *2"); }
2516
	       *sfr.fr = getfreg(sp.flt);
2517
	       fr.fr = *sfr.fr;
2518
	       fr.dble = sfr.dble;
2519
	       setfregalt(dest.answhere, fr);
2520
	  }
2521
	  rscope_level++;
2522
	  old_procans = procans;
2523
	  procans = dest.answhere;
2524
	  rscope_label =  exitlab;
2525
 
2526
	  if (as_file) fprintf(as_file, " # start inlined proc\n");
2527
	  mka = make_code (son (e), sp, dest, rscope_label);
2528
	  if (as_file) fprintf(as_file, " # end inlined proc\n");
2529
 
2530
 
2531
	  if (mka.lab != 0 && mka.lab != rscope_label) {
2532
	  	set_label(mka.lab);
2533
	  }
2534
	  mka.lab = rscope_label;
2535
	  mka.regmove = NOREG;
2536
	  rscope_level--;
2537
	  procans = old_procans;
2538
	  rscope_label = old_rscope_label;
2539
	  return mka;
2540
	}
2541
*/
2542
 
2543
    case solve_tag:
2544
      {
7 7u83 2545
	exp m = bro(son(e));
2 7u83 2546
	int   l = exitlab;
2547
	if (dest.answhere.discrim == insomereg) {
2548
	  /* choose register for result */
7 7u83 2549
	  int  *sr = someregalt(dest.answhere);
2 7u83 2550
	  if (*sr != -1) {
7 7u83 2551
	    failer("Somereg *2");
2 7u83 2552
	  }
7 7u83 2553
	  *sr = getreg(sp.fixed);
2554
	  setregalt(dest.answhere, *sr);
2 7u83 2555
	}
2556
	else
7 7u83 2557
	if (dest.answhere.discrim == insomefreg) {
2 7u83 2558
	       somefreg sfr;
2559
	       freg fr;
2560
   	       sfr = somefregalt(dest.answhere);
7 7u83 2561
	       if (*sfr.fr != -1) { failer("Somefreg *2"); }
2 7u83 2562
	       *sfr.fr = getfreg(sp.flt);
2563
	       fr.fr = *sfr.fr;
2564
	       fr.dble = sfr.dble;
2565
	       setfregalt(dest.answhere, fr);
2566
	}
2567
 
2568
	for (;;) {		/* set up all the labels in the component
2569
				   labst_tags */
7 7u83 2570
	  no(son(m)) = new_label();
2571
	  if (last(m))
2 7u83 2572
	    break;
7 7u83 2573
	  m = bro(m);
2 7u83 2574
	}
2575
 
7 7u83 2576
	m = son(e);
2 7u83 2577
	for (;;) {		/* evaluate all the component statements
2578
				*/
7 7u83 2579
	  int   fl = make_code(m, sp, dest, l).lab;
2580
	  clear_all();
2 7u83 2581
	  if (fl != 0)
2582
	    l = fl;
2583
	  if (!last (m)) {	/* jump to end of solve */
2584
	    if (l == 0)
7 7u83 2585
	      l = new_label();
2586
	    if (name(sh(m))!= bothd) {
2587
	      uncond_ins(i_b, l);
2 7u83 2588
	    }
2589
	  }
7 7u83 2590
	  if (last(m)) {
2 7u83 2591
	    mka.lab = l;
2592
	    return mka;
2593
	  };
7 7u83 2594
	  m = bro(m);
2 7u83 2595
	}
2596
      }				/* end solve */
2597
 
2598
 
2599
 
2600
    case case_tag:
2601
      {
7 7u83 2602
	int   r = reg_operand(son(e), sp);
2 7u83 2603
	/* evaluate controlling integer into reg r */
2604
	mm lims;
7 7u83 2605
	exp z = bro(son(e));
2 7u83 2606
	exp zt = z;
2607
	long  n;
2608
	long  l;
2609
	long  u = 0x80000000;
2610
 
2611
	sp = guardreg(r,sp);
7 7u83 2612
	l = no(zt);
2 7u83 2613
	for (n = 1;; n++) {	/* calculate crude criterion for using
2614
				   jump vector or branches */
7 7u83 2615
	  if (u + 1 != no(zt) && son(zt)!= nilexp) {
2 7u83 2616
	    n++;
2617
	  }
7 7u83 2618
	  if (last(zt)) {
2619
	    u = (son(zt)!= nilexp)? no(son(zt)): no(zt);
2 7u83 2620
	    break;
2621
	  }
7 7u83 2622
	  if (son(zt)!= nilexp) {
2623
	    u = no(son(zt));
2 7u83 2624
	  }
2625
	  else {
7 7u83 2626
	    if (u + 1 == no(zt))
2 7u83 2627
	      u += 1;
2628
	  }
2629
 
7 7u83 2630
	  zt = bro(zt);
2 7u83 2631
	}
2632
 
2633
	/* now l is lowest controlling value and u is highest */
2634
 
7 7u83 2635
	if (is_signed(sh(son(e)))) { u = u/2 - l/2; }
2636
	else { u = ((unsigned)u) /2 - ((unsigned)l) /2; }
2 7u83 2637
 
2638
	if ( u <= n * n / 4 -3 /* ware overflow! */) {
2639
	  /* space-time product criterion for jump vector instead of tests
2640
	     and branches *//* use jump vector */
7 7u83 2641
	  int   endlab = new_label();
2642
	  int   veclab = next_dlab_sym();
2 7u83 2643
	  baseoff zeroveclab;
2644
	  baseoff zero3;
7 7u83 2645
	  int   mr = getreg(sp.fixed);
2 7u83 2646
	  int r3 = getreg(guardreg(mr,sp).fixed);
2647
	  zero3.base = r3;
2648
	  zero3.offset = 0;
2649
	  zeroveclab.offset = 0;
2650
	  zeroveclab.base = veclab;
2651
	  n = l;
2652
 
2653
	  if (as_file)
7 7u83 2654
	    fprintf(as_file, "\t.rdata\n$$%d:\n", veclab);
2655
	  out_common(0, irdata);
2656
	  out_common(tempsnos[veclab - 32], ilabel);
2 7u83 2657
	  for (;;) {
2658
	    for (; no (z) > n; n++) {/* o/p jump vector */
2659
	      if (as_file)
7 7u83 2660
		fprintf(as_file,
2 7u83 2661
			(PIC_code)?"\t.gpword\t$%d\n":"\t.word\t$%d\n", endlab);
7 7u83 2662
	      out_value(-endlab,(PIC_code)?igpword:iword, 0, 1);
2 7u83 2663
	    }
7 7u83 2664
	    u = (son(z) == nilexp)? n : no(son(z));
2 7u83 2665
	    for (; n <= u; n++) {
2666
	      props(son(pt(z))) = 1; /* as bug - see labst_tag */
2667
	      if (as_file)
7 7u83 2668
		fprintf(as_file,
2669
			(PIC_code)?"\t.gpword\t$%d\n":"\t.word\t$%d\n", no(son(pt(z))));
2670
	      out_value(-no(son(pt(z))), (PIC_code)?igpword:iword, 0, 1);
2 7u83 2671
	    }
7 7u83 2672
	    if (last(z))
2 7u83 2673
	      break;
7 7u83 2674
	    z = bro(z);
2 7u83 2675
	  }
2676
 
2677
	  if (as_file)
7 7u83 2678
	    fprintf(as_file, "\t.text\n");
2679
	  out_common(0, itext);
2 7u83 2680
 
7 7u83 2681
	  ls_ins(i_la, r3, zeroveclab);
2 7u83 2682
	  if (l != 0) {
7 7u83 2683
	    rri_ins(i_addu, mr, r, -l);
2684
	    condri_ins(i_bgeu, mr, u - l + 1, endlab);
2685
	    rri_ins(i_mul, mr, mr, 4);
2 7u83 2686
	  }
2687
	  else {
7 7u83 2688
	    condri_ins(i_bgeu, r, u + 1, endlab);
2689
	    rri_ins(i_mul, mr, r, 4);
2 7u83 2690
	  }
7 7u83 2691
	  rrr_ins(i_addu, r3, r3, mr);
2692
	  ls_ins(i_lw, r3, zero3);
2 7u83 2693
	  if (PIC_code) {  rrr_ins(i_addu, r3, r3, 28); }
7 7u83 2694
	  uncond_ins(i_j, r3);
2695
	  set_label(endlab);
2 7u83 2696
	  return mka;
2697
	}
2698
	else
2699
	if (is_signed(sh(son(e)))) {
2700
	  int   over = 0;	/* use branches - tests are already
2701
				   ordered */
2702
	  bool usw;
7 7u83 2703
	  lims = maxmin(sh(son(e)));
2 7u83 2704
	  for (;;) {
7 7u83 2705
	    int   lab = no(son(pt(z)));
2706
	    long l = no(z);
2 7u83 2707
	    if (son (z) == nilexp) {/* only single test required */
7 7u83 2708
	      condri_ins(i_beq, r, l, lab);
2 7u83 2709
	      if (l == lims.maxi)
2710
		lims.maxi -= 1;
2711
	      else
2712
		if (l == lims.mini)
2713
		  lims.mini += 1;
2714
	    }
2715
	    else
7 7u83 2716
	      if (u = no(son(z)), l > lims.mini) {
2717
		if (u >= lims.maxi)
2 7u83 2718
		{/* have already tested lower */
7 7u83 2719
		  condri_ins(i_bge, r, l, lab);
2 7u83 2720
		  lims.maxi = l - 1;
2721
		}
2722
		else {
2723
		  if (over == 0) {
7 7u83 2724
		    over = new_label();
2 7u83 2725
		  }
7 7u83 2726
		  condri_ins(i_blt, r, l, over);
2727
		  condri_ins(i_ble, r, u, lab);
2 7u83 2728
		  lims.mini = u + 1;
2729
		}
2730
	      }
2731
	      else		/* lower is <= lower limit of shape */
2732
		if (u < lims.maxi) {
7 7u83 2733
		  condri_ins(i_ble, r, u, lab);
2 7u83 2734
		  lims.mini = u + 1;
2735
		}
2736
		else {		/* upper is >= upper limit of shape */
7 7u83 2737
		  uncond_ins(i_b, lab);
2 7u83 2738
		}
7 7u83 2739
	    if (last(z)) {
2 7u83 2740
	      if (over != 0) {
7 7u83 2741
		set_label(over);
2 7u83 2742
	      } return mka;
2743
	    }
7 7u83 2744
	    z = bro(z);
2 7u83 2745
	  }
2746
	}
2747
	else {
2748
	  int   over = 0;	/* use branches - tests are already
2749
				   ordered */
2750
	  unsigned long maxi;
2751
	  unsigned long mini;
7 7u83 2752
	  lims = maxmin(sh(son(e)));
2 7u83 2753
	  maxi = (unsigned)lims.maxi;
2754
	  mini = (unsigned)lims.mini;
2755
	  for (;;) {
7 7u83 2756
	    int   lab = no(son(pt(z)));
2757
	    unsigned long l = no(z);
2 7u83 2758
	    if (son (z) == nilexp) {/* only single test required */
7 7u83 2759
	      condri_ins(i_beq, r, l, lab);
2 7u83 2760
	      if (l == maxi)
2761
		maxi -= 1;
2762
	      else
2763
		if (l == mini)
2764
		  mini += 1;
2765
	    }
2766
	    else
7 7u83 2767
	      if (u = no(son(z)), l > mini) {
2768
		if (u >= maxi)
2 7u83 2769
		{/* have already tested lower */
7 7u83 2770
		  condri_ins(i_bgeu, r, l, lab);
2 7u83 2771
		  maxi = l - 1;
2772
		}
2773
		else {
2774
		  if (over == 0) {
7 7u83 2775
		    over = new_label();
2 7u83 2776
		  }
7 7u83 2777
		  condri_ins(i_bltu, r, l, over);
2778
		  condri_ins(i_bleu, r, u, lab);
2 7u83 2779
		  mini = u + 1;
2780
		}
2781
	      }
2782
	      else		/* lower is <= lower limit of shape */
2783
		if (u < maxi) {
7 7u83 2784
		  condri_ins(i_bleu, r, u, lab);
2 7u83 2785
		  mini = u + 1;
2786
		}
2787
		else {		/* upper is >= upper limit of shape */
7 7u83 2788
		  uncond_ins(i_b, lab);
2 7u83 2789
		}
7 7u83 2790
	    if (last(z)) {
2 7u83 2791
	      if (over != 0) {
7 7u83 2792
		set_label(over);
2 7u83 2793
	      } return mka;
2794
	    }
7 7u83 2795
	    z = bro(z);
2 7u83 2796
	  }
2797
	}
2798
 
2799
      }				/* end case */
2800
 
2801
    case offset_add_tag: { /* byte offset + bit offset - see needs scan */
2802
	exp l = son(e);
2803
	exp r = bro(l);
2804
	int r1 = reg_operand(l, sp);
2805
	int tmp, d, r2;
2806
	space nsp;
2807
	ans aa;
2808
	tmp = getreg(sp.fixed);
2809
	rri_ins(i_sll, tmp, r1, 3);
2810
	d = regfrmdest(&dest, sp);
7 7u83 2811
	if (name(r) ==val_tag) {
2 7u83 2812
		rri_ins(i_addu, d, tmp, no(r));
2813
	}
2814
	else {
2815
		nsp = guardreg(tmp, sp);
2816
		r2 = reg_operand(r, nsp);
2817
		rrr_ins(i_addu, d, tmp, r2);
2818
	}
2819
	setregalt(aa, d);
2820
	mka.regmove = move(aa, dest, guardreg(d, sp), 0);
2821
	return mka;
2822
    }
2823
 
2824
   case offset_subtract_tag: { /* bit offset - byte offset - see needs scan */
2825
	exp l = son(e);
2826
	exp r = bro(l);
2827
	int r2 = reg_operand(r, sp);
2828
	int tmp, d, r1;
2829
	space nsp;
2830
	ans aa;
2831
	tmp = getreg(sp.fixed);
2832
	rri_ins(i_sll, tmp, r2, 3);
2833
	d = regfrmdest(&dest, sp);
2834
	nsp = guardreg(tmp, sp);
2835
	r1 = reg_operand(l, nsp);
2836
	rrr_ins(i_subu, d, r1, tmp);
2837
 
2838
	setregalt(aa, d);
2839
	mka.regmove = move(aa, dest, guardreg(d, sp), 0);
2840
	return mka;
2841
    }
2842
 
2843
 
2844
 
2845
    case plus_tag:
2846
      {
7 7u83 2847
        if (optop(e)) {
2 7u83 2848
          mka.regmove =
7 7u83 2849
            comm_op(e, sp, dest, i_addu);
2 7u83 2850
          return mka;
2851
        }
7 7u83 2852
       if ((errhandle(e) &3) ==3 && is_signed(sh(e)) && shape_size(sh(e)) ==32) {
2 7u83 2853
          mka.regmove =
7 7u83 2854
            comm_op(e, sp, dest, i_add);
2 7u83 2855
          return mka;
2856
        }
2857
        else {
2858
          /* possible overflow - can optimised a bit fot lit. operand*/
2859
          int r1 = reg_operand(son(e), sp);
2860
          int r2, r3, r0;
2861
          long over = new_label();
2862
          long trap = trap_label(e);
2863
          space nsp;
2864
          ans aa;
2865
          nsp = guardreg(r1, sp);
2866
          r2 = reg_operand(bro(son(e)), nsp);
2867
          nsp = guardreg(r2, nsp);
2868
          r0 = getreg(nsp.fixed);
2869
          nsp = guardreg(r0, nsp);
2870
          rrr_ins(i_addu, r0, r1, r2);
2871
 
7 7u83 2872
          switch (name(sh(e))) {
2 7u83 2873
             case slonghd: {
2874
             	r3 = getreg(nsp.fixed);
2875
          	rrr_ins(i_xor, r3, r1, r2);
2876
 
2877
          	condr_ins(i_bltz, r3, over);
2878
          	rrr_ins(i_xor, r3, r0, r1);
2879
          	condr_ins(i_bltz, r3, trap);
2880
 
2881
          	set_label(over);
2882
          	break;
2883
             }
2884
             case ulonghd: {
2885
             	r3 = getreg(nsp.fixed);
2886
          	mon_ins(i_not, r3, r1);
2887
          	rrr_ins(i_sltu, r3, r3, r2);
2888
          	condrr_ins(i_bne, r3, 0, trap);
2889
          	break;
2890
             }
2891
             case scharhd: {
2892
                testsigned(r0, -128, 127, trap);
2893
                break;
2894
             }
2895
             case ucharhd: {
2896
                testusigned(r0, 255, trap);
2897
                break;
2898
             }
2899
             case swordhd: {
2900
                testsigned(r0, -0x8000, 0x7fff, trap);
2901
                break;
2902
             }
2903
             case uwordhd: {
2904
                testusigned(r0, 0xffff, trap);
2905
                break;
2906
             }
2907
             default: failer("NOT integer in plus with o/f");
2908
          }
2909
          setregalt(aa, r0);
2910
          mka.regmove = move(aa, dest, nsp, 0);
2911
          return mka;
2912
      }
2913
    }				/* end plus */
2914
 
2915
 
2916
    case chvar_tag:
2917
      {
2918
	int   a;
2919
	int   d;
2920
	ans aa;
7 7u83 2921
	int   nsh = name(sh(e));
2 7u83 2922
	if (!BIGEND && dest.answhere.discrim == inreg
7 7u83 2923
		&& regalt(dest.answhere)!= 0) {
2 7u83 2924
	      ash arga;
7 7u83 2925
	      arga = ashof(sh(son(e)));
2 7u83 2926
	      if (arga.ashsize <= dest.ashwhere.ashsize) {
2927
		dest.ashwhere = arga;
2928
	      }
7 7u83 2929
	      a = regalt(dest.answhere);
2930
	      code_here(son(e), sp, dest);
2 7u83 2931
	      /* evaluate arguement into reg */
2932
	}
2933
	else {
7 7u83 2934
	      a = reg_operand(son(e), sp);
2 7u83 2935
	      /* evaluate arguement into a */
2936
	}
7 7u83 2937
	setregalt(aa, a);
2 7u83 2938
	if (!optop(e)) {
2939
		long trap = trap_label(e);
2940
		bool sg = is_signed(sh(son(e)));
7 7u83 2941
		switch (nsh) {
2 7u83 2942
		case scharhd:
2943
	           	if (sg) { testsigned(a, -128, 127, trap);}
2944
			else { testusigned(a, 127, trap); }
2945
			break;
2946
		case ucharhd: testusigned(a, 255, trap); break;
2947
		case swordhd:
7 7u83 2948
			if (sg) { testsigned(a, -0x8000, 0x7fff, trap); }
2 7u83 2949
			else { testusigned(a, 0x7fff, trap); }
2950
			break;
2951
		case uwordhd: testusigned(a, 0xffff, trap); break;
2952
		case slonghd:
2953
			if (!sg) { testusigned(a, 0x7fffffff, trap); }
2954
			break;
2955
		case ulonghd:
2956
			if (sg) { testusigned(a, 0x7fffffff, trap); }
2957
			break;
2958
		}
7 7u83 2959
		mka.regmove = move(aa, dest, sp, 1);
2 7u83 2960
		return mka;
2961
	}
2962
 
7 7u83 2963
	if (sh(son(e)) == sh(e) || nsh  >= slonghd) {
2 7u83 2964
	  /* no changes required, so just move */
7 7u83 2965
	  mka.regmove = move(aa, dest, sp, 1);
2 7u83 2966
	  return mka;
2967
	}
2968
 
2969
	switch (dest.answhere.discrim) {
2970
	  case insomereg:
2971
	    {
7 7u83 2972
	      int  *dr = someregalt(dest.answhere);
2973
	      d = getreg(sp.fixed);
2 7u83 2974
	      *dr = d;
2975
	      goto out;
2976
	    }
2977
	  case inreg:
2978
	    {
7 7u83 2979
	      d = regalt(dest.answhere);
2 7u83 2980
	      goto out;
2981
	    }
2982
	  default:
2983
	    /* representation in store will be same so just move */
2984
	    {
7 7u83 2985
	      move(aa, dest, sp, 1);
2 7u83 2986
	      return mka;
2987
	    }
2988
	}
2989
 
2990
    out: 			/* d is destination register - do
2991
				   appropriate ands etc */
2992
	if (d==0) return mka;
2993
 
2994
	if (nsh == ucharhd) {
7 7u83 2995
	  rri_ins(i_and, d, a, 255);
2 7u83 2996
	}
2997
	else
2998
	  if (nsh == uwordhd) {
7 7u83 2999
	    rri_ins(i_and, d, a,(1 << 16) - 1);
2 7u83 3000
	  }
3001
	  else
3002
	    if (nsh == scharhd) {
7 7u83 3003
	      rri_ins(i_sll, d, a, 24);
3004
	      rri_ins(i_sra, d, d, 24);
2 7u83 3005
	    }
3006
	    else
3007
	      if (nsh == swordhd) {
7 7u83 3008
		rri_ins(i_sll, d, a, 16);
3009
		rri_ins(i_sra, d, d, 16);
2 7u83 3010
	      }
3011
	mka.regmove = d;
3012
	return mka;
3013
      }				/* end chvar */
3014
 
3015
    case minus_tag:
3016
      {
3017
        if (optop(e)) {
3018
          mka.regmove =
7 7u83 3019
            non_comm_op(e, sp, dest, i_subu);
2 7u83 3020
          return mka;
3021
        }
3022
        else
7 7u83 3023
	if ((errhandle(e) &3) ==3 && is_signed(sh(e)) && shape_size(sh(e)) ==32) {
2 7u83 3024
          mka.regmove =
7 7u83 3025
            non_comm_op(e, sp, dest, i_sub);
2 7u83 3026
          return mka;
3027
        }
3028
        else {
3029
          /* possible overflow - can optimised a bit for lit. operand*/
3030
          int r1 = reg_operand(son(e), sp);
3031
          int r2, r3, r0;
3032
          long over = new_label();
3033
          long trap = trap_label(e);
3034
          space nsp;
3035
          ans aa;
3036
          nsp = guardreg(r1, sp);
3037
          r2 = reg_operand(bro(son(e)), nsp);
3038
          nsp = guardreg(r2, nsp);
3039
          r0 = getreg(nsp.fixed);
3040
          nsp = guardreg(r0,nsp);
3041
          rrr_ins(i_subu, r0, r1, r2);
7 7u83 3042
          switch (name(sh(e))) {
2 7u83 3043
             case slonghd: {
3044
             	r3 = getreg(nsp.fixed);
3045
             	rrr_ins(i_xor, r3, r1, r2);
3046
 
3047
             	condr_ins(i_bgez, r3, over);
3048
             	rrr_ins(i_xor, r3, r0, r1);
3049
             	condr_ins(i_bltz, r3, trap);
3050
 
3051
             	set_label(over);
3052
/* Alteration 2 also in plus_tag */
3053
             	break;
3054
             }
3055
             case ulonghd: {
3056
             	r3 = getreg(nsp.fixed);
3057
/* Alteration 3 */
3058
             	rrr_ins(i_sltu, r3, r1, r2);
3059
             	condrr_ins(i_bne, r3, 0, trap);
3060
             	break;
3061
             }
3062
             case scharhd: {
3063
                testsigned(r0, -128, 127, trap);
3064
                break;
3065
             }
3066
             case ucharhd: {
3067
                testusigned(r0, 255, trap);
3068
                break;
3069
             }
3070
             case swordhd: {
3071
                testsigned(r0, -0x8000, 0x7fff, trap);
3072
                break;
3073
             }
3074
             case uwordhd: {
3075
                testusigned(r0, 0xffff, trap);
3076
                break;
3077
             }
3078
             default: failer("NOT integer in minus with o/f");
3079
          }
3080
          setregalt(aa, r0);
3081
          mka.regmove = move(aa, dest, nsp, 0);
3082
          return mka;
3083
      }
3084
 
3085
    }				/* end minus */
3086
 
3087
    case mult_tag: case offset_mult_tag:
3088
      {
7 7u83 3089
	exp rop = bro(son(e));
2 7u83 3090
	if (!optop(e)) {	/* test for overflo */
3091
          int r1 = reg_operand(son(e), sp);
3092
          int r2, r3, r0;
3093
          long trap = trap_label(e);
3094
          space nsp;
3095
          ans aa;
3096
          nsp = guardreg(r1, sp);
3097
          r2 = reg_operand(bro(son(e)), nsp);
3098
          nsp = guardreg(r2, nsp);
3099
          r0 = getreg(nsp.fixed);
3100
          nsp = guardreg(r0, nsp);
3101
          r3 = getreg(nsp.fixed);
7 7u83 3102
          switch (name(sh(e))) {
2 7u83 3103
             case slonghd: {
3104
                int r4;
3105
		mon_ins(i_mult, r1, r2);
3106
		hilo_ins(i_mflo, r0);
3107
		hilo_ins(i_mfhi, r3);
3108
		r4 = getreg(guardreg(r3, nsp).fixed);
3109
		rri_ins(i_sra, r4, r0, 31);
3110
		condrr_ins(i_bne, r4, r3, trap);
3111
		break;
3112
	     }
3113
	     case ulonghd: {
3114
	     	mon_ins(i_multu, r1, r2);
3115
	     	hilo_ins(i_mflo, r0);
3116
	     	hilo_ins(i_mfhi, r3);
3117
	     	condrr_ins(i_bne, r3, 0, trap);
3118
	     	break;
3119
	     }
3120
             case scharhd: {
3121
             	rrr_ins(i_mul, r0, r1, r2);
3122
                testsigned(r0, -128, 127, trap);
3123
                break;
3124
             }
3125
             case ucharhd: {
3126
                rrr_ins(i_mul, r0, r1, r2);
3127
                testusigned(r0, 255, trap);
3128
                break;
3129
             }
3130
             case swordhd: {
3131
                rrr_ins(i_mul, r0, r1, r2);
3132
                testsigned(r0, -0x8000, 0x7fff, trap);
3133
                break;
3134
             }
3135
             case uwordhd: {
3136
             	rrr_ins(i_mul, r0, r1, r2);
3137
                testusigned(r0, 0xffff, trap);
3138
                break;
3139
             }
3140
             default: failer("NOT integer in mult with o/f");
3141
          }
3142
          setregalt(aa, r0);
3143
          mka.regmove = move(aa, dest, nsp, 0);
3144
          return mka;
3145
      }
3146
 
3147
 
3148
 
7 7u83 3149
	if (last(rop) && name(rop) == val_tag) {
2 7u83 3150
	  /* multiplication by constant m */
7 7u83 3151
	  int   m = no(rop);
2 7u83 3152
	  int   p2;
3153
	  if (m > 1 && (
3154
		((p2 = m) & (m - 1)) == 0 ||
3155
		(m & (p2 = m + 1)) == 0 ||
3156
		((p2 = m - 1) & (m - 2)) == 0
7 7u83 3157
	     )
2 7u83 3158
	    ) {			/* m = 2^shleng   or  m = 2^(shleng +/- 1)
3159
				*/
7 7u83 3160
	    int   r = reg_operand(son(e), sp);
2 7u83 3161
	    /* evaluate first arguement */
3162
	    int   rr;
3163
	    space nsp;
3164
	    int   shleng;
3165
	    ans aa;
3166
	    for (shleng = 0; p2 != 1; shleng++)
3167
	      p2 >>= 1;
3168
 
3169
	    switch (dest.answhere.discrim) {
3170
	      case inreg:
3171
		{
7 7u83 3172
		  rr = regalt(dest.answhere);
2 7u83 3173
		  if (rr != r || (m & (m - 1)) == 0) {
3174
		    nsp = sp;
3175
		    break;
3176
		  }
3177
		  /* else continue to next case */
3178
		}
3179
	      default:
3180
		{
7 7u83 3181
		 	if ((m & (m-1)) ==0) {
2 7u83 3182
				rr = getreg(sp.fixed);
3183
				nsp = sp;
3184
			}
3185
			else {
7 7u83 3186
				nsp = guardreg(r, sp);
3187
		  		rr = getreg(nsp.fixed);
2 7u83 3188
			}
3189
		}
3190
	    }
3191
 
7 7u83 3192
	    rri_ins(i_sll, rr, r, shleng);
2 7u83 3193
 
7 7u83 3194
	    if ((m & (m - 1))!= 0)
3195
	      rrr_ins(((m & (m + 1)) == 0)? i_subu : i_addu, rr, rr, r);
3196
	    setregalt(aa, rr);
3197
	    mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
2 7u83 3198
	    return mka;
3199
	  }
3200
	}			/* else do straightforward mult */
3201
 
7 7u83 3202
	mka.regmove = comm_op(e, sp, dest, i_mul);
2 7u83 3203
	return mka;
3204
      }				/* end mult */
3205
 
3206
 
3207
 
3208
    case div0_tag:case div2_tag: case offset_div_by_int_tag: case offset_div_tag:
3209
      {
7 7u83 3210
	exp rop = bro(son(e));
2 7u83 3211
	exp lop = son(e);
7 7u83 3212
	bool uns = !(is_signed(sh(e)));
2 7u83 3213
	int trap;
3214
	space nsp;
3215
	int r0, r1, r2;
3216
	ans aa;
7 7u83 3217
	if (name(rop) == val_tag) {
2 7u83 3218
	  /* division by constant */
7 7u83 3219
	  int   m = no(rop);
2 7u83 3220
	  if (m==1) {
3221
		e = lop;
3222
		goto tailrecurse;
3223
	  }
3224
	  if ((name(e) == div0_tag || uns) && m > 1 && (m & (m - 1)) == 0) {
7 7u83 3225
	      int   r = reg_operand(son(e), sp);
2 7u83 3226
	       /* replace div by 2^shleng by sh right shleng */
3227
              int   shleng;
3228
              int   rr;
3229
              for (shleng = 0; m != 1; shleng++)
3230
                m >>= 1;
3231
 
3232
              rr = regfrmdest(&dest, sp);
7 7u83 3233
              rri_ins((uns)?i_srl:i_sra, rr, r, shleng);
3234
              setregalt(aa, rr);
3235
              mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
2 7u83 3236
              return mka;
3237
          }
3238
	}
3239
 
3240
	r1 = reg_operand(lop, sp);
3241
	nsp = guardreg(r1, sp);
3242
	r2 = reg_operand(rop, nsp);
3243
 
3244
	if (!optop(e)|| (errhandle(e)&3)==2) { /* test for (-inf)/-1 and /0 */
3245
	   long over = new_label();
7 7u83 3246
           trap = ((errhandle(e) &3) ==2)?new_label():trap_label(e);
2 7u83 3247
	   condri_ins(i_beq, r2, 0, trap);
3248
	   if (!uns) {
3249
             condri_ins(i_bne, r2, -1, over);
3250
             condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
3251
             set_label(over);
3252
           }
3253
	}
3254
	r0 = regfrmdest(&dest,sp);
3255
	rrr_ins((uns)?i_divu:i_div, r0, r1, r2);
7 7u83 3256
	if ((errhandle(e) &3) ==2)set_label(trap);
2 7u83 3257
	setregalt(aa, r0);
3258
	mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
3259
	return mka;
3260
      }
3261
 
3262
      case div1_tag:
3263
 
3264
      {  /* only applies to signed operands */
7 7u83 3265
	exp rop = bro(son(e));
2 7u83 3266
	exp lop = son(e);
3267
	space nsp;
3268
	int r0, r1, r2;
3269
	int lab, treg, trap;
3270
	ans aa;
3271
 
3272
	if (name (rop) == val_tag ) {/*  division by constant */
7 7u83 3273
	  int   m = no(rop);
2 7u83 3274
	  if (m > 1 && (m & (m - 1)) == 0) {
7 7u83 3275
	      int   r = reg_operand(son(e), sp);
2 7u83 3276
	       /* replace div by 2^shleng by arith sh right shleng */
3277
              int   shleng;
3278
              int   rr;
3279
              for (shleng = 0; m != 1; shleng++)
3280
                m >>= 1;
3281
 
3282
              rr = regfrmdest(&dest, sp);
7 7u83 3283
              rri_ins(i_sra, rr, r, shleng);
3284
              setregalt(aa, rr);
3285
              mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
2 7u83 3286
              return mka;
3287
          }
3288
	}
3289
 
3290
	r1 = reg_operand(lop, sp);
3291
	nsp = guardreg(r1, sp);
3292
	r2 = reg_operand(rop, nsp);
3293
	nsp = guardreg(r2, sp);
3294
 
3295
 
3296
	if (!optop(e)|| (errhandle(e)&3)==2) { /* test for (-inf)/-1 and /0 */
3297
	   long over = new_label();
7 7u83 3298
           trap = ((errhandle(e) &3) ==2)?new_label():trap_label(e);
2 7u83 3299
	   condri_ins(i_beq, r2, 0, trap);
3300
           condri_ins(i_bne, r2, -1, over);
3301
           condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
3302
           set_label(over);
3303
	}
3304
	r0 = regfrmdest(&dest,nsp);
3305
        rrr_ins((is_signed(sh(e)))?i_div:i_divu, r0, r1, r2);
3306
	treg = getreg(guardreg(r0,nsp).fixed);
3307
	lab = new_label();
3308
	hilo_ins(i_mfhi, treg);
3309
	condri_ins(i_beq, treg, 0, lab);
3310
	rrr_ins(i_xor, treg, treg, r2);
3311
	rri_ins(i_sra, treg, treg, 31);
3312
	rrr_ins(i_addu, r0, r0, treg);
3313
	set_label(lab);
7 7u83 3314
	if ((errhandle(e) &3) ==2)set_label(trap);
2 7u83 3315
	setregalt(aa, r0);
3316
	mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
3317
	return mka;
3318
    }
3319
 
3320
 
3321
    case abs_tag: {
3322
	int r = reg_operand(son(e), sp);
3323
	int d = regfrmdest(&dest, guardreg(r, sp));
3324
	int l = new_label();
3325
	ans aa;
3326
	setnoreorder();
3327
	condri_ins(i_bge,r, 0, l);
3328
	rri_ins(i_addu, d, r, 0);
3329
	rrr_ins(i_subu, d, 0, r);
3330
	setreorder();
3331
	if (!optop(e)) {
7 7u83 3332
		condri_ins(i_ble, r, maxmin(sh(e)).mini, trap_label(e));
2 7u83 3333
	}
3334
        set_label_no_clear(l);
3335
	setregalt(aa, d);
3336
	mka.regmove = move(aa, dest, guardreg(d, sp), 0);
3337
	return mka;
3338
    }
3339
    case neg_tag: case offset_negate_tag:
3340
      {
7 7u83 3341
	if (optop(e)) {
3342
          mka.regmove = monop(e, sp, dest, i_negu);
2 7u83 3343
          return mka;
3344
        }
7 7u83 3345
        if ((errhandle(e) &3) ==3 && shape_size(sh(e)) == 32) {
3346
          mka.regmove = monop(e, sp, dest, i_neg);
2 7u83 3347
          return mka;
3348
        }
3349
        else {
3350
          int r1 = reg_operand(son(e), sp);
3351
          long trap = trap_label(e);
3352
          int r2;
3353
          ans aa;
3354
          condri_ins((is_signed(sh(e)))?i_ble:i_bne, r1, maxmin(sh(e)).mini, trap);
3355
          r2 = getreg(sp.fixed);
3356
          mon_ins(i_neg, r2, r1);
3357
	  if (is_signed(sh(e)))condri_ins(i_ble, r2, maxmin(sh(e)).mini, trap);
3358
	  setregalt(aa, r2);
3359
	  mka.regmove = move(aa, dest, guardreg(r2, sp), 0);
3360
	  return mka;
3361
	}
3362
 
3363
 
3364
      }				/* end neg */
3365
 
3366
 
3367
 
3368
    case goto_lv_tag: {
3369
    	int r = reg_operand(son(e),sp);
3370
    	uncond_ins(i_j, r);
3371
    	clear_all();
3372
    	return mka;
3373
    }
3374
 
3375
 
3376
 
3377
    case shl_tag:
3378
    case shr_tag:
3379
      {
7 7u83 3380
	exp s = son(e);
3381
	exp b = bro(s);
2 7u83 3382
	int   a;
3383
	int   d;
3384
	int sz = shape_size(sh(s));
7 7u83 3385
        bool lded = ((name(s) == name_tag && regofval(s) >= 100)
3386
	      		|| (name(s) == cont_tag &&
3387
		   (name(son(s))!= name_tag || regofval(son(s)) > 0)
3388
	      		   )
3389
		   );
3390
        bool signok = (sz == 32 || name(s) == chvar_tag || lded);
2 7u83 3391
	ans aa;
3392
	space nsp;
7 7u83 3393
	bool sgned = is_signed(sh(e));
2 7u83 3394
	char *shnat;
3395
	char *shun;
3396
	int norms = 0;
7 7u83 3397
	if (lded && name(b) == val_tag && (no(b) == 16 || no(b) == 24)
3398
	    && name(e) == shr_tag ) {
2 7u83 3399
		/* can use short loads instead of shifts */
3400
	  where w;
3401
	  instore is;
7 7u83 3402
	  w = locate(s, sp, sh(s), 0);
2 7u83 3403
	  /* 'address' of  first operand with shape of result */
3404
 
3405
	  switch (w.answhere.discrim) {
3406
	      /* if w is a register we still have to do shifts */
3407
	    case inreg: {
7 7u83 3408
		a = regalt(w.answhere);
2 7u83 3409
		goto alreadythere;
3410
	      }
3411
	    case notinreg:
3412
	      {
7 7u83 3413
		is = insalt(w.answhere);
2 7u83 3414
		if (!is.adval)
3415
		  break;
3416
		if (is.b.offset == 0 && (a = is.b.base) >= 0 && a <= 31) {
3417
		  goto alreadythere;
3418
		}
3419
	      }
3420
	    default: {	/* this shoudn't happen - shift of address or
3421
	    		    perhaps float in reg */
3422
	    	where temp;
3423
		a = -1;
3424
		setsomeregalt(temp.answhere, &a);
3425
		temp.ashwhere = dest.ashwhere;
3426
		move(w.answhere, temp, sp, 1);
3427
		goto alreadythere;
3428
	      }
3429
	  }
3430
 
3431
	  d = regfrmdest(&dest,sp);
3432
 
3433
	  /* d is destination register */
3434
	  if (!BIGEND) {
7 7u83 3435
            if (no(b) == 16) {
2 7u83 3436
              is.b.offset += 2;
3437
            }
3438
            else {
3439
              is.b.offset += 3;
3440
            }
3441
          }
7 7u83 3442
	  ls_ins((no(b) == 16)?((sgned)? i_lh : i_lhu):((sgned)? i_lb : i_lbu),
2 7u83 3443
	      d, is.b);
7 7u83 3444
	  setregalt(aa, d);
3445
	  move(aa, dest, guardreg(d, sp), 0);
2 7u83 3446
	  mka.regmove = d;
3447
	  return mka;
3448
 
3449
	}
3450
 
7 7u83 3451
	a = reg_operand(s, sp);
2 7u83 3452
    alreadythere:
3453
	/* choose which shift instruction */
7 7u83 3454
	if (name(e) == shr_tag) {
3455
	  shnat = (sgned)? i_sra : i_srl;
2 7u83 3456
	  shun = i_sll;
3457
	  if (!signok) {
3458
		rri_ins(i_sll, a, a, norms = 32-sz);
3459
	  }
3460
	}
3461
	else {
3462
	  shnat = i_sll;
7 7u83 3463
	  shun = (sgned)? i_sra : i_srl;
2 7u83 3464
	}
3465
 
3466
 
7 7u83 3467
	nsp = guardreg(a, sp);
2 7u83 3468
	d = regfrmdest(&dest, nsp);
3469
 
3470
 
7 7u83 3471
	if (name(b) == val_tag) {
2 7u83 3472
	  /* if its a constant shift we dont have to choose shift
3473
	     dynamically ... */
7 7u83 3474
	  if (no(b) >= 0) {
3475
	    rri_ins(shnat, d, a, no(b) +norms);
2 7u83 3476
	  }
3477
	  else {
7 7u83 3478
	    rri_ins(shun, d, a, -no(b));
2 7u83 3479
	  }
3480
	}
3481
	else {
7 7u83 3482
	  int   sr = getreg(nsp.fixed);
3483
	  int   ar = reg_operand(b, nsp);
2 7u83 3484
	  if (norms != 0) {
3485
		rri_ins(shnat, a, a, norms);
3486
	  }
3487
	  if (NONEGSHIFTS || !is_signed(sh(e))
7 7u83 3488
	      || (name(b) == and_tag && name(bro(son(b))) == val_tag
3489
		&& no(bro(son(b))) > 0 && no(bro(son(b))) <= 31)
2 7u83 3490
	    ) {			/* ... similarly in these cases */
7 7u83 3491
	    rrr_ins(shnat, d, a, ar);
2 7u83 3492
	  }
3493
	  else {		/* choose shift dynamically - is this
3494
				   necessary for C? */
7 7u83 3495
	    int   l = new_label();
3496
	    int   endl = new_label();
3497
	    condri_ins(i_bge, ar, 0, l);
3498
	    mon_ins(i_neg, sr, ar);
3499
	    rrr_ins(shun, d, a, sr);
3500
	    uncond_ins(i_b, endl);
3501
	    set_label(l);
3502
	    rrr_ins(shnat, d, a, ar);
3503
	    set_label(endl);
2 7u83 3504
	  }
3505
	}
7 7u83 3506
	setregalt(aa, d);
3507
	move(aa, dest, nsp, 1);
2 7u83 3508
	mka.regmove = d;
3509
	return mka;
3510
      }				/* end shl */
3511
 
3512
 
3513
 
3514
    case mod_tag:
3515
      {  /* only applies to signed operands */
7 7u83 3516
	exp rop = bro(son(e));
2 7u83 3517
	exp lop = son(e);
3518
	space nsp;
3519
	int r0, r1, r2;
3520
	int lab, treg;
3521
	ans aa;
3522
	if (name (rop) == val_tag) {/* mod by constant */
7 7u83 3523
	  int   m = no(rop);
2 7u83 3524
	  if (m > 1 && (m & (m - 1)) == 0) {
3525
	    /* mod by power of 2 replaced by and */
7 7u83 3526
	    int   r = reg_operand(son(e), sp);
2 7u83 3527
	    ans aa;
3528
	    int   rr = regfrmdest(&dest,sp);
7 7u83 3529
	    rri_ins(i_and, rr, r, no(rop) - 1);
3530
	    setregalt(aa, rr);
3531
	    mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
2 7u83 3532
	    return mka;
3533
	  }
3534
	}
3535
 
3536
	r1 = reg_operand(lop, sp);
3537
	nsp = guardreg(r1, sp);
3538
	r2 = reg_operand(rop, nsp);
3539
 
3540
	if (!optop(e)) { /* test for (-inf)/-1 and /0 */
3541
	   long over = new_label();
3542
           long trap = trap_label(e);
3543
	   condri_ins(i_beq, r2, 0, trap);
3544
           condri_ins(i_bne, r2, -1, over);
3545
           condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
3546
           set_label(over);
3547
	}
3548
	r0 = regfrmdest(&dest, nsp);
3549
	rrr_ins(i_rem, r0, r1, r2);
3550
	treg= getreg(guardreg(r0, nsp).fixed);
3551
	lab = new_label();
3552
	condri_ins(i_beq, r0, 0, lab);
3553
	rrr_ins(i_xor, treg, r0, r2);
3554
	condri_ins(i_bge, treg, 0, lab);
3555
	rrr_ins(i_addu, r0, r0, r2);
3556
	set_label(lab);
3557
	setregalt(aa, r0);
3558
	mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
3559
	return mka;
3560
    }
3561
 
3562
    case rem2_tag: case rem0_tag:
3563
      {
7 7u83 3564
	exp rop = bro(son(e));
2 7u83 3565
	exp lop = son(e);
7 7u83 3566
	bool uns = !is_signed(sh(e));
2 7u83 3567
	space nsp;
3568
	int r0, r1, r2;
3569
	ans aa;
7 7u83 3570
	if ((uns || name(e) ==rem0_tag) && name(rop) == val_tag) {
2 7u83 3571
		/* mod by constant */
7 7u83 3572
	  int   m = no(rop);
2 7u83 3573
	  if (m > 1 && (m & (m - 1)) == 0) {
3574
	    /* mod by power of 2 replaced by and */
7 7u83 3575
	    int   r = reg_operand(son(e), sp);
2 7u83 3576
	    ans aa;
3577
	    int   rr = regfrmdest(&dest,sp);
7 7u83 3578
	    rri_ins(i_and, rr, r, no(rop) - 1);
3579
	    setregalt(aa, rr);
3580
	    mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
2 7u83 3581
	    return mka;
3582
	  }
7 7u83 3583
	  if (m != 0 && (m!=-1 || uns)) {
2 7u83 3584
	  	r1 = reg_operand(lop, sp);
3585
	  	r0 = regfrmdest(&dest, sp);
3586
		rri_ins((uns)?i_remu:i_rem, r0, r1, m);
3587
		setregalt(aa, r0);
3588
		mka.regmove = move(aa, dest, guardreg(r0,nsp), 0);
3589
		return mka;
3590
	  }
3591
	}
3592
 
3593
	r1 = reg_operand(lop, sp);
3594
	nsp = guardreg(r1, sp);
3595
	r2 = reg_operand(rop, nsp);
3596
 
3597
	if (!optop(e)) { /* test for (-inf)/-1 and /0 */
3598
	   long over = new_label();
3599
           long trap = trap_label(e);
3600
	   condri_ins(i_beq, r2, 0, trap);
3601
	   if (!uns) {
3602
             condri_ins(i_bne, r2, -1, over);
3603
             condri_ins(i_beq, r1, maxmin(sh(e)).mini, trap);
3604
             set_label(over);
3605
           }
3606
	}
3607
 
3608
	r0 = regfrmdest(&dest, sp);
3609
	rrr_ins((uns)?i_remu:i_rem, r0, r1, r2);
3610
	setregalt(aa, r0);
3611
	mka.regmove = move(aa, dest, guardreg(r0,nsp), 0);
3612
	return mka;
3613
 
3614
      }				/* end mod */
3615
 
3616
 
3617
    case minptr_tag: case make_stack_limit_tag:
3618
      {
7 7u83 3619
	mka.regmove = non_comm_op(e, sp, dest, i_subu);
2 7u83 3620
	return mka;
3621
      }
3622
 
3623
    case fplus_tag:
3624
      {
3625
	mka.regmove =
7 7u83 3626
	  fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_add_d : i_add_s);
3627
	if (!optop(e))checknan(e, sp);
2 7u83 3628
	return mka;
3629
      }
3630
 
3631
    case fminus_tag:
3632
      {
3633
	mka.regmove =
7 7u83 3634
	  fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_sub_d : i_sub_s);
3635
	if (!optop(e))checknan(e, sp);
2 7u83 3636
	return mka;
3637
      }
3638
 
3639
    case fmult_tag:
3640
      {
3641
	mka.regmove =
7 7u83 3642
	  fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_mul_d : i_mul_s);
3643
	if (!optop(e))checknan(e, sp);
2 7u83 3644
	return mka;
3645
      }
3646
 
3647
    case fdiv_tag:
3648
      {
3649
	mka.regmove =
7 7u83 3650
	  fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_div_d : i_div_s);
3651
	if (!optop(e))checknan(e, sp);
2 7u83 3652
	return mka;
3653
      }
3654
 
3655
    case fneg_tag:
3656
      {
3657
	mka.regmove =
7 7u83 3658
	  fmop(e, sp, dest,(name(sh(e))!= shrealhd)? i_neg_d : i_neg_s);
3659
	if (!optop(e))checknan(e, sp);
2 7u83 3660
	return mka;
3661
      }
3662
 
3663
    case fabs_tag:
3664
      {
3665
	mka.regmove =
7 7u83 3666
	  fmop(e, sp, dest,(name(sh(e))!= shrealhd)? i_abs_d : i_abs_s);
3667
	if (!optop(e))checknan(e, sp);
2 7u83 3668
	return mka;
3669
      }
3670
 
3671
    case float_tag:
3672
      {
7 7u83 3673
	exp in = son(e);
2 7u83 3674
	where w;
3675
	int r;
3676
	int   f
7 7u83 3677
	=    (dest.answhere.discrim == infreg)? regalt(dest.answhere)
2 7u83 3678
				/* cheat */
7 7u83 3679
	:     getfreg(sp.flt);
2 7u83 3680
	freg frg;
3681
	ans aa;
3682
	ash ain;
7 7u83 3683
	ain = ashof(sh(in));
2 7u83 3684
	frg.fr = f;
3685
	frg.dble = 0;
7 7u83 3686
	if (ain.ashsize == 32 && name(sh(in))!= ulonghd) {
3687
	  setfregalt(w.answhere, frg);
3688
	  w.ashwhere = ashof(sh(in));
3689
	  code_here(in, sp, w);
2 7u83 3690
	  /* evaluate fix pt arguement into float pt reg f */
3691
	}
3692
	else {			/* bytes and halfs must go through fixpt
3693
				   regs */
7 7u83 3694
	  r = reg_operand(in, sp);
3695
	  cop_ins(i_mtc1, r, f << 1);
2 7u83 3696
	}
3697
 
7 7u83 3698
	rrfp_ins((name(sh(e))!= shrealhd)? i_cvt_d_w : i_cvt_s_w,
2 7u83 3699
	    f << 1, f << 1);
7 7u83 3700
	if (name(sh(e))!= shrealhd) {
2 7u83 3701
	  frg.dble = 1;
3702
	}
3703
 
7 7u83 3704
	if (name(sh(in)) ==ulonghd) {
2 7u83 3705
	     int tmp = getreg(sp.fixed);
3706
	     int constf = getfreg(guardfreg(f,sp).flt);
3707
	     rri_ins(i_and, tmp,r, 0x80000000);
7 7u83 3708
	     cop_ins(i_mtc1, tmp, constf << 1);
3709
	     rrfp_ins((frg.dble)? i_cvt_d_w : i_cvt_s_w,
2 7u83 3710
	     		constf << 1, constf << 1);
7 7u83 3711
	     rrrfp_ins((frg.dble)? i_sub_d: i_sub_s, f<<1, f<<1, constf<<1);
3712
	     rrrfp_ins((frg.dble)? i_sub_d: i_sub_s, f<<1, f<<1, constf<<1);
2 7u83 3713
	}
7 7u83 3714
	setfregalt(aa, frg);
3715
	move(aa, dest, sp, 1);
3716
	mka.regmove = (frg.dble)? - (f + 32):(f + 32);
2 7u83 3717
	return mka;
3718
      }
3719
    case chfl_tag:
3720
      {
7 7u83 3721
	int   to = name(sh(e));
3722
	int   from = name(sh(son(e)));
3723
	bool dto = (to != shrealhd)? 1 : 0;
3724
	bool dfrom = (from != shrealhd)? 1 : 0;
2 7u83 3725
	if (dto == dfrom) {	/* no change in representation */
7 7u83 3726
	  return make_code(son(e), sp, dest, exitlab);
2 7u83 3727
	}
3728
	else {
3729
	  freg frg;
3730
	  ans aa;
3731
	  where w;
3732
	  if (dest.answhere.discrim == infreg) {
7 7u83 3733
	    frg = fregalt(dest.answhere);
2 7u83 3734
	  }
3735
	  else {
7 7u83 3736
	    frg.fr = getfreg(sp.flt);
2 7u83 3737
	  }
3738
	  frg.dble = dfrom;
7 7u83 3739
	  setfregalt(aa, frg);
2 7u83 3740
	  w.answhere = aa;
7 7u83 3741
	  w.ashwhere = ashof(sh(son(e)));
3742
	  code_here(son(e), sp, w);
3743
	  if (!optop(e) && !dto)setnoreorder();
3744
	  rrfp_ins((dfrom)? i_cvt_s_d : i_cvt_d_s, frg.fr << 1, frg.fr << 1);
2 7u83 3745
	  frg.dble = dto;
7 7u83 3746
	  setfregalt(aa, frg);
3747
	  move(aa, dest, sp, 1);
3748
	  mka.regmove = (frg.dble)? - (frg.fr + 32):(frg.fr + 32);
2 7u83 3749
	  if (!optop(e) && !dto) {
3750
		setreorder();
3751
		checknan(e, sp);
3752
	  }
3753
	  return mka;
3754
	}
3755
      }
3756
 
3757
    case and_tag:
3758
      {
7 7u83 3759
	exp r = son(e);
3760
	exp l = bro(son(e));
2 7u83 3761
	ans aa;
3762
	space nsp;
3763
	where d1;
7 7u83 3764
	if (last(l) && name(l) == val_tag && (no(l) == 255 || no(l) == 0xffff)
3765
	    && ((name(r) == name_tag && regofval(r) == 100)
3766
	      || (name(r) == cont_tag &&
3767
		(name(son(r))!= name_tag
3768
		  || regofval(son(r)) > 0
2 7u83 3769
		)
7 7u83 3770
	     )
3771
	   )
3772
	    && (aa = iskept(r), (aa.discrim == inreg && regalt(aa) == 0))
2 7u83 3773
	  ) {			/* can use load short instructions */
3774
	  where w;
3775
	  int   dsize = dest.ashwhere.ashsize;
7 7u83 3776
	  int   asize = (no(l) == 255)? 8 : 16;
3777
	  w = locate(r, sp, sh(r), 0);
2 7u83 3778
	  if (w.answhere.discrim == notinreg
7 7u83 3779
	      && dest.answhere.discrim == notinreg && no(l) == 0xffff) {
2 7u83 3780
	    instore isw;
3781
	    instore isd;
7 7u83 3782
	    isw = insalt(w.answhere);
3783
	    isd = insalt(dest.answhere);
2 7u83 3784
	    if (!isw.adval && isd.adval && isw.b.base == isd.b.base &&
3785
		isd.b.offset == isw.b.offset) {
3786
	      if (dsize > 16) {
7 7u83 3787
		if (!BIGEND)isd.b.offset += 2;
2 7u83 3788
		/* just clear out top bits */
7 7u83 3789
		ls_ins(i_sh, 0, isd.b);
2 7u83 3790
	      }
3791
	      return mka;
3792
	    }			/* else drop through to load short case */
3793
	  }
3794
	  if (!BIGEND) {
3795
	  	nsp = guard(w,sp);
3796
	  	setregalt(aa,getreg(nsp.fixed));
3797
	  	d1.answhere = aa;
3798
	  	d1.ashwhere.ashsize = d1.ashwhere.ashalign = asize;
3799
	  	move(w.answhere, d1, nsp, 0);
3800
	  	mka.regmove
3801
	   	 = move (aa, dest, guard(d1,nsp), 0 /* unsigned */ );
3802
 
3803
            	return mka;
3804
	  }
3805
	}
7 7u83 3806
	mka.regmove = comm_op(e, sp, dest, i_and);
2 7u83 3807
	return mka;
3808
      }
3809
    case or_tag:
3810
      {
7 7u83 3811
	mka.regmove = comm_op(e, sp, dest, i_or);
2 7u83 3812
	return mka;
3813
      }
3814
 
3815
    case xor_tag:
3816
      {
7 7u83 3817
	mka.regmove = comm_op(e, sp, dest, i_xor);
2 7u83 3818
	return mka;
3819
      }
3820
 
3821
    case not_tag:
3822
      {
3823
	if (name(son(e)) == or_tag) {
3824
		mka.regmove = comm_op(son(e), sp, dest, i_nor);
3825
	}
3826
	else {
7 7u83 3827
		mka.regmove = monop(e, sp, dest, i_not);
2 7u83 3828
	}
3829
	return mka;
3830
      }
3831
 
3832
 
3833
    case offset_pad_tag: {
3834
	int r, v;
3835
	ans aa;
3836
        if (al2(sh(son(e))) >= al2(sh(e))) {
7 7u83 3837
	    if (al2(sh(e))!= 1 || al2(sh(son(e))) == 1) {
2 7u83 3838
		/* is already aligned correctly, whether as bit or byte-offset*/
3839
		e = son(e); goto tailrecurse;
3840
	    }
3841
  	    r = regfrmdest(&dest, sp);
3842
	    v = reg_operand(son(e), sp);
3843
	    rri_ins(i_sll, r, v, 3);
3844
	}
3845
	else {
7 7u83 3846
		int al = (al2(sh(son(e))) ==1)?al2(sh(e)):(al2(sh(e)) /8);
2 7u83 3847
		r = regfrmdest(&dest, sp);
3848
		v = reg_operand(son(e), sp);
3849
		rri_ins(i_addu, r, v, al-1);
3850
		rri_ins(i_and, r, r, -al);
3851
		if (al2(sh(son(e)))==1) { /* operand is bit-offset,
3852
						byte-offset required */
3853
			rri_ins(i_sra, r, r, 3);
3854
		}
3855
	}
3856
	setregalt(aa,r);
3857
	mka.regmove = move(aa, dest, guardreg(r,sp), 0);
3858
        return mka;
3859
    }
3860
 
3861
   case locptr_tag: {
3862
    	int pr = reg_operand(son(e), sp);
3863
    	int ansr = regfrmdest(&dest, sp);
3864
    	baseoff b;
3865
    	ans aa;
3866
    	b.base = pr; b.offset = -12;
3867
    	ls_ins(i_lw, ansr, b);
3868
    	setregalt(aa,ansr);
3869
    	mka.regmove = move(aa, dest, guardreg(ansr,sp), 0);
3870
    	return mka;
3871
    }
3872
 
3873
    case cont_tag:
3874
    case name_tag:
3875
    case field_tag:
3876
    case reff_tag:
3877
    case addptr_tag:
3878
    case subptr_tag:
3879
    case contvol_tag:
3880
      {
3881
	where w;
3882
	bool sgned;
3883
	ash desper;
3884
 
7 7u83 3885
	int   dr = (dest.answhere.discrim == inreg)? dest.answhere.val.regans : 0;
3886
	desper = ashof(sh(e));
2 7u83 3887
 
7 7u83 3888
	if (name(e) == contvol_tag) {
3889
	  clear_all();
3890
	  setvolatile();
2 7u83 3891
	}
7 7u83 3892
	w = locate(e, sp, sh(e), dr);
2 7u83 3893
	/* 'address of arguement */
7 7u83 3894
	sgned = ((w.ashwhere.ashsize >= 32) || is_signed(sh(e)))? 1 : 0;
3895
	mka.regmove = move(w.answhere, dest,(guard(w, sp)), sgned);
3896
	if (name(e) == contvol_tag) {
2 7u83 3897
	  mka.regmove = NOREG;
7 7u83 3898
	  setnovolatile();
2 7u83 3899
	}
3900
	return mka;
3901
      }				/* end cont */
3902
 
3903
 
3904
    case real_tag: {
7 7u83 3905
	int dble = shape_size(sh(e)) >32;
2 7u83 3906
	r2l x;
3907
	int i;
3908
	ans aa;
3909
        instore isa;
3910
	int n = (nca<16)?nca:16;
7 7u83 3911
	x = real2longs_IEEE(&flptnos[no(e)], dble);
3912
	for (i=0; i< n; i++) {
2 7u83 3913
	    rcache *r = &rca[i];
3914
	    if (r->dble == dble && r->r.i1 == x.i1 && r-> r.i2 == x.i2)
3915
		{isa = r->ad; goto found;}
3916
	}
3917
	isa = evaluated(e, 0,(dec*)0);
3918
        rca[nca & 15].dble = dble; rca[nca & 15].r = x; rca[nca & 15].ad = isa;
3919
	nca++;
3920
	settext();
7 7u83 3921
  found:setinsalt(aa, isa);
3922
	mka.regmove = move(aa, dest, sp, 0);
2 7u83 3923
	return mka;
3924
    }
3925
    case string_tag:
3926
      {
3927
	instore isa;
3928
	ans aa;
7 7u83 3929
	bool sgned = ((ashof(sh(e)).ashsize >= 32) || is_signed(sh(e)))? 1 : 0;
3930
	isa = evaluated(e, 0,(dec*)0);
2 7u83 3931
	/* place constant in appropriate data segment */
7 7u83 3932
	settext();
3933
	setinsalt(aa, isa);
3934
	mka.regmove = move(aa, dest, sp, sgned);
2 7u83 3935
	return mka;
3936
      }				/* end eval */
3937
 
3938
    case val_tag:
3939
      {
7 7u83 3940
	if (shape_size(sh(e)) >32) {
2 7u83 3941
		flt64 temp;
3942
		int ov;
3943
		int r = getreg(sp.fixed);
3944
		space nsp;
3945
		baseoff bc;
3946
		ans aa;
3947
		if (dest.answhere.discrim!=notinreg) return mka;
3948
		if (isbigval(e)) {
3949
			temp = flt_to_f64(no(e), 0, &ov);
3950
		}
3951
		else {
7 7u83 3952
			temp.big = (is_signed(sh(e)) && no(e) <0)?-1:0;
2 7u83 3953
			temp.small = no(e);
3954
		}
3955
		nsp = guardreg(r, sp);
3956
		bc.base =0;
3957
		bc.offset = temp.small;
3958
		ls_ins(i_li, r, bc);
3959
		setregalt(aa,r);
3960
		dest.ashwhere.ashsize = 32;
3961
		dest.ashwhere.ashalign = 32;
3962
		move(aa,dest,nsp,1);
3963
		bc.offset = temp.big;
3964
		ls_ins(i_li, r, bc);
3965
		dest.answhere.val.instoreans.b.offset+=4;
3966
		move(aa,dest,nsp,1);
3967
		return mka;
3968
	}
7 7u83 3969
	if (no(e) == 0) {
2 7u83 3970
	  goto null_tag_case;
3971
	}
3972
	else {
3973
	  ash a;
7 7u83 3974
	  a = ashof(sh(e));
3975
	  if (a.ashsize == 32 || !is_signed(sh(e))) {
3976
	    constval = no(e);
2 7u83 3977
	  }
3978
	  else
3979
	    if (a.ashsize == 8) {
7 7u83 3980
	      constval = no(e) & 255;
2 7u83 3981
	      constval -= (constval & 128) << 1;
3982
	    }
3983
	    else {
7 7u83 3984
	      constval = no(e) & 65535;
2 7u83 3985
	      constval -= (constval & 32768) << 1;
3986
	    }
3987
	  goto moveconst;
3988
	}
3989
      }
3990
 
3991
    case top_tag: {
3992
	return mka;
3993
      }
3994
 
3995
    case dump_tag: {
3996
    	long fxd = no(e);
3997
    	long fld = no(pt(e));
3998
    	long old_fixdone = fixdone;
3999
    	long old_fltdone = fltdone;
4000
    	long old_result_label = result_label;
4001
    	exp l;
4002
    	result_label =0;
4003
    	dump_sregs(fxd, fld);
4004
    	if ((fxd &(1<<31))) sp.fixed &= ~(1<<31); /*release link reg */
7 7u83 4005
    	for (l=son(crt_proc); name(l) ==ident_tag && isparam(l);) {
2 7u83 4006
    		/* move any pars still in registers which go into dump regs */
4007
    		int sr = props(son(l));
4008
    		int tr = no(l);
4009
    		if ((props(l) & inanyreg)!=0 && (tr !=sr) && sr != 0) {
4010
    		    if ((props(l) & infreg_bits)!=0 &&
7 7u83 4011
    		        (fld & (3<< (sr<<1)))!=0) {
4012
    		       if (name(sh(son(l)))!= shrealhd) {
2 7u83 4013
    		       	  rrfp_ins(i_mov_d, sr<<1, tr<<1);
4014
    		       }
4015
    		       else {
4016
   		       	  rrfp_ins(i_mov_s, sr<<1, tr<<1);
4017
    		       }
4018
    		       sp.flt &= ~(1<<tr); /* release fpar reg */
4019
    		       no(l) = sr; props(son(l)) = tr;
4020
    		    }
4021
    		    else
7 7u83 4022
    		    if ((fxd & (1<<sr))!=0) {
2 7u83 4023
    		    	mon_ins(i_move, sr, tr);
4024
    		    	sp.fixed &= ~(1<<tr); /* release par reg */
7 7u83 4025
    		    	no(l) =sr; props(son(l)) = tr;
2 7u83 4026
    		    }
4027
    		 }
4028
    		 l = bro(son(l));
7 7u83 4029
    		 if (name(l) ==dump_tag)l = son(l);
2 7u83 4030
        }
4031
        code_here(son(e), sp, dest);
7 7u83 4032
    	for (l=son(crt_proc); name(l) ==ident_tag && isparam(l);) {
2 7u83 4033
    		/* restore structure of moved pars */
4034
    		int sr = props(son(l));
4035
    		int tr = no(l);
4036
    		if ((props(l) & inanyreg)!=0 && (tr !=sr) && sr != 0) {
4037
    		    if ((props(l) & infreg_bits)!=0 &&
7 7u83 4038
    		        (fld & (3<< (tr<<1)))!=0) {
2 7u83 4039
    		       no(l) = sr; props(son(l)) = tr;
4040
    		    }
4041
    		    else
7 7u83 4042
    		    if ((fxd & (1<<tr))!=0) {
4043
    		    	no(l) =sr; props(son(l)) = tr;
2 7u83 4044
    		    }
4045
    		 }
4046
    		 l = bro(son(l));
7 7u83 4047
    		 if (name(l) ==dump_tag)l = son(l);
2 7u83 4048
        }
7 7u83 4049
        if (name(sh(e))!= bothd) {
2 7u83 4050
        	restore_sregs(fxd, fld);
4051
        }
4052
        fixdone = old_fixdone;
4053
        fltdone = old_fltdone;
4054
        result_label = old_result_label;
4055
        return mka;
4056
    }
4057
 
4058
    case env_size_tag: {
4059
	exp tg = son(son(e));
4060
	procrec * pr = &procrecs[no(son(tg))];
4061
	constval = (pr->frame_size+pr->callee_size) >> 3;
4062
	goto moveconst;
4063
   }
4064
 
4065
    case proc_tag: case general_proc_tag:
4066
      {				/*
4067
				 set up locals_offset, fixdump, floatdump, frame_size, dumpstart
4068
				 dec stack  ; output frame and mask
4069
				 code here;
4070
				 */
4071
	procrec * pr = & procrecs[no(e)];
4072
	needs * ndpr = & pr->needsproc;
4073
	long pprops = (ndpr->propsneeds);
4074
	bool leaf = (pprops & anyproccall) == 0;
4075
	space tbd;
4076
	space pars;
4077
	long st;
4078
	exp l;
4079
 
4080
	crt_proc = e;
4081
	old_pls = (postl_chain*)0;
4082
 
4083
	frame_size = pr->frame_size;
4084
	locals_offset = pr->locals_offset;
4085
	max_args = pr->max_args;
4086
	fixdump = pr->fixdump;
4087
	floatdump = pr->floatdump;
4088
	dumpstart = pr->dumpstart;
4089
	fldumpstart = pr->fldumpstart;
4090
	callee_size = pr->callee_size;
4091
 
4092
        setframe_flags(e, leaf);
4093
 
4094
	st = (frame_size+callee_size) >> 3;
4095
 
4096
	fixdone = fltdone = 0;	/* no s-regs have been dumped yet */
4097
 
4098
 
4099
	tbd.fixed = fixdump;
4100
	tbd.flt = floatdump;
4101
 
4102
	pars.fixed = (leaf)?0:(1<<31);
4103
	pars.flt = 0;
4104
 
4105
	for (l = son(e);
4106
	     name(l) == ident_tag && isparam(l)
4107
		&& name(son(l))	!= formal_callee_tag;
4108
             l = bro(son(l))) {
4109
		if ((props(l) & infreg_bits)!= 0) {
4110
			int n = props(son(l));
4111
			if (n != no(l) && n != 0) {
7 7u83 4112
				pars.flt |= (3<< (no(l) <<1));
2 7u83 4113
			}
4114
		}
4115
		else
4116
		if ((props(l) & inreg_bits)!=0) {
4117
			int n = props(son(l));
4118
			if (n != no(l) && n != 0) {
4119
				pars.fixed |= (1<<no(l));
4120
			}
4121
		}
4122
	}
4123
 
4124
	dump_opt(e, &tbd, &pars);
4125
 
4126
	if (PIC_code) {
4127
	    setnoreorder();
4128
	    out_cpload(current_symno, 25);
4129
	    if (as_file) {
4130
	    	fprintf(as_file, "\t.cpload\t$25\n");
4131
	    }
4132
	    setreorder();
4133
	}
4134
 
4135
 
7 7u83 4136
	if (name(e) ==general_proc_tag) {
2 7u83 4137
	  if (Has_vcallees) {
4138
	  	baseoff b;
4139
	  	b.base = 30;
4140
	  	b.offset = -16;
4141
	  	ls_ins(i_sw, local_reg, b); /* old l-reg in -16(30) */
4142
		mon_ins(i_move, local_reg, 29);
4143
		/* if(!leaf) */ {
4144
			b.offset = -12; /* new l_reg in -12(30); */
4145
			ls_ins(i_sw, local_reg, b);
4146
		}
4147
	  }
4148
	  else
7 7u83 4149
	  if (Has_fp && name(e) ==general_proc_tag) {
2 7u83 4150
	 	rri_ins(i_addu, 30, 29, callee_size>>3);
4151
	   }
4152
	  if (frame_size !=0) {
7 7u83 4153
		rri_ins(i_subu, 29, 29, frame_size>>3);
2 7u83 4154
	  }
4155
	}
4156
	else {
4157
	  if (st !=0) {
7 7u83 4158
		rri_ins(i_subu, 29, 29, st);
2 7u83 4159
	  }
4160
	  if (Has_fp) {
4161
		baseoff b;
4162
		b.base = 29;
4163
		b.offset = st-4;
4164
		ls_ins(i_sw, 30, b);
4165
		rri_ins(i_addu, 30, 29, st);
4166
	  }
4167
        }
4168
 
7 7u83 4169
	if (Has_tos) {
2 7u83 4170
		baseoff b;
4171
		b.base = 30;
4172
		b.offset = -8;
4173
		ls_ins(i_sw, 29, b);
4174
	}
4175
 
4176
        diagPIClab = 0;
4177
	if (PIC_code && !leaf) {
4178
		dump_gp();
4179
	        if (diagnose && frame_size != 0) {
4180
			diagPIClab = new_label();
4181
		}
4182
	}
4183
 
4184
	allocaerr_lab = 0;
4185
	if (proc_has_checkstack(e)) {
4186
		baseoff b;
4187
		exp stl = find_named_tg("__TDFstacklim",
4188
				f_pointer(f_alignment(f_proc)));
4189
		setvar(stl);
4190
		b = boff(stl);
4191
		stackerr_lab = new_label();
4192
		ls_ins(i_lw, 2, b);
4193
		condrr_ins(i_bgt, 2, 29, stackerr_lab);
4194
	}
4195
	else stackerr_lab = 0;
4196
 
7 7u83 4197
	setframe(st);
2 7u83 4198
	/* I'm not sure that this is the right order for these -
4199
	   diagnostics ? */
4200
 
4201
 
4202
	if (fixdump != 0) {
7 7u83 4203
	  setmask(fixdump, dumpstart - st - 4);
2 7u83 4204
	}
4205
	if (floatdump != 0) {
7 7u83 4206
	  setfmask(floatdump, fldumpstart - st - 4);
2 7u83 4207
	}
4208
 
4209
 
7 7u83 4210
	if ((pprops & realresult_bit)!= 0) {
2 7u83 4211
	      /* proc has real result */
4212
	      freg frg;
4213
	      frg.fr = 0;
7 7u83 4214
	      frg.dble = (pprops & longrealresult_bit)? 1 : 0;
4215
	      setfregalt(procans, frg);
2 7u83 4216
	}
4217
	else
7 7u83 4218
	if ((pprops & has_result_bit)!= 0) {
2 7u83 4219
		/* proc has fixed pt result */
7 7u83 4220
		setregalt(procans, 2);
2 7u83 4221
	}
4222
	else {		/* proc has no result */
7 7u83 4223
		setregalt(procans, 0);
2 7u83 4224
	}
4225
 
4226
	rscope_level = 0;
4227
	result_label = 0;
4228
 
4229
        aritherr_lab = 0;
4230
 
7 7u83 4231
	code_here(son(e), guardreg(31,sp), nowhere);
2 7u83 4232
	/* evaluate body of proc */
4233
        if (stackerr_lab != 0 || allocaerr_lab != 0) {
4234
	   if (stackerr_lab != 0) {
4235
		set_label(stackerr_lab);
7 7u83 4236
		rri_ins(i_addu, 29, 29, frame_size>>3);
2 7u83 4237
	   }
4238
	   if (allocaerr_lab != 0) { set_label(allocaerr_lab); }
4239
	   do_exception(MIPS_SIGUSR1);
4240
	}
4241
	if (aritherr_lab != 0) {
4242
		set_label(aritherr_lab);
4243
		do_exception(MIPS_SIGFPE);
4244
	}
4245
	if (diagPIClab != 0) {
4246
		set_label(diagPIClab);
7 7u83 4247
		uncond_ins(i_j, 31);
2 7u83 4248
	}
4249
 
4250
	return mka;
4251
 
4252
      }				/* end proc */
4253
 
4254
    case alloca_tag: {
4255
    	exp s = son(e);
4256
    	int r = regfrmdest(&dest, sp);
4257
    	ans aa;
4258
	if (checkalloc(e)) {
4259
	    int tmp = getreg(guardreg(r,sp).fixed);
4260
	    exp stl = find_named_tg("__TDFstacklim",
7 7u83 4261
			f_pointer(f_alignment(f_proc)));
2 7u83 4262
	    baseoff b;
4263
	    setvar(stl);
7 7u83 4264
	    if (name(s) ==val_tag) {
4265
		    rri_ins(i_subu, r, 29,(no(s) +7) &~7);
2 7u83 4266
	    }
4267
	    else {
4268
		    int rr = reg_operand(s, sp);
7 7u83 4269
		    rri_ins(i_addu, tmp, rr, 7);
2 7u83 4270
		    rri_ins(i_and, tmp,tmp, ~7);
4271
		    rrr_ins(i_subu, r, 29, tmp);
4272
	    }
4273
	    b = boff(stl);
7 7u83 4274
	    if (allocaerr_lab == 0)allocaerr_lab = new_label();
2 7u83 4275
	    ls_ins(i_lw, tmp, b);
4276
	    condrr_ins(i_bgt, tmp, r, allocaerr_lab);
4277
	    rri_ins(i_addu, 29, r, 0);
4278
	}
4279
	else {
7 7u83 4280
	    if (name(s) ==val_tag) {
4281
		    rri_ins(i_subu, 29, 29,(no(s) +7) &~7);
2 7u83 4282
	    }
4283
	    else {  int tmp = getreg(sp.fixed);
4284
		    int rr = reg_operand(s, sp);
7 7u83 4285
		    rri_ins(i_addu, tmp, rr, 7);
2 7u83 4286
		    rri_ins(i_and, tmp,tmp, ~7);
4287
		    rrr_ins(i_subu, 29, 29, tmp);
4288
	    }
4289
	}
4290
	reset_tos();
7 7u83 4291
	rri_ins(i_addu, r, 29,(max_args>>3));
2 7u83 4292
    	setregalt(aa, r);
4293
    	mka.regmove = move(aa, dest, sp, 1);
4294
    	return mka;
4295
    }
4296
 
4297
    case last_local_tag: {
4298
    	int r = regfrmdest(&dest, sp);
4299
    	ans aa;
4300
    	rri_ins(i_addu, r, 29, max_args>>3);
4301
    	setregalt(aa, r);
4302
    	mka.regmove = move(aa, dest, sp, 1);
4303
    	return mka;
4304
    }
4305
 
4306
    case local_free_tag: {
4307
	exp p = son(e);
4308
    	int r = reg_operand(p, sp);
4309
	exp off = bro(p);
7 7u83 4310
	if (name(off) ==val_tag) {
4311
		rri_ins(i_addu, r, r,(no(off) +7) &~7);
2 7u83 4312
	}
4313
	else {
4314
		int tmp = reg_operand(off, guardreg(r, sp));
7 7u83 4315
		rri_ins(i_addu, tmp, tmp, 7);
2 7u83 4316
		rri_ins(i_and, tmp,tmp, ~7);
4317
		rrr_ins(i_addu, r, r, tmp);
4318
	}
4319
 
4320
    	if (Has_fp) {
4321
          rri_ins(i_subu, 29, r, max_args>>3);
4322
          reset_tos();
4323
        }
4324
    	return mka;
4325
    }
4326
 
4327
    case local_free_all_tag: {
4328
    	if (Has_fp) {
7 7u83 4329
          rri_ins(i_subu, 29, 30 ,(frame_size+callee_size) >>3);
2 7u83 4330
          reset_tos();
4331
        }
4332
    	return mka;
4333
    }
4334
 
4335
    case current_env_tag: {
4336
    	int r = regfrmdest(&dest, sp);
4337
    	ans aa;
4338
    	if (Has_fp) {
4339
    		mon_ins(i_move, r, 30);
4340
    	}
4341
    	else {
7 7u83 4342
    		rri_ins(i_addu, r, 29,(frame_size+callee_size) >>3);
2 7u83 4343
    	}
4344
    	setregalt(aa, r);
4345
    	mka.regmove = move(aa, dest, sp, 1);
4346
    	return mka;
4347
    }
4348
 
4349
    case env_offset_tag: case general_env_offset_tag:{
4350
    	constval = frame_offset(son(e));
4351
    	goto moveconst;
4352
    }
4353
 
4354
    case null_tag:
4355
  null_tag_case:
4356
      {
4357
	ans aa;
7 7u83 4358
	setregalt(aa, 0);
4359
	mka.regmove = move(aa, dest, sp, 1);
2 7u83 4360
	return mka;
4361
      }
4362
 
4363
    case round_tag:
4364
   /* case trunc_tag: */
4365
      {
7 7u83 4366
	int   r = (dest.answhere.discrim == inreg)? regalt(dest.answhere)
4367
	:     getreg(sp.fixed);
4368
	int   sfr = freg_operand(son(e), sp);
4369
	int   dfr = getfreg(guardfreg(sfr, sp).flt);
2 7u83 4370
	ans aa;
4371
	int   s = shape_size(sh(son(e)));
7 7u83 4372
	int mr = (round_number(e) == f_to_nearest)? 3:
4373
			(round_number(e) == f_toward_zero)? 2:
4374
			(round_number(e) == f_toward_larger)? 1:
4375
			(round_number(e) == f_toward_smaller)? 0:3;
2 7u83 4376
	int r1;
7 7u83 4377
	if (r==0)r = getreg(sp.fixed);
2 7u83 4378
	sp = guardreg(r, sp);
4379
	r1 = getreg(sp.fixed);
7 7u83 4380
 	if (!optop(e))setnoreorder();
2 7u83 4381
 
4382
	cop_ins(i_cfc1, r, 31);
4383
	rrr_ins(i_or, 0, 0, 0); /* nop */
4384
	rri_ins(i_or, r1, r , 3);
4385
	rri_ins(i_xor, r1, r1, mr);
4386
	cop_ins(i_ctc1, r1, 31);
4387
	rrr_ins(i_or, 0, 0, 0); /* nop */
4388
	rrfp_ins((s==32)?i_cvt_w_s:i_cvt_w_d, dfr<<1, sfr<<1);
4389
 
4390
	if (!optop(e)) {
4391
		setreorder();
4392
		checknan(e, guardreg(r, sp));
4393
	}
4394
	cop_ins(i_ctc1, r, 31);
7 7u83 4395
	cop_ins(i_mfc1, r, dfr << 1);
2 7u83 4396
 
4397
 
4398
/*  cfc1    r,$31
4399
  cfc1    r,$31
4400
  ori     r1,dfr,0x3
4401
  xori    r1,r1, to_n = 3, to_z = 2, to+i = 1, to-i = 0
4402
  ctc1    r1,$31
4403
  srl     r0,r0,0
4404
  cvt.w.s $f6,$f0
4405
	check
4406
  ctc1    r,$31
4407
	expansion of i_round_w_s etc
4408
*/
4409
 
7 7u83 4410
	setregalt(aa, r);
4411
	mka.regmove = move(aa, dest, sp, 1);
2 7u83 4412
	return mka;
4413
      }
4414
 
4415
 
4416
    case int_to_bitf_tag:
4417
      {
4418
	int   r;
4419
	where w;
4420
	ash a;
4421
	ash ai;
4422
	ans aa;
4423
	space nsp;
7 7u83 4424
	a = ashof(sh(e));
4425
	ai = ashof(sh(son(e)));
2 7u83 4426
	r = regfrmdest(&dest, sp);
4427
 
7 7u83 4428
	setregalt(w.answhere, r);
2 7u83 4429
	w.ashwhere = a;
7 7u83 4430
	code_here(son(e), sp, w);
2 7u83 4431
	if (a.ashsize != ai.ashsize) {
7 7u83 4432
	  rri_ins(i_and, r, r,(1 << a.ashsize) - 1);
2 7u83 4433
	}
7 7u83 4434
	nsp = guardreg(r, sp);
4435
	setregalt(aa, r);
4436
	move(aa, dest, nsp, 0);
2 7u83 4437
	return mka;
4438
      }
4439
 
4440
 
4441
    case bitf_to_int_tag:
4442
      {
4443
	ash a;
4444
	int   r;
4445
	where w;
7 7u83 4446
	a = ashof(sh(son(e)));
2 7u83 4447
	r = regfrmdest(&dest, sp);
4448
 
7 7u83 4449
	setregalt(w.answhere, r);
2 7u83 4450
	w.ashwhere = a;
7 7u83 4451
	code_here(son(e), sp, w);
2 7u83 4452
	if (a.ashsize != 32) {
7 7u83 4453
	  if (is_signed(sh(e))) {
4454
	    rri_ins(i_sll, r, r, 32 - a.ashsize);
4455
	    rri_ins(i_sra, r, r, 32 - a.ashsize);
2 7u83 4456
	  }
4457
	  else {
7 7u83 4458
	    rri_ins(i_and, r, r,((1 << a.ashsize) - 1));
2 7u83 4459
	  }
4460
	}
4461
 
7 7u83 4462
	move(w.answhere, dest, guardreg(r, sp), 0);
4463
	keepreg(e, r);
2 7u83 4464
	return mka;
4465
      }
4466
 
4467
 
4468
    case movecont_tag: {
4469
        exp szarg = bro(bro(son(e)));
4470
    	int dr, sr, szr, mr;
4471
 	int lout = new_label();
4472
 	space nsp;
4473
 	int bytemove;
4474
 	where w;
4475
 
4476
 	sr = getreg(sp.fixed);
4477
 	setregalt(w.answhere, sr);
4478
 	w.ashwhere = ashof(sh(son(e)));
4479
 	IGNORE make_code(son(e), sp, w , 0);
4480
 	nsp = guardreg(sr, sp);
4481
 	dr = getreg(nsp.fixed);
4482
 	setregalt(w.answhere, dr);
4483
 	IGNORE make_code(bro(son(e)), nsp, w, 0);
4484
 	nsp = guardreg(dr, nsp);
4485
 	w.ashwhere = ashof(sh(bro(bro(son(e)))));
4486
 	szr = getreg(nsp.fixed);
4487
 	setregalt(w.answhere, szr);
4488
 	IGNORE make_code(szarg, nsp, w, 0);
4489
 	nsp = guardreg(szr, nsp);
4490
 	mr = getreg(nsp.fixed);
4491
        bytemove = (al2(sh(szarg)) <= 8);
4492
 
4493
 
7 7u83 4494
	if (name(szarg)!= val_tag || no(szarg) == 0) {
2 7u83 4495
		condrr_ins(i_beq, szr, 0, lout);
4496
	}
4497
	if (isnooverlap(e)) {
4498
		move_dlts(dr,sr,szr,mr, bytemove);
4499
	}
4500
	else {
4501
		int gtlab = new_label();
4502
		condrr_ins(i_bgt, dr, sr,gtlab);
4503
		move_dlts(dr,sr,szr, mr, bytemove);
4504
		uncond_ins(i_b, lout);
4505
		set_label(gtlab);
4506
		move_dgts(dr,sr,szr, mr, bytemove);
4507
	}
4508
 	set_label(lout);
4509
 	return mka;
4510
   }
4511
    case set_stack_limit_tag: {
7 7u83 4512
	baseoff b;
2 7u83 4513
	int r = reg_operand(son(e), sp);
4514
	exp stl = find_named_tg("__TDFstacklim",
4515
				f_pointer(f_alignment(f_proc)));
4516
	setvar(stl);
4517
	b = boff(stl);
4518
	ls_ins(i_sw, r, b);
4519
	return mka;
4520
    }
4521
    case give_stack_limit_tag: {
4522
    	baseoff b;
4523
    	ans aa;
4524
	int r = regfrmdest(&dest, sp);
4525
	exp stl = find_named_tg("__TDFstacklim",
4526
				f_pointer(f_alignment(f_proc)));
4527
	setvar(stl);
4528
	b = boff(stl);
4529
	ls_ins(i_lw, r, b);
7 7u83 4530
	setregalt(aa, r);
4531
        move(aa, dest, guardreg(r, sp), 1);
2 7u83 4532
	return mka;
4533
    }
4534
    case trap_tag: {
4535
	if (no(e) == f_overflow) {
4536
		do_exception(MIPS_SIGFPE);
4537
	}
4538
	else
4539
	if (no(e) == f_nil_access) {
4540
		do_exception(MIPS_SIGSEGV);
4541
	}
4542
	else do_exception(MIPS_SIGUSR1);
4543
 
4544
	return mka;
4545
    }
4546
 
4547
 
4548
 
4549
    default:
7 7u83 4550
      failer("not done yet");
2 7u83 4551
  }				/* end outer switch */
4552
 
4553
 
4554
 
4555
moveconst:
4556
  {
4557
    int   r = regfrmdest(&dest, sp);
4558
    baseoff b;
4559
    ans aa;
4560
 
4561
    if (r != 0) {		/* somewhere! */
4562
      b.base = 0;
4563
      b.offset = constval;
7 7u83 4564
      ls_ins(i_li, r, b);
4565
      setregalt(aa, r);
4566
      move(aa, dest, guardreg(r, sp), 1);
2 7u83 4567
    }
4568
    mka.regmove = r;
4569
    return mka;
4570
  }
4571
 
4572
}				/* end make_code */