Warning: Undefined variable $n in /usr/local/www/websvn.planix.org/include/diff_util.php on line 243

Warning: Undefined variable $n in /usr/local/www/websvn.planix.org/include/diff_util.php on line 247

Warning: Undefined variable $m in /usr/local/www/websvn.planix.org/include/diff_util.php on line 251

Warning: Undefined variable $n in /usr/local/www/websvn.planix.org/include/diff_util.php on line 243

Warning: Undefined variable $n in /usr/local/www/websvn.planix.org/include/diff_util.php on line 247

Warning: Undefined variable $m in /usr/local/www/websvn.planix.org/include/diff_util.php on line 251
WebSVN – tendra.SVN – Diff – /branches/tendra5/src/installers/680x0/common/ops_misc.c – Rev 5 and 6

Subversion Repositories tendra.SVN

Rev

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

Rev 5 Rev 6
Line -... Line 1...
-
 
1
/*
-
 
2
 * Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.
-
 
3
 * All rights reserved.
-
 
4
 *
-
 
5
 * Redistribution and use in source and binary forms, with or without
-
 
6
 * modification, are permitted provided that the following conditions are met:
-
 
7
 *
-
 
8
 * 1. Redistributions of source code must retain the above copyright notice,
-
 
9
 *    this list of conditions and the following disclaimer.
-
 
10
 * 2. Redistributions in binary form must reproduce the above copyright notice,
-
 
11
 *    this list of conditions and the following disclaimer in the documentation
-
 
12
 *    and/or other materials provided with the distribution.
-
 
13
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
-
 
14
 *    may be used to endorse or promote products derived from this software
-
 
15
 *    without specific, prior written permission.
-
 
16
 *
-
 
17
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
-
 
18
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-
 
19
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-
 
20
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
-
 
21
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-
 
22
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-
 
23
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-
 
24
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-
 
25
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-
 
26
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-
 
27
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 
28
 *
-
 
29
 * $Id$
-
 
30
 */
1
 
31
 
2
/*
32
/*
3
    		 Crown Copyright (c) 1997
33
    		 Crown Copyright (c) 1997
4
 
34
 
5
    This TenDRA(r) Computer Program is subject to Copyright
35
    This TenDRA(r) Computer Program is subject to Copyright
Line 79... Line 109...
79
 *
109
 *
80
 * Revision 1.2  1996/07/05  14:24:52  john
110
 * Revision 1.2  1996/07/05  14:24:52  john
81
 * Changes for spec 3.1
111
 * Changes for spec 3.1
82
 *
112
 *
83
 * Revision 1.1.1.1  1996/03/26  15:45:16  john
113
 * Revision 1.1.1.1  1996/03/26  15:45:16  john
84
 *
114
 *
85
 * Revision 1.4  94/06/29  14:24:51  14:24:51  ra (Robert Andrews)
115
 * Revision 1.4  94/06/29  14:24:51  14:24:51  ra (Robert Andrews)
86
 * Need to be more careful about bitfields in change_variety.
116
 * Need to be more careful about bitfields in change_variety.
87
 *
117
 *
88
 * Revision 1.3  94/02/21  16:02:15  16:02:15  ra (Robert Andrews)
118
 * Revision 1.3  94/02/21  16:02:15  16:02:15  ra (Robert Andrews)
89
 * Clear up a couple of int-long confusions.
119
 * Clear up a couple of int-long confusions.
Line 131... Line 161...
131
  the global variable overflow_jump is set the the corresponding label.
161
  the global variable overflow_jump is set the the corresponding label.
132
  If e has the error treatment trap overflow_jump is set to -1 instead.
162
  If e has the error treatment trap overflow_jump is set to -1 instead.
133
  The previous value of overflow_jump is returned, so it can be restored.
163
  The previous value of overflow_jump is returned, so it can be restored.
134
 ************************************************************************/
164
 ************************************************************************/
135
 
165
 
136
int set_overflow
166
int
137
    PROTO_N ( ( e ) )
-
 
138
    PROTO_T ( exp e )
167
set_overflow(exp e)
139
{
168
{
140
   int prev_overflow_jump = overflow_jump ;
169
	int prev_overflow_jump = overflow_jump;
141
 
170
 
142
   if (! optop ( e ) ) {
171
	if (! optop(e)) {
143
      if ( pt ( e ) ) {
172
		if (pt(e)) {
-
 
173
			/* error jump on overflow */
144
         overflow_jump = no(son ( pt ( e ) ) ) ; /* error jump on overflow */
174
			overflow_jump = no(son(pt(e)));
145
         overflow_jump = ptno(pt(son(pt(e)))) ;
175
			overflow_jump = ptno(pt(son(pt(e))));
146
         overflow_jump = e->ptf.expr->sonf.expr->ptf.expr->ptf.l;
176
			overflow_jump = e->ptf.expr->sonf.expr->ptf.expr->ptf.l;
147
 
177
 
148
      }
-
 
149
      else {
178
		} else {
150
         overflow_jump = -1 ; /* trap on overflow */
179
			overflow_jump = -1 ; /* trap on overflow */
151
      }
180
		}
152
   }
181
	}
153
 
182
 
154
   return prev_overflow_jump ;
183
	return prev_overflow_jump;
155
}
184
}
156
 
185
 
157
/************************************************************************
186
/************************************************************************
158
  CLEAR_OVERFLOW
187
  CLEAR_OVERFLOW
159
  Restore the global variable overflow_jump with a previous value.
188
  Restore the global variable overflow_jump with a previous value.
160
 ************************************************************************/
189
 ************************************************************************/
161
 
190
 
162
void clear_overflow
191
void
163
    PROTO_N ( ( prev_overflow_jump ) )
-
 
164
    PROTO_T ( int prev_overflow_jump )
192
clear_overflow(int prev_overflow_jump)
165
{
193
{
166
   overflow_jump = prev_overflow_jump ;
194
	overflow_jump = prev_overflow_jump;
167
}
195
}
168
 
196
 
169
/************************************************************************
197
/************************************************************************
170
  HAVE_OVERFLOW
198
  HAVE_OVERFLOW
171
  Used to test if overflow_jump has been set (we have an error treatment)
199
  Used to test if overflow_jump has been set (we have an error treatment)
172
 ************************************************************************/
200
 ************************************************************************/
173
 
201
 
174
int have_overflow
202
int
175
    PROTO_Z ()
203
have_overflow(void)
176
{
204
{
177
   return overflow_jump ;
205
	return overflow_jump;
178
}
206
}
179
 
207
 
180
/************************************************************************
208
/************************************************************************
181
  TRAP_INS
209
  TRAP_INS
182
  Calls the error handler with ec as argument
210
  Calls the error handler with ec as argument
183
 ************************************************************************/
211
 ************************************************************************/
184
 
212
 
185
void trap_ins
213
void
186
    PROTO_N ( ( ec ) )
-
 
187
    PROTO_T ( int ec )
214
trap_ins(int ec)
188
{
215
{
189
   push ( slongsh, L32, mnw( ec ) ) ;
216
	push(slongsh, L32, mnw(ec));
190
   callins( 0, get_error_handler() ) ;
217
	callins(0, get_error_handler());
191
}
218
}
192
 
219
 
193
/*
220
/*
194
    OVERFLOW JUMP LABEL
221
    OVERFLOW JUMP LABEL
195
 
222
 
196
    This is 0 to denote that overflows should be ignored.  Otherwise
223
    This is 0 to denote that overflows should be ignored.  Otherwise
197
    it gives the label to be jumped to.
224
    it gives the label to be jumped to.
198
*/
225
*/
199
 
226
 
200
int overflow_jump = 0 ;
227
int overflow_jump = 0;
201
 
228
 
202
int err_continue = 0;
229
int err_continue = 0;
203
 
230
 
204
/************************************************************************
231
/************************************************************************
205
  TEST_OVERFLOW2
232
  TEST_OVERFLOW2
Line 208... Line 235...
208
  overflowed then either a trap or a jump is takken.
235
  overflowed then either a trap or a jump is takken.
209
 
236
 
210
  The test condition is specified by br_ins
237
  The test condition is specified by br_ins
211
  ************************************************************************/
238
  ************************************************************************/
212
 
239
 
213
void test_overflow2
240
void
214
    PROTO_N ( ( br_ins ) )
-
 
215
    PROTO_T ( int br_ins )
241
test_overflow2(int br_ins)
216
{
242
{
217
   if ( overflow_jump == -1 ) {
243
	if (overflow_jump == -1) {
218
      ins0( bra2trap( br_ins ) ) ;
244
		ins0(bra2trap(br_ins));
219
   }
-
 
220
   else if ( overflow_jump ) {
245
	} else if (overflow_jump) {
221
      make_jump(br_ins, overflow_jump);
246
		make_jump(br_ins, overflow_jump);
222
   }
247
	}
223
}
248
}
224
 
249
 
225
 
250
 
226
/************************************************************************
251
/************************************************************************
227
  TEST_OVERFLOW
252
  TEST_OVERFLOW
228
 
253
 
229
  If an error_treatment is specified and the previous instruction
254
  If an error_treatment is specified and the previous instruction
230
  overflowed then either a trap or a jump is takken.
255
  overflowed then either a trap or a jump is takken.
231
 
256
 
232
  This function finds the right test condition based on overflow_type
257
  This function finds the right test condition based on overflow_type
233
  ************************************************************************/
258
  ************************************************************************/
234
 
259
 
235
void test_overflow
260
void
236
    PROTO_N ( ( typ ) )
-
 
237
    PROTO_T ( overflow_type typ )
261
test_overflow(overflow_type typ)
238
{
262
{
239
   int instr ;
263
	int instr;
240
 
264
 
241
   if (! have_overflow() ) return ;
265
	if (! have_overflow()) {
-
 
266
		return;
-
 
267
	}
242
 
268
 
243
   switch ( typ ) {
269
	switch (typ) {
244
   case UNCONDITIONAL:  instr = m_bra ; break ;
270
	case UNCONDITIONAL:
-
 
271
		instr = m_bra;
-
 
272
		break;
245
   case ON_OVERFLOW:    instr = m_bvs ; break ;
273
	case ON_OVERFLOW:
-
 
274
		instr = m_bvs;
-
 
275
		break;
-
 
276
	case ON_CARRY:
246
   case ON_CARRY:       instr = m_bcs ; break ;
277
		instr = m_bcs;
-
 
278
		break;
247
   case ON_FP_OVERFLOW:
279
	case ON_FP_OVERFLOW:
248
   case ON_FP_CARRY:
280
	case ON_FP_CARRY:
249
      ins2 ( m_fmovel, L32, L32, register ( REG_FPSR ), D0, 1 ) ;
281
		ins2(m_fmovel, L32, L32, register(REG_FPSR), D0, 1);
250
      ins2h ( m_andl, 0x00001c00, L32, D0, 1 ) ;
282
		ins2h(m_andl, 0x00001c00, L32, D0, 1);
251
      instr = m_bne ;
283
		instr = m_bne;
252
      break ;
284
		break;
253
   case ON_FP_OPERAND_ERROR:
285
	case ON_FP_OPERAND_ERROR:
254
      ins2 ( m_fmovel, L32, L32, register ( REG_FPSR ), D0, 1 ) ;
286
		ins2(m_fmovel, L32, L32, register(REG_FPSR), D0, 1);
255
      ins2h ( m_andl, 0x00002000, L32, D0, 1 ) ;
287
		ins2h(m_andl, 0x00002000, L32, D0, 1);
256
      instr = m_bne ;
288
		instr = m_bne;
257
      break;
289
		break;
258
   default:
290
	default:
259
      error("invalid overflow test");
291
		error("invalid overflow test");
260
      return ;
292
		return;
261
   }
293
	}
262
 
294
 
263
   test_overflow2(instr);
295
	test_overflow2(instr);
264
}
296
}
265
 
297
 
266
/************************************************************************
298
/************************************************************************
267
  CHECKALLOC_STACK
299
  CHECKALLOC_STACK
268
 
300
 
269
  Checks if it is possible to allocate sz bytes on the stack.
301
  Checks if it is possible to allocate sz bytes on the stack.
270
  If it is not possible an exception is generated.
302
  If it is not possible an exception is generated.
271
  else if do_alloc is TRUE, the allocation is done.
303
  else if do_alloc is TRUE, the allocation is done.
272
 
304
 
273
  ************************************************************************/
305
  ************************************************************************/
274
 
306
 
275
void checkalloc_stack
307
void
276
    PROTO_N ( ( sz, do_alloc ) )
-
 
277
    PROTO_T ( where sz X int do_alloc )
308
checkalloc_stack(where sz, int do_alloc)
278
{
309
{
279
   int erlab = next_lab ();
310
	int erlab = next_lab();
280
   int cnlab = next_lab ();
311
	int cnlab = next_lab();
281
   make_comment("check for stack overflow ...") ;
312
	make_comment("check for stack overflow ...");
282
   ins2 (m_movl, 32, 32, SP, D0, 1);
313
	ins2(m_movl, 32, 32, SP, D0, 1);
283
   ins2 (m_subl, 32, 32, sz, D0, 1);
314
	ins2(m_subl, 32, 32, sz, D0, 1);
284
   make_jump (m_bcs, erlab);
315
	make_jump(m_bcs, erlab);
285
   ins2 (m_cmpl, 32, 32, mw(get_stack_limit(), 0), D0, 0);
316
	ins2(m_cmpl, 32, 32, mw(get_stack_limit(), 0), D0, 0);
286
   make_jump (m_bcc, cnlab);
317
	make_jump(m_bcc, cnlab);
287
   make_label (erlab);
318
	make_label(erlab);
288
   trap_ins(f_stack_overflow);
319
	trap_ins(f_stack_overflow);
289
   make_label (cnlab);
320
	make_label(cnlab);
290
   if ( do_alloc )
321
	if (do_alloc) {
291
   ins2 (m_movl, 32, 32, D0, SP, 1);
322
		ins2(m_movl, 32, 32, D0, SP, 1);
-
 
323
	}
292
   make_comment("check for stack overflow done") ;
324
	make_comment("check for stack overflow done");
293
}
325
}
294
 
326
 
295
/*
327
/*
296
    MARK D1 AS SPECIAL
328
    MARK D1 AS SPECIAL
297
 
329
 
298
    This flag is used to indicate that the D1 regsiter is being used
330
    This flag is used to indicate that the D1 regsiter is being used
299
    as a special register and should be treated with care.
331
    as a special register and should be treated with care.
300
*/
332
*/
301
 
333
 
302
bool D1_is_special = 0 ;
334
bool D1_is_special = 0;
303
 
335
 
304
 
336
 
305
/*
337
/*
306
    OUTPUT A CALL INSTRUCTION
338
    OUTPUT A CALL INSTRUCTION
307
 
339
 
308
    The procedure call given by fn is output.  A temporary A-register
340
    The procedure call given by fn is output.  A temporary A-register
309
    needs to be used when fn is not a simple procedure name.  The
341
    needs to be used when fn is not a simple procedure name.  The
310
    stack is then increased by longs to overwrite the procedure arguments.
342
    stack is then increased by longs to overwrite the procedure arguments.
311
*/
343
*/
312
 
344
 
313
void callins
345
void
314
    PROTO_N ( ( longs, fn ) )
-
 
315
    PROTO_T ( long longs X exp fn )
346
callins(long longs, exp fn)
316
{
347
{
317
    mach_op *op ;
348
	mach_op *op;
318
    exp s = son ( fn ), call_exp, fn_exp ;
349
	exp s = son(fn), call_exp, fn_exp;
319
    bool simple_proc = 0 ;
350
	bool simple_proc = 0;
320
    fn_exp = fn ;
351
	fn_exp = fn;
321
 
352
 
322
    /* Let's see if we have the procedure at compilation time */
353
	/* Let's see if we have the procedure at compilation time */
323
    if ( name ( fn ) == name_tag && ! isvar ( s ) && isglob ( s ) ) {
354
	if (name(fn) == name_tag && ! isvar(s) && isglob(s)) {
324
       exp def = son ( s ) ; /* Definition of Identify construct */
355
		exp def = son ( s ) ; /* Definition of Identify construct */
325
       if ( !def || name ( def ) == proc_tag || name ( def ) == general_proc_tag )
356
		if (!def || name(def) == proc_tag ||
-
 
357
		    name(def) == general_proc_tag) {
326
       simple_proc = 1;
358
			simple_proc = 1;
327
    }
359
		}
-
 
360
	}
328
 
361
 
329
    /* If this is not a straight call, put the name into an A register */
362
	/* If this is not a straight call, put the name into an A register */
330
    if ( ! simple_proc ) {
363
	if (! simple_proc) {
331
	where w ;
364
		where w;
332
	w = zw ( fn ) ;
365
		w = zw(fn);
333
	if ( whereis ( w ) != Areg ) {
366
		if (whereis(w)!= Areg) {
334
	    int r = next_tmp_reg () ;
367
			int r = next_tmp_reg();
335
	    regsinproc |= regmsk ( r ) ;
368
			regsinproc |= regmsk(r);
336
	    move ( slongsh, w, register ( r ) ) ;
369
			move(slongsh, w, register(r));
337
	    fn_exp = register ( r ).wh_exp ;
370
			fn_exp = register(r).wh_exp;
-
 
371
		}
338
	}
372
	}
339
    }
-
 
340
    /* Now output the call instruction */
373
	/* Now output the call instruction */
341
    call_exp = getexp ( proksh, nilexp, 0, fn_exp, nilexp, 0, L0, cont_tag ) ;
374
	call_exp = getexp(proksh, nilexp, 0, fn_exp, nilexp, 0, L0, cont_tag);
342
    op = operand ( L32, zw ( call_exp ) ) ;
375
	op = operand(L32, zw(call_exp));
343
    make_instr ( m_call, op, null, ~save_msk ) ;
376
	make_instr(m_call, op, null, ~save_msk);
344
    no_calls++ ;
377
	no_calls++;
345
    retcell ( call_exp ) ;
378
	retcell(call_exp);
346
    dec_stack ( -longs ) ;
379
	dec_stack(-longs);
347
    have_cond = 0 ;
380
	have_cond = 0;
348
    return ;
381
	return;
349
}
382
}
350
 
383
 
351
/************************************************************************
384
/************************************************************************
352
    OUTPUT A JMP INSTRUCTION
385
    OUTPUT A JMP INSTRUCTION
353
 
386
 
354
    The jump to the procedure given by fn is output.  A temporary A-register
387
    The jump to the procedure given by fn is output.  A temporary A-register
355
    needs to be used when fn is not a simple procedure name.
388
    needs to be used when fn is not a simple procedure name.
356
 
389
 
357
 ************************************************************************/
390
 ************************************************************************/
358
 
391
 
359
void jmpins
392
void
360
    PROTO_N ( ( fn ) )
-
 
361
    PROTO_T ( exp fn )
393
jmpins(exp fn)
362
{
394
{
363
    mach_op *op ;
395
	mach_op *op;
364
    exp s = son ( fn ), jmp_exp, fn_exp ;
396
	exp s = son(fn), jmp_exp, fn_exp;
365
    fn_exp = fn ;
397
	fn_exp = fn;
366
    /* If this is not a straight jmp, put the name into an A register */
398
	/* If this is not a straight jmp, put the name into an A register */
367
    if ( name ( fn ) != name_tag || isvar ( s ) || !isglob ( s ) ) {
399
	if (name(fn)!= name_tag || isvar(s) || !isglob(s)) {
368
	where w ;
400
		where w;
369
	w = zw ( fn ) ;
401
		w = zw(fn);
370
	if ( whereis ( w ) != Areg ) {
402
		if (whereis(w)!= Areg) {
371
	    int r = next_tmp_reg () ;
403
			int r = next_tmp_reg();
372
	    regsinproc |= regmsk ( r ) ;
404
			regsinproc |= regmsk(r);
373
	    move ( slongsh, w, register ( r ) ) ;
405
			move(slongsh, w, register(r));
374
	    fn_exp = register ( r ).wh_exp ;
406
			fn_exp = register(r).wh_exp;
375
	}
407
		}
376
    }
408
	}
377
    /* Now output the jmp instruction */
409
	/* Now output the jmp instruction */
378
    jmp_exp = getexp ( proksh, nilexp, 0, fn_exp, nilexp, 0, L0, cont_tag ) ;
410
	jmp_exp = getexp(proksh, nilexp, 0, fn_exp, nilexp, 0, L0, cont_tag);
379
    op = operand ( L32, zw ( jmp_exp ) ) ;
411
	op = operand(L32, zw(jmp_exp));
380
    make_instr ( m_jmp, op, null, ~save_msk ) ;
412
	make_instr(m_jmp, op, null, ~save_msk);
381
    retcell ( jmp_exp ) ;
413
	retcell(jmp_exp);
382
    have_cond = 0 ;
414
	have_cond = 0;
383
    return ;
415
	return;
384
}
416
}
385
 
417
 
386
 
418
 
387
 
419
 
388
/*
420
/*
389
    CONDITION CODES STATUS
421
    CONDITION CODES STATUS
390
 
422
 
391
    Many comparison instructions are unnecessary because the previous
423
    Many comparison instructions are unnecessary because the previous
392
    instruction has set the appropriate condition flags.  The flag
424
    instruction has set the appropriate condition flags.  The flag
Line 398... Line 430...
398
    last_cond and last_cond2.  Finally a value of 3 is used immediately
430
    last_cond and last_cond2.  Finally a value of 3 is used immediately
399
    after certain move instructions to indicate that the flags are
431
    after certain move instructions to indicate that the flags are
400
    appropriate to either of the arguments, last_cond or last_cond_alt.
432
    appropriate to either of the arguments, last_cond or last_cond_alt.
401
*/
433
*/
402
 
434
 
403
bool have_cond = 0 ;
435
bool have_cond = 0;
404
where last_cond ;
436
where last_cond;
405
where last_cond2 ;
437
where last_cond2;
406
where last_cond_alt ;
438
where last_cond_alt;
407
long last_cond_sz ;
439
long last_cond_sz;
408
 
440
 
409
 
441
 
410
/*
442
/*
411
    COMPARE WITH ZERO
443
    COMPARE WITH ZERO
412
 
444
 
413
    The value a (of shape sha and size sz) is compared with 0.  The
445
    The value a (of shape sha and size sz) is compared with 0.  The
414
    cases when have_cond is 1 or 3 are dealt with by this routine.
446
    cases when have_cond is 1 or 3 are dealt with by this routine.
415
*/
447
*/
416
 
448
 
417
void cmp_zero
449
void
418
    PROTO_N ( ( sha, sz, a ) )
-
 
419
    PROTO_T ( shape sha X long sz X where a )
450
cmp_zero(shape sha, long sz, where a)
420
{
451
{
421
    long w ;
452
	long w;
422
    /* Check existing condition codes */
453
	/* Check existing condition codes */
423
    if ( have_cond == 1 && last_cond_sz == sz ) {
454
	if (have_cond == 1 && last_cond_sz == sz) {
424
	if ( eq_where ( last_cond, a ) ) return ;
455
		if (eq_where(last_cond, a)) {
-
 
456
			return;
425
    }
457
		}
-
 
458
	}
426
    if ( have_cond == 3 && last_cond_sz == sz ) {
459
	if (have_cond == 3 && last_cond_sz == sz) {
427
	if ( eq_where ( last_cond, a ) ) return ;
460
		if (eq_where(last_cond, a)) {
-
 
461
			return;
-
 
462
		}
428
	if ( eq_where ( last_cond_alt, a ) ) return ;
463
		if (eq_where(last_cond_alt, a)) {
-
 
464
			return;
429
    }
465
		}
-
 
466
	}
430
    w = whereis ( a ) ;
467
	w = whereis(a);
431
    if ( w == Areg ) {
468
	if (w == Areg) {
432
	/* This does work, despite the manual */
469
		/* This does work, despite the manual */
433
	int instr = ins ( sz, ml_tst ) ;
470
		int instr = ins(sz, ml_tst);
434
	ins1 ( instr, sz, a, 0 ) ;
471
		ins1(instr, sz, a, 0);
435
    } else if ( w == Freg || ( w == External && name ( sha ) == prokhd ) ) {
472
	} else if (w == Freg || (w == External && name(sha) == prokhd)) {
436
	/* Moving to D0 sets the flags */
473
		/* Moving to D0 sets the flags */
437
	move ( sha, a, D0 ) ;
474
		move(sha, a, D0);
438
    } else {
475
	} else {
439
        if ( sz == 64 ) {
476
		if (sz == 64) {
440
            where w ;
477
			where w;
441
	    w = a ;
478
			w = a;
442
            ins1 ( m_tstl, 32, w, 0 ) ;
479
			ins1(m_tstl, 32, w, 0);
443
            w.wh_off += 32 ;
480
			w.wh_off += 32;
444
            ins1 ( m_tstl, 32, w, 0 ) ;
481
			ins1(m_tstl, 32, w, 0);
445
        }
-
 
446
        else {
482
		} else {
447
            int instr = ins ( sz, ml_tst ) ;
483
			int instr = ins(sz, ml_tst);
448
            ins1 ( instr, sz, a, 0 ) ;
484
			ins1(instr, sz, a, 0);
449
        }
485
		}
450
    }
486
	}
451
    /* Set new condition codes */
487
	/* Set new condition codes */
452
    set_cond ( a, sz ) ;
488
	set_cond(a, sz);
453
    return ;
489
	return;
454
}
490
}
455
 
491
 
456
 
492
 
457
/*
493
/*
458
    AUXILIARY COMPARISON ROUTINE
494
    AUXILIARY COMPARISON ROUTINE
459
 
495
 
460
    The values a and b of size sz are compared.
496
    The values a and b of size sz are compared.
461
*/
497
*/
462
 
498
 
463
static bool cmp_aux
499
static bool
464
    PROTO_N ( ( sz, a, b ) )
-
 
465
    PROTO_T ( long sz X where a X where b )
500
cmp_aux(long sz, where a, where b)
466
{
501
{
467
    where d ;
502
	where d;
468
    if ( whereis ( a ) == Freg ) {
503
	if (whereis(a) == Freg) {
469
	if ( whereis ( b ) == Freg ) {
504
		if (whereis(b) == Freg) {
470
	    move ( slongsh, a, D0 ) ;
505
			move(slongsh, a, D0);
471
	    move ( slongsh, b, D1 ) ;
506
			move(slongsh, b, D1);
472
	    regsinproc |= regmsk ( REG_D1 ) ;
507
			regsinproc |= regmsk(REG_D1);
473
	    return ( cmp_aux ( sz, D1, D0 ) ) ;
508
			return (cmp_aux(sz, D1, D0));
474
	}
509
		}
475
	if ( eq_where ( b, D0 ) ) {
510
		if (eq_where(b, D0)) {
476
	    d = D1 ;
511
			d = D1;
477
	    regsinproc |= regmsk ( REG_D1 ) ;
512
			regsinproc |= regmsk(REG_D1);
478
	} else {
513
		} else {
479
	    d = D0 ;
514
			d = D0;
480
	}
515
		}
481
	move ( slongsh, a, d ) ;
516
		move(slongsh, a, d);
482
	return ( cmp_aux ( sz, b, d ) ) ;
517
		return (cmp_aux(sz, b, d));
483
    }
518
	}
484
    if ( whereis ( b ) == Freg ) {
519
	if (whereis(b) == Freg) {
485
	if ( eq_where ( a, D0 ) ) {
520
		if (eq_where(a, D0)) {
486
	    d = D1 ;
521
			d = D1;
487
	    regsinproc |= regmsk ( REG_D1 ) ;
522
			regsinproc |= regmsk(REG_D1);
488
	} else {
523
		} else {
489
	    d = D0 ;
524
			d = D0;
490
	}
525
		}
491
	move ( slongsh, b, d ) ;
526
		move(slongsh, b, d);
492
	return ( cmp_aux ( sz, a, d ) ) ;
527
		return (cmp_aux(sz, a, d));
493
    }
528
	}
494
    ins2_cmp ( ins ( sz, ml_cmp ), sz, sz, a, b, 0 ) ;
529
	ins2_cmp(ins(sz, ml_cmp), sz, sz, a, b, 0);
495
    have_cond = 2 ;
530
	have_cond = 2;
496
    last_cond = a ;
531
	last_cond = a;
497
    last_cond2 = b ;
532
	last_cond2 = b;
498
    last_cond_sz = sz ;
533
	last_cond_sz = sz;
499
    return ( 1 ) ;
534
	return (1);
500
}
535
}
501
 
536
 
502
 
537
 
503
/*
538
/*
504
    COMPARE WITH A CONSTANT
539
    COMPARE WITH A CONSTANT
505
 
540
 
506
    The value a is compared with the constant value c, the type of the
541
    The value a is compared with the constant value c, the type of the
507
    comparison being given by ntst.  The value returned by this routine
542
    comparison being given by ntst.  The value returned by this routine
508
    has the same meaning as that returned by cmp.
543
    has the same meaning as that returned by cmp.
509
*/
544
*/
510
 
545
 
511
static bool cmp_const
546
static bool
512
    PROTO_N ( ( sha, sz, c, a, ntst ) )
-
 
513
    PROTO_T ( shape sha X long sz X where c X where a X long ntst )
547
cmp_const(shape sha, long sz, where c, where a, long ntst)
514
{
548
{
515
    bool sw ;
549
	bool sw;
516
    long v = nw ( c ) ;
550
	long v = nw(c);
517
    if ( is_offset ( c.wh_exp ) ) v /= 8 ;
551
	if (is_offset(c.wh_exp)) {
-
 
552
		v /= 8;
-
 
553
	}
518
    if ( v == 0 ) {
554
	if (v == 0) {
519
	if ( !is_signed ( sha ) && ntst != tst_neq && ntst != tst_eq ) {
555
		if (!is_signed(sha) && ntst != tst_neq && ntst != tst_eq) {
520
	    /* Force an actual comparison in these cases */
556
			/* Force an actual comparison in these cases */
521
	    have_cond = 0 ;
557
			have_cond = 0;
522
	}
558
		}
523
	cmp_zero ( sha, sz, a ) ;
559
		cmp_zero(sha, sz, a);
524
	return ( 1 ) ;
560
		return (1);
525
    }
561
	}
526
 
562
 
527
    if ( v < -128 || v > 127 ) {
563
	if (v < -128 || v > 127) {
528
	sw = cmp_aux ( sz, c, a ) ;
564
		sw = cmp_aux(sz, c, a);
529
	return ( sw ) ;
565
		return (sw);
530
    }
566
	}
531
 
567
 
532
    if ( interfere ( a, D0 ) ) {
568
	if (interfere(a, D0)) {
533
	sw = cmp_aux ( sz, c, a ) ;
569
		sw = cmp_aux(sz, c, a);
534
	return ( sw ) ;
570
		return (sw);
535
    }
571
	}
536
 
572
 
537
#ifdef REJECT
573
#ifdef REJECT
538
    if ( !output_immediately ) {
574
	if (!output_immediately) {
539
	mach_ins *p = current_ins ;
575
		mach_ins *p = current_ins;
540
	if ( p && p->ins_no == m_moveq && p->op1->def.num == v ) {
576
		if (p && p->ins_no == m_moveq && p->op1->def.num == v) {
541
	    sw = cmp_aux ( sz, a, register ( p->op2->def.num ) ) ;
577
			sw = cmp_aux(sz, a, register(p->op2->def.num));
542
	    last_cond2 = c ;
578
			last_cond2 = c;
543
	    return ( !sw ) ;
579
			return (!sw);
-
 
580
		}
544
	}
581
	}
545
    }
-
 
546
#endif
582
#endif
547
 
583
 
548
    move ( slongsh, c, D0 ) ;
584
	move(slongsh, c, D0);
549
    sw = cmp_aux ( sz, a, D0 ) ;
585
	sw = cmp_aux(sz, a, D0);
550
    last_cond2 = c ;
586
	last_cond2 = c;
551
    return ( !sw ) ;
587
	return (!sw);
552
}
588
}
553
 
589
 
554
 
590
 
555
/*
591
/*
556
    MAIN COMPARISON ROUTINE
592
    MAIN COMPARISON ROUTINE
557
 
593
 
558
    The values var and limit of shape sha are compared for the test
594
    The values var and limit of shape sha are compared for the test
559
    indicated by ntst.  Depending on the addressing modes of var and
595
    indicated by ntst.  Depending on the addressing modes of var and
560
    limit we may do "cmp var,limit" or "cmp limit,var".  In the first
596
    limit we may do "cmp var,limit" or "cmp limit,var".  In the first
561
    case we return 1 and in the second 0.  The case when have_cond is
597
    case we return 1 and in the second 0.  The case when have_cond is
562
    2 is dealt with by this routine.
598
    2 is dealt with by this routine.
563
*/
599
*/
564
 
600
 
565
bool cmp
601
bool
566
    PROTO_N ( ( sha, var, limit, ntst ) )
-
 
567
    PROTO_T ( shape sha X where var X where limit X long ntst )
602
cmp(shape sha, where var, where limit, long ntst)
568
{
603
{
569
    bool sw ;
604
	bool sw;
570
    long sz = shape_size ( sha ) ;
605
	long sz = shape_size(sha);
571
    long rt = shtype ( sha ) ;
606
	long rt = shtype(sha);
572
 
607
 
573
    long whv = whereis ( var ) ;
608
	long whv = whereis(var);
574
    long whl = whereis ( limit ) ;
609
	long whl = whereis(limit);
575
 
610
 
576
#if 0
611
#if 0
577
    if (name(sha) == ptrhd) {
612
	if (name(sha) == ptrhd) {
578
       make_comment("HACK shape size");
613
		make_comment("HACK shape size");
579
       shape_size(sha) = 32 ;
614
		shape_size(sha) = 32;
580
       sz = 32 ;
615
		sz = 32;
581
    }
616
	}
582
#endif
617
#endif
583
    if ( rt == Freg ) {
618
	if (rt == Freg) {
584
	/* Floating point comparisons are never swapped */
619
		/* Floating point comparisons are never swapped */
585
	where rv, rl ;
620
		where rv, rl;
586
	have_cond = 0 ;
621
		have_cond = 0;
587
	if ( whv == Freg && last_use ( var ) ) {
622
		if (whv == Freg && last_use(var)) {
588
	    rv = var ;
623
			rv = var;
589
	} else {
624
		} else {
590
	    if ( eq_where ( limit, FP0 ) ) {
625
			if (eq_where(limit, FP0)) {
591
		rv = FP1 ;
626
				rv = FP1;
592
		regsinproc |= regmsk ( REG_FP1 ) ;
627
				regsinproc |= regmsk(REG_FP1);
593
	    } else {
628
			} else {
594
		rv = FP0 ;
629
				rv = FP0;
595
	    }
630
			}
596
	}
631
		}
597
	if ( whl == Freg && last_use ( limit ) ) {
632
		if (whl == Freg && last_use(limit)) {
598
	    rl = limit ;
633
			rl = limit;
599
	} else {
634
		} else {
600
	    if ( eq_where ( rv, FP0 ) ) {
635
			if (eq_where(rv, FP0)) {
601
		rl = FP1 ;
636
				rl = FP1;
602
		regsinproc |= regmsk ( REG_FP1 ) ;
637
				regsinproc |= regmsk(REG_FP1);
603
	    } else {
638
			} else {
604
		rl = FP0 ;
639
				rl = FP0;
605
	    }
640
			}
606
	}
641
		}
607
	if ( whv == Freg ) {
642
		if (whv == Freg) {
608
	    push_float ( sz, var ) ;
643
			push_float(sz, var);
609
	    pop_float ( sz, rv ) ;
644
			pop_float(sz, rv);
610
	} else {
645
		} else {
611
	    move ( sha, var, rv ) ;
646
			move(sha, var, rv);
612
	}
647
		}
613
	if ( whl == Freg ) {
648
		if (whl == Freg) {
614
	    push_float ( sz, limit ) ;
649
			push_float(sz, limit);
615
	    pop_float ( sz, rl ) ;
650
			pop_float(sz, rl);
616
	} else {
651
		} else {
617
	    move ( sha, limit, rl ) ;
652
			move(sha, limit, rl);
618
	}
653
		}
619
	ins2_cmp ( m_fcmpx, sz, sz, rl, rv, 0 ) ;
654
		ins2_cmp(m_fcmpx, sz, sz, rl, rv, 0);
620
	return ( 1 ) ;
655
		return (1);
621
    }
656
	}
622
 
657
 
623
    /* Check existing condition codes */
658
	/* Check existing condition codes */
624
    if ( have_cond == 2 && last_cond_sz == sz ) {
659
	if (have_cond == 2 && last_cond_sz == sz) {
625
	if ( eq_where ( last_cond, var ) &&
660
		if (eq_where(last_cond, var) && eq_where(last_cond2, limit)) {
-
 
661
			return (0);
-
 
662
		}
626
	     eq_where ( last_cond2, limit ) ) return ( 0 ) ;
663
		if (eq_where(last_cond, limit) && eq_where(last_cond2, var)) {
-
 
664
			return (1);
-
 
665
		}
-
 
666
	}
-
 
667
 
627
	if ( eq_where ( last_cond, limit ) &&
668
	if (whl == Value) {
628
	     eq_where ( last_cond2, var ) ) return ( 1 ) ;
669
		sw = cmp_const(sha, sz, limit, var, ntst);
-
 
670
		return (sw);
629
    }
671
	}
630
 
672
 
631
    if ( whl == Value ) {
673
	if (whv == Value) {
632
	sw = cmp_const ( sha, sz, limit, var, ntst ) ;
674
		sw = cmp_const(sha, sz, var, limit, ntst);
633
	return ( sw ) ;
675
		return (!sw);
634
    }
676
	}
635
 
677
 
636
    if ( whv == Value ) {
678
	if (whl == Dreg || whl == Areg) {
637
	sw = cmp_const ( sha, sz, var, limit, ntst ) ;
679
		sw = cmp_aux(sz, var, limit);
638
	return ( !sw ) ;
680
		return (!sw);
639
    }
681
	}
640
 
682
 
641
    if ( whl == Dreg || whl == Areg ) {
-
 
642
	sw = cmp_aux ( sz, var, limit ) ;
-
 
643
	return ( !sw ) ;
-
 
644
    }
-
 
645
 
-
 
646
    if ( whv == Dreg || whv == Areg ) {
683
	if (whv == Dreg || whv == Areg) {
647
	sw = cmp_aux ( sz, limit, var ) ;
684
		sw = cmp_aux(sz, limit, var);
648
	return ( sw ) ;
685
		return (sw);
649
    }
686
	}
650
 
687
 
651
#if 0
688
#if 0
652
    if(name (var.wh_exp) == name_tag && name(sha) == prokhd &&
689
	if (name(var.wh_exp) == name_tag && name(sha) == prokhd &&
653
       ((son(son(var.wh_exp))==nilexp) ||
690
	    ((son(son(var.wh_exp)) ==nilexp) ||
654
	(name(son(son(var.wh_exp))) == proc_tag))) {
691
	     (name(son(son(var.wh_exp))) == proc_tag))) {
655
      exp proc_cont = getexp(sha,nilexp,0,var.wh_exp,nilexp,0,0,cont_tag);
692
		exp proc_cont = getexp(sha, nilexp, 0, var.wh_exp, nilexp, 0,
-
 
693
				       0, cont_tag);
656
      var.wh_exp = proc_cont;
694
		var.wh_exp = proc_cont;
657
    }
695
	}
658
#endif
696
#endif
659
 
697
 
660
    if ( !interfere ( var, D0 ) ) {
698
	if (!interfere(var, D0)) {
661
	move ( sha, limit, D0 ) ;
699
		move(sha, limit, D0);
662
	sw = cmp_aux ( sz, var, D0 ) ;
700
		sw = cmp_aux(sz, var, D0);
663
	last_cond2 = limit ;
701
		last_cond2 = limit;
664
	return ( !sw ) ;
702
		return (!sw);
665
    }
703
	}
666
 
704
 
667
    if ( !interfere ( limit, D0 ) ) {
705
	if (!interfere(limit, D0)) {
668
	move ( sha, var, D0 ) ;
706
		move(sha, var, D0);
669
	sw = cmp_aux ( sz, limit, D0 ) ;
707
		sw = cmp_aux(sz, limit, D0);
670
	last_cond2 = var ;
708
		last_cond2 = var;
671
	return ( sw ) ;
709
		return (sw);
672
    }
710
	}
673
 
711
 
674
    move ( sha, limit, D1 ) ;
712
	move(sha, limit, D1);
675
    sw = cmp_aux ( sz, var, D1 ) ;
713
	sw = cmp_aux(sz, var, D1);
676
    regsinproc |= regmsk ( REG_D1 ) ;
714
	regsinproc |= regmsk(REG_D1);
677
    last_cond2 = limit ;
715
	last_cond2 = limit;
678
    return ( !sw ) ;
716
	return (!sw);
679
}
717
}
680
 
718
 
681
 
719
 
682
/*
720
/*
683
    OUTPUT A PUSH INSTRUCTION
721
    OUTPUT A PUSH INSTRUCTION
684
 
722
 
685
    The value wh of shape sha and size sz is pushed onto the stack.
723
    The value wh of shape sha and size sz is pushed onto the stack.
686
*/
724
*/
687
 
725
 
688
void push
726
void
689
    PROTO_N ( ( sha, sz, wh ) )
-
 
690
    PROTO_T ( shape sha X long sz X where wh )
727
push(shape sha, long sz, where wh)
691
{
728
{
692
    long s ;
729
	long s;
693
    mach_op *op1, *op2 ;
730
	mach_op *op1, *op2;
694
    bool real_push = 1 ;
731
	bool real_push = 1;
695
    if ( sz != 32 ) {
732
	if (sz != 32) {
696
	if ( is_signed ( sha ) && ( whereis ( wh ) == Dreg ) ) {
733
		if (is_signed(sha) && (whereis(wh) == Dreg)) {
697
	    change_var_sh ( slongsh, sha, wh, wh ) ;
734
			change_var_sh(slongsh, sha, wh, wh);
698
	    push ( slongsh, L32, wh ) ;
735
			push(slongsh, L32, wh);
-
 
736
		} else {
-
 
737
			change_var_sh(slongsh, sha, wh, D0);
-
 
738
			push(slongsh, L32, D0);
-
 
739
		}
-
 
740
		have_cond = 0;
-
 
741
		return;
-
 
742
	}
-
 
743
	if (stack_change) {
-
 
744
		stack_change -= 32;
-
 
745
		real_push = 0;
-
 
746
		if (stack_direction) {
-
 
747
			update_stack();
-
 
748
		}
-
 
749
		s = stack_change;
-
 
750
		stack_change = 0;
-
 
751
	}
-
 
752
	op1 = operand(sz, wh);
-
 
753
	if (real_push) {
-
 
754
		op2 = make_dec_sp();
-
 
755
	} else {
-
 
756
		op2 = make_indirect(REG_SP, s / 8);
-
 
757
	}
-
 
758
	make_instr(m_movl, op1, op2, 0);
-
 
759
	have_cond = 0;
-
 
760
	if (real_push) {
-
 
761
		stack_size -= 32;
699
	} else {
762
	} else {
700
	    change_var_sh ( slongsh, sha, wh, D0 ) ;
-
 
701
	    push ( slongsh, L32, D0 ) ;
763
		stack_change = s;
702
	}
764
	}
703
	have_cond = 0 ;
-
 
704
	return ;
765
	return;
705
    }
-
 
706
    if ( stack_change ) {
-
 
707
	stack_change -= 32 ;
-
 
708
	real_push = 0 ;
-
 
709
	if ( stack_direction ) update_stack () ;
-
 
710
	s = stack_change ;
-
 
711
	stack_change = 0 ;
-
 
712
    }
-
 
713
    op1 = operand ( sz, wh ) ;
-
 
714
    if ( real_push ) {
-
 
715
	op2 = make_dec_sp () ;
-
 
716
    } else {
-
 
717
	op2 = make_indirect ( REG_SP, s / 8 ) ;
-
 
718
    }
-
 
719
    make_instr ( m_movl, op1, op2, 0 ) ;
-
 
720
    have_cond = 0 ;
-
 
721
    if ( real_push ) {
-
 
722
	stack_size -= 32 ;
-
 
723
    } else {
-
 
724
	stack_change = s ;
-
 
725
    }
-
 
726
    return ;
-
 
727
}
766
}
728
 
767
 
729
 
768
 
730
/*
769
/*
731
    PUSH A FLOATING POINT REGISTER
770
    PUSH A FLOATING POINT REGISTER
732
 
771
 
733
    The floating-point register wh of size sz is pushed onto the stack.
772
    The floating-point register wh of size sz is pushed onto the stack.
734
*/
773
*/
735
 
774
 
736
void push_float
775
void
737
    PROTO_N ( ( sz, wh ) )
-
 
738
    PROTO_T ( long sz X where wh )
776
push_float(long sz, where wh)
739
{
777
{
740
    mach_op *op1 = operand ( sz, wh ) ;
778
	mach_op *op1 = operand(sz, wh);
741
    mach_op *op2 = make_dec_sp () ;
779
	mach_op *op2 = make_dec_sp();
742
    int instr = insf ( sz, ml_fmove ) ;
780
	int instr = insf(sz, ml_fmove);
743
    make_instr ( instr, op1, op2, 0 ) ;
781
	make_instr(instr, op1, op2, 0);
744
    stack_size -= sz ;
782
	stack_size -= sz;
745
    have_cond = 0 ;
783
	have_cond = 0;
746
    return ;
784
	return;
747
}
785
}
748
 
786
 
749
 
787
 
750
/*
788
/*
751
    OUTPUT A POP OPERATION
789
    OUTPUT A POP OPERATION
752
 
790
 
753
    A value of shape sha and size sz is popped from the stack into wh.
791
    A value of shape sha and size sz is popped from the stack into wh.
754
*/
792
*/
755
 
793
 
756
void pop
794
void
757
    PROTO_N ( ( sha, sz, wh ) )
-
 
758
    PROTO_T ( shape sha X long sz X where wh )
795
pop(shape sha, long sz, where wh)
759
{
796
{
760
    mach_op *op1, *op2 ;
797
	mach_op *op1, *op2;
761
    if ( sz != 32 ) {
798
	if (sz != 32) {
762
	if ( whereis ( wh ) == Dreg ) {
799
		if (whereis(wh) == Dreg) {
763
	    pop ( slongsh, L32, wh ) ;
800
			pop(slongsh, L32, wh);
764
	    change_var_sh ( sha, slongsh, wh, wh ) ;
801
			change_var_sh(sha, slongsh, wh, wh);
765
	} else {
802
		} else {
766
	    pop ( slongsh, L32, D0 ) ;
803
			pop(slongsh, L32, D0);
767
	    change_var_sh ( sha, slongsh, D0, wh ) ;
804
			change_var_sh(sha, slongsh, D0, wh);
768
	}
805
		}
769
	have_cond = 0 ;
806
		have_cond = 0;
770
	return ;
807
		return;
771
    }
808
	}
772
    op1 = make_inc_sp () ;
809
	op1 = make_inc_sp();
773
    op2 = operand ( sz, wh ) ;
810
	op2 = operand(sz, wh);
774
    make_instr ( m_movl, op1, op2, 0 ) ;
811
	make_instr(m_movl, op1, op2, 0);
775
    have_cond = 0 ;
812
	have_cond = 0;
776
    stack_size += sz ;
813
	stack_size += sz;
777
    return ;
814
	return;
778
}
815
}
779
 
816
 
780
 
817
 
781
/*
818
/*
782
    POP A FLOATING POINT REGISTER
819
    POP A FLOATING POINT REGISTER
783
 
820
 
784
    A value of size sz is popped from the stack into the floating-point
821
    A value of size sz is popped from the stack into the floating-point
785
    register wh.
822
    register wh.
786
*/
823
*/
787
 
824
 
788
void pop_float
825
void
789
    PROTO_N ( ( sz, wh ) )
-
 
790
    PROTO_T ( long sz X where wh )
826
pop_float(long sz, where wh)
791
{
827
{
792
    mach_op *op1 = make_inc_sp () ;
828
	mach_op *op1 = make_inc_sp();
793
    mach_op *op2 = operand ( sz, wh ) ;
829
	mach_op *op2 = operand(sz, wh);
794
    int instr = insf ( sz, ml_fmove ) ;
830
	int instr = insf(sz, ml_fmove);
795
    make_instr ( instr, op1, op2, 0 ) ;
831
	make_instr(instr, op1, op2, 0);
796
    have_cond = 0 ;
832
	have_cond = 0;
797
    stack_size += sz ;
833
	stack_size += sz;
798
    return ;
834
	return;
799
}
835
}
800
 
836
 
801
 
837
 
802
/*
838
/*
803
    MOVE AN ADDRESS INTO A TEMPORARY REGISTER
839
    MOVE AN ADDRESS INTO A TEMPORARY REGISTER
804
 
840
 
805
    The effective address of wh is loaded into a temporary register and
841
    The effective address of wh is loaded into a temporary register and
806
    the register number is returned.  By default, register r is used,
842
    the register number is returned.  By default, register r is used,
807
    but if try is true we see if we can do better.
843
    but if try is true we see if we can do better.
808
*/
844
*/
809
 
845
 
810
static int tmp_mova
846
static int
811
    PROTO_N ( ( wh, r, try ) )
-
 
812
    PROTO_T ( where wh X int r X bool try )
847
tmp_mova(where wh, int r, bool try)
813
{
848
{
814
    tmp_reg_prefer = r ;
849
	tmp_reg_prefer = r;
815
    mova ( wh, register ( r ) ) ;
850
	mova(wh, register(r));
816
    if ( try && !output_immediately && current_ins ) {
851
	if (try && !output_immediately && current_ins) {
817
	int i = current_ins->ins_no ;
852
		int i = current_ins->ins_no;
818
	if ( i == m_lea || i == m_movl ) {
853
		if (i == m_lea || i == m_movl) {
819
	    mach_op *op1 = current_ins->op1 ;
854
			mach_op *op1 = current_ins->op1;
820
	    mach_op *op2 = current_ins->op2 ;
855
			mach_op *op2 = current_ins->op2;
821
	    if ( op2->type == MACH_REG && op2->def.num == r ) {
856
			if (op2->type == MACH_REG && op2->def.num == r) {
822
		int t = r ;
857
				int t = r;
823
		if ( i == m_lea ) {
858
				if (i == m_lea) {
824
		    if ( op1->type == MACH_CONT ) {
859
					if (op1->type == MACH_CONT) {
825
			op1 = op1->of ;
860
						op1 = op1->of;
-
 
861
						if (op1->type == MACH_REG &&
-
 
862
						    op1->plus == null) {
-
 
863
							t = op1->def.num;
-
 
864
						}
-
 
865
					}
-
 
866
				} else {
826
			if ( op1->type == MACH_REG && op1->plus == null ) {
867
					if (op1->type == MACH_REG) {
827
			    t = op1->def.num ;
868
						t = op1->def.num;
-
 
869
					}
-
 
870
				}
-
 
871
				if (t != r) {
-
 
872
					current_ins->ins_no = m_ignore_ins;
-
 
873
					op2->def.num = t;
-
 
874
					r = t;
-
 
875
				}
828
			}
876
			}
829
		    }
-
 
830
		} else {
-
 
831
		    if ( op1->type == MACH_REG ) t = op1->def.num ;
-
 
832
		}
-
 
833
		if ( t != r ) {
-
 
834
		    current_ins->ins_no = m_ignore_ins ;
-
 
835
		    op2->def.num = t ;
-
 
836
		    r = t ;
-
 
837
		}
877
		}
838
	    }
-
 
839
	}
878
	}
840
    }
-
 
841
    regsinproc |= regmsk ( r ) ;
879
	regsinproc |= regmsk(r);
842
    return ( r ) ;
880
	return (r);
843
}
881
}
844
 
882
 
845
 
883
 
846
/*
884
/*
847
    MOVE A CONSTANT VALUE
885
    MOVE A CONSTANT VALUE
848
 
886
 
849
    The constant value c is assigned to the where to (of shape sha and
887
    The constant value c is assigned to the where to (of shape sha and
850
    size sz).
888
    size sz).
851
*/
889
*/
852
 
890
 
853
void move_const
891
void
854
    PROTO_N ( ( sha, sz, c, to ) )
-
 
855
    PROTO_T ( shape sha X long sz X long c X where to )
892
move_const(shape sha, long sz, long c, where to)
856
{
-
 
857
    int instr ;
-
 
858
    int whto = whereis ( to ) ;
-
 
859
 
-
 
860
    if ( c == 0 ) {
-
 
861
	/* Clearing is a special case */
-
 
862
	if ( whto == Dreg ) {
-
 
863
	    ins2n ( m_moveq, 0, L32, to, 1 ) ;
-
 
864
	    set_cond ( to, sz ) ;
-
 
865
	    return ;
-
 
866
	}
-
 
867
	if ( whto == Areg ) {
-
 
868
	    ins2 ( m_subl, L32, L32, to, to, 1 ) ;
-
 
869
	    have_cond = 0 ;
-
 
870
	    return ;
-
 
871
	}
-
 
872
        if ( sz == 64 ) {
-
 
873
            where w ;
-
 
874
	    w = to ;
-
 
875
            ins1 ( m_clrl, 32, w, 0 ) ;
-
 
876
            w.wh_off += 32 ;
-
 
877
            ins1 ( m_clrl, 32, w, 0 ) ;
-
 
878
        }
-
 
879
        else {
-
 
880
            instr = ins ( sz, ml_clr ) ;
-
 
881
            ins1 ( instr, sz, to, 1 ) ;
-
 
882
            set_cond ( to, sz ) ;
-
 
883
        }
-
 
884
	return ;
-
 
885
    }
-
 
886
 
-
 
887
    instr = ins ( sz, ml_mov ) ;
-
 
888
 
-
 
889
    if ( sz == 8 )  c &= 0xff ;
-
 
890
    if ( sz == 16 ) c &= 0xffff ;
-
 
891
    if ( c >= -128 && c <= 127 ) {
-
 
892
	/* Look for quick moves */
-
 
893
	if ( whto == Dreg ) {
-
 
894
	    ins2n ( m_moveq, c, L32, to, 1 ) ;
-
 
895
	    set_cond ( to, sz ) ;
-
 
896
	    return ;
-
 
897
	} else {
-
 
898
	    ins2n ( m_moveq, c, L32, D0, 1 ) ;
-
 
899
	    if ( whto == Areg ) instr = m_movl ;
-
 
900
	    ins2 ( instr, sz, sz, D0, to, 1 ) ;
-
 
901
	    if ( whto == Areg ) {
-
 
902
		have_cond = 0 ;
-
 
903
	    } else {
-
 
904
		set_cond ( to, sz ) ;
-
 
905
	    }
-
 
906
	    return ;
-
 
907
	}
-
 
908
    }
-
 
909
 
-
 
910
    if ( whto == Areg && sz == 8 ) {
-
 
911
	ins2n ( instr, c, sz, D0, 1 ) ;
-
 
912
	ins2 ( m_movl, L32, L32, D0, to, 1 ) ;
-
 
913
    } else {
-
 
914
	ins2n ( instr, c, sz, to, 1 ) ;
-
 
915
    }
-
 
916
    if ( whto == Areg ) {
-
 
917
	have_cond = 0 ;
-
 
918
    } else {
-
 
919
	set_cond ( to, sz ) ;
-
 
920
    }
-
 
921
    return ;
-
 
922
}
-
 
923
 
-
 
924
 
-
 
925
/*
-
 
926
    MOVE FROM A FLOATING-POINT REGISTER
-
 
927
 
-
 
928
    The value in the floating-point register from (of size sz) is moved
-
 
929
    into to.
-
 
930
*/
-
 
931
 
-
 
932
static void move_from_freg
-
 
933
    PROTO_N ( ( sz, from, to ) )
-
 
934
    PROTO_T ( long sz X where from X where to )
-
 
935
{
893
{
-
 
894
	int instr;
-
 
895
	int whto = whereis(to);
-
 
896
 
-
 
897
	if (c == 0) {
-
 
898
		/* Clearing is a special case */
-
 
899
		if (whto == Dreg) {
-
 
900
			ins2n(m_moveq, 0, L32, to, 1);
-
 
901
			set_cond(to, sz);
-
 
902
			return;
-
 
903
		}
-
 
904
		if (whto == Areg) {
-
 
905
			ins2(m_subl, L32, L32, to, to, 1);
-
 
906
			have_cond = 0;
-
 
907
			return;
-
 
908
		}
-
 
909
		if (sz == 64) {
-
 
910
			where w;
-
 
911
			w = to;
-
 
912
			ins1(m_clrl, 32, w, 0);
-
 
913
			w.wh_off += 32;
-
 
914
			ins1(m_clrl, 32, w, 0);
-
 
915
		} else {
-
 
916
			instr = ins(sz, ml_clr);
-
 
917
			ins1(instr, sz, to, 1);
-
 
918
			set_cond(to, sz);
-
 
919
		}
-
 
920
		return;
-
 
921
	}
-
 
922
 
936
    int instr = insf ( sz, ml_fmove ) ;
923
	instr = ins(sz, ml_mov);
-
 
924
 
-
 
925
	if (sz == 8) {
-
 
926
		c &= 0xff;
-
 
927
	}
-
 
928
	if (sz == 16) {
-
 
929
		c &= 0xffff;
-
 
930
	}
937
    switch ( whereis ( to ) ) {
931
	if (c >= -128 && c <= 127) {
-
 
932
		/* Look for quick moves */
-
 
933
		if (whto == Dreg) {
-
 
934
			ins2n(m_moveq, c, L32, to, 1);
-
 
935
			set_cond(to, sz);
-
 
936
			return;
938
	case Dreg : {
937
		} else {
-
 
938
			ins2n(m_moveq, c, L32, D0, 1);
-
 
939
			if (whto == Areg) {
-
 
940
				instr = m_movl;
-
 
941
			}
939
	    ins2 ( m_fmoves, sz, sz, from, to, 1 ) ;
942
			ins2(instr, sz, sz, D0, to, 1);
-
 
943
			if (whto == Areg) {
940
	    have_cond = 0 ;
944
				have_cond = 0;
-
 
945
			} else {
-
 
946
				set_cond(to, sz);
-
 
947
			}
941
	    return ;
948
			return;
-
 
949
		}
942
	}
950
	}
-
 
951
 
943
	case Freg : {
952
	if (whto == Areg && sz == 8) {
944
	    ins2 ( m_fmovex, sz, sz, from, to, 1 ) ;
953
		ins2n(instr, c, sz, D0, 1);
945
	    have_cond = 0 ;
954
		ins2(m_movl, L32, L32, D0, to, 1);
946
	    return ;
955
	} else {
-
 
956
		ins2n(instr, c, sz, to, 1);
947
	}
957
	}
-
 
958
	if (whto == Areg) {
-
 
959
		have_cond = 0;
-
 
960
	} else {
-
 
961
		set_cond(to, sz);
-
 
962
	}
-
 
963
	return;
-
 
964
}
-
 
965
 
-
 
966
 
-
 
967
/*
-
 
968
    MOVE FROM A FLOATING-POINT REGISTER
-
 
969
 
-
 
970
    The value in the floating-point register from (of size sz) is moved
-
 
971
    into to.
-
 
972
*/
-
 
973
 
-
 
974
static void
-
 
975
move_from_freg(long sz, where from, where to)
-
 
976
{
-
 
977
	int instr = insf(sz, ml_fmove);
-
 
978
	switch (whereis(to)) {
-
 
979
	case Dreg:
-
 
980
		ins2(m_fmoves, sz, sz, from, to, 1);
-
 
981
		have_cond = 0;
-
 
982
		return;
-
 
983
	case Freg:
-
 
984
		ins2(m_fmovex, sz, sz, from, to, 1);
-
 
985
		have_cond = 0;
-
 
986
		return;
948
	case RegPair : {
987
	case RegPair: {
949
	    exp te = to.wh_exp ;
988
		exp te = to.wh_exp;
-
 
989
		if (sz != 64) {
950
	    if ( sz != 64 ) error ( "Wrong floating variety" ) ;
990
			error("Wrong floating variety");
-
 
991
		}
951
	    push_float ( sz, from ) ;
992
		push_float(sz, from);
952
	    pop ( slongsh, L32, zw ( son ( te ) ) ) ;
993
		pop(slongsh, L32, zw(son(te)));
953
	    pop ( slongsh, L32, zw ( bro ( te ) ) ) ;
994
		pop(slongsh, L32, zw(bro(te)));
-
 
995
		have_cond = 0;
-
 
996
		return;
-
 
997
	}
-
 
998
	default:
-
 
999
		ins2(instr, sz, sz, from, to, 1);
954
	    have_cond = 0 ;
1000
		have_cond = 0;
955
	    return ;
1001
		return;
956
	}
1002
	}
957
	default : {
-
 
958
	    ins2 ( instr, sz, sz, from, to, 1 ) ;
-
 
959
	    have_cond = 0 ;
-
 
960
	    return ;
-
 
961
	}
-
 
962
    }
-
 
963
}
1003
}
964
 
1004
 
965
 
1005
 
966
/*
1006
/*
967
    MOVE TO A FLOATING-POINT REGISTER
1007
    MOVE TO A FLOATING-POINT REGISTER
968
 
1008
 
969
    The value in from (of size sz) is moved into the floating-point
1009
    The value in from (of size sz) is moved into the floating-point
970
    register to.
1010
    register to.
971
*/
1011
*/
972
 
1012
 
973
static void move_to_freg
1013
static void
974
    PROTO_N ( ( sz, from, to ) )
-
 
975
    PROTO_T ( long sz X where from X where to )
1014
move_to_freg(long sz, where from, where to)
976
{
1015
{
977
    int instr = insf ( sz, ml_fmove ) ;
1016
	int instr = insf(sz, ml_fmove);
978
    switch ( whereis ( from ) ) {
1017
	switch (whereis(from)) {
979
	case Dreg : {
1018
	case Dreg:
980
	    ins2 ( m_fmoves, sz, sz, from, to, 1 ) ;
1019
		ins2(m_fmoves, sz, sz, from, to, 1);
981
	    have_cond = 0 ;
1020
		have_cond = 0;
982
	    return ;
1021
		return;
983
	}
-
 
984
	case Areg : {
1022
	case Areg:
985
	    move ( slongsh, from, D0 ) ;
1023
		move(slongsh, from, D0);
986
	    ins2 ( m_fmoves, sz, sz, D0, to, 1 ) ;
1024
		ins2(m_fmoves, sz, sz, D0, to, 1);
987
	    have_cond = 0 ;
1025
		have_cond = 0;
988
	    return ;
1026
		return;
989
	}
-
 
990
	case Freg : {
1027
	case Freg:
991
	    ins2 ( m_fmovex, sz, sz, from, to, 1 ) ;
1028
		ins2(m_fmovex, sz, sz, from, to, 1);
992
	    have_cond = 0 ;
1029
		have_cond = 0;
993
	    return ;
1030
		return;
994
	}
-
 
995
	case RegPair : {
1031
	case RegPair: {
996
	    exp fe = from.wh_exp ;
1032
		exp fe = from.wh_exp;
-
 
1033
		if (sz != 64) {
997
	    if ( sz != 64 ) error ( "Wrong floating variety" ) ;
1034
			error("Wrong floating variety");
-
 
1035
		}
998
	    push ( slongsh, L32, zw ( bro ( fe ) ) ) ;
1036
		push(slongsh, L32, zw(bro(fe)));
999
	    push ( slongsh, L32, zw ( son ( fe ) ) ) ;
1037
		push(slongsh, L32, zw(son(fe)));
1000
	    pop_float ( sz, to ) ;
1038
		pop_float(sz, to);
1001
	    have_cond = 0 ;
1039
		have_cond = 0;
1002
	    return ;
1040
		return;
1003
	}
1041
	}
1004
	default : {
1042
	default:
1005
	    ins2 ( instr, sz, sz, from, to, 1 ) ;
1043
		ins2(instr, sz, sz, from, to, 1);
1006
	    have_cond = 0 ;
1044
		have_cond = 0;
1007
	    return ;
1045
		return;
1008
	}
1046
	}
1009
    }
-
 
1010
}
1047
}
1011
 
1048
 
1012
 
1049
 
1013
/*
1050
/*
1014
    TEST AN EXTERNAL FOR SIMPLE CONTENTS/ASSIGN
1051
    TEST AN EXTERNAL FOR SIMPLE CONTENTS/ASSIGN
1015
 
1052
 
1016
    The expression e of external storage type is checked for simple
1053
    The expression e of external storage type is checked for simple
1017
    operand type.
1054
    operand type.
1018
*/
1055
*/
1019
 
1056
 
1020
static bool ca_extern
1057
static bool
1021
    PROTO_N ( ( e ) )
-
 
1022
    PROTO_T ( exp e )
1058
ca_extern(exp e)
1023
{
1059
{
1024
    char n = name ( e ) ;
1060
	char n = name(e);
1025
    if ( n != cont_tag && n != ass_tag ) return ( 0 ) ;
1061
	if (n != cont_tag && n != ass_tag) {
-
 
1062
		return (0);
-
 
1063
	}
1026
    return ( name ( son ( e ) ) == name_tag ? 1 : 0 ) ;
1064
	return (name(son(e)) == name_tag ? 1 : 0);
1027
}
1065
}
1028
 
1066
 
1029
 
1067
 
1030
/*
1068
/*
1031
    MOVE LARGE OBJECTS
1069
    MOVE LARGE OBJECTS
1032
 
1070
 
1033
    sz bits are copied from from to to.  down can be 0 (start at the
1071
    sz bits are copied from from to to.  down can be 0 (start at the
1034
    top), 1 (start at the bottom) or 2 (don't care).
1072
    top), 1 (start at the bottom) or 2 (don't care).
1035
*/
1073
*/
1036
 
1074
 
1037
void move_bytes
1075
void
1038
    PROTO_N ( ( sz, from, to, down ) )
-
 
1039
    PROTO_T ( long sz X where from X where to X int down )
1076
move_bytes(long sz, where from, where to, int down)
1040
{
1077
{
1041
    long off ;
1078
	long off;
1042
    int instr ;
1079
	int instr;
1043
 
-
 
1044
    exp fe = from.wh_exp ;
-
 
1045
    exp te = to.wh_exp ;
-
 
1046
    long fof = from.wh_off ;
-
 
1047
    long tof = to.wh_off ;
-
 
1048
 
1080
 
-
 
1081
	exp fe = from.wh_exp;
-
 
1082
	exp te = to.wh_exp;
1049
    long whfrom = whereis ( from ) ;
1083
	long fof = from.wh_off;
1050
    long whto = whereis ( to ) ;
1084
	long tof = to.wh_off;
1051
 
1085
 
1052
    /* Set up move types */
1086
	long whfrom = whereis(from);
1053
    int r1 = REG_A0 ;
1087
	long whto = whereis(to);
1054
    int r2 = REG_A1 ;
-
 
1055
    int s1 = 0 ;
-
 
1056
    int s2 = 0 ;
-
 
1057
 
1088
 
1058
    if ( whfrom == External && ca_extern ( fe ) ) s1 = 3 ;
1089
	/* Set up move types */
1059
    if ( name ( te ) == apply_tag || name ( te ) == apply_general_tag
1090
	int r1 = REG_A0;
1060
        || name ( te ) == tail_call_tag ) s2 = 1 ;
1091
	int r2 = REG_A1;
-
 
1092
	int s1 = 0;
1061
    if ( whto == External && ca_extern ( te ) ) s2 = 3 ;
1093
	int s2 = 0;
1062
 
1094
 
-
 
1095
	if (whfrom == External && ca_extern(fe)) {
-
 
1096
		s1 = 3;
-
 
1097
	}
-
 
1098
	if (name(te) == apply_tag || name(te) == apply_general_tag ||
-
 
1099
	    name(te) == tail_call_tag) {
-
 
1100
		s2 = 1;
-
 
1101
	}
-
 
1102
	if (whto == External && ca_extern(te)) {
-
 
1103
		s2 = 3;
-
 
1104
	}
-
 
1105
 
1063
    if ( whfrom == Variable || whfrom == Parameter || whfrom == RegInd ) {
1106
	if (whfrom == Variable || whfrom == Parameter || whfrom == RegInd) {
1064
	s1 = 3 ;
1107
		s1 = 3;
1065
    }
1108
	}
1066
    if ( whto == Variable || whto == Parameter || whto == RegInd ) {
1109
	if (whto == Variable || whto == Parameter || whto == RegInd) {
1067
	s2 = 3 ;
1110
		s2 = 3;
1068
    }
1111
	}
1069
    if ( whfrom == RegPair ) s1 = 4 ;
1112
	if (whfrom == RegPair) {
-
 
1113
		s1 = 4;
-
 
1114
	}
1070
    if ( whto == RegPair ) s2 = 4 ;
1115
	if (whto == RegPair) {
-
 
1116
		s2 = 4;
-
 
1117
	}
1071
 
1118
 
1072
    if ( sz > 12 * 32 && s2 != 1 && down != 1 ) {
1119
	if (sz > 12 * 32 && s2 != 1 && down != 1) {
1073
	mach_op *op1, *op2 ;
1120
		mach_op *op1, *op2;
1074
	long lab = next_lab () ;
1121
		long lab = next_lab();
1075
	long longs = ( sz / 32 ) ;
1122
		long longs = (sz / 32);
1076
	sz -= 32 * longs ;
1123
		sz -= 32 * longs;
1077
	r1 = REG_A0 ;
1124
		r1 = REG_A0;
1078
	r2 = REG_A1 ;
1125
		r2 = REG_A1;
1079
	s1 = 0 ;
1126
		s1 = 0;
1080
	s2 = 0 ;
1127
		s2 = 0;
1081
	tmp_mova ( from, r1, 0 ) ;
1128
		tmp_mova(from, r1, 0);
1082
	tmp_mova ( to, r2, 0 ) ;
1129
		tmp_mova(to, r2, 0);
1083
	move ( slongsh, mnw ( longs - 1 ), D0 ) ;
1130
		move(slongsh, mnw(longs - 1), D0);
1084
	make_label ( lab ) ;
1131
		make_label(lab);
1085
	op1 = make_postinc ( r1 ) ;
1132
		op1 = make_postinc(r1);
1086
	op2 = make_postinc ( r2 ) ;
1133
		op2 = make_postinc(r2);
1087
	make_instr ( m_movl, op1, op2, regmsk ( r1 ) | regmsk ( r2 ) ) ;
1134
		make_instr(m_movl, op1, op2, regmsk(r1) | regmsk(r2));
1088
	op1 = make_register ( REG_D0 ) ;
1135
		op1 = make_register(REG_D0);
1089
	op2 = make_lab_data ( lab, 0 ) ;
1136
		op2 = make_lab_data(lab, 0);
1090
	make_instr ( m_dbf, op1, op2, regmsk ( REG_D0 ) ) ;
1137
		make_instr(m_dbf, op1, op2, regmsk(REG_D0));
1091
    } else {
-
 
1092
	if ( s1 == 0 ) {
-
 
1093
	    int r = tmp_mova ( from, r1, 1 ) ;
-
 
1094
	    if ( r != r1 ) {
-
 
1095
		if ( s2 == 0 ) r2 = tmp_mova ( to, r1, 1 ) ;
-
 
1096
		r1 = r ;
-
 
1097
	    } else {
-
 
1098
		if ( s2 == 0 ) r2 = tmp_mova ( to, r2, 1 ) ;
-
 
1099
	    }
-
 
1100
	} else {
1138
	} else {
-
 
1139
		if (s1 == 0) {
-
 
1140
			int r = tmp_mova(from, r1, 1);
-
 
1141
			if (r != r1) {
-
 
1142
				if (s2 == 0) {
-
 
1143
					r2 = tmp_mova(to, r1, 1);
-
 
1144
				}
-
 
1145
				r1 = r;
-
 
1146
			} else {
-
 
1147
				if (s2 == 0) {
-
 
1148
					r2 = tmp_mova(to, r2, 1);
-
 
1149
				}
-
 
1150
			}
-
 
1151
		} else {
-
 
1152
			if (s2 == 0) {
1101
	    if ( s2 == 0 ) r2 = tmp_mova ( to, REG_A1, 1 ) ;
1153
				r2 = tmp_mova(to, REG_A1, 1);
-
 
1154
			}
-
 
1155
		}
1102
	}
1156
	}
1103
    }
-
 
1104
 
1157
 
1105
    off = 0 ;
1158
	off = 0;
1106
    while ( sz ) {
1159
	while (sz) {
1107
	mach_op *op1, *op2 ;
1160
		mach_op *op1, *op2;
1108
	long b = ( ( sz >= 32 ) ? 32 : ( ( sz >= 16 ) ? 16 : 8 ) ) ;
1161
		long b = ((sz >= 32)? 32 :((sz >= 16)? 16 : 8));
1109
	sz -= b ;
1162
		sz -= b;
1110
	if ( down != 0 ) off = sz ;
1163
		if (down != 0) {
-
 
1164
			off = sz;
-
 
1165
		}
1111
	instr = ins ( b, ml_mov ) ;
1166
		instr = ins(b, ml_mov);
1112
	switch ( s1 ) {
1167
		switch (s1) {
-
 
1168
		case 0:
1113
	    case 0 : op1 = make_indirect ( r1, off / 8 ) ; break ;
1169
			op1 = make_indirect(r1, off / 8);
-
 
1170
			break;
-
 
1171
		case 2:
1114
	    case 2 : op1 = make_lab_ind ( r1, off / 8 ) ; break ;
1172
			op1 = make_lab_ind(r1, off / 8);
-
 
1173
			break;
-
 
1174
		case 3:
1115
	    case 3 : op1 = operand ( L32, mw ( fe, fof + off ) ) ; break ;
1175
			op1 = operand(L32, mw(fe, fof + off));
-
 
1176
			break;
1116
	    case 4 : {
1177
		case 4:
1117
		op1 = operand ( L32, zw ( sz ? bro ( fe ) : son ( fe ) ) ) ;
1178
			op1 = operand(L32, zw(sz ? bro(fe) : son(fe)));
1118
		break ;
1179
			break;
1119
	    }
-
 
1120
	}
1180
		}
1121
	switch ( s2 ) {
1181
		switch (s2) {
-
 
1182
		case 0:
1122
	    case 0 : op2 = make_indirect ( r2, off / 8 ) ; break ;
1183
			op2 = make_indirect(r2, off / 8);
-
 
1184
			break;
-
 
1185
		case 1:
1123
	    case 1 : op2 = make_dec_sp () ; break ;
1186
			op2 = make_dec_sp();
-
 
1187
			break;
-
 
1188
		case 3:
1124
	    case 3 : op2 = operand ( L32, mw ( te, tof + off ) ) ; break ;
1189
			op2 = operand(L32, mw(te, tof + off));
-
 
1190
			break;
1125
	    case 4 : {
1191
		case 4: {
1126
		op2 = operand ( L32, zw ( sz ? bro ( te ) : son ( te ) ) ) ;
1192
			op2 = operand(L32, zw(sz ? bro(te) : son(te)));
1127
		break ;
1193
			break;
-
 
1194
		}
-
 
1195
		}
-
 
1196
		make_instr(instr, op1, op2, 0);
-
 
1197
		if (s2 == 1) {
-
 
1198
			stack_size -= b;
1128
	    }
1199
		}
-
 
1200
		off += b;
1129
	}
1201
	}
1130
	make_instr ( instr, op1, op2, 0 ) ;
-
 
1131
	if ( s2 == 1 ) stack_size -= b ;
-
 
1132
	off += b ;
-
 
1133
    }
-
 
1134
    have_cond = 0 ;
1202
	have_cond = 0;
1135
    return ;
1203
	return;
1136
}
1204
}
1137
 
1205
 
1138
 
1206
 
1139
/*
1207
/*
1140
    MAIN MOVE ROUTINE
1208
    MAIN MOVE ROUTINE
Line 1142... Line 1210...
1142
    A value of shape sha is moved from from into to.  There are several
1210
    A value of shape sha is moved from from into to.  There are several
1143
    main subcases : floating-point values, values of sizes 8, 16 and 32,
1211
    main subcases : floating-point values, values of sizes 8, 16 and 32,
1144
    and all other cases.
1212
    and all other cases.
1145
*/
1213
*/
1146
 
1214
 
1147
void move
1215
void
1148
    PROTO_N ( ( sha, from, to ) )
-
 
1149
    PROTO_T ( shape sha X where from X where to )
1216
move(shape sha, where from, where to)
1150
{
1217
{
1151
    int instr ;
1218
	int instr;
1152
    long sz = shape_size ( sha ) ;
1219
	long sz = shape_size(sha);
1153
    long rt = shtype ( sha ) ;
1220
	long rt = shtype(sha);
1154
    where from1, from2 ;
1221
	where from1, from2;
1155
 
1222
 
1156
    exp fe = from.wh_exp ;
1223
	exp fe = from.wh_exp;
1157
    exp te = to.wh_exp ;
1224
	exp te = to.wh_exp;
1158
    long fof = from.wh_off ;
1225
	long fof = from.wh_off;
1159
    long tof = to.wh_off ;
1226
	long tof = to.wh_off;
1160
 
1227
 
1161
    long whfrom = whereis ( from ) ;
1228
	long whfrom = whereis(from);
1162
    long whto = whereis ( to ) ;
1229
	long whto = whereis(to);
1163
 
1230
 
1292
	}
1374
	}
1293
	/* Fall through otherwise */
-
 
1294
    }
-
 
1295
 
1375
 
1296
    /* Move things of size 8, 16 or 32 */
1376
	/* Move things of size 8, 16 or 32 */
1297
    if ( sz <= 32 && sz != 24 ) {
1377
	if (sz <= 32 && sz != 24) {
1298
 
-
 
1299
	if ( name ( te ) == apply_tag || name ( te ) == apply_general_tag
1378
		if (name(te) == apply_tag || name(te) == apply_general_tag ||
1300
            || name ( te ) == tail_call_tag ) {
1379
		    name(te) == tail_call_tag) {
1301
	    if ( whfrom == Value ) {
1380
			if (whfrom == Value) {
1302
		mach_op *op1, *op2 ;
1381
				mach_op *op1, *op2;
1303
		long v = nw ( from ) ;
1382
				long v = nw(from);
1304
		if ( is_offset ( from.wh_exp ) ) v /= 8 ;
1383
				if (is_offset(from.wh_exp)) {
-
 
1384
					v /= 8;
-
 
1385
				}
1305
		if ( v == 0 && stack_change == 0 ) {
1386
				if (v == 0 && stack_change == 0) {
1306
		    op1 = make_dec_sp () ;
1387
					op1 = make_dec_sp();
1307
		    make_instr ( m_clrl, op1, null, 0 ) ;
1388
					make_instr(m_clrl, op1, null, 0);
1308
		    have_cond = 0 ;
1389
					have_cond = 0;
1309
		    stack_size -= 32 ;
1390
					stack_size -= 32;
1310
		    return ;
1391
					return;
1311
		}
1392
				}
1312
		if ( v >= -128 && v <= 127 ) {
1393
				if (v >= -128 && v <= 127) {
1313
		    long s = stack_change ;
1394
					long s = stack_change;
1314
		    stack_change = 0 ;
1395
					stack_change = 0;
1315
		    op1 = make_value ( v ) ;
1396
					op1 = make_value(v);
1316
		    op2 = make_register ( REG_D0 ) ;
1397
					op2 = make_register(REG_D0);
1317
		    make_instr ( m_moveq, op1, op2, regmsk ( REG_D0 ) ) ;
1398
					make_instr(m_moveq, op1, op2,
-
 
1399
						   regmsk(REG_D0));
1318
		    stack_change = s ;
1400
					stack_change = s;
1319
		    push ( sha, L32, D0 ) ;
1401
					push(sha, L32, D0);
1320
		    return ;
1402
					return;
1321
		}
1403
				}
1322
		if ( stack_change ) {
1404
				if (stack_change) {
1323
		    push ( sha, L32, from ) ;
1405
					push(sha, L32, from);
1324
		    return ;
1406
					return;
-
 
1407
				}
-
 
1408
				op1 = make_int_data(v);
-
 
1409
				make_instr(m_pea, op1, null, 0);
-
 
1410
				have_cond = 0;
-
 
1411
				stack_size -= 32;
-
 
1412
				return;
-
 
1413
			}
-
 
1414
			push(sha, sz, from);
-
 
1415
			return;
-
 
1416
		}
-
 
1417
 
-
 
1418
		if (name(fe) == null_tag) {
-
 
1419
			move_const(sha, sz, L0, to);
-
 
1420
			return;
-
 
1421
		}
-
 
1422
 
-
 
1423
		if (whfrom == Value) {
-
 
1424
			long v = nw(from);
-
 
1425
			if (is_offset(from.wh_exp)) {
-
 
1426
				v /= 8;
-
 
1427
			}
-
 
1428
			move_const(sha, sz, v, to);
-
 
1429
			return;
-
 
1430
		}
-
 
1431
 
-
 
1432
		if (sz == 8) {
-
 
1433
			if (whfrom == Areg) {
-
 
1434
				move(slongsh, from, D0);
-
 
1435
				move(sha, D0, to);
-
 
1436
				return;
-
 
1437
			}
-
 
1438
			if (whto == Areg) {
-
 
1439
				move(sha, from, D0);
-
 
1440
				move(slongsh, D0, to);
-
 
1441
				return;
-
 
1442
			}
-
 
1443
		}
-
 
1444
 
-
 
1445
		if (whfrom == Other && whto == Other) {
-
 
1446
			move(sha, from, D0);
-
 
1447
			move(sha, D0, to);
-
 
1448
			return;
1325
		}
1449
		}
1326
		op1 = make_int_data ( v ) ;
-
 
1327
		make_instr ( m_pea, op1, null, 0 ) ;
-
 
1328
		have_cond = 0 ;
-
 
1329
		stack_size -= 32 ;
-
 
1330
		return ;
-
 
1331
	    }
-
 
1332
	    push ( sha, sz, from ) ;
-
 
1333
	    return ;
-
 
1334
	}
-
 
1335
 
-
 
1336
	if ( name ( fe ) == null_tag ) {
-
 
1337
	    move_const ( sha, sz, L0, to ) ;
-
 
1338
	    return ;
-
 
1339
	}
-
 
1340
 
-
 
1341
	if ( whfrom == Value ) {
-
 
1342
	    long v = nw ( from ) ;
-
 
1343
	    if ( is_offset ( from.wh_exp ) ) v /= 8 ;
-
 
1344
	    move_const ( sha, sz, v, to ) ;
-
 
1345
	    return ;
-
 
1346
	}
-
 
1347
 
-
 
1348
	if ( sz == 8 ) {
-
 
1349
	    if ( whfrom == Areg ) {
-
 
1350
		move ( slongsh, from, D0 ) ;
-
 
1351
		move ( sha, D0, to ) ;
-
 
1352
		return ;
-
 
1353
	    }
-
 
1354
	    if ( whto == Areg ) {
-
 
1355
		move ( sha, from, D0 ) ;
-
 
1356
		move ( slongsh, D0, to ) ;
-
 
1357
		return ;
-
 
1358
	    }
-
 
1359
	}
-
 
1360
 
-
 
1361
	if ( whfrom == Other && whto == Other ) {
-
 
1362
	    move ( sha, from, D0 ) ;
-
 
1363
	    move ( sha, D0, to ) ;
-
 
1364
	    return ;
-
 
1365
	}
-
 
1366
# if 0
1450
# if 0
1367
	if ((name(sha) == prokhd) && (whfrom == External) && (whto == Dreg)){
1451
		if ((name(sha) == prokhd) && (whfrom == External) &&
-
 
1452
		    (whto == Dreg)) {
1368
	  /* We need the contents of this address */
1453
			/* We need the contents of this address */
1369
	  move(sha,from,A0);
1454
			move(sha,from,A0);
1370
	  move(sha,A0_p,D0);
1455
			move(sha,A0_p,D0);
1371
	  move(sha,D0,to);
1456
			move(sha,D0,to);
1372
	  return;
1457
			return;
1373
	}
1458
		}
1374
#endif
1459
#endif
1375
	instr = ins ( sz, ml_mov ) ;
1460
		instr = ins(sz, ml_mov);
1376
	ins2 ( instr, sz, sz, from, to, 1 ) ;
1461
		ins2(instr, sz, sz, from, to, 1);
1377
	if ( whto == Areg ) {
1462
		if (whto == Areg) {
1378
	    have_cond = 0 ;
1463
			have_cond = 0;
1379
	} else {
1464
		} else {
1380
	    set_cond ( to, sz ) ;
1465
			set_cond(to, sz);
1381
	    if ( whfrom == Dreg || whfrom == Areg ) set_cond_alt ( from ) ;
1466
			if (whfrom == Dreg || whfrom == Areg) {
1382
	}
-
 
1383
	return ;
-
 
1384
    }
-
 
1385
 
-
 
1386
    if ( name ( fe ) == null_tag ) {
-
 
1387
       move_const ( sha, sz, L0, to ) ;
-
 
1388
       return ;
-
 
1389
    }
-
 
1390
 
-
 
1391
    /* Other cases are dealt with by move_bytes */
-
 
1392
    move_bytes ( sz, from, to, 2 ) ;
-
 
1393
    return ;
-
 
1394
}
-
 
1395
 
-
 
1396
 
-
 
1397
/*
-
 
1398
    MOVE ADDRESS ROUTINE
-
 
1399
 
-
 
1400
    The effective address of from is loaded into to.
-
 
1401
*/
-
 
1402
 
-
 
1403
void mova
-
 
1404
    PROTO_N ( ( from, to ) )
-
 
1405
    PROTO_T ( where from X where to )
-
 
1406
{
-
 
1407
    int r ;
-
 
1408
    exp fe = from.wh_exp ;
-
 
1409
    char nf = name ( fe ) ;
-
 
1410
    char nt = name ( to.wh_exp ) ;
-
 
1411
 
-
 
1412
    if ( nf == reff_tag ) {
-
 
1413
	exp s = son ( from.wh_exp ) ;
-
 
1414
	mova ( mw ( s, nw ( from ) ), to ) ;
-
 
1415
	return ;
-
 
1416
    }
-
 
1417
 
-
 
1418
    if ( nt == apply_tag || nt == apply_general_tag || nt == tail_call_tag ) {
-
 
1419
	exp s = son ( from.wh_exp ) ;
-
 
1420
	if ( nf == cont_tag ) {
-
 
1421
	    ins1 ( m_pea, L32, zw ( s ), 0 ) ;
-
 
1422
	} else {
-
 
1423
	    ins1 ( m_pea, L32, from, 0 ) ;
-
 
1424
	}
-
 
1425
	stack_size -= 32 ;
-
 
1426
	have_cond = 0 ;
1467
				set_cond_alt(from);
1427
	return ;
-
 
1428
    }
-
 
1429
 
-
 
1430
    switch ( nf ) {
-
 
1431
	case val_tag : {
-
 
1432
	    move ( slongsh, from, to ) ;
-
 
1433
	    return ;
-
 
1434
	}
1468
			}
1435
 
-
 
1436
	case cont_tag :
-
 
1437
	case ass_tag : {
-
 
1438
	    exp s = son ( from.wh_exp ) ;
-
 
1439
	    if ( from.wh_off == 0 && name ( s ) == name_tag ) {
-
 
1440
		exp ss = son ( s ) ;
-
 
1441
		if ( !isvar ( ss ) && !isglob ( ss ) ) {
-
 
1442
		    move ( slongsh, zw ( s ), to ) ;
-
 
1443
		    return ;
-
 
1444
		}
1469
		}
-
 
1470
		return;
1445
	    }
1471
	}
-
 
1472
 
-
 
1473
	if (name(fe) == null_tag) {
-
 
1474
		move_const(sha, sz, L0, to);
1446
	    break ;
1475
		return;
1447
	}
1476
	}
1448
    }
-
 
1449
 
1477
 
-
 
1478
	/* Other cases are dealt with by move_bytes */
-
 
1479
	move_bytes(sz, from, to, 2);
-
 
1480
	return;
-
 
1481
}
-
 
1482
 
-
 
1483
 
-
 
1484
/*
-
 
1485
    MOVE ADDRESS ROUTINE
-
 
1486
 
-
 
1487
    The effective address of from is loaded into to.
-
 
1488
*/
-
 
1489
 
-
 
1490
void
-
 
1491
mova(where from, where to)
-
 
1492
{
-
 
1493
	int r;
-
 
1494
	exp fe = from.wh_exp;
-
 
1495
	char nf = name(fe);
-
 
1496
	char nt = name(to.wh_exp);
-
 
1497
 
-
 
1498
	if (nf == reff_tag) {
-
 
1499
		exp s = son(from.wh_exp);
-
 
1500
		mova(mw(s, nw(from)), to);
-
 
1501
		return;
-
 
1502
	}
-
 
1503
 
-
 
1504
	if (nt == apply_tag || nt == apply_general_tag ||
-
 
1505
	    nt == tail_call_tag) {
-
 
1506
		exp s = son(from.wh_exp);
-
 
1507
		if (nf == cont_tag) {
-
 
1508
			ins1(m_pea, L32, zw(s), 0);
-
 
1509
		} else {
-
 
1510
			ins1(m_pea, L32, from, 0);
-
 
1511
		}
-
 
1512
		stack_size -= 32;
-
 
1513
		have_cond = 0;
-
 
1514
		return;
-
 
1515
	}
-
 
1516
 
-
 
1517
	switch (nf) {
-
 
1518
	case val_tag:
-
 
1519
		move(slongsh, from, to);
-
 
1520
		return;
-
 
1521
	case cont_tag:
-
 
1522
	case ass_tag: {
-
 
1523
		exp s = son(from.wh_exp);
-
 
1524
		if (from.wh_off == 0 && name(s) == name_tag) {
-
 
1525
			exp ss = son(s);
-
 
1526
			if (!isvar(ss) && !isglob(ss)) {
-
 
1527
				move(slongsh, zw(s), to);
-
 
1528
				return;
-
 
1529
			}
-
 
1530
		}
-
 
1531
		break;
-
 
1532
	}
-
 
1533
	}
-
 
1534
 
1450
    if ( whereis ( to ) == Areg ) {
1535
	if (whereis(to) == Areg) {
1451
/*
1536
		/*
1452
       if (nf == name_tag && isvar (son (fe))) {
1537
		   if (nf == name_tag && isvar (son (fe))) {
1453
          move (slongsh, from, to);
1538
		   	move (slongsh, from, to);
1454
          return;
1539
		   	return;
1455
       }
1540
		   }
1456
*/
1541
		 */
1457
       if (nf == name_tag && !isvar(son(fe)) && ptno(son(fe)) == reg_pl)
1542
		if (nf == name_tag && !isvar(son(fe)) &&
-
 
1543
		    ptno(son(fe)) == reg_pl) {
1458
          add(slongsh, mw(fe, 0), mw(zeroe, from.wh_off/8), to);
1544
			add(slongsh, mw(fe, 0), mw(zeroe, from.wh_off / 8),
-
 
1545
			    to);
1459
       else {
1546
		} else {
1460
          ins2 ( m_lea, L32, L32, from, to, 1 ) ;
1547
			ins2(m_lea, L32, L32, from, to, 1);
1461
          have_cond = 0 ;
1548
			have_cond = 0;
1462
       }
1549
		}
1463
       return ;
1550
		return;
1464
    }
1551
	}
1465
 
1552
 
1466
 
1553
 
1467
    r = next_tmp_reg () ;
1554
	r = next_tmp_reg();
1468
    regsinproc |= regmsk ( r ) ;
1555
	regsinproc |= regmsk(r);
1469
    ins2 ( m_lea, L32, L32, from, register ( r ), 1 ) ;
1556
	ins2(m_lea, L32, L32, from, register(r), 1);
1470
    have_cond = 0 ;
1557
	have_cond = 0;
1471
    tmp_reg_status = 1 ;
1558
	tmp_reg_status = 1;
1472
    move ( slongsh, register ( r ), to ) ;
1559
	move(slongsh, register(r), to);
1473
    return ;
1560
	return;
1474
}
1561
}
1475
 
1562
 
1476
 
1563
 
1477
 
1564
 
1478
long range_max
1565
long
1479
    PROTO_N ( (shp) )
-
 
1480
    PROTO_T ( shape shp )
1566
range_max(shape shp)
1481
{
1567
{
1482
  switch (name(shp)) {
1568
	switch (name(shp)) {
1483
    case scharhd : return 0x7f;
1569
	case scharhd:
-
 
1570
		return 0x7f;
-
 
1571
	case swordhd:
1484
    case swordhd : return 0x7fff;
1572
		return 0x7fff;
-
 
1573
	case slonghd:
1485
    case slonghd : return 0x7fffffff;
1574
		return 0x7fffffff;
1486
    case ucharhd : return 0xff;
1575
	case ucharhd:
-
 
1576
		return 0xff;
-
 
1577
	case uwordhd:
1487
    case uwordhd : return 0xffff;
1578
		return 0xffff;
-
 
1579
	case ulonghd:
1488
    case ulonghd : return 0xffffffff;
1580
		return 0xffffffff;
-
 
1581
	default:
1489
    default : fprintf(stderr,"Illegal shape in comparison");
1582
		fprintf(stderr, "Illegal shape in comparison");
1490
  }
1583
	}
1491
  return 0 ;
1584
	return 0;
1492
}
1585
}
1493
 
1586
 
1494
long range_min
1587
long
1495
    PROTO_N ( (shp) )
-
 
1496
    PROTO_T ( shape shp )
1588
range_min(shape shp)
1497
{
1589
{
1498
  switch (name(shp)) {
1590
	switch (name(shp)) {
-
 
1591
	case scharhd:
1499
    case scharhd : return -0x80;
1592
		return -0x80;
-
 
1593
	case swordhd:
1500
    case swordhd : return -0x8000;
1594
		return -0x8000;
-
 
1595
	case slonghd:
1501
    case slonghd : return -0x80000000;
1596
		return -0x80000000;
-
 
1597
	case ucharhd:
-
 
1598
	case uwordhd:
1502
    case ucharhd : case uwordhd : case ulonghd : return 0;
1599
	case ulonghd:
-
 
1600
		return 0;
-
 
1601
	default:
1503
    default : fprintf(stderr,"Illegal shape in comparison");
1602
		fprintf(stderr, "Illegal shape in comparison");
1504
  }
1603
	}
1505
  return 0 ;
1604
	return 0;
1506
}
1605
}
1507
 
1606
 
1508
 
1607
 
1509
/*
1608
/*
1510
    AUXILIARY CHANGE VARIETY ROUTINE
1609
    AUXILIARY CHANGE VARIETY ROUTINE
1511
 
1610
 
1512
    The value from of shape shf is converted to a value of shape sht and
1611
    The value from of shape shf is converted to a value of shape sht and
1513
    moved into to.
1612
    moved into to.
1688
	}
1797
	}
1689
    }
-
 
1690
 
1798
 
1691
    if ( sgf ) {
1799
	if (sgf) {
1692
	bool d ;
1800
		bool d;
1693
	where dest ;
1801
		where dest;
1694
	if ( wht == Dreg ) {
1802
		if (wht == Dreg) {
1695
	    dest = to ;
1803
			dest = to;
1696
	    move ( shf, from, dest ) ;
1804
			move(shf, from, dest);
1697
	    d = 0 ;
1805
			d = 0;
-
 
1806
		} else {
-
 
1807
			if (whf == Dreg) {
-
 
1808
				/* Extension is non-intrusive */
-
 
1809
				dest = from;
-
 
1810
			} else {
-
 
1811
				dest = D0;
-
 
1812
				move(shf, from, dest);
-
 
1813
			}
-
 
1814
			d = 1;
-
 
1815
		}
-
 
1816
		if (szf == 8) {
-
 
1817
			instr = (szt == 16 ? m_extw : m_extbl);
-
 
1818
		} else {
-
 
1819
			instr = m_extl;
-
 
1820
		}
-
 
1821
		ins1(instr, szt, dest, 1);
-
 
1822
		set_cond(dest, szt);
-
 
1823
		if (d) {
-
 
1824
			move(sht, dest, to);
-
 
1825
		}
1698
	} else {
1826
	} else {
1699
	    if ( whf == Dreg ) {
1827
		if (wht == Dreg) {
1700
		/* Extension is non-intrusive */
1828
			if (eq_where(to, from)) {
-
 
1829
				long v = (szf == 8 ? 0xff : 0xffff);
1701
		dest = from ;
1830
				if (!eq_where(to, D0)) {
-
 
1831
					and(slongsh, mnw(v), to, to);
-
 
1832
				}
1702
	    } else {
1833
				return;
-
 
1834
			}
-
 
1835
		}
1703
		dest = D0 ;
1836
		move(slongsh, zero, D0);
1704
		move ( shf, from, dest ) ;
1837
		move(shf, from, D0);
1705
	    }
1838
		move(sht, D0, to);
1706
	    d = 1 ;
1839
		return;
1707
	}
1840
	}
1708
	if ( szf == 8 ) {
-
 
1709
	    instr = ( szt == 16 ? m_extw : m_extbl ) ;
-
 
1710
	} else {
-
 
1711
	    instr = m_extl ;
-
 
1712
	}
-
 
1713
	ins1 ( instr, szt, dest, 1 ) ;
-
 
1714
	set_cond ( dest, szt ) ;
-
 
1715
	if ( d ) move ( sht, dest, to ) ;
-
 
1716
    } else {
-
 
1717
	if ( wht == Dreg ) {
-
 
1718
	    if ( eq_where ( to, from ) ) {
-
 
1719
		long v = ( szf == 8 ? 0xff : 0xffff ) ;
-
 
1720
		if ( !eq_where ( to, D0 ) ) and ( slongsh, mnw ( v ), to, to ) ;
-
 
1721
		return ;
-
 
1722
	    }
-
 
1723
	}
-
 
1724
	move ( slongsh, zero, D0 ) ;
-
 
1725
	move ( shf, from, D0 ) ;
-
 
1726
	move ( sht, D0, to ) ;
-
 
1727
	return ;
1841
	return;
1728
    }
-
 
1729
    return ;
-
 
1730
}
1842
}
1731
 
1843
 
1732
 
1844
 
1733
/*
1845
/*
1734
    MAIN CHANGE VARIETY ROUTINE
1846
    MAIN CHANGE VARIETY ROUTINE
1735
 
1847
 
1736
    The value from is converted to a value of shape sha and moved into to.
1848
    The value from is converted to a value of shape sha and moved into to.
1737
*/
1849
*/
1738
 
1850
 
1739
void change_var
1851
void
1740
    PROTO_N ( ( sha, from, to ) )
-
 
1741
    PROTO_T ( shape sha X where from X where to )
1852
change_var(shape sha, where from, where to)
1742
{
1853
{
1743
    shape shf = sh ( from.wh_exp ) ;
1854
	shape shf = sh(from.wh_exp);
1744
    change_var_sh ( sha, shf, from, to ) ;
1855
	change_var_sh(sha, shf, from, to);
1745
    return ;
1856
	return;
1746
}
1857
}
1747
 
1858
 
1748
/*
1859
/*
1749
    FIND APPROPRIATE BRANCH INSTRUCTION TYPE
1860
    FIND APPROPRIATE BRANCH INSTRUCTION TYPE
1750
 
1861
 
1751
    This routine returns the appropriate branch instruction for test number
1862
    This routine returns the appropriate branch instruction for test number
1752
    test_no, which should be switched if sw is 0.  sf indicates whether
1863
    test_no, which should be switched if sw is 0.  sf indicates whether
1753
    a floating-point instruction should be used.  If not, sg indicates
1864
    a floating-point instruction should be used.  If not, sg indicates
1754
    whether a signed or unsigned instruction should be used.
1865
    whether a signed or unsigned instruction should be used.
1755
*/
1866
*/
1756
 
1867
 
1757
int branch_ins
1868
int
1758
    PROTO_N ( ( test_no, sw, sg, sf ) )
-
 
1759
    PROTO_T ( long test_no X int sw X int sg X int sf )
1869
branch_ins(long test_no, int sw, int sg, int sf)
1760
{
1870
{
1761
    int r = test_no ;
1871
	int r = test_no;
1762
    if ( !sw ) {
1872
	if (!sw) {
1763
	switch ( r ) {
1873
		switch (r) {
1764
	    case tst_le : r = tst_ge ; break ;
1874
		case tst_le:
-
 
1875
			r = tst_ge;
-
 
1876
			break;
1765
	    case tst_ls : r = tst_gr ; break ;
1877
		case tst_ls:
-
 
1878
			r = tst_gr;
-
 
1879
			break;
1766
	    case tst_ge : r = tst_le ; break ;
1880
		case tst_ge:
1767
	    case tst_gr : r = tst_ls ; break ;
1881
			r = tst_le;
-
 
1882
			break;
1768
	    case tst_ngr : r = tst_nls ; break ;
1883
		case tst_gr:
1769
	    case tst_nge : r = tst_nle ; break ;
1884
			r = tst_ls;
-
 
1885
			break;
1770
	    case tst_nls : r = tst_ngr ; break ;
1886
		case tst_ngr:
1771
	    case tst_nle : r = tst_nge ; break ;
1887
			r = tst_nls;
1772
	}
1888
			break;
1773
    }
1889
		case tst_nge:
1774
    switch ( r ) {
1890
			r = tst_nle;
-
 
1891
			break;
1775
	case tst_eq : {
1892
		case tst_nls:
1776
	    /* Equal */
1893
			r = tst_ngr;
-
 
1894
			break;
-
 
1895
		case tst_nle:
1777
	    return ( sf ? m_fbeq : m_beq ) ;
1896
			r = tst_nge;
-
 
1897
			break;
-
 
1898
		}
1778
	}
1899
	}
-
 
1900
	switch (r) {
-
 
1901
	case tst_eq:
-
 
1902
		/* Equal */
-
 
1903
		return (sf ? m_fbeq : m_beq);
1779
	case tst_neq : {
1904
	case tst_neq:
1780
	    /* Not equal */
1905
		/* Not equal */
1781
	    return ( sf ? m_fbne : m_bne ) ;
1906
		return (sf ? m_fbne : m_bne);
1782
	}
-
 
1783
	case tst_le : {
1907
	case tst_le:
1784
	    /* Less than or equals */
1908
		/* Less than or equals */
1785
	    if ( sf ) return ( m_fble ) ;
1909
		if (sf) {
1786
	    return ( sg ? m_ble : m_bls ) ;
1910
			return (m_fble);
1787
	}
1911
		}
-
 
1912
		return (sg ? m_ble : m_bls);
1788
	case tst_ls : {
1913
	case tst_ls:
1789
	    /* Less than */
1914
		/* Less than */
1790
	    if ( sf ) return ( m_fblt ) ;
1915
		if (sf) {
1791
	    return ( sg ? m_blt : m_bcs ) ;
1916
			return (m_fblt);
1792
	}
1917
		}
-
 
1918
		return (sg ? m_blt : m_bcs);
1793
	case tst_ge : {
1919
	case tst_ge:
1794
	    /* Greater than or equals */
1920
		/* Greater than or equals */
1795
	    if ( sf ) return ( m_fbge ) ;
1921
		if (sf) {
1796
	    return ( sg ? m_bge : m_bcc ) ;
1922
			return (m_fbge);
1797
	}
1923
		}
-
 
1924
		return (sg ? m_bge : m_bcc);
1798
	case tst_gr : {
1925
	case tst_gr:
1799
	    /* Greater than */
1926
		/* Greater than */
1800
	    if ( sf ) return ( m_fbgt ) ;
1927
		if (sf) {
1801
	    return ( sg ? m_bgt : m_bhi ) ;
1928
			return (m_fbgt);
1802
	}
1929
		}
-
 
1930
		return (sg ? m_bgt : m_bhi);
1803
	case tst_ngr : {
1931
	case tst_ngr:
1804
	    /* Not greater than */
1932
		/* Not greater than */
1805
	    if ( sf ) return ( m_fbngt ) ;
1933
		if (sf) {
1806
	    return ( sg ? m_ble : m_bls ) ;
1934
			return (m_fbngt);
1807
	}
1935
		}
-
 
1936
		return (sg ? m_ble : m_bls);
1808
	case tst_nge : {
1937
	case tst_nge:
1809
	    /* Not greater than or equals */
1938
		/* Not greater than or equals */
1810
	    if ( sf ) return ( m_fbnge ) ;
1939
		if (sf) {
1811
	    return ( sg ? m_blt : m_bcs ) ;
1940
			return (m_fbnge);
1812
	}
1941
		}
-
 
1942
		return (sg ? m_blt : m_bcs);
1813
	case tst_nls : {
1943
	case tst_nls:
1814
	    /* Not less than */
1944
		/* Not less than */
1815
	    if ( sf ) return ( m_fbnlt ) ;
1945
		if (sf) {
1816
	    return ( sg ? m_bge : m_bcc ) ;
1946
			return (m_fbnlt);
1817
	}
1947
		}
-
 
1948
		return (sg ? m_bge : m_bcc);
1818
	case tst_nle : {
1949
	case tst_nle:
1819
	    /* Not less than or equals */
1950
		/* Not less than or equals */
-
 
1951
		if (sf) {
1820
	    if ( sf ) return ( m_fbnle ) ;
1952
			return (m_fbnle);
-
 
1953
		}
1821
	    return ( sg ? m_bgt : m_bhi ) ;
1954
		return (sg ? m_bgt : m_bhi);
1822
	}
1955
	}
1823
    }
-
 
1824
    error ( "Illegal test" ) ;
1956
	error("Illegal test");
1825
    return ( m_dont_know ) ;
1957
	return (m_dont_know);
1826
}
1958
}
1827
 
1959
 
1828
 
1960
 
1829
/*
1961
/*
1830
    OUTPUT CONDITIONAL JUMP
1962
    OUTPUT CONDITIONAL JUMP
1831
 
1963
 
1832
    A jump to the label indicated by jr is output.  test_no, sw, sg and sf
1964
    A jump to the label indicated by jr is output.  test_no, sw, sg and sf
1833
    have the same meanings as in branch_ins.
1965
    have the same meanings as in branch_ins.
1834
*/
1966
*/
1835
 
1967
 
1836
void branch
1968
void
1837
    PROTO_N ( ( test_no, jr, sg, sw, sf ) )
-
 
1838
    PROTO_T ( long test_no X exp jr X int sg X int sw X int sf )
1969
branch(long test_no, exp jr, int sg, int sw, int sf)
1839
{
1970
{
1840
    make_jump ( branch_ins ( test_no, sw, sg, sf ), ptno ( jr ) ) ;
1971
	make_jump(branch_ins(test_no, sw, sg, sf), ptno(jr));
1841
    return ;
1972
	return;
1842
}
1973
}