Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
2 7u83 1
/*
6 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
6 7u83 33
 
2 7u83 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:-
6 7u83 42
 
2 7u83 43
        (1) Its Recipients shall ensure that this Notice is
44
        reproduced upon any copies or amended versions of it;
6 7u83 45
 
2 7u83 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;
6 7u83 49
 
2 7u83 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;
6 7u83 53
 
2 7u83 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
 
6 7u83 61
/* 	$Id$	 */
2 7u83 62
 
63
#ifndef lint
6 7u83 64
static char vcid[] = "$Id$";
2 7u83 65
#endif /* lint */
66
/*
67
$Log: coder.c,v $
68
 * Revision 1.2  1998/02/04  10:43:30  release
69
 * Changes during testing.
70
 *
71
 * Revision 1.1.1.1  1998/01/17  15:55:58  release
72
 * First version to be checked into rolling release.
73
 *
74
 * Revision 1.46  1997/09/05  12:22:14  john
75
 * Changed case behaviour
76
 *
77
 * Revision 1.45  1996/11/27  17:56:27  john
78
 * Changed case behaviour
79
 *
80
 * Revision 1.44  1996/03/18  17:00:17  john
81
 * Fix to rem operation
82
 *
83
 * Revision 1.43  1996/03/15  10:29:39  john
84
 * Fix to char & short ops
85
 *
86
 * Revision 1.42  1996/02/29  17:35:49  john
87
 * Fix to remainder op
88
 *
89
 * Revision 1.41  1996/02/19  09:25:05  john
90
 * change to register
91
 *
92
 * Revision 1.40  1996/02/15  09:49:16  john
93
 * Some changes to general proc handling
94
 *
95
 * Revision 1.39  1996/01/23  16:48:40  john
96
 * Fixed vararg handling for general procs
97
 *
98
 * Revision 1.38  1996/01/17  09:30:14  john
99
 * Various fixes
100
 *
101
 * Revision 1.37  1995/12/04  09:12:17  john
102
 * Fix to varparams & alloca
103
 *
104
 * Revision 1.36  1995/11/14  15:20:53  john
105
 * Fixes to general procs
106
 *
107
 * Revision 1.35  1995/11/13  12:10:15  john
108
 * Fixes to arithmetic
109
 *
110
 * Revision 1.34  1995/10/27  16:17:00  john
111
 * Change to general procs
112
 *
113
 * Revision 1.33  1995/10/27  12:07:40  john
114
 * Fix to same_callees
115
 *
116
 * Revision 1.32  1995/10/24  09:27:53  john
117
 * Fixes to large numbers
118
 *
119
 * Revision 1.31  1995/10/19  16:36:13  john
120
 * Fix to error treatments
121
 *
122
 * Revision 1.30  1995/10/18  09:28:40  john
123
 * Fix to round_tag
124
 *
125
 * Revision 1.29  1995/09/29  15:27:04  john
126
 * Some changes for vcallers
127
 *
128
 * Revision 1.28  1995/09/22  16:02:04  john
129
 * Minor fix
130
 *
131
 * Revision 1.27  1995/09/21  15:40:43  john
132
 * Various improvements to error handling
133
 *
134
 * Revision 1.26  1995/09/15  16:21:15  john
135
 * New exception handling
136
 *
137
 * Revision 1.25  1995/09/13  15:45:29  john
138
 * Cleared out some old code
139
 *
140
 * Revision 1.24  1995/09/13  08:22:10  john
141
 * Addition for exception handling
142
 *
143
 * Revision 1.23  1995/09/07  12:27:46  john
144
 * Changes to general procs
145
 *
146
 * Revision 1.22  1995/09/04  16:13:00  john
147
 * Fix to general procs
148
 *
149
 * Revision 1.21  1995/09/01  09:08:56  john
150
 * Fix to mult_tag
151
 *
152
 * Revision 1.20  1995/08/31  15:41:46  john
153
 * Added fmax_tag & fixed some limits bugs
154
 *
155
 * Revision 1.19  1995/08/30  16:13:14  john
156
 * Various fixes to error treatments
157
 *
158
 * Revision 1.18  1995/08/23  16:05:06  john
159
 * Corrected comment
160
 *
161
 * Revision 1.17  1995/08/21  13:37:28  john
162
 * Changed handling of caller_tag
163
 *
164
 * Revision 1.16  1995/08/21  10:44:11  john
165
 * Added trap_tag
166
 *
167
 * Revision 1.15  1995/08/21  08:43:28  john
168
 * Changed include files
169
 *
170
 * Revision 1.14  1995/08/04  15:49:40  john
171
 * Fixed parameters of tail call and added new error jumps
172
 *
173
 * Revision 1.13  1995/07/27  09:24:39  john
174
 * Changed general procs, repositioned $fp
175
 *
176
 * Revision 1.12  1995/07/04  09:07:43  john
177
 * Fixed tail call
178
 *
179
 * Revision 1.11  1995/06/30  07:58:34  john
180
 * Fixed bug in tail_call, callee parameters were being passed the wrong
181
 * way round.
182
 *
183
 * Revision 1.10  1995/06/28  10:19:37  john
184
 * Fix to shr_tag
185
 *
186
 * Revision 1.9  1995/06/21  14:24:51  john
187
 * Reformatting
188
 *
189
 * Revision 1.8  1995/06/15  09:43:44  john
190
 * Added code for stack error handling
191
 *
192
 * Revision 1.7  1995/06/15  08:34:41  john
193
 * Some reformatting and additions for new error treatment
194
 *
195
 * Revision 1.6  1995/05/25  15:33:02  john
196
 * Cosmetic changes
197
 *
198
 * Revision 1.5  1995/05/23  10:53:53  john
199
 * Reformatting + additions for spec 3.1
200
 *
201
 * Revision 1.4  1995/04/10  14:14:50  john
202
 * Added new division code.  Not fully tested in this version
203
 *
204
 * Revision 1.3  1995/03/29  14:01:08  john
205
 * Changes to keep tcheck happy
206
 *
207
 * Revision 1.2  1995/03/29  10:29:33  john
208
 * Added code to detect and handle IEEE denormals
209
 *
210
 * Revision 1.1.1.1  1995/03/23  10:39:03  john
211
 * Entered into CVS
212
 *
213
 * Revision 1.51  1995/03/23  10:00:47  john
214
 * Various changes for AVS test suite
215
 *
216
 * Revision 1.50  1995/03/16  09:43:41  john
217
 * Removed bitfield operations, fixed local_free_tag and changed
218
 * chvar_tag
219
 *
220
 * Revision 1.49  1995/03/09  14:08:55  john
221
 * Introduced code to use the scheduler, and fixed a bug in test_tag
222
 *
223
 * Revision 1.48  1995/02/09  17:17:29  john
224
 * Fix to rep_tag and local_free_tag
225
 *
226
 * Revision 1.47  1995/02/06  16:45:11  john
227
 * Fix to case_tag
228
 *
229
 * Revision 1.46  1995/01/26  13:30:54  john
230
 * Modified error jump handling, and did some reformating
231
 *
232
 * Revision 1.45  1995/01/23  09:18:45  john
233
 * First attempt at implementing error jumps
234
 *
235
 * Revision 1.44  1995/01/18  11:49:03  john
236
 * Fixed errors in abslike_tag and case_tag, and added overflow check to
237
 * div_tag
238
 *
239
 * Revision 1.43  1995/01/17  10:30:44  john
240
 * Changed implementation of absbool_tag
241
 *
242
 * Revision 1.42  1995/01/10  09:42:23  john
243
 * Minor reformating and removal of dead code.
244
 *
245
*/
246
 
6 7u83 247
/*
2 7u83 248
   coder.c
249
   This is the principal code producing module
250
*/
251
#include "config.h"
252
#include "coder.h"
253
#include "common_types.h"
254
#include "addresstypes.h"
255
#include "tags.h"
256
#include "expmacs.h"
257
#include "exp.h"
258
#include "exptypes.h"
259
#include "externs.h"
260
#include "maxminmacs.h"
261
#include "shapemacs.h"
262
#include "basicread.h"
263
#include "procrectypes.h"
264
#include "eval.h"
265
#include "move.h"
266
#include "operators.h"
267
#include "pseudo.h"
268
#include "getregs.h"
269
#include "guard.h"
270
#include "locate.h"
271
#include "code_here.h"
272
#include "inst_fmt.h"
273
#include "alpha_ins.h"
274
#include "handle_sregs.h"
275
#include "bitsmacs.h"
276
#include "labels.h"
277
#include "regexps.h"
278
#include "special.h"
279
#include "new_tags.h"
280
#include "syms.h"
281
#include "flags.h"
282
#include "main.h"
283
#include "dump_distr.h"
284
#include "extratags.h"
285
#include "frames.h"
286
#include "reg_defs.h"
287
#include "cross.h"
288
#include "flpttypes.h"
289
#include "flpt.h"
290
#include "f64.h"
291
#include "fail.h"
292
#include "bool.h"
293
#include "regable.h"
294
#include "symdiags.h"
295
#include "f64.h"
296
#include "install_fns.h"
297
#include "outofline.h"
298
#include "diag_fns.h"
299
#include "out_ba.h"
300
#include "float.h"
301
#include "szs_als.h"
302
#include "translate.h"
303
extern  FILE * as_file;
304
int fscopefile;	/* file of current proc */
305
 
306
/*extern void add_odd_bits PROTO_S ((outofline*));*/
307
 
308
ans procans;
309
int rscope_level;
310
int rscope_label;
311
int result_label = 0;
312
int currentnop;
313
long max_args;
314
 
315
baseoff procbase=
316
{
317
  RA,0L
318
};
319
 
320
flt alpha_word_max = {{32768,0,0,0,0,0,0,0},1,0};
321
flt alpha_long_max = {{1,0,0,0,0,0,0,0},1,2};
322
flt alpha_quad_max = {{1,0,0,0,0,0,0,0},1,4};
323
 
324
where nowhere;
325
int stack_top;
326
int paramsdumpstart;
327
int gpdumpstart;
328
int arg_stack_space=0;
329
 
330
static exp crt_proc;
331
 
332
int use_andcomp = 0;
333
int in_general_proc = 0;
334
int in_vcallers_apply = 0;
335
int aritherr_lab = 0;
336
int stackerr_lab = 0;
337
 
338
int testrev[] = {
339
  4,3,2,1,6,5
340
};
341
/*
342
outofline *odd_bits;
343
int doing_odd_bits;
344
*/
345
/* put register number 'Reg' back into the current space. */
6 7u83 346
#define replace_reg(Reg,Space)((Space) & ~(1<< (Reg)))
2 7u83 347
 
6 7u83 348
#define fix_parameter_size(X,Y) if (Y==32) {\
2 7u83 349
operate_fmt_immediate(i_addl,X,0,X);\
350
}
351
 
6 7u83 352
#define error_treatment_is_trap(e)((errhandle(e) &3) ==3)
2 7u83 353
 
354
/*
355
  Return TRUE if the floating point number is zero and FALSE
356
  otherwise.
357
*/
358
static bool is_fzero
6 7u83 359
(flt fnum)
2 7u83 360
{
361
  int i;
6 7u83 362
  for (i=0;(i<MANT_SIZE) && (fnum.mant[i] ==0);++i);
363
  return(i==MANT_SIZE);
2 7u83 364
}
365
 
366
 
367
 
368
/*
369
  Functions to handle the 'trap' exception handling mechanism
370
*/
371
static int trap_label
6 7u83 372
(exp e)
2 7u83 373
{
6 7u83 374
  if (error_treatment_is_trap(e)) {
375
    if (aritherr_lab == 0)aritherr_lab = new_label();
2 7u83 376
    return aritherr_lab;
377
  }
378
  else return no(son(pt(e)));
379
}
380
 
381
static void do_exception
6 7u83 382
(int ex)
2 7u83 383
{
384
  baseoff b;
385
 
386
  load_store_immediate(i_ldiq, FIRST_INT_ARG,  ex);
387
  setnoat();
388
  /*  b = find_tag("__TDFhandler");*/
389
  b = find_tag("__alpha_errhandler");
390
  load_store(i_ldq,AT,b);
391
  operate_fmt(i_bis,AT,AT,PV);
392
  b.base = AT;
393
  b.offset = 0;
394
  integer_jump(i_jmp,31,AT,0);
395
  setat();
396
  return;
397
}
398
 
399
 
400
/*
6 7u83 401
  check that the floating point register contains a non-negative
402
  value and,if it does, convert to signed by adding the
2 7u83 403
  appropriate constant.
404
*/
405
static void fix_unsigned
6 7u83 406
(freg fr, space sp, int name)
2 7u83 407
{
408
  space nsp;
409
  int ftmp;
6 7u83 410
  freg newfr;
2 7u83 411
  ans aa;
412
  flpt fltval;
413
  exp float_exp;
414
  instore isa;
415
  where dest;
416
  flt constval;
417
  nsp = guardfreg(fr.fr,sp);
418
  ftmp = getfreg(nsp.flt);
419
  fltval = new_flpt();
6 7u83 420
  switch (name) {
2 7u83 421
    case uwordhd:
422
    constval = alpha_word_max;
423
    break;
424
    case ulonghd:
425
    constval =  alpha_long_max;
426
    break;
427
    case u64hd:
428
    constval = alpha_quad_max;
429
    break;
430
  }
431
  flptnos[fltval] = constval;
432
  comment("BEGIN fix_unsigned");
433
  float_exp = getexp(realsh,nilexp,1,nilexp,nilexp,0,fltval,real_tag);
434
#if DO_SCHEDULE
435
  start_new_capsule(false);
436
#endif
437
  isa = evaluated(float_exp,0);
438
  set_text_section();
439
#if DO_SCHEDULE
440
  close_capsule();
441
#endif
442
  setinsalt(aa,isa);
443
  dest.ashwhere.ashsize = (fr.type == IEEE_single)?32:64;
444
  dest.ashwhere.ashalign = dest.ashwhere.ashsize;
445
  newfr.fr = ftmp;
446
  newfr.type = fr.type;
447
  setfregalt(dest.answhere,newfr);
6 7u83 448
 (void)move(aa,dest,nsp,0);
2 7u83 449
  float_op((fr.type == IEEE_single)?i_adds:i_addt,fr.fr,ftmp,ftmp);
450
  float_op(i_fcmovlt,fr.fr,ftmp,fr.fr);
451
  comment("END fix_unsigned");
452
  return;
453
}
454
 
455
 
456
INT64 unsigned_rep
6 7u83 457
(INT64 val, shape dest_shape)
2 7u83 458
{
6 7u83 459
  switch (name(dest_shape)) {
2 7u83 460
    case ucharhd: return val & 0xff;
461
    case uwordhd: return val & 0xffff;
462
    case ulonghd: return val & 0xffffffff;
463
    case u64hd: return val;
464
  }
465
  return val;
466
}
467
 
468
 
469
 
470
/*
471
  Inserts global pointer reference.
472
*/
473
static void set_global_pointer
6 7u83 474
(void)
2 7u83 475
{
476
  baseoff a;
477
  a.offset = 0;
478
  a.base = PV;
479
  load_store(i_ldgp,GP,a);
480
  return;
481
}
482
 
483
#if !DO_NEW_DIVISION
484
/*
6 7u83 485
  This function produces a code sequence to divide the contents of
2 7u83 486
  register 'src' by constant value 'm' and store the result in
6 7u83 487
  register 'target'.  The division is performed by calculating
488
  umax64/b and then performing an umulh of this with the source
2 7u83 489
  register.
490
*/
491
static void divide_by_constant
6 7u83 492
(int src, INT64 m, int target, space sp)
2 7u83 493
{
494
  space newsp;
495
  int rtmp;
496
  int ruse;
497
  INT64 divres;
498
  int use_div_lab,exit_lab;
499
  newsp = guardreg(src,sp);
500
  rtmp=getreg(newsp.fixed);
501
  ruse = getreg(guardreg(rtmp,newsp).fixed);
502
  exit_lab = new_label();
503
  use_div_lab = new_label();
504
  operate_fmt(i_subq,31,src,ruse);
505
  operate_fmt(i_cmovgt,src,src,ruse);
506
  INT64_assign(divres, INT64_increment(INT64_divide(umax,m,0)));
507
  load_store_immediate(i_ldiq,rtmp,divres);
508
  operate_fmt(i_umulh,rtmp,ruse,target);
509
  operate_fmt(i_subq,31,target,ruse);
510
  operate_fmt(i_cmovlt,src,ruse,target);
511
  return;
512
}
513
#endif
514
 
515
#if DO_NEW_DIVISION
516
 
6 7u83 517
/*
2 7u83 518
   Output log2(x) rounding up.
519
*/
520
int log2
6 7u83 521
(INT64 val)
2 7u83 522
{
523
  int res = 0;
524
  int absval = abs(val);
6 7u83 525
  while (!INT64_eq(absval,make_INT64(0,1))) {
2 7u83 526
    /*while (absval != 1){*/
6 7u83 527
    while (!INT64_eq(INT64_mod(absval,make_INT64(0,2),1),make_INT64(0,0))) {
2 7u83 528
      /*while (absval % 2){*/
529
      absval = INT64_increment(absval);
530
      /*++absval;*/
531
    }
6 7u83 532
    while (INT64_eq(INT64_mod(absval,make_INT64(0,2),1),make_INT64(0,0))) {
2 7u83 533
      /*while (absval % 2 == 0){*/
534
      ++res;
535
      absval = INT64_divide(absval,make_INT64(0,2),1);
536
      /*absval /=2;*/
537
    }
538
  }
539
  return res;
540
}
541
 
542
 
543
 
544
 
545
/*
546
  If 1/m can be transformed into the form:
547
 
548
  1/m = 1/(2^n) * (2^x/b).  Then return the values of n and x
549
  required.  If successfull, return TRUE, otherwise, return FALSE.
550
*/
551
bool calculate_shift_for_division
6 7u83 552
(INT64 m, int *n, int *x, bool is_quad)
2 7u83 553
{
554
  INT64 val = m;
555
  INT64 r;
556
  int shift=0;
557
  int power = 1;
558
  INT64 max32 = make_INT64(0,0xffffffff);
559
  INT64 max16 = make_INT64(0,0xffff);
6 7u83 560
  if (is_quad) {
2 7u83 561
    /*r = (429496729L%m) * 429496729L;*/
6 7u83 562
    r = INT64_mult(max32, INT64_mod(max32,m,1),1);
2 7u83 563
  }
564
  else{
565
    /*r = (65536%m) *65536;*/
6 7u83 566
    r = INT64_mult(max16, INT64_mod(max16,m,1),1);
2 7u83 567
  }
568
  r = INT64_mod(r,val,1);
569
  /*r = r % val; */
6 7u83 570
  while (INT64_eq(INT64_mod(val,make_INT64(0,2),1),make_INT64(0,0))) {
2 7u83 571
    /*  while(val%2 == 0){*/
572
    val = INT64_shift_right(val,1,1);
573
    /*val/=2;*/
574
    shift++;
575
  }
6 7u83 576
  if (INT64_eq(val,make_INT64(0,1))) {
2 7u83 577
    failer("Unexpected power of 2 in shift calculation");
578
    exit(EXIT_FAILURE);
579
  }
6 7u83 580
  while ((INT64_lt(make_INT64(0,power),val) &&
581
	  INT64_lt(make_INT64(0,power), INT64_subtract(val,r,1)))) {
2 7u83 582
    /*while ((power<val) && (val-r > power)){*/
583
    r = INT64_mult(r,make_INT64(0,2),1);
584
    /*r *= 2;*/
585
    /*r = r % val;*/
586
    r = INT64_mod(r,val,1);
587
    power *=2;
588
    /*power *= 2;*/
589
  }
590
  *n = shift;
591
  *x = power;
592
  return INT64_lt(make_INT64(0,power),val)?TRUE:FALSE;
593
  /*return (power<val)?TRUE:FALSE;*/
594
}
595
 
596
 
597
/*
6 7u83 598
  This function produces a code sequence to divide the contents of
2 7u83 599
  register 'src' by constant value 'm' and store the result in
6 7u83 600
  register 'target'.  The division is performed by calculating
601
  umax64/b and then performing an umulh of this with the source
2 7u83 602
  register.  The code produced makes use of the AT register.
603
*/
604
static void divide_by_constant
6 7u83 605
(exp div, exp lhs, exp valexp, int r_dest, space nsp)
2 7u83 606
{
6 7u83 607
  INT64 m = zero_int64;
2 7u83 608
  INT64 divres;
609
  bool simple_div;
610
  INT64 max_val;
611
  INT64 factor;
612
  int shift,power /*,factor*/;
613
  int src = reg_operand(lhs,nsp);
614
  int ruse,rdest,r_frac_value;
615
  space newsp = guardreg(src,nsp);
616
  int is_quad = !is32(sh(lhs));
617
  newsp = guardreg(r_dest,newsp);
6 7u83 618
  if (!is_quad) {
2 7u83 619
    m = make_INT64(0,no(valexp));
620
  }
621
  else{
622
    m = flt64_to_INT64(exp_to_f64(valexp));
6 7u83 623
  }
624
  if (!is_signed(sh(lhs)) && INT64_lt(m,make_INT64(0,0))) {
2 7u83 625
    setnoat();
626
    load_store_immediate(i_ldiq,AT,m);
627
    operate_fmt(i_cmpule,AT,src,rdest);
628
    setat();
629
    return;
6 7u83 630
  }
2 7u83 631
  /*max_val = is_quad?0xffffffffffffffffL:0xffffffffL;*/
632
  max_val = is_quad?make_INT64(0xffffffff,0xffffffff):make_INT64(0,0xffffffff);
6 7u83 633
 
2 7u83 634
  simple_div = calculate_shift_for_division(m,&shift,&power,is_quad);
635
  r_frac_value = r_dest;	/* alias, saves registers */
6 7u83 636
  if (simple_div) {
2 7u83 637
    factor = m/*2<<power*/;
6 7u83 638
    factor = INT64_shift_left(make_INT64(0,2),log2(m) -1,1);
2 7u83 639
    /*factor = 2<<(log2(m)-1);*/
640
  }
6 7u83 641
  else if (is_signed(sh(lhs))) {
2 7u83 642
    factor = (m);
6 7u83 643
    factor = INT64_shift_left(make_INT64(0,2),log2(m) -1,1);
2 7u83 644
    /*factor = 2<<(log2(m)-1);*/
645
    shift = 0 /*factor*/;
646
  }
647
  else{
648
    factor = INT64_subtract(
6 7u83 649
			    INT64_shift_left(make_INT64(0,2),log2(m) -1,1),
2 7u83 650
			    m,1);
651
    /*factor = (2<<(log2(m)-1))-m;*/
652
    /*    factor = power-m;*/
653
  }
654
  divres = INT64_add(INT64_divide(factor,m,1),
655
		     INT64_mult(
656
				INT64_divide(max_val,m,1),
657
				factor,
658
				1
6 7u83 659
				),
2 7u83 660
		     1
6 7u83 661
		    );
2 7u83 662
  /*  divres = factor/m + (max_val/m)*factor;*/
6 7u83 663
  if (!is_quad)divres =
2 7u83 664
    INT64_add(
665
	      INT64_divide(
666
			   INT64_shift_left(
667
					    make_INT64(0,1),
6 7u83 668
					    32+log2(m) -1,
2 7u83 669
					    1
6 7u83 670
					   ),
2 7u83 671
			   m,
672
			   1
6 7u83 673
			  ),
2 7u83 674
	      INT64_divide(
675
			   INT64_shift_left(
676
					    make_INT64(0,1),
6 7u83 677
					    log2(m) -1,
2 7u83 678
					    1
6 7u83 679
					   ),
2 7u83 680
			   m,
681
			   1
6 7u83 682
			  ),
2 7u83 683
	      1
6 7u83 684
	     );
685
#if 0
686
  if (!is_quad)divres = (((long)0x1<< (32+log2(m))) /m) + (1<<log2(m)) /m;
2 7u83 687
#endif
6 7u83 688
  if (is_signed(sh(lhs))) {
2 7u83 689
    /*ruse = getreg(newsp.fixed);*/
690
    ruse = AT;
691
    setnoat();
692
    operate_fmt(i_subq,31,src,ruse);
693
    operate_fmt(i_cmovgt,src,src,ruse);
6 7u83 694
  }
2 7u83 695
  else{
6 7u83 696
    if (!is_quad) {
2 7u83 697
      /*ruse = getreg(newsp.fixed);*/
698
      ruse = AT;
699
      setnoat();
700
      operate_fmt_immediate(i_zap,src,240,ruse);
701
    }
702
    else {
703
      ruse = src;
6 7u83 704
    }
2 7u83 705
  }
6 7u83 706
  if (is_quad) {
2 7u83 707
    operate_fmt_big_immediate(i_umulh,ruse,divres,r_dest);
708
  }
709
  else{
710
    load_store_immediate(i_ldiq,r_frac_value,divres);
711
    operate_fmt(i_mulq,ruse,r_frac_value,r_dest);
712
  }
6 7u83 713
  if (is_signed(sh(lhs))) {
714
    operate_fmt_immediate(i_sra,r_dest,(is_quad?0:32) +log2(m) -1,r_dest);
715
  }
2 7u83 716
  else{
6 7u83 717
    operate_fmt_immediate(i_srl,r_dest,(is_quad?0:32) + ((!simple_div)?0:
718
						      (log2(m) -1)),r_dest);
2 7u83 719
  }
6 7u83 720
  if (is_signed(sh(lhs))) {
2 7u83 721
    operate_fmt(i_subq,31,r_dest,ruse);
722
    operate_fmt(INT64_lt(make_INT64(0,0),m)?i_cmovlt:i_cmovgt,src,ruse,r_dest);
723
    /*operate_fmt((m>0)?i_cmovlt:i_cmovgt,src,ruse,r_dest);*/
724
  }
6 7u83 725
  else if (!simple_div && !is_signed(sh(lhs))) {
2 7u83 726
    operate_fmt(i_addq,r_dest,ruse,r_dest);
727
    operate_fmt_immediate(i_srl,r_dest,log2(m),r_dest);
728
  }
6 7u83 729
  if (ruse == AT)setat();
2 7u83 730
  return;
731
}
732
 
733
#endif
734
 
735
 
736
 
737
/*
6 7u83 738
  This function produces a code sequence to convert the value in
739
  register reg from shape src_shape to shape dest_shape.
2 7u83 740
  Returns TRUE if any code is produced and FALSE otherwise.
741
*/
742
static bool convert_shapes
6 7u83 743
(int dest_shape, int src_shape, int reg, int dreg)
2 7u83 744
{
6 7u83 745
  if (reg<32 && dreg<32) {
746
    switch (dest_shape) {
2 7u83 747
      case s64hd:
748
      case u64hd:
6 7u83 749
      switch (src_shape) {
2 7u83 750
	case ucharhd:
751
	operate_fmt_immediate(i_zapnot,reg,1,dreg);
752
	/* clear all but the bottom byte */
753
	return TRUE;
754
	case uwordhd:
755
	operate_fmt_immediate(i_zapnot,reg,3,dreg);
756
	return TRUE;
757
	case ulonghd:
758
	operate_fmt_immediate(i_zapnot,reg,15,dreg);
759
	return TRUE;
760
	default: return FALSE;
761
      }
762
      case slonghd:
6 7u83 763
      switch (src_shape) {
2 7u83 764
	case ucharhd:
765
	operate_fmt_immediate(i_zapnot,reg,1,dreg);
766
	return TRUE;
767
	case uwordhd:
768
	operate_fmt_immediate(i_zapnot,reg,3,dreg);
769
	return TRUE;
770
	case ulonghd:
771
/*	operate_fmt_immediate(i_addl,reg,0,dreg);
772
	return TRUE;*/
773
	return FALSE;
774
	/* sign extend */
775
#if 0
6 7u83 776
	case s64hd:
2 7u83 777
	operate_fmt_immediate(i_zapnot,reg,15,dreg);
778
	/*operate_fmt_immediate(i_addl,reg,0,reg);*/
779
	return TRUE;
780
#endif
781
	default:return FALSE;
782
      }
783
      case ulonghd:
6 7u83 784
      switch (src_shape) {
2 7u83 785
	case scharhd:
786
	operate_fmt_immediate(i_zapnot,reg,1,dreg);
787
	return TRUE;
788
	case swordhd:
789
	operate_fmt_immediate(i_zapnot,reg,3,dreg);
790
	return TRUE;
791
	case slonghd:
792
/*	operate_fmt_immediate(i_zapnot,reg,15,dreg);
793
	return TRUE;*/
794
	return FALSE;
795
#if 0
796
	case s64hd:
797
	operate_fmt_immediate(i_zapnot,reg,15,dreg);
798
	return TRUE;
799
#endif
800
	default: return FALSE
6 7u83 801
		  ;
2 7u83 802
      }
803
      default:return FALSE;
804
    }
805
  }
806
  return FALSE;
807
}
808
 
809
#define OVERFLOW_VALUE 0x02e0000000000000
810
/*
6 7u83 811
  Checks for floating point error.
2 7u83 812
 
6 7u83 813
  This function outputs code to look at the contents of the
814
  floating  point control register (FPCR) and determine whether
815
  or not a floating point error has occured.  If an error is
816
  detected a jump is made to the label specified in no(son(pt(e))).
817
 
818
  The error status is determined by looking at the summary bit
2 7u83 819
  of the FPCR (bit 63) which is a bitwise OR of all the error bits.
820
  The errors recognised are : integer overflow,inexact result,
821
  underflow,overflow,division by zero, and invalid operation.
822
*/
823
#if 0
824
static void check_exception
6 7u83 825
(exp e, space sp)
2 7u83 826
{
827
  long trap;
828
  int r1,r2;
6 7u83 829
  if (!pt(e)) {
2 7u83 830
    alphafail(NO_ERROR_HANDLER);
831
  }
832
  trap = trap_label(e);  	/* label of handler */
833
  r1 = getfreg(sp.flt);
834
  r2 = getfreg(guardfreg(r1,sp).flt);
6 7u83 835
  no_parameter_instructions(i_trapb);
836
  float_op(i_mf_fpcr,r1,r1,r1);
2 7u83 837
#if 0
838
  /*float_op(i_mt_fpcr,31,31,31);*/
839
  float_load_store_immediate(i_ldit,r2,"1.0"); 	/* ?? */
840
  float_op(i_cpys,r1,r2,r2);/* take the sign bit of the fpcr and append 1.0 */
6 7u83 841
  no_parameter_instructions(i_trapb);
2 7u83 842
  float_branch(i_fblt,r2,trap);
843
#else
844
  {
845
    baseoff b;
846
    int rt = getreg(sp.fixed);
847
    b.base = SP;
848
    b.offset = stack_top;
849
    float_load_store(i_stt,r1,b);
850
    load_store(i_ldq,rt,b);
851
    /* now check for overflow (bits 57/55/54/53) */
852
    operate_fmt_big_immediate(i_and,rt,OVERFLOW_VALUE,rt);
6 7u83 853
    no_parameter_instructions(i_trapb);
2 7u83 854
    integer_branch(i_bne,rt,trap);
855
  }
6 7u83 856
#endif
2 7u83 857
}
858
#endif
6 7u83 859
#define check_exception(e, sp)	((void)0)
2 7u83 860
 
861
#define PLUS_INFINITY 3
862
 
863
void set_up_rounding_mode
6 7u83 864
(int val)
2 7u83 865
{
866
  return;
867
}
6 7u83 868
 
869
 
2 7u83 870
/*
6 7u83 871
  This function returns the appropriate branch instruction
2 7u83 872
  for the test represented by 'i'
873
*/
874
static instruction sbranches
6 7u83 875
(int i)
2 7u83 876
{
877
  switch (i) {
6 7u83 878
    case  1:
2 7u83 879
    return i_ble;
6 7u83 880
    case 2:
2 7u83 881
    return i_blt;
6 7u83 882
    case 3:
2 7u83 883
    return i_bge;
6 7u83 884
    case 4:
2 7u83 885
    return i_bgt;
6 7u83 886
    case 5:
2 7u83 887
    return i_bne;
6 7u83 888
    case 6:
2 7u83 889
    return i_beq;
890
    default:
891
    failer("Illegal value for ntest");
892
  }
893
  return i_ble;
894
}
895
 
6 7u83 896
 
2 7u83 897
void testunsigned
6 7u83 898
(int r, long max, int lab, space sp)
2 7u83 899
{
900
  int rtmp = getreg(sp.fixed);
901
  operate_fmt_immediate(i_cmpule,r,max,rtmp);
902
  integer_branch(i_bne,rtmp,lab);
903
  return;
904
}
905
 
906
 
6 7u83 907
 
2 7u83 908
static bool fdouble_comparisons
6 7u83 909
(instruction *ins, int i)
2 7u83 910
{
911
  bool rev = FALSE;
6 7u83 912
  switch (i) {
2 7u83 913
    case 1:
914
    *ins = i_cmptle;
915
    break;
916
    case 2:
917
    *ins = i_cmptlt;
918
    break;
919
    case 3:
920
    *ins = i_cmptlt;
921
    rev = TRUE;
922
    break;
923
    case 4:
924
    *ins = i_cmptle;
925
    rev = TRUE;
926
    break;
927
    case 5:
928
    *ins = i_cmpteq;
929
    rev = TRUE;
930
    break;
931
    case 6:
932
    *ins = i_cmpteq;
933
    break;
934
    default:
935
    failer("illegal branch");
936
    break;
937
  }
938
  return rev;
939
}
940
 
6 7u83 941
 
2 7u83 942
/*
943
  This function selects an appropriate compare instruction for
944
  the test represented by 'i', returning the instruction name in
945
  the 'ins' parameter.  As the set of instructions available does
946
  not directly cover all the required tests, some instructions
947
  carry out the inverse of the required test.  In these cases, the
948
  return value is TRUE, otherwise it is FALSE.
949
*/
950
static bool comparisons
6 7u83 951
(instruction *ins, shape s, int i)
2 7u83 952
{
953
  bool rev=FALSE;
6 7u83 954
  if ((is_signed(s))) {
2 7u83 955
    /* treat pointer as signed (even though it isn't) */
6 7u83 956
    switch (i) {
2 7u83 957
      case 1:
958
      *ins=i_cmple;
959
      break;
960
      case 2:
961
      *ins = i_cmplt;
962
      break;
963
      case 3:
964
      *ins = i_cmplt;
965
      rev = TRUE;
966
      break;
967
      case 4:
968
      *ins = i_cmple;
969
      rev = TRUE;
970
      break;
971
      case 5:
972
      *ins = i_cmpeq;
973
      rev = TRUE;
974
      break;
975
      case 6:
976
      *ins = i_cmpeq;
977
      break;
978
      default:
979
      failer("illegal branch");
980
      break;
981
    }
982
  }
983
  else{
6 7u83 984
    switch (i) {
2 7u83 985
      case 1:
986
      *ins=i_cmpule;
987
      break;
988
      case 2:
989
      *ins=i_cmpult;
990
      break;
991
      case 3:
992
      *ins=i_cmpult;
993
      rev=TRUE;		/* actually >= */
994
      break;
6 7u83 995
      case 4:
2 7u83 996
      *ins=i_cmpule;	/* actually > */
997
      rev=TRUE;
998
      break;
999
      case 5:
1000
      *ins = i_cmpeq;
1001
      rev = 1;
1002
      break;
1003
      case 6:
1004
      *ins = i_cmpeq;
1005
      break;
1006
      default:
1007
      failer("illegal branch");
1008
    }
1009
  }
1010
  return rev;
1011
}
1012
 
1013
 
6 7u83 1014
 
2 7u83 1015
/*
1016
  conditional moves
1017
*/
1018
static instruction condmove
6 7u83 1019
(int i)
2 7u83 1020
{
6 7u83 1021
  switch (i) {
2 7u83 1022
    case 1:
1023
    return i_cmovle;
1024
    case 2:
1025
    return i_cmovlt;
1026
    case 3:
1027
    return i_cmovge;
1028
    case 4:
1029
    return i_cmovgt;
1030
    case 5:
1031
    return i_cmovne;
1032
    case 6:
1033
    return i_cmoveq;
1034
    default:
1035
    failer("Illegal value for ntest");
1036
  }
1037
  return i_cmovle;
1038
}
1039
/*
1040
static instruction fcondmove
1041
    PROTO_N ( ( i ) )
1042
    PROTO_T ( int i )
1043
{
1044
  switch(i){
1045
   case 1:
1046
    return i_fcmovle;
1047
   case 2:
1048
    return i_fcmovlt;
1049
   case 3:
1050
    return i_fcmovge;
1051
   case 4:
1052
    return i_fcmovgt;
1053
   case 5:
1054
    return i_fcmovne;
1055
   case 6:
1056
    return i_fcmoveq;
1057
 default:
1058
     failer("Illegal value for ntest");
1059
 }
1060
}
1061
*/
1062
 
1063
 
1064
static bool compares
6 7u83 1065
(instruction *ins, shape s, int i)
2 7u83 1066
{
1067
  bool rev=FALSE;
6 7u83 1068
  if (is_signed(s)) {
2 7u83 1069
    /* signed comparison */
6 7u83 1070
    switch (i) {
2 7u83 1071
      case 1:
1072
      *ins= i_cmplt;
1073
      break;
1074
      case 2:
1075
      *ins= i_cmple;
1076
      break;
1077
      case 3:
1078
      *ins= i_cmplt;
1079
      break;
1080
      case 4:
1081
      *ins= i_cmple;
1082
      break;
1083
      case 5:
1084
      *ins= i_cmpeq;
1085
      break;
1086
      case 6:
1087
      *ins= i_cmpeq;
1088
      break;
1089
    }
1090
  }
1091
  else{
6 7u83 1092
    switch (i) {
2 7u83 1093
      case 1:
1094
      *ins= i_cmpult;
1095
      break;
1096
      case 2:
6 7u83 1097
      *ins= i_cmpule;
2 7u83 1098
      break;
1099
      case 3:
1100
      *ins= i_cmpult;
1101
      rev=TRUE;
1102
      break;
1103
      case 4:
1104
      *ins= i_cmpule;
1105
      rev=TRUE;
1106
      break;
1107
      case 5:
1108
      *ins= i_cmpeq;
1109
      break;
1110
      case 6:
1111
      *ins= i_cmpeq;
1112
      break;
1113
    }
1114
  }
1115
  return rev;
1116
}
1117
 
1118
/*
1119
static instruction fbranches
1120
    PROTO_N ( ( i ) )
1121
    PROTO_T ( int i )
1122
{
1123
  switch (i) {
6 7u83 1124
    case  1:
2 7u83 1125
    return i_fble;
6 7u83 1126
    case 2:
2 7u83 1127
    return i_fblt;
6 7u83 1128
    case 3:
2 7u83 1129
    return i_fbge;
6 7u83 1130
    case 4:
2 7u83 1131
    return i_fbgt;
6 7u83 1132
    case 5:
2 7u83 1133
    return i_fbne;
6 7u83 1134
    case 6:
2 7u83 1135
    return i_fbeq;
1136
    default:
1137
    failer("Illegal value for ntest");
1138
  }
1139
}
1140
 
1141
static instruction fdbranches
1142
    PROTO_N ( ( i ) )
1143
    PROTO_T ( int i )
1144
{
1145
  switch (i) {
6 7u83 1146
   case  1:
2 7u83 1147
    return i_fble;
6 7u83 1148
   case 2:
2 7u83 1149
    return i_fblt;
6 7u83 1150
   case 3:
2 7u83 1151
    return i_fbge;
6 7u83 1152
   case 4:
2 7u83 1153
    return i_fbgt;
6 7u83 1154
   case 5:
2 7u83 1155
    return i_fbne;
6 7u83 1156
   case 6:
2 7u83 1157
    return i_fbeq;
1158
   default:
1159
    failer("Illegal value for ntest");
1160
  }
1161
}
1162
*/
1163
long  notbranch[6] = {
1164
  4, 3, 2, 1, 6, 5
1165
};
1166
/* used to invert TDF tests */
1167
 
1168
/*
1169
  count the number of bits set in b.
1170
*/
1171
int bitsin
6 7u83 1172
(int32 b)
2 7u83 1173
{
1174
  int   n = 0;
1175
  int32  mask = 1;
1176
  for (; b != 0;) {
6 7u83 1177
    n += ((b & mask)!= 0)? 1 : 0;
2 7u83 1178
    b &= ~mask;
1179
    mask = mask << 1;
1180
  }
1181
  return n;
1182
}
1183
 
1184
 
1185
/*****************************************************************/
1186
 
1187
/*
6 7u83 1188
  Move sizereg bytes to dest from source using movereg
1189
  bytemove is the maximum number of bytes which can be moved
1190
  in a single instruction if available.
1191
  In order to reduce the time for the operation the function
1192
  attempts to use the most appropriate load & store instructions,
1193
  which requires that the number of bytes remaining to be copied
1194
  and the alignment of the object be taken into account.
1195
  As the code sequence required to generate word (16 bit)
1196
  load/store is prohibitively long, these cases are treated
2 7u83 1197
  as bytes.
1198
*/
1199
 
1200
 
1201
/*
1202
  Without overlap (destination < source)
1203
*/
1204
void move_dlts
6 7u83 1205
(int dest, int src, int sizereg, int movereg, int bytemove, space sp)
2 7u83 1206
{
1207
 
1208
  int qword_lab,lword_lab,word_lab,byte_lab,endlab;
1209
  int rtest = getreg(sp.fixed);
1210
  baseoff b;
1211
  b.offset = 0;
1212
  qword_lab = (bytemove==8)?new_label():-1;
1213
  lword_lab = (bytemove>=4)?new_label():-1;
1214
  word_lab = (bytemove>=2)?new_label():-1;
1215
  byte_lab = new_label();
1216
  endlab = new_label();
6 7u83 1217
  switch (bytemove) {
1218
    case 8:{
2 7u83 1219
      set_label(qword_lab);
1220
      operate_fmt_immediate(i_cmplt,sizereg,8,rtest);
1221
      integer_branch(i_bne,rtest,lword_lab);
1222
      b.base = src;
1223
      load_store(i_ldq,movereg,b);
1224
      b.base = dest;
1225
      load_store(i_stq,movereg,b);
1226
      operate_fmt_immediate(i_addq,src,8,src);
1227
      operate_fmt_immediate(i_addq,dest,8,dest);
1228
      operate_fmt_immediate(i_subq,sizereg,8,sizereg);
1229
      integer_branch(i_beq,sizereg,endlab);
1230
      integer_branch(i_br,31,qword_lab);
1231
    }
1232
    FALL_THROUGH;
6 7u83 1233
    case 4:{
2 7u83 1234
      set_label(lword_lab);
1235
      operate_fmt_immediate(i_cmplt,sizereg,4,rtest);
1236
      integer_branch(i_bne,rtest,byte_lab);
1237
      b.base = src;
1238
      load_store(i_ldl,movereg,b);
1239
      b.base = dest;
1240
      load_store(i_stq,movereg,b);
1241
      operate_fmt_immediate(i_addq,src,4,src);
1242
      operate_fmt_immediate(i_addq,dest,4,dest);
1243
      operate_fmt_immediate(i_subq,sizereg,4,sizereg);
1244
      integer_branch(i_beq,sizereg,endlab);
1245
      integer_branch(i_br,31,lword_lab);
1246
    }
1247
    FALL_THROUGH;
6 7u83 1248
    case 2:
2 7u83 1249
    FALL_THROUGH;
6 7u83 1250
    case 1:{
2 7u83 1251
      int rtmp = getreg(sp.fixed);
1252
      int rtmp2 = getreg(sp.fixed);
1253
      set_label(byte_lab);
1254
      integer_branch(i_beq,sizereg,endlab);
1255
      b.base=src;
1256
      load_store(i_ldq_u,movereg,b);
1257
      setnoat();
1258
      load_store(i_lda,AT,b);
1259
      operate_fmt(i_extbl,movereg,AT,movereg);
1260
      b.base=dest;
1261
      load_store(i_lda,AT,b);
1262
      load_store(i_ldq_u,rtmp,b);
1263
      operate_fmt(i_insbl,movereg,AT,rtmp2);
1264
      operate_fmt(i_mskbl,rtmp,AT,rtmp);
1265
      setat();
1266
      operate_fmt(i_bis,rtmp,rtmp2,rtmp);
1267
      load_store(i_stq_u,rtmp,b);
1268
      operate_fmt_immediate(i_addq,src,1,src);
1269
      operate_fmt_immediate(i_addq,dest,1,dest);
1270
      operate_fmt_immediate(i_subq,sizereg,1,sizereg);
1271
      integer_branch(i_bne,sizereg,byte_lab);
1272
    }
1273
  }
1274
  set_label(endlab);
1275
  return;
1276
}
1277
 
1278
 
1279
/*
1280
  With overlap (destination > src)
1281
*/
1282
void move_dgts
6 7u83 1283
(int dest, int src, int sizereg, int movereg, int bytemove, space sp)
2 7u83 1284
{
1285
  int qword_lab,lword_lab,word_lab,byte_lab,endlab;
1286
  int rtest = getreg(sp.fixed);
1287
  baseoff b;
1288
  b.offset = 0;
1289
  qword_lab = (bytemove==8)?new_label():-1;
1290
  lword_lab = (bytemove>=4)?new_label():-1;
1291
  word_lab = (bytemove>=2)?new_label():-1;
1292
  byte_lab = new_label();
1293
  endlab = new_label();
1294
  operate_fmt(i_addq,dest,sizereg,dest);
1295
  operate_fmt(i_addq,src,sizereg,src);
6 7u83 1296
  switch (bytemove) {
1297
    case 8:{
2 7u83 1298
      b.offset = -8;
1299
      set_label(qword_lab);
1300
      operate_fmt_immediate(i_cmplt,sizereg,8,rtest);
1301
      integer_branch(i_bne,rtest,lword_lab);
1302
      b.base = src;
1303
      load_store(i_ldq,movereg,b);
1304
      b.base = dest;
1305
      load_store(i_stq,movereg,b);
1306
      operate_fmt_immediate(i_subq,src,8,src);
1307
      operate_fmt_immediate(i_subq,dest,8,dest);
1308
      operate_fmt_immediate(i_subq,sizereg,8,sizereg);
1309
      integer_branch(i_beq,sizereg,endlab);
1310
      integer_branch(i_br,31,qword_lab);
1311
    }
1312
    FALL_THROUGH;
6 7u83 1313
    case 4:{
2 7u83 1314
      b.offset = -4;
1315
      set_label(lword_lab);
1316
      operate_fmt_immediate(i_cmplt,sizereg,4,rtest);
1317
      integer_branch(i_bne,rtest,byte_lab);
1318
      b.base = src;
1319
      load_store(i_ldl,movereg,b);
1320
      b.base = dest;
1321
      load_store(i_stq,movereg,b);
1322
      operate_fmt_immediate(i_subq,src,4,src);
1323
      operate_fmt_immediate(i_subq,dest,4,dest);
1324
      operate_fmt_immediate(i_subq,sizereg,4,sizereg);
1325
      integer_branch(i_beq,sizereg,endlab);
1326
      integer_branch(i_br,31,lword_lab);
1327
    }
1328
    FALL_THROUGH;
6 7u83 1329
    case 2:
2 7u83 1330
    FALL_THROUGH;
6 7u83 1331
    case 1:{
2 7u83 1332
      int rtmp = getreg(sp.fixed);
1333
      int rtmp2 = getreg(sp.fixed);
1334
      b.offset = -1;
1335
      set_label(byte_lab);
1336
      integer_branch(i_beq,sizereg,endlab);
1337
      b.base=src;
1338
      load_store(i_ldq_u,movereg,b);
1339
      setnoat();
1340
      load_store(i_lda,AT,b);
1341
      operate_fmt(i_extbl,movereg,AT,movereg);
1342
      b.base=dest;
1343
      load_store(i_lda,AT,b);
1344
      load_store(i_ldq_u,rtmp,b);
1345
      operate_fmt(i_insbl,movereg,AT,rtmp2);
1346
      operate_fmt(i_mskbl,rtmp,AT,rtmp);
1347
      setat();
1348
      operate_fmt(i_bis,rtmp,rtmp2,rtmp);
1349
      load_store(i_stq_u,rtmp,b);
1350
      operate_fmt_immediate(i_subq,src,1,src);
1351
      operate_fmt_immediate(i_subq,dest,1,dest);
1352
      operate_fmt_immediate(i_subq,sizereg,1,sizereg);
1353
      integer_branch(i_bne,sizereg,byte_lab);
1354
    }
1355
  }
1356
  set_label(endlab);
1357
  return;
1358
}
1359
 
1360
/****************************************************************/
1361
 
1362
 
6 7u83 1363
 
1364
 
2 7u83 1365
static void reset_tos
6 7u83 1366
(void)
2 7u83 1367
{
6 7u83 1368
  if (Has_tos) {
2 7u83 1369
    baseoff b;
1370
    b.base = FP;
6 7u83 1371
    b.offset = - ((PTR_SZ>>3)*2) - arg_stack_space;
2 7u83 1372
    load_store(i_stq,SP,b);
1373
  }
1374
  return;
1375
}
1376
 
6 7u83 1377
 
1378
 
2 7u83 1379
/*
6 7u83 1380
  This function finds the last test in the sequence e which is
2 7u83 1381
  a branch to second, if any exists, otherwise it returns nil.
1382
*/
1383
static exp testlast
6 7u83 1384
(exp e, exp second)
2 7u83 1385
{
6 7u83 1386
  if (name(e) == test_tag && pt(e) == second) {
1387
    return(e);
2 7u83 1388
  }
6 7u83 1389
  if (name(e) == seq_tag) {
1390
    if (name(bro(son(e))) == test_tag && pt(bro(son(e))) == second) {
1391
      return bro(son(e));
2 7u83 1392
    }
6 7u83 1393
    else if (name(bro(son(e))) == top_tag) {
1394
      exp list = son(son(e));
2 7u83 1395
      for (;;) {
6 7u83 1396
	if (last(list)) {
1397
	  if (name(list) == test_tag && pt(list) == second) {
2 7u83 1398
	    return list;
1399
	  }
1400
	  else {
1401
	    return 0;
1402
	  }
1403
	}
1404
	else {
6 7u83 1405
	  list = bro(list);
2 7u83 1406
	}
1407
      }
1408
    }
1409
  }
1410
  return 0;
1411
}
1412
 
1413
 
1414
bool last_param
6 7u83 1415
(exp e)
2 7u83 1416
{
1417
  bool res=0;
6 7u83 1418
  if (isparam(e)) {
2 7u83 1419
    e = bro(son(e));
6 7u83 1420
    while (name(e) == diagnose_tag)
2 7u83 1421
      e = son(e);
6 7u83 1422
    if ((name(e)!= ident_tag) || !isparam(e) ||
1423
       name(son(e)) ==formal_callee_tag)
2 7u83 1424
      res=1;
1425
  }
1426
  return res;
1427
}
1428
 
1429
 
1430
void test_unsigned
6 7u83 1431
(int reg, unsigned long upper, unsigned trap)
2 7u83 1432
{
1433
  setnoat();
1434
  operate_fmt_big_immediate(i_cmpule,reg,upper,AT);
1435
  integer_branch(i_beq,AT,trap);
1436
  setat();
1437
  return;
1438
}
1439
 
1440
void test_signed
6 7u83 1441
(int reg, long lower, long upper, int trap)
2 7u83 1442
{
1443
  setnoat();
1444
  operate_fmt_big_immediate(i_cmplt,reg,lower,AT);
1445
  integer_branch(i_bne,AT,trap);
1446
  operate_fmt_big_immediate(i_cmple,reg,upper,AT);
1447
  integer_branch(i_beq,AT,trap);
1448
  setat();
1449
  return;
1450
}
1451
 
1452
 
1453
void test_signed_and_trap
6 7u83 1454
(int reg, long lower, long upper, int except)
2 7u83 1455
{
1456
  int ok_lab = new_label();
1457
  int jump_label = new_label();
6 7u83 1458
 
2 7u83 1459
  setnoat();
1460
  operate_fmt_big_immediate(i_cmplt,reg,lower,AT);
1461
  integer_branch(i_bne,AT,jump_label);
1462
  operate_fmt_big_immediate(i_cmple,reg,upper,AT);
1463
  integer_branch(i_beq,AT,jump_label);
1464
  setat();
1465
  integer_branch(i_br,31,ok_lab);
1466
  set_label(jump_label);
1467
  do_exception(except);
1468
  set_label(ok_lab);
1469
  return;
1470
}
1471
 
1472
void test_unsigned_and_trap
6 7u83 1473
(int reg, unsigned long upper, unsigned except)
2 7u83 1474
{
1475
  int ok_lab = new_label();
1476
  setnoat();
1477
  operate_fmt_big_immediate(i_cmpule,reg,upper,AT);
1478
  integer_branch(i_bne,AT,ok_lab);
1479
  setat();
1480
  do_exception(except);
1481
  set_label(ok_lab);
1482
  return;
1483
}
1484
 
1485
 
1486
 
1487
 
1488
/*
1489
  This function returns a register for use as a destination operand.
6 7u83 1490
  If the final destination is in a register then that register is
2 7u83 1491
  returned, otherwise a new register is selected from the pool.
1492
*/
1493
int regfrmdest
6 7u83 1494
(where *dest, space sp)
2 7u83 1495
{
1496
  switch (dest->answhere.discrim) {
6 7u83 1497
    case inreg:{
1498
      return regalt(dest->answhere);
2 7u83 1499
    }
1500
    default :{
6 7u83 1501
      return getreg(sp.fixed);
2 7u83 1502
    }
1503
  }
6 7u83 1504
}
2 7u83 1505
 
1506
 
1507
freg fregfrmdest
6 7u83 1508
(where *dest, space sp)
2 7u83 1509
{
1510
  switch (dest->answhere.discrim) {
6 7u83 1511
    case infreg: {
2 7u83 1512
      return fregalt(dest->answhere);
1513
    }
1514
    default : {
1515
      freg fr;
1516
      fr.fr = getfreg(sp.flt);
1517
      fr.type = IEEE_double;
1518
      return fr;
1519
    }
1520
  }
1521
}
1522
 
1523
 
1524
/*
6 7u83 1525
  Divide dividend by divisor using the divide instructions supplied
2 7u83 1526
  by the the assembler.  These divide instructions corrupt the t-regs
1527
  23,24,25,27(PV), and 28(AT) which have to be protected if in use.
1528
  Returns result register.
1529
*/
1530
static int divide_using_div
6 7u83 1531
(exp div, exp dividend, exp divisor, where dest, space sp, instruction div_ins)
2 7u83 1532
{
1533
  int r_result;
1534
  space newsp;
1535
  int r_dividend,r_divisor;
1536
  int uns;
1537
  newsp = guardreg(AT,sp);
1538
  uns = !is_signed(sh(dividend));
1539
  r_result = regfrmdest(&dest,newsp);
6 7u83 1540
  if (r_result == NO_REG) {
2 7u83 1541
    r_result = getreg(newsp.fixed);
1542
  }
1543
  newsp = guardreg(r_result,newsp);
1544
  r_dividend = reg_operand(dividend,newsp);
1545
  clear_reg(AT),clear_reg(23),clear_reg(24),clear_reg(25),clear_reg(27);
1546
  newsp = guardreg(r_dividend,newsp);
6 7u83 1547
  if (r_result == NO_REG)r_result = getreg(newsp.fixed);
1548
  if (name(divisor) == val_tag && optop(div)) {
2 7u83 1549
    r_divisor = no(divisor);
1550
  }
1551
  else{
1552
    r_divisor = reg_operand(divisor,newsp);
1553
  }
1554
  if (!optop(div) && !error_treatment_is_trap(div)) {
1555
    /* test for (-inf)/-1 and /0 */
1556
    int over = new_label();
1557
    int trap = trap_label(div);
1558
    integer_branch(i_beq,r_divisor,trap);
6 7u83 1559
    if (!(is_signed(sh(div)))) {
2 7u83 1560
      int rt=getreg(newsp.fixed);
1561
      comment(" check unsigned overflow ");
1562
      operate_fmt_immediate(i_cmpeq,r_divisor,-1,rt);
1563
      integer_branch(i_bne,rt,trap);
1564
      set_label(over);
1565
    }
1566
  }
1567
 
6 7u83 1568
  if (!optop(div) && is_signed(sh(div)) && (is64(sh(div)) || is32(sh(div)))) {
2 7u83 1569
    int continue_lab = new_label();
1570
    setnoat();
1571
    operate_fmt_immediate(i_cmpeq,r_divisor,-1,AT);
1572
    integer_branch(i_beq,AT,continue_lab);
1573
    operate_fmt_big_immediate(i_cmpeq,r_dividend,maxmin(sh(div)).mini,AT);
1574
    integer_branch(i_beq,AT,continue_lab);
6 7u83 1575
    if (error_treatment_is_trap(div)) {
2 7u83 1576
      do_exception(f_overflow);
1577
    }
1578
    else{
1579
      integer_branch(i_br,31,trap_label(div));
1580
    }
1581
    set_label(continue_lab);
1582
    setat();
1583
  }
6 7u83 1584
 
1585
  if ((name(divisor)!= val_tag) || !optop(div)) {
2 7u83 1586
    operate_fmt(div_ins,r_dividend,r_divisor,r_result);
1587
  }
1588
  else{
1589
    operate_fmt_immediate(div_ins,r_dividend,r_divisor,r_result);
1590
  }
6 7u83 1591
  if (name(div) == div1_tag) {
2 7u83 1592
    int rem_neg = new_label();
1593
    int exitlab = new_label();
1594
    int rrem = getreg(newsp.fixed);
6 7u83 1595
    if ((name(divisor)!= val_tag) || !optop(div)) {
2 7u83 1596
      operate_fmt(((uns)?((is64(sh(div)))?i_remqu:i_remlu):
6 7u83 1597
		  (is64(sh(div)))?i_remq:i_reml),
2 7u83 1598
		  r_dividend,r_divisor,rrem);
1599
    }
1600
    else {
1601
      operate_fmt_immediate(((uns)?((is64(sh(div)))?i_remqu:i_remlu):
6 7u83 1602
			    (is64(sh(div)))?i_remq:i_reml),
2 7u83 1603
			    r_dividend,r_divisor,rrem);
1604
    }
6 7u83 1605
 
2 7u83 1606
    integer_branch(i_beq,rrem,exitlab);
1607
    integer_branch(i_blt,rrem,rem_neg);
1608
    /*set_label(rem_pos);*/
1609
    integer_branch(i_bge,r_divisor,exitlab);
1610
    operate_fmt_immediate((is64(sh(div)))?i_addq:i_addl,r_result,-1,r_result);
1611
    integer_branch(i_br,31,exitlab);
1612
    set_label(rem_neg);
1613
    integer_branch(i_ble,r_divisor,exitlab);
1614
    operate_fmt_immediate((is64(sh(div)))?i_addq:i_addl,r_result,-1,r_result);
1615
    set_label(exitlab);
1616
  }
6 7u83 1617
  if (!optop(div)) {
1618
    switch (name(sh(div))) {
1619
      case ucharhd:{
1620
	if (error_treatment_is_trap(div)) {
2 7u83 1621
	  test_unsigned_and_trap(r_result,255,f_overflow);
1622
	}
1623
	else {
1624
	  test_unsigned(r_result,255,trap_label(div));
1625
	}
1626
	break;
1627
      }
6 7u83 1628
      case scharhd:{
1629
	if (error_treatment_is_trap(div)) {
2 7u83 1630
	  test_signed_and_trap(r_result,-128,127,f_overflow);
1631
	}
1632
	else{
1633
	  test_signed(r_result,-128,127,trap_label(div));
1634
	}
1635
	break;
1636
      }
6 7u83 1637
      case uwordhd:{
1638
	if (error_treatment_is_trap(div)) {
2 7u83 1639
	  test_unsigned_and_trap(r_result,0xffff,f_overflow);
1640
	}
1641
	else {
1642
	  test_unsigned(r_result,0xffff,trap_label(div));
1643
	}
1644
	break;
1645
      }
6 7u83 1646
      case swordhd: {
1647
	if (error_treatment_is_trap(div)) {
2 7u83 1648
	  test_signed_and_trap(r_result,-0x8000,0x7fff,f_overflow);
1649
	}
1650
	else {
1651
	  test_signed(r_result,-0x8000,0x7fff,trap_label(div));
1652
	}
1653
	break;
1654
      }
6 7u83 1655
      case ulonghd:{
1656
	if (error_treatment_is_trap(div)) {
2 7u83 1657
	  test_unsigned_and_trap(r_result,0xffffffff,f_overflow);
1658
	}
1659
	else{
1660
	  test_unsigned(r_result,0xffffffff,trap_label(div));
1661
	}
1662
	break;
1663
      }
6 7u83 1664
      case slonghd:{
1665
	if (error_treatment_is_trap(div)) {
2 7u83 1666
	  test_signed_and_trap(r_result,-0x80000000L,0x7fffffff,f_overflow);
1667
	}
1668
	else{
1669
	  test_signed(r_result,-0x80000000L,0x7fffffff,trap_label(div));
1670
	}
1671
	break;
1672
      }
6 7u83 1673
      case s64hd:{
1674
	if (error_treatment_is_trap(div)) {
2 7u83 1675
	  test_signed_and_trap(r_result,-0x8000000000000000L,0x7fffffffffffffffL
6 7u83 1676
			       ,f_overflow);
2 7u83 1677
	}
1678
	else{
1679
	  test_signed(r_result,-0x8000000000000000L,0x7fffffffffffffffL
1680
		      ,trap_label(div));
1681
	}
1682
	break;
1683
      }
6 7u83 1684
      case u64hd:{
1685
	if (error_treatment_is_trap(div)) {
2 7u83 1686
	  test_unsigned_and_trap(r_result,0xffffffffffffffffL,f_overflow);
1687
	}
1688
	else{
1689
	  test_unsigned(r_result,0xffffffffffffffffL,trap_label(div));
1690
	}
1691
	break;
1692
      }
1693
      default:failer("Illegal shape in div");
1694
    }
1695
  }
1696
  return r_result;
1697
}
1698
 
6 7u83 1699
 
2 7u83 1700
static int proc_has_vararg;
1701
 
1702
 
1703
/*
6 7u83 1704
  Process a parameter list
2 7u83 1705
*/
1706
space do_callers
6 7u83 1707
(exp list, space sp, int *sizecallers)
2 7u83 1708
{
1709
  int disp;
1710
  int spar;
1711
  int fpar = 16;
1712
  ash ansash;
1713
  bool hadfixed;
1714
  instore is;
1715
  is.b.base = SP;
1716
  is.b.offset = 0;
1717
  is.adval = 1;
6 7u83 1718
 
2 7u83 1719
#ifdef DO_SPECIAL
1720
  if ((disp = specialfn (fn)) > 0) { /* eg function is strlen */
6 7u83 1721
    mka.lab = specialmake(disp, list, sp, dest, exitlab);
2 7u83 1722
    return mka;
1723
  }
1724
#endif
6 7u83 1725
  ansash = ashof(sh(list));
2 7u83 1726
  disp = 0;
1727
  spar = FIRST_INT_ARG;/* register holding 1st integer parameter */
1728
  hadfixed = 0;
1729
  for (;;) {		/* evaluate parameters in turn */
6 7u83 1730
    int   hd = name(sh(list));
2 7u83 1731
    where w;
1732
    ash ap;
1733
    int paral;
1734
    int parsize;
6 7u83 1735
    ap = ashof(sh(list));
2 7u83 1736
    paral = (ap.ashalign < 32)?32:ap.ashalign;
6 7u83 1737
    if (spar>21) {
2 7u83 1738
      ap.ashalign=64;
1739
      paral = 64;
1740
    }
1741
    parsize = ap.ashsize;
1742
    /* all parameters passed on stack are quadword aligned */
1743
    w.ashwhere = ap;
1744
    disp = rounder(disp,paral);
1745
    spar = FIRST_INT_ARG+ (disp>>6);
1746
    fpar = FIRST_FLOAT_ARG+ (disp>>6);
1747
    if (disp>448) {spar =22; fpar = 22; }
1748
    if (is_floating(hd) && disp+parsize <= 384) {
1749
      freg frg;
1750
      ans ansfr;
1751
      frg.fr = fpar++;
6 7u83 1752
      if (hd != shrealhd)
2 7u83 1753
	frg.type = IEEE_double;
1754
      else
1755
	frg.type = IEEE_single;
6 7u83 1756
      setfregalt(ansfr, frg);
2 7u83 1757
      w.answhere = ansfr;
6 7u83 1758
      code_here(list, sp, w);
2 7u83 1759
      /* evaluate parameter into floating parameter register */
1760
      sp = guardfreg(frg.fr, sp);
1761
    }
6 7u83 1762
    else if (((valregable(sh(list)) || (name(sh(list)) ==cpdhd)) ||
1763
	    (name(sh(list)) ==nofhd)) && spar<=21) {
2 7u83 1764
      /* compound types are always passed in registers
1765
	 (given enough space). */
1766
      ans ansr;
1767
      int par_reg;
6 7u83 1768
      int numleft = parsize- ((LAST_INT_ARG-spar+1) <<6);
1769
      int pregs_used = min((numleft>>6) +6,6);
2 7u83 1770
      hadfixed=1;
1771
      setregalt(ansr,spar);
1772
      w.answhere=ansr;
6 7u83 1773
      for (par_reg=spar;par_reg<spar+pregs_used;++par_reg) {
2 7u83 1774
	sp = guardreg(par_reg,sp);
1775
      }
1776
      sp = guardreg(spar,sp);
1777
      code_here(list,sp,w);
6 7u83 1778
      if (numleft>0) {
2 7u83 1779
	is.b.offset+=(numleft>>3); /* += number of bytes remaining */
1780
      }
1781
    }
1782
    else {
6 7u83 1783
      /* pass remaining parameters on the stack.
1784
	 The parameters are aligned on 8 byte boundaries.
2 7u83 1785
	 */
6 7u83 1786
      setinsalt(w.answhere, is);
1787
      is.b.offset+= (max(ap.ashsize,REG_SIZE) >>3);
2 7u83 1788
      /* 'size' was used here */
6 7u83 1789
      code_here(list, sp, w);
2 7u83 1790
      hadfixed = 1;
1791
      /* eval parameter into argument space on stack */
6 7u83 1792
    }
1793
    if (name(list) == caller_tag) {
2 7u83 1794
      no(list) = disp;
1795
    }
1796
    disp+=parsize;
1797
    disp = rounder(disp, REG_SIZE);
1798
    *sizecallers = min(disp,NUM_PARAM_REGS*REG_SIZE);
6 7u83 1799
    if (last(list)) return sp;
1800
    list = bro(list);
2 7u83 1801
  } /* end for */
1802
  return sp;
1803
}
1804
 
1805
 
1806
void load_reg
6 7u83 1807
(exp e, int r, space sp)
2 7u83 1808
{
1809
  where w;
1810
  w.ashwhere = ashof(sh(e));
1811
  setregalt(w.answhere,r);
1812
  code_here(e,sp,w);
1813
  return;
1814
}
1815
 
1816
 
1817
 
1818
static postlude_chain * old_postludes;
1819
 
1820
void update_plc
6 7u83 1821
(postlude_chain *chain, int ma)
2 7u83 1822
{
6 7u83 1823
  while (chain) {
2 7u83 1824
    exp pl = chain->postlude;
1825
    while (name(pl) == ident_tag && name(son(pl)) == caller_name_tag) {
1826
      no(pl) += (ma<<1);
1827
      pl = bro(son(pl));
1828
    }
1829
    chain = chain->outer;
1830
  }
1831
  return;
1832
}
1833
 
1834
 
1835
/*
1836
  This function finds the caller_tag corresponding to a caller_name tag
1837
*/
1838
exp find_ote
6 7u83 1839
(exp name, int n)
2 7u83 1840
{
1841
  exp dad = father(name);
6 7u83 1842
  while (name(dad)!= apply_general_tag) {
2 7u83 1843
    dad = father(dad);
1844
  }
1845
  dad = son(bro(son(dad)));
6 7u83 1846
  while (n) {
2 7u83 1847
    dad = bro(dad);
6 7u83 1848
    n --;
2 7u83 1849
  }
1850
  Assert(name(dad) == caller_tag);
1851
  return dad;
1852
}
1853
 
1854
 
1855
 
1856
/*
6 7u83 1857
  This function produces code for expression e, evaluating
2 7u83 1858
  its result into dest.
1859
*/
1860
makeans make_code
6 7u83 1861
(exp e, space sp, where dest, int exitlab)
2 7u83 1862
{
1863
  INT64  constval;
1864
  makeans mka;
1865
  static int param_stack_space;
1866
  static int sizecallers = 0;
6 7u83 1867
tailrecurse:
2 7u83 1868
  mka.lab = exitlab;
1869
  mka.regmove = NOREG;
1870
  clear_INT64(constval);
6 7u83 1871
 
1872
  switch (name(e)) {
1873
    case ident_tag: {
2 7u83 1874
      where placew;
1875
      int   r = NOREG;
1876
      bool remember = 0;
1877
      placew = nowhere;
6 7u83 1878
 
1879
      if (name(sh(son(e))) == ptrhd && name(son(e))!= cont_tag) {
2 7u83 1880
	/* We should never be identifing a pointer to bits */
1881
	if (al1(sh(son(e))) == 1) {
1882
#if 0
6 7u83 1883
	  failer("Identify REF BITS");
2 7u83 1884
#endif
6 7u83 1885
	}
2 7u83 1886
      }
6 7u83 1887
      if (is_param_reg(no(e)) && is32(sh(son(e))) &&
1888
	 name(son(e))!=formal_callee_tag) {
2 7u83 1889
	operate_fmt_immediate(i_addl,no(e),0,no(e));
1890
      }
6 7u83 1891
      if (props(e) & defer_bit) {
2 7u83 1892
	/* the tag of this declaration is
1893
	   transparently identified with its
1894
	   definition, without reserving more
1895
	   space */
6 7u83 1896
	e = bro(son(e));
2 7u83 1897
	goto tailrecurse;
1898
      }
6 7u83 1899
      if (son(e) == nilexp) {
2 7u83 1900
	placew = nowhere;	/* is this needed? */
1901
      }
6 7u83 1902
      else if (name(son(e)) == caller_name_tag) {
2 7u83 1903
	exp ote = find_ote(e,no(son(e)));
1904
	int disp = no(ote);
6 7u83 1905
	if (in_vcallers_apply) {
2 7u83 1906
	  /* bit of a hack here */
6 7u83 1907
	  if (is_floating(name(sh(son(e))))) {
1908
	    no(e) = (((disp-sizecallers) >>3) <<4) + SP;
2 7u83 1909
	  }
1910
	  else {
6 7u83 1911
	    no(e) = (((disp - 6*PTR_SZ) >>3) <<4) +SP;
2 7u83 1912
	  }
1913
	}
1914
	else {
6 7u83 1915
	  no(e) = (((disp-sizecallers) >>3) <<4) + SP;
2 7u83 1916
	}
1917
	placew = nowhere;
1918
      }
1919
      else {
1920
	ash a;
6 7u83 1921
	int   n = no(e);
1922
	a = ashof(sh(son(e)));
1923
	if (is_param_reg(n) && (props(e) &inreg_bits) && proc_has_vararg) {
2 7u83 1924
	  props(e) &= (~inreg_bits);
1925
	}
6 7u83 1926
	if (((props(e) & inreg_bits)!= 0)) {
2 7u83 1927
	  /* tag in some fixed pt reg */
6 7u83 1928
	  if (n == NO_REG) {
2 7u83 1929
	    /* if it hasn't been already allocated
1930
	       into a s-reg (or r0) allocate tag into
1931
	       fixed t-reg ... */
1932
	    int   s = sp.fixed;
1933
	    if (props (e) & notparreg)/* ... but not a parameter reg */
1934
	      s |= PARAM_REGS;
1935
	    n = getreg(s);
6 7u83 1936
	    no(e) = n;
2 7u83 1937
	  }
6 7u83 1938
	  setregalt(placew.answhere, n);
2 7u83 1939
	}
6 7u83 1940
	else if ((props(e) & infreg_bits)!= 0) {
2 7u83 1941
	  /* tag in some float reg */
1942
	  freg frg;
6 7u83 1943
	  if (n == NO_REG) {
2 7u83 1944
	    /* if it hasn't been already allocated
1945
	       into a s-reg (or r0) allocate tag into
1946
	       float-reg ... */
1947
	    int s = sp.flt;
6 7u83 1948
	    if (props(e) & notparreg)
2 7u83 1949
	      s |= 0xc0;
6 7u83 1950
	    n = getfreg(s);
1951
	    no(e) = n;
2 7u83 1952
	  }
1953
	  frg.fr = n;
6 7u83 1954
	  if (a.ashsize == 64)
2 7u83 1955
	    frg.type = IEEE_double;
1956
	  else
1957
	    frg.type = IEEE_single;
6 7u83 1958
	  setfregalt(placew.answhere, frg);
2 7u83 1959
	}
1960
	else if (isparam(e)) {
6 7u83 1961
	  if (name(son(e))!= formal_callee_tag) {
2 7u83 1962
	    instore is;
1963
	    int this_reg=-1;
1964
	    int comp_size;
6 7u83 1965
	    /* floating point registers are to be separated
1966
	       from fixed point registers when saving to the
2 7u83 1967
	       stack  */
1968
	    int n;
1969
	    int offset_adjustment;
6 7u83 1970
	    if (proc_has_vararg && !is_floating(name(sh(son(e))))) {
2 7u83 1971
	      offset_adjustment = 6 * PTR_SZ;
1972
	    }
1973
	    else {
1974
	      offset_adjustment = arg_stack_space *8;
1975
	    }
6 7u83 1976
 
1977
	    if (Has_fp) {
1978
	      n = (no(son(e)) >>3) - (offset_adjustment>>3);
2 7u83 1979
	    }
1980
	    else{
6 7u83 1981
	      n= (((no(son(e)) +frame_size+callee_size-offset_adjustment) >>3));
2 7u83 1982
	    }
6 7u83 1983
 
1984
	    if (props(son(e))) {
1985
	      this_reg = (props(son(e)) -16) <<6;
2 7u83 1986
	    }
1987
	    /* save all parameters in 64 bit chunks */
1988
	    /* Byte disp of params */
1989
	    is.b.offset = n;
1990
	    is.b.base = (Has_fp)?FP:SP;
1991
	    is.adval =1;
1992
	    setinsalt(placew.answhere, is);
6 7u83 1993
	    if (Has_fp) {
1994
	      if (Has_no_vcallers || is_floating(name(sh(son(e))))) {
1995
		no(e) = ((no(son(e)) +frame_size+callee_size-locals_offset-
1996
			 (offset_adjustment)) <<1) +FP;
2 7u83 1997
	      }
1998
	      else{
1999
		no(e) = ((no(son(e)) + frame_size + callee_size -locals_offset
6 7u83 2000
			  - (arg_stack_space<<3)) <<1) +FP;
2 7u83 2001
		no(e) = ((no(son(e)) + frame_size + callee_size -locals_offset
6 7u83 2002
			  - (offset_adjustment)) <<1) +FP;
2 7u83 2003
	      }
2004
	    }
2005
	    else{
6 7u83 2006
	      no(e) = ((no(son(e)) +frame_size+callee_size-locals_offset -
2007
		     (offset_adjustment)) <<1) +SP;
2 7u83 2008
	    }
6 7u83 2009
 
2010
	    if ((a.ashsize>64) && (this_reg != -1)) {
2011
	      for (comp_size=a.ashsize;(comp_size>0) && (this_reg<384);
2012
				      comp_size -= 64) {
2 7u83 2013
		load_store(i_stq,16+ (this_reg>>6),is.b);
2014
		this_reg+=64;
2015
		is.b.offset+=8;
2016
	      }
2017
				      /*props(son(e))=0;*/ /* ensures it wont be saved again */
2018
	    }
6 7u83 2019
	    if (proc_has_vararg && last_param(e) && (this_reg>=0)) {
2 7u83 2020
	      /* attempt to detect vararg */
6 7u83 2021
	      int r = rounder(no(son(e)) +shape_size(sh(son(e))), REG_SIZE);
2 7u83 2022
	      setinsalt(placew.answhere,is);
6 7u83 2023
	      for (r=this_reg;r<=320;r+=64) {
2 7u83 2024
		/* no need to save first freg */
6 7u83 2025
		is.b.offset = ((r+paramsdumpstart) >>3) -
2026
		 ((is.b.base == FP)?(frame_size>>3):0);
2027
		float_load_store(i_stt,16+ (r>>6),is.b);
2 7u83 2028
	      }
6 7u83 2029
	      for (r=this_reg;r<=320;r+=64) {
2030
		is.b.offset = ((r+gpdumpstart) >>3) -
2031
		 ((is.b.base == FP)?(frame_size>>3):0);;
2032
		load_store(i_stq,16+ (r>>6),is.b);
2 7u83 2033
	      }
6 7u83 2034
	      is.b.offset = n;
2 7u83 2035
	    }
2036
	    else{
6 7u83 2037
	      if ((name(sh(son(e))) ==cpdhd) && (a.ashsize==64)) {
2038
		/* the alignment of a complex shape is the
2039
		   maximum of the alignments of its components.
2040
		   This assignment overrides that rule in order
2 7u83 2041
		   to simplify saving the parameter to the stack.
2042
		   */
2043
		a.ashalign=a.ashsize;
6 7u83 2044
	      }
2045
	      is.b.offset = n;
2 7u83 2046
	    }
2047
	    setinsalt(placew.answhere, is);
2048
	    remember =1;
2049
	  }
2050
	  else{
6 7u83 2051
	    no(e) = ((no(son(e)) + frame_size - locals_offset) <<1) +
2052
	     ((Has_vcallees)?local_reg:FP);
2053
	    if (!Has_vcallees) {
2 7u83 2054
	      no(e) -= (arg_stack_space<<4);
2055
	    }
2056
	    placew = nowhere;
2057
	  }
2058
	}
2059
	else {		/* allocate on stack */
2060
	  int   base = n & 0x3f;
2061
	  instore is;
2062
	  is.b.base = base;
2063
	  is.b.offset = (n - base) >> 4;
2064
	  is.adval = 1;
6 7u83 2065
	  if (base == SP) {
2 7u83 2066
	    is.b.offset += locals_offset >> 3;
2067
	  }
6 7u83 2068
	  else if ((base == FP && Has_fp)) {
2 7u83 2069
#if 1
6 7u83 2070
	    is.b.offset += (((locals_offset-callee_size-frame_size) >>3)
2 7u83 2071
			    /*- ((in_general_proc)?0:arg_stack_space)*/);
2072
#else
6 7u83 2073
	    is.b.offset += (((locals_offset-callee_size-frame_size) >>3)
2 7u83 2074
			    -arg_stack_space);
2075
#endif
2076
	  }
6 7u83 2077
	  else if ((base == local_reg && Has_vcallees)) {
2078
	    is.b.offset += ((locals_offset-frame_size) >>3);
2 7u83 2079
	  }
2080
	  setinsalt(placew.answhere,is);
2081
	  remember = 1;
2082
	}
6 7u83 2083
 
2 7u83 2084
	placew.ashwhere = a;
2085
      }
6 7u83 2086
      if (isparam(e) && name(son(e))!= formal_callee_tag) {
2 7u83 2087
	exp se = son(e);
2088
	exp d = e;
2089
	/* parameter fiddles */
6 7u83 2090
	if (props(se) == 0 && (props(d) & inanyreg)!=0) {
2 7u83 2091
	  /* not originally in required reg */
2092
	  ans a;
2093
	  instore is;
2094
	  is.b.base = (Has_fp)?FP:SP;
6 7u83 2095
	  is.b.offset = ((no(se) - (arg_stack_space<<3)) +
2096
	   ((Has_fp)?0:((callee_size+frame_size)))) >>3;
2097
 
2098
 
2 7u83 2099
	  is.adval = 0;
2100
	  setinsalt(a, is);
6 7u83 2101
	 (void)move(a,placew, sp, name(sh(se)) & 1);
2 7u83 2102
	}
6 7u83 2103
	else if (props(se)!=0 && (props(d) & inanyreg) ==0) {
2 7u83 2104
	  /* originally in reg and required in store */
2105
	  ans a;
6 7u83 2106
	  if (is_floating(name(sh(se)))) {
2 7u83 2107
	    freg fr;
2108
	    fr.fr = props(se);
6 7u83 2109
	    if (name(sh(se))!=shrealhd)
2 7u83 2110
	      fr.type = IEEE_double;
2111
	    else
2112
	      fr.type = IEEE_single;
2113
	    setfregalt(a, fr);
6 7u83 2114
	  }
2 7u83 2115
	  else { setregalt(a, props(se)); }
2116
	  r = move(a, placew, sp, 0);
2117
	}
6 7u83 2118
	else if (props(se)!=0 && props(se)!= no(d)) {
2 7u83 2119
	  /* in wrong register */
2120
	  int sr = no(d);
2121
	  int tr = props(se);
6 7u83 2122
	  if (is_floating(name(sh(se)))) {
2123
	    if ((fltdone & (1<< (sr)))!= 0) {
2124
	      float_op((name(sh(se))!= shrealhd)? i_cpys: i_cpys,
2125
			(int)props(se), (int)(props(se)),no(d));
2126
	    }
2127
	    else {
2128
	      props(se) = sr; no(d) = tr;
2129
	      sp = guardfreg(tr, sp);
2 7u83 2130
	      /* !? swopped and moved in  dump_tag !? */
2131
	    }
2132
	  }
2133
	  else {
6 7u83 2134
	    if ((fixdone & (1<<sr))!=0) {
2 7u83 2135
	      /*	      operate_fmt(i_bis,no(d),no(d),(int)props(se));*/
6 7u83 2136
	      operate_fmt(i_bis,(int)props(se), (int)props(se),no(d));
2 7u83 2137
	    }
2138
	    else {
6 7u83 2139
	      props(se) = sr; no(d) = tr;
2 7u83 2140
	      sp = guardreg(tr,sp);
2141
	      /* !? swapped for dump_tag !? */
2142
	    }
2143
	  }
6 7u83 2144
	}
2145
	/* maybe more about promotions */
2 7u83 2146
      }
6 7u83 2147
      else if (isparam(e) && name(son(e)) == formal_callee_tag) {
2 7u83 2148
	exp se = son(e);
2149
	exp d = e;
6 7u83 2150
	if ((props(d) & inanyreg)!= 0) {
2 7u83 2151
	  /* callee parameter assigned to reg */
2152
	  ans a;
2153
	  instore is;
2154
	  is.b.base = FP;
6 7u83 2155
	  is.b.offset = (no(se) - callee_size) >>3;
2 7u83 2156
	  is.adval = 0;
2157
	  setinsalt(a, is);
6 7u83 2158
	 (void)move(a, placew, sp, is_signed(sh(se)));
2159
	}
2 7u83 2160
      }
2161
      else{
6 7u83 2162
	r = code_here(son(e), sp, placew);
2 7u83 2163
	/* evaluate the initialisation of tag, putting it into place
2164
	   allocated ... */
2165
      }
6 7u83 2166
      if (remember && r != NOREG && pt(e)!= nilexp
2167
	  && eq_sze(sh(son(e)), sh(pt(e)))) {
2 7u83 2168
	/* ...if it was temporarily in a register, remember it */
6 7u83 2169
	if (isvar(e)) {
2170
	  keepcont(pt(e), r);
2171
	}
2 7u83 2172
	else {
6 7u83 2173
	  keepreg(pt(e), r);
2 7u83 2174
	}
2175
      }
6 7u83 2176
      sp =  guard(placew, sp);
2177
      e = bro(son(e));
2178
      goto tailrecurse;
2 7u83 2179
      /* and evaluate the body of the declaration */
2180
    }					/* end ident */
6 7u83 2181
    case clear_tag: {
2 7u83 2182
      return mka;
6 7u83 2183
    }
2184
    case seq_tag: {
2185
      exp t = son(son(e));
2 7u83 2186
      for (;;) {
6 7u83 2187
	exp next = (last(t))?(bro(son(e))): bro(t);
2 7u83 2188
	if (name (next) == goto_tag) {/* gotos end sequences */
6 7u83 2189
	  make_code(t, sp, nowhere, no(son(pt(next))));
2190
	}
2 7u83 2191
	else {
6 7u83 2192
	  code_here(t, sp, nowhere);
2 7u83 2193
	}
6 7u83 2194
	if (last(t)) {
2195
	  e = bro(son(e));
2 7u83 2196
	  goto tailrecurse;
2197
	}
6 7u83 2198
	t = bro(t);
2 7u83 2199
      }
2200
    }				/* end seq */
6 7u83 2201
    case cond_tag: {
2202
      exp first = son(e);
2203
      exp second = bro(son(e));
2 7u83 2204
      exp test;
2205
      exp record;
2206
      record = getexp(f_bottom,nilexp,0,nilexp,nilexp,0,0,0);
2207
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2208
      start_new_capsule(true);
6 7u83 2209
#endif
2 7u83 2210
      if (dest.answhere.discrim == insomereg) {
2211
	/* must make choice of register to contain answer to cond */
6 7u83 2212
	int  *sr = someregalt(dest.answhere);
2 7u83 2213
	if (*sr != -1) {
6 7u83 2214
	  failer("Somereg *2");
2215
	}
2216
	*sr = getreg(sp.fixed);
2217
	setregalt(dest.answhere, *sr);
2 7u83 2218
      }
2219
      else if (dest.answhere.discrim == insomefreg) {
2220
	somefreg sfr;
2221
	freg fr;
2222
	sfr = somefregalt(dest.answhere);
6 7u83 2223
	if (*sfr.fr != -1) { failer("Somefreg *2"); }
2 7u83 2224
	*sfr.fr = getfreg(sp.flt);
2225
	fr.fr = *sfr.fr;
2226
	fr.type = sfr.type;
2227
	setfregalt(dest.answhere, fr);
2228
      }
2229
 
6 7u83 2230
      if (name(first) == goto_tag && pt(first) == second) {
2 7u83 2231
	/* first is goto second */
6 7u83 2232
	no(son(second)) = 0;
2233
	mka = make_code(second, sp, dest, exitlab);
2 7u83 2234
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2235
	close_capsule();
6 7u83 2236
#endif
2 7u83 2237
	return mka;
6 7u83 2238
      }
2239
      else if (name(second) == labst_tag &&
2240
	       name(bro(son(second))) == top_tag) {
2 7u83 2241
	/* second is empty */
6 7u83 2242
	int   endl = (exitlab == 0)? new_label(): exitlab;
2243
	no(son(second)) = endl;
2244
	make_code(first, sp, dest, endl);
2 7u83 2245
	mka.lab = endl;
2246
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2247
	close_capsule();
2248
#endif
2249
	return mka;
2250
      }
6 7u83 2251
      else if (name(second) == labst_tag &&
2252
	       name(bro(son(second))) == goto_tag) {
2 7u83 2253
	/* second is goto */
6 7u83 2254
	exp g = bro(son(second));
2255
	no(son(second)) = no(son(pt(g)));
2256
	mka = make_code(first, sp, dest, exitlab);
2 7u83 2257
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2258
	close_capsule();
6 7u83 2259
#endif
2 7u83 2260
	return mka;
2261
      }
2262
      if ((test = testlast (first, second)) /* I mean it */ ) {
2263
	/* effectively an empty then part */
6 7u83 2264
	int   l = (exitlab != 0)? exitlab : new_label();
2 7u83 2265
	bool rev = IsRev(test);
2266
	ptno(test) = -l;	/* make test jump to exitlab - see
2267
				   test_tag: */
6 7u83 2268
	props(test) = notbranch[(props(test) &127) - 1];
2 7u83 2269
	if (rev) { SetRev(test); }
2270
	/* ... with inverse test */
6 7u83 2271
	no(son(second)) = new_label();
2272
	make_code(first, sp, dest, l);
2273
	make_code(second, sp, dest, l);
2 7u83 2274
	mka.lab = l;
2275
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2276
	close_capsule();
6 7u83 2277
#endif
2 7u83 2278
	return mka;
2279
      }
2280
      else {
2281
	int   fl;
6 7u83 2282
	no(son(second)) = new_label();
2283
	fl = make_code(first, sp, dest, exitlab).lab;
2 7u83 2284
	{
6 7u83 2285
	  int l = (fl != 0)? fl :((exitlab != 0)? exitlab : new_label());
2286
	  if (name(sh(first))!=bothd)integer_branch(i_br,31,l);
2287
	  make_code(second, sp, dest, l);
2288
	  clear_all();
2 7u83 2289
	  mka.lab = l;
2290
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2291
	  close_capsule();
6 7u83 2292
#endif
2 7u83 2293
	  return mka;
2294
	}
2295
      }
2296
    }				/* end cond */
6 7u83 2297
    case labst_tag: {
2298
      if (no(son(e))!= 0) {
2299
	set_label(no(son(e)));
2 7u83 2300
      }
6 7u83 2301
      if (is_loaded_lv(e) && No_S) {
2 7u83 2302
	/* can be target of long_jump; reset sp */
2303
	baseoff b;
2304
	b.base = FP;
6 7u83 2305
	if (Has_vcallees) {
2 7u83 2306
#if 0
6 7u83 2307
	  b.offset = -arg_stack_space- (3*(PTR_SZ>>3));
2 7u83 2308
#endif
6 7u83 2309
	  b.offset = - (3*(PTR_SZ>>3));
2 7u83 2310
	  load_store(i_ldq,local_reg,b);
2311
	}
2312
	if (Has_tos) {
6 7u83 2313
	  b.offset = - (PTR_SZ>>3) - (arg_stack_space);
2 7u83 2314
	  load_store(i_ldq,SP,b);
2315
	}
2316
	else {
2317
	  comment("labst_tag:");
6 7u83 2318
	  operate_fmt_immediate(i_subq,FP,(frame_size+callee_size) >>3,SP);
2 7u83 2319
	}
6 7u83 2320
      }
2321
      e = bro(son(e));
2 7u83 2322
      goto tailrecurse;
2323
    }				/* end labst */
6 7u83 2324
    case rep_tag: {
2325
      exp first = son(e);
2326
      exp second = bro(first);
2 7u83 2327
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2328
      /* start_new_capsule(true);*/
6 7u83 2329
#endif
2 7u83 2330
      code_here(first,sp,nowhere);
6 7u83 2331
      no(son(second)) = new_label();
2 7u83 2332
      /*e = second;*/
2333
      mka = make_code(second,sp,dest,exitlab);
2334
#if DO_SCHEDULE && ENCAPSULATE_LABELS
2335
/*       close_capsule();*/
2336
#endif
2337
      return mka;
2338
      /*goto tailrecurse;*/
2339
    }				/* end rep */
6 7u83 2340
    case goto_tag: {
2341
      int   lab = no(son(pt(e)));
2342
      clear_all();
2 7u83 2343
      integer_branch(i_br,31,lab);
2344
      return mka;
2345
    }				/* end goto */
6 7u83 2346
    case make_lv_tag: {
2 7u83 2347
      int r = regfrmdest(&dest,sp);
2348
      ans aa;
2349
      load_store_label(i_lda,r,no(son(pt(e))));
2350
      setregalt(aa,r);
2351
      move(aa,dest, guardreg(r,sp), 0);
2352
      mka.regmove = r;
2353
      return mka;
2354
    }
6 7u83 2355
 
2356
    case long_jump_tag: {
2 7u83 2357
      int fp = reg_operand(son(e), sp);
2358
      int labval = reg_operand(bro(son(e)), sp);
2359
      comment("long jump");
2360
      operate_fmt(i_bis,fp,fp,FP);	/* move fp into FP */
2361
      /* load labval into register*/
2362
      integer_jump(i_jmp,31,labval,0);
2363
      return mka;
2364
    }
2365
    /*
2366
      max(x,y) and min(x,y)
2367
      */
6 7u83 2368
    case offset_max_tag:
2369
    case max_tag:
2370
    case min_tag:{
2 7u83 2371
      exp l = son(e);
2372
      exp r = bro(l);
2373
      int a1= reg_operand(l,sp);
2374
      int a2 = reg_operand(r,sp);
2375
      int d = regfrmdest(&dest,sp);
2376
      int rtmp = getreg(guardreg(d,sp).fixed);
2377
      ans aa;
2378
 
2379
      operate_fmt(i_bis,a1,a1,d);
2380
      operate_fmt(is_signed(sh(l))?i_cmplt:i_cmpult,a1,a2,rtmp);
6 7u83 2381
      if ((name(e) == max_tag) || (name(e) == offset_max_tag)) {
2 7u83 2382
	operate_fmt(i_cmovne,rtmp,a2,d);
2383
      }
2384
      else{
2385
	operate_fmt(i_cmoveq,rtmp,a2,d);
2386
      }
2387
      setregalt(aa,d);
6 7u83 2388
     (void)move(aa,dest,guardreg(d,sp),0);
2 7u83 2389
      mka.regmove=d;
2390
      return mka;
2391
    }
2392
 
6 7u83 2393
    case fmax_tag: {
2 7u83 2394
      exp l = son(e);
2395
      exp r = bro(l);
2396
      int a1 = freg_operand(l,sp);
2397
      int a2 = freg_operand(r,sp);
2398
      freg rd;
2399
      int rtmp;
2400
      ans aa;
2401
      rd = fregfrmdest(&dest,sp);
2402
      rtmp = getfreg(guardreg(rd.fr,sp).fixed);
2403
      float_op(i_cpys,a1,a1,rd.fr);
2404
      float_op(i_cmptlt,a1,a2,rtmp);
2405
      float_op(i_fcmovne,rtmp,a2,rd.fr);
2406
      setfregalt(aa,rd);
2407
      mka.regmove = move(aa,dest,guardfreg(rd.fr,sp),1);
2408
      return mka;
2409
    }
6 7u83 2410
 
2411
    case abslike_tag:{
2 7u83 2412
      /* if (test x) then res = -x, else res = x *
2413
	 The code produced for this construct is:
2414
	 move x to res, neg x -> y, cmov(test) x,y,res.
6 7u83 2415
	 If the test is unsigned then we can optimise certain
2 7u83 2416
	 cases, i.e. less-than and greater-than-or-equal are
2417
	 always false and true respectively
2418
	 */
2419
      exp l = son(son(e));
2420
      shape shl = sh(l);
2421
      instruction cmove_ins;
2422
      space nsp;
2423
      int test_num;
2424
      int dest_reg;
2425
      int uns;
2426
      ans aa;
2427
      int a1,rtmp;
2428
      nsp = sp;
2429
      test_num = props(son(e));
2430
      dest_reg = regfrmdest(&dest,nsp);
2431
      mka.regmove = dest_reg;
2432
      setregalt(aa,dest_reg);
2433
      uns = !is_signed(shl);
2434
      nsp = guardreg(dest_reg,nsp);
2435
      a1 = reg_operand(l,nsp);
2436
      nsp = guardreg(dest_reg,nsp);
2437
      rtmp = getreg(nsp.fixed);
2438
      operate_fmt(i_bis,a1,a1,dest_reg);
2439
      cmove_ins = condmove(test_num);
2440
      operate_fmt(i_subq,31,a1,rtmp);
2441
      operate_fmt(cmove_ins,a1,rtmp,dest_reg);
2442
      move(aa,dest,guardreg(dest_reg,nsp),0);
2443
      return mka;
2444
    }
2445
 
6 7u83 2446
 
2447
 
2448
    case absbool_tag:
2 7u83 2449
    /*case abslike_tag:*/{
2450
      /*
2451
	need to clear up the distinctions between comparison and
2452
	conditional move.
2453
	*/
6 7u83 2454
      exp l = son(son(e));
2455
      exp r = bro(l);
2456
      shape shl = sh(l);
2 7u83 2457
      instruction compare_ins;
6 7u83 2458
      int   n = props(son(e));
2 7u83 2459
      int   d;
2460
      int   a1;
2461
      int   a2;
6 7u83 2462
      bool xlike = (name(e)!= absbool_tag);
2 7u83 2463
      ans aa;
2464
      bool uns = (!is_signed(shl));
6 7u83 2465
      if (!xlike && name(l) == val_tag) {
2 7u83 2466
	/* put literal operand on right */
2467
	exp temp = l;
2468
	l = r;
2469
	r = temp;
2470
	if (n <= 2) {
2471
	  n += 2;
2472
	}
2473
	else
2474
	  if (n <= 4) {
2475
	    n -= 2;
2476
	  }
2477
      }
6 7u83 2478
 
2479
     (void)compares(&compare_ins,shl,n);
2 7u83 2480
      d = regfrmdest(&dest, sp);
2481
 
2482
      /* reg d will contain result of compare */
2483
 
6 7u83 2484
      a1 = reg_operand(l, sp);
2 7u83 2485
      sp = guardreg(a1,sp);
2486
      if (xlike && a1==d) {
2487
	d = getreg(sp.fixed);
2488
      }
6 7u83 2489
      if (name(r) == val_tag) {
2490
	if ((n==1) || (n==2)) {
2 7u83 2491
	  int rt = getreg(guardreg(d,sp).fixed);
6 7u83 2492
	  if (no(r)) {
2 7u83 2493
	    INT64 res;
6 7u83 2494
	    if (isbigval(r)) {
2 7u83 2495
	      INT64_assign(res,flt64_to_INT64(exp_to_f64(r)));
2496
	      /*res=flt64_to_INT64(exp_to_f64(r));*/
2497
	    }
2498
	    else{
2499
	      INT64_assign(res,make_INT64(0,no(r)));
6 7u83 2500
	    }
2 7u83 2501
	    load_store_immediate(i_ldiq,rt,res);
2502
	  }
2503
	  else
2504
	    rt=31;
6 7u83 2505
	  if (name(e)!=absbool_tag) {
2 7u83 2506
	    int rtmp;
6 7u83 2507
	    if (uns) {
2 7u83 2508
	      rtmp = getreg(sp.fixed);
2509
	      operate_fmt(compare_ins,rt,a1,rtmp);
2510
	    }
2511
	    else{
2512
	      rtmp = rt;
2513
	    }
2514
	    compare_ins=condmove(n);
2515
	    operate_fmt(i_bis,rtmp,rtmp,d);
2516
	    operate_fmt(compare_ins,a1,a1,d);
2517
	  }
2518
	  else
2519
	    operate_fmt(compare_ins,rt,a1,d);
2520
	}
2521
	else{
6 7u83 2522
	  if (isbigval(r)) {
2 7u83 2523
	    operate_fmt_big_immediate(compare_ins,a1,
2524
				      flt64_to_INT64(exp_to_f64(r)),d);
2525
	  }
2526
	  else{
2527
	    operate_fmt_immediate(compare_ins,a1,no(r),d);
2528
	  }
2529
	}
2530
	if(n==6)	/* ? */
2531
	  operate_fmt(i_cmpeq,d,31,d);
2532
	/* invert the result */
2533
      }
2534
      else {
2535
	space nsp;
6 7u83 2536
	nsp = guardreg(a1, sp);
2537
	a2 = reg_operand(r, nsp);
2 7u83 2538
	if (xlike && a2==d) {
2539
	  nsp = guardreg(a2, nsp);
2540
	  d = getreg(nsp.fixed);
2541
	}
6 7u83 2542
	if ((n==1) || (n==2))
2 7u83 2543
	  operate_fmt(compare_ins,a2,a1,d);
2544
	else
2545
	  operate_fmt(compare_ins,a1,a2,d);
6 7u83 2546
	if (n==6)operate_fmt(i_cmpeq,d,31,d);
2 7u83 2547
      }
6 7u83 2548
      if (name(e) ==maxlike_tag || name(e) ==minlike_tag) {
2 7u83 2549
	instruction ins;
2550
	int l = new_label();
2551
	setnoreorder();
6 7u83 2552
	ins= (name(e) ==maxlike_tag)?i_bne:i_beq;
2 7u83 2553
	/*operate_fmt(i_addu, d, a1, 0);*/
2554
	integer_branch(ins,d,l);
6 7u83 2555
	if (name(r) ==val_tag) {
2 7u83 2556
	  INT64 v;
2557
	  low_INT64(v) = no(r);
2558
	  load_store_immediate(i_ldil,d,v);
2559
	}
2560
	else operate_fmt(i_bis,no(r),no(r),d);
2561
	set_label_no_clear(l);
2562
	setreorder();
6 7u83 2563
      }
2 7u83 2564
      else
6 7u83 2565
	if (name(e) ==abslike_tag) {
2 7u83 2566
	  int l1 = new_label();
2567
	  int l2 = new_label();
2568
	  setnoreorder();
2569
	  integer_branch(i_bne,d,l2);
2570
	  operate_fmt(i_subq, 31, a1, d);
2571
	  integer_branch(i_br,31,l1);
2572
	  set_label(l2);
2573
	  operate_fmt(i_bis,a1,a1,d);
2574
 
2575
	  set_label_no_clear(l1);
6 7u83 2576
	  setreorder();
2577
	}
2578
      setregalt(aa, d);
2579
      move(aa,dest, guardreg(d, sp), 0);
2 7u83 2580
      mka.regmove = d;
2581
      return mka;
2582
    }			/* end absbool */
2583
 
6 7u83 2584
 
2585
    case test_tag: {
2 7u83 2586
      /*
2587
	Tests are performed by either a comparison or subraction
2588
	instruction, followed by a conditional branch.  If the
2589
	test is unsigned, or if a subtraction could cause an
2590
	overflow, then comparisons must be used.
2591
	*/
6 7u83 2592
      exp l = son(e);
2593
      exp r = bro(l);
2 7u83 2594
      int   lab = (ptno (e) < 0) ? -ptno (e) : no (son (pt (e))); /* !! */
2595
      /* see frig in cond_tag */
6 7u83 2596
      shape shl = sh(l);
2 7u83 2597
      instruction test_ins;
2598
      int   n = (props (e)) & 127; /* could have Rev bit in props*/
2599
      bool rev;
6 7u83 2600
      bool is_compare = ((!is_signed(shl)) && ((n-5) <0) &&
2601
			(name(shl)!=ptrhd)) || ((is64(shl)));
2 7u83 2602
      is_compare = TRUE;
6 7u83 2603
      if (is_floating(name(sh(l)))) {
2 7u83 2604
	instruction compare_ins;
2605
	space nsp;
2606
	int rev;
2607
	int a1,a2,dest;
2608
	a1 = freg_operand(l,sp);
2609
	nsp = guardfreg(a1,sp);
2610
	a2 = freg_operand(r,nsp);
2611
	dest = getfreg(nsp.flt);
2612
	rev = fdouble_comparisons(&compare_ins,n);
2613
	float_op(compare_ins,a1,a2,dest);
2614
	float_branch(rev?i_fbeq:i_fbne,dest,lab);
2615
	return mka;
6 7u83 2616
      }
2 7u83 2617
      else {
2618
	int   a1;
2619
	int   a2;
2620
	if (name (l) == val_tag) {/* put literal operand on right */
2621
	  exp temp = l;
2622
	  l = r;
2623
	  r = temp;
2624
	  if (n <= 2) {
2625
	    n += 2;
2626
	  }
2627
	  else
2628
	    if (n <= 4) {
2629
	      n -= 2;
2630
	    }
2631
	}
6 7u83 2632
	if (is_compare) {
2 7u83 2633
	  rev = comparisons(&test_ins,shl, n);
2634
	}
2635
	else{
2636
	  rev = 0;
2637
	  test_ins = sbranches(n);
2638
	}
6 7u83 2639
	a1 = reg_operand(l, sp);
2640
	if (name(r) == val_tag) {
2 7u83 2641
	  space nsp;
2642
	  int rtemp;
6 7u83 2643
 
2644
	  switch (name(sh(r))) {
2645
	    case ucharhd:{
2 7u83 2646
	      no(r) = (unsigned char)no(r);
2647
	      break;
2648
	    }
6 7u83 2649
	    case scharhd:{
2 7u83 2650
	      no(r) = (char)no(r);
2651
	      break;
2652
	    }
6 7u83 2653
	    case swordhd:{
2 7u83 2654
	      no(r) = (short)no(r);
2655
	      break;
2656
	    }
6 7u83 2657
	    case uwordhd:{
2 7u83 2658
	      no(r) = (unsigned short)no(r);
2659
	      break;
2660
	    }
2661
	  }
2662
 
6 7u83 2663
 
2664
	  if ((no(r)!=0) || (isbigval(r))) {
2 7u83 2665
	    nsp=guardreg(a1,sp);
2666
	    rtemp=getreg(nsp.fixed);
6 7u83 2667
	    if (is_compare) {
2668
	      if (isbigval(r)) {
2 7u83 2669
		operate_fmt_big_immediate(test_ins,a1,exp_to_INT64(r),rtemp);
2670
	      }
2671
	      else{
2672
		operate_fmt_immediate(test_ins,a1,no(r),rtemp);
2673
	      }
2674
	      integer_branch(rev?i_beq:i_bne,rtemp,lab);
2675
	    }
2676
	    else{
6 7u83 2677
	      if (name(shl) ==ulonghd) {
2 7u83 2678
		operate_fmt_immediate(i_addl,a1,0,a1);
2679
	      }
6 7u83 2680
	      if (isbigval(r)) {
2 7u83 2681
		INT64 res = flt64_to_INT64(exp_to_f64(r));
2682
		operate_fmt_big_immediate(i_subq,a1,res,rtemp);
2683
	      }
2684
	      else{
2685
		operate_fmt_immediate(i_subq,a1,no(r),rtemp);
2686
	      }
6 7u83 2687
	      integer_branch(test_ins,rtemp,lab);
2 7u83 2688
	    }
2689
	  }
2690
	  else{
6 7u83 2691
	    if (is_compare) {
2 7u83 2692
	      int rtmp=getreg(guardreg(a1,sp).fixed);
6 7u83 2693
	      if (is_signed(shl)) {
2 7u83 2694
		test_ins = sbranches(n);
2695
		integer_branch(test_ins,a1,lab);
2696
	      }
2697
	      else{
2698
		operate_fmt(test_ins,a1,31,rtmp);
2699
		integer_branch(rev?i_beq:i_bne,rtmp,lab);
2700
	      }
2701
	    }
2702
	    else{
2703
	      int dreg=a1;
2704
	      integer_branch(test_ins,dreg,lab);
2705
	    }
2706
	  }
2707
	}
2708
	else {
2709
	  space nsp;
2710
	  int rtemp;
6 7u83 2711
	  nsp = guardreg(a1, sp);
2712
	  a2 = reg_operand(r, nsp);
2713
	  if (a2!=31) {
2 7u83 2714
	    rtemp=getreg(guardreg(a2,nsp).fixed);
6 7u83 2715
	    if (is_compare) {
2 7u83 2716
	      operate_fmt(test_ins,a1,a2,rtemp);
2717
	      integer_branch(rev?i_beq:i_bne,rtemp,lab);
2718
	    }
2719
	    else{
2720
	      operate_fmt(is64(sh(son(e)))?i_subq:i_subl,a1,a2,
6 7u83 2721
			  rtemp);
2722
	      integer_branch(test_ins,rtemp,lab);
2 7u83 2723
	    }
2724
	  }
2725
	  else{
2726
	    test_ins = sbranches(n);
2727
	    integer_branch(test_ins,a1,lab);
2728
	  }
2729
	}
2730
	return mka;
2731
      }		  /* end int test */
2732
    }			/* end test */
2733
 
6 7u83 2734
    case ass_tag:
2735
    case assvol_tag: {
2736
      exp lhs = son(e);
2737
      exp rhs = bro(lhs);
2 7u83 2738
      where assdest;
2739
      space nsp;
2740
      ash arhs;
6 7u83 2741
 
2 7u83 2742
      int   contreg = NOREG;
6 7u83 2743
      if (name(e) == assvol_tag) {
2744
	clear_all();
2 7u83 2745
	/*setvolatile ();*/
2746
      }
2747
 
6 7u83 2748
      arhs = ashof(sh(rhs));
2 7u83 2749
 
6 7u83 2750
      if (name(e) == ass_tag && name(rhs) == apply_tag &&
2751
	 (is_floating(name(sh(rhs))) || valregable(sh(rhs)))) {
2 7u83 2752
	/* if source is simple proc call, evaluate it first and do
2753
	   assignment */
2754
	ans aa;
6 7u83 2755
	code_here(rhs, sp, nowhere);
2756
	if (is_floating(name(sh(rhs)))) {
2 7u83 2757
	  freg frg;
2758
	  frg.fr = 0;
6 7u83 2759
	  if (arhs.ashsize==64)
2 7u83 2760
	    frg.type = IEEE_double;
2761
	  else
2762
	    frg.type = IEEE_single;
6 7u83 2763
	  setfregalt(aa, frg);
2 7u83 2764
	}
2765
	else {
6 7u83 2766
	  setregalt(aa, RESULT_REG);
2 7u83 2767
	}
6 7u83 2768
	assdest = locate(lhs, guardreg(RESULT_REG,sp), sh(rhs), NO_REG);
2769
	move(aa,assdest, sp, 1);
2770
	move(aa,dest, sp, 1);
2771
	clear_dep_reg(lhs);
2 7u83 2772
	return mka;
2773
      }
2774
 
2775
/*	if (al1(sh(lhs)) == 1 || arhs.ashalign == 1)
2776
	clear_reg (0);*/
2777
 
6 7u83 2778
      assdest = locate(lhs, sp, sh(rhs), NO_REG);
2779
      nsp = guard(assdest, sp);
2 7u83 2780
      /* evaluate address of destination */
2781
 
2782
      if (assdest.ashwhere.ashalign == 1) {
6 7u83 2783
	/* this is an assignment of a bitfield, so get address
2 7u83 2784
	   in proper form */
2785
	instore is;
2786
	switch (assdest.answhere.discrim) {
6 7u83 2787
	  case inreg: {
2788
	    is.b.base = regalt(assdest.answhere);
2 7u83 2789
	    is.b.offset = 0;
2790
	    is.adval = 1;
2791
	    break;
2792
	  }
6 7u83 2793
	  case notinreg: {
2794
	    is = insalt(assdest.answhere);
2 7u83 2795
	    if (!is.adval) {
6 7u83 2796
	      int   r = getreg(nsp.fixed);
2 7u83 2797
	      load_store(i_ldq,r,is.b);
6 7u83 2798
	      nsp = guardreg(r, nsp);
2 7u83 2799
	      is.adval = 1;
2800
	      is.b.base = r;
2801
	      is.b.offset = 0;
2802
	    }
2803
	    else {
2804
	      is.b.offset = is.b.offset << 3;
2805
	    }
2806
	    break;
2807
	  }
2808
#if 0
6 7u83 2809
	  case bitad: {
2810
	    is = bitadalt(assdest.answhere);
2 7u83 2811
	    break;
2812
	  }
2813
#endif
6 7u83 2814
	  default:
2815
	  failer("Wrong assbits");
2816
	}
2 7u83 2817
/*	  setbitadalt (assdest.answhere, is);*/
6 7u83 2818
      }
2819
      else if (name(e) == ass_tag
2 7u83 2820
	       && assdest.answhere.discrim == notinreg
2821
	       && assdest.ashwhere.ashsize == assdest.ashwhere.ashalign) {
2822
	instore is;
6 7u83 2823
	is = insalt(assdest.answhere);
2824
	if (!is.adval) {
2 7u83 2825
	  /* this is an indirect assignment, so make
2826
	     it direct by loading pointer into a register
2827
	     (and remember it) */
6 7u83 2828
	  int   r = getreg(nsp.fixed);
2 7u83 2829
	  load_store(i_ldq,r,is.b);
6 7u83 2830
	  nsp = guardreg(r, nsp);
2 7u83 2831
	  is.adval = 1;
2832
	  is.b.base = r;
2833
	  is.b.offset = 0;
6 7u83 2834
	  setinsalt(assdest.answhere, is);
2835
	  keepexp(lhs, assdest.answhere);
2 7u83 2836
	}
2837
      }
6 7u83 2838
 
2839
      contreg = code_here(rhs, guard(assdest,nsp), assdest);
2840
      /*
2841
	 evaluate source into assignment destination
2842
	 and move it into dest - could use assignment as value
2 7u83 2843
	 */
2844
 
2845
      switch (assdest.answhere.discrim) {
6 7u83 2846
	case inreg: {
2847
	  int   a = regalt(assdest.answhere);
2848
	  keepreg(rhs, a);
2 7u83 2849
	  /* remember that source has been evaluated into a */
6 7u83 2850
	  clear_dep_reg(lhs);
2 7u83 2851
	  /* forget register dependencies on destination */
6 7u83 2852
	  move(assdest.answhere,dest, nsp, 1);
2 7u83 2853
	  break;
2854
	}
6 7u83 2855
	case infreg:{
2 7u83 2856
	  freg frg;
2857
	  int   r;
6 7u83 2858
	  frg = fregalt(assdest.answhere);
2 7u83 2859
	  r = frg.fr + 32;
2860
	  if (frg.type==IEEE_double) {
2861
	    r = -r;
2862
	  };
6 7u83 2863
	  keepreg(rhs, r);
2 7u83 2864
	  /* remember that source has been evaluated into a */
6 7u83 2865
	  clear_dep_reg(lhs);
2 7u83 2866
	  /* forget register dependencies on destination */
6 7u83 2867
	  move(assdest.answhere,dest, nsp, 1);
2 7u83 2868
	  break;
2869
	}
2870
	case notinreg : /*case bitad: */{
6 7u83 2871
	  if (contreg != NOREG && name(e) == ass_tag) {
2 7u83 2872
	    ans aa;
2873
	    space nnsp;
2874
	    if (contreg > 0 && contreg < 31) {
6 7u83 2875
	      setregalt(aa, contreg);
2876
	      nnsp = guardreg(contreg, sp);
2 7u83 2877
	    }
2878
	    else {
2879
	      freg frg;
6 7u83 2880
	      frg.fr = abs(contreg) - 32;
2881
	      if (contreg<0)
2 7u83 2882
		frg.type = IEEE_double;
6 7u83 2883
	      else
2 7u83 2884
		frg.type = IEEE_single;
2885
	      nnsp = nsp;
6 7u83 2886
	      setfregalt(aa, frg);
2 7u83 2887
	    }
6 7u83 2888
	    move(aa,dest, nnsp, 1);
2889
	    clear_dep_reg(lhs);
2 7u83 2890
	    /* forget register dependencies on destination */
6 7u83 2891
	    if (name(lhs) == name_tag || !dependson(lhs, 0, lhs)) {
2892
	      /* remember that dest contains source,
2 7u83 2893
		 provided that it is not dependent on it */
6 7u83 2894
	      keepcont(lhs, contreg);
2 7u83 2895
	    }
2896
	    return mka;
2897
	  }
6 7u83 2898
	  clear_dep_reg(lhs);
2 7u83 2899
	  /* forget register dependencies on destination */
6 7u83 2900
	  move(assdest.answhere,dest, nsp, 1);
2 7u83 2901
	  break;
6 7u83 2902
	  case insomereg: case insomefreg: {
2903
	    clear_dep_reg(lhs);
2 7u83 2904
	    /* forget register dependencies on destination */
6 7u83 2905
	    move(assdest.answhere,dest, guard(assdest, sp), 1);
2 7u83 2906
	  }
6 7u83 2907
	}
2 7u83 2908
      }			/* end sw on answhere */
2909
 
2910
/*	if (name (e) == assvol_tag)*/
2911
      /*setnovolatile ();*/
2912
      return mka;
2913
    }				/* end ass */
2914
 
6 7u83 2915
    case compound_tag: {
2916
      exp t = son(e);
2 7u83 2917
      space nsp;
2918
      instore str;
2919
      int r;
6 7u83 2920
 
2921
      nsp = sp;
2922
      switch (dest.answhere.discrim) {
2923
	case notinreg: {
2 7u83 2924
	  str = insalt (dest.answhere);/* it should be !! */
2925
	  if (!str.adval) {
6 7u83 2926
	    int   r = getreg(sp.fixed);
2927
	    nsp = guardreg(r, sp);
2 7u83 2928
	    load_store(i_ldq,r,str.b);
2929
	    str.adval = 1;
2930
	    str.b.base = r;
2931
	    str.b.offset = 0;
6 7u83 2932
	  }
2 7u83 2933
	  for (;;) {
2934
	    where newdest;
2935
	    instore newis;
2936
	    newis = str;
2937
	    newis.b.offset += no(t);
6 7u83 2938
	    Assert(name(t) ==val_tag && al2(sh(t)) >= 8);
2939
	    setinsalt(newdest.answhere, newis);
2940
	    newdest.ashwhere = ashof(sh(bro(t)));
2941
	    code_here(bro(t), nsp, newdest);
2942
	    if (last(bro(t))) {
2 7u83 2943
	      return mka;
6 7u83 2944
	    }
2945
	    t = bro(bro(t));
2946
	  }
2 7u83 2947
	}
6 7u83 2948
	case insomereg: {
2 7u83 2949
	  int * sr = someregalt(dest.answhere);
2950
	  if (*sr != -1) {
6 7u83 2951
	    failer("Somereg *2");
2952
	  }
2953
	  *sr = getreg(sp.fixed);
2954
	  setregalt(dest.answhere, *sr);
2955
	}
2 7u83 2956
	FALL_THROUGH;
6 7u83 2957
	case inreg: {
2 7u83 2958
	  code_here(bro(t), sp, dest);
2959
	  r = regalt(dest.answhere);
6 7u83 2960
	  Assert(name(t) ==val_tag);
2961
	  if (no(t)!=0) {
2962
	    operate_fmt_immediate(i_sll, r,
2963
				 (al2(sh(t)) >= 8)?(no(t) <<3):no(t),r);
2964
	  }
2 7u83 2965
	  nsp = guardreg(r, sp);
6 7u83 2966
	  while (!last(bro(t))) {
2 7u83 2967
	    int z;
2968
	    t = bro(bro(t));
6 7u83 2969
	    Assert(name(t) ==val_tag);
2 7u83 2970
	    z = reg_operand(bro(t), nsp);
6 7u83 2971
	    if (no(t)!=0) {
2 7u83 2972
	      operate_fmt_immediate
6 7u83 2973
		(i_sll, z,(al2(sh(t)) >= 8)?(no(t) <<3):no(t),z);
2974
	    }
2 7u83 2975
	    operate_fmt(i_bis, z, z, r);
6 7u83 2976
	  }
2 7u83 2977
	  return mka;
2978
	}
2979
	default: failer("No Tuples in freg");
2980
      }
2981
      break;
2982
    }				/* end tup */
6 7u83 2983
 
2984
    case nof_tag:
2985
    case concatnof_tag:{
2986
      exp t = son(e);
2 7u83 2987
      space nsp;
2988
      instore str;
2989
      int r, disp = 0;
6 7u83 2990
 
2991
      nsp = sp;
2992
      switch (dest.answhere.discrim) {
2993
	case notinreg: {
2 7u83 2994
	  str = insalt (dest.answhere);	/* it should be !! */
2995
	  if (!str.adval) {
6 7u83 2996
	    int   r = getreg(sp.fixed);
2997
	    nsp = guardreg(r, sp);
2 7u83 2998
	    load_store(i_ldq,r,str.b);
2999
	    str.adval = 1;
3000
	    str.b.base = r;
3001
	    str.b.offset = 0;
3002
	  }
3003
	  for (;;) {
3004
	    where newdest;
3005
	    instore newis;
6 7u83 3006
	    if (t == nilexp) return mka;
2 7u83 3007
	    newis = str;
3008
	    newis.b.offset += disp;
6 7u83 3009
	    setinsalt(newdest.answhere, newis);
3010
	    newdest.ashwhere = ashof(sh(t));
3011
	    code_here(t, nsp, newdest);
3012
	    if (last(t)) {
2 7u83 3013
	      return mka;
3014
	    }
6 7u83 3015
	    disp+= (rounder(shape_size(sh(t)), shape_align(sh(bro(t)))) >>3);
2 7u83 3016
	    t =bro(t);
3017
	  }
3018
	}
6 7u83 3019
	case insomereg: {
2 7u83 3020
	  int * sr = someregalt(dest.answhere);
3021
	  if (*sr != -1) {
6 7u83 3022
	    failer("Somereg *2");
2 7u83 3023
	  }
6 7u83 3024
	  *sr = getreg(sp.fixed);
3025
	  setregalt(dest.answhere, *sr);
2 7u83 3026
	  /* ,... */
6 7u83 3027
	}
2 7u83 3028
	FALL_THROUGH;
6 7u83 3029
	case inreg: {
3030
	  if (t == nilexp) return mka;
2 7u83 3031
	  code_here(t, sp, dest);
3032
	  r = regalt(dest.answhere);
3033
	  nsp = guardreg(r, sp);
6 7u83 3034
	  while (!last(t)) {
2 7u83 3035
	    int z;
3036
	    disp+=rounder(shape_size(sh(t)), shape_align(sh(bro(t))));
3037
	    t =bro(t);
3038
	    z = reg_operand(t, nsp);
6 7u83 3039
	    operate_fmt_immediate(i_sll, z,disp,z);
2 7u83 3040
	    operate_fmt(i_bis, z, z, r);
3041
	  }
3042
	  return mka;
3043
	}
3044
	default: failer("No Tuples in freg");
3045
      }
3046
      break;
3047
    }
6 7u83 3048
 
3049
    case ncopies_tag:{
3050
      exp t = son(e);
2 7u83 3051
      space nsp;
3052
      instore str;
3053
      int i, r, disp = 0;
6 7u83 3054
      nsp = sp;
3055
      switch (dest.answhere.discrim) {
3056
	case notinreg: {
2 7u83 3057
	  str = insalt (dest.answhere); /* it should be !! */
3058
	  if (!str.adval) {
6 7u83 3059
	    int   r = getreg(sp.fixed);
3060
	    nsp = guardreg(r, sp);
2 7u83 3061
	    load_store(i_ldq,r,str.b);
3062
	    str.adval = 1;
3063
	    str.b.base = r;
3064
	    str.b.offset = 0;
6 7u83 3065
	  }
2 7u83 3066
	  for (i=1;i<=no(e); i++) {
3067
	    where newdest;
3068
	    instore newis;
3069
	    newis = str;
3070
	    newis.b.offset += disp;
6 7u83 3071
	    setinsalt(newdest.answhere, newis);
3072
	    newdest.ashwhere = ashof(sh(t));
3073
	    code_here(t, nsp, newdest);
3074
	    disp+= (rounder(shape_size(sh(t)), shape_align(sh(t))) >>3);
3075
	  }
2 7u83 3076
	  return mka;
3077
	}
6 7u83 3078
	case insomereg: {
2 7u83 3079
	  int * sr = someregalt(dest.answhere);
3080
	  if (*sr != -1) {
6 7u83 3081
	    failer("Somereg *2");
3082
	  }
3083
	  *sr = getreg(sp.fixed);
3084
	  setregalt(dest.answhere, *sr);
3085
	}
2 7u83 3086
	FALL_THROUGH;
3087
	case inreg: {
3088
	  code_here(t, sp, dest);
3089
	  r = regalt(dest.answhere);
3090
	  nsp = guardreg(r, sp);
6 7u83 3091
	  for (i=1; i<=no(e); i++) {
2 7u83 3092
	    int z;
3093
	    disp+=rounder(shape_size(sh(t)), shape_align(sh(t)));
3094
	    z = reg_operand(t, nsp);
3095
	    operate_fmt_immediate(i_sll, z,disp,z);
3096
	    operate_fmt(i_bis, z, z, r);
6 7u83 3097
	  }
2 7u83 3098
	  return mka;
3099
	}
3100
	default: failer("No Tuples in freg");
3101
      }
3102
      break;
6 7u83 3103
    }
3104
    case apply_tag:{
3105
      exp fn = son(e);
3106
      exp par = bro(fn);
2 7u83 3107
      exp list = par;
6 7u83 3108
      int   hda = name(sh(e));
2 7u83 3109
      int   disp;
3110
      int   spar;
3111
      int   fpar = 16;
3112
      ash ansash;
3113
      bool hadfixed;
3114
      instore is;
3115
      is.b.base = SP;
3116
      is.b.offset = 0;
3117
      is.adval = 1;
6 7u83 3118
 
2 7u83 3119
#ifdef DO_SPECIAL
3120
      if ((disp = specialfn (fn)) > 0) { /* eg function is strlen */
6 7u83 3121
	mka.lab = specialmake(disp, list, sp, dest, exitlab);
2 7u83 3122
	return mka;
3123
 
3124
      }
3125
#endif
6 7u83 3126
      ansash = ashof(sh(e));
2 7u83 3127
      disp = 0;
3128
      spar = FIRST_INT_ARG;/* register holding 1st integer parameter */
3129
      hadfixed = 0;
6 7u83 3130
 
3131
 
2 7u83 3132
      if (!last(fn)) {
3133
	for (;;) {		/* evaluate parameters in turn */
6 7u83 3134
	  int   hd = name(sh(list));
2 7u83 3135
	  where w;
3136
	  ash ap;
3137
	  int paral;
3138
	  int parsize;
6 7u83 3139
	  ap = ashof(sh(list));
2 7u83 3140
	  paral = (ap.ashalign < 32)?32:ap.ashalign;
6 7u83 3141
	  if (spar>21) {
2 7u83 3142
	    ap.ashalign=64;
3143
	    paral = 64;
3144
	  }
3145
	  parsize = ap.ashsize;
3146
	  /* all parameters passed on stack are quadword aligned */
3147
	  w.ashwhere = ap;
3148
	  disp = rounder(disp,paral);
3149
	  spar = FIRST_INT_ARG+ (disp>>6);
3150
	  fpar = FIRST_FLOAT_ARG+ (disp>>6);
3151
	  if (disp>448) {spar =22; fpar = 22; }
3152
	  if (is_floating(hd) && disp+parsize <= 384) {
3153
	    freg frg;
3154
	    ans ansfr;
3155
	    frg.fr = fpar++;
6 7u83 3156
	    if (hd != shrealhd)
2 7u83 3157
	      frg.type = IEEE_double;
3158
	    else
3159
	      frg.type = IEEE_single;
6 7u83 3160
	    setfregalt(ansfr, frg);
2 7u83 3161
	    w.answhere = ansfr;
6 7u83 3162
	    code_here(list, sp, w);
2 7u83 3163
	    /* eval parameter into floating parameter register */
3164
	    sp = guardfreg(frg.fr, sp);
3165
	  }
6 7u83 3166
	  else if (((valregable(sh(list)) || (name(sh(list)) ==cpdhd)) ||
3167
		  (name(sh(list)) ==nofhd)) && spar<=21) {
2 7u83 3168
	    /* compound types are always passed in registers
3169
	       (given enough space). */
3170
	    ans ansr;
3171
	    int par_reg;
6 7u83 3172
	    int numleft = parsize- ((LAST_INT_ARG-spar+1) <<6);
3173
	    int pregs_used = min((numleft>>6) +6,6);
2 7u83 3174
	    hadfixed=1;
3175
	    setregalt(ansr,spar);
3176
	    w.answhere=ansr;
6 7u83 3177
	    for (par_reg=spar;par_reg<spar+pregs_used;++par_reg) {
2 7u83 3178
	      sp = guardreg(par_reg,sp);
3179
	    }
3180
 
6 7u83 3181
 
2 7u83 3182
	    sp = guardreg(spar,sp);
3183
	    code_here(list,sp,w);
6 7u83 3184
	    if (numleft>0) {
2 7u83 3185
	      is.b.offset+=(numleft>>3); /* += number of bytes remaining */
3186
	    }
3187
	  }
3188
	  else {
6 7u83 3189
	    /* pass remaining parameters on the stack.
3190
	       The parameters are aligned on 8 byte boundaries.
2 7u83 3191
	       */
6 7u83 3192
	    setinsalt(w.answhere, is);
3193
	    is.b.offset+= (max(ap.ashsize,REG_SIZE) >>3);
2 7u83 3194
	    /* 'size' was used here */
6 7u83 3195
	    code_here(list, sp, w);
2 7u83 3196
	    hadfixed = 1;
3197
	    /* eval parameter into argument space on stack */
6 7u83 3198
	  }
3199
	  if (name(list) == caller_tag) {
2 7u83 3200
	    no(list) = disp;
3201
	  }
3202
	  disp+=parsize;
3203
	  disp = rounder(disp, REG_SIZE);
3204
 
3205
 
6 7u83 3206
	  if (last(list))break;
3207
	  list = bro(list);
2 7u83 3208
	} /* end for */
3209
      } /* end if list */
6 7u83 3210
 
3211
      if (name(fn) == name_tag && name(son(fn)) == ident_tag
3212
	  && (son(son(fn)) == nilexp || name(son(son(fn))) == proc_tag)) {
2 7u83 3213
	/* the procedure can be entered directly */
3214
	if (			/*!tlrecurse*/1) {
3215
	  baseoff a;
3216
	  integer_jump_external(i_jsr,26,boff(son(fn)));
3217
	  a.base = RA;
3218
	  a.offset=0;
3219
	  load_store(i_ldgp,GP,a);
6 7u83 3220
	}
2 7u83 3221
	else {
3222
	  if (Has_fp) {
3223
	    baseoff b;
3224
	    b.base = FP;
6 7u83 3225
	    b.offset = (frame_size+ callee_size) >>3;
2 7u83 3226
	    restore_sregs(fixdone, fltdone);
3227
	    operate_fmt(i_bis,FP,FP,SP);
3228
	    load_store(i_ldq,FP,b);
6 7u83 3229
	  }
2 7u83 3230
	  else {
3231
	    baseoff b;
3232
	    b.base=SP;
6 7u83 3233
	    b.offset= (frame_size+callee_size) >>3;
3234
 
2 7u83 3235
	    restore_sregs(fixdone, fltdone);
3236
	    load_store(i_lda,SP,b);
6 7u83 3237
	  }
2 7u83 3238
	  integer_jump_external(i_jmp,31,boff(son(fn)));
6 7u83 3239
	  if (as_file) {
3240
	    fprintf(as_file," # Tail recursion\n");
2 7u83 3241
	  }
6 7u83 3242
 
3243
	}
2 7u83 3244
      }
3245
      else {			/* the address of the proc is evaluated
3246
				   and entered indirectly */
3247
	int destreg=reg_operand(fn,guardreg(26,sp));
3248
	operate_fmt(i_bis,destreg,destreg,PV);
3249
	integer_jump(i_jsr,RA,destreg,0);
3250
	load_store(i_ldgp,GP,procbase);
3251
      }
6 7u83 3252
      if (in_general_proc) {
2 7u83 3253
	/* Temporary */
3254
	/*	operate_fmt_immediate(i_addq,SP,(callee_size+frame_size)>>3,FP);*/
3255
      }
3256
      clear_all ();		/* forget all register memories */
3257
      {
3258
	ans aa;
6 7u83 3259
	if (is_floating(hda)) {
2 7u83 3260
	  freg frg;
3261
	  frg.fr = 0;
6 7u83 3262
	  if (hda != shrealhd)
2 7u83 3263
	    frg.type = IEEE_double;
3264
	  else
3265
	    frg.type = IEEE_single;
6 7u83 3266
	  setfregalt(aa, frg);
3267
	  move(aa,dest, sp, 1);
3268
	  /* move floating point result of application
2 7u83 3269
	     to destination */
3270
	}
3271
	else {
6 7u83 3272
	  setregalt(aa, RESULT_REG);
2 7u83 3273
	  mka.regmove = 0;
6 7u83 3274
	  move(aa,dest, sp, 1);
3275
	  /* move floating point result of application to
2 7u83 3276
	     destination */
3277
	}
3278
	/* else struct results are moved by body of proc */
3279
      }
3280
      return mka;
3281
    }				/* end apply */
6 7u83 3282
    case caller_tag: {
2 7u83 3283
      e = son(e);
3284
      goto tailrecurse;
3285
    }
3286
 
6 7u83 3287
    case apply_general_tag: {
2 7u83 3288
      exp fn = son(e);
3289
      exp callers = bro(fn);
3290
      exp cllees = bro(callers);
3291
      exp postlude = bro(cllees);
3292
      space nsp;
3293
      int postlude_arg_space;
3294
      nsp = sp;
6 7u83 3295
      if (no(callers)!= 0) {
2 7u83 3296
	nsp = do_callers(son(callers),sp,&sizecallers);
3297
      }
3298
      else {
3299
	sizecallers = 0;
3300
      }
3301
 
6 7u83 3302
      if ((in_vcallers_apply = call_has_vcallers(cllees))) {
2 7u83 3303
	sizecallers = 12 * REG_SIZE;
3304
      }
3305
      else {
3306
	sizecallers = 6 * REG_SIZE;
3307
      }
6 7u83 3308
 
3309
     (void)make_code(cllees,nsp,nowhere,0);
3310
      if (name(fn) == name_tag && name(son(fn)) == ident_tag &&
3311
	(son(son(fn)) == nilexp || name(son(son(fn))) == proc_tag ||
3312
	  name(son(son(fn))) == general_proc_tag)) {
2 7u83 3313
	baseoff a;
3314
	a.base = RA;
3315
	a.offset = 0;
3316
	integer_jump_external(i_jsr,26,boff(son(fn)));
3317
	load_store(i_ldgp,GP,a);
3318
      }
3319
      else{
3320
	if (Has_fp) {
3321
	  baseoff b;
3322
	  b.base = FP;
6 7u83 3323
	  b.offset = (frame_size+callee_size) >>3;
2 7u83 3324
	  b.offset = -8;
6 7u83 3325
	}
2 7u83 3326
	else {
3327
	  baseoff b;
3328
	  b.base=SP;
6 7u83 3329
	}
2 7u83 3330
	integer_jump_fn(i_jmp,31,fn,sp);
3331
      }
3332
      clear_all();
3333
      {
3334
	int hda = name(sh(e));
3335
	ans aa;
6 7u83 3336
	if (is_floating(hda)) {
2 7u83 3337
	  freg frg;
3338
	  frg.fr = 0;
6 7u83 3339
	  if (hda != shrealhd)
2 7u83 3340
	    frg.type = IEEE_double;
3341
	  else
3342
	    frg.type = IEEE_single;
6 7u83 3343
	  setfregalt(aa, frg);
3344
	  move(aa,dest, sp, 1);
3345
	  /* move floating point result of application
2 7u83 3346
	     to destination */
3347
	}
3348
	else {
6 7u83 3349
	  setregalt(aa, RESULT_REG);
2 7u83 3350
	  mka.regmove = RESULT_REG;
6 7u83 3351
	  move(aa,dest, sp, 1);
2 7u83 3352
	  /* move floating point result of application to destination */
3353
	}
3354
	/* else struct results are moved by body of proc */
3355
      }
6 7u83 3356
      if (in_vcallers_apply) {
2 7u83 3357
	postlude_arg_space = max(max_args,sizecallers);
3358
      }
3359
      else {
3360
	postlude_arg_space = max(max_args,6*PTR_SZ);
3361
      }
6 7u83 3362
 
3363
      if (call_is_untidy(cllees)) {
2 7u83 3364
	operate_fmt_immediate(i_subq,SP,postlude_arg_space>>3,SP);
3365
	reset_tos();
3366
	Assert(name(bro(cllees)) == top_tag);
3367
      }
6 7u83 3368
      else if (postlude_has_call(e)) {
2 7u83 3369
	exp x = son(callers);
3370
	postlude_chain p;
6 7u83 3371
	for (;;) {
3372
	  if (name(x) == caller_tag) {
2 7u83 3373
	    no(x) += postlude_arg_space;
3374
	  }
6 7u83 3375
	  if (last(x))break;
2 7u83 3376
	  x = bro(x);
3377
	}
3378
	comment("In postlude, with call");
3379
	/*	operate_fmt_immediate(i_subq,SP,max_args>>3,SP);*/
3380
 
3381
	mka.regmove = NOREG;
3382
	update_plc(old_postludes,postlude_arg_space);
3383
	p.postlude = postlude;
3384
	p.outer = old_postludes;
3385
	old_postludes = &p;
3386
	operate_fmt_immediate(i_subq,SP,postlude_arg_space>>3,SP);
3387
	(void)make_code(postlude,sp,nowhere,0);
3388
	operate_fmt_immediate(i_addq,SP,postlude_arg_space>>3,SP);
3389
	old_postludes = p.outer;
3390
	update_plc(old_postludes,-postlude_arg_space);
3391
      }
3392
      else {
3393
	(void)make_code(postlude,sp,nowhere,0);
3394
      }
3395
      in_vcallers_apply = 0;
3396
      return mka;
3397
    }
6 7u83 3398
    case caller_name_tag: {
2 7u83 3399
      return mka;
3400
    }
6 7u83 3401
    case make_callee_list_tag: {
3402
      int size  = ((no(e) >>3) + 39) & ~7;
2 7u83 3403
      int alloc_size;
3404
      bool vc = call_has_vcallees(e);
3405
      exp list = son(e);
3406
      instore is;
3407
      where w;
3408
      baseoff b;
3409
      int disp=0;
3410
      ash ap;
3411
      exp anc = father(e);
6 7u83 3412
      if (call_has_vcallers(e)) {
3413
	alloc_size = size + (12 *(PTR_SZ>>3));
2 7u83 3414
	sizecallers = (12*(PTR_SZ));
3415
      }
3416
      else{
6 7u83 3417
	alloc_size = size + ((name(anc) ==tail_call_tag)?(6*PTR_SZ>>3):
3418
			    (sizecallers>>3));
2 7u83 3419
      }
3420
      b.base = SP;
3421
      operate_fmt_immediate(i_subq,SP,alloc_size,SP);
3422
 
6 7u83 3423
      if (name(anc) == tail_call_tag) {
2 7u83 3424
	/*b.offset = alloc_size - (PTR_SZ>>3) - arg_stack_space;*/
3425
	b.offset = alloc_size - (PTR_SZ>>3);
3426
	load_store(i_stq,FP,b);
3427
      }
3428
      else {
6 7u83 3429
	b.offset = alloc_size - (PTR_SZ>>3) - (sizecallers>>3);
2 7u83 3430
	load_store(i_stq,FP,b);
3431
      }
6 7u83 3432
#if 0
3433
      if (!Has_fp)
2 7u83 3434
	operate_fmt_immediate(i_addq,SP,size,FP);
3435
#endif
3436
      update_plc(old_postludes,alloc_size<<3);
6 7u83 3437
      if (no(e)) {
2 7u83 3438
	int lastpar = 0;
6 7u83 3439
	for (;!lastpar;list =  bro(list)) {
2 7u83 3440
	  ap = ashof(sh(list));
3441
	  disp = rounder(disp,ap.ashalign);
3442
	  is.b.offset = disp>>3;
3443
	  is.b.base = SP;
3444
	  is.adval = 1;
3445
	  w.ashwhere = ap;
3446
	  setinsalt(w.answhere,is);
3447
	  code_here(list,sp,w);
3448
	  disp = rounder(disp+ap.ashsize,PTR_SZ);
3449
/*	disp = rounder(disp+ap.ashsize,is32(sh(list))?32:64);*/
3450
	  lastpar = last(list);
3451
	}
3452
      }
3453
      update_plc(old_postludes,-alloc_size<<3);
3454
#if 1
6 7u83 3455
      if (vc  && (name(anc) == apply_general_tag)) {
3456
	operate_fmt_immediate(i_addq,SP,alloc_size,FP);
2 7u83 3457
      }
3458
#endif
3459
      return mka;
3460
    }
3461
 
6 7u83 3462
    case same_callees_tag: {
2 7u83 3463
      baseoff b;
3464
      bool vc = call_has_vcallees(e);
3465
      space nsp;
6 7u83 3466
      if (Has_vcallees) {
2 7u83 3467
	int rsize = getreg(sp.fixed);
3468
	int rsrc,rdest;
3469
	int le = new_label();
3470
	int lb = new_label();
3471
	int tmp;
3472
	nsp = guardreg(rsize,sp);
3473
	tmp = getreg(nsp.fixed);
3474
	nsp = guardreg(tmp,nsp);
3475
	rsrc = getreg(nsp.fixed);
3476
	nsp = guardreg(rsrc,nsp);
3477
	rdest = getreg(nsp.fixed);
3478
	nsp = guardreg(rdest,nsp);
3479
	operate_fmt(i_bis,SP,SP,tmp);
3480
	operate_fmt(i_subq,FP,local_reg,rsize);
6 7u83 3481
	if (!Has_no_vcallers && !call_has_vcallers(e)) {
2 7u83 3482
	  operate_fmt_immediate(i_subq,rsize,6*PTR_SZ>>3,rsize);
3483
	}
6 7u83 3484
 
3485
 
3486
	if ((sizecallers>>3) >arg_stack_space) {
2 7u83 3487
	  operate_fmt_immediate(i_addq,rsize,
6 7u83 3488
				((sizecallers>>3) -arg_stack_space),rsize);
2 7u83 3489
	}
3490
	operate_fmt(i_subq,SP,rsize,SP);
3491
	b.base = tmp;
6 7u83 3492
	b.offset = - (PTR_SZ>>3) - (sizecallers>>3);
2 7u83 3493
	load_store(i_stq,FP,b);
6 7u83 3494
	operate_fmt_immediate(i_subq,FP,4*(PTR_SZ>>3) + (arg_stack_space),
2 7u83 3495
			      rsrc);
6 7u83 3496
	operate_fmt_immediate(i_subq,tmp,(4*(PTR_SZ>>3)) + (sizecallers>>3),
2 7u83 3497
			      rdest);
6 7u83 3498
 
2 7u83 3499
	setnoat();
3500
	operate_fmt(i_cmpeq,rdest,SP,AT);
3501
	integer_branch(i_bne,AT,le);
3502
	setat();
3503
	set_label(lb);
3504
	b.base = rsrc;
6 7u83 3505
	b.offset = - (PTR_SZ>>3);
2 7u83 3506
	load_store(i_ldq,rsize,b);
3507
	b.base = rdest;
3508
	load_store(i_stq,rsize,b);
3509
	operate_fmt_immediate(i_subq,rsrc,PTR_SZ>>3,rsrc);
3510
	operate_fmt_immediate(i_subq,rdest,PTR_SZ>>3,rdest);
3511
	setnoat();
3512
	operate_fmt(i_cmpeq,rdest,SP,AT);
3513
	integer_branch(i_beq,AT,lb);
3514
	setat();
3515
	set_label(le);
6 7u83 3516
	if (vc)operate_fmt(i_bis,tmp,tmp,FP);
2 7u83 3517
      }
3518
      else{
3519
	int cs = callee_size>>3;
3520
	int i;
3521
	int tr = getreg(sp.fixed);
3522
	operate_fmt_immediate(i_subq,SP,cs + (sizecallers>>3),SP);
3523
	b.base = SP;
3524
	b.offset = cs - (PTR_SZ>>3) /*-arg_stack_space*//*-(sizecallers>>3)*/;
3525
	load_store(i_stq,FP,b);
6 7u83 3526
	for (i=cs - (4*8);i>0;i -= 8) {
2 7u83 3527
	  b.base = FP;
3528
	  b.offset = i -cs -8 - (arg_stack_space);
3529
	  load_store(i_ldq,tr,b);
3530
	  b.base = SP;
3531
	  b.offset = i - 8;
3532
	  load_store(i_stq,tr,b);
3533
	}
6 7u83 3534
	if (vc)operate_fmt_immediate(i_addq,SP,cs + (sizecallers>>3),FP);
2 7u83 3535
      }
3536
      return mka;
3537
    }
6 7u83 3538
    case make_dynamic_callee_tag: {
2 7u83 3539
      bool vc = call_has_vcallees(e);
3540
      exp anc = father(e);
3541
      int extra_space;
3542
      int rptr,rsize,rdest,tempreg,ls,le;
3543
      space nsp;
3544
      baseoff b;
3545
      extra_space = (name(anc) == apply_general_tag)?(sizecallers>>3):
3546
	arg_stack_space;
3547
      rptr = getreg(sp.fixed);
3548
      load_reg(son(e),rptr,sp);
3549
      nsp = guardreg(rptr,sp);
3550
      rsize = getreg(nsp.fixed);
3551
      load_reg(bro(son(e)),rsize,sp);
3552
      nsp = guardreg(rsize,nsp);
3553
      rdest = getreg(nsp.fixed);
3554
      nsp = guardreg(rdest,nsp);
3555
      tempreg = getreg(nsp.fixed);
6 7u83 3556
      operate_fmt_immediate(i_addq,rsize,(4*(PTR_SZ>>3) +extra_space) +7,rdest);
2 7u83 3557
      operate_fmt_immediate(i_bic,rdest,7,rdest);
3558
      b.base = SP;
6 7u83 3559
      b.offset = - (PTR_SZ>>3) - (sizecallers>>3);
2 7u83 3560
      load_store(i_stq,FP,b);
6 7u83 3561
      if (vc)operate_fmt(i_bis,SP,SP,FP);
2 7u83 3562
      operate_fmt(i_subq,SP,rdest,SP);
3563
      operate_fmt(i_bis,SP,SP,rdest);
3564
      ls = new_label();
3565
      le = new_label();
3566
      integer_branch(i_ble,rsize,le);
3567
      b.offset = 0;
3568
      set_label(ls);
3569
      b.base = rptr;
3570
      load_store(i_ldq,tempreg,b);
3571
      b.base = rdest;
3572
      load_store(i_stq,tempreg,b);
3573
      operate_fmt_immediate(i_addq,rdest,(PTR_SZ>>3),rdest);
3574
      operate_fmt_immediate(i_addq,rptr,(PTR_SZ>>3),rptr);
3575
      operate_fmt_immediate(i_subq,rsize,(PTR_SZ>>3),rsize);
3576
      integer_branch(i_bgt,rsize,ls);
3577
      set_label(le);
3578
      return mka;
3579
    }
3580
 
6 7u83 3581
    case tail_call_tag: {
2 7u83 3582
      exp fn = son(e);
3583
      exp cllees = bro(fn);
3584
      exp bdy = son(crt_proc);
3585
      int stack_space;
3586
      int rsize = -1;
3587
      space nsp;
3588
      nsp = sp;
3589
      stack_space = max(arg_stack_space,6*(PTR_SZ>>3));
6 7u83 3590
 
3591
      if (name(cllees) == make_callee_list_tag) {
2 7u83 3592
	code_here(cllees,sp,nowhere);
3593
      }
6 7u83 3594
      for (;name(bdy) ==dump_tag || name(bdy) ==diagnose_tag;bdy = son(bdy));
2 7u83 3595
 
6 7u83 3596
      while (name(bdy) == ident_tag && isparam(bdy)) {
3597
	/* go throught the current callers, making sure they are
2 7u83 3598
	   in the right place */
3599
	exp sbody = son(bdy);
3600
	baseoff b;
6 7u83 3601
	if (Has_fp) {
2 7u83 3602
	  b.base = FP;
6 7u83 3603
	  b.offset = (no(sbody) >>3) - stack_space;
2 7u83 3604
	}
3605
	else {
3606
	  b.base = SP;
6 7u83 3607
	  b.offset = (no(sbody) + frame_size + callee_size) >>3;
2 7u83 3608
	}
6 7u83 3609
#if 0
2 7u83 3610
 
3611
 
3612
	b.base = FP;
6 7u83 3613
	b.offset = (no(sbody)>>3) - (PTR_SZ>>3)  ;  /* This will work its
3614
						       way through the
2 7u83 3615
						       caller param area */
6 7u83 3616
	b.offset = no(sbody) >>3;
2 7u83 3617
#endif
3618
 
6 7u83 3619
	if (name(sbody) == formal_callee_tag) {
3620
	  if ((props(bdy) & inanyreg)) {
2 7u83 3621
	    b.offset -= callee_size>>3;
6 7u83 3622
	    if (isvar(bdy)) {
3623
	      if (is_floating(name(sh(sbody)))) {
2 7u83 3624
		float_load_store((name(sh(sbody)) == shrealhd)?i_sts : i_stt,
3625
				 no(bdy),b);
3626
	      }
3627
	      else {
3628
		load_store(is64(sh(sbody))?i_stq : i_stl,no(bdy),b);
3629
	      }
3630
	    }
3631
	  }
3632
	}
6 7u83 3633
	else if (props(sbody) ==0 && (props(bdy) &inanyreg)!=0) {
2 7u83 3634
	  /* move from reg to store */
6 7u83 3635
	  if (isvar(bdy)) {
3636
	    if (is_floating(name(sh(sbody)))) {
3637
	      float_load_store((name(sh(sbody)) ==shrealhd)?i_sts:i_stt,
2 7u83 3638
			       no(bdy),b);
3639
	    }
3640
	    else{
3641
	      load_store(is64(sh(sbody))?i_stq:i_stl,props(sbody),b);
3642
	    }
3643
	  }
3644
	}
6 7u83 3645
	else if (props(sbody)!= 0 && (props(bdy) & inanyreg) ==0) {
2 7u83 3646
	  /* move from store to reg */
6 7u83 3647
	  if (is_floating(name(sh(sbody)))) {
3648
	    float_load_store((name(sh(sbody)) ==shrealhd)?i_lds:i_ldt,
2 7u83 3649
			     props(sbody),b);
3650
	  }
3651
	  else{
6 7u83 3652
	    if (isvis(bdy) && last_param(bdy) && !Has_no_vcallers) {
2 7u83 3653
	      int this_reg = props(sbody);
3654
	      int r;
3655
	      Assert(this_reg>=16);
6 7u83 3656
	      b.offset = ((this_reg+1-16) <<3) + ((gpdumpstart - frame_size) >>3);
3657
	      for (r = this_reg+1;r <= LAST_INT_ARG;++r) {
2 7u83 3658
		load_store(i_ldq,r,b);
3659
		b.offset += (REG_SIZE>>3);
3660
	      }
6 7u83 3661
	      b.offset = ((paramsdumpstart-frame_size) >>3);
3662
	      for (r = FIRST_FLOAT_ARG;r<= LAST_FLOAT_ARG;++r) {
2 7u83 3663
		float_load_store(i_ldt,r,b);
3664
		b.offset += (REG_SIZE>>3);
3665
	      }
6 7u83 3666
	      b.offset = ((this_reg-16) <<3) + ((gpdumpstart-frame_size) >>3);
2 7u83 3667
	      load_store(is64(sh(sbody))?i_ldq:i_ldl,props(sbody),b);
3668
	    }
3669
	    else {
3670
	      load_store(is64(sh(sbody))?i_ldq:i_ldl,props(sbody),b);
3671
	    }
6 7u83 3672
 
2 7u83 3673
	  }
3674
	}
6 7u83 3675
	else if (props(sbody)!=0 && (props(sbody)!= no(bdy))) {
2 7u83 3676
	  /* move from reg to reg */
6 7u83 3677
	  if (is_floating(name(sh(sbody)))) {
2 7u83 3678
	    float_op(i_cpys,no(bdy),no(bdy),props(sbody));
3679
	  }
3680
	  else{
3681
	    operate_fmt(i_bis,no(bdy),no(bdy),props(sbody));
3682
	  }
3683
	}
3684
	bdy = bro(sbody);
3685
      }
3686
      restore_sregs(fixdone,fltdone);
3687
 
3688
      /*
6 7u83 3689
	Allocate space on the frame for the number of callees used
3690
	in the tail call which exceed the number of callees for
3691
	this procedure
2 7u83 3692
	*/
6 7u83 3693
      if (name(cllees) == make_callee_list_tag) {
2 7u83 3694
	int x = (((no(cllees) >> 3) + 39) & ~7) + stack_space;
3695
	baseoff b;
3696
	int i;
6 7u83 3697
	int rndcllees = ((no(cllees) >>3) +7) &~7;
2 7u83 3698
	setnoat();
6 7u83 3699
	for (i=no(cllees) >>3;i>0;i -= (PTR_SZ>>3)) {
2 7u83 3700
	  b.base = SP;
3701
	  b.offset = i - (PTR_SZ>>3);
3702
	  load_store(i_ldq,AT,b);
3703
	  b.base = FP;
6 7u83 3704
	  b.offset = i- (4*(PTR_SZ>>3)) - (rndcllees + (PTR_SZ>>3))
2 7u83 3705
	    - stack_space;
3706
	  load_store(i_stq,AT,b);
3707
	}
3708
	setat();
3709
	operate_fmt_immediate(i_subq,FP,x,SP);
3710
      }
6 7u83 3711
      else if (name(cllees) == make_dynamic_callee_tag) {
2 7u83 3712
	int rdest,rsource,tempreg,le,ls;
3713
	space nsp;
3714
	baseoff b;
3715
	rdest = getreg(sp.fixed);
3716
	nsp = guardreg(rdest,sp);
3717
	rsource = getreg(nsp.fixed);
3718
	load_reg(son(cllees),rsource,sp);
3719
	nsp = guardreg(rsource,nsp);
3720
	rsize = getreg(nsp.fixed);
3721
	load_reg(bro(son(cllees)),rsize,nsp);
3722
	nsp = guardreg(rsize,nsp);
3723
	tempreg = getreg(nsp.fixed);
6 7u83 3724
	operate_fmt_immediate(i_subq,FP,4*(PTR_SZ>>3) +stack_space,rdest);
2 7u83 3725
	operate_fmt_immediate(i_addq,rsize,7,rsize);
3726
	operate_fmt_immediate(i_bic,rsize,7,rsize);
3727
	operate_fmt(i_addq,rsource,rsize,rsource);
3728
	le = new_label();
3729
	ls = new_label();
3730
	integer_branch(i_ble,rsize,le);
3731
	set_label(ls);
3732
	b.base = rsource;
6 7u83 3733
	b.offset = - (PTR_SZ>>3);
2 7u83 3734
	load_store(i_ldq,tempreg,b);
3735
	b.base = rdest;
3736
	load_store(i_stq,tempreg,b);
3737
	operate_fmt_immediate(i_subq,rdest,(PTR_SZ>>3),rdest);
3738
	operate_fmt_immediate(i_subq,rsource,(PTR_SZ>>3),rsource);
3739
	operate_fmt_immediate(i_subq,rsize,(PTR_SZ>>3),rsize);
3740
	integer_branch(i_bgt,rsize,ls);
3741
	set_label(le);
3742
	operate_fmt(i_bis,rdest,rdest,SP);
3743
      }
3744
      else{
6 7u83 3745
	if (Has_vcallees) {
2 7u83 3746
	  operate_fmt(i_bis,local_reg,local_reg,SP);
3747
	}
3748
	else{
6 7u83 3749
	  operate_fmt_immediate(i_subq,FP,stack_space+ (callee_size>>3),SP);
2 7u83 3750
	}
3751
      }
6 7u83 3752
      if (Has_vcallees) {
2 7u83 3753
	baseoff b;
3754
	b.base = FP;
6 7u83 3755
	b.offset = (-4 *(PTR_SZ>>3)) - stack_space;
2 7u83 3756
	load_store(i_ldq,local_reg,b);
3757
      }
6 7u83 3758
 
3759
      if (!in_general_proc) {
2 7u83 3760
	baseoff b;
3761
	b.base = FP;
6 7u83 3762
	b.offset = - (PTR_SZ>>3) -arg_stack_space;
2 7u83 3763
	setnoat();
3764
	load_store(i_ldq,AT,b);
3765
	b.base = SP;
6 7u83 3766
	if (name(cllees)!=make_dynamic_callee_tag) {
3767
	  b.offset = (((no(cllees) >> 3) + 39) & ~7) - (PTR_SZ>>3);
2 7u83 3768
	}
3769
	else {
3770
	  load_reg(bro(son(cllees)),rsize,sp);
3771
	  operate_fmt_immediate(i_addq,rsize,7,rsize);
3772
	  operate_fmt_immediate(i_bic,rsize,7,rsize);
6 7u83 3773
	  operate_fmt_immediate(i_addq,rsize,(39&~7) - (PTR_SZ>>3),rsize);
2 7u83 3774
	  operate_fmt(i_addq,rsize,SP,rsize);
3775
	  b.base = rsize;
3776
	  b.offset = 0;
3777
	}
6 7u83 3778
 
2 7u83 3779
	load_store(i_stq,AT,b);
6 7u83 3780
	if (Has_vcallees) {
2 7u83 3781
	  operate_fmt(i_bis,FP,FP,local_reg);
3782
	}
3783
      }
6 7u83 3784
 
2 7u83 3785
      {
3786
	int rt = getreg(sp.fixed);
3787
	rt = reg_operand(fn,guardreg(RA,sp));
3788
	operate_fmt(i_bis,rt,rt,PV);
3789
	integer_jump(i_jmp,31,rt,0);
3790
	/*integer_jump_external(i_jmp,31,boff(son(fn)));*/
3791
      }
3792
      return mka;
3793
    }
3794
#ifdef return_to_label_tag
6 7u83 3795
    case return_to_label_tag: {
2 7u83 3796
      int r = getreg(sp.fixed);
3797
      where w;
3798
      w.ashwhere.ashsize = 64;
3799
      w.ashwhere.ashalign = 64;
3800
      setregalt(w.answhere,r);
3801
      code_here(son(e),sp,w);
3802
      clear_all();
6 7u83 3803
      if (Has_fp) {
2 7u83 3804
	baseoff b;
3805
	b.base = FP;
3806
	restore_sregs(fixdone,fltdone);
6 7u83 3807
	if (Has_vcallees) {
2 7u83 3808
	  b.offset = -4*(PTR_SZ>>3);
3809
	  load_store(i_ldq,local_reg,b);
3810
	}
6 7u83 3811
	b.offset = - (PTR_SZ>>3) - arg_stack_space;
2 7u83 3812
	operate_fmt(i_bis,FP,FP,SP);
3813
	load_store(i_ldq,FP,b);
3814
      }
6 7u83 3815
      else if (frame_size != 0) {
2 7u83 3816
	restore_sregs(fixdone,fltdone);
3817
	operate_fmt_immediate(i_addq,SP,frame_size>>3,SP);
3818
      }
3819
      integer_jump(i_jmp,31,r,0);
3820
      clear_all();
3821
      return mka;
3822
    }
6 7u83 3823
#endif
2 7u83 3824
 
6 7u83 3825
    case untidy_return_tag:
3826
    case res_tag: {
2 7u83 3827
      where w;
3828
      w.answhere = procans;
6 7u83 3829
      w.ashwhere = ashof(sh(son(e)));
3830
      code_here(son(e), sp, w);
2 7u83 3831
      /* evaluate result value */
6 7u83 3832
      if (name(e) == untidy_return_tag)comment("untidy return");
3833
 
2 7u83 3834
      clear_all ();		/* clear all register memories */
3835
      if (rscope_level == 0) {/* normal proc body */
3836
	if (name(son(e)) == apply_tag && props(e)) return mka;
3837
	/* was a tail recursion */
3838
	if (frame_size == 0 && !Has_fp) {
3839
	  integer_jump(i_ret,31,RA,1);
3840
	}
3841
	if (result_label != 0) {
3842
	  integer_branch(i_br,31,result_label);
3843
	  comment(" Return ");
3844
	}
3845
	else{
6 7u83 3846
	  if ((fixdone|fltdone) ==0) {
2 7u83 3847
	    result_label = new_label();
3848
	    set_label(result_label);
3849
	  }
3850
	  if (Has_fp) {
3851
	    baseoff b;
3852
	    b.base = FP;
6 7u83 3853
	    restore_sregs(fixdone, fltdone);
3854
	    if (Has_vcallees) {
3855
	      b.offset = -4 *(PTR_SZ>>3) - arg_stack_space;
2 7u83 3856
	      load_store(i_ldq,local_reg,b);
3857
	    }
6 7u83 3858
	    b.offset = (in_general_proc)?(-PTR_SZ>>3):(-arg_stack_space- (PTR_SZ>>3));;
3859
	    b.offset = (-arg_stack_space- (PTR_SZ>>3));;
2 7u83 3860
#if 0
6 7u83 3861
	    if (arg_stack_space && in_general_proc && name(e) == res_tag) {
2 7u83 3862
	      operate_fmt_immediate(i_addq,FP,arg_stack_space,SP);
3863
	    }
3864
 
6 7u83 3865
	    else
2 7u83 3866
#endif
6 7u83 3867
	      if (name(e) == res_tag) {
2 7u83 3868
		operate_fmt(i_bis,FP,FP,SP);
3869
	    }
3870
	    load_store(i_ldq,FP,b);
3871
	  }
6 7u83 3872
	  else {
2 7u83 3873
	    baseoff a;
6 7u83 3874
	    restore_sregs(fixdone, fltdone);
2 7u83 3875
	    /* restore dumped value of s-regs on entry */
3876
	    a.base=SP;
6 7u83 3877
	    a.offset= (callee_size+frame_size) >>3;
3878
	    if (a.offset!=0 && name(e) == res_tag)
2 7u83 3879
	      load_store(i_lda,SP,a);
3880
	    /* reset stack ptr */
3881
	  }
3882
	  integer_jump(i_ret,31,RA,1);
3883
	}
3884
      }
3885
      else {			/* inlined result */
6 7u83 3886
	if (rscope_label == 0)rscope_label = new_label();
2 7u83 3887
	if (rscope_label != exitlab) {
3888
	  integer_branch(i_br,31,rscope_label);
3889
	  /*
3890
	    uncond_ins (i_b, rscope_label);*/
3891
	}
3892
      }
3893
      sizecallers = 0;
3894
      return mka;
3895
    }				/* end result */
3896
 
6 7u83 3897
    case diagnose_tag: {
2 7u83 3898
      output_diag(dno(e),0,e);
3899
/*      output_symbolic_diagnostic(as_file,dno(e));*/
6 7u83 3900
      mka = make_code(son(e), sp, dest, exitlab);
2 7u83 3901
      output_end_scope(dno(e),e);
3902
      return mka;
3903
    }
6 7u83 3904
    case solve_tag: {
3905
      exp m = bro(son(e));
2 7u83 3906
      int   l = exitlab;
3907
      if (dest.answhere.discrim == insomereg) {
3908
	/* choose register for result */
6 7u83 3909
	int  *sr = someregalt(dest.answhere);
2 7u83 3910
	if (*sr != -1) {
6 7u83 3911
	  failer("Somereg *2");
3912
	}
3913
	*sr = getreg(sp.fixed);
3914
	setregalt(dest.answhere, *sr);
2 7u83 3915
      }
6 7u83 3916
      else if (dest.answhere.discrim == insomefreg) {
2 7u83 3917
	somefreg sfr;
3918
	freg fr;
3919
	sfr = somefregalt(dest.answhere);
6 7u83 3920
	if (*sfr.fr != -1) { failer("Somefreg *2"); }
2 7u83 3921
	*sfr.fr = getfreg(sp.flt);
3922
	fr.fr = *sfr.fr;
3923
	fr.type = sfr.type;
3924
	setfregalt(dest.answhere, fr);
3925
      }
3926
 
3927
      for (;;) {		/* set up all the labels in the component
3928
				   labst_tags */
6 7u83 3929
	no(son(m)) = new_label();
3930
	if (last(m))
2 7u83 3931
	  break;
6 7u83 3932
	m = bro(m);
2 7u83 3933
      }
3934
 
6 7u83 3935
      m = son(e);
3936
      for (;;) {		/* evaluate all the component statements
2 7u83 3937
				 */
6 7u83 3938
	int   fl = make_code(m, sp, dest, l).lab;
3939
	clear_all();
2 7u83 3940
	if (fl != 0)
3941
	  l = fl;
3942
	if (!last (m)) {	/* jump to end of solve */
3943
	  if (l == 0)
6 7u83 3944
	    l = new_label();
3945
	  if (name(sh(m))!= bothd) {
2 7u83 3946
	    integer_branch(i_br,31,l);
3947
	  }
3948
	}
6 7u83 3949
	if (last(m)) {
2 7u83 3950
	  mka.lab = l;
3951
	  return mka;
3952
	}
6 7u83 3953
	m = bro(m);
2 7u83 3954
      }
3955
    }				/* end solve */
3956
 
3957
      /*
3958
	case_tag now uses the INT64 type.
3959
	*/
6 7u83 3960
    case case_tag: {
2 7u83 3961
      char * outline = (char*)NULL;
6 7u83 3962
      int   r = reg_operand(son(e), sp);
2 7u83 3963
      /* evaluate controlling integer into reg r */
3964
      mm lims;
6 7u83 3965
      exp z = bro(son(e));
2 7u83 3966
      exp zt = z;
3967
      INT64  n;
3968
      INT64  l;
3969
      INT64  u;
3970
      INT64 xt,yt;
3971
      int control_sgned = is_signed(sh(son(e)));
3972
      u = make_INT64(0x80000000,0x00000000);
3973
      /*INT64_assign(u,smin);*/
3974
      comment(" begin case ");
3975
      INT64_assign(l,exp_to_INT64(zt));
6 7u83 3976
      for (n=make_INT64(0,1);;n=INT64_increment(n)) {
2 7u83 3977
	/* calculate crude criterion for using
3978
	   jump vector or branches */
6 7u83 3979
	if (!(INT64_eq(INT64_increment(u),exp_to_INT64(zt))) &&
3980
	  (son(zt)!=nilexp)) {
2 7u83 3981
	  n = INT64_increment(n);
3982
	}
6 7u83 3983
	if (last(zt)) {
3984
	  u = (son(zt)!= nilexp)? exp_to_INT64(son(zt)):exp_to_INT64(zt);
2 7u83 3985
	  break;
3986
	}
6 7u83 3987
	if (son(zt)!= nilexp) {
3988
	  u = exp_to_INT64(son(zt));
2 7u83 3989
	}
3990
	else {
6 7u83 3991
	  if (INT64_eq(INT64_increment(u),exp_to_INT64(zt))) {
2 7u83 3992
	    u = INT64_increment(u);
3993
	  }
3994
	}
3995
 
6 7u83 3996
	zt = bro(zt);
2 7u83 3997
      }
3998
 
3999
      /* now l is lowest controlling value and u is highest */
4000
      /*	 The above actually means: */
6 7u83 4001
      if (control_sgned) {
2 7u83 4002
	xt = (INT64_subtract(INT64_shift_right(u,1,1),
4003
			     INT64_shift_right(l,1,1),1));
4004
	yt = (INT64_subtract(INT64_divide(INT64_mult(n,n,1),
4005
					  make_INT64(0,4),1),
4006
			     make_INT64(0,3),1));
4007
      }
4008
      else {
6 7u83 4009
	unsigned long uu = unsigned_rep(u,sh(son(e)));
4010
	unsigned long lu = unsigned_rep(l,sh(son(e)));
2 7u83 4011
	xt = (INT64_subtract(INT64_shift_right(uu,1,1),
4012
			     INT64_shift_right(lu,1,1),1));
4013
	yt = (INT64_subtract(INT64_divide(INT64_mult(n,n,1),
4014
					  make_INT64(0,4),1),
4015
			     make_INT64(0,3),1));
4016
      }
6 7u83 4017
 
4018
 
4019
       if (xt <= yt) {
4020
	/* space-time product criterion for jump vector instead
2 7u83 4021
	   of tests  and branches */
4022
	/* use jump vector */
6 7u83 4023
	int   endlab = new_label();
4024
	int   veclab = next_dlab_sym();
2 7u83 4025
	baseoff zeroveclab;
4026
	baseoff zero3;
4027
	int  rtmp=getreg(guardreg(r,sp).fixed); /* could use AT */
4028
 
4029
 
4030
 
4031
	zero3.base = rtmp;
4032
	zero3.offset = 0;
4033
	zeroveclab.offset = 0;
4034
	zeroveclab.base = veclab;
4035
	n = l;
4036
	start_new_capsule(false);
6 7u83 4037
	if (as_file) {
2 7u83 4038
#if !DO_SCHEDULE
6 7u83 4039
	  fprintf(as_file, "\t.rdata\n$$%d:\n", veclab);
2 7u83 4040
#else
4041
	  outline = (char*)xcalloc(30,sizeof(char));
6 7u83 4042
	  sprintf(outline, "\t.rdata\n$$%d:\n", veclab);
2 7u83 4043
#endif
4044
	}
4045
#if DO_SCHEDULE
4046
	output_instruction(class_null,outline,out_common(0,irdata));
4047
	output_instruction(class_null,(char*)NULL,
4048
			   out_common(tempsnos[veclab-32],ilabel));
4049
#else
6 7u83 4050
	out_common(0, irdata);
4051
	out_common(tempsnos[veclab - 32], ilabel);
2 7u83 4052
#endif
4053
	for (;;) {
6 7u83 4054
	  for (; INT64_lt(n,exp_to_INT64(z));
4055
		 n = INT64_increment(n)) {
2 7u83 4056
	    /* o/p jump vector */
6 7u83 4057
	    if (as_file) {
2 7u83 4058
#if !DO_SCHEDULE
6 7u83 4059
	      fprintf(as_file, "\t.gprel32\t$%d\n", endlab);
2 7u83 4060
#else
4061
	      outline = (char*)xcalloc(30,sizeof(char));
6 7u83 4062
	      sprintf(outline, "\t.gprel32\t$%d\n", endlab);
2 7u83 4063
#endif
4064
	    }
4065
#if DO_SCHEDULE
4066
	    output_instruction(class_null,outline,
4067
			       out_value(-endlab,igprel32,0,1));
6 7u83 4068
#else
4069
	    out_value(-endlab, igprel32, make_INT64(0,0), 1);
2 7u83 4070
#endif
4071
	  }
6 7u83 4072
	  u = (son(z) == nilexp)? n : exp_to_INT64(son(z));
2 7u83 4073
	  for (; INT64_leq(n,u) /*n <= u*/; n=INT64_increment(n)/*n++*/){
6 7u83 4074
	    if (as_file) {
2 7u83 4075
#if !DO_SCHEDULE
6 7u83 4076
	      fprintf(as_file, "\t.gprel32\t$%d\n", no(son(pt(z))));
2 7u83 4077
#else
4078
	      outline = (char*)xcalloc(30,sizeof(char));
6 7u83 4079
	      sprintf(outline, "\t.gprel32\t$%d\n", no(son(pt(z))));
2 7u83 4080
#endif
4081
	    }
4082
#if DO_SCHEDULE
4083
	    output_instruction(class_null,outline,
4084
			       out_value(-no(son(pt(z))),igprel32,0,1));
6 7u83 4085
#else
2 7u83 4086
	    out_value(-no(son(pt(z))),igprel32,make_INT64(0,0),1);
4087
#endif
4088
	  }
6 7u83 4089
	  if (last(z))
2 7u83 4090
	    break;
6 7u83 4091
	  z = bro(z);
2 7u83 4092
	}
4093
	set_text_section();
4094
	setnoat();
6 7u83 4095
	load_store(i_lda, AT, zeroveclab);
2 7u83 4096
	if (!INT64_eq(l,zero_int64) /*l != 0*/) {
4097
	  int rtmp2;
4098
	  INT64 lit;
4099
	  space newsp;
4100
	  newsp = guardreg(r,sp);
4101
	  newsp = guardreg(rtmp,newsp);
4102
	  rtmp2 = getreg(newsp.fixed);
4103
	  lit=INT64_subtract(make_INT64(0,0),l,1);
6 7u83 4104
	  operate_fmt_big_immediate(i_addq, r, lit,rtmp);
2 7u83 4105
	  lit = INT64_increment(INT64_subtract(u,l,1));
4106
	  operate_fmt_big_immediate(i_cmpult,rtmp,lit,rtmp2);
4107
	  integer_branch(i_beq,rtmp2,endlab);
4108
	  operate_fmt(i_s4addq,rtmp,AT,rtmp);
4109
	}
4110
	else {
4111
	  int rtmp2;
4112
	  space newsp;
4113
	  newsp = guardreg(r,sp);
4114
	  newsp = guardreg(rtmp,newsp);
4115
	  rtmp2 = getreg(newsp.fixed);
4116
	  load_store_immediate(i_ldiq,rtmp2,INT64_increment(u));
4117
 
6 7u83 4118
/*	   operate_fmt(i_subq,r,rtmp2,rtmp);
2 7u83 4119
	   integer_branch(i_bge,rtmp,endlab); */
4120
	  operate_fmt(i_cmpule,rtmp2,r,rtmp);
4121
	  integer_branch(i_bne,rtmp,endlab);
4122
	  operate_fmt(i_s4addq,r,AT,rtmp);
4123
	}
4124
	setat();
4125
	load_store(i_ldl,rtmp,zero3);
4126
	operate_fmt(i_addq,rtmp,GP,rtmp);
4127
	integer_jump(i_jmp,31,rtmp,endlab); /* endlab is hint */
6 7u83 4128
	set_label(endlab);
2 7u83 4129
	close_capsule();
4130
	comment(" end case ");
4131
	return mka;
4132
      }
4133
      else {
4134
	int   over = 0;	/* use branches - tests are already
4135
			   ordered */
4136
	int rtmp = getreg(guardreg(r,sp).fixed);
4137
	bool usw;
6 7u83 4138
	lims = maxmin(sh(son(e)));
2 7u83 4139
	usw = !is_signed(sh(son(e)));
4140
	for (;;) {
4141
	  int lab = no(son(pt(z))); /* can this be big */
4142
	  l = exp_to_INT64(z);
6 7u83 4143
	  if (isbigval(son(pt(z))))
2 7u83 4144
	    alphafail(BIG_LABEL);
4145
	  if (son (z) == nilexp) { /* only single test required */
4146
	    operate_fmt_big_immediate(i_cmpeq,r,l,rtmp);
4147
	    integer_branch(i_bne,rtmp,lab);
6 7u83 4148
	    if (INT64_eq(l,lims.maxi)) {
2 7u83 4149
	      lims.maxi = INT64_decrement(lims.maxi);
4150
	    }
4151
	    else if (INT64_eq(l,lims.mini)) {
4152
	      lims.mini = INT64_increment(lims.mini);
4153
	    }
4154
	  }
6 7u83 4155
	  else if (u = exp_to_INT64(son(z)),
4156
		   INT64_leq(lims.mini,l) ||usw) {
2 7u83 4157
/*	       if (INT64_lt(lims.maxi,INT64_and(INT64_not(usw),u))){ */
6 7u83 4158
	    if (INT64_leq(lims.maxi,u) && !usw) {
2 7u83 4159
	      /* have already tested lower */
4160
	      operate_fmt_big_immediate(i_cmplt,r,l,rtmp);
4161
	      integer_branch(i_beq,rtmp,lab);
4162
	      lims.maxi = INT64_decrement(l);
4163
	    }
4164
	    else {
4165
	      if (over == 0) {
6 7u83 4166
		over = new_label();
2 7u83 4167
	      }
4168
	      operate_fmt_big_immediate(i_cmplt,r,l,rtmp);
4169
	      integer_branch(i_bne,rtmp,over);
4170
	      operate_fmt_big_immediate(i_cmple,r,u,rtmp);
4171
	      integer_branch(i_bne,rtmp,lab);
4172
	      lims.mini = INT64_increment(u);
6 7u83 4173
	    }
2 7u83 4174
	  }
6 7u83 4175
	  else if  (INT64_lt(u,lims.maxi)) {/*lower is <= lower limit
2 7u83 4176
					      of shape*/
4177
	    operate_fmt_big_immediate(i_cmple,r,u,rtmp);
4178
	    integer_branch(i_bne,rtmp,lab);
4179
	    lims.mini = INT64_increment(u);
4180
	  }
4181
	  else {	/* upper is >= upper limit of shape */
4182
	    integer_branch(i_br,31,lab);
4183
	  }
6 7u83 4184
	  if (last(z)) {
2 7u83 4185
	    if (over != 0) {
6 7u83 4186
	      set_label(over);
4187
	    }
2 7u83 4188
	    comment(" end case ");
4189
	    return mka;
4190
	  }
6 7u83 4191
	  z = bro(z);
2 7u83 4192
	}
4193
      }
4194
    } /* end case */
4195
 
6 7u83 4196
    case plus_tag:
4197
    case offset_add_tag:{
4198
      if (optop(e)) {
2 7u83 4199
	mka.regmove = comm_op(e,sp,dest,(dest.ashwhere.ashsize==32)?
4200
			      i_addl:i_addq);
4201
	return mka;
4202
      }
4203
#if 0
4204
      if(error_treatment_is_trap(e) /*&& is_signed(sh(e))*/){
4205
	mka.regmove = comm_op(e,sp,dest,(dest.ashwhere.ashsize==32)?
4206
			      i_addlv:i_addqv);
4207
	return mka;
4208
      }
6 7u83 4209
#endif
2 7u83 4210
      else{
4211
	int r1 = reg_operand(son(e), sp);
4212
	int r2,r0;
4213
	int over = new_label();
4214
	int trap = trap_label(e);
4215
	space nsp;
4216
	ans aa;
4217
	nsp = guardreg(r1, sp);
4218
	r2 = reg_operand(bro(son(e)), nsp);
4219
	nsp = guardreg(r2, nsp);
4220
	r0 = getreg(nsp.fixed);
4221
	nsp = guardreg(r0, nsp);
4222
	operate_fmt(is64(sh(e))?i_addq:i_addl,r1,r2,r0);
6 7u83 4223
	switch (name(sh(e))) {
4224
	  case s64hd:
4225
	  case slonghd:{
2 7u83 4226
	    int r3 = getreg(sp.fixed);
4227
	    operate_fmt(i_xor,r1,r2,r3);
4228
	    integer_branch(i_blt,r3,over);
4229
	    operate_fmt(i_xor,r0,r1,r3);
6 7u83 4230
	    if (error_treatment_is_trap(e)) {
2 7u83 4231
	      integer_branch(i_bge,r3,over);
4232
	      do_exception(f_overflow);
4233
	    }
4234
	    else{
4235
	      integer_branch(i_blt,r3,trap);
4236
	    }
4237
	    set_label(over);
4238
	    break;
4239
	  }
6 7u83 4240
	  case ulonghd:
4241
	  case u64hd:{
2 7u83 4242
	    int r3 = getreg(sp.fixed);
4243
	    operate_fmt(i_cmpult,r0,r1,r3);
6 7u83 4244
	    if (error_treatment_is_trap(e)) {
2 7u83 4245
	      int oklab = new_label();
4246
	      integer_branch(i_beq,r3,oklab);
4247
	      do_exception(f_overflow);
4248
	      set_label(oklab);
4249
	    }
4250
	    else{
4251
	      integer_branch(i_bne,r3,trap);
4252
	    }
4253
	    break;
4254
	  }
6 7u83 4255
	  case uwordhd:{
4256
	    if (error_treatment_is_trap(e)) {
2 7u83 4257
	      test_unsigned_and_trap(r0,0xffff,f_overflow);
4258
	    }
4259
	    else{
4260
	      test_unsigned(r0,0xffff,trap);
4261
	    }
4262
	    break;
4263
	  }
6 7u83 4264
	  case swordhd:{
4265
	    if (error_treatment_is_trap(e)) {
2 7u83 4266
	      test_signed_and_trap(r0,-0x8000L,0x7fff,f_overflow);
4267
	    }
4268
	    else{
4269
	      test_signed(r0,-0x8000L,0x7fff,trap);
4270
	    }
4271
	    break;
4272
	  }
6 7u83 4273
	  case ucharhd:{
4274
	    if (error_treatment_is_trap(e)) {
2 7u83 4275
	      test_unsigned_and_trap(r0,255,f_overflow);
4276
	    }
4277
	    else{
4278
	      test_unsigned(r0,255,trap);
4279
	    }
4280
	    break;
4281
	  }
6 7u83 4282
	  case scharhd:{
4283
	    if (error_treatment_is_trap(e)) {
2 7u83 4284
	      test_signed_and_trap(r0,-128,127,f_overflow);
4285
	    }
4286
	    else{
4287
	      test_signed(r0,-128,127,trap);
4288
	    }
4289
	    break;
4290
	  }
4291
	  default:failer("illegal shape");
4292
	}
4293
	setregalt(aa,r0);
4294
	mka.regmove = move(aa,dest,nsp,0);
4295
	return mka;
4296
      }
4297
    } /* end plus */
4298
 
6 7u83 4299
    case chvar_tag: {
2 7u83 4300
      int   a;
4301
      int tmpreg;
4302
      int   d;
4303
      ans aa;
6 7u83 4304
      int   nsh = name(sh(e));
2 7u83 4305
      switch (dest.answhere.discrim) {
6 7u83 4306
	case inreg: {
2 7u83 4307
	  ash arga;
6 7u83 4308
	  arga = ashof(sh(son(e)));
2 7u83 4309
	  if (arga.ashsize <= dest.ashwhere.ashsize) {
4310
	    dest.ashwhere = arga;
4311
	  }
6 7u83 4312
	  a = regalt(dest.answhere);
2 7u83 4313
	  if (a == NO_REG) {
4314
	    a = getreg(sp.fixed);
4315
	    setregalt(dest.answhere,a);
4316
	    dest.ashwhere.ashsize = shape_size(sh(son(e)));
4317
	    dest.ashwhere.ashalign = dest.ashwhere.ashsize;
4318
	  }
6 7u83 4319
	  code_here(son(e), sp, dest);
2 7u83 4320
	  /* evaluate argument into reg */
4321
	  break;
4322
	}
6 7u83 4323
	default:
4324
	a = reg_operand(son(e), sp);
2 7u83 4325
	/* evaluate arguement into a */
6 7u83 4326
      }
4327
      setregalt(aa, a);
4328
      if (sh(son(e)) == sh(e)) {
2 7u83 4329
	mka.regmove = move(aa,dest,sp,1);
4330
	return mka;
4331
      }
4332
 
6 7u83 4333
      if ((dest.answhere.discrim == inreg) &&
4334
	(dest.answhere.val.regans == a)) {
2 7u83 4335
	tmpreg = a;
4336
      }
4337
      else{
4338
	tmpreg = getreg(sp.fixed);
4339
      }
4340
 
6 7u83 4341
      if (nsh >= s64hd) {
4342
	/* destination is 64 bits wide, the only thing we have
4343
	   to worry about is the conversion of unsigned
4344
	   values to signed, which can be avoided by the
2 7u83 4345
	   following code */
6 7u83 4346
	if (convert_shapes(nsh,name(sh(son(e))),a,tmpreg)) {
2 7u83 4347
	  setregalt(aa,tmpreg);
4348
	}
4349
	mka.regmove = move(aa,dest,sp,1);
4350
	return mka;
4351
      }
4352
      if (sh (son (e)) == sh (e) /*|| nsh  >= slonghd*/) {
4353
	/* no changes required, so just move to dest*/
6 7u83 4354
 
4355
	mka.regmove = move(aa, dest, sp, 1);
2 7u83 4356
	return mka;
4357
      }
4358
      switch (dest.answhere.discrim) {
6 7u83 4359
	case insomereg: {
4360
	  int  *dr = someregalt(dest.answhere);
4361
	  d = getreg(sp.fixed);
2 7u83 4362
	  *dr = d;
4363
	  goto out;
4364
	}
6 7u83 4365
	case inreg: {
4366
	  d = regalt(dest.answhere);
2 7u83 4367
	  goto out;
4368
	}
4369
	default: {
4370
	  /* representation in store will be same so just move */
6 7u83 4371
	  move(aa, dest, sp, 1);
2 7u83 4372
	  return mka;
4373
	}
4374
      }
4375
  out: 			/* d is destination register - do
4376
			   appropriate ands etc */
4377
      if (d==NO_REG) return mka;
4378
/*       (void)convert_shapes(nsh,name(sh(son(e))),a,d);*/
6 7u83 4379
      switch (nsh) {
4380
	case ucharhd:{
4381
	  if (is_signed(sh(son(e))) && !optop(e)) {
4382
	    if (error_treatment_is_trap(e)) {
2 7u83 4383
	      int new_lab = new_label();
4384
	      integer_branch(i_bge,a,new_lab);
4385
	      do_exception(f_overflow);
4386
	      set_label(new_lab);
4387
	    }
4388
	    else{
4389
	      integer_branch(i_blt,a,trap_label(e));
4390
	    }
6 7u83 4391
 
2 7u83 4392
	  }
6 7u83 4393
	  if (!optop(e)) {
4394
	    if (error_treatment_is_trap(e)) {
2 7u83 4395
	      test_unsigned_and_trap(a,255,f_overflow);
4396
	    }
4397
	    else{
4398
	      test_unsigned(a,255,trap_label(e));
4399
	    }
4400
	  }
4401
	  operate_fmt_immediate(i_and,a,255,d);
4402
	  break;
4403
	}
6 7u83 4404
	case scharhd:{
4405
	  if (!is_signed(sh(son(e))) && !optop(e)) {
2 7u83 4406
	    setnoat();
4407
	    operate_fmt_immediate(i_cmpule,a,0x7f,AT);
6 7u83 4408
	    if (!error_treatment_is_trap(e)) {
2 7u83 4409
	      integer_branch(i_beq,AT,trap_label(e));
4410
	    }
4411
	    else{
4412
	      int new_lab = new_label();
4413
	      integer_branch(i_bne,AT,new_lab);
4414
	      do_exception(f_overflow);
4415
	      set_label(new_lab);
4416
	    }
4417
	    setat();
4418
	  }
6 7u83 4419
	  if (!optop(e)) {
4420
	    if (error_treatment_is_trap(e)) {
2 7u83 4421
	      test_signed_and_trap(a,-128,127,f_overflow);
4422
	    }
4423
	    else{
4424
	      test_signed(a,-128,127,trap_label(e));
4425
	    }
4426
	  }
4427
	  operate_fmt_immediate(i_extqh,a,1,d);
4428
	  operate_fmt_immediate(i_sra,d,REG_SIZE-8,d);
4429
	  break;
4430
	}
6 7u83 4431
	case uwordhd:{
4432
	  if (is_signed(sh(son(e))) && !optop(e)) {
4433
	    if (error_treatment_is_trap(e)) {
2 7u83 4434
	      int new_lab = new_label();
4435
	      integer_branch(i_bge,a,new_lab);
4436
	      do_exception(f_overflow);
4437
	      set_label(new_lab);
4438
	    }
4439
	    else{
4440
	      integer_branch(i_blt,a,trap_label(e));
4441
	    }
4442
	  }
6 7u83 4443
	  if (!optop(e)) {
4444
	    if (error_treatment_is_trap(e)) {
2 7u83 4445
	      test_unsigned_and_trap(a,0xffff,f_overflow);
4446
	    }
4447
	    else{
4448
	      test_unsigned(a,0xffff,trap_label(e));
4449
	    }
4450
	  }
6 7u83 4451
	  operate_fmt_immediate(i_and,a,(1<<16) -1,d);
2 7u83 4452
	  break;
4453
	}
6 7u83 4454
	case swordhd: {
4455
	  if (!is_signed(sh(son(e))) && !optop(e)) {
2 7u83 4456
	    setnoat();
4457
	    operate_fmt_immediate(i_cmpule,a,0x7fff,AT);
6 7u83 4458
	    if (error_treatment_is_trap(e)) {
2 7u83 4459
	      int new_lab = new_label();
4460
	      integer_branch(i_bne,AT,new_lab);
4461
	      do_exception(f_overflow);
4462
	      set_label(new_lab);
4463
	    }
4464
	    else{
4465
	      integer_branch(i_beq,AT,trap_label(e));
4466
	    }
4467
	    setat();
4468
	  }
6 7u83 4469
	  if (!optop(e)) {
4470
	    if (error_treatment_is_trap(e)) {
2 7u83 4471
	      test_signed_and_trap(a,-0x8000L,0x7fff,f_overflow);
4472
	    }
4473
	    else{
4474
	      test_signed(a,-0x8000L,0x7fff,trap_label(e));
4475
	    }
4476
	  }
4477
	  operate_fmt_immediate(i_sll,a,48,d);
4478
	  operate_fmt_immediate(i_sra,d,48,d);
4479
	  break;
4480
	}
6 7u83 4481
	case ulonghd:{
4482
	  if (is_signed(sh(son(e))) && !optop(e)) {
4483
	    if (error_treatment_is_trap(e)) {
2 7u83 4484
	      int new_lab = new_label();
4485
	      integer_branch(i_bge,a,new_lab);
4486
	      do_exception(f_overflow);
4487
	      set_label(new_lab);
4488
	    }
4489
	    else{
4490
	      integer_branch(i_blt,a,trap_label(e));
4491
	    }
4492
	  }
6 7u83 4493
	  if (!optop(e)) {
4494
	    if (error_treatment_is_trap(e)) {
2 7u83 4495
	      test_unsigned_and_trap(a,0xffffffff,f_overflow);
4496
	    }
4497
	    else{
4498
	      test_unsigned(a,0xffffffff,trap_label(e));
4499
	    }
4500
	  }
4501
	  operate_fmt_immediate(i_addl,a,0,d);
4502
	  /*operate_fmt_big_immediate(i_and,a,0xffffffff,d);*/
4503
	  break;
4504
	}
6 7u83 4505
	case slonghd:{
4506
	  if (!is_signed(sh(son(e))) && !optop(e)) {
2 7u83 4507
	    setnoat();
4508
	    operate_fmt_big_immediate(i_cmpule,a,0x7fffffff,AT);
6 7u83 4509
	    if (error_treatment_is_trap(e)) {
2 7u83 4510
	      int new_lab = new_label();
4511
	      integer_branch(i_bne,AT,new_lab);
4512
	      do_exception(f_overflow);
4513
	      set_label(new_lab);
4514
	    }
4515
	    else{
4516
	      integer_branch(i_beq,AT,trap_label(e));
4517
	    }
4518
	    setat();
4519
	  }
6 7u83 4520
	  if (!optop(e)) {
4521
	    if (error_treatment_is_trap(e)) {
2 7u83 4522
	      test_signed_and_trap(a,-0x80000000L,0x7fffffff,f_overflow);
4523
	    }
4524
	    else{
4525
	      test_signed(a,-0x80000000L,0x7fffffff,trap_label(e));
4526
	    }
4527
	  }
4528
	  operate_fmt_immediate(i_sll,a,32,d);
4529
	  operate_fmt_immediate(i_sra,d,32,d);
4530
	  break;
4531
	}
6 7u83 4532
	case s64hd: {
4533
	  if (!is_signed(sh(e)) && !optop(e)) {
2 7u83 4534
	    setnoat();
4535
	    operate_fmt_big_immediate(i_cmpule,a,0x7fffffffffffffffL,AT);
6 7u83 4536
	    if (error_treatment_is_trap(e)) {
2 7u83 4537
	      int new_lab = new_label();
4538
	      integer_branch(i_bne,AT,new_lab);
4539
	      do_exception(f_overflow);
4540
	      set_label(new_lab);
4541
	    }
4542
	    else{
4543
	      integer_branch(i_beq,AT,trap_label(e));
4544
	    }
4545
	    setat();
4546
	  }
6 7u83 4547
	  if (!optop(e)) {
4548
	    if (error_treatment_is_trap(e)) {
2 7u83 4549
	      test_signed_and_trap(a,-0x8000000000000000L,0x7fffffffffffffffL,
4550
				   f_overflow);
4551
	    }
4552
	    else{
4553
	      test_signed(a,-0x8000000000000000L,0x7fffffffffffffffL,
4554
				   trap_label(e));
4555
	    }
4556
	  }
4557
	  operate_fmt(i_bis,a,a,d);
4558
	  break;
4559
	}
6 7u83 4560
 
4561
	case u64hd:{
4562
	  if (is_signed(sh(e)) && !optop(e)) {
4563
	    if (error_treatment_is_trap(e)) {
2 7u83 4564
	      int new_lab = new_label();
4565
	      integer_branch(i_bge,a,new_lab);
4566
	      do_exception(f_overflow);
4567
	      set_label(new_lab);
4568
	    }
4569
	    else{
4570
	      integer_branch(i_blt,a,trap_label(e));
4571
	    }
4572
	  }
4573
	  operate_fmt(i_bis,a,a,d);
4574
	  break;
4575
	}
4576
	default:failer("Illegal shape in chvar");
4577
      }
6 7u83 4578
#if 0
2 7u83 4579
      if (nsh == ucharhd) {
6 7u83 4580
	operate_fmt_immediate(i_and, a, 255,d);
2 7u83 4581
      }
4582
      else if (nsh == uwordhd) {
6 7u83 4583
	operate_fmt_immediate(i_and,a,(1 << 16) - 1,d);
2 7u83 4584
	}
4585
      else if (nsh == scharhd) {
4586
	/*	      operate_fmt_immediate (i_sll,a,REG_SIZE-8,d);*/
6 7u83 4587
	operate_fmt_immediate(i_extqh,a,1,d);
4588
	operate_fmt_immediate(i_sra,d,REG_SIZE-8,d);
2 7u83 4589
      }
4590
      else if (nsh == swordhd) {
6 7u83 4591
	operate_fmt_immediate(i_sll, a, 32,d);
4592
	operate_fmt_immediate(i_sra, d, 32,d);
2 7u83 4593
      }
4594
#endif
4595
      mka.regmove = d;
4596
      return mka;
4597
    } /* end chvar */
4598
 
6 7u83 4599
    case minus_tag:
4600
    case offset_subtract_tag:{
4601
      if (optop(e)) {
4602
	mka.regmove = non_comm_op(e,sp,dest,is64(sh(e))?i_subq:i_subl);
2 7u83 4603
	return mka;
4604
      }
4605
#if 0
6 7u83 4606
      if (error_treatment_is_trap(e) && is_signed(sh(e))) {
4607
	mka.regmove = non_comm_op(e,sp,dest,is64(sh(e))?i_subqv:i_sublv);
2 7u83 4608
	return mka;
4609
      }
4610
#endif
4611
      else{
4612
/*	   if(!optop(e)) check_exception(e,sp);*/
4613
	int r1 = reg_operand(son(e), sp);
4614
	int r2, r3, r0;
4615
	int over = new_label();
4616
	int trap = trap_label(e);
4617
	space nsp;
4618
	ans aa;
4619
	nsp = guardreg(r1, sp);
4620
	r2 = reg_operand(bro(son(e)), nsp);
4621
	nsp = guardreg(r2, nsp);
4622
	r0 = getreg(nsp.fixed);
4623
	nsp = guardreg(r0,nsp);
6 7u83 4624
	operate_fmt((is64(sh(e)))?i_subq:i_subl, r1, r2,r0);
4625
	switch (name(sh(e))) {
4626
	  case s64hd:
4627
	  case slonghd: {
2 7u83 4628
	    r3 = getreg(nsp.fixed);
4629
	    operate_fmt(i_xor,r1, r2,r3);
4630
	    integer_branch(i_bge,r3,over);
4631
	    operate_fmt(i_xor,r0,r1,r3);
6 7u83 4632
	    if (error_treatment_is_trap(e)) {
2 7u83 4633
	      integer_branch(i_bge,r3,over);
4634
	      do_exception(f_overflow);
4635
	    }
4636
	    else{
4637
	      integer_branch(i_blt,r3,trap);
4638
	    }
4639
	    set_label(over);
4640
	    break;
4641
	  }
6 7u83 4642
	  case u64hd:
4643
	  case ulonghd: {
2 7u83 4644
	    r3 = getreg(guardreg(r0, nsp).fixed);
4645
	    operate_fmt(i_cmpult,r1,r2,r3);
6 7u83 4646
	    if (error_treatment_is_trap(e)) {
2 7u83 4647
	      int ok_lab = new_label();
4648
	      integer_branch(i_beq,r3,ok_lab);
4649
	      do_exception(f_overflow);
4650
	      set_label(ok_lab);
4651
	    }
4652
	    else{
4653
	      integer_branch(i_bne,r3,trap);
4654
	    }
4655
	    break;
4656
	  }
6 7u83 4657
	  case scharhd: {
4658
	    if (error_treatment_is_trap(e)) {
2 7u83 4659
	      test_signed_and_trap(r0,-128,127,f_overflow);
4660
	    }
4661
	    else{
4662
	      test_signed(r0, -128, 127, trap);
4663
	    }
4664
	    break;
4665
	  }
6 7u83 4666
	  case ucharhd: {
4667
	    if (error_treatment_is_trap(e)) {
2 7u83 4668
	      test_unsigned_and_trap(r0,255,f_overflow);
4669
	    }
4670
	    else{
4671
	      test_unsigned(r0, 255, trap);
4672
	    }
4673
	    break;
4674
	  }
6 7u83 4675
	  case swordhd: {
4676
	    if (error_treatment_is_trap(e)) {
2 7u83 4677
	      test_signed_and_trap(r0,-0x8000L,0x7fff,f_overflow);
4678
	    }
4679
	    else{
4680
	      test_signed(r0, -0x8000L, 0x7fff, trap);
4681
	    }
4682
	    break;
4683
	  }
6 7u83 4684
	  case uwordhd: {
4685
	    if (error_treatment_is_trap(e)) {
2 7u83 4686
	      test_unsigned_and_trap(r0,0xffff,f_overflow);
4687
	    }
4688
	    else{
4689
	      test_unsigned(r0, 0xffff, trap);
4690
	    }
4691
	    break;
4692
	  }
4693
	  default: failer("NOT integer in minus with o/f");
4694
	}
4695
	setregalt(aa, r0);
4696
	mka.regmove = move(aa, dest, nsp, 0);
6 7u83 4697
	return mka;
2 7u83 4698
      }
4699
      return mka;
4700
    }
4701
				/* end minus */
6 7u83 4702
    case mult_tag:
4703
    case offset_mult_tag:{
4704
      exp rop = bro(son(e));
2 7u83 4705
      instruction mult_ins;
6 7u83 4706
      if (!optop(e) & error_treatment_is_trap(e)) {
2 7u83 4707
	mult_ins = is64(sh(e))?i_mulqv : i_mullv;
4708
      }
4709
      else{
4710
	mult_ins = is64(sh(e))?i_mulq : i_mull;
4711
      }
6 7u83 4712
 
4713
      if (last(rop) && name(rop) == val_tag && optop(e)) {
2 7u83 4714
	/* multiplication by constant m */
6 7u83 4715
	int   m = no(rop);
2 7u83 4716
	int   p2;
4717
	if (m > 1 && (
6 7u83 4718
		     ((p2 = m) & (m - 1)) == 0 ||
4719
		     (m & (p2 = m + 1)) == 0 ||
4720
		     ((p2 = m - 1) & (m - 2)) == 0
4721
		     )) {
4722
	  /* m = 2^shleng   or  m = 2^(shleng +/- 1)
2 7u83 4723
	   */
6 7u83 4724
	  int   r = reg_operand(son(e), sp);
2 7u83 4725
	  /* evaluate first arguement */
4726
	  int   rr;
4727
	  space nsp;
4728
	  int   shleng;
4729
	  ans aa;
4730
	  for (shleng = 0; p2 != 1; shleng++)
4731
	    p2 >>= 1;
4732
 
4733
	  switch (dest.answhere.discrim) {
6 7u83 4734
	    case inreg: {
4735
	      rr = regalt(dest.answhere);
2 7u83 4736
	      if (rr != r || (m & (m - 1)) == 0) {
4737
		nsp = sp;
4738
		break;
4739
	      }
4740
	    }
4741
	    FALL_THROUGH;
4742
	    default: {
6 7u83 4743
	      nsp = guardreg(r, sp);
4744
	      rr = getreg(nsp.fixed);
2 7u83 4745
	    }
6 7u83 4746
	  }
2 7u83 4747
 
6 7u83 4748
	  operate_fmt_immediate(i_sll,r,shleng,rr);
4749
 
4750
	  if ((m & (m - 1))!= 0)
4751
	    if (optop(e)) {
4752
	      operate_fmt(((m & (m + 1)) == 0)? i_subq : i_addq, rr, r, rr);
2 7u83 4753
	    }
4754
	    else{
6 7u83 4755
	      operate_fmt(((m& (m+1)) ==0)? i_subqv : i_addqv, rr, r, rr);
2 7u83 4756
	    }
6 7u83 4757
	  if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 4758
	    check_exception(e,sp);
4759
	  }
6 7u83 4760
	  setregalt(aa, rr);
4761
	  mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
2 7u83 4762
	  return mka;
4763
	}
4764
      } /* else do straightforward mult */
6 7u83 4765
 
2 7u83 4766
      if(optop(e) /*|| error_treatment_is_trap(e)*/) {
6 7u83 4767
	mka.regmove = comm_op(e, sp, dest, mult_ins);
2 7u83 4768
      }
4769
      else /* if (!optop(e) && !error_treatment_is_trap(e)) */{
4770
	int r1 = reg_operand(son(e), sp);
4771
	int r2,r0;
4772
	/*int over = new_label();*/
4773
	space nsp;
4774
	ans aa;
4775
	int contlab = new_label();
4776
	int zerolab = new_label();
4777
	int mult_end_lab = new_label();
4778
	nsp = guardreg(r1, sp);
4779
	r2 = reg_operand(bro(son(e)), nsp);
4780
	nsp = guardreg(r2, nsp);
4781
	r0 = getreg(nsp.fixed);
4782
	nsp = guardreg(r0, nsp);
4783
	integer_branch(i_beq,r1,zerolab);
4784
	integer_branch(i_beq,r2,zerolab);
4785
	integer_branch(i_br,31,contlab);
4786
	set_label(zerolab);
4787
	operate_fmt(i_bis,31,31,r0);
4788
	integer_branch(i_br,31,mult_end_lab);
4789
	set_label(contlab);
6 7u83 4790
 
2 7u83 4791
	  /*	operate_fmt(is64(sh(e))?i_mulq:i_mull,r1,r2,r0);*/
6 7u83 4792
	if (error_treatment_is_trap(e)) {
2 7u83 4793
	  operate_fmt(i_mulqv,r1,r2,r0);
4794
	}
4795
	else{
4796
	  operate_fmt(i_mulq,r1,r2,r0);
4797
	}
6 7u83 4798
	switch (name(sh(e))) {
4799
	  case u64hd:
4800
	  case s64hd:{
2 7u83 4801
	    int r3 = getreg(sp.fixed);
4802
	    int oklab = new_label();
4803
	    integer_branch(i_beq,r1,oklab);
4804
	    integer_branch(i_beq,r2,oklab);
6 7u83 4805
	    if (error_treatment_is_trap(e)) {
2 7u83 4806
	      int new_lab = new_label();
4807
	      integer_branch(i_bne,r0,new_lab);
4808
	      do_exception(f_overflow);
4809
	      set_label(new_lab);
4810
	    }
4811
	    else{
4812
	      integer_branch(i_beq,r0,trap_label(e));
4813
	    }
4814
	    set_label(oklab);
4815
	    operate_fmt(i_xor,r1,r2,r3);
4816
	    /*integer_branch(i_blt,r3,over);*/
4817
	    operate_fmt(i_xor,r3,r0,r3);
6 7u83 4818
	    if (error_treatment_is_trap(e)) {
2 7u83 4819
	      int ok_lab = new_label();
4820
	      integer_branch(i_bge,r3,ok_lab);
4821
	      do_exception(f_overflow);
4822
	      set_label(ok_lab);
4823
	    }
4824
	    else{
4825
	      integer_branch(i_blt,r3,trap_label(e));
4826
	    }
4827
	    /*set_label(over);*/
4828
	    break;
4829
	  }
6 7u83 4830
	  case slonghd: {
4831
	    if (!error_treatment_is_trap(e)) {
2 7u83 4832
	      int r3 = getreg(sp.fixed);
4833
	      operate_fmt(i_xor,r1,r2,r3);
4834
	      operate_fmt(i_xor,r3,r0,r3);
4835
	      integer_branch(i_blt,r3,trap_label(e));
4836
	      test_signed(r0,-0x80000000L,0x7fffffff,trap_label(e));
4837
	    }
4838
	    else{
4839
#if 1
4840
	      int oklab = new_label();
4841
	      int r3 = getreg(sp.fixed);
4842
	      operate_fmt(i_xor,r1,r2,r3);
4843
	      operate_fmt(i_xor,r3,r0,r3);
4844
	      integer_branch(i_bge,r3,oklab);
4845
	      do_exception(f_overflow);
4846
	      set_label(oklab);
4847
#endif
4848
	      test_signed_and_trap(r0,-0x80000000L,0x7fffffff,f_overflow);
4849
	    }
4850
	    break;
4851
	  }
6 7u83 4852
	  case ulonghd: {
4853
	    if (!error_treatment_is_trap(e)) {
2 7u83 4854
	      int r3 = getreg(sp.fixed);
4855
	      operate_fmt(i_xor,r1,r2,r3);
4856
	      integer_branch(i_blt,r3,trap_label(e));
4857
	      test_unsigned(r0,0xffffffff,trap_label(e));
4858
	    }
4859
	    else{
4860
	      int r3 = getreg(sp.fixed);
4861
	      int oklab = new_label();
4862
	      operate_fmt(i_xor,r1,r2,r3);
4863
	      integer_branch(i_bge,r3,oklab);
4864
	      do_exception(f_overflow);
4865
	      set_label(oklab);
4866
	      test_unsigned_and_trap(r0,0xffffffff,f_overflow);
4867
	    }
4868
	    break;
4869
	  }
6 7u83 4870
	  case uwordhd:{
4871
	    if (error_treatment_is_trap(e)) {
2 7u83 4872
	      test_unsigned_and_trap(r0,0xffff,f_overflow);
4873
	    }
4874
	    else{
4875
	      test_unsigned(r0,0xffff,trap_label(e));
4876
	    }
4877
	    break;
4878
	  }
6 7u83 4879
	  case swordhd:{
4880
	    if (error_treatment_is_trap(e)) {
2 7u83 4881
	      test_signed_and_trap(r0,-0x8000L,0x7fff,f_overflow);
4882
	    }
4883
	    else{
4884
	      test_signed(r0,-0x8000L,0x7fff,trap_label(e));
4885
	    }
4886
	    break;
4887
	  }
6 7u83 4888
	  case ucharhd:{
4889
	    if (error_treatment_is_trap(e)) {
2 7u83 4890
	      test_unsigned_and_trap(r0,255,f_overflow);
4891
	    }
4892
	    else{
4893
	      test_unsigned(r0,255,trap_label(e));
4894
	    }
4895
	    break;
4896
	  }
6 7u83 4897
	  case scharhd:{
4898
	    if (error_treatment_is_trap(e)) {
2 7u83 4899
	      test_signed_and_trap(r0,-128,127,f_overflow);
4900
	    }
4901
	    else{
4902
	      test_signed(r0,-128,127,trap_label(e));
4903
	    }
4904
	    break;
4905
	  }
4906
	  default:failer("illegal shape");
4907
	}
4908
	set_label(mult_end_lab);
4909
	setregalt(aa,r0);
4910
	mka.regmove = move(aa,dest,nsp,0);
4911
      }
4912
      return mka;
4913
    } /* end mult */
4914
 
6 7u83 4915
    case div1_tag:
4916
    case div2_tag:
4917
    case offset_div_by_int_tag:
4918
    case offset_div_tag:
4919
    case div0_tag:{
4920
      exp rop = bro(son(e));
2 7u83 4921
      exp lop = son(e);
4922
      bool uns = (name (sh (e)) & 1) == 0; /* ?? */
4923
      space nsp;
4924
      int r0;
4925
      ans aa;
4926
      ash a;
4927
      instruction div_ins;
6 7u83 4928
      if (name(rop) == val_tag) {
2 7u83 4929
	/* unsigned division by constant */
6 7u83 4930
	int   m = no(rop);
4931
	if ((m == 0) && !optop(e)) {
2 7u83 4932
	  integer_branch(i_br,31,trap_label(e));
4933
	}
6 7u83 4934
 
2 7u83 4935
	if (m > 1 && (m & (m - 1)) == 0) {
6 7u83 4936
	  int   r = reg_operand(son(e), sp);
2 7u83 4937
	  /* replace div by 2^shleng by arith sh right shleng */
4938
	  int   shleng;
4939
	  int   rr;
4940
	  for (shleng = 0; m != 1; shleng++)
4941
	    m >>= 1;
6 7u83 4942
 
4943
	  rr = regfrmdest(&dest,(guardreg(r,sp)));
4944
	  operate_fmt_immediate((uns)? i_srl : i_sra,r, shleng,rr);
4945
	  setregalt(aa, rr);
4946
	  mka.regmove = move(aa, dest, guardreg(r,guardreg(rr, sp)), 1);
4947
	  return mka;
2 7u83 4948
	}
6 7u83 4949
	else if (use_umulh_for_div) {
4950
	  if (m>0) {
4951
	    int r = reg_operand(son(e),sp);
4952
	    int rr = regfrmdest(&dest,sp);
2 7u83 4953
	    if(m!=1){		/* no point in dividing by 1 ! */
4954
#if DO_NEW_DIVISION
4955
	      divide_by_constant(e,lop,rop,rr,nsp);
4956
#else
4957
	      divide_by_constant(r,make_INT64(0,m),rr,guardreg(r,sp));
4958
#endif
4959
	    }
4960
	    else{
4961
	      rr=r;
4962
	    }
6 7u83 4963
	    setregalt(aa, rr);
4964
	    mka.regmove = move(aa, dest, guardreg(rr, sp), 1);
2 7u83 4965
	    return mka;
4966
	  }
4967
	}
4968
      }
4969
      a = ashof(sh(son(e)));
4970
      if (!optop(e) && !error_treatment_is_trap(e)) {/* test for (-inf)/-1 and /0 */
4971
	check_exception(e,sp);
4972
      }
6 7u83 4973
      nsp.fixed = (sp.fixed) | (1<<23) | (1<<24) | (1<<25) | (1<<27);
4974
      div_ins= (uns)?((a.ashsize==32)?i_divlu:i_divqu):
2 7u83 4975
	(a.ashsize==32)?i_divl:i_divq;
6 7u83 4976
      if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 4977
	int rd = reg_operand(rop,sp);
4978
	integer_branch(i_beq,rd,no(son(pt(e))));
4979
      }
4980
      r0 = divide_using_div(e,lop,rop,dest,nsp,div_ins);
4981
      setregalt(aa, r0);
4982
      clear_reg(AT);
4983
      clear_reg(23);
4984
      clear_reg(24);
4985
      clear_reg(25);
4986
      clear_reg(27);
6 7u83 4987
 
2 7u83 4988
      mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
4989
      return mka;
4990
    }
4991
#if 0
4992
    case div1_tag: {  /* only applies to signed operands */
6 7u83 4993
      exp rop = bro(son(e));
2 7u83 4994
      exp lop = son(e);
4995
      int ne = name(e);
4996
      space nsp;
4997
      int r0, r1, r2;
4998
      int lab, treg;
6 7u83 4999
      ans aa;
2 7u83 5000
      r2 = reg_operand(rop, sp);
5001
      nsp = guardreg(r2, sp);
5002
      r1 = reg_operand(lop, nsp);
5003
 
6 7u83 5004
 
2 7u83 5005
      if (!optop(e)) { /* test for (-inf)/-1 and /0 */
5006
	long over = new_label();
6 7u83 5007
	long trap = no(son(pt(e)));
5008
	ans aa;
5009
	set_label(over);
2 7u83 5010
      }
5011
      r0 = regfrmdest(&dest,nsp);
5012
      treg = getreg(guardreg(r0,nsp).fixed);
5013
      lab = new_label();
5014
      operate_fmt(i_xor, treg, r2, treg);
5015
      operate_fmt(i_sra, treg, 31,treg);
5016
      operate_fmt(i_addq, r0,treg,r0);
6 7u83 5017
      set_label(lab);
2 7u83 5018
      setregalt(aa, r0);
5019
      mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
5020
      return mka;
5021
    }
5022
#endif
5023
 
6 7u83 5024
 
5025
    case neg_tag:
5026
    case offset_negate_tag:{
2 7u83 5027
      if (optop(e) /* || (name(sh(e)) & 1) ==0 */ ) {
5028
	int r1=getreg(sp.fixed);
5029
	int a1;
5030
	space nsp;
5031
	a1 = reg_operand(son(e),sp);
6 7u83 5032
	if (dest.answhere.discrim == inreg) {
2 7u83 5033
	  int d = regalt(dest.answhere);
5034
	  operate_fmt(is64(sh(e))?i_subq:i_subl,31,a1,d);
5035
	  /*if (optop(e)) tidyshort(d,sh(e));*/
5036
	}
5037
	else {
5038
	  ans a;
6 7u83 5039
	  setregalt(a,r1);
2 7u83 5040
	  operate_fmt(is64(sh(e))?i_subq:i_subl,31,a1,r1);
5041
	  /*if (optop(e)) tidyshort(r1,sh(e));*/
5042
	  nsp=guardreg(r1,sp);
5043
	  move(a,dest,nsp,1);
5044
	  mka.regmove = r1;
5045
	}
5046
	return mka;
6 7u83 5047
      }
2 7u83 5048
      else {
5049
	int r1 = reg_operand(son(e), sp);
5050
	space nsp;
5051
	/* int trap = trap_label(e); */
5052
	int r2;
5053
	ans aa;
5054
	nsp = guardreg(r1,sp);
5055
	r2 = getreg(nsp.fixed);
5056
	operate_fmt(i_subq,31,r1,r2);
6 7u83 5057
	switch (name(sh(e))) {
5058
	  case ucharhd:{
5059
	    if (!optop(e)) {
5060
	      if (error_treatment_is_trap(e)) {
2 7u83 5061
		test_unsigned_and_trap(r2,255,f_overflow);
5062
	      }
5063
	      else{
5064
		test_unsigned(r2,255,trap_label(e));
5065
	      }
5066
	    }
5067
	    break;
5068
	  }
6 7u83 5069
	  case scharhd:{
5070
	    if (!optop(e)) {
5071
	      if (error_treatment_is_trap(e)) {
2 7u83 5072
		test_signed_and_trap(r2,-128,127,f_overflow);
5073
	      }
5074
	      else{
5075
		test_signed(r2,-128,127,trap_label(e));
5076
	      }
5077
	    }
5078
	    break;
5079
	  }
6 7u83 5080
	  case uwordhd:{
5081
	    if (!optop(e)) {
5082
	      if (error_treatment_is_trap(e)) {
2 7u83 5083
		test_unsigned_and_trap(r2,0xffff,f_overflow);
5084
	      }
5085
	      else{
5086
		test_unsigned(r2,0xffff,trap_label(e));
5087
	      }
5088
	    }
5089
	    break;
5090
	  }
6 7u83 5091
	  case swordhd: {
5092
	    if (!optop(e)) {
5093
	      if (error_treatment_is_trap(e)) {
2 7u83 5094
		test_signed_and_trap(r2,-0x8000L,0x7fff,f_overflow);
5095
	      }
5096
	      else{
5097
		test_signed(r2,-0x8000L,0x7fff,trap_label(e));
5098
	      }
5099
	    }
5100
	    break;
5101
	  }
6 7u83 5102
	  case ulonghd:{
5103
	    if (!optop(e)) {
5104
	      if (error_treatment_is_trap(e)) {
2 7u83 5105
		test_unsigned_and_trap(r2,0xffffffff,f_overflow);
5106
	      }
5107
	      else{
5108
		test_unsigned(r2,0xffffffff,trap_label(e));
5109
	      }
5110
	    }
5111
	    break;
5112
	  }
6 7u83 5113
	  case slonghd:{
5114
	    if (!optop(e)) {
5115
	      if (error_treatment_is_trap(e)) {
2 7u83 5116
		test_signed_and_trap(r2,-0x80000000L,0x7fffffff,f_overflow);
5117
	      }
5118
	      else{
5119
		test_signed(r2,-0x80000000L,0x7fffffff,trap_label(e));
5120
	      }
5121
	    }
5122
	    break;
5123
	  }
6 7u83 5124
	  case s64hd:{
5125
	    if (!optop(e)) {
5126
	      if (error_treatment_is_trap(e)) {
2 7u83 5127
		test_unsigned_and_trap(r1,0x7fffffffffffffffL,f_overflow);
5128
	      }
5129
	      else{
5130
		test_unsigned(r1,0x7fffffffffffffffL,trap_label(e));
5131
	      }
5132
	    }
5133
	    break;
5134
	  }
6 7u83 5135
	  case u64hd:{
5136
	    if (!optop(e)) {
5137
	      if (error_treatment_is_trap(e)) {
2 7u83 5138
		int new_lab = new_label();
5139
		integer_branch(i_ble,r1,new_lab);
5140
		do_exception(f_overflow);
5141
		set_label(new_lab);
5142
	      }
5143
	      else{
5144
		integer_branch(i_bgt,r1,trap_label(e));
5145
	      }
5146
	    }
5147
	    break;
5148
	  }
6 7u83 5149
 
2 7u83 5150
	  default:failer("Illegal shape in neg");
5151
	}
5152
 
5153
 
5154
	setregalt(aa, r2);
5155
	mka.regmove = move(aa, dest, guardreg(r2, nsp), 0);
5156
	return mka;
5157
      }
6 7u83 5158
 
5159
 
2 7u83 5160
    } /* end neg */
5161
 
6 7u83 5162
    case goto_lv_tag: {
2 7u83 5163
      int r = reg_operand(son(e),sp);
5164
      integer_jump(i_jmp,31,r,0);
5165
      clear_all();
5166
      return mka;
5167
    }
6 7u83 5168
    case movecont_tag:{
2 7u83 5169
      exp szarg = bro(bro(son(e)));
5170
      int dr, sr, szr, mr;
5171
      int lout = new_label();
5172
      space nsp;
5173
      int bytemove;
5174
      where w;
5175
 
5176
      sr = getreg(sp.fixed);
5177
      setregalt(w.answhere, sr);
5178
      w.ashwhere = ashof(sh(son(e)));
6 7u83 5179
     (void)make_code(son(e), sp, w , 0);
2 7u83 5180
      nsp = guardreg(sr, sp);
5181
      dr = getreg(nsp.fixed);
5182
      setregalt(w.answhere, dr);
6 7u83 5183
     (void)make_code(bro(son(e)), nsp, w, 0);
2 7u83 5184
      nsp = guardreg(dr, nsp);
5185
      w.ashwhere = ashof(sh(bro(bro(son(e)))));
5186
      szr = getreg(nsp.fixed);
5187
      setregalt(w.answhere, szr);
6 7u83 5188
     (void)make_code(szarg, nsp, w, 0);
2 7u83 5189
      nsp = guardreg(szr, nsp);
5190
      mr = getreg(nsp.fixed);
6 7u83 5191
      bytemove = al2(sh(szarg)) >>3;
2 7u83 5192
 
6 7u83 5193
      if (name(szarg)!= val_tag || no(szarg) == 0) {
2 7u83 5194
	integer_branch(i_beq,szr,lout);
6 7u83 5195
      }
2 7u83 5196
      if (isnooverlap(e)) {
5197
	move_dlts(dr,sr,szr,mr, bytemove,sp);
5198
      }
5199
      else {
5200
	int gtlab = new_label();
5201
	int rtmp=getreg(nsp.fixed);
5202
	operate_fmt(i_cmple,dr,sr,rtmp);
5203
	integer_branch(i_beq,rtmp,gtlab);
5204
	move_dlts(dr,sr,szr, mr, bytemove,sp);
5205
	integer_branch(i_br,31,lout);
5206
	set_label(gtlab);
5207
	move_dgts(dr,sr,szr, mr, bytemove,sp);
5208
      }
5209
      set_label(lout);
5210
      return mka;
5211
    }
6 7u83 5212
    case set_stack_limit_tag: {
2 7u83 5213
      int reg = reg_operand(son(e),sp);
5214
      baseoff b;
5215
      /*      b = find_tag("__TDFstacklim");*/
5216
      b = find_tag("__alpha_stack_limit");
5217
      load_store(i_stq,reg,b);
5218
      return mka;
5219
    }
6 7u83 5220
    case give_stack_limit_tag: {
2 7u83 5221
      ans aa;
5222
      baseoff b;
5223
      int reg = regfrmdest(&dest,sp);
5224
      /*      b = find_tag("__TDFstacklim");*/
5225
      b = find_tag("__alpha_stack_limit");
5226
      load_store(i_ldq,reg,b);
5227
      setregalt(aa,reg);
5228
      move(aa,dest,guardreg(reg,sp),1);
5229
      return mka;
5230
    }
6 7u83 5231
    case shl_tag:
5232
    case shr_tag:{
5233
      exp s = son(e);
5234
      exp b = bro(s);
2 7u83 5235
      int a;
6 7u83 5236
      int d;
2 7u83 5237
      int src_reg;
5238
      ans aa;
5239
      space nsp;
5240
      bool sgned = is_signed(sh(e));
5241
      instruction shnat;
5242
      instruction shun;
6 7u83 5243
      a = reg_operand(s, sp);
2 7u83 5244
      /* choose which shift instruction */
6 7u83 5245
      if (name(e) == shr_tag) {
5246
	shnat = (sgned)? i_sra : i_srl;
2 7u83 5247
	shun = i_sll;
5248
      }
5249
      else {
5250
	shnat = i_sll;
6 7u83 5251
	shun = (sgned)? i_sra : i_srl;
2 7u83 5252
      }
6 7u83 5253
 
5254
      nsp = guardreg(a, sp);
2 7u83 5255
      d = regfrmdest(&dest, nsp);
5256
 
5257
      /* when applying right shifts to unsigned data which is less then
6 7u83 5258
	 the full (64 bit) register length, we must ensure that all the
2 7u83 5259
	 unused bits in the upper part of the register are set to zero */
6 7u83 5260
     if (!is64(sh(son(e))) && !is_signed(sh(son(e)))
2 7u83 5261
	 && ins_equal(i_srl,shnat)) {
5262
	src_reg = getreg(nsp.fixed);
6 7u83 5263
	if (name(sh(son(e))) == ulonghd)
2 7u83 5264
	  operate_fmt_immediate(i_zapnot,a,15,src_reg);
6 7u83 5265
	else if (name(sh(son(e))) == uwordhd)
2 7u83 5266
	  operate_fmt_immediate(i_zapnot,a,3,src_reg);
5267
	else if (name(sh(son(e))) == ucharhd)
5268
	  operate_fmt_immediate(i_zapnot,a,1,src_reg);
5269
      }
5270
      else {
5271
	src_reg = a;
5272
      }
5273
      nsp = guardreg(src_reg,nsp);
6 7u83 5274
      if (name(b) == val_tag) {
2 7u83 5275
	/* if its a constant shift we dont have to choose shift
5276
	   dynamically ... */
6 7u83 5277
	if (no(b) >= 0) {
2 7u83 5278
#if 0
6 7u83 5279
	  if (!is64(sh(son(e))) && !is_signed(sh(son(e))) &&
5280
	     ins_equal(i_srl,shnat)) {
5281
	    /* if quantity being shifted right is not 64 bits wide
2 7u83 5282
	       then the top 32 bits of the register containing it
6 7u83 5283
	       must be set to zero.  This does not apply to
2 7u83 5284
	       arithmetic shifts. */
5285
	    operate_fmt_immediate(i_zapnot,a,15,a);
5286
	  }
5287
#endif
6 7u83 5288
	  operate_fmt_immediate(shnat,src_reg, no(b),d);
2 7u83 5289
	}
5290
	else {
6 7u83 5291
	  operate_fmt_immediate(shun,src_reg, -no(b),d);
2 7u83 5292
	}
5293
      }
5294
      else {
6 7u83 5295
	int   sr = getreg(nsp.fixed);
5296
	int   ar = reg_operand(b, nsp);
2 7u83 5297
	if (!is_signed(sh(b))/* unsigned */
6 7u83 5298
	    || (name(b) == and_tag && name(bro(son(b))) == val_tag
5299
		&& no(bro(son(b))) > 0 && no(bro(son(b))) <= 31)
2 7u83 5300
	    ) {			/* ... similarly in these cases */
6 7u83 5301
	  operate_fmt(shnat,src_reg, ar,d);
2 7u83 5302
	}
5303
	else {		/* choose shift dynamically */
6 7u83 5304
	  int   l = new_label();
5305
	  int   endl = new_label();
5306
	  if (!is64(sh(son(e)))) {
2 7u83 5307
	    operate_fmt_immediate(i_sll,src_reg,32,src_reg);
5308
	    operate_fmt_immediate(is_signed(sh(son(e)))?i_sra:i_srl,src_reg
5309
				  ,32,src_reg);
5310
	    /*operate_fmt_immediate(i_zap,a,240,a);*/	/* ?? */
5311
	  }
5312
	  integer_branch(i_bge,ar,l);
5313
	  operate_fmt(i_subq,31,ar,sr);
5314
	  operate_fmt(shun,src_reg, sr,d);
5315
	  integer_branch(i_br,31,endl);
6 7u83 5316
	  set_label(l);
5317
	  operate_fmt(shnat,src_reg, ar,d);
5318
	  set_label(endl);
2 7u83 5319
	}
5320
      }
6 7u83 5321
      if (is32(sh(e)) && (name(e) == shl_tag)) {
2 7u83 5322
	operate_fmt_immediate(i_addl,d,0,d);
5323
      }
6 7u83 5324
      setregalt(aa, d);
5325
      move(aa, dest, nsp, 1);
2 7u83 5326
      mka.regmove = d;
5327
      return mka;
5328
    } /* end shl */
5329
#if 0
6 7u83 5330
    case mod_tag:{
2 7u83 5331
      /* only applies to signed operands */
6 7u83 5332
      exp rop = bro(son(e));
2 7u83 5333
      exp lop = son(e);
5334
      int ne = name(e);
5335
      space nsp;
5336
      int r0, r1, r2;
5337
      int lab, treg;
5338
      ans aa;
6 7u83 5339
 
2 7u83 5340
      failer("mod_tag not implemented correctly");
5341
      r1 = reg_operand(lop, sp);
5342
      nsp = guardreg(r1, sp);
5343
      r2 = reg_operand(rop, nsp);
6 7u83 5344
 
2 7u83 5345
      if (!optop(e)) {		/* test for (-inf)/-1 and /0 */
5346
	long over = new_label();
6 7u83 5347
	long trap = no(son(pt(e)));
2 7u83 5348
	int rt = getreg(guardreg(r2,nsp).fixed);
6 7u83 5349
	ans aa;
2 7u83 5350
	integer_branch(i_beq,r2,trap);
5351
	operate_fmt_immediate(i_cmpeq,r2,-1,rt);
5352
	integer_branch(i_bne,r2,over);
5353
	operate_fmt_big_immediate(i_cmpeq,r1,maxmin(sh(e)).mini,rt);
5354
	integer_branch(i_beq,rt,trap);
6 7u83 5355
	set_label(over);
2 7u83 5356
      }
5357
      r0 = regfrmdest(&dest, nsp);
5358
      failer("mod tag not implemented correctly");
5359
      /*	operate_fmt(i_rem, r0, r1, r2);*/
5360
      treg= getreg(guardreg(r0, nsp).fixed);
5361
      lab = new_label();
5362
      /*	condri_ins(i_beq, r0, 0, lab);*/
5363
      operate_fmt(i_xor, treg, r0, r2);
5364
      /*	condri_ins(i_bge, treg, 0, lab);*/
5365
      operate_fmt(i_addq, r0, r0, r2);
6 7u83 5366
      set_label(lab);
2 7u83 5367
      setregalt(aa, r0);
5368
      mka.regmove = move(aa, dest, guardreg(r0,sp), 0);
5369
      return mka;
6 7u83 5370
    }
5371
#endif
5372
      /* Remainder operations have the same effect on the registers
5373
	 AT,23,24,25 and 27 as the division operations,
2 7u83 5374
	 so they must be treated in the same way.*/
6 7u83 5375
    case mod_tag:
5376
    case rem0_tag:
5377
    case rem2_tag:{
5378
      exp rop = bro(son(e));
2 7u83 5379
      exp lop = son(e);
5380
      bool uns = !is_signed(sh(e));
5381
      space nsp;
5382
      int r0,r1, r2;
6 7u83 5383
      ans aa;
2 7u83 5384
#if 0
5385
      int size=dest.ashwhere.ashsize;
5386
#endif
5387
      nsp = sp;
6 7u83 5388
      if (name(rop) ==val_tag) {
5389
	/* if the second argument is a constant then we can
5390
	   replace the rem* instruction by either an and
5391
	   instruction, or an umulh and multiplication
2 7u83 5392
	   followed by a subtraction */
5393
	int r = reg_operand(son(e),sp);
5394
	int m = no(rop);	/* value of constant */
5395
	int rres = regfrmdest(&dest,sp);
5396
	int rtmp = getreg(guardreg(rres,sp).fixed);
5397
 
6 7u83 5398
	if (m>1 && ((m& (m-1)) ==0)) {
2 7u83 5399
	  /* if the constant is a power of 2 then use an and */
5400
	  ans aa;
6 7u83 5401
	  operate_fmt_immediate(i_and,r, no(rop) - 1,rres);
5402
	  setregalt(aa, rres);
5403
	  mka.regmove = move(aa, dest, guardreg(rres, sp), 1);
2 7u83 5404
	  return mka;
5405
	}
5406
	else{
6 7u83 5407
	  if (m!=1) {
5408
	    if (use_umulh_for_div) {
2 7u83 5409
#if DO_NEW_DIVISION
5410
	      divide_by_constant(e,lop,rop,rtmp,nsp);
5411
#else
5412
	      divide_by_constant(r,make_INT64(0,m),rtmp,guardreg(r,sp));
5413
#endif
5414
	    }
5415
	    else{
6 7u83 5416
	      if (!optop(e) && (m == 0)) {
5417
		if (error_treatment_is_trap(e)) {
2 7u83 5418
		  do_exception(f_overflow);
5419
		}
5420
		else {
5421
		  integer_branch(i_br,31,trap_label(e));
5422
		}
5423
	      }
5424
	      else {
5425
		operate_fmt_immediate(uns?i_divqu : i_divq,r,m,rtmp);
5426
	      }
5427
	    }
5428
	    operate_fmt_immediate(i_mulq,rtmp,m,rtmp);
5429
	    operate_fmt(i_subq,r,rtmp,rres);
5430
	  }
5431
	  else{
5432
	    load_store_immediate(i_ldiq,rres,make_INT64(0,0));
5433
	  }
5434
	  setregalt(aa,rres);
5435
	  mka.regmove = move(aa, dest, guardreg(rres,sp), 1);
5436
	  return mka;
5437
	}
5438
      }
5439
 
6 7u83 5440
      nsp.fixed |= ((1<<23) | (1<<24) | (1<<25) | (1<<27));
2 7u83 5441
      r1 = reg_operand(lop, nsp);
5442
      clear_reg(23);
5443
      clear_reg(24);
5444
      clear_reg(25);
5445
      clear_reg(27);
5446
      nsp = guardreg(r1, nsp);
5447
      r2 = reg_operand(rop, nsp);
6 7u83 5448
 
2 7u83 5449
      if (!optop(e)) {		/* test for (-inf)/-1 and /0 */
5450
	check_exception(e,nsp);
5451
      }
5452
      if ((r0 = regfrmdest(&dest, nsp)) == NO_REG) {
5453
	r0  = getreg(nsp.fixed);
5454
      }
5455
      nsp = guardreg(r0,nsp);
6 7u83 5456
      if (!optop(e)) {
2 7u83 5457
	integer_branch(i_beq,r2,trap_label(e));
5458
      }
5459
      operate_fmt((uns)?((is64(sh(e)))?i_remqu : i_remlu):
6 7u83 5460
		 ((is64(sh(e)))?i_remq : i_reml),r1,r2,r0);
5461
#if 0
2 7u83 5462
      operate_fmt((uns)?((size==32)?i_remlu:i_remqu):
6 7u83 5463
		 ((size==32)?i_reml:i_remq),
2 7u83 5464
		  r1,r2,r0);
5465
#endif
6 7u83 5466
      if (name(e) == mod_tag) {
2 7u83 5467
	int res_neg = new_label();
5468
	int exitlab = new_label();
5469
	integer_branch(i_beq,r0,exitlab);
5470
	integer_branch(i_blt,r0,res_neg);
5471
	integer_branch(i_bge,r2,exitlab);
5472
#if 0
5473
	operate_fmt((size == 32)?i_addl:i_addq,r0,r2,r0);
5474
#endif
5475
	operate_fmt(is64(sh(e))?i_addq : i_addl,r0,r2,r0);
5476
	integer_branch(i_br,31,exitlab);
5477
	set_label(res_neg);
5478
	integer_branch(i_ble,r2,exitlab);
5479
#if 0
5480
	operate_fmt((size == 32)?i_addl:i_addq,r0,r2,r0);
5481
#endif
5482
	operate_fmt(is64(sh(e))? i_addq : i_addl,r0,r2,r0);
5483
	set_label(exitlab);
5484
      }
5485
 
6 7u83 5486
 
2 7u83 5487
      setregalt(aa, r0);
6 7u83 5488
      if ((r2 == 23) || (r2 == 24) || (r2 == 25) || (r2 == AT)) {
2 7u83 5489
	clear_dep_reg(rop);
5490
      }
6 7u83 5491
      if ((r1 == 23) || (r1 == 24) || (r1 == 25) || (r1 == AT)) {
2 7u83 5492
	clear_dep_reg(lop);
6 7u83 5493
      }
2 7u83 5494
      clear_reg(23);
5495
      clear_reg(24);
5496
      clear_reg(25);
6 7u83 5497
      clear_reg(27);
2 7u83 5498
      mka.regmove = move(aa, dest, guardreg(r0,nsp), 0);
5499
      return mka;
5500
 
5501
    } /* end mod */
5502
 
5503
 
6 7u83 5504
    case offset_pad_tag:{
2 7u83 5505
      int rdest = regfrmdest(&dest,sp);
5506
      int roff = reg_operand(son(e),sp);
5507
      ans aa;
6 7u83 5508
      if (al2(sh(son(e))) >= al2(sh(e))) {
5509
	if (al2(sh(e))!=1 || al2(sh(son(e))) ==1) {
2 7u83 5510
	  e = son(e);
5511
	  goto tailrecurse;
5512
	}
5513
	operate_fmt_immediate(i_sll,roff,3,rdest);
5514
      }
5515
      else{
6 7u83 5516
	int al = (al2(sh(son(e))) ==1)?al2(sh(e)):(al2(sh(e)) /8);
2 7u83 5517
	operate_fmt_immediate(i_addq,roff,al-1,rdest);
5518
	operate_fmt_immediate(i_and,rdest,-al,rdest);
6 7u83 5519
	if (al2(sh(son(e))) == 1) {
2 7u83 5520
	  operate_fmt_immediate(i_sra,rdest,3,rdest);
5521
	}
5522
      }
5523
      setregalt(aa,rdest);
5524
      mka.regmove = move(aa,dest,guardreg(rdest,sp),0);
5525
      return mka;
5526
    }
6 7u83 5527
#ifdef make_stack_limit_tag
5528
    case make_stack_limit_tag:
2 7u83 5529
#endif
6 7u83 5530
    case minptr_tag:{
5531
      mka.regmove = non_comm_op(e, sp, dest, i_subq);
2 7u83 5532
      return mka;
5533
    }
6 7u83 5534
    case abs_tag: {
2 7u83 5535
      int arg = reg_operand(son(e),sp);
5536
      int rtmp = getreg(guardreg(arg,sp).fixed);
5537
      int destreg;
5538
      ans tmp;
6 7u83 5539
      switch (dest.answhere.discrim) {
5540
        case inreg:{
2 7u83 5541
	  destreg = regalt(dest.answhere);
5542
	  break;
5543
	}
5544
        default:{
5545
	  destreg = getreg(sp.fixed);
5546
	  break;
5547
	}
5548
      }
6 7u83 5549
      if (destreg == NO_REG)destreg = getreg(sp.fixed);
5550
 
2 7u83 5551
      operate_fmt(i_bis,arg,arg,destreg);
5552
      operate_fmt(i_subq,31,arg,rtmp);
5553
      operate_fmt(i_cmovgt,rtmp,rtmp,destreg);
5554
      if(!optop(e) /*&& !error_treatment_is_trap(e)*/) {
5555
	int rt = getreg(sp.fixed);
5556
	operate_fmt_big_immediate(i_subq,destreg,maxmin(sh(e)).maxi,rt);
6 7u83 5557
	if (error_treatment_is_trap(e)) {
2 7u83 5558
	  int newl = new_label();
5559
	  integer_branch(i_ble,rt,newl);
5560
	  do_exception(f_overflow);
5561
	  set_label(newl);
5562
	}
5563
	else{
5564
	  integer_branch(i_bgt,rt,trap_label(e));
5565
	}
5566
      }
5567
      setregalt(tmp,destreg);
5568
      mka.regmove = move(tmp,dest,sp,1);
5569
      return mka;
5570
    }
6 7u83 5571
    case fplus_tag:{
2 7u83 5572
      mka.regmove =
6 7u83 5573
	fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_addt : i_adds);
5574
      if ((name(sh(e))!=shrealhd) &&
5575
	(fregalt(dest.answhere).type==IEEE_single) &&
5576
	 dest.answhere.discrim==infreg) {
2 7u83 5577
      }
6 7u83 5578
      if (!optop(e))check_exception(e, sp);
2 7u83 5579
      return mka;
5580
    }
5581
 
6 7u83 5582
    case fminus_tag:{
2 7u83 5583
      mka.regmove =
6 7u83 5584
	fop(e, sp, dest,(name(sh(e))!= shrealhd)? i_subt : i_subs);
5585
      if (!optop(e))check_exception(e,sp);
2 7u83 5586
      return mka;
5587
    }
5588
 
6 7u83 5589
    case fmult_tag:{
2 7u83 5590
      instruction mult_ins;
6 7u83 5591
      mult_ins = (name(sh(e))!= shrealhd)?i_mult:i_muls;
5592
      mka.regmove = fop(e, sp, dest, mult_ins);
5593
      if (!optop(e) && !error_treatment_is_trap(e))check_exception(e,sp);
2 7u83 5594
      return mka;
5595
    }
5596
 
6 7u83 5597
    case fdiv_tag:{
2 7u83 5598
      instruction div_ins;
6 7u83 5599
      div_ins = (name(sh(e))!= shrealhd)?i_divt:i_divs;
2 7u83 5600
      /*
5601
	if(!optop(e)){
5602
	div_ins = (name(sh(e)) != shrealhd)?i_divtsu:i_divssu;
5603
	}
5604
	else{
5605
	div_ins = (name(sh(e)) != shrealhd)?i_divt:i_divs;
5606
	}
5607
	*/
6 7u83 5608
      if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 5609
	int fr = freg_operand(bro(son(e)),sp);
5610
	float_branch(i_fbeq,fr,no(son(pt(e))));
5611
      }
6 7u83 5612
      mka.regmove = fop(e, sp, dest, div_ins);
5613
      if (!optop(e) && !error_treatment_is_trap(e))check_exception(e,sp);
2 7u83 5614
      return mka;
5615
    }
6 7u83 5616
 
5617
    case fneg_tag:
5618
    case fabs_tag:{
2 7u83 5619
      instruction ins;
5620
      freg fr;
5621
      int arg=freg_operand(son(e),sp);
6 7u83 5622
      if (name(e) == fneg_tag) {
5623
	if (optop(e))ins = (name(sh(e))!= shrealhd)?i_subt:i_subs;
2 7u83 5624
	else
6 7u83 5625
	  ins = (name(sh(e))!= shrealhd)?i_subtsu:i_subssu;
2 7u83 5626
      }
5627
      else{
5628
	ins = i_cpys;
5629
      }
6 7u83 5630
      switch (dest.answhere.discrim) {
5631
	case infreg:{
2 7u83 5632
	  fr=fregalt(dest.answhere);
5633
	  float_op(ins,31,arg,fr.fr);
5634
	  break;
5635
	}
5636
	default :{
5637
	  ans tmp;
6 7u83 5638
	  fr.type= (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
2 7u83 5639
	  fr.fr=getfreg(sp.flt);
5640
	  setfregalt(tmp,fr);
5641
	  float_op(ins,31,arg,fr.fr);
5642
	  move(tmp,dest,sp,1);
5643
	}
5644
      }
6 7u83 5645
      if (!optop(e) && (name(e) ==fneg_tag) && !error_treatment_is_trap(e))
5646
	check_exception(e,sp);
5647
      mka.regmove= ((fr.type==IEEE_double)? - (fr.fr+32):(fr.fr+32));
2 7u83 5648
      return mka;
5649
    }
6 7u83 5650
 
5651
    case float_tag: {
5652
      exp in = son(e);
2 7u83 5653
      where w;
5654
      int r;
5655
      int   f
6 7u83 5656
	=    (dest.answhere.discrim == infreg)? regalt(dest.answhere)
5657
	:     getfreg(sp.flt);
2 7u83 5658
      freg frg;
5659
      ans aa;
5660
      ash ain;
5661
      bool quad;
6 7u83 5662
      ain = ashof(sh(in));
2 7u83 5663
      quad = (ain.ashsize!=32);
5664
      frg.fr = f;
5665
      frg.type = IEEE_single;
6 7u83 5666
      if (ain.ashsize<32) {
2 7u83 5667
	/* go via fixed point register for bytes and words */
5668
	where tmp;
5669
	ans src;
5670
	r=reg_operand(in,sp);
5671
	setregalt(tmp.answhere,r);
5672
	tmp.ashwhere=ashof(sh(in));
5673
	/*code_here(in,sp,tmp);*/	/* move it into fixed pt reg r */
5674
	setregalt(src,r);
5675
	frg.type=IEEE_double;
5676
	setfregalt(tmp.answhere,frg);
5677
	move(src,tmp,sp,0);
5678
      }
5679
      else{
6 7u83 5680
	switch (name(sh(in))) {
5681
	  case swordhd:
5682
	  case uwordhd:
5683
	  case slonghd:
5684
	  case ulonghd:
5685
	  case s64hd:
5686
	  case u64hd:{
2 7u83 5687
	    freg load_reg;
5688
	    load_reg.type = IEEE_double; /* so we load in an octaword */
5689
	    load_reg.fr=f;
5690
	    setfregalt(w.answhere,load_reg);
5691
	    w.ashwhere=ashof(sh(in));
5692
	    code_here(in,sp,w);
5693
	    break;
5694
	  }
5695
	  default:
5696
	  setfregalt(w.answhere,frg);
5697
	  w.ashwhere = ashof(sh(in));
5698
	  code_here(in,sp,w);
5699
	  break;
6 7u83 5700
	}
2 7u83 5701
      }
6 7u83 5702
      if (!quad) {
2 7u83 5703
	float_convert(i_cvtlq,f,f);
5704
      }
6 7u83 5705
      float_convert((name(sh(e)) ==shrealhd)?i_cvtqs:i_cvtqt,f,f);
5706
      if (name(sh(e))!= shrealhd) {
2 7u83 5707
	frg.type = IEEE_double;
5708
      }
6 7u83 5709
      setfregalt(aa, frg);
5710
      move(aa, dest, sp, 1);
5711
      if (name(sh(in)) ==u64hd|| (name(sh(in)) ==ulonghd)) {
2 7u83 5712
	fix_unsigned(frg,sp,name(sh(in)));
5713
      }
6 7u83 5714
      mka.regmove = (frg.type==IEEE_double)? - (f + 32):(f + 32);
2 7u83 5715
      return mka;
5716
    }
6 7u83 5717
    case chfl_tag:{
5718
      int   to = name(sh(e));
5719
      int   from = name(sh(son(e)));
5720
      bool dto = (to != shrealhd)? 1 : 0;
5721
      bool dfrom = (from != shrealhd)? 1 : 0;
2 7u83 5722
      if (!dto && !dfrom) {	/* no change in representation */
6 7u83 5723
	return make_code(son(e), sp, dest, exitlab);
2 7u83 5724
      }
5725
      else {
5726
	freg frg;
5727
	ans aa;
5728
	where w;
5729
	if (dest.answhere.discrim == infreg) {
6 7u83 5730
	  frg = fregalt(dest.answhere);
2 7u83 5731
	}
5732
	else {
6 7u83 5733
	  frg.fr = getfreg(sp.flt);
2 7u83 5734
	}
5735
	if(dto)		/* was dfrom */
5736
	  frg.type = IEEE_double;
5737
	else
5738
	  frg.type = IEEE_single;
6 7u83 5739
	setfregalt(aa, frg);
2 7u83 5740
	w.answhere = aa;
6 7u83 5741
	w.ashwhere = ashof(sh(son(e)));
5742
	code_here(son(e), sp, w);
5743
	if (dto)
2 7u83 5744
	  frg.type = IEEE_double;
5745
	else
5746
	  frg.type = IEEE_single;
6 7u83 5747
	if ((!dto) && dfrom) {
5748
	  /* If converting from double to single then we
2 7u83 5749
	     need to use a conversion */
5750
	  float_convert(i_cvtts,frg.fr,frg.fr);
5751
	}
6 7u83 5752
	setfregalt(aa, frg);
5753
	move(aa, dest, sp, 1);
5754
	mka.regmove = (frg.type==IEEE_double)?- (frg.fr + 32):(frg.fr + 32);
5755
	if (!optop(e) && !dto && !error_treatment_is_trap(e))check_exception(e,sp);
2 7u83 5756
	return mka;
5757
      }
5758
    }
5759
 
6 7u83 5760
    case and_tag: {
5761
      if (use_andcomp && name(bro(son(e))) == not_tag) {
2 7u83 5762
	bro(son(e)) = son(bro(son(e)));
6 7u83 5763
	mka.regmove = comm_op(e,sp,dest,i_bic);
2 7u83 5764
      }
6 7u83 5765
      else if (use_andcomp && name(son(e)) == not_tag) {
2 7u83 5766
	exp tmp = copyexp(son(e));
5767
	son(e) = bro(son(e));
5768
	bro(son(e)) = son(tmp);
5769
	/*retcell(tmp)*/;
6 7u83 5770
	mka.regmove = comm_op(e,sp,dest,i_bic);
2 7u83 5771
      }
5772
      else
6 7u83 5773
	mka.regmove = comm_op(e, sp, dest, i_and);
2 7u83 5774
      return mka;
5775
    }
6 7u83 5776
    case andcomp_tag:{
2 7u83 5777
      mka.regmove = comm_op(e,sp,dest,i_bic);
5778
      return mka;
5779
    }
6 7u83 5780
    case or_tag: {
5781
      mka.regmove = comm_op(e, sp, dest, i_bis);
2 7u83 5782
      return mka;
5783
    }
5784
 
6 7u83 5785
    case xor_tag:{
5786
      mka.regmove = comm_op(e, sp, dest, i_xor);
2 7u83 5787
      return mka;
5788
    }
5789
 
6 7u83 5790
    case not_tag: {
2 7u83 5791
      int arg=reg_operand(son(e),sp);
6 7u83 5792
      switch (dest.answhere.discrim) {
5793
	case inreg:{
2 7u83 5794
	  int the_dest = regalt(dest.answhere);
5795
	  operate_fmt(i_ornot,31,arg,the_dest);
5796
	  break;
5797
	}
5798
	default:{
5799
	  ans a;
5800
	  space nsp;
5801
	  int reg=getreg(sp.fixed);
5802
	  setregalt(a,reg);
5803
	  operate_fmt(i_ornot,31,arg,reg);
5804
	  tidyshort(reg,sh(e));
5805
	  nsp=guardreg(reg,sp);
5806
	  move(a,dest,nsp,is_signed(sh(e)));
5807
	}
5808
      }
5809
      return mka;
5810
    }
6 7u83 5811
    case locptr_tag: {
2 7u83 5812
      int ptr = reg_operand(son(e),sp);
5813
      int ansr = regfrmdest(&dest,sp);
5814
      baseoff b;
5815
      ans aa;
5816
      b.base = ptr;
5817
      b.offset = -arg_stack_space -3*(PTR_SZ>>3);
5818
      load_store(i_ldq,ansr,b);
5819
      setregalt(aa,ansr);
5820
      mka.regmove = move(aa,dest,guardreg(ansr,sp),0);
5821
      return mka;
5822
    }
6 7u83 5823
 
5824
    case cont_tag:
5825
    case name_tag:
5826
    case field_tag:
5827
    case reff_tag:
5828
    case addptr_tag:
5829
    case subptr_tag:
5830
    case contvol_tag: {
2 7u83 5831
      where w;
5832
      bool sgned;
5833
      ash desper;
6 7u83 5834
      int dr= (dest.answhere.discrim == inreg)?dest.answhere.val.regans:NO_REG;
5835
      desper = ashof(sh(e));
2 7u83 5836
 
6 7u83 5837
      if (name(e) == contvol_tag) {
5838
	clear_all();
2 7u83 5839
	/*setvolatile ();*/
5840
      }
5841
      clear_dep_reg(e);
6 7u83 5842
 
5843
      w = locate(e, guardreg(dr,sp), sh(e), dr);
2 7u83 5844
      /* 'address of argument */
6 7u83 5845
      /*sgned = ((w.ashwhere.ashsize >= 64)
2 7u83 5846
	|| name (sh (e)) & 1) ? 1 : 0;*/
5847
      sgned = is_signed(sh(e));
6 7u83 5848
      mka.regmove = move(w.answhere, dest,(guard(w, sp)), sgned);
2 7u83 5849
      clear_dep_reg(e);
6 7u83 5850
      if (name(e) == contvol_tag) {
2 7u83 5851
	mka.regmove = NOREG;
5852
	/* setnovolatile ();*/
5853
      }
5854
      return mka;
5855
    } /* end cont */
5856
 
5857
#if (FBASE != 10)
6 7u83 5858
    case real_tag:
2 7u83 5859
#endif
6 7u83 5860
    case string_tag:{
2 7u83 5861
      instore isa;
5862
      ans aa;
6 7u83 5863
      bool sgned = ((ashof(sh(e)).ashsize >= 32) || name(sh(e)) & 1)? 1 : 0;
5864
      if (name(e) ==real_tag) {
2 7u83 5865
	bool is_denorm = is_denormal(e);
6 7u83 5866
	if (is_fzero(flptnos[no(e)]) || (is_denorm && treat_denorm_specially)) {
2 7u83 5867
	  freg frg;
5868
	  frg.fr = 31;
5869
	  frg.type = (shape_size(sh(e)) == 32)?IEEE_single:IEEE_double;
5870
	  setfregalt(aa,frg);
5871
	  mka.regmove = move(aa,dest,sp,sgned);
6 7u83 5872
	  if (is_denorm) {
5873
	    if (fail_with_denormal_constant) {
2 7u83 5874
	      failer("Denormalised constant encountered");
5875
	      exit(EXIT_FAILURE);
5876
	    }
5877
	    alphawarn("Replaced IEEE denormal with 0.0!");
5878
	    comment("Replaced IEEE denormal with 0.0");
5879
	  }
5880
	  return mka;
5881
	}
5882
      }
5883
#if DO_SCHEDULE
5884
      start_new_capsule(false);
6 7u83 5885
#endif
2 7u83 5886
      isa=evaluated(e,0);
5887
      set_text_section();
5888
#if DO_SCHEDULE
5889
      close_capsule();
5890
#endif
5891
      setinsalt(aa,isa);
5892
      mka.regmove=move(aa,dest,sp,sgned);
5893
      return mka;
5894
    }
5895
#if (FBASE == 10)	/* now defunct */
6 7u83 5896
    case real_tag:{
2 7u83 5897
      instore isa;
5898
      ans aa;
5899
      char *flt_string;	/* a string representing the real literal */
6 7u83 5900
      char *ld_ins;
2 7u83 5901
      freg fr;
5902
      int use_fzero;		/* set if value of real is 0.0 */
6 7u83 5903
 
5904
      bool sgned = ((ashof(sh(e)).ashsize >= 32) || name(sh(e)) & 1)? 1 : 0;
2 7u83 5905
      flt_string = floating_value(e);
5906
      use_fzero = !strcmp(flt_string,"0.0");
6 7u83 5907
      switch (dest.answhere.discrim) {
5908
	case infreg:
2 7u83 5909
	fr.fr = regalt(dest.answhere);
5910
	fr.type = (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
5911
	break;
6 7u83 5912
	case insomefreg:
5913
	if (!use_fzero) {
2 7u83 5914
	  fr.fr = getfreg(sp.flt);
5915
	  fr.type = (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
5916
	}
5917
	break;
6 7u83 5918
	case notinreg:
2 7u83 5919
	fr.fr=getfreg(sp.flt);
6 7u83 5920
	fr.type= (dest.ashwhere.ashsize==32)?IEEE_single:IEEE_double;
2 7u83 5921
	break;
5922
	default:
5923
	  failer("dubious target for real_tag ");
5924
	}
5925
      ld_ins = (fr.type==IEEE_single)?i_ldis:i_ldit;
6 7u83 5926
      if (use_fzero) {
5927
	if (dest.answhere.discrim==insomefreg) {
2 7u83 5928
	  *dest.answhere.val.somefregans.fr=31;
5929
	  return mka;
5930
	}
5931
	else
5932
	  float_op(i_cpys,31,31,fr.fr);
5933
      }
5934
      else
5935
	float_load_store_immediate(ld_ins,fr.fr,flt_string);
6 7u83 5936
      if (dest.answhere.discrim==insomefreg)
2 7u83 5937
	*dest.answhere.val.somefregans.fr = fr.fr;
6 7u83 5938
      if (dest.answhere.discrim==notinreg) {
2 7u83 5939
	/* put reg contents into memory */
5940
	ans src;
5941
	setfregalt(src,fr);
5942
	mka.regmove=move(src,dest,sp,sgned);
5943
      }
5944
      return mka;
5945
    } /* end eval */
5946
#endif /* (FBASE==10) */
6 7u83 5947
 
5948
    case val_tag: {
5949
      if (no(e) == 0 && !isbigval(e)) {
2 7u83 5950
	goto null_tag_case;
5951
      }
5952
      else {
5953
	ash a;
6 7u83 5954
	a = ashof(sh(e));
5955
	switch (a.ashsize)	{
5956
	  case 8:{
5957
	    low_INT64(constval) = no(e) &255;
5958
	    if (is_signed(sh(e)))
5959
	      low_INT64(constval) -= (low_INT64(constval) &128) <<1;
2 7u83 5960
	    break;
5961
	  }
6 7u83 5962
	  case 32:{
2 7u83 5963
	    low_INT64(constval) = no(e);
5964
	  }
6 7u83 5965
 
5966
#if 0
5967
	    if (is_signed(sh(e))) {
2 7u83 5968
	      low_INT64(constval) = no(e);
5969
	    }
5970
	    else{
5971
	      low_INT64(constval) = uno(e);
5972
	    }
5973
#endif
5974
	    break;
6 7u83 5975
	  case 64:{
2 7u83 5976
	    int findex = no(e);
5977
	    int ov;
6 7u83 5978
	    if (isbigval(e)) {
2 7u83 5979
	      flt64 res;
5980
	      res = flt_to_f64(findex,is_signed(sh(e)),&ov);
5981
	      INT64_assign(constval, flt64_to_INT64(res));
5982
	    }
5983
	    else low_INT64(constval) = no(e);
5984
	    break;
5985
	  }
5986
	  default:{
6 7u83 5987
	    low_INT64(constval) = no(e) &65535;
5988
	    if (is_signed(sh(e)))
5989
	      low_INT64(constval) -= (low_INT64(constval) &32768) <<1;
2 7u83 5990
	    break;
5991
	  }
5992
	}
6 7u83 5993
 
2 7u83 5994
	goto moveconst;
5995
      }
5996
    }
6 7u83 5997
    case prof_tag:
5998
    case top_tag: {
2 7u83 5999
      return mka;
6000
    }
6 7u83 6001
    case dump_tag: {
2 7u83 6002
      int fxd = no(e);
6003
      int fld = no(pt(e));
6004
      int old_fixdone = fixdone;
6005
      int old_fltdone = fltdone;
6006
      int old_result_label = result_label;
6007
      exp l;
6008
      result_label=0;
6009
      dump_sregs(fxd, fld);
6 7u83 6010
      if ((fxd & (1<<RA)))sp.fixed &= ~(1<<RA);
6011
      for (l=son(crt_proc); name(l) ==ident_tag && isparam(l);) {
2 7u83 6012
	/* move any pars still in registers which go into dump regs */
6013
	int sr = props(son(l));
6014
	int tr = no(l);
6015
	if ((props(l) & inanyreg)!=0 && (tr !=sr) && sr != 0) {
6 7u83 6016
	  if ((props(l) & infreg_bits)!=0 &&
6017
	     (fld & (1<< (sr)))!=0) {
6018
	    if (name(sh(son(l)))!= shrealhd) {
2 7u83 6019
	      float_op(i_cpys,tr,tr,sr);
6020
	    }
6021
	    else {
6022
	      float_op(i_cpys,tr,tr,sr);
6023
	    }
6024
	    sp.flt &= ~(1<<tr); /* release fpar reg */
6025
	    no(l) = sr; props(son(l)) = tr;
6026
	  }
6027
	  else
6 7u83 6028
	    if (((fxd & (1<<sr))!=0) && (props(l) & inreg_bits)) {
2 7u83 6029
	      operate_fmt(i_bis,tr,tr,sr);
6030
	      sp.fixed &= ~(1<<tr); /* release par reg */
6 7u83 6031
	      no(l) =sr; props(son(l)) = tr;
2 7u83 6032
	    }
6033
	}
6034
	l = bro(son(l));
6 7u83 6035
	if (name(l) ==dump_tag)l = son(l);
2 7u83 6036
      }
6037
      code_here(son(e), sp, dest);
6 7u83 6038
      for (l=son(crt_proc); name(l) ==ident_tag && isparam(l);) {
2 7u83 6039
	/* restore structure of moved pars */
6040
	int sr = props(son(l));
6041
	int tr = no(l);
6042
	if ((props(l) & inanyreg)!=0 && (tr !=sr) && sr != 0) {
6 7u83 6043
	  if ((props(l) & infreg_bits)!=0 &&
6044
	     (fld & (1<< (tr<<1)))!=0) {
2 7u83 6045
	    no(l) = sr; props(son(l)) = tr;
6046
	  }
6047
	  else
6 7u83 6048
	    if ((fxd & (1<<tr))!=0) {
6049
	      no(l) =sr; props(son(l)) = tr;
2 7u83 6050
	    }
6051
	}
6052
	l = bro(son(l));
6 7u83 6053
	if (name(l) ==dump_tag)l = son(l);
6054
      }
6055
      if (name(sh(e))!= bothd) {
2 7u83 6056
	restore_sregs(fxd, fld);
6057
      }
6058
      fixdone = old_fixdone;
6059
      fltdone = old_fltdone;
6060
      result_label = old_result_label;
6061
      return mka;
6 7u83 6062
    }
2 7u83 6063
 
6 7u83 6064
    case env_size_tag: {
2 7u83 6065
      exp tg = son(son(e));
6066
      procrec *pr = &procrecs[no(son(tg))];
6067
      constval = (pr->frame_size+pr->callee_size) >> 3;
6068
      goto moveconst;
6069
    }
6 7u83 6070
 
6071
    case general_proc_tag:
6072
    case proc_tag: {
6073
      /*
6074
	 set up locals_offset, fixdump, floatdump,
2 7u83 6075
	 frame_size, dumpstart
6 7u83 6076
	 dec stack  ; output frame and mask
2 7u83 6077
	 code here;
6078
 
6079
	 The standard stack layout for a make_proc is as follows:
6 7u83 6080
 
2 7u83 6081
	 -------------------------------------  Bottom of env
6082
	 space for caller params to be passed on stack
6083
	 (If containing apply or apply_general)
6084
 
6085
	 space for dumped s registers
6086
	 locals
6087
	 space for dumped arguments (first 6)
6088
	 -------------------------------------- Top of env
6089
	 remaining arguments (in callers frame)
6090
 
6091
 
6092
	 for general procs the frame will be set up as follows:
6 7u83 6093
 
2 7u83 6094
	 ----------------------------  Bottom of callee env
6095
	 extra caller parameters (If containing apply or apply_general)
6 7u83 6096
	 callee parameters (1,2,,,,,)
2 7u83 6097
	 space for dumped s registers
6 7u83 6098
	 locals
2 7u83 6099
	 caller local reg
6100
	 callee local reg
6101
	 callee top of stack
6 7u83 6102
	 caller frame pointer
2 7u83 6103
	 Up to 6 caller parameters
6104
	 --------------------------- Top of callee env
6105
	 Any remaining caller parameters
6106
	 */
6 7u83 6107
 
6108
      procrec * pr = & procrecs[no(e)];
2 7u83 6109
      needs * ndpr = & pr->needsproc;
6110
      long pprops = (ndpr->propsneeds);
6 7u83 6111
      bool leaf = (pprops & anyproccall) == 0;
2 7u83 6112
      space tbd;
6113
      space pars;
6114
      long st;
6115
      exp l;
6116
      int i;
6117
      int has_va;
6 7u83 6118
      setframe_flags(e, leaf);
6119
      has_va = has_c_vararg(e) || ((name(e) == general_proc_tag) &&
6120
				  (!Has_no_vcallers));
6121
      in_general_proc = (name(e) ==general_proc_tag);
2 7u83 6122
      old_postludes = (postlude_chain*)NULL;
6123
      crt_proc = e;
6124
      frame_size = pr->frame_size;
6125
      locals_offset = pr->locals_offset;
6126
      max_args = pr->max_args;
6127
      param_stack_space = (min(max_args,
6 7u83 6128
			      (Has_no_vcallers)?6*PTR_SZ : 12*PTR_SZ)) >>3;
2 7u83 6129
      arg_stack_space = min(pr->needsproc.numparams,
6 7u83 6130
			   (has_va)?12*PTR_SZ : 6*PTR_SZ) >>3;
2 7u83 6131
#if 0
6 7u83 6132
      if (pr->needsproc.numparams > 11 * PTR_SZ) {
2 7u83 6133
	arg_stack_space = 12*PTR_SZ;
6134
      }
6135
      else {
6136
	arg_stack_space = max(pr->needsproc.numparams,
6 7u83 6137
			     (Has_no_vcallers?6*PTR_SZ : 12*PTR_SZ));
2 7u83 6138
      }
6 7u83 6139
#endif
2 7u83 6140
 
6 7u83 6141
      /* this doesn't actually waste much space, and simplifies matters
2 7u83 6142
	 later */
6143
      if(name(e) == general_proc_tag /* || proc_has_gen_call(e)*/) {
6144
	int old_arg_count = arg_stack_space;
6 7u83 6145
	arg_stack_space = ((has_va)?12*PTR_SZ : 6*PTR_SZ) >>3;
6146
	if (arg_stack_space > old_arg_count)
6147
	  frame_size += ((arg_stack_space - old_arg_count) <<3);
2 7u83 6148
      }
6 7u83 6149
 
2 7u83 6150
      /*
6 7u83 6151
	param_stack_space contains the maximum number of bytes
2 7u83 6152
	that will be required to save the registers used by this
6153
	proc when passing parameters to other procedures.  As
6154
	the space is actually allocated in the callee frame, this
6155
	is only needed for apply_general_proc.  arg_stack_space
6 7u83 6156
	contains the number of arguments passed to this proc,
2 7u83 6157
	and for which space must be reserved within the current
6 7u83 6158
	frame.
2 7u83 6159
	*/
6 7u83 6160
      for (i=0;i<min(pr->needsproc.numparams>>6,NUM_PARAM_REGS);++i) {
2 7u83 6161
	sp = guardreg(FIRST_INT_ARG+i,sp);
6162
      }
6 7u83 6163
 
2 7u83 6164
      paramsdumpstart = pr->paramsdumpstart;
6 7u83 6165
      /* the fixed point registers will be stored in the space
2 7u83 6166
	 starting from gpdumpstart */
6167
      gpdumpstart = (has_va)?paramsdumpstart+384:paramsdumpstart;
6168
      proc_has_vararg = (has_va)?1:0;
6169
      fixdump = pr->fixdump;
6170
      floatdump = pr->floatdump;
6171
      dumpstart = pr->dumpstart;
6172
      fldumpstart = pr->fldumpstart;
6173
      callee_size = pr->callee_size;
6 7u83 6174
      stack_top= (locals_offset>>3) -8;
2 7u83 6175
 
6 7u83 6176
 
2 7u83 6177
      st = (frame_size+callee_size) >> 3;
6178
      fixdone = fltdone = 0;	/* no s-regs have been dumped yet */
6 7u83 6179
 
6180
 
2 7u83 6181
      tbd.fixed = fixdump;
6182
      tbd.flt = floatdump;
6 7u83 6183
 
6184
      pars.fixed = (leaf)?0:(1<<RA);
2 7u83 6185
      pars.flt = 0;
6186
      for (l = son(e); name(l) == ident_tag && isparam(l) &&
6187
			 name(son(l))!=formal_callee_tag; l = bro(son(l))) {
6188
	if ((props(l) & infreg_bits)!= 0) {
6189
	  int n = props(son(l));
6190
	  if (n != no(l) && n != 0) {
6191
	    pars.flt |= (1<<no(l));
6192
	  }
6193
	}
6194
	else if ((props(l) & inreg_bits)!=0) {
6195
	  int n = props(son(l));
6196
	  if (n != no(l) && n != 0) {
6197
	    pars.fixed |= (1<<no(l));
6198
	  }
6199
	}
6 7u83 6200
      }
6201
 
2 7u83 6202
      dump_opt(e, &tbd, &pars);
6203
      set_global_pointer();
6204
 
6 7u83 6205
      if (name(e) ==general_proc_tag) {
2 7u83 6206
	if (Has_vcallees) {
6207
	  baseoff b;
6208
	  b.base = FP;
6209
	  b.offset = (-4 * PTR_SZ>>3) - arg_stack_space;
6 7u83 6210
	  load_store(i_stq, local_reg, b);
2 7u83 6211
	  operate_fmt(i_bis,SP,SP,local_reg);
6 7u83 6212
	  if (!leaf) {
2 7u83 6213
	    b.offset = (-3*PTR_SZ>>3) - arg_stack_space;
6214
	    load_store(i_stq, local_reg, b);
6215
	  }
6216
	}
6 7u83 6217
	else if (Has_fp && name(e) ==general_proc_tag) {
2 7u83 6218
	  operate_fmt_immediate(i_addq,SP, arg_stack_space+
6219
				(callee_size>>3),FP);
6220
	}
6221
#if DO_SCHEDULE
6222
	close_capsule();
6223
	start_new_capsule(true);
6224
#endif
6 7u83 6225
	if (frame_size != 0 || callee_size!=0) {
6226
	  operate_fmt_immediate(i_subq,SP,(frame_size+callee_size) >>3,SP);
2 7u83 6227
	}
6228
      }
6229
      else{
6230
	if (st != 0) {
6231
	  baseoff a;
6232
	  a.base = SP;
6233
	  a.offset=-st;
6234
	  load_store(i_lda,SP,a);
6235
	}
6 7u83 6236
	setframe(st,0);
2 7u83 6237
	/* I'm not sure that this is the right order for these -
6238
	   diagnostics ? */
6239
 
6240
	setprologue(2);
6241
#if DO_SCHEDULE
6242
	close_capsule();
6243
	start_new_capsule(true);
6244
#endif
6245
	if (Has_fp) {
6246
	  baseoff b;
6247
	  b.base = SP;
6248
#if 0
6 7u83 6249
	  b.offset = ((callee_size+frame_size) >>3) -
6250
	    arg_stack_space- (PTR_SZ>>3);
2 7u83 6251
#endif
6 7u83 6252
	  b.offset = ((callee_size+frame_size-PTR_SZ) >>3) -
6253
	   ((in_general_proc)?0:arg_stack_space);
2 7u83 6254
 
6 7u83 6255
	  b.offset = ((callee_size+frame_size-PTR_SZ) >>3) -
6256
	   (arg_stack_space);
2 7u83 6257
 
6258
	  load_store(i_stq,FP,b);
6259
	  operate_fmt_immediate(i_addq,SP,st,FP);
6260
	  /*operate_fmt(i_bis,SP,SP,FP);*/
6261
	  if (Has_tos) {
6262
	    b.base = FP;
6 7u83 6263
	    b.offset = - ((PTR_SZ>>3)*2) - (arg_stack_space);
2 7u83 6264
	    load_store(i_stq,SP,b);
6265
	  }
6266
	}
6267
      }
6268
 
6 7u83 6269
      if (proc_has_checkstack(e)) {
2 7u83 6270
	baseoff b;
6271
	int rtmp = getreg(sp.fixed);
6272
	/*	b = find_tag("__TDFstacklim");*/
6273
	b = find_tag("__alpha_stack_limit");
6274
	stackerr_lab = new_label();
6275
	load_store(i_ldq,rtmp,b);
6276
	setnoat();
6277
	operate_fmt(i_cmplt,SP,rtmp,AT);
6278
	integer_branch(i_bne,AT,stackerr_lab);
6279
	setat();
6280
      }
6281
      else{
6282
	stackerr_lab = 0;
6283
      }
6 7u83 6284
 
6285
 
6286
      if ((pprops & realresult_bit)!= 0) {
2 7u83 6287
	/* proc has real result */
6288
 
6289
	/* add an entry for complex result : returned in f0/f1 */
6290
 
6291
	freg frg;
6292
	frg.fr = 0;
6 7u83 6293
	if (pprops & longrealresult_bit)
2 7u83 6294
	  frg.type = IEEE_double;
6295
	else
6296
	  frg.type = IEEE_single;
6 7u83 6297
	setfregalt(procans, frg);
2 7u83 6298
      }
6 7u83 6299
      else if ((pprops & has_result_bit)!= 0) {
2 7u83 6300
	/* proc has fixed pt result */
6 7u83 6301
	setregalt(procans, RESULT_REG);
6302
      }
2 7u83 6303
      else {			/* proc has no result */
6 7u83 6304
	setregalt(procans, NO_REG);
6305
      }
2 7u83 6306
      result_label = 0;
6307
      aritherr_lab = 0;
6308
      /* fix up integers passed in registers */
6 7u83 6309
      for (l = son(e);name(l) == ident_tag && isparam(l);l=bro(son(l))) {
6310
	if (props(l) & inreg_bits) {
2 7u83 6311
	  int n = props(son(l));
6312
	  Assert((n>=FIRST_INT_ARG) && (n<=LAST_INT_ARG));
6 7u83 6313
	  if (is32(sh(son(l))))operate_fmt_immediate(i_addl,n,0,n);
2 7u83 6314
	}
6315
      }
6 7u83 6316
      code_here(son(e), guardreg(RA,sp), nowhere);
2 7u83 6317
      param_stack_space = arg_stack_space = sizecallers = 0;
6318
      /* evaluate body of proc */
6 7u83 6319
      if (stackerr_lab) {
2 7u83 6320
	set_label(stackerr_lab);
6321
	operate_fmt_immediate(i_addq,SP,frame_size>>3,SP);
6322
	do_exception(f_stack_overflow);
6323
      }
6 7u83 6324
      if (aritherr_lab) {
2 7u83 6325
	set_label(aritherr_lab);
6326
	do_exception(f_overflow);
6327
      }
6328
      return mka;
6329
    } /* end proc */
6330
 
6 7u83 6331
    case alloca_tag: {
2 7u83 6332
      exp s = son(e);
6333
      int r = regfrmdest(&dest, sp);
6334
      int rd;
6335
      ans aa;
6336
      comment("alloca");
6 7u83 6337
      if (checkalloc(e)) {
2 7u83 6338
	rd = getreg(sp.fixed);
6339
	operate_fmt(i_bis,SP,SP,rd);
6340
      }
6341
      else{
6342
	rd = SP;
6343
      }
6 7u83 6344
      if (name(s) ==val_tag) {
6345
	operate_fmt_immediate(i_subq, rd,(no(s) +7) &~7,rd);
2 7u83 6346
      }
6 7u83 6347
      else {
2 7u83 6348
	int tmp = getreg(sp.fixed);
6349
	int rop = reg_operand(s,sp);
6350
	operate_fmt_immediate(i_addq,rop,7,tmp);
6351
	operate_fmt_immediate(i_bic,tmp,7,tmp);
6352
	operate_fmt(i_subq,rd,tmp,rd);
6353
      }
6 7u83 6354
      if (checkalloc(e)) {
2 7u83 6355
	int rt = getreg(sp.fixed);
6356
	baseoff b;
6357
	b = find_tag("__alpha_stack_limit");
6358
	load_store(i_ldq,rt,b);
6359
	setnoat();
6360
	operate_fmt(i_cmple,rt,SP,AT);
6 7u83 6361
	if (stackerr_lab == 0)stackerr_lab = new_label();
2 7u83 6362
	integer_branch(i_beq,AT,stackerr_lab);
6363
	setat();
6364
	operate_fmt(i_bis,rd,rd,SP);
6365
      }
6 7u83 6366
 
2 7u83 6367
      reset_tos();
6 7u83 6368
      operate_fmt_immediate(i_addq,SP,max(0,(max_args-6*(PTR_SZ)) >>3),r);
2 7u83 6369
      /*operate_fmt(i_bis,SP,SP,r);*/
6370
      setregalt(aa, r);
6371
      mka.regmove = move(aa, dest, sp, 1);
6372
      return mka;
6373
    }
6 7u83 6374
 
6375
    case last_local_tag: {
2 7u83 6376
      int r = regfrmdest(&dest, sp);
6377
      ans aa;
6378
      /*operate_fmt_immediate(i_addq,SP,max_args>>3,r);*/
6379
      operate_fmt(i_bis,SP,SP,r);
6380
      setregalt(aa, r);
6381
      mka.regmove = move(aa, dest, sp, 1);
6382
      return mka;
6383
    }
6 7u83 6384
 
6385
    case local_free_tag: {
2 7u83 6386
      exp s = son(e);
6387
      int r = reg_operand(s, sp);
6388
      exp off = bro(s);
6389
      comment("local_free_tag");
6 7u83 6390
      if (name(off) == val_tag) {
6391
	operate_fmt_immediate(i_addq, r,((no(off) >>3) +7) &~7,r);
2 7u83 6392
      }
6393
      else{
6394
	int rtmp = reg_operand(off,guardreg(r,sp));
6395
	operate_fmt_immediate(i_addq,rtmp,7,rtmp);
6396
	operate_fmt_immediate(i_bic,rtmp,7,rtmp);
6397
	operate_fmt(i_addq,r,rtmp,r);
6398
      }
6 7u83 6399
      if (Has_fp) {
2 7u83 6400
	/*operate_fmt_immediate(i_subq,r,max_args>>3,SP);*/
6401
	operate_fmt(i_bis,r,r,SP);
6402
	reset_tos();
6403
      }
6404
      return mka;
6405
    }
6 7u83 6406
 
6407
    case local_free_all_tag: {
2 7u83 6408
      if (Has_fp) {
6 7u83 6409
	operate_fmt_immediate(i_subq,FP,(frame_size+callee_size) >>3,SP);
2 7u83 6410
	reset_tos();
6411
      }
6412
      return mka;
6 7u83 6413
    }
6414
 
6415
    case current_env_tag: {
2 7u83 6416
      int r = regfrmdest(&dest, sp);
6417
      ans aa;
6418
      if (Has_fp) {
6419
	operate_fmt(i_bis,FP,FP,r);
6420
      }
6421
      else {
6 7u83 6422
	operate_fmt_immediate(i_addq, SP,(frame_size+callee_size) >>3,r);
2 7u83 6423
      }
6424
      setregalt(aa, r);
6425
      mka.regmove = move(aa, dest, sp, 1);
6426
      return mka;
6 7u83 6427
    }
6428
    case general_env_offset_tag:
6429
    case env_offset_tag: {
2 7u83 6430
      low_INT64(constval) = frame_offset(son(e));
6431
      goto moveconst;
6 7u83 6432
    }
6433
 
6434
    case null_tag:
2 7u83 6435
null_tag_case : {
6436
      ans aa;
6 7u83 6437
      setregalt(aa, 31);
6438
      mka.regmove = move(aa, dest, sp, 1);
2 7u83 6439
      return mka;
6440
    }
6441
 
6 7u83 6442
    case round_tag:{
6443
      int   r = (dest.answhere.discrim == inreg)? regalt(dest.answhere)
6444
	:getreg(sp.fixed);
6445
      int   sfr = freg_operand(son(e), sp);
6446
      int   dfr = getfreg(guardfreg(sfr, sp).flt);
2 7u83 6447
      ash a;
6448
      ans aa;
6449
      int   s;
6450
      instruction ins;
6451
      int truncate = (round_number(e)!=f_to_nearest);
6 7u83 6452
      a = ashof(sh(son(e)));
2 7u83 6453
      s = a.ashsize;
6 7u83 6454
      if (r == NO_REG) {
2 7u83 6455
	Assert(!optop(e));
6456
	r = getreg(sp.fixed);
6457
      }
6 7u83 6458
 
2 7u83 6459
      /* start of round */
6460
      /* simply do a conversion: double->long or float->int */
6461
      /* need to check FPCR for possible [over/under]flow */
6462
      ins = (truncate)?i_cvttqc:i_cvttq;
6 7u83 6463
      if (round_number(e) == f_toward_zero) {
2 7u83 6464
	ins = i_cvttqc;
6465
      }
6 7u83 6466
      else if (round_number(e) == f_toward_smaller) {
2 7u83 6467
	ins = i_cvttqm;
6468
      }
6 7u83 6469
      else if (round_number(e) == f_toward_larger) {
2 7u83 6470
	set_up_rounding_mode(PLUS_INFINITY);
6471
	ins = i_cvttqd;
6472
      }
6473
      else{
6474
	ins = i_cvttq;
6475
      }
6 7u83 6476
 
2 7u83 6477
      float_convert(ins,sfr,dfr); /* convert to integer QW */
6478
      /* now move the result into register r */
6479
      {
6480
	ans source;
6481
	where d;
6482
	freg fr;
6483
	fr.fr=dfr;
6 7u83 6484
	fr.type= (s==32)?IEEE_single:IEEE_double;
2 7u83 6485
	setfregalt(source,fr);
6486
	setregalt(d.answhere,r);
6487
	d.ashwhere=a;
6488
	move(source,d,sp,0);
6489
      }
6 7u83 6490
 
2 7u83 6491
      /* we may have to cope with overflow a la C */
6 7u83 6492
      if (name(sh(e)) == ucharhd) {
6493
	if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 6494
	  test_unsigned(r,255,trap_label(e));
6495
	}
6 7u83 6496
	else if (error_treatment_is_trap(e)) {
2 7u83 6497
	  test_unsigned_and_trap(r,255,f_overflow);
6498
	}
6 7u83 6499
	operate_fmt_immediate(i_and, r, 255,r);
2 7u83 6500
      }
6 7u83 6501
      else if (name(sh(e)) == uwordhd) {
6502
	if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 6503
	  test_unsigned(r,0xffff,trap_label(e));
6504
	}
6 7u83 6505
	else if (error_treatment_is_trap(e)) {
2 7u83 6506
	  test_unsigned_and_trap(r,0xffff,f_overflow);
6507
	}
6 7u83 6508
	operate_fmt_immediate(i_and, r,(1 << 16) - 1,r);
2 7u83 6509
      }
6 7u83 6510
      else if (name(sh(e)) == scharhd) {
6511
	if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 6512
	  test_signed(r,-128,127,trap_label(e));
6513
	}
6 7u83 6514
	else if (error_treatment_is_trap(e)) {
2 7u83 6515
	  test_signed_and_trap(r,-128,127,f_overflow);
6516
	}
6 7u83 6517
	operate_fmt_immediate(i_sll, r,56, r);
6518
	operate_fmt_immediate(i_sra, r, 56, r);
2 7u83 6519
      }
6 7u83 6520
      else if (name(sh(e)) == swordhd) {
6521
	if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 6522
	  test_signed(r,-0x8000L,0x7fff,trap_label(e));
6523
	}
6 7u83 6524
	else if (error_treatment_is_trap(e)) {
2 7u83 6525
	  test_signed_and_trap(r,-0x8000L,0x7fff,f_overflow);
6526
	}
6 7u83 6527
	operate_fmt_immediate(i_sll, r, 48,r);
6528
	operate_fmt_immediate(i_sra, r, 48,r);
2 7u83 6529
      }
6530
      else if (name(sh(e)) == slonghd) {
6 7u83 6531
	if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 6532
	  test_signed(r,-0x80000000L,0x7fffffff,trap_label(e));
6533
	}
6 7u83 6534
	else if (error_treatment_is_trap(e)) {
2 7u83 6535
	  test_signed_and_trap(r,-0x80000000L,0x7fffffff,f_overflow);
6536
	}
6537
	operate_fmt_immediate(i_sll,r,32,r);
6538
	operate_fmt_immediate(i_sra,r,32,r);
6539
      }
6540
      else if (name(sh(e)) == ulonghd) {
6 7u83 6541
	if (!optop(e) && !error_treatment_is_trap(e)) {
2 7u83 6542
	  test_unsigned(r,0xffffffff,trap_label(e));
6543
	}
6 7u83 6544
	else if (error_treatment_is_trap(e)) {
2 7u83 6545
	  test_unsigned(r,0xffffffff,f_overflow);
6546
	}
6547
	operate_fmt_immediate(i_zap,r,240,r);
6548
      }
6 7u83 6549
      setregalt(aa, r);
6550
      mka.regmove = move(aa, dest, sp, 1);
2 7u83 6551
      return mka;
6552
      /* end of round */
6553
    }
6554
 
6 7u83 6555
    case int_to_bitf_tag:{
2 7u83 6556
      int   r;
6557
      where w;
6558
      ash a;
6559
       ash ai;
6560
       ans aa;
6561
       space nsp;
6 7u83 6562
       a = ashof(sh(e));
6563
       ai = ashof(sh(son(e)));
2 7u83 6564
       r = regfrmdest(&dest, sp);
6565
 
6 7u83 6566
       setregalt(w.answhere, r);
2 7u83 6567
       w.ashwhere = a;
6 7u83 6568
       code_here(son(e), sp, w);
2 7u83 6569
       if (a.ashsize != ai.ashsize) {
6 7u83 6570
	 operate_fmt_immediate(i_and, r,(1 << a.ashsize) - 1,r);
2 7u83 6571
       }
6 7u83 6572
       nsp = guardreg(r, sp);
6573
       setregalt(aa, r);
6574
       move(aa, dest, nsp, 0);
2 7u83 6575
       return mka;
6576
     }
6577
 
6578
 
6 7u83 6579
     case bitf_to_int_tag: {
2 7u83 6580
       ash a;
6581
       int   r;
6582
       where w;
6 7u83 6583
       a = ashof(sh(son(e)));
2 7u83 6584
       r = regfrmdest(&dest, sp);
6585
 
6 7u83 6586
       setregalt(w.answhere, r);
2 7u83 6587
       w.ashwhere = a;
6 7u83 6588
       code_here(son(e), sp, w);
6589
       if (a.ashsize != 64) {
6590
	 if ((name((sh(e))) & 1) == 1) {
6591
	   operate_fmt_immediate(i_sll, r,64 - a.ashsize,r);
6592
	   operate_fmt_immediate(i_sra, r,64 - a.ashsize,r);
2 7u83 6593
	 }
6594
	 else {
6 7u83 6595
	   operate_fmt_immediate(i_and,r,((1 << a.ashsize) - 1),r);
2 7u83 6596
	 }
6597
       }
6598
 
6 7u83 6599
       move(w.answhere, dest, guardreg(r, sp), 0);
6600
       keepreg(e, r);
2 7u83 6601
       return mka;
6602
     }
6603
#ifdef trap_tag
6 7u83 6604
    case trap_tag: {
6605
      if (no(e) == f_overflow) {
2 7u83 6606
	do_exception(f_overflow);
6607
      }
6 7u83 6608
      else if (no(e) == f_nil_access) {
2 7u83 6609
	do_exception(f_nil_access);
6610
      }
6611
      else {
6612
	do_exception(f_stack_overflow);
6613
      }
6614
      return mka;
6615
    }
6 7u83 6616
#endif
2 7u83 6617
 
6 7u83 6618
    case special_tag:{
6619
      if (no(e) == 0) {
6620
	no_parameter_instructions(i_trapb);
2 7u83 6621
      }
6622
      return mka;
6623
    }
6 7u83 6624
 
2 7u83 6625
#if 1
6 7u83 6626
     case condassign_tag:{
2 7u83 6627
       /*
6628
	 This handles a conditional assignment of the form:
6629
	 IF ( A .rel. B) THEN X = Y, using conditional moves.
6630
	 son(e) is the test_tag and bro(son(e)) is the assignment.
6 7u83 6631
	 Note that the test condition is the opposite of the
2 7u83 6632
	 condition for the conditional move (because the original
6633
	 test is a jump over the assigment).
6634
	*/
6635
       where assdest;
6636
       instruction cinst;
6637
       exp ctest = son(e);
6638
       exp cass = bro(ctest);
6639
       exp ltest = son(ctest);	/* lhs of test */
6640
       exp rtest = bro(ltest);	/* rhs of test */
6641
       int testid = props(ctest) & 127;
6642
       int targ1,targ2;		/* arguments of test */
6643
       int aarg1,aarg2;		/* arguments of assignment */
6644
       int rev = 0;		/* set if test is reversed */
6645
       ans aa;
6646
       exp rhs = bro(son(cass));
6647
       failer("ERROR: condassign_tag should not be encountered");
6648
       assdest = locate(son(cass),sp,sh(rhs),NO_REG);
6 7u83 6649
       if (((is_floating(name(sh(ltest)))) &&
6650
	  (!is_floating(name(sh(son(cass))))))
6651
	  || ((!is_floating(name(sh(ltest))))
6652
	      && (is_floating((name(sh(son(cass)))))))) {
2 7u83 6653
	 return make_code(ctest,sp,dest,exitlab);
6654
       }
6 7u83 6655
       if (is_floating(name(sh(ltest)))) {
6656
	 bool fcompare = (name(sh(ltest))!= shrealhd);
2 7u83 6657
	 instruction compare_ins;
6658
	 space nsp;
6659
	 int rdest  = getfreg(sp.flt);
6660
	 freg frg;
6661
	 targ1 = freg_operand(ltest,sp);
6662
	 nsp = guardreg(targ1,sp);
6663
	 targ2 = freg_operand(rtest,nsp);
6 7u83 6664
	 if (fcompare) {
2 7u83 6665
	   rev = fdouble_comparisons(&compare_ins,testid);
6666
	   float_op(compare_ins,targ1,targ2,rdest);
6667
	 }
6668
	 else {
6669
	   float_op(i_subs,targ1,targ2,rdest);
6670
	 }
6671
	 aarg1 = freg_operand(son(cass),sp);
6672
	 nsp = guardreg(aarg1,sp);
6673
	 aarg2 = freg_operand(bro(son(cass)),nsp);
6674
	 frg.fr = aarg1;
6675
	 frg.type = (name(sh(ltest)) == shrealhd)?IEEE_single:IEEE_double;
6676
	 float_op(rev?i_fcmovne:i_fcmoveq,rdest,aarg2,aarg1);
6677
	 setfregalt(aa,frg);
6678
       }
6679
       else { /* integer */
6 7u83 6680
	 bool is_compare = ((!is_signed(sh(ltest))) && ((testid-5) <0) &&
6681
			   (name(sh(ltest))!=ptrhd)) || ((is64(sh(ltest))));
2 7u83 6682
	 instruction compare_ins;
6683
	 int rres;	/* the result of the test */
6 7u83 6684
	 if (is_compare) {
2 7u83 6685
	   rev = comparisons(&compare_ins,sh(ltest),testid);
6686
	 }
6 7u83 6687
 
2 7u83 6688
	 targ1 = reg_operand(ltest,sp);
6 7u83 6689
	 if (name(rtest) == val_tag) {
2 7u83 6690
	   space nsp;
6 7u83 6691
	   if (no(rtest) || (isbigval(rtest))) {
2 7u83 6692
	     nsp = guardreg(targ1,sp);
6693
	     rres = getreg(nsp.fixed);
6 7u83 6694
	     if (is_compare) {
6695
	       if (isbigval(rtest)) {
2 7u83 6696
		 operate_fmt_big_immediate(compare_ins,targ1,
6697
					   exp_to_INT64(rtest),rres);
6698
	       }
6699
	       else{
6700
		 operate_fmt_immediate(compare_ins,targ1,no(rtest),rres);
6701
	       }
6702
	     }
6703
	     else{
6 7u83 6704
	       if (name(sh(ltest)) == ulonghd) {
2 7u83 6705
		 operate_fmt_immediate(i_addl,targ1,0,targ1);
6706
	       }
6 7u83 6707
	       if (isbigval(rtest)) {
2 7u83 6708
		 operate_fmt_big_immediate(i_subq,targ1,exp_to_INT64(rtest),
6709
					   rres);
6710
	       }
6711
	       else{
6712
		 operate_fmt_immediate(i_subq,targ1,no(rtest),rres);
6713
	       }
6714
	     }
6715
	   }
6716
	   else{	/* test against zero */
6717
	     rev = 0;
6718
	     rres = targ1;
6719
	   }
6720
	 }
6721
	 else{
6722
	   space nsp;
6723
	   nsp = guardreg(targ1,sp);
6724
	   targ2 = reg_operand(rtest,nsp);
6 7u83 6725
	   if (targ2 == 31) {
2 7u83 6726
	     rev = 0;
6727
	     rres = targ1;
6728
	   }
6729
	   else{
6730
	     rres = getreg(nsp.fixed);
6 7u83 6731
	     if (is_compare) {
2 7u83 6732
	       operate_fmt(compare_ins,targ1,targ2,rres);
6733
	     }
6734
	     else{
6735
	       operate_fmt(i_subq,targ1,targ2,rres);
6736
	     }
6737
	   }
6738
	 }
6739
	 aarg1 = regfrmdest(&assdest,sp);
6740
	 cinst = condmove((!rev)?testrev[testid-1]:testid);
6741
 
6 7u83 6742
	 if (is_compare) {
2 7u83 6743
	   cinst = rev?i_cmovne:i_cmoveq;
6744
	 }
6745
	 else{
6746
	   cinst = condmove((!rev)?testrev[testid-1]:testid);
6747
	 }
6 7u83 6748
 
6749
	 if (name(rhs) == val_tag) {
6750
	   if (isbigval(rhs)) {
2 7u83 6751
	     operate_fmt_big_immediate(cinst,rres,exp_to_INT64(rhs),aarg1);
6752
	   }
6753
	   else{
6 7u83 6754
	     if (no(rhs) == 0 && (testid == 5)) {
2 7u83 6755
	       operate_fmt_immediate(i_cmpeq,rres,31,aarg1);
6756
	     }
6757
	     else{
6758
	       operate_fmt_big_immediate(cinst,rres,exp_to_INT64(rhs),aarg1);
6759
	     }
6 7u83 6760
	     	   }
2 7u83 6761
	 }
6762
	 else{
6763
	   int r2 = reg_operand(rhs,sp);
6764
	   operate_fmt(cinst,rres,r2,aarg1);
6765
	 }
6766
	 setregalt(aa,aarg1);
6767
       }
6 7u83 6768
      (void)move(aa,assdest,sp,1);
6769
      (void)move(aa,dest,sp,1);
2 7u83 6770
       clear_dep_reg(son(cass));
6771
       return mka;
6772
     }
6773
#endif
6 7u83 6774
    default:
2 7u83 6775
      alphafail(TAG_NOT_IMPLEMENTED);
6776
    }				/* end outer switch */
6777
 
6778
moveconst:{
6779
  int   r = regfrmdest(&dest, sp);
6780
  ans aa;
6 7u83 6781
  if (r==NO_REG)
2 7u83 6782
    r=getreg(sp.fixed);
6783
  if (r != 31) {		/* somewhere! */
6 7u83 6784
    if (INT64_eq(constval,zero_int64))
2 7u83 6785
      operate_fmt(i_bis,31,31,r);
6786
    else{
6787
      load_store_immediate(is64(sh(e))?i_ldiq:i_ldil,r,constval);
6788
    }
6 7u83 6789
    setregalt(aa, r);
6790
    move(aa, dest, guardreg(r, sp), 1);
2 7u83 6791
  }
6792
  mka.regmove = r;
6793
  return mka;
6794
 }
6 7u83 6795
 
2 7u83 6796
}					/* end make_code */
6797
 
6798
 
6799