Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
2 7u83 1
/*
2
    		 Crown Copyright (c) 1997
3
 
4
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
12
 
13
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
15
 
16
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
19
 
20
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
22
        these conditions;
23
 
24
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
27
        it may be put.
28
*/
29
 
30
 
31
 
32
 
33
/*
34
			    VERSION INFORMATION
35
			    ===================
36
 
37
--------------------------------------------------------------------------
38
$Header: /u/g/release/CVSROOT/Source/src/installers/sparc/common/proc.c,v 1.2 1998/03/15 16:00:43 pwe Exp $
39
--------------------------------------------------------------------------
40
$Log: proc.c,v $
41
 * Revision 1.2  1998/03/15  16:00:43  pwe
42
 * regtrack dwarf dagnostics added
43
 *
44
 * Revision 1.1.1.1  1998/01/17  15:55:55  release
45
 * First version to be checked into rolling release.
46
 *
47
 * Revision 1.61  1998/01/09  14:59:42  pwe
48
 * prep restructure
49
 *
50
 * Revision 1.60  1997/11/06  09:29:13  pwe
51
 * ANDF-DE V1.8
52
 *
53
 * Revision 1.59  1997/10/28  10:19:05  pwe
54
 * extra diags
55
 *
56
 * Revision 1.58  1997/10/23  09:33:16  pwe
57
 * prep extra_diags
58
 *
59
 * Revision 1.57  1997/10/10  18:32:56  pwe
60
 * prep ANDF-DE revision
61
 *
62
 * Revision 1.56  1997/08/23  13:54:28  pwe
63
 * initial ANDF-DE
64
 *
65
 * Revision 1.55  1997/05/02  11:09:11  pwe
66
 * dwarf2 re return address offset
67
 *
68
 * Revision 1.54  1997/04/24  15:16:31  pwe
69
 * optim -O0 in tail_call
70
 *
71
 * Revision 1.53  1997/04/17  11:59:54  pwe
72
 * dwarf2 support
73
 *
74
 * Revision 1.52  1997/03/26  13:04:45  pwe
75
 * general proc compatibility
76
 *
77
 * Revision 1.51  1997/03/24  17:09:35  pwe
78
 * reorganise solaris/sunos split
79
 *
80
 * Revision 1.50  1997/02/18  11:48:17  pwe
81
 * NEWDIAGS for debugging optimised code
82
 *
83
 * Revision 1.49  1996/09/18  12:03:59  pwe
84
 * fixed PIC_code
85
 *
86
 * Revision 1.48  1996/09/10  14:36:48  pwe
87
 * fix diags - nested scope, param struct and leaf return
88
 *
89
 * Revision 1.47  1996/09/09  12:32:52  pwe
90
 * protect result during postlude
91
 *
92
 * Revision 1.46  1996/09/06  16:50:27  pwe
93
 * fix outpar doubles for postlude
94
 *
95
 * Revision 1.45  1996/09/04  12:41:37  pwe
96
 * untidy_call must not remove stacked callees
97
 *
98
 * Revision 1.44  1996/08/30  17:00:25  pwe
99
 * ensure space available for struct return
100
 *
101
 * Revision 1.43  1996/08/28  16:57:51  pwe
102
 * postlude with calls and no callers
103
 *
104
 * Revision 1.42  1996/08/28  11:47:54  pwe
105
 * correct postlude with calls
106
 *
107
 * Revision 1.41  1996/08/27  14:09:09  pwe
108
 * ensure all varargs are stored, and ptr is not64bit
109
 *
110
 * Revision 1.40  1996/08/22  16:47:10  pwe
111
 * correct accessing for double params
112
 *
113
 * Revision 1.39  1996/06/24  08:46:09  john
114
 * Removed aggregate initialisation
115
 *
116
 * Revision 1.38  1996/06/19  15:39:22  john
117
 * Fixed register allocation bug
118
 *
119
 * Revision 1.37  1996/05/24  10:46:08  john
120
 * Fixed discarded return for function returning struct/long double
121
 *
122
 * Revision 1.36  1996/03/20  15:39:49  john
123
 * Fix to  double & long double handling
124
 *
125
 * Revision 1.35  1996/03/18  09:02:03  john
126
 * Change to caller move
127
 *
128
 * Revision 1.34  1996/02/20  14:16:29  john
129
 * Fix for caller param lists containing structures.
130
 *
131
 * Revision 1.33  1996/01/17  10:29:59  john
132
 * Fix to stack space usage on tail call
133
 *
134
 * Revision 1.32  1996/01/10  17:23:00  john
135
 * Fix to check_stack
136
 *
137
 * Revision 1.31  1996/01/08  11:15:24  john
138
 * Fix to discarded function return when using out_pars
139
 *
140
 * Revision 1.30  1995/12/15  10:26:23  john
141
 * Changes stack error handling + fixes to postlude for general procs
142
 *
143
 * Revision 1.29  1995/11/27  09:22:54  john
144
 * Fixed register allocation
145
 *
146
 * Revision 1.28  1995/11/24  14:51:43  john
147
 * Fixed bug in register allocation
148
 *
149
 * Revision 1.27  1995/11/24  11:41:38  john
150
 * Fix for postludes
151
 *
152
 * Revision 1.26  1995/11/23  12:47:43  john
153
 * Fix for general procs
154
 *
155
 * Revision 1.25  1995/11/17  13:01:08  john
156
 * Fix to general proc call
157
 *
158
 * Revision 1.24  1995/11/16  17:23:43  john
159
 * Fix to same_callees
160
 *
161
 * Revision 1.23  1995/11/16  14:14:00  john
162
 * Fixed untidy return
163
 *
164
 * Revision 1.22  1995/11/16  14:03:28  john
165
 * Fixed register problems in general procs
166
 *
167
 * Revision 1.21  1995/11/07  09:42:09  john
168
 * Extensive changes to handling of callee parameters in general procs
169
 *
170
 * Revision 1.20  1995/11/01  16:13:59  john
171
 * Changed general proc definition
172
 *
173
 * Revision 1.19  1995/10/31  12:48:10  john
174
 * Change to dynamic callees
175
 *
176
 * Revision 1.18  1995/10/27  14:22:54  john
177
 * change to previous fix
178
 *
179
 * Revision 1.17  1995/10/27  10:51:41  john
180
 * Fix to general procs
181
 *
182
 * Revision 1.16  1995/10/25  17:13:18  john
183
 * Changed stack overflow test to unsigned
184
 *
185
 * Revision 1.15  1995/09/29  09:23:09  john
186
 * Fixed condition for setting Has_no_vcallers
187
 *
188
 * Revision 1.14  1995/09/27  13:35:27  john
189
 * Fix to tail_call
190
 *
191
 * Revision 1.13  1995/09/22  15:58:23  john
192
 * Fix to apply_general_proc
193
 *
194
 * Revision 1.12  1995/09/22  13:07:07  john
195
 * Fix to general procs
196
 *
197
 * Revision 1.11  1995/09/15  16:17:02  john
198
 * New exception handling
199
 *
200
 * Revision 1.10  1995/09/04  10:14:22  john
201
 * Fix to general procs
202
 *
203
 * Revision 1.9  1995/08/04  15:46:34  john
204
 * Fix to general procs
205
 *
206
 * Revision 1.8  1995/07/27  16:31:32  john
207
 * Fixed prototype
208
 *
209
 * Revision 1.7  1995/07/18  08:24:34  john
210
 * Fix to tail calls
211
 *
212
 * Revision 1.6  1995/07/14  16:33:23  john
213
 * Various changes for new spec
214
 *
215
 * Revision 1.5  1995/07/04  07:51:45  john
216
 * *** empty log message ***
217
 *
218
 * Revision 1.4  1995/06/30  08:29:35  john
219
 * Fixed bug in tail_call
220
 *
221
 * Revision 1.3  1995/06/14  15:35:44  john
222
 * Added support for trap error treatment and stack limits.  Also, some
223
 * reformatting
224
 *
225
 * Revision 1.2  1995/05/26  13:00:28  john
226
 * Changes for new spec (3.1)
227
 *
228
 * Revision 1.1.1.1  1995/03/13  10:18:51  john
229
 * Entered into CVS
230
 *
231
 * Revision 1.5  1995/01/17  15:32:24  john
232
 * Removed structure parameter check.
233
 *
234
 * Revision 1.4  1994/12/01  13:07:34  djch
235
 * with longjmp one can get procs of shape bottom. consider them as returning
236
 * void
237
 *
238
 * Revision 1.3  1994/07/07  16:11:33  djch
239
 * Jul94 tape
240
 *
241
 * Revision 1.2  1994/05/13  13:06:59  djch
242
 * Incorporates improvements from expt version
243
 * removed rscope related fns.
244
 * added RET_IN_CODE, not set -> return at end of leaf, not in middle...
245
 *
246
 * Revision 1.1  94/05/03  14:49:48  djch
247
 * Initial revision
248
 * 
249
 * Revision 1.8  94/02/21  16:12:49  16:12:49  ra (Robert Andrews)
250
 * reg_result now returns int, not bool.
251
 * 
252
 * Revision 1.7  93/09/27  14:53:49  14:53:49  ra (Robert Andrews)
253
 * In System V the __GLOBAL_OFFSET_TABLE_ starts with only one _.
254
 * 
255
 * Revision 1.6  93/08/27  11:35:12  11:35:12  ra (Robert Andrews)
256
 * A number of lint-like changes.
257
 * 
258
 * Revision 1.5  93/08/13  14:44:13  14:44:13  ra (Robert Andrews)
259
 * Reformatted.
260
 * 
261
 * Revision 1.4  93/07/14  11:21:26  11:21:26  ra (Robert Andrews)
262
 * Misprint when reformatting : .reserved should be .reserve.
263
 * 
264
 * Revision 1.3  93/07/05  18:23:46  18:23:46  ra (Robert Andrews)
265
 * Made distinction between the System V assembler and the System V ABI.
266
 * Added support for PIC (procedure prologue).
267
 * 
268
 * Revision 1.2  93/06/29  14:30:40  14:30:40  ra (Robert Andrews)
269
 * Changed an error message.
270
 * 
271
 * Revision 1.1  93/06/24  14:59:01  14:59:01  ra (Robert Andrews)
272
 * Initial revision
273
 * 
274
--------------------------------------------------------------------------
275
*/
276
 
277
/*
278
  This file contains functions which handle the various aspects
279
  of procedure definition and invocation.
280
*/
281
 
282
 
283
#define SPARCTRANS_CODE
284
#include "config.h"
285
#include "common_types.h"
286
#include "myassert.h"
287
#include "addrtypes.h"
288
#include "tags.h"
289
#include "expmacs.h"
290
#include "installtypes.h"
291
#include "exp.h"
292
#include "exptypes.h"
293
#include "maxminmacs.h"
294
#include "shapemacs.h"
295
#include "basicread.h"
296
#include "proctypes.h"
297
#include "eval.h"
298
#include "move.h"
299
#include "comment.h"
300
#include "getregs.h"
301
#include "guard.h"
302
#include "locate.h"
303
#include "codehere.h"
304
#include "inst_fmt.h"
305
#include "sparcins.h"
306
#include "bitsmacs.h"
307
#include "labels.h"
308
#include "regexps.h"
309
#include "regmacs.h"
310
#include "regable.h"
311
#include "flags.h"
312
#include "special.h"
313
#include "translat.h"
314
#include "makecode.h"
315
#include "out.h"
316
#include "proc.h"
317
#include "szs_als.h"
318
#include "externs.h"
319
#include "sparctrans.h"
320
 
321
#ifdef NEWDIAGS
322
#include "dg_globs.h"
323
#endif
324
 
325
#ifdef NEWDWARF
326
#include "dw2_config.h"
327
#include "dw2_info.h"
328
#include "dw2_basic.h"
329
#include "dw2_extra.h"
330
#endif
331
 
332
/*
333
  CODE GENERATION STATE FOR THE CURRENT PROCEDURE
334
*/
335
 
336
static void alloc_space PROTO_S((int,int));
337
static void alloc_reg_space PROTO_S((int,int));
338
 
339
extern int call_base_reg;
340
 
341
 
342
struct proc_state proc_state ;
343
static exp current_proc;
344
 
345
bool Has_vcallees = 0;
346
bool Has_no_vcallers = 0;
347
bool in_general_proc = 0;
348
#ifdef GENCOMPAT
349
bool May_have_callees = 0;
350
#endif
351
 
352
 
353
static bool in_postlude = 0;
354
 
355
extern char * proc_name;
356
int local_reg = R_I5;
357
 
358
int callee_start_reg = R_I5;   /* will point to start of callee params */
359
 
360
int callee_end_reg = R_I4;     /* will point to end of callee params.  Only
361
				  used for variable or dynamic parameter
362
				  lists */
363
int callee_start_reg_out = R_O5;
364
int callee_end_reg_out = R_O4;
365
 
366
 
367
static int vc_call = 0;
368
 
369
int aritherr_lab = 0;
370
 
371
int stackerr_lab = 0;
372
int local_stackerr_lab = 0;
373
 
374
#define is64(X) ((name(X)==u64hd)||(name(X)==s64hd))
375
 
376
 
377
void call_tdf_main 
378
    PROTO_Z () {
379
  outs("\tcall\t___TDF_main\n");
380
  outs("\tnop\n");
381
  return;
382
}
383
 
384
 
385
 
386
 
387
/*
388
  FIND TEMPORARY MEMORY
389
  This is a temporary location in the stack frame callee parameter 
390
  save area that can be used in short instruction sequences, such 
391
  as moving between float and fixed registers.  It is initialised 
392
  in the procedure prelude.
393
*/
394
 
395
baseoff mem_temp 
396
    PROTO_N ( ( byte_offset ) )
397
    PROTO_T ( int byte_offset ){
398
  baseoff b ;
399
  b = proc_state.mem_temp0 ;
400
  /* only 2 words of temp allocated */
401
  assert ( byte_offset >= 0 && byte_offset < 8 ) ;
402
  b.offset += byte_offset ;
403
  return ( b ) ;
404
}
405
 
406
 
407
 
408
/*
409
  Postlude chaining function 
410
*/
411
static postlude_chain * old_postludes;
412
 
413
void update_plc 
414
    PROTO_N ( ( chain, maxargs ) )
415
    PROTO_T ( postlude_chain* chain X int maxargs ) {
416
 
417
  while(chain) {
418
    exp pl = chain->postlude;
419
    while(name(pl) == ident_tag) {
420
      if (name(son(pl)) == caller_name_tag)
421
	no(pl) += (maxargs<<1);
422
      pl = bro(son(pl));
423
    }
424
    chain = chain->outer;
425
  }
426
  return;
427
}
428
 
429
 
430
/*
431
  ENCODE A PROCEDURE DEFINITION
432
*/
433
 
434
makeans make_proc_tag_code 
435
    PROTO_N ( ( e, sp, dest, exitlab ) )
436
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
437
  procrec *pr = &procrecs [ no ( e ) ] ;
438
  needs *ndpr = &pr->needsproc ;
439
  spacereq *sppr = &pr->spacereqproc ;
440
  long pprops = ( long ) ( ndpr->prps ) ;
441
  bool leaf = ( bool ) ( ( pprops & anyproccall ) == 0 ) ;	/* LINT */
442
  long maxargs = ndpr->maxargs ;/* maxargs of proc body in bits */
443
  long st = sppr->stack ;		/* space for locals in bits */
444
  struct proc_state old_proc_state ;
445
  makeans mka ;
446
  exp par ;
447
  old_postludes = (postlude_chain*)NULL;
448
  current_proc = e;
449
  Has_vcallees = (name(e) == general_proc_tag) && (proc_has_vcallees(e));
450
  Has_no_vcallers = (name(e) == proc_tag) || (!proc_has_vcallers(e));
451
  in_general_proc = (name(e) == general_proc_tag);
452
#ifdef GENCOMPAT
453
  May_have_callees = proc_may_have_callees(e);
454
#endif
455
  /* save & reinstate proc_state for nested procs */
456
  old_proc_state = proc_state ;
457
  mka.lab = exitlab ;
458
  mka.regmove = NOREG ;
459
#ifdef GENCOMPAT
460
  if (May_have_callees) {
461
#else
462
  if(in_general_proc) {
463
#endif
464
    sp = guardreg(callee_start_reg,sp);
465
  }
466
 
467
  if(Has_vcallees) {
468
    sp = guardreg(callee_end_reg,sp);
469
    outs("\t.optim\t\"-O0\"\n"); /* as -O2 optimises out some moves 
470
				    from %sp to other registers */
471
  }
472
 
473
  /* this is a procedure definition */
474
  assert ( name ( e ) == proc_tag || name(e) == general_proc_tag) ;
475
 
476
  /* set global flag for res_tag */
477
  proc_state.leaf_proc = leaf ;
478
 
479
  /* maxargs is the maxargs in bits of any proc called, not this proc */
480
 
481
  /* SPARC reserved stack area */
482
  if ( leaf ) {
483
    /* reg window dump area */
484
    assert ( maxargs == 0 ) ;
485
    maxargs = ( 16 ) * 32 ;
486
  } 
487
  else {
488
    assert ( maxargs >= 0 ) ;
489
    /* at least reg param dump for calls */
490
    if ( maxargs < ( 6 ) * 32 ) maxargs = ( 6 ) * 32 ;
491
    /* plus reg window dump area + hidden struct return param */
492
    maxargs += ( 16 + 1 ) * 32 ;
493
  }
494
 
495
  /* use space we are allowing for called procs */
496
  proc_state.mem_temp0.base = R_SP ;
497
  proc_state.mem_temp0.offset = ( 16 + 1 + 1 ) * 4 ;
498
 
499
  /* double word aligned */
500
  assert ( ( proc_state.mem_temp0.offset & 7 ) == 0 ) ;
501
 
502
  /* make sure mem_temp () is allowed for */
503
  if ( proc_state.mem_temp0.base == R_SP &&
504
       maxargs < ( ( proc_state.mem_temp0.offset + 8 ) << 3 ) ) {
505
    /* ie, a leaf proc */
506
    assert ( leaf ) ;
507
    maxargs = ( proc_state.mem_temp0.offset + 8 ) << 3 ;
508
    }
509
 
510
  /* align to 64 bit boundaries */
511
  maxargs = ( maxargs + 63 ) & ~63 ;
512
  st = ( st + 63 ) & ~63 ;
513
  /* -----------------------WARNING--------------------------- */
514
  /* if you alter these then please check boff_env_offset, 'cos 
515
     they're effectively reproduced there..... */
516
  proc_state.locals_space = st ;
517
  proc_state.locals_offset = 0 ;
518
  /*proc_state.params_offset = ( 16 + 1 ) * 32 ;*/
519
  proc_state.params_offset = PARAMS_OFFSET;
520
  proc_state.callee_size = ndpr->callee_size;
521
  /* beyond register window save area and hidden param of 
522
     caller's frame */
523
 
524
  proc_state.frame_size = maxargs + st ;
525
  proc_state.maxargs = maxargs ;
526
 
527
  st = proc_state.frame_size >> 3 ;
528
 
529
#ifdef NEWDWARF
530
  if (dwarf2) {
531
    START_BB ();
532
    dw2_start_fde(current_proc);
533
  }
534
#endif
535
 
536
  if(name(e) == general_proc_tag){
537
    if(proc_has_checkstack(e) && (st > 64)) {
538
      rir_ins(i_save,R_SP,-64,R_SP);
539
    }
540
    else {
541
      rir_ins(i_save,R_SP,-st,R_SP);
542
    }
543
#ifdef NEWDWARF
544
    if (dwarf2)
545
      dw2_fde_save();
546
#endif
547
#ifdef GENCOMPAT
548
    if (May_have_callees)
549
#endif
550
    {
551
      int entry_lab = new_label();
552
      uncond_ins(i_b,entry_lab);
553
      /*rir_ins(i_save,R_SP,0,R_SP);*/
554
 
555
      if(st>64) {
556
	rir_ins(i_sub,R_SP, st - 64,R_SP);
557
      }
558
      set_label(entry_lab);
559
    }
560
  }
561
  else{
562
    rir_ins ( i_save, R_SP, -st, R_SP ) ;
563
#ifdef NEWDWARF
564
    if (dwarf2)
565
      dw2_fde_save();
566
#endif
567
    /* more here about fp */
568
  }
569
 
570
  /* position independent code */
571
  if ( PIC_code && proc_uses_external ( e ) ) {
572
    char *g = "__GLOBAL_OFFSET_TABLE_" ;
573
    if ( sysV_assembler ) g++ ;
574
    outs ( "1:\n" ) ;
575
    outs ( "\tcall\t2f\n" ) ;
576
    outf ( "\tsethi\t%%hi(%s+(.-1b)),%%l7\n", g ) ;
577
    outs ( "2:\n" ) ;
578
    outf ( "\tor\t%%l7,%%lo(%s+(.-1b)),%%l7\n", g ) ;
579
    outs ( "\tadd\t%l7,%o7,%l7\n" ) ;
580
#ifdef NEWDWARF
581
    if (dwarf2)
582
      lost_count_ins();
583
#endif
584
  }
585
 
586
  local_stackerr_lab = 0;
587
  stackerr_lab = 0;
588
  if(name(e) == general_proc_tag){
589
    if(proc_has_checkstack(e)){
590
      baseoff b;
591
      int rtmp;
592
      int rt;
593
      if (st > 64) {
594
	rt = getreg(sp.fixed);
595
	rir_ins(i_sub,R_SP,(st - 64),rt);
596
      }
597
      else {
598
	rt = R_SP;
599
      }
600
      b = find_tag(TDF_STACKLIM);
601
      stackerr_lab = new_label();
602
      rtmp = getreg(guardreg(rt,sp).fixed);
603
      ld_ins(i_ld,b,rtmp);
604
      condrr_ins(i_bgtu,rtmp,R_SP,stackerr_lab);
605
      if(rt != R_SP) {
606
	rr_ins(i_mov,rt,R_SP);
607
      }
608
    }
609
 
610
    /* Here we make a local copy of the callees */
611
    if(Has_vcallees) {
612
      baseoff b;
613
      int copy_lab = new_label();
614
      int end_copy_lab = new_label();
615
      /* copy callees to new space (pointed to by reg rdest) */
616
      int rsize = getreg(sp.fixed);
617
      int rdest = getreg(guardreg(rsize,sp).fixed);
618
      int rt = getreg(guardreg(rdest,sp).fixed);
619
      rrr_ins(i_sub,callee_end_reg,callee_start_reg,rsize);
620
      condrr_ins(i_be,rsize,R_G0,end_copy_lab);
621
      alloc_reg_space(rsize,rdest);
622
      b.offset = 0;
623
      set_label(copy_lab);
624
      b.base = callee_start_reg;
625
      ld_ro_ins(i_ld,b,rt);
626
      b.base = rdest;
627
      st_ro_ins(i_st,rt,b);
628
      rir_ins(i_add,callee_start_reg,PTR_SZ>>3,callee_start_reg);
629
      rir_ins(i_add,rdest,PTR_SZ>>3,rdest);
630
      condrr_ins(i_bne,callee_start_reg,callee_end_reg,copy_lab);
631
      /* now set up the new callee pointers */
632
      rr_ins(i_mov,rdest,callee_end_reg);
633
      rrr_ins(i_sub,rdest,rsize,callee_start_reg);
634
      set_label(end_copy_lab);
635
    }
636
#ifdef GENCOMPAT
637
    else
638
    if (May_have_callees) {
639
#else
640
    else {
641
#endif
642
      baseoff b;
643
      int size = proc_state.callee_size/8;
644
      int rdest = getreg(sp.fixed);
645
      int el;
646
      int rt = getreg(guardreg(rdest,sp).fixed);
647
      alloc_space(size,rdest);
648
      b.offset = 0;
649
      for(el = proc_state.callee_size/8;el>0;el -= (PTR_SZ>>3)) {
650
	b.base = callee_start_reg;
651
	b.offset = el - (PTR_SZ>>3);
652
	ld_ro_ins(i_ld,b,rt);
653
	b.base = rdest;
654
	st_ro_ins(i_st,rt,b);
655
      }
656
      /* now deallocate old storage.  This is needs for outpars to be 
657
	 accessed properly from postludes. */
658
#if 0
659
      rir_ins(i_add,callee_start_reg,((proc_state.callee_size>>3)+7)&~7,callee_start_reg);
660
      rir_ins(i_sub,callee_start_reg,96,R_FP);
661
#endif
662
      rr_ins(i_mov,rdest,callee_start_reg);
663
 
664
    }
665
  }
666
  if ( do_profile ) {
667
      /* implement -p option, call mcount */
668
    static int p_lab = 0 ;
669
    p_lab++ ;
670
    if ( sysV_assembler ) {
671
      outs ( "\t.reserve\tLP." ) ;
672
      outn ( p_lab ) ;
673
      outs ( ",4,\".bss\",4\n" ) ;
674
      } 
675
    else {
676
      outs ( "\t.reserve\tLP." ) ;
677
      outn ( p_lab ) ;
678
      outs ( ",4,\"bss\",4\n" ) ;
679
    }
680
    insection ( text_section ) ;
681
    outs ( "\tset\tLP." ) ;
682
    outn ( p_lab ) ;
683
    outs ( ",%o0\n" ) ;
684
#ifdef NEWDWARF
685
    if (dwarf2)
686
      lost_count_ins();
687
#endif
688
    extj_special_ins ( i_call, "mcount", 1 ) ;
689
  }
690
 
691
    /* Move params if necessary */
692
  par = son ( e ) ;
693
  while ( name ( par ) == ident_tag ) {
694
    if ( isparam ( par ) ) {
695
      /* Got a parameter ident */
696
      int r = ( int ) props ( son ( par ) ) ;
697
      /* ( r == 0 ) ? ( on stack ) : ( input reg no ) */
698
/*	assert ( name ( son ( par ) ) == clear_tag ) ;*/
699
 
700
      if ( r != 0 ) {
701
	/* Parameter in register */
702
	assert ( R_I0 <= r && r <= R_I5 ) ;
703
 
704
	if ( no ( par ) != 0 ) {
705
	  if ( no ( par ) == R_NO_REG ) {
706
	    /* struct/union parameter, on stack aleady,
707
	       nothing useful in reg */
708
	    assert ( !fixregable ( par ) &&
709
		     !floatregable ( par ) ) ;
710
	  } 
711
	  else if ( no ( par ) == r ) {
712
	    if ( name ( sh ( son ( par ) ) ) == ucharhd ) {
713
	      rir_ins ( i_and, r, 255, no ( par ) ) ;
714
	    } 
715
	    else if ( name ( sh ( son ( par ) ) ) == uwordhd ) {
716
	      rir_ins ( i_and, r, 65535, no ( par ) ) ;
717
	    }	
718
	  } 
719
	  else {
720
	    if ( name ( sh ( son ( par ) ) ) == ucharhd ) {
721
	      rir_ins ( i_and, r, 255, no ( par ) ) ;
722
	    } 
723
	    else if ( name ( sh ( son ( par ) ) ) == uwordhd ) {
724
	      rir_ins ( i_and, r, 65535, no ( par ) ) ;
725
	    } 
726
	    else {
727
	      rr_ins ( i_mov, r, no ( par ) ) ;
728
	    }
729
	  }
730
	} 
731
	else {
732
	  /* Parameter in reg move to stack */
733
	  baseoff stackpos ;
734
	  long size = shape_size ( sh ( son ( par ) ) ) ;
735
	  int offs = ( int ) ( ( no ( son ( par ) ) +
736
				 proc_state.params_offset ) >> 3 ) ;
737
	  stackpos.base = R_FP ;
738
	  stackpos.offset =offs ;
739
 
740
	  switch ( size ) {
741
	    case 8 : {
742
	      st_ro_ins ( i_stb, r, stackpos ) ;
743
	      break ;
744
	    }
745
	    case 16 : {
746
	      st_ro_ins ( i_sth, r, stackpos ) ;
747
	      break ;
748
	    }
749
	    case 32 : {
750
	      st_ro_ins ( i_st, r, stackpos ) ;
751
	      break ;
752
	    }
753
	    case 64 : {
754
	      /* A double can be passed first word in reg
755
		 (R_I5) and second word on stack. Must only
756
		 store out first word in this case  */
757
	      st_ro_ins ( i_st, r, stackpos ) ;
758
	      if ( r != R_I5 ) {
759
		/* float point double passed in fixed
760
		   point reg pair */
761
		stackpos.offset += 4 ;
762
		st_ro_ins ( i_st, r + 1, stackpos ) ;
763
	      }
764
	      break ;
765
	    }
766
	    default : {
767
	      fail ( "bad size in make_proc_tag_code" ) ;
768
	      break ;
769
	    }
770
	  }
771
	}
772
      } 
773
      else {
774
	/* Param on stack, no change */
775
      }
776
    }
777
    par = bro ( son ( par ) ) ;
778
  }
779
 
780
  clear_all () ;
781
 
782
 
783
    if ( ( pprops & long_result_bit ) != 0 ) {
784
      /* structure or union result, address of space to [ %fp+64 ] */
785
      instore is ;
786
      /* [%fp+64] as per call convention */
787
      is.adval = 0 ;
788
      is.b.base = R_FP ;
789
      is.b.offset = ( 16 * 4 ) ;
790
      setinsalt ( proc_state.procans, is ) ;
791
    } 
792
    else if ( ( pprops & realresult_bit ) != 0 ) {
793
      /* proc has real result */
794
      freg frg ;
795
      frg.fr = 0 ;
796
      frg.dble = ( bool ) ( ( pprops & longrealresult_bit ) ? 1 : 0 ) ;
797
      setfregalt ( proc_state.procans, frg ) ;
798
    } 
799
    else if ( ( pprops & has_result_bit ) != 0 ) {
800
      setregalt ( proc_state.procans, R_I0 ) ;
801
    } 
802
    else {
803
      /* no result */
804
      setregalt ( proc_state.procans, R_G0 ) ;
805
    }
806
 
807
    proc_state.rscope_level = 0 ;
808
    proc_state.result_label = 0 ;
809
 
810
    /* code for body of proc */
811
#if 1
812
    if(!sysV_abi && do_dynamic_init && !strcmp(proc_name,"_main")) {
813
      call_tdf_main();
814
    }
815
#endif    
816
    (void) code_here ( son ( e ), sp, nowhere ) ;
817
    clear_all () ;
818
    if (stackerr_lab){
819
      set_label(stackerr_lab);
820
      fprintf ( as_file, "\t%s\n", i_restore ) ;     
821
      if(local_stackerr_lab) {
822
	set_label(local_stackerr_lab);
823
      }
824
 
825
      /*rir_ins(i_add,R_SP,proc_state.frame_size>>3,R_SP);*/
826
      do_exception(f_stack_overflow);
827
    }
828
    if (aritherr_lab != 0){
829
      set_label(aritherr_lab);
830
      do_exception(f_overflow);
831
    }
832
 
833
#ifndef RET_IN_CODE
834
    if (proc_state.result_label !=0){
835
      set_label ( proc_state.result_label ) ;
836
#ifdef NEWDWARF
837
      if (dwarf2)
838
        dw2_return_pos (0);
839
#endif
840
      ret_restore_ins () ;
841
    }
842
#endif	
843
#ifdef NEWDWARF
844
    if (dwarf2)
845
      dw2_complete_fde ();
846
#endif    
847
    proc_state = old_proc_state ;
848
    return ( mka ) ;
849
}
850
 
851
 
852
 
853
/*
854
  ENCODE A PROCEDURE RESULT
855
*/
856
 
857
makeans make_res_tag_code 
858
    PROTO_N ( ( e, sp, dest, exitlab ) )
859
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
860
  where w ;
861
  makeans mka ;
862
  mka.lab = exitlab ;
863
  mka.regmove = NOREG ;
864
  assert ( name ( e ) == res_tag || name(e) == untidy_return_tag) ;
865
  w.answhere = proc_state.procans ;
866
  w.ashwhere = ashof ( sh ( son ( e ) ) ) ;
867
  ( void ) code_here ( son ( e ), sp, w ) ;
868
  assert(proc_state.rscope_level == 0);
869
				/* procedure return */
870
  switch ( discrim ( w.answhere ) ){
871
    case notinreg : {
872
      instore isw ;
873
      isw = insalt ( w.answhere ) ;
874
      /* [%fp+64] as per call convention */
875
      if ( isw.adval == 0 && isw.b.base == R_FP &&
876
	   isw.b.offset == ( 16 * 4 ) ) {
877
	/* struct or union result */
878
#ifdef NEWDWARF
879
	if (dwarf2)
880
	  dw2_return_pos (0);
881
#endif
882
	stret_restore_ins () ;
883
	break ;
884
      }	
885
	   /* FALL THROUGH */
886
    }
887
    default : 
888
    {
889
      /* not struct or union result */
890
      if ( proc_state.leaf_proc && name(e) == res_tag && !sysV_assembler
891
#ifdef NEWDIAGS
892
		&& !diag_visible) {
893
#else
894
		&& !diagnose) {
895
#endif
896
	/* Use only one return per proc, as this is necessary
897
	   for the peep-hole assembler 'as -O' to recognise
898
	   leaf procs (not applicable in SunOS
899
	   5 assembler).  Empirical tests show that using last
900
	   return is very slightly faster for SPECint tests
901
		- but beware of confusing diagnostic info */
902
	if ( proc_state.result_label == 0 ) {
903
	  /* first return in proc, generate return */
904
	  proc_state.result_label = new_label () ;
905
	  /* first return in a leaf proc is ret_restore,
906
	     others branch here */
907
#if RET_IN_CODE
908
	  set_label ( proc_state.result_label ) ;
909
	  {
910
	    baseoff b;
911
	    b.base = R_FP;
912
#if 0
913
	    if(Has_vcallees){
914
	      baseoff b;
915
	      b.base = R_FP;
916
	      b.offset = -4 * PTR_SZ>>3;
917
	      ld_ro_ins(i_ld,b,local_reg);
918
	    }
919
#endif
920
	  }
921
#ifdef NEWDWARF
922
	  if (dwarf2)
923
	    dw2_return_pos (0);
924
#endif
925
	  if(name(e) == res_tag) {
926
	    ret_restore_ins () ;
927
	  }
928
	  else {
929
	    fprintf ( as_file, "\t%s\n", i_ret );
930
#ifdef NEWDWARF
931
	    if (dwarf2)
932
	      count_ins(1);
933
#endif
934
	    rir_ins(i_restore,R_SP,-proc_state.maxargs>>3,R_SP);
935
	  }
936
 
937
#else
938
	  uncond_ins ( i_b, proc_state.result_label ) ;
939
#endif
940
	} 
941
	else {
942
	  /* jump to the return for this proc */
943
	  uncond_ins ( i_b, proc_state.result_label ) ;
944
	}
945
      } 
946
      else {
947
	baseoff b;
948
	b.base = R_FP;
949
#if 0
950
	if(Has_vcallees){
951
	  baseoff b;
952
	  b.base = R_FP;
953
	  b.offset = -4 * PTR_SZ>>3;
954
	  ld_ro_ins(i_ld,b,local_reg);
955
	}
956
#endif
957
	/* return here, avoiding cost of branch to return */
958
#ifdef NEWDWARF
959
	if (dwarf2)
960
	  dw2_return_pos (0);
961
#endif
962
	if(name(e) == res_tag) {
963
	  ret_restore_ins () ;
964
	}
965
	else {
966
	  fprintf ( as_file, "\t%s\n", i_ret );
967
#ifdef NEWDWARF
968
	  if (dwarf2)
969
	    count_ins(1);
970
#endif
971
	  rir_ins(i_restore,R_SP,-proc_state.maxargs>>3,R_SP);
972
	  /*fprintf ( as_file, "\t%s,\%sp,0,\%sp\n", i_restore ) ;*/
973
	}
974
	/*      ret_restore_ins () ;*/
975
      }
976
    }
977
  }
978
  /* regs invalid after return (what about inlining?) */
979
  clear_all () ;	
980
  return ( mka ) ;
981
}
982
 
983
 
984
/*
985
  ENCODE A PROCEDURE CALL
986
*/
987
extern int reg_result PROTO_S ( ( shape ) ) ;
988
 
989
makeans make_apply_tag_code 
990
    PROTO_N ( ( e, sp, dest, exitlab ) )
991
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
992
  exp fn = son ( e ) ;
993
  exp par = bro ( fn ) ;
994
  exp list = par ;
995
  int hda = ( int ) name ( sh ( e ) ) ;
996
  int special ;
997
  int param_reg = R_O0 ;	 /* next param reg to use */
998
  int param_regs_used ;	 /* how many were used */
999
  ash ansash ;
1000
  space nsp ;
1001
  int void_result = (( name ( sh ( e ) ) == tophd ) ||
1002
		     ( name ( sh ( e ) ) == bothd));
1003
 
1004
  int reg_res = reg_result ( sh ( e ) ) ;
1005
  int guarded_dest_reg = R_NO_REG ;/* reg used to address tuple result */
1006
  makeans mka ;
1007
 
1008
  exp dad = father ( e ) ;
1009
  bool tlrecurse = ( bool ) ( proc_state.rscope_level == 0 &&
1010
			      name ( dad ) == res_tag && props ( dad ) ) ;
1011
 
1012
  nsp = sp ;
1013
 
1014
  mka.lab = exitlab ;
1015
  mka.regmove = NOREG ;
1016
  assert ( name ( e ) == apply_tag ) ;
1017
 
1018
  /* first see if it is a special to be handled inline */
1019
  if ( ( special = specialfn ( fn ) ) > 0 ) {
1020
    /* eg function is strlen */
1021
    mka.lab = specialmake ( special, list, sp, dest, exitlab ) ;
1022
    return ( mka ) ;
1023
  }
1024
 
1025
  ansash = ashof ( sh ( e ) ) ;
1026
 
1027
  if ( !reg_res && !void_result ) {
1028
    /* structure or union result, address of space to [%sp+64] 
1029
     must do this before evaluating args as dest may use param reg */
1030
    instore is ;
1031
    baseoff stack_struct_ret_addr ;
1032
 
1033
    /* [%sp+64] as per call convention */
1034
    stack_struct_ret_addr.base = R_SP ;
1035
    stack_struct_ret_addr.offset = ( 16 * 4 ) ;
1036
 
1037
    assert ( discrim ( dest.answhere ) == notinreg ) ;
1038
    if(discrim(dest.answhere) != notinreg){	/* should be redundant */
1039
      is.b = mem_temp(0);
1040
      is.adval = 1;
1041
    }
1042
    else{
1043
      is = insalt ( dest.answhere ) ;
1044
    }
1045
    if ( is.adval ) {
1046
      /* generate address of dest */
1047
      if ( IS_FIXREG ( is.b.base ) ) {
1048
	if ( is.b.offset == 0 ) {
1049
	  st_ro_ins ( i_st, is.b.base, stack_struct_ret_addr ) ;
1050
	} 
1051
	else {
1052
	  rir_ins ( i_add, is.b.base, is.b.offset, R_TMP ) ;
1053
	  st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
1054
	}
1055
	guarded_dest_reg = is.b.base ;	/* can be guarded */
1056
      } 
1057
      else {
1058
	set_ins ( is.b, R_TMP ) ;
1059
	st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
1060
      }
1061
    } 
1062
    else {
1063
      /* load dest */
1064
      ld_ins ( i_ld, is.b, R_TMP ) ;
1065
      st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
1066
    }
1067
  }
1068
 
1069
 
1070
  /* evaluate params to param reg or stack */
1071
  if ( !last ( fn ) ) {
1072
    int param_offset = ( 16 + 1 ) * 32 ;
1073
    /* beyond reg window save area and hidden param of caller's frame */
1074
 
1075
    /* evaluate parameters in turn */
1076
    for ( ; ; ) {
1077
      ash ap ;
1078
      where w ;
1079
      shape a = sh ( list ) ;
1080
      int hd = ( int ) name ( a ) ;
1081
      ap = ashof ( a ) ;
1082
      w.ashwhere = ap ;
1083
 
1084
      if ( 0 /*struct_par*/ ) {
1085
	/* non-ABI construct being used - give stronger warning */
1086
	if ( sysV_abi ) fail ( "Structure parameter passed by value" ) ;
1087
      }
1088
 
1089
      if ( is_floating ( hd ) && param_reg <= R_O5 ) {
1090
	/* Float point. Copy to stack as if stack parameter,
1091
	   then recover words as needed into fixed point regs */
1092
	instore is ;
1093
	/* Locations we offer may not be aligned for doubles.  We
1094
	   assume 'move' can cope with this */
1095
	is.b.base = R_SP ;
1096
	is.b.offset = param_offset >> 3 ;
1097
	is.adval = 1 ;
1098
 
1099
	setinsalt ( w.answhere, is ) ;
1100
	( void ) code_here ( list, nsp, w ) ;
1101
	ld_ro_ins ( i_ld, is.b, param_reg ) ;
1102
	nsp = guardreg ( param_reg, nsp ) ;
1103
	param_reg++ ;     
1104
	param_offset += 32 ;
1105
 
1106
	if ( hd != shrealhd ) {
1107
	  /* double */
1108
	  if ( param_reg <= R_O5 ) {
1109
	    /* double whose second word can go in reg */
1110
	    is.b.offset += 4 ;
1111
	    ld_ro_ins ( i_ld, is.b, param_reg ) ;
1112
	    nsp = guardreg ( param_reg, nsp ) ;
1113
	    param_reg++ ;
1114
	  }
1115
	  param_offset += 32 ;
1116
	}
1117
      } 
1118
      else if ( valregable ( sh ( list ) ) && param_reg <= R_O5 ) {
1119
	/* fixed point parameter in a single reg */
1120
	nsp = guardreg ( param_reg, nsp ) ;
1121
	reg_operand_here ( list, nsp, param_reg ) ;
1122
	param_reg++ ;     
1123
	param_offset += 32 ;
1124
      } 
1125
      else {
1126
	/* stack parameter */
1127
	instore is ;
1128
	/* Locations we offer may not be aligned for doubles.
1129
	   We assume 'move' can cope with this  */
1130
	is.b.base = R_SP ;
1131
	is.b.offset = param_offset >> 3 ;
1132
	is.adval = 1 ;
1133
	if ( valregable ( sh ( list ) ) &&
1134
	     ( ap.ashsize == 8 || ap.ashsize == 16 ) ) {
1135
	  /* Byte or 16bit scalar parameter - convert to integer.
1136
	     We must pass a full word to conform with SPARC ABI,
1137
	     so have to expand source to full word.  We do this
1138
	     by loading into a reg */
1139
	  int r = reg_operand ( list, nsp ) ;
1140
	  ans op ;
1141
	  setregalt ( op, r ) ;
1142
	  /* round down to word boundary */
1143
	  is.b.offset &= ~0x3 ;
1144
	  ap.ashsize = ap.ashalign = 32 ;
1145
	  w.ashwhere = ap ;
1146
	  setinsalt ( w.answhere, is ) ;
1147
	  ( void ) move ( op, w, guardreg ( r, nsp ).fixed, 1 ) ;
1148
	} 
1149
	else {
1150
	  setinsalt ( w.answhere, is ) ;
1151
	  ( void ) code_here ( list, nsp, w ) ;
1152
	}
1153
	param_offset = ( int ) ( param_offset + ap.ashsize ) ;
1154
      }
1155
 
1156
      if ( last ( list ) ) break ;
1157
      list = bro ( list ) ;
1158
    }
1159
  }
1160
 
1161
  assert ( param_reg >= R_O0 && param_reg <= R_O5 + 1 ) ;
1162
  param_regs_used = param_reg - R_O0 ;
1163
 
1164
  if ( special != 0 ) {
1165
    extj_special_ins ( i_call, special_call_name ( special ),
1166
		       param_regs_used ) ;
1167
  } 
1168
  else if ( name ( fn ) == name_tag &&
1169
	      name ( son ( fn ) ) == ident_tag &&
1170
	      ( son ( son ( fn ) ) == nilexp ||
1171
		(name ( son ( son ( fn ) ) ) == proc_tag || 
1172
		 name(son(son(fn))) == general_proc_tag)) ) {
1173
    baseoff b ;
1174
    b = boff ( son ( fn ) ) ;
1175
    if ( !tlrecurse ) {
1176
#ifdef NEWDWARF
1177
      if (current_dg_info) {
1178
	current_dg_info->data.i_call.brk = set_dw_text_label ();
1179
	current_dg_info->data.i_call.p.k = WH_CODELAB;
1180
	current_dg_info->data.i_call.p.u.l = b.base;
1181
	current_dg_info->data.i_call.p.o = b.offset;
1182
      }
1183
#endif
1184
      extj_ins ( i_call, b, param_regs_used ) ;
1185
    } 
1186
    else {
1187
      assert ( !tlrecurse ) ;
1188
    }
1189
  } 
1190
  else {
1191
    int r = reg_operand ( fn, nsp ) ;
1192
#ifdef NEWDWARF
1193
    if (current_dg_info) {
1194
      current_dg_info->data.i_call.brk = set_dw_text_label ();
1195
      current_dg_info->data.i_call.p.k = WH_REG;
1196
      current_dg_info->data.i_call.p.u.l = r;
1197
    }
1198
#endif
1199
    extj_reg_ins ( i_call, r, param_regs_used ) ;
1200
  }
1201
 
1202
  if ( !reg_res && !void_result ) {
1203
    /* Generate unimp instruction, as per structure result call
1204
       convention.  Argument is low-order 12 bits of structure size,
1205
       see section D.4 of * SPARC architecture manual */
1206
    unimp_ins ( ( long ) ( ( ansash.ashsize / 8 ) & 0xfff ) ) ;
1207
  }
1208
 
1209
#ifdef NEWDWARF
1210
  if (dwarf2)
1211
    START_BB ();
1212
#endif
1213
 
1214
  /* grab clobbered %g and %o regs, as safety test for bad code */
1215
  {
1216
    int r ;
1217
    space gsp ;
1218
    gsp = sp ;
1219
 
1220
    /* %g1..%g_reg_max, %o0..%o7 */
1221
    for ( r = R_G1 ; r < R_O7 + 1 ;
1222
		     r = ( ( r == R_G0 + g_reg_max ) ? R_O0 : r + 1 ) ) {
1223
      /* skip R_O0 as often used in result-reg optimisation */
1224
      if ( !( r == R_TMP || r == R_O0 || r == R_SP ||
1225
	      r == guarded_dest_reg ) ) {
1226
	/* not special regs */
1227
	gsp = needreg ( r, gsp ) ;
1228
      }
1229
    }
1230
  }
1231
  clear_all () ;	/* ??? not %i0..%l7 that may be t-regs */
1232
 
1233
  if ( reg_res ) {
1234
    ans aa ;
1235
    if ( is_floating ( hda ) ) {
1236
      freg frg ;
1237
      frg.fr = 0 ;
1238
      frg.dble = ( bool ) ( hda != shrealhd ) ;
1239
      setfregalt ( aa, frg ) ;
1240
      /* move floating point result of application to destination */
1241
      ( void ) move ( aa, dest, sp.fixed, 1 ) ;
1242
    } 
1243
    else {
1244
      setregalt ( aa, R_O0 ) ;
1245
      if ( discrim ( dest.answhere ) == inreg ) {
1246
	int r = regalt ( dest.answhere ) ;
1247
	if ( r == R_G0 ) {
1248
	  /* void result */
1249
	}
1250
	else if ( r != R_O0 ) {
1251
	  /* move result from %o0 */
1252
	  ( void ) move ( aa, dest, sp.fixed, 1 ) ;
1253
	} 
1254
	else {
1255
	  /* no move required */
1256
	}
1257
	mka.regmove = R_O0 ;
1258
      } 
1259
      else {
1260
	( void ) move ( aa, dest, sp.fixed, 1 ) ;
1261
      }
1262
    }
1263
  } 
1264
  else {
1265
    /* not register result */
1266
  }
1267
  return ( mka ) ;
1268
}
1269
 
1270
 
1271
static space do_callers 
1272
    PROTO_N ( ( list, sp, param_reg, trad_call ) )
1273
    PROTO_T ( exp list X space sp X int* param_reg X bool trad_call ){
1274
  int param_offset = (16+1)*32; /* beyond reg window save area & 
1275
				 hidden param of callers frame */
1276
  int last_reg;
1277
#ifdef GENCOMPAT
1278
  if (!trad_call) {
1279
#else
1280
  if(in_general_proc) {
1281
#endif
1282
    if(vc_call) {
1283
      last_reg = R_O3;
1284
    }
1285
    else {
1286
      last_reg = R_O4;
1287
    }
1288
  }
1289
  else {
1290
    last_reg = R_O5;
1291
  }
1292
 
1293
  for(;;){
1294
    ash ap;
1295
    where w;
1296
    shape a = sh(list);
1297
    int hd = (int)name(a);
1298
    exp par = (name(list) == caller_tag)?son(list) : list;
1299
    ap = ashof(a);
1300
    w.ashwhere = ap;
1301
    if(is_floating(hd) && *param_reg <= last_reg){
1302
      /* floating pt.  Copy to stack as if stack param then recover
1303
	 into fixed point reg */
1304
      instore is;
1305
      is.b.base = R_SP;
1306
      is.b.offset = param_offset>>3;
1307
      is.adval = 1;
1308
      setinsalt(w.answhere,is);
1309
      (void)code_here ( par, sp, w ) ;
1310
      if(hd == doublehd){
1311
	rir_ins(i_add,is.b.base,is.b.offset,*param_reg);
1312
      }
1313
      else {
1314
	ld_ro_ins ( i_ld, is.b, *param_reg ) ;
1315
      }
1316
      sp = guardreg ( *param_reg, sp ) ;
1317
      (*param_reg)++ ;     
1318
      param_offset += 32 ;
1319
      if ( hd == realhd ) {
1320
	/* double */
1321
	if ( *param_reg <= last_reg ) {
1322
	  /* double whose second word can go in reg */
1323
	  is.b.offset += 4 ;
1324
	  ld_ro_ins ( i_ld, is.b, *param_reg ) ;
1325
	  sp = guardreg (* param_reg, sp ) ;
1326
	  (*param_reg)++ ;
1327
	}
1328
	param_offset += 32 ;
1329
      }
1330
    } 
1331
    else if ( valregable ( sh ( list ) ) && *param_reg <= last_reg ) {
1332
      /* fixed point parameter in a single reg */
1333
      sp = guardreg ( *param_reg, sp ) ;
1334
      reg_operand_here ( list, sp, *param_reg ) ;
1335
      (*param_reg)++ ;     
1336
      param_offset += 32 ;
1337
    } 
1338
    else {
1339
      /* stack parameter */
1340
      instore is ;
1341
      /* Locations we offer may not be aligned for doubles.
1342
	 We assume 'move' can cope with this  */
1343
      is.b.base = R_SP ;
1344
      is.b.offset = param_offset >> 3 ;
1345
      is.adval = 1 ;
1346
      if ( valregable ( sh ( list ) ) &&
1347
	   ( ap.ashsize == 8 || ap.ashsize == 16 ) ) {
1348
	/* Byte or 16bit scalar parameter - convert to integer.
1349
	   We must pass a full word to conform with SPARC ABI,
1350
	   so have to expand source to full word.  We do this
1351
	   by loading into a reg */
1352
	int r = reg_operand ( list, sp ) ;
1353
	ans op ;
1354
	setregalt ( op, r ) ;
1355
	/* round down to word boundary */
1356
	is.b.offset &= ~0x3 ;
1357
	ap.ashsize = ap.ashalign = 32 ;
1358
	w.ashwhere = ap ;
1359
	setinsalt ( w.answhere, is ) ;
1360
	(void)move ( op, w, guardreg ( r, sp ).fixed, 1 ) ;
1361
      } 
1362
      else{
1363
	setinsalt ( w.answhere, is ) ;
1364
	(void)code_here ( par, sp, w ) ;
1365
      }
1366
      if ( *param_reg <= last_reg ) {
1367
	/* Copy back into the correct param regs */
1368
	int start_offset = is.b.offset;
1369
	int block_size = w.ashwhere.ashsize;
1370
	baseoff curr_pos;
1371
	curr_pos.base = R_SP;
1372
	curr_pos.offset = start_offset;
1373
	if(is64(sh(list)) || (name(sh(list)) == cpdhd) || 
1374
	   (name(sh(list)) == nofhd)){
1375
	  rir_ins(i_add,curr_pos.base,curr_pos.offset,*param_reg);
1376
	  (*param_reg)++;
1377
	  block_size -=32;
1378
        }
1379
	else {
1380
	  while (*param_reg <= last_reg && block_size>0) {
1381
	    ld_ro_ins(i_ld,curr_pos,*param_reg);
1382
	    ++(*param_reg);
1383
	    curr_pos.offset += 4;
1384
	    block_size -= 32;
1385
	  }
1386
	}
1387
      }
1388
      param_offset = ( int ) ( param_offset + ap.ashsize ) ;
1389
    }
1390
    if ( last ( list ) ) return sp;
1391
    list = bro ( list ) ;
1392
  }
1393
 
1394
  return sp;
1395
}
1396
 
1397
/*
1398
  Give the first parameter par_base, find parameter 'num'
1399
*/
1400
exp get_param 
1401
    PROTO_N ( ( par_base, num ) )
1402
    PROTO_T ( exp par_base X int num ) {
1403
  exp res_exp = par_base;
1404
  int current_par;
1405
  if(num == 1) return par_base;
1406
  for(current_par = 2;current_par<=num;++current_par) {
1407
    res_exp = bro(res_exp);
1408
  }
1409
  return res_exp;
1410
}
1411
 
1412
 
1413
 
1414
 
1415
/*
1416
  Move the caller parameters up the stack from their current position
1417
  by %size_reg bytes.  The function assumes that there will always be at 
1418
  least one parameter.
1419
*/
1420
static void move_parameters 
1421
    PROTO_N ( ( callers, size_reg, sp ) )
1422
    PROTO_T ( exp callers X int size_reg X space sp ) {
1423
  int param_offset;   /* offset of first parameter */
1424
  int newbase;
1425
  baseoff b;
1426
  int last_caller = 0;
1427
  int has_callers = 0;
1428
  exp current_caller = son(callers);
1429
  int rtmp = getreg(sp.fixed);
1430
  int rtop = getreg(guardreg(rtmp,sp).fixed);
1431
  int i;
1432
 
1433
  param_offset = 64;
1434
  for(i=0;i<no(callers);++i){
1435
    if (shape_size(sh(current_caller)) > 32)
1436
      param_offset += 8;
1437
    else
1438
      param_offset += 4;
1439
    current_caller = bro(current_caller);
1440
  }
1441
  current_caller = son(callers);
1442
 
1443
 
1444
  /* top is sp + param_offset + callers * num */
1445
  while(!last_caller) {
1446
    last_caller = last(current_caller);
1447
    if(name(current_caller) == caller_tag) {
1448
      has_callers = 1;
1449
    }
1450
    current_caller = bro(current_caller);
1451
  }
1452
  current_caller = son(callers);
1453
  last_caller = 0;
1454
 
1455
  if(!has_callers) return;
1456
  rir_ins(i_add,R_SP,param_offset /*+ (no(callers))*/,rtop);
1457
 
1458
 
1459
  b.offset = param_offset;
1460
  b.offset = 0;
1461
  if (size_reg == R_NO_REG)
1462
    newbase = rtop;
1463
  else {
1464
    newbase = getreg(guardreg(rtop,sp).fixed);
1465
    rrr_ins(i_add,rtop,size_reg,newbase);
1466
  }
1467
  assert(current_caller != (exp)NULL);
1468
 
1469
  for(i=no(callers);i>0;--i) {
1470
    exp par = get_param(son(callers),i);
1471
    if(name( par ) == caller_tag) {
1472
      /* move it up the stack */
1473
      b.base = rtop;
1474
      ld_ro_ins(i_ld,b,rtmp);
1475
      b.base = newbase;
1476
      st_ro_ins(i_st,rtmp,b);
1477
      if(shape_size(sh(par)) > 32) {
1478
	b.base = rtop;
1479
	b.offset = -4;
1480
	ld_ro_ins(i_ld,b,rtmp);
1481
	b.base = newbase;
1482
	st_ro_ins(i_st,rtmp,b);
1483
      }
1484
      b.offset -= 4;
1485
    }
1486
    else
1487
      b.offset -= (shape_size(sh(par)) > 32 ? 8 : 4);
1488
  }
1489
  return;
1490
}
1491
 
1492
 
1493
 
1494
makeans make_apply_general_tag_code 
1495
    PROTO_N ( ( e, sp, dest, exitlab ) )
1496
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
1497
  exp fn = son(e);
1498
  exp callers = bro(fn);
1499
  exp cllees = bro(callers);
1500
  exp postlude = bro(cllees);
1501
  int hda = (int)name(sh(e));
1502
  int param_reg = R_O0;
1503
  int param_regs_used;
1504
  ash ansash;
1505
  space nsp;
1506
  int void_result = (( name ( sh ( e ) ) == tophd ) ||
1507
		     ( name ( sh ( e ) ) == bothd));
1508
 
1509
  int reg_res = reg_result ( sh ( e ) ) ;
1510
  int guarded_dest_reg = R_NO_REG; /* reg used to address tuple result */
1511
  makeans mka ;
1512
  exp dad = father ( e ) ;
1513
  bool tlrecurse = ( bool ) ( proc_state.rscope_level == 0 &&
1514
			      name ( dad ) == res_tag && props ( dad ) ) ;
1515
  bool trad_call = 0;
1516
  ansash = ashof(sh(e));
1517
  nsp = sp;
1518
  mka.lab = exitlab ;
1519
  mka.regmove = NOREG ;
1520
  if((call_has_vcallees(cllees)!= 0)) {
1521
    outs("\t.optim\t\"-O0\"\n"); 
1522
  }
1523
 
1524
  param_regs_used = param_reg - R_O0;
1525
 
1526
#ifdef GENCOMPAT
1527
  if ((call_has_vcallees(cllees)== 0)) {
1528
    if (name(cllees) == make_callee_list_tag) {
1529
      if (no(cllees) == 0)
1530
	trad_call = 1;
1531
    }
1532
    else if (name(cllees) == make_dynamic_callee_tag) {
1533
      if (name(bro(son(cllees))) == val_tag && no(bro(son(cllees))) == 0)
1534
	trad_call = 1;
1535
    }
1536
    else {	/* same callees */
1537
      if (!May_have_callees)
1538
	trad_call = 1;
1539
    }
1540
  }
1541
#endif
1542
  if (!trad_call)
1543
    (void)make_code(cllees,nsp,nowhere,0);
1544
 
1545
  if(!reg_res && !void_result){
1546
    /* structure result */
1547
        instore is ;
1548
    baseoff stack_struct_ret_addr ;
1549
 
1550
    /* [%sp+64] as per call convention */
1551
    stack_struct_ret_addr.base = R_SP ;
1552
    stack_struct_ret_addr.offset = ( 16 * 4 ) ;
1553
 
1554
    assert ( discrim ( dest.answhere ) == notinreg ) ;
1555
    if(discrim(dest.answhere) != notinreg){	/* should be redundant */
1556
      discrim(dest.answhere) = notinreg;
1557
      is.b.base = R_SP;
1558
      is.b.offset = (4*16);
1559
      /* is.b = mem_temp(0);   not compatible with out_pars */
1560
      is.adval = 1;
1561
      dest.answhere.val.instoreans = is;
1562
    }
1563
    else{
1564
      is = insalt ( dest.answhere ) ;
1565
    }
1566
    if ( is.adval ) {
1567
      /* generate address of dest */
1568
      if ( IS_FIXREG ( is.b.base ) ) {
1569
	if ( is.b.offset == 0 ) {
1570
	  st_ro_ins ( i_st, is.b.base, stack_struct_ret_addr ) ;
1571
	} 
1572
	else {
1573
	  rir_ins ( i_add, is.b.base, is.b.offset, R_TMP ) ;
1574
	  st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
1575
	}
1576
	guarded_dest_reg = is.b.base ;	/* can be guarded */
1577
      } 
1578
      else {
1579
	set_ins ( is.b, R_TMP ) ;
1580
	st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
1581
      }
1582
    } 
1583
    else {
1584
      /* load dest */
1585
      ld_ins ( i_ld, is.b, R_TMP ) ;
1586
      st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
1587
    }
1588
  }
1589
 
1590
 
1591
#ifdef GENCOMPAT
1592
  if (!trad_call)
1593
#endif
1594
  {
1595
    /*rr_ins(i_mov,callee_start_reg,R_O5);*/ 
1596
    nsp = guardreg(R_O5,nsp);
1597
    if(call_has_vcallees(cllees)) {
1598
      /*rr_ins(i_mov,callee_end_reg,R_O4);*/
1599
      nsp = guardreg(R_O4,nsp);
1600
    }
1601
  }
1602
 
1603
  if(no(callers) != 0){
1604
    int tmp = in_general_proc;
1605
    in_general_proc = 1;
1606
    vc_call = (call_has_vcallees(cllees)!=0);
1607
    nsp = do_callers(son(callers),nsp,&param_reg, trad_call);
1608
    vc_call = 0;
1609
    in_general_proc = tmp;
1610
  }
1611
  call_base_reg = R_SP;
1612
 
1613
  if ( name ( fn ) == name_tag && name ( son ( fn ) ) == ident_tag &&
1614
       ( son ( son ( fn ) ) == nilexp ||
1615
	 (name ( son ( son ( fn ) ) ) == proc_tag ||
1616
	  name(son(son(fn))) == general_proc_tag)) ) {
1617
    baseoff b;
1618
    b = boff(son(fn));
1619
    if(!tlrecurse){
1620
      /* don't tell the assembler how many parameters are being used, as
1621
	 it optimises away changes to "unused" parameter registers which,
1622
	 in general procs, are needed to pass callees.
1623
	 */
1624
#ifdef NEWDWARF
1625
      if (current_dg_info) {
1626
	current_dg_info->data.i_call.brk = set_dw_text_label ();
1627
	current_dg_info->data.i_call.p.k = WH_CODELAB;
1628
	current_dg_info->data.i_call.p.u.l = b.base;
1629
	current_dg_info->data.i_call.p.o = b.offset;
1630
      }
1631
#endif
1632
      extj_ins(i_call,b,-1 /*param_regs_used*/);
1633
    }
1634
    else{
1635
      assert(!tlrecurse);
1636
    }
1637
  }
1638
  else{
1639
    int r = reg_operand(fn,nsp);
1640
#ifdef NEWDWARF
1641
    if (current_dg_info) {
1642
      current_dg_info->data.i_call.brk = set_dw_text_label ();
1643
      current_dg_info->data.i_call.p.k = WH_REG;
1644
      current_dg_info->data.i_call.p.u.l = r;
1645
    }
1646
#endif
1647
    extj_reg_ins(i_call,r,-1 /*param_regs_used*/);
1648
  }
1649
  if(!reg_res && !void_result){
1650
    /* Generate unimp instruction, as per structure result call
1651
	   convention.  Argument is low-order 12 bits of structure size,
1652
	   see section D.4 of * SPARC architecture manual */
1653
    unimp_ins ( ( long ) ( ( ansash.ashsize / 8 ) & 0xfff ) ) ;
1654
  }
1655
 
1656
#ifdef NEWDWARF
1657
  if (dwarf2)
1658
    START_BB ();
1659
#endif
1660
 
1661
  /* free the space used to generate the callee parameters and, if in
1662
     a postlude, move the caller outpars up the stack to a correct parameter 
1663
     offset from the new stack pointer */
1664
 
1665
  clear_all();
1666
  {
1667
    int size_reg;
1668
    space nsp;
1669
    nsp = guardreg(R_O0,sp);
1670
#ifdef GENCOMPAT
1671
    if (trad_call)
1672
      size_reg = R_NO_REG;
1673
    else
1674
#endif
1675
    {
1676
      if(name(cllees) == make_callee_list_tag) {
1677
	size_reg = getreg(nsp.fixed);
1678
	ir_ins(i_mov,((no(cllees)>>3)+23)&~7,size_reg);
1679
      }
1680
      else if(name(cllees) == make_dynamic_callee_tag) {
1681
	size_reg = reg_operand(bro(son(cllees)),nsp);
1682
	rir_ins(i_add,size_reg,4*(PTR_SZ>>3)+7,size_reg);
1683
	rir_ins(i_and,size_reg,~7,size_reg);
1684
      }
1685
      else {	/* same callees */
1686
	size_reg = getreg(nsp.fixed);
1687
	if(Has_vcallees) {
1688
	  rrr_ins(i_sub,callee_end_reg,callee_start_reg,size_reg);
1689
	}
1690
	else {
1691
	  ir_ins(i_mov,proc_state.callee_size/8,size_reg);
1692
	}
1693
      }
1694
      nsp = guardreg(size_reg,nsp);
1695
    }
1696
    if(no(callers)/* && (in_postlude || postlude_has_call(e))*/) {
1697
      move_parameters(callers,size_reg,nsp); /* move all outpars into 
1698
						    correct positions */
1699
    }
1700
    if(!call_is_untidy(cllees) && size_reg != R_NO_REG) {
1701
      if(!sysV_assembler) {
1702
	/* with -O2 SunOS removes [add %sp,X,%sp] statements. */
1703
	outs("\t.optim\t\"-O0\"\n"); 
1704
      }
1705
      rrr_ins(i_add,R_SP,size_reg,R_SP);
1706
    }
1707
  }
1708
 
1709
 
1710
 
1711
  /* grab clobbered %g and %o regs, as safety test for bad code */
1712
  {
1713
    int r ;
1714
    space gsp ;
1715
    gsp = sp ;
1716
 
1717
    /* %g1..%g_reg_max, %o0..%o7 */
1718
    for ( r = R_G1 ; r < R_O7 + 1 ;
1719
		     r = ( ( r == R_G0 + g_reg_max ) ? R_O0 : r + 1 ) ) {
1720
      /* skip R_O0 as often used in result-reg optimisation */
1721
      if ( !( r == R_TMP || r == R_O0 || r == R_SP ||
1722
	      r == guarded_dest_reg ) ) {
1723
	/* not special regs */
1724
	gsp = needreg ( r, gsp ) ;
1725
      }
1726
    }
1727
  }
1728
  clear_all () ;	/* ??? not %i0..%l7 that may be t-regs */
1729
 
1730
  if ( reg_res ) {
1731
    ans aa ;
1732
    if ( is_floating ( hda ) ) {
1733
      freg frg ;
1734
      frg.fr = 0 ;
1735
      frg.dble = ( bool ) ( hda != shrealhd ) ;
1736
      setfregalt ( aa, frg ) ;
1737
      /* move floating point result of application to destination */
1738
      ( void ) move ( aa, dest, sp.fixed, 1 ) ;
1739
    } else {
1740
      setregalt ( aa, R_O0 ) ;
1741
      if ( discrim ( dest.answhere ) == inreg ) {
1742
	int r = regalt ( dest.answhere ) ;
1743
	if ( r == R_G0 ) {
1744
	  /* void result */
1745
	} 
1746
	else if ( r != R_O0 ) {
1747
	  /* move result from %o0 */
1748
	  ( void ) move ( aa, dest, sp.fixed, 1 ) ;
1749
	} 
1750
	else {
1751
	  /* no move required */
1752
	  assert (name(postlude) == top_tag);
1753
	}
1754
	mka.regmove = R_O0 ;
1755
      } 
1756
      else {
1757
	( void ) move ( aa, dest, sp.fixed, 1 ) ;
1758
      }
1759
    }
1760
  } 
1761
  else {
1762
    /* not register result */
1763
  }
1764
#if 0
1765
  if(Has_vcallees){
1766
    baseoff b;
1767
    b.base = R_FP;
1768
    b.offset = -3 * (PTR_SZ>>3);
1769
    ld_ro_ins(i_ld,b,local_reg);
1770
  }
1771
#endif
1772
 
1773
  if(call_is_untidy(cllees)) {
1774
    /*    rir_ins(i_sub,R_SP,proc_state.maxargs>>3,R_SP);*/
1775
    /*assert(name(bro(cllees)) == top_tag);*/
1776
  }
1777
  else if(postlude_has_call(e)){
1778
    exp x = son(callers);
1779
    postlude_chain p;
1780
 
1781
    if (x != nilexp) {
1782
      for(;;) {
1783
	if(name(x) == caller_tag) {
1784
	  no(x) += proc_state.maxargs;
1785
#if 0
1786
	  if(name(sh(x)) == realhd){
1787
	    no(x) -=32;
1788
	  }
1789
#endif
1790
	}
1791
	if(last(x))break;
1792
	x = bro(x);
1793
      }
1794
    }
1795
    mka.regmove = NOREG;
1796
    update_plc(old_postludes,proc_state.maxargs);
1797
    p.postlude = postlude;
1798
    p.outer = old_postludes;
1799
    old_postludes = &p;
1800
    rir_ins(i_sub,R_SP,proc_state.maxargs>>3,R_SP);
1801
 
1802
    in_postlude = 1;
1803
    (void)make_code(postlude,sp,nowhere,0);
1804
    in_postlude = 0;
1805
    rir_ins(i_add,R_SP,proc_state.maxargs>>3,R_SP);
1806
    old_postludes = p.outer;
1807
    update_plc(old_postludes,-proc_state.maxargs);
1808
  }
1809
  else {
1810
    (void)make_code(postlude,sp,nowhere,0);
1811
  }
1812
 
1813
  return mka;
1814
}
1815
 
1816
 
1817
/*
1818
  Allocate an amount of space on the stack corresponding to the value
1819
  held in register size_reg, and store a pointer to the resulting area
1820
  in register ptr_reg.
1821
*/
1822
static void alloc_reg_space 
1823
    PROTO_N ( ( size_reg, ptr_reg ) )
1824
    PROTO_T ( int size_reg X int ptr_reg ) {
1825
 
1826
  int maxargbytes = (int)proc_state.maxargs/8;
1827
  rir_ins(i_add,size_reg,7,R_TMP);   
1828
  rir_ins(i_and,R_TMP,~7,R_TMP);      /* make the size a multiple of 8 */
1829
  rrr_ins(i_sub,R_SP,R_TMP,R_SP);
1830
  rir_ins(i_add,R_SP,maxargbytes,ptr_reg);
1831
  return;
1832
}
1833
 
1834
 
1835
/* 
1836
   As alloc_reg_space, but with a constant size.
1837
*/
1838
static void alloc_space 
1839
    PROTO_N ( ( size, ptr_reg ) )
1840
    PROTO_T ( int size X int ptr_reg ) {
1841
  int maxargbytes = (int)proc_state.maxargs/8;
1842
  size = (size+7)&~7;
1843
  rir_ins(i_sub,R_SP,size,R_SP);
1844
  rir_ins(i_add,R_SP,maxargbytes,ptr_reg);
1845
  return;
1846
}
1847
 
1848
 
1849
makeans make_make_callee_list_tag 
1850
    PROTO_N ( ( e, sp, dest, exitlab ) )
1851
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
1852
  int size = ((no(e)>>3) + 23)&~7;
1853
  makeans mka;
1854
  bool vc = call_has_vcallees(e);
1855
  exp list = son(e);
1856
  where w;
1857
  instore is;
1858
  baseoff b;
1859
  int disp = 0;
1860
  ash ap;
1861
  space nsp;
1862
  int rdest;
1863
 
1864
  nsp = guardreg(R_O5,sp);
1865
  nsp = guardreg(R_O4,nsp);
1866
  mka.regmove = R_G0;
1867
  mka.lab = 0;
1868
  /* perform an alloca */
1869
  call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
1870
  nsp = guardreg(call_base_reg,nsp);
1871
  rr_ins(i_mov,R_SP,call_base_reg);
1872
  rdest  = getreg(nsp.fixed);
1873
  nsp = guardreg(rdest,nsp);
1874
  alloc_space(size,rdest); /* */
1875
 
1876
  b.base = rdest;
1877
  b.offset = size - (PTR_SZ>>3);
1878
  st_ro_ins(i_st,R_FP,b);
1879
  if(no(e)){
1880
    int lastpar = 0;
1881
    for(;!lastpar;list = bro(list)){
1882
      ap = ashof(sh(list));
1883
      disp = rounder(disp,ap.ashalign);
1884
      is.b.offset = disp>>3;
1885
      is.b.base = rdest;
1886
      is.adval = 1;
1887
      w.ashwhere = ap;
1888
      setinsalt(w.answhere,is);
1889
      code_here(list,guard(w,nsp),w);
1890
      disp = rounder(disp+ap.ashsize,PTR_SZ);
1891
      lastpar = last(list);
1892
    }
1893
  }
1894
  rr_ins(i_mov,rdest,callee_start_reg_out);/* Not before, as the construction 
1895
					      of the callees may require that 
1896
					      we access some of the old 
1897
					      callees */
1898
  if(vc){
1899
    rir_ins(i_add,callee_start_reg_out,size,callee_end_reg_out);
1900
    /*rir_ins(i_add,R_FP,size,R_FP);*/
1901
  }
1902
  return mka;
1903
}
1904
 
1905
 
1906
 
1907
/*
1908
  Construct a copy of the current callees for use in a new procedure
1909
  call.  This writes the callee pointer(s) to the output registers o4 and 
1910
  o5, so a tail call will have to copy back to i4,i5.
1911
*/
1912
makeans make_same_callees_tag 
1913
    PROTO_N ( ( e, sp, dest, exitlab ) )
1914
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
1915
  baseoff b;
1916
  bool vc = call_has_vcallees(e);
1917
  makeans mka;
1918
  space nsp;
1919
  mka.regmove = R_G0;
1920
  if(Has_vcallees) {
1921
    /* copy from [callee_start_reg ... callee_end_reg] into newly allocated
1922
       area, then set callee_start reg to start of area and, if the call
1923
       also has vcallees, set callee_end_reg to the end of the area.
1924
       */
1925
    int rsize; /* register to contain the size of the 
1926
				     callee parameters area */
1927
    int rsrc,rdest;               /* registers containing pointers to where 
1928
				     to copy from and to */
1929
    int rtmp;                     /* temporary register used in copying */
1930
 
1931
    int end_copy_lab = new_label();   /* marks end of copy loop */
1932
    int start_copy_lab = new_label(); /* marks start of copy loop */
1933
    nsp = guardreg(R_O4,sp);
1934
    nsp = guardreg(R_O5,nsp);
1935
    call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
1936
    nsp = guardreg(call_base_reg,sp);
1937
    rsize = getreg(nsp.fixed);
1938
    nsp = guardreg(rsize,sp);
1939
    rsrc = getreg(nsp.fixed);
1940
    nsp = guardreg(rsrc,nsp);
1941
    rdest = getreg(nsp.fixed);
1942
    nsp = guardreg(rdest,nsp);
1943
    rrr_ins(i_sub,callee_end_reg,callee_start_reg,rsize);
1944
    rr_ins(i_mov,R_SP,call_base_reg);
1945
    alloc_reg_space(rsize,rdest); /* */
1946
    rrr_ins(i_add,rdest,rsize,rdest);
1947
 
1948
    /* now do top-down copy of parameters */
1949
    rir_ins(i_sub,callee_end_reg, 4*(PTR_SZ>>3), rsrc);
1950
    rir_ins(i_sub,rdest, 4*(PTR_SZ>>3), rdest);
1951
    /*condrr_ins(i_be,rdest,rsrc,end_copy_lab);*/
1952
    set_label(start_copy_lab);
1953
    b.base = rsrc;
1954
    b.offset = -(PTR_SZ>>3);
1955
    rtmp = getreg(nsp.fixed);
1956
    ld_ro_ins(i_ld,b,rtmp);
1957
    b.base = rdest;
1958
    st_ro_ins(i_st,rtmp,b);
1959
    rir_ins(i_sub,rsrc,PTR_SZ>>3,rsrc);
1960
    rir_ins(i_sub,rdest,PTR_SZ>>3,rdest);
1961
    condrr_ins(i_bne,rsrc,callee_start_reg,start_copy_lab);
1962
    set_label(end_copy_lab);
1963
    /* callee_start_reg will now be rdest */
1964
    rr_ins(i_mov,rdest,callee_start_reg_out);
1965
 
1966
    if(vc) {
1967
      rrr_ins(i_add,callee_start_reg_out,rsize,callee_end_reg_out);
1968
    }
1969
  }
1970
  else {
1971
    int size_of_callees = proc_state.callee_size/8;
1972
    int rdest;
1973
    int el;
1974
    int rsrc;
1975
    space nsp;
1976
    int tmpreg ;
1977
    nsp = guardreg(R_O4,sp);
1978
    nsp = guardreg(R_O5,nsp);
1979
    call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
1980
    nsp = guardreg(call_base_reg,sp);
1981
    rdest = getreg(nsp.fixed);
1982
    nsp = guardreg(rdest,sp);
1983
    tmpreg = getreg(nsp.fixed);
1984
    nsp = guardreg(tmpreg,nsp);
1985
    rr_ins(i_mov,R_SP,call_base_reg);
1986
    alloc_space(size_of_callees,rdest); /* */
1987
    b.base = rdest;
1988
    b.offset = size_of_callees - (PTR_SZ>>3);
1989
    st_ro_ins(i_st,R_FP,b);
1990
    rsrc = getreg(nsp.fixed);
1991
    rir_ins(i_add,callee_start_reg,size_of_callees,rsrc);
1992
    /*rir_ins(i_add,rdest,size_of_callees,rdest);*/
1993
    for(el=(size_of_callees-4*(PTR_SZ>>3));el>0;el-=(PTR_SZ>>3)){
1994
      b.base = rsrc;
1995
      b.offset = el - size_of_callees - (PTR_SZ>>3);
1996
      ld_ro_ins(i_ld,b,tmpreg);
1997
      b.base = rdest;
1998
      b.offset = el - (PTR_SZ>>3);
1999
      st_ro_ins(i_st,tmpreg,b);
2000
    }
2001
    /* callee_start_reg will no be rdest */
2002
    if(vc) {
2003
      rir_ins(i_add,rdest,size_of_callees,callee_end_reg_out);
2004
      /*rr_ins(i_mov,rdest,callee_end_reg_out);*/
2005
    }
2006
    rr_ins(i_mov,rdest,callee_start_reg_out);
2007
    /*rir_ins(i_sub,rdest,size_of_callees,callee_start_reg_out);*/
2008
  }
2009
  return mka;
2010
}
2011
 
2012
 
2013
/* 
2014
   Produce code to dynamically construct a new set of callee params.  The
2015
   parameters are placed in a specially allocated piece of the current stack, 
2016
   and pointed to by callee_start_reg and callee_end_reg.
2017
*/
2018
makeans make_make_dynamic_callee_tag 
2019
    PROTO_N ( ( e, sp, dest, exitlab ) )
2020
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
2021
  /* bool vc = call_has_vcallees(e); */
2022
  int rptr,rsize,rdest,r_true_size;
2023
  int copy_start_lab = new_label();
2024
  int copy_end_lab = new_label();
2025
  space nsp;
2026
  baseoff b;
2027
  makeans mka;
2028
  mka.regmove = R_G0;
2029
  mka.lab = exitlab;
2030
  nsp = guardreg(R_O5,sp);
2031
  nsp = guardreg(R_O4,nsp);
2032
  call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
2033
  nsp = guardreg(call_base_reg,nsp);
2034
  rptr = getreg(nsp.fixed);
2035
  nsp = guardreg(rptr,nsp);
2036
  load_reg(son(e),rptr,nsp);    /* rptr now contains a pointer to the start of
2037
			       the callees */
2038
  rsize = getreg(nsp.fixed);
2039
  nsp = guardreg(rsize,nsp);
2040
  load_reg(bro(son(e)),rsize,nsp); /* rsize now contains the size of the 
2041
				      callees */
2042
  rdest = getreg(nsp.fixed);
2043
  nsp = guardreg(rdest,nsp);
2044
  r_true_size = getreg(nsp.fixed);
2045
  nsp = guardreg(r_true_size,nsp);
2046
  /*rdest = callee_start_reg_out;*/ /*getreg(nsp.fixed);*/
2047
  rir_ins(i_add,rsize,4*(PTR_SZ>>3)+7,r_true_size);
2048
  rir_ins(i_and,r_true_size,~7,r_true_size);
2049
  rr_ins(i_mov,R_SP,call_base_reg);
2050
 
2051
  alloc_reg_space(r_true_size,rdest); /* */
2052
  rrr_ins(i_add,rdest,r_true_size /*rsize*/,R_TMP);
2053
  /*rrr_ins(i_sub,rdest,r_true_size,rdest);*/
2054
  b.base = R_TMP;
2055
  b.offset = -(PTR_SZ>>3);
2056
  st_ro_ins(i_st,R_FP,b);
2057
  rr_ins(i_mov,rdest,callee_start_reg_out);
2058
  /*if(vc)*/ rr_ins(i_mov,R_TMP,callee_end_reg_out);
2059
 
2060
  /* Now copy from rptr to rdest */
2061
  condrr_ins(i_ble,rsize,R_G0,copy_end_lab);  /* make shure size > 0 */
2062
  b.offset = 0;
2063
  set_label(copy_start_lab);
2064
  b.base = rptr;
2065
  ld_ro_ins(i_ld,b,R_TMP);
2066
  b.base = rdest;
2067
  st_ro_ins(i_st,R_TMP,b);
2068
  rir_ins(i_add,rptr,PTR_SZ>>3,rptr);
2069
  rir_ins(i_add,rdest,PTR_SZ>>3,rdest);
2070
  rir_ins(i_sub,rsize,PTR_SZ>>3,rsize);
2071
  condrr_ins(i_bgt,rsize,R_G0,copy_start_lab);
2072
  set_label(copy_end_lab);
2073
  return mka;
2074
}
2075
 
2076
 
2077
 
2078
 
2079
/*
2080
  This generates code for a tail_call tag.  The target of the call MUST be 
2081
  a general proc.
2082
*/
2083
makeans make_tail_call_tag 
2084
    PROTO_N ( ( e, sp, dest, exitlab ) )
2085
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
2086
  exp fn = son(e);
2087
  exp cllees = bro(fn);
2088
  exp bdy = son(current_proc);
2089
  space nsp;
2090
  bool vc = call_has_vcallees(cllees);
2091
  int callee_size = proc_state.callee_size;
2092
  makeans mka;
2093
  baseoff bproc;
2094
  bool glob = ((name(fn) == name_tag) && (name(son(fn)) == ident_tag) &&
2095
	       ((son(son(fn)) == nilexp) || (name(son(son(fn))) == proc_tag)
2096
		|| (name(son(son(fn))) == general_proc_tag)));
2097
  bool trad_proc = 0;
2098
#ifdef GENCOMPAT
2099
  if (!vc) {
2100
    if (name(cllees) == make_callee_list_tag) {
2101
      if (no(cllees) == 0)
2102
	trad_proc = 1;
2103
    }
2104
    else if (name(cllees) == make_dynamic_callee_tag) {
2105
      if (name(bro(son(cllees))) == val_tag && no(bro(son(cllees))) == 0)
2106
	trad_proc = 1;
2107
    }
2108
    else {	/* same callees */
2109
      if (!May_have_callees)
2110
	trad_proc = 1;
2111
    }
2112
  }
2113
#endif
2114
 
2115
  mka.lab = exitlab;
2116
  mka.regmove = R_G0;
2117
  nsp = sp;
2118
  nsp.fixed |= PARAM_TREGS;
2119
  if(name(cllees) != same_callees_tag){
2120
    code_here(cllees,sp,nowhere);
2121
  }
2122
#ifndef NEWDIAGS
2123
  for(;name(bdy) == diagnose_tag;bdy=son(bdy));
2124
#endif
2125
 
2126
  while(name(bdy) == ident_tag && isparam(bdy)){
2127
    exp sbdy = son(bdy);
2128
    baseoff b;
2129
    b.base = R_FP;
2130
    b.offset = (no(sbdy)>>3) + (proc_state.params_offset>>3);
2131
 
2132
    if (name(sbdy) == formal_callee_tag) {
2133
      if((props(bdy) & inanyreg)!=0) {
2134
	b.offset -= (proc_state.callee_size>>3);
2135
	if(isvar(bdy)) {
2136
	  if(is_floating(name(sh(bdy)))) {
2137
	    stf_ins(i_st,no(bdy)<<1,b); 	/* add case for long double */
2138
	  }
2139
	  else {
2140
	    st_ro_ins(i_st,no(bdy),b);
2141
	  }
2142
	}
2143
      }
2144
    }
2145
    else if(props(sbdy)== 0 && ((props(bdy) & inanyreg)!=0)){
2146
      /* move from reg to store */
2147
      if(isvar(bdy)){
2148
	if(is_floating(name(sh(sbdy)))){
2149
	  stf_ins(i_stf,no(bdy)<<1,b);
2150
	}
2151
	else{
2152
	  assert( IS_IN_REG(props(sbdy)));
2153
/*	  props(sbdy) = (props(sbdy)-R_I0)+R_O0;*/
2154
	  st_ro_ins(i_st,no(bdy),b);
2155
	}
2156
      }
2157
    }
2158
    else if(props(sbdy)!=0 && ((props(bdy)&inanyreg) == 0)){
2159
      /* move from store to reg */
2160
      int par_reg = props(sbdy);
2161
      int last_reg = (shape_size(sh(sbdy)) > 32 ? par_reg+1 : par_reg);
2162
      int past_reg = ((trad_proc) ? R_I5+1 : (vc)?R_I4:R_I5);
2163
					  /* registers i4 & i5 are reserved
2164
					       in general procs for handling
2165
					       of callee parameters */
2166
      assert( IS_IN_REG(par_reg));
2167
/*    props(sbdy) = (props(sbdy)-R_I0)+R_O0;*/
2168
      if ((last_param(bdy) && isvis(bdy) && !Has_no_vcallers)
2169
		|| last_reg >= past_reg)
2170
	last_reg = past_reg - 1;
2171
      while(par_reg <= last_reg) {
2172
	ld_ro_ins(i_ld,b,par_reg);
2173
	++par_reg;
2174
	b.offset += 4;
2175
      }
2176
    }
2177
    else if(props(sbdy) != 0 && (props(sbdy) != no(bdy))){
2178
      if(is_floating(name(sh(sbdy)))){
2179
	freg fr;
2180
	fr.fr = no(bdy);
2181
	fr.dble = (name(sh(sbdy)) == realhd);
2182
	stf_ins ( i_st, fr.fr<<1, mem_temp ( 0 ) ) ;
2183
	ld_ro_ins ( i_ld, mem_temp ( 0 ), props(sbdy) ) ;
2184
	if ( fr.dble ) {
2185
	  stf_ins ( i_st, ( fr.fr << 1 ) + 1,
2186
		    mem_temp ( 4 ) ) ;
2187
	  ld_ro_ins ( i_ld, mem_temp ( 4 ), props(sbdy)+ 1 ) ;
2188
	}
2189
      }
2190
      else{
2191
	assert( IS_IN_REG(props(sbdy)));
2192
/*	props(sbdy) = (props(sbdy)-R_I0)+R_O0;*/
2193
	rr_ins(i_mov,no(bdy),props(sbdy));
2194
      }
2195
    }
2196
    bdy = bro(sbdy);
2197
  }
2198
 
2199
  bproc = boff(son(fn));
2200
  assert(bproc.offset == 0);
2201
#ifdef GENCOMPAT
2202
  if (trad_proc) {
2203
    int r = getreg(nsp.fixed);
2204
    if (glob) {
2205
      set_ins(bproc,r);
2206
    }
2207
    else{
2208
      load_reg(fn,r,nsp);
2209
    }
2210
    if(!sysV_assembler) {
2211
	/* with -O2 SunOS corrupts unusual jmp/restore combination. */
2212
      outs("\t.optim\t\"-O0\"\n"); 
2213
    }
2214
#ifdef NEWDWARF
2215
    if (current_dg_info) {
2216
	current_dg_info->data.i_lj.brk = set_dw_text_label ();
2217
	current_dg_info->data.i_lj.j.k = WH_REG;
2218
	current_dg_info->data.i_lj.j.u.l = r;
2219
    }
2220
#endif
2221
    extj_reg_ins_no_delay(i_jmp,r,-1);
2222
    fprintf ( as_file, "\t%s\n", i_restore ) ;	/* delay slot */
2223
#ifdef NEWDWARF
2224
    if (dwarf2)
2225
      count_ins(1);
2226
#endif
2227
  }
2228
  else
2229
#endif
2230
  {
2231
    bproc.offset = 12;
2232
    if(name(cllees)!= same_callees_tag) {
2233
      rr_ins(i_mov,callee_start_reg_out,callee_start_reg);
2234
      if(vc) rr_ins(i_mov,callee_end_reg_out,callee_end_reg);
2235
    }
2236
    if(name(cllees) == same_callees_tag && (vc && !Has_vcallees)) {
2237
      rir_ins(i_add,callee_start_reg,callee_size>>3,callee_end_reg);
2238
    }
2239
 
2240
    {
2241
      int r = getreg(nsp.fixed);
2242
      if(glob){
2243
	set_ins(bproc,r);
2244
#ifdef NEWDWARF
2245
	if (current_dg_info) {
2246
	  current_dg_info->data.i_lj.brk = set_dw_text_label ();
2247
	  current_dg_info->data.i_lj.j.k = WH_REG;
2248
	  current_dg_info->data.i_lj.j.u.l = r;
2249
	}
2250
#endif
2251
	extj_reg_ins(i_jmp,r,-1);
2252
      }
2253
      else{
2254
	load_reg(fn,r,nsp);
2255
	rir_ins(i_add,r,12,r);
2256
#ifdef NEWDWARF
2257
	if (current_dg_info) {
2258
	  current_dg_info->data.i_lj.brk = set_dw_text_label ();
2259
	  current_dg_info->data.i_lj.j.k = WH_REG;
2260
	  current_dg_info->data.i_lj.j.u.l = r;
2261
	}
2262
#endif
2263
	extj_reg_ins(i_jmp,r,-1);
2264
      }
2265
    }
2266
  }
2267
  clear_all();
2268
  return mka;
2269
}	
2270
 
2271
 
2272
 
2273