Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
2 7u83 1
/*
7 7u83 2
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
3
 * All rights reserved.
4
 *
5
 * Redistribution and use in source and binary forms, with or without
6
 * modification, are permitted provided that the following conditions are met:
7
 *
8
 * 1. Redistributions of source code must retain the above copyright notice,
9
 *    this list of conditions and the following disclaimer.
10
 * 2. Redistributions in binary form must reproduce the above copyright notice,
11
 *    this list of conditions and the following disclaimer in the documentation
12
 *    and/or other materials provided with the distribution.
13
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
14
 *    may be used to endorse or promote products derived from this software
15
 *    without specific, prior written permission.
16
 *
17
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
18
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
19
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
20
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
21
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
22
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
23
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
24
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
26
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
27
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
 *
29
 * $Id$
30
 */
31
/*
2 7u83 32
    		 Crown Copyright (c) 1996
33
 
34
    This TenDRA(r) Computer Program is subject to Copyright
35
    owned by the United Kingdom Secretary of State for Defence
36
    acting through the Defence Evaluation and Research Agency
37
    (DERA).  It is made available to Recipients with a
38
    royalty-free licence for its use, reproduction, transfer
39
    to other parties and amendment for any purpose not excluding
40
    product development provided that any such use et cetera
41
    shall be deemed to be acceptance of the following conditions:-
42
 
43
        (1) Its Recipients shall ensure that this Notice is
44
        reproduced upon any copies or amended versions of it;
45
 
46
        (2) Any amended version of it shall be clearly marked to
47
        show both the nature of and the organisation responsible
48
        for the relevant amendment or amendments;
49
 
50
        (3) Its onward transfer from a recipient to another
51
        party shall be deemed to be that party's acceptance of
52
        these conditions;
53
 
54
        (4) DERA gives no warranty or assurance as to its
55
        quality or suitability for any purpose and DERA accepts
56
        no liability whatsoever in relation to any use to which
57
        it may be put.
58
*/
59
/*
60
			    VERSION INFORMATION
61
			    ===================
62
 
63
--------------------------------------------------------------------------
64
$Header: /u/g/release/CVSROOT/Source/src/installers/680x0/common/ops_int.c,v 1.1.1.1 1998/01/17 15:55:49 release Exp $
65
--------------------------------------------------------------------------
66
$Log: ops_int.c,v $
67
 * Revision 1.1.1.1  1998/01/17  15:55:49  release
68
 * First version to be checked into rolling release.
69
 *
70
Revision 1.5  1997/11/13 08:27:15  ma
71
All avs test passed (except add_to_ptr).
72
 
73
Revision 1.4  1997/11/10 15:38:07  ma
74
.
75
 
76
Revision 1.3  1997/11/09 14:12:27  ma
77
Fixed max_min & splitted add_const into add_const and sub_const to make
78
error handling work.
79
 
80
Revision 1.2  1997/10/29 10:22:26  ma
81
Replaced use_alloca with has_alloca.
82
 
83
Revision 1.1.1.1  1997/10/13 12:42:56  ma
84
First version.
85
 
86
Revision 1.6  1997/10/13 08:49:47  ma
87
Made all pl_tests for general proc & exception handling pass.
88
 
89
Revision 1.5  1997/09/25 06:45:24  ma
90
All general_proc tests passed
91
 
92
Revision 1.4  1997/06/24 10:56:06  ma
93
Added changes for "Plumhall Patch"
94
 
95
Revision 1.3  1997/06/18 10:09:42  ma
96
Checking in before merging with Input Baseline changes.
97
 
98
Revision 1.2  1997/04/20 11:30:34  ma
99
Introduced gcproc.c & general_proc.[ch].
100
Added cases for apply_general_proc next to apply_proc in all files.
101
 
102
Revision 1.1.1.1  1997/03/14 07:50:16  ma
103
Imported from DRA
104
 
105
 * Revision 1.1.1.1  1996/09/20  10:56:57  john
106
 *
107
 * Revision 1.3  1996/07/30  16:31:23  john
108
 * Removed offset conversion
109
 *
110
 * Revision 1.2  1996/07/05  14:24:16  john
111
 * Changes for spec 3.1
112
 *
113
 * Revision 1.1.1.1  1996/03/26  15:45:15  john
114
 *
115
 * Revision 1.7  94/11/16  10:37:25  10:37:25  ra (Robert Andrews)
116
 * Added support for integer absolute.
117
 *
118
 * Revision 1.6  94/11/08  11:23:45  11:23:45  ra (Robert Andrews)
119
 * The operations addq and subq on A-registers do not set the condition
120
 * flags.
121
 *
122
 * Revision 1.5  94/06/29  14:23:27  14:23:27  ra (Robert Andrews)
123
 * Added maximum and minimum operations.
124
 *
125
 * Revision 1.4  94/02/21  16:01:29  16:01:29  ra (Robert Andrews)
126
 * Made a couple of integer literals into longs.
127
 *
128
 * Revision 1.3  93/04/19  13:35:28  13:35:28  ra (Robert Andrews)
129
 * Change_varieties in division routines were the wrong way round.
130
 *
131
 * Revision 1.2  93/03/03  14:49:05  14:49:05  ra (Robert Andrews)
132
 * Started adding support for error treatments.
133
 *
134
 * Revision 1.1  93/02/22  17:16:20  17:16:20  ra (Robert Andrews)
135
 * Initial revision
136
 *
137
--------------------------------------------------------------------------
138
*/
139
 
140
 
141
#include "config.h"
142
#include "common_types.h"
143
#include "assembler.h"
144
#include "basicread.h"
145
#include "check.h"
146
#include "exp.h"
147
#include "expmacs.h"
148
#include "externs.h"
149
#include "install_fns.h"
150
#include "shapemacs.h"
151
#include "tags.h"
152
#include "mach.h"
153
#include "mach_ins.h"
154
#include "where.h"
155
#include "mach_op.h"
156
#include "instr.h"
157
#include "codex.h"
158
#include "instrs.h"
159
#include "coder.h"
160
#include "tests.h"
161
#include "operations.h"
162
#include "evaluate.h"
163
#include "utility.h"
164
#include "translate.h"
165
#include "ops_shared.h"
7 7u83 166
extern void add_const(shape, long, where);
2 7u83 167
 
168
/*
169
    DO AN ADD BY A LOAD EFFECTIVE ADDRESS
170
 
171
    The m_lea instruction is used to add the constant offset to the value
172
    a and put the result into dest.  The flag psh is true to indicate
173
    that the result should be pushed onto the stack.
174
*/
175
 
176
void load_ea
7 7u83 177
(shape sha, long offset, where a, where dest, bool psh)
2 7u83 178
{
7 7u83 179
    if (have_overflow()) {
180
	move(sha, a, D0);
181
	add_const(sha, offset, D0);
182
	move(sha, D0, dest);
183
	have_cond = 0;
2 7u83 184
    } else {
7 7u83 185
	exp ra = simple_exp(dummy_tag);
186
	son(ra) = a.wh_exp;
187
	no(ra) = 8 * offset;
188
	if (psh) {
189
	    ins1(m_pea, L32, zw(ra), 0);
190
	    stack_size -= 32;
2 7u83 191
	} else {
7 7u83 192
	    ins2(m_lea, L32, L32, zw(ra), dest, 1);
2 7u83 193
	}
7 7u83 194
	retcell(ra);
195
	have_cond = 0;
2 7u83 196
    }
7 7u83 197
    return;
2 7u83 198
}
199
 
200
 
201
/*
202
    INCREASE BY A CONSTANT
203
 
204
    The value dest is increased or decreased by the constant n.
205
*/
206
 
207
void addsub_const
7 7u83 208
(shape sha, long n, where dest, bool use_sub)
2 7u83 209
{
7 7u83 210
    int instr;
211
    bool negate = 0, use_quick = 0;
2 7u83 212
 
7 7u83 213
    long sz = shape_size(sha);
214
    if (n == 0) return;
2 7u83 215
 
216
    /* If destination is a value we just have to test for overflow */
217
 
7 7u83 218
    if (whereis(dest) == Value) {
219
       long v = nw(dest);
220
       if (is_signed(sha)) {
221
          if (use_sub)
222
             n = -n;
2 7u83 223
          if (v>0 && n>0) {
224
             if (v > range_max(sha) - n)
7 7u83 225
                test_overflow(UNCONDITIONAL);
2 7u83 226
          }
227
          else if (v<0 && n<0) {
228
             if (v < range_min(sha) - n)
7 7u83 229
                test_overflow(UNCONDITIONAL);
2 7u83 230
          }
231
       }
232
       else { /* unsigned addition */
233
          if (use_sub) {
234
             /* will v - n underflow ? */
7 7u83 235
             if ((unsigned)v < (unsigned)range_min(sha) - (unsigned)n)
236
                test_overflow(UNCONDITIONAL);
2 7u83 237
          }
238
          else {
7 7u83 239
             if ((unsigned)v > (unsigned)range_max(sha) - (unsigned)n)
240
                test_overflow(UNCONDITIONAL);
2 7u83 241
          }
242
       }
7 7u83 243
       return;
2 7u83 244
    }
245
 
246
 
247
    /* Destination is not just a value */
248
 
249
    /* If we don't have to test for overflow, we can chose wheter to add/sub */
250
    /* Changeing add and sub might allow us to use quick add or sub */
7 7u83 251
    if (! have_overflow()) {
2 7u83 252
       /* But -(INT_MIN) can't be represented in signed shape */
253
       if (n != INT_MIN) {
254
          if (n < 0)
7 7u83 255
             negate = 1;
2 7u83 256
          if ((n < 8) && (n > -8))
7 7u83 257
             use_quick = 1;
2 7u83 258
       }
259
    }
260
    else {
261
       if ((unsigned long)n < 8)
7 7u83 262
          use_quick = 1;
2 7u83 263
    }
264
 
265
    /* Special handling for address regs. */
7 7u83 266
    if (whereis(dest) == Areg) {
2 7u83 267
       if (use_quick) {
7 7u83 268
          have_cond = 0;
2 7u83 269
       }
270
       else {
271
          if (use_sub)
7 7u83 272
             n = -n;
273
          load_ea(sha, n, dest, dest, 0);
274
          return;
2 7u83 275
       }
276
    }
277
 
278
    /* Find appropriate ADD/SUB */
279
    if (negate) {
7 7u83 280
       n = -n;
281
       use_sub = ! use_sub;
2 7u83 282
    }
283
 
284
    if (use_sub) {
285
       if (use_quick)
7 7u83 286
          instr = ins(sz, ml_subq);
2 7u83 287
       else
7 7u83 288
          instr = ins(sz, ml_sub);
2 7u83 289
    }
290
    else {
291
       if (use_quick)
7 7u83 292
          instr = ins(sz, ml_addq);
2 7u83 293
       else
7 7u83 294
          instr = ins(sz, ml_add);
2 7u83 295
    }
296
 
7 7u83 297
    ins2n(instr, n, sz, dest, 1);
298
    set_cond(dest, sz);
299
    test_overflow(ON_SHAPE(sha));
2 7u83 300
}
301
 
302
void add_const
7 7u83 303
(shape sha, long n, where dest)
2 7u83 304
{
7 7u83 305
   addsub_const(sha, n, dest, 0);
2 7u83 306
}
307
 
308
void sub_const
7 7u83 309
(shape sha, long n, where dest)
2 7u83 310
{
7 7u83 311
   addsub_const(sha, n, dest, 1);
2 7u83 312
}
313
 
314
/*
315
    AUXILIARY ADD ROUTINE
316
 
317
    The value inc (of shape sha and size sz) is added to dest.
318
*/
319
 
320
static void add_aux
7 7u83 321
(shape sha, long sz, where inc, where dest)
2 7u83 322
{
7 7u83 323
    int instr;
324
    long whi = whereis(inc);
325
    long whd = whereis(dest);
326
    if (whd == Freg) {
327
	move(sha, dest, D0);
328
	add_aux(sha, sz, inc, D0);
329
	move(sha, D0, dest);
330
	return;
2 7u83 331
    }
7 7u83 332
    if (whi == Value) {
333
	long v = nw(inc);
334
	if (is_offset(inc.wh_exp))v /= 8;
335
	add_const(sha, v, dest);
336
	return;
2 7u83 337
    }
7 7u83 338
    if (whi == Freg) {
339
	move(sha, inc, D0);
340
	add_aux(sha, sz, D0, dest);
341
	return;
2 7u83 342
    }
343
 
7 7u83 344
    if (have_overflow() && whd == Areg) {
2 7u83 345
	/* Skip to end */
7 7u83 346
    } else if (whi == Dreg || whd == Dreg || whd == Areg) {
347
	instr = ins(sz, ml_add);
348
	ins2(instr, sz, sz, inc, dest, 1);
349
	if (whd == Areg) {
350
	    have_cond = 0;
2 7u83 351
	} else {
7 7u83 352
	    set_cond(dest, sz);
2 7u83 353
	}
7 7u83 354
        test_overflow(ON_SHAPE(sha));
355
	return;
2 7u83 356
    }
7 7u83 357
    move(sha, inc, D0);
358
    add_aux(sha, sz, D0, dest);
359
    return;
2 7u83 360
}
361
 
362
 
363
/*
364
    ADD CONSTANT ROUTINE
365
 
366
    The constant c is added to the value inc, and the result is stored
367
    in dest.
368
*/
369
 
370
static void addsub_const_3_args
7 7u83 371
(shape sha, long sz, long c, where inc, where dest, bool use_sub)
2 7u83 372
{
7 7u83 373
    if (c == 0) {
374
	move(sha, inc, dest);
375
	return;
2 7u83 376
    }
7 7u83 377
    switch (whereis(dest)) {
378
	case Dreg: {
379
	    move(sha, inc, dest);
380
	    addsub_const(sha, c, dest, use_sub);
381
	    return;
2 7u83 382
	}
7 7u83 383
	case Areg: {
384
	    if (whereis(inc) == Areg) {
385
		load_ea(sha, c, inc, dest, 0);
386
		return;
2 7u83 387
	    }
7 7u83 388
	    move(sha, inc, dest);
389
	    addsub_const(sha, c, dest, use_sub);
390
	    return;
2 7u83 391
	}
392
	default : {
7 7u83 393
	    long whi = whereis(inc);
394
	    if (whi == Dreg && last_use(inc)) {
395
		addsub_const(sha, c, inc, use_sub);
396
		move(sha, inc, dest);
397
		set_cond(dest, sz);
398
		return;
2 7u83 399
	    }
7 7u83 400
	    if (whi == Areg && (  name(dest.wh_exp) == apply_tag
401
                                 || name(dest.wh_exp) == apply_general_tag
402
                                 || name(dest.wh_exp) == tail_call_tag)) {
403
		load_ea(sha, c, inc, dest, 1);
404
		return;
2 7u83 405
	    }
7 7u83 406
	    addsub_const_3_args(sha, sz, c, inc, D0, use_sub);
407
	    move(sha, D0, dest);
408
	    set_cond(dest, sz);
409
	    return;
2 7u83 410
	}
411
    }
412
}
413
 
414
 
415
/*
416
    MAIN ADD ROUTINE
417
 
418
    The values a1 and a2 of shape sha are added and the result stored in
419
    dest.
420
*/
421
 
422
void add
7 7u83 423
(shape sha, where a1, where a2, where dest)
2 7u83 424
{
7 7u83 425
    long sz = shape_size(sha);
426
    long rt = shtype(sha);
427
    long wh1, wh2, whd;
2 7u83 428
 
7 7u83 429
    if (rt == Freg) {
430
	fl_binop(fplus_tag, sha, a1, a2, dest);
431
	return;
2 7u83 432
    }
433
 
7 7u83 434
    if (eq_where(a1, dest)) {
435
	add_aux(sha, sz, a2, dest);
436
	return;
2 7u83 437
    }
438
 
7 7u83 439
    if (eq_where(a2, dest)) {
440
	add_aux(sha, sz, a1, dest);
441
	return;
2 7u83 442
    }
443
 
7 7u83 444
    wh1 = whereis(a1);
445
    wh2 = whereis(a2);
446
    whd = whereis(dest);
2 7u83 447
 
7 7u83 448
    if (wh1 == Value) {
449
	long v1 = nw(a1);
450
	if (is_offset(a1.wh_exp))v1 /= 8;
451
	if (wh2 == Value && !have_overflow()) {
452
	    long v2 = nw(a2);
453
	    if (is_offset(a2.wh_exp))v2 /= 8;
454
	    move(sha, mnw(v1 + v2), dest);
455
	    return;
2 7u83 456
	}
7 7u83 457
	addsub_const_3_args(sha, sz, v1, a2, dest, 0);
458
	return;
2 7u83 459
    }
460
 
7 7u83 461
    if (wh2 == Value) {
462
	long v2 = nw(a2);
463
	if (is_offset(a2.wh_exp))v2 /= 8;
464
	addsub_const_3_args(sha, sz, v2, a1, dest, 0);
465
	return;
2 7u83 466
    }
467
 
7 7u83 468
    if (whd == Dreg) {
469
	if (!interfere(a2, dest)) {
470
	    move(sha, a1, dest);
471
	    add_aux(sha, sz, a2, dest);
472
	    return;
2 7u83 473
	}
7 7u83 474
	if (!interfere(a1, dest)) {
475
	    move(sha, a2, dest);
476
	    add_aux(sha, sz, a1, dest);
477
	    return;
2 7u83 478
	}
479
    }
480
 
7 7u83 481
    if (wh1 == Dreg && last_use(a1)) {
482
	add_aux(sha, sz, a2, a1);
483
	move(sha, a1, dest);
484
	set_cond(dest, sz);
485
	return;
2 7u83 486
    }
487
 
7 7u83 488
    if (wh2 == Dreg && last_use(a2)) {
489
	add_aux(sha, sz, a1, a2);
490
	move(sha, a2, dest);
491
	set_cond(dest, sz);
492
	return;
2 7u83 493
    }
494
 
7 7u83 495
    if (wh1 == Dreg) {
496
	move(sha, a2, D0);
497
	add_aux(sha, sz, a1, D0);
2 7u83 498
    } else {
7 7u83 499
	move(sha, a1, D0);
500
	add_aux(sha, sz, a2, D0);
2 7u83 501
    }
7 7u83 502
    move(sha, D0, dest);
503
    set_cond(dest, sz);
504
    return;
2 7u83 505
}
506
 
507
 
508
/*
509
    AUXILIARY SUBTRACT ROUTINE
510
 
511
    The value a is subtracted from dest.
512
*/
513
 
514
static void sub_aux
7 7u83 515
(shape sha, long sz, where a, where dest)
2 7u83 516
{
7 7u83 517
    long wha = whereis(a);
518
    long whd = whereis(dest);
519
    if (whd == Freg) {
520
	move(sha, dest, D0);
521
	sub_aux(sha, sz, a, D0);
522
	move(sha, D0, dest);
523
	return;
2 7u83 524
    }
525
 
7 7u83 526
    if (wha == Value) {
527
	long v = nw(a);
528
	if (is_offset(a.wh_exp))v /= 8;
529
	sub_const(sha, v, dest);
530
	return;
2 7u83 531
    }
532
 
7 7u83 533
    if (wha != Freg) {
534
	if (have_overflow() && whd == Areg) {
2 7u83 535
	    /* Skip to end */
7 7u83 536
	} else if (whd == Dreg || whd == Areg || wha == Dreg) {
537
	    int instr = ins(sz, ml_sub);
538
	    ins2(instr, sz, sz, a, dest, 1);
539
	    if (whd == Areg) {
540
		have_cond = 0;
2 7u83 541
	    } else {
7 7u83 542
		set_cond(dest, sz);
2 7u83 543
	    }
7 7u83 544
            test_overflow(ON_SHAPE(sha));
545
	    return;
2 7u83 546
	}
547
    }
7 7u83 548
    move(sha, a, D0);
549
    sub_aux(sha, sz, D0, dest);
550
    set_cond(dest, sz);
551
    return;
2 7u83 552
}
553
 
554
 
555
/*
556
    MAIN SUBTRACT ROUTINE
557
 
558
    The value a2 of shape sha is subtracted from a1 and the result is
559
    stored in dest.
560
*/
561
 
562
void sub
7 7u83 563
(shape sha, where a1, where a2, where dest)
2 7u83 564
{
7 7u83 565
    long sz = shape_size(sha);
566
    long wh1, wh2, whd;
2 7u83 567
 
7 7u83 568
    if (eq_where(a1, a2)) {
569
	move(sha, zero, dest);
570
	return;
2 7u83 571
    }
572
 
7 7u83 573
    if (eq_where(a2, dest) && !eq_where(dest,zero)) {
574
	sub_aux(sha, sz, a1, dest);
575
	return;
2 7u83 576
    }
577
 
7 7u83 578
    wh1 = whereis(a1);
579
    wh2 = whereis(a2);
580
    whd = whereis(dest);
2 7u83 581
 
7 7u83 582
    if (wh1 == Value) {
583
	long v1 = nw(a1);
584
	if (is_offset(a1.wh_exp))v1 /= 8;
585
	if (wh2 == Value) {
586
	    long v2 = nw(a2);
587
	    if (is_offset(a2.wh_exp))v2 /= 8;
2 7u83 588
 
7 7u83 589
            if (is_signed(sha)) {
2 7u83 590
               if (v2>0 && v1<0) {
591
                  if (-v1 > range_max(sha) - v2)
7 7u83 592
                  test_overflow(UNCONDITIONAL);
2 7u83 593
               }
594
               else if (v2<0 && v1>0) {
7 7u83 595
                  if (v2 < range_min(sha) + v1)
596
                  test_overflow(UNCONDITIONAL);
2 7u83 597
               }
598
            }
599
            else {
7 7u83 600
               if ((unsigned)v1> (unsigned)v2)
601
               test_overflow(UNCONDITIONAL);
2 7u83 602
            }
603
 
7 7u83 604
	    move(sha, mnw(v2 - v1), dest);
605
	    return;
2 7u83 606
	}
7 7u83 607
	addsub_const_3_args(sha, sz, v1, a2, dest, 1);
608
	return;
2 7u83 609
    }
610
 
7 7u83 611
    if (wh2 == Value && nw(a2) == 0) {
612
	negate(sha, a1, dest);
613
	return;
2 7u83 614
    }
615
 
7 7u83 616
    if ((whd == Dreg || whd == Areg) && !interfere(a1, dest)) {
617
	move(sha, a2, dest);
618
	sub_aux(sha, sz, a1, dest);
619
	return;
2 7u83 620
    }
621
 
7 7u83 622
    move(sha, a2, D0);
623
    sub_aux(sha, sz, a1, D0);
624
    move(sha, D0, dest);
625
    set_cond(dest, sz);
626
    return;
2 7u83 627
}
628
 
629
 
630
/*
631
    NEGATE ROUTINE
632
 
633
    The value a of shape sha is negated and the result is stored in dest.
634
*/
635
 
636
void negate
7 7u83 637
(shape sha, where a, where dest)
2 7u83 638
{
7 7u83 639
    int instr;
640
    long sz = shape_size(sha);
641
    long rt = shtype(sha);
642
    long wha = whereis(a);
643
    long whd = whereis(dest);
2 7u83 644
 
7 7u83 645
    if (rt == Freg) {
646
	negate_float(sha, a, dest);
647
	return;
2 7u83 648
    }
649
 
7 7u83 650
    if (wha == Value) {
651
	long c = nw(a);
652
        bool overflow = 0;
2 7u83 653
 
7 7u83 654
	if (is_offset(a.wh_exp))c /= 8;
2 7u83 655
 
7 7u83 656
        if (is_signed(sha)) {
2 7u83 657
           if (c < - range_max(sha))
7 7u83 658
           overflow = 1;
2 7u83 659
        }
660
        else {
7 7u83 661
           if (c != 0) {
2 7u83 662
              make_comment("negation of unsigned shape");
7 7u83 663
              overflow = 1;
2 7u83 664
           }
665
        }
666
 
667
        /* If there is overflow and we have an error treatment, do it */
7 7u83 668
        if (overflow && have_overflow()) {
669
           test_overflow(UNCONDITIONAL);
2 7u83 670
        }
671
        /* No, so move the value in place */
672
        else {
7 7u83 673
           move(sha, mnw(-c), dest);
2 7u83 674
        }
675
 
7 7u83 676
	return;
2 7u83 677
    }
678
 
7 7u83 679
    if (eq_where(a, dest) && whd != Areg) {
680
	instr = ins(sz, ml_neg);
681
	ins1(instr, sz, dest, 1);
682
	set_cond(dest, sz);
683
        test_overflow(ON_SHAPE(sha));
2 7u83 684
 
7 7u83 685
	return;
2 7u83 686
    }
687
 
7 7u83 688
    if (whd == Dreg) {
689
	move(sha, a, dest);
690
	negate(sha, dest, dest);
691
	return;
2 7u83 692
    }
693
 
7 7u83 694
    if (wha == Dreg && last_use(a)) {
695
	negate(sha, a, a);
696
	move(sha, a, dest);
697
	return;
2 7u83 698
    }
699
 
7 7u83 700
    move(sha, a, D0);
701
    negate(sha, D0, D0);
702
    move(sha, D0, dest);
703
    return;
2 7u83 704
}
705
 
706
 
707
/*
708
    AUXILIARY MULTIPLY ROUTINE
709
 
710
    The value dest of shape sha is multiplied by a.
711
*/
712
 
713
static void mult_aux
7 7u83 714
(shape sha, where a, where dest)
2 7u83 715
{
7 7u83 716
    bool sg = is_signed(sha);
717
    long sz = shape_size(sha);
718
    int instr = (sg ? m_mulsl : m_mulul);
719
    shape lsha = (sg ? slongsh : ulongsh);
2 7u83 720
 
7 7u83 721
    if (whereis(a) == Freg) {
722
	move(sha, a, D0);
723
	mult_aux(sha, D0, dest);
724
	return;
2 7u83 725
    }
726
 
7 7u83 727
    if (sz == 8 || (have_overflow() && (sz == 16))) {
728
	change_var_sh(lsha, sha, dest, dest);
729
	change_var_sh(lsha, sha, a, D0);
730
	ins2(instr, L32, L32, dest, D0, 1);
731
        test_overflow(ON_OVERFLOW);
732
	change_var_sh(sha, lsha, D0, dest);
733
	set_cond(dest, sz);
734
	return;
2 7u83 735
    }
736
 
7 7u83 737
    if (sz == 16)instr = (sg ? m_mulsw : m_muluw);
2 7u83 738
 
7 7u83 739
    if (whereis(dest) == Dreg) {
740
	if (whereis(a) == Areg) {
741
	    if (eq_where(dest, D0)) {
742
		move(sha, a, D1);
743
		regsinproc |= regmsk(REG_D1);
744
		ins2(instr, sz, sz, D1, dest, 1);
2 7u83 745
	    } else {
7 7u83 746
		move(sha, a, D0);
747
		ins2(instr, sz, sz, D0, dest, 1);
2 7u83 748
	    }
749
	} else {
7 7u83 750
	    ins2(instr, sz, sz, a, dest, 1);
2 7u83 751
	}
7 7u83 752
        test_overflow(ON_OVERFLOW);
753
	set_cond(dest, sz);
754
	return;
2 7u83 755
    }
756
 
7 7u83 757
    move(sha, dest, D0);
758
    if (whereis(a) == Areg) {
759
	move(sha, a, D1);
760
	regsinproc |= regmsk(REG_D1);
761
	ins2(instr, sz, sz, D1, D0, 1);
2 7u83 762
    } else {
7 7u83 763
	ins2(instr, sz, sz, a, D0, 1);
2 7u83 764
    }
7 7u83 765
    test_overflow(ON_OVERFLOW);
766
    move(sha, D0, dest);
767
    set_cond(dest, sz);
768
    return;
2 7u83 769
}
770
 
771
 
772
/*
773
    MULTIPLY USING LOAD EFFECTIVE ADDRESS
774
 
775
    The m_lea instruction is used to multiply a by the constant sf + 1
776
    where sf is 1, 2, 4 or 8.  If d is true then a further add instruction
777
    is used to multiply further by 2.  The result is stored in dest.
778
    This routine only applies to values of size 32.
779
*/
780
 
781
static void mult_clever
7 7u83 782
(where a, where dest, long sf, bool d)
2 7u83 783
{
7 7u83 784
    int r;
785
    where ar;
786
    mach_op *op1, *op2;
787
    if (whereis(dest) == Areg) {
788
	ar = dest;
789
	r = reg(dest.wh_regs);
2 7u83 790
    } else {
7 7u83 791
	r = next_tmp_reg();
792
	regsinproc |= regmsk(r);
793
	ar = register(r);
2 7u83 794
    }
7 7u83 795
    move(slongsh, a, ar);
796
    op1 = make_reg_index(r, r, 0, sf);
797
    op2 = make_register(r);
798
    make_instr(m_lea, op1, op2, regmsk(r));
799
    have_cond = 0;
800
    if (d) {
801
	op1 = make_register(r);
802
	op2 = make_register(r);
803
	make_instr(m_addl, op1, op2, regmsk(r));
2 7u83 804
    }
7 7u83 805
    tmp_reg_status = 1;
806
    move(slongsh, ar, dest);
807
    return;
2 7u83 808
}
809
 
810
 
811
/*
812
    MULTIPLY A REGISTER BY A POWER OF 2
813
 
814
    The register r is multiplied by 2 to the power of p.  The flag
815
    D1_used is passed on to shift_aux if necessary.
816
*/
817
 
818
static void mult_power2
7 7u83 819
(long p, where r, bool D1_used)
2 7u83 820
{
7 7u83 821
    switch (p) {
822
	case 0: return;
823
	case 1: ins2(m_addl, L32, L32, r, r, 1); return;
2 7u83 824
	default : {
7 7u83 825
	    shift_aux(slongsh, mnw(p), r, r, 0, D1_used);
826
	    return;
2 7u83 827
	}
828
    }
829
}
830
 
831
 
832
/*
833
    MULTIPLICATION UTILITY ROUTINE
834
 
835
    This routine is used by mult_const.  The values r1 and r2 represent
836
    registers.  If P denotes 2 to the power of p and Q denotes 2 to the
837
    power of q then :
838
 
839
	(a)  If first_time is true, then q will be zero and r2 will hold
840
	     the same value as r1.  r1 is multiplied by P - 1.
841
 
842
	(b)  Otherwise, r1 is set equal to ( P * Q * r1 + ( P - 1 ) * r2 ).
843
 
844
    The flag D1_used is passed onto mult_power2 if necessary.
845
*/
846
 
847
static void mult_utility
7 7u83 848
(long p, long q, where r1, where r2, bool D1_used, bool first_time)
2 7u83 849
{
7 7u83 850
    if (first_time) {
851
	switch (p) {
2 7u83 852
 
853
	    case 0 : return ;		/* Doesn't occur */
854
	    case 1 : return ;		/* Multiply by one */
855
 
7 7u83 856
	    case 2: {
2 7u83 857
		/* Multiply by 3 */
7 7u83 858
		ins2(m_addl, L32, L32, r1, r1, 1);
859
		ins2(m_addl, L32, L32, r2, r1, 1);
860
		return;
2 7u83 861
	    }
862
 
863
	    default : {
7 7u83 864
		mult_power2(p, r1, D1_used);
865
		ins2(m_subl, L32, L32, r2, r1, 1);
866
		return;
2 7u83 867
	    }
868
	}
869
    } else {
7 7u83 870
	switch (p) {
2 7u83 871
 
7 7u83 872
	    case 0: {
2 7u83 873
		/* P = 1 => r1 = ( Q * r1 ) */
7 7u83 874
		mult_power2(q, r1, D1_used);
875
		return;
2 7u83 876
	    }
877
 
7 7u83 878
	    case 1: {
2 7u83 879
		/* P = 2 => r1 = ( 2 * Q * r1 + r2 ) */
7 7u83 880
		mult_power2(q + 1, r1, D1_used);
881
		ins2(m_addl, L32, L32, r2, r1, 1);
882
		return;
2 7u83 883
	    }
884
 
7 7u83 885
	    case 2: {
2 7u83 886
		/* P = 4 => r1 = ( 4 * Q * r1 + 3 * r2 ) */
7 7u83 887
		mult_power2(q + 1, r1, D1_used);
888
		ins2(m_addl, L32, L32, r2, r1, 1);
889
		ins2(m_addl, L32, L32, r1, r1, 1);
890
		ins2(m_addl, L32, L32, r2, r1, 1);
891
		return;
2 7u83 892
	    }
893
 
894
	    default : {
7 7u83 895
		mult_power2(q, r1, D1_used);
896
		ins2(m_addl, L32, L32, r2, r1, 1);
897
		mult_power2(p, r1, D1_used);
898
		ins2(m_subl, L32, L32, r2, r1, 1);
899
		return;
2 7u83 900
	    }
901
	}
902
    }
903
}
904
 
905
 
906
/*
907
    MULTIPLY BY A CONSTANT
908
 
909
    The value a1 of shape sha is multiplied by the constant value a2
910
    and the result is stored in dest.  All constant multiplications
911
    are done by means of shifts, adds and subtracts.  Certain small
912
    cases and powers of 2 are dealt with separately.  The main algorithm
913
    is to split the constant into sections of the form 00...0011...11.
914
*/
915
 
916
static void mult_const
7 7u83 917
(shape sha, where a1, where a2, where dest)
2 7u83 918
{
7 7u83 919
    long n = nw(a2), m, p, q, n0;
920
    where reg1, reg2;
921
    bool D1_used, dont_move = 0;
922
    bool started = 0, first_time = 1;
2 7u83 923
 
7 7u83 924
    long sz = shape_size(sha);
2 7u83 925
 
7 7u83 926
    long wh1 = whereis(a1);
927
    long whd = whereis(dest);
2 7u83 928
 
7 7u83 929
    if (is_offset(a2.wh_exp))n /= 8;
930
    switch (n) {
2 7u83 931
 
7 7u83 932
	case 0: {
2 7u83 933
	    /* Multiply by zero = Load zero */
7 7u83 934
	    move(sha, zero, dest);
935
	    return;
2 7u83 936
	}
937
 
7 7u83 938
	case 1: {
2 7u83 939
	    /* Multiply by one = Move */
7 7u83 940
	    move(sha, a1, dest);
941
	    return;
2 7u83 942
	}
943
 
7 7u83 944
	case -1: {
2 7u83 945
	    /* Multiply by minus one = Negate */
7 7u83 946
	    negate(sha, a1, dest);
947
	    return;
2 7u83 948
	}
949
 
7 7u83 950
	case 2: {
2 7u83 951
	    /* Multiply by two = Add */
7 7u83 952
	    add(sha, a1, a1, dest);
953
	    return;
2 7u83 954
	}
955
 
7 7u83 956
	case 5: {
957
	    if (sz == 32) {
958
		mult_clever(a1, dest, L4, 0);
959
		return;
2 7u83 960
	    }
7 7u83 961
	    break;
2 7u83 962
	}
963
 
7 7u83 964
	case 9: {
965
	    if (sz == 32) {
966
		mult_clever(a1, dest, L8, 0);
967
		return;
2 7u83 968
	    }
7 7u83 969
	    break;
2 7u83 970
	}
971
 
7 7u83 972
	case 10: {
973
	    if (sz == 32) {
974
		mult_clever(a1, dest, L4, 1);
975
		return;
2 7u83 976
	    }
7 7u83 977
	    break;
2 7u83 978
	}
979
 
7 7u83 980
	case 18: {
981
	    if (sz == 32) {
982
		mult_clever(a1, dest, L8, 1);
983
		return;
2 7u83 984
	    }
7 7u83 985
	    break;
2 7u83 986
	}
987
    }
988
 
989
    /* Find two registers */
7 7u83 990
    if (whd == Dreg && !eq_where(dest, D0)) {
991
	reg1 = dest;
992
	reg2 = D0;
993
	D1_used = 0;
2 7u83 994
    } else {
7 7u83 995
	reg1 = D0;
996
	reg2 = D1;
997
	D1_used = 1;
2 7u83 998
    }
7 7u83 999
    if (wh1 == Dreg && !eq_where(a1, reg1)) {
1000
	reg2 = a1;
1001
	D1_used = 0;
1002
	dont_move = 1;
2 7u83 1003
    }
1004
 
1005
    /* Deal with multiplications of less than 32 bits */
7 7u83 1006
    if (sz < 32) {
1007
	shape lsha = (is_signed(sha)? slongsh : ulongsh);
1008
	change_var_sh(lsha, sha, a1, reg1);
1009
    	mult_const(lsha, reg1, a2, reg1);
1010
	change_var_sh(sha, lsha, reg1, dest);
1011
	return;
2 7u83 1012
    }
1013
 
1014
    /* Now prepare to multiply by |n| */
7 7u83 1015
    n0 = n;
1016
    if (n < 0)n = -n;
2 7u83 1017
 
7 7u83 1018
    if (is_pow2(n)) {
2 7u83 1019
	/* Powers of two are easy */
7 7u83 1020
	p = log2(n);
1021
	if (wh1 == Dreg && last_use(a1)) {
1022
	    reg1 = a1;
1023
	    D1_used = 0;
2 7u83 1024
	} else {
7 7u83 1025
	    move(sha, a1, reg1);
2 7u83 1026
	}
7 7u83 1027
	mult_power2(p, reg1, D1_used);
2 7u83 1028
    } else {
1029
	/* The thing we are multiplying goes in reg1 */
7 7u83 1030
	move(sha, a1, reg1);
2 7u83 1031
	/* Copy reg1 into reg2 if necessary */
7 7u83 1032
	if (!dont_move)move(slongsh, reg1, reg2);
1033
	if (D1_used)regsinproc |= regmsk(REG_D1);
2 7u83 1034
	/* p will count consecutive ones and q consecutive zeros */
7 7u83 1035
	p = 0;
1036
	q = 0;
2 7u83 1037
	/* Scan through the 31 bits of n (the sign bit is zero), MSB first */
7 7u83 1038
	for (m = pow2(30); m; m >>= 1) {
1039
	    if (m & n) {
2 7u83 1040
		/* Set bit - record this */
7 7u83 1041
		started = 1;
1042
		p++;
2 7u83 1043
	    } else {
1044
		/* Reset bit - record this */
7 7u83 1045
		if (p) {
2 7u83 1046
		    /* We have read q 0's, then p 1's, before this 0 */
7 7u83 1047
		    mult_utility(p, q, reg1, reg2, 1, first_time);
1048
		    first_time = 0;
2 7u83 1049
		    /* Restart counts */
7 7u83 1050
		    p = 0;
1051
		    q = 0;
2 7u83 1052
		}
1053
		/* Record reset bit, ignoring initial zeros */
7 7u83 1054
		if (started)q++;
2 7u83 1055
	    }
1056
	}
1057
	/* Deal with last batch of digits */
7 7u83 1058
	if (p || q)mult_utility(p, q, reg1, reg2, 1, first_time);
2 7u83 1059
    }
1060
    /* Now put the result into dest - take care of sign of n now */
7 7u83 1061
    if (n0 < 0) {
1062
	negate(slongsh, reg1, dest);
2 7u83 1063
    } else {
7 7u83 1064
	move(slongsh, reg1, dest);
2 7u83 1065
    }
7 7u83 1066
    set_cond(dest, L32);
1067
    return;
2 7u83 1068
}
1069
 
1070
 
1071
/*
1072
    MAIN MULTIPLICATION ROUTINE
1073
 
1074
    The values a1 and a2 of shape sha are multiplied and the result is
1075
    stored in dest.
1076
*/
1077
 
1078
void mult
7 7u83 1079
(shape sha, where a1, where a2, where dest)
2 7u83 1080
{
7 7u83 1081
    where w;
1082
    long wh1 = whereis(a1);
1083
    long wh2 = whereis(a2);
1084
    long whd = whereis(dest);
2 7u83 1085
 
7 7u83 1086
    if (!have_overflow()) {
2 7u83 1087
	/* Constant multiplication */
7 7u83 1088
	if (wh1 == Value) {
1089
	    if (wh2 == Value) {
1090
		long v1 = nw(a1);
1091
		long v2 = nw(a2);
1092
		if (is_offset(a1.wh_exp))v1 /= 8;
1093
		if (is_offset(a2.wh_exp))v2 /= 8;
1094
		move(sha, mnw(v1 * v2), dest);
1095
		return;
2 7u83 1096
	    }
7 7u83 1097
	    mult_const(sha, a2, a1, dest);
1098
	    return;
2 7u83 1099
	}
1100
 
7 7u83 1101
	if (wh2 == Value) {
1102
	    mult_const(sha, a1, a2, dest);
1103
	    return;
2 7u83 1104
	}
1105
    }
1106
 
7 7u83 1107
    if (eq_where(a1, a2)) {
1108
	if (whd == Dreg) {
1109
	    move(sha, a1, dest);
1110
	    mult_aux(sha, dest, dest);
1111
	    return;
2 7u83 1112
	} else {
7 7u83 1113
	    move(sha, a1, D0);
1114
	    mult_aux(sha, D0, D0);
1115
	    move(sha, D0, dest);
1116
	    return;
2 7u83 1117
	}
1118
    }
1119
 
7 7u83 1120
    if (eq_where(a1, dest)) {
1121
	mult_aux(sha, a2, dest);
1122
	return;
2 7u83 1123
    }
1124
 
7 7u83 1125
    if (eq_where(a2, dest)) {
1126
	mult_aux(sha, a1, dest);
1127
	return;
2 7u83 1128
    }
1129
 
7 7u83 1130
    if (whd == Dreg) {
1131
	if (!interfere(a2, dest)) {
1132
	    move(sha, a1, dest);
1133
	    mult_aux(sha, a2, dest);
1134
	    return;
2 7u83 1135
	}
7 7u83 1136
	if (!interfere(a1, dest)) {
1137
	    move(sha, a2, dest);
1138
	    mult_aux(sha, a1, dest);
1139
	    return;
2 7u83 1140
	}
1141
    }
1142
 
7 7u83 1143
    if (shape_size(sha) == 8 ||
1144
	((shape_size(sha) ==16) && (have_overflow()))) {
1145
	w = D1;
1146
	regsinproc |= regmsk(REG_D1);
2 7u83 1147
    } else {
7 7u83 1148
	w = D0;
2 7u83 1149
    }
7 7u83 1150
    if (whereis(a2) == Areg) {
1151
	move(sha, a2, w);
1152
	mult_aux(sha, a1, w);
1153
	move(sha, w, dest);
2 7u83 1154
    } else {
7 7u83 1155
	move(sha, a1, w);
1156
	mult_aux(sha, a2, w);
1157
	move(sha, w, dest);
2 7u83 1158
    }
7 7u83 1159
    return;
2 7u83 1160
}
1161
 
1162
 
1163
/*
1164
    DIVISION BY A POWER OF 2
1165
 
1166
    The value top of shape sha is divided by the constant v which is a
1167
    power of 2.  The result is stored in dest.
1168
*/
1169
 
1170
static void div_power2
7 7u83 1171
(shape sha, long v, where top, where dest)
2 7u83 1172
{
7 7u83 1173
    long n = log2(v);
1174
    if (is_signed(sha)) {
1175
	bool sw;
1176
	where w;
1177
	int instr;
1178
	long sz = shape_size(sha);
1179
	long lab = next_lab();
1180
	exp jt = simple_exp(0);
1181
	ptno(jt) = lab;
2 7u83 1182
 
7 7u83 1183
	if (whereis(dest) == Dreg) {
1184
	    w = dest;
1185
	} else if (whereis(top) == Dreg && last_use(top)) {
1186
	    w = top;
2 7u83 1187
	} else {
7 7u83 1188
	    w = D0;
2 7u83 1189
	}
7 7u83 1190
	move(sha, top, w);
1191
	sw = cmp(sha, w, zero, tst_ge);
1192
	branch(tst_ge, jt, 1, sw, 0);
1193
	add(sha, w, mnw(v - 1), w);
1194
	make_label(lab);
1195
	instr = ins(sz, ml_asr);
1196
	while (n) {
1197
	    long m = (n > 8 ? 7 : n);
1198
	    ins2n(instr, m, sz, w, 1);
1199
	    n -= m;
2 7u83 1200
	}
7 7u83 1201
	move(sha, w, dest);
1202
	set_cond(dest, sz);
2 7u83 1203
    } else {
7 7u83 1204
	shift_aux(sha, mnw(n), top, dest, 1, 0);
2 7u83 1205
    }
7 7u83 1206
    return;
2 7u83 1207
}
1208
 
1209
 
1210
/*
1211
    REMAINDER MODULO A POWER OF 2
1212
 
1213
    The remainder of the value top of shape sha when divided by the
1214
    constant v (which is a power of 2) is stored in dest.
1215
*/
1216
 
1217
static void rem_power2
7 7u83 1218
(shape sha, long v, where top, where dest)
2 7u83 1219
{
7 7u83 1220
    if (is_signed(sha)) {
1221
	bool sw;
1222
	where w;
1223
	long lab = next_lab();
1224
	long end = next_lab();
1225
	exp jt = simple_exp(0);
1226
	exp je = simple_exp(0);
1227
	ptno(jt) = lab;
1228
	ptno(je) = end;
2 7u83 1229
 
7 7u83 1230
	if (whereis(dest) == Dreg) {
1231
	    w = dest;
1232
	} else if (whereis(top) == Dreg && last_use(top)) {
1233
	    w = top;
2 7u83 1234
	} else {
7 7u83 1235
	    w = D0;
2 7u83 1236
	}
7 7u83 1237
	move(sha, top, w);
1238
	sw = cmp(sha, w, zero, tst_ge);
1239
	branch(tst_ge, jt, 1, sw, 0);
1240
	negate(sha, w, w);
1241
	and(sha, mnw(v - 1), w, w);
1242
	negate(sha, w, w);
1243
	make_jump(m_bra, end);
1244
	make_label(lab);
1245
	and(sha, mnw(v - 1), w, w);
1246
	make_label(end);
1247
	move(sha, w, dest);
1248
	set_cond(dest, shape_size(sha));
2 7u83 1249
    } else {
7 7u83 1250
	and(sha, mnw(v - 1), top, dest);
2 7u83 1251
    }
7 7u83 1252
    return;
2 7u83 1253
}
1254
 
1255
 
1256
/*
1257
    REMAINDER MODULO A POWER OF 2 MINUS 1
1258
 
1259
    The remainder of the value top of shape sha when divided by the
1260
    constant v (which is a power of 2 minus 1) is stored in dest.  The
1261
    algorithm used is a modification of "casting out the nines".
1262
*/
1263
 
1264
static bool rem_power2_1
7 7u83 1265
(shape sha, long v, where top, where dest)
2 7u83 1266
{
7 7u83 1267
    bool sw;
1268
    where d0, d1;
1269
    long loop, end, tst;
1270
    exp jloop, jend, jtst;
1271
    bool s = is_signed(sha);
2 7u83 1272
 
7 7u83 1273
    if (s && (eq_where(top, D0) || eq_where(top, D1))) return(0);
2 7u83 1274
 
7 7u83 1275
    if (whereis(dest) == Dreg) {
1276
	d1 = dest;
2 7u83 1277
    } else {
7 7u83 1278
	d1 = D1;
1279
	regsinproc |= regmsk(REG_D1);
2 7u83 1280
    }
1281
 
7 7u83 1282
    if (eq_where(d1, D0)) {
1283
	d0 = D1;
1284
	regsinproc |= regmsk(REG_D1);
2 7u83 1285
    } else {
7 7u83 1286
	d0 = D0;
2 7u83 1287
    }
1288
 
7 7u83 1289
    loop = next_lab();
1290
    jloop = simple_exp(0);
1291
    ptno(jloop) = loop;
1292
    end = next_lab();
1293
    jend = simple_exp(0);
1294
    ptno(jend) = end;
1295
    tst = next_lab();
1296
    jtst = simple_exp(0);
1297
    ptno(jtst) = tst;
2 7u83 1298
 
7 7u83 1299
    move(sha, top, d1);
1300
    if (s) {
1301
	sw = cmp(sha, d1, zero, tst_ge);
1302
	branch(tst_ge, jloop, s, sw, 0);
1303
	negate(sha, d1, d1);
2 7u83 1304
    }
7 7u83 1305
    make_label(loop);
1306
    move(sha, mnw(v), d0);
1307
    sw = cmp(ulongsh, d1, d0, tst_le);
1308
    branch(tst_le, jend, s, sw, 0);
1309
    and(ulongsh, d1, d0, d0);
1310
    rshift(ulongsh, mnw(log2(v + 1)), d1, d1);
1311
    add(ulongsh, d0, d1, d1);
1312
    make_jump(m_bra, loop);
1313
    make_label(end);
1314
    branch(tst_neq, jtst, s, sw, 0);
1315
    move(sha, zero, d1);
1316
    make_label(tst);
1317
    if (s) {
1318
	long ntst = next_lab();
1319
	exp jntst = simple_exp(0);
1320
	ptno(jntst) = ntst;
1321
	sw = cmp(sha, top, zero, tst_ge);
1322
	branch(tst_ge, jntst, 1, sw, 0);
1323
	negate(sha, d1, d1);
1324
	make_label(ntst);
2 7u83 1325
    }
7 7u83 1326
    have_cond = 0;
1327
    move(sha, d1, dest);
1328
    return(1);
2 7u83 1329
}
1330
 
1331
 
1332
/*
1333
    MARKERS FOR DIVISION AND REMAINDER
1334
 
1335
    Division, remainder and combined division-remainder operations are
1336
    all handled by a single routine.  The following values are used to
1337
    indicate to the routine the operation type.
1338
*/
1339
 
1340
#define  DIV		0
1341
#define  REM		1
1342
#define  BOTH		2
1343
 
1344
 
1345
/*
1346
    MAIN DIVISION AND REMAINDER ROUTINE
1347
 
1348
    The value top of shape sha is divided by bottom and, depending on
1349
    the value of type, the quotient is stored in quot and the remainder
1350
    in rem.  Which of the two possible division types used is determined
1351
    by form : for example, if form is 1 then :
1352
 
1353
		    5 = ( -2 ) * ( -3 ) - 1
1354
 
1355
    whereas if form is 2 :
1356
 
1357
		    5 = ( -1 ) * ( -3 ) + 2
1358
 
1359
    The second form is the standard one.
1360
*/
1361
 
1362
static void euclid
7 7u83 1363
(shape sha, where bottom, where top, where quot, where rem, int type, int form)
2 7u83 1364
{
7 7u83 1365
    long v;
1366
    bool b_const = 0;
1367
    bool save_d1 = 0;
1368
    bool d1_pending = 0;
1369
    where qreg, rreg, breg;
1370
    long sz = shape_size(sha);
1371
    bool sg = is_signed(sha);
1372
    shape lsha = (sg ? slongsh : ulongsh);
2 7u83 1373
 
1374
    /* The two forms are the same for unsigned division */
7 7u83 1375
    if (!sg) form = 2;
2 7u83 1376
 
1377
    /* Deal with division by constants */
7 7u83 1378
    if (name(bottom.wh_exp) == val_tag) {
1379
	b_const = 1;
1380
	v = nw(bottom);
1381
	if (is_offset(bottom.wh_exp))v /= 8;
1382
	switch (v) {
2 7u83 1383
 
7 7u83 1384
	    case 0: {
1385
		warning("Division by zero");
1386
                if (have_overflow()) {
1387
                   test_overflow(UNCONDITIONAL);
2 7u83 1388
                }
1389
                else {
7 7u83 1390
                   if (type != REM)move(sha, zero, quot);
1391
                   if (type != DIV)move(sha, zero, rem);
2 7u83 1392
                }
7 7u83 1393
		return;
2 7u83 1394
	    }
1395
 
7 7u83 1396
	    case 1: {
1397
		if (type != REM)move(sha, top, quot);
1398
		if (type != DIV)move(sha, zero, rem);
1399
		return;
2 7u83 1400
	    }
1401
 
7 7u83 1402
	    case -1: {
2 7u83 1403
                if (is_signed(sha)) { /* is it really negative */
7 7u83 1404
                    if (type != REM || have_overflow())negate(sha, top, quot);
1405
                    if (type != DIV)move(sha, zero, rem);
1406
                    return;
2 7u83 1407
                }
1408
                /* fall through */
1409
	    }
1410
 
1411
	    default : {
7 7u83 1412
		if (form != 1) {
1413
                    if ((!is_signed(sha) || v > 0) && is_pow2(v) && sz == 32) {
1414
                        if (type == DIV) {
1415
			    div_power2(sha, v, top, quot);
1416
			    return;
2 7u83 1417
			}
7 7u83 1418
			if (type == REM) {
1419
			    rem_power2(sha, v, top, rem);
1420
			    return;
2 7u83 1421
			}
1422
		    }
7 7u83 1423
		    if (v > 7 && is_pow2(v + 1) && sz == 32) {
1424
			if (type == REM &&
1425
			     rem_power2_1(sha, v, top, rem)) {
1426
			    return;
2 7u83 1427
			}
1428
		    }
1429
		}
7 7u83 1430
		break;
2 7u83 1431
	    }
1432
	}
1433
    }
1434
 
1435
    /* Check on pointless divisions */
7 7u83 1436
    if (eq_where(top, bottom)) {
1437
	if (type != REM)move(sha, mnw(1), quot);
1438
	if (type != DIV)move(sha, zero, rem);
1439
	return;
2 7u83 1440
    }
1441
 
1442
    /* Now find two registers */
7 7u83 1443
    if (type == BOTH && interfere(quot, rem)) {
1444
	qreg = D0;
1445
	rreg = D1;
1446
	regsinproc |= regmsk(REG_D1);
1447
	if (D1_is_special)save_d1 = 1;
2 7u83 1448
    } else {
7 7u83 1449
	if (type != REM && whereis(quot) == Dreg &&
1450
	     !interfere(quot, bottom)) {
1451
	    qreg = quot;
2 7u83 1452
	} else {
7 7u83 1453
	    qreg = D0;
2 7u83 1454
	}
7 7u83 1455
	if (type != DIV && whereis(rem) == Dreg) {
1456
	    if (eq_where(rem, D0)) {
1457
		qreg = D1;
1458
		rreg = D0;
1459
		regsinproc |= regmsk(REG_D1);
1460
		if (D1_is_special)save_d1 = 1;
2 7u83 1461
	    } else {
7 7u83 1462
		rreg = rem;
2 7u83 1463
	    }
1464
	} else {
7 7u83 1465
	    if (eq_where(qreg, D0)) {
1466
		rreg = D1;
1467
		if (type == DIV) {
1468
		    d1_pending = 1;
2 7u83 1469
		} else {
7 7u83 1470
		    regsinproc |= regmsk(REG_D1);
1471
		    if (D1_is_special)save_d1 = 1;
2 7u83 1472
		}
1473
	    } else {
7 7u83 1474
		rreg = D0;
2 7u83 1475
	    }
1476
	}
1477
    }
1478
 
1479
    /* Save D1 if necessary */
7 7u83 1480
    if (save_d1)push(slongsh, L32, D1);
2 7u83 1481
#if 0
1482
    /* Keep the denominator in form 1 */
7 7u83 1483
    if (form == 1 && !b_const)push(slongsh, L32, bottom);
2 7u83 1484
#endif
1485
    /* Get the arguments into the correct positions */
7 7u83 1486
    if (sz != 32) {
1487
       bool d0_pushed = 0;
2 7u83 1488
 
7 7u83 1489
       make_comment("change variety top -> qreg");
1490
       change_var_sh(lsha, sha, top, qreg);
2 7u83 1491
 
7 7u83 1492
       if (eq_where(qreg, D0)) {
1493
          push(slongsh, L32, D0);
1494
          d0_pushed = 1;
2 7u83 1495
       }
1496
 
7 7u83 1497
       make_comment("change variety bottom -> rreg");
1498
       change_var_sh(lsha, sha, bottom, rreg);
2 7u83 1499
 
7 7u83 1500
       if (d0_pushed)
2 7u83 1501
          pop(slongsh,L32,D0);
1502
 
7 7u83 1503
       breg = rreg;
2 7u83 1504
    } else {
7 7u83 1505
	move(sha, top, qreg);
1506
	if (whereis(bottom) == Areg || whereis(bottom) == Freg) {
1507
	    if (d1_pending) {
1508
		regsinproc |= regmsk(REG_D1);
1509
		if (D1_is_special) {
1510
		    save_d1 = 1;
1511
		    push(slongsh, L32, D1);
2 7u83 1512
		}
1513
	    }
7 7u83 1514
	    move(sha, bottom, rreg);
1515
	    breg = rreg;
2 7u83 1516
	} else {
7 7u83 1517
	    breg = bottom;
2 7u83 1518
	}
1519
    }
1520
 
1521
    if (have_overflow()) {
7 7u83 1522
       if (save_d1) {
2 7u83 1523
          pop(slongsh,L32,D1);
1524
       }
7 7u83 1525
       cmp_zero(sha, sz, breg);
1526
       test_overflow2(m_beq);
1527
       if (save_d1) {
2 7u83 1528
          push(slongsh,L32,D1);
1529
       }
1530
    }
1531
 
1532
    /* Keep the denominator in form 1 */
7 7u83 1533
    if (form == 1 && !b_const)push(slongsh, L32, breg);
2 7u83 1534
 
1535
    /* Create the actual division instruction */
7 7u83 1536
    if (type == DIV && form != 1) {
1537
	long qn = reg(qreg.wh_regs);
1538
	int instr = (sg ? m_divsl : m_divul);
1539
	mach_op *op1 = operand(L32, breg);
1540
	mach_op *op2 = make_register(qn);
1541
	make_instr(instr, op1, op2, regmsk(qn));
2 7u83 1542
    } else {
7 7u83 1543
	long qn = reg(qreg.wh_regs);
1544
	long rn = reg(rreg.wh_regs);
1545
	int instr = (sg ? m_divsll : m_divull);
1546
	mach_op *op1 = operand(L32, breg);
1547
	mach_op *op2 = make_reg_pair(rn, qn);
1548
	make_instr(instr, op1, op2,(regmsk(qn) | regmsk(rn)));
2 7u83 1549
    }
7 7u83 1550
    if (have_overflow()) {
1551
      if (save_d1) {
2 7u83 1552
	pop(slongsh,L32,D1);
1553
      }
7 7u83 1554
      if (form == 1 && !b_const) {
2 7u83 1555
	dec_stack(-32);
1556
      }
7 7u83 1557
      test_overflow(ON_SHAPE(sha));
1558
      if (form == 1 && !b_const) {
2 7u83 1559
	dec_stack(32);
1560
      }
1561
 
1562
 
1563
    }
1564
 
1565
 
1566
    /* Apply hacks for form 1 */
7 7u83 1567
    if (form == 1 && is_signed(sha)) {
1568
	mach_op *op1, *op2;
1569
	long lab1 = next_lab();
1570
	long lab2 = next_lab();
1571
	long qn = reg(qreg.wh_regs);
1572
	long rn = reg(rreg.wh_regs);
1573
	if (!b_const) {
1574
	    op1 = make_indirect(REG_SP, 0);
1575
	    make_instr(m_tstl, op1, null, 0);
1576
	    make_jump(m_bge, lab1);
2 7u83 1577
	}
1578
 
1579
	/* Denominator is negative ? */
7 7u83 1580
	if (!(b_const && v >= 0)) {
1581
	    op1 = make_register(rn);
1582
	    make_instr(m_tstl, op1, null, 0);
1583
	    make_jump(m_ble, lab2);
1584
	    if (type != REM) {
1585
		op1 = make_value(1);
1586
		op2 = make_register(qn);
1587
		make_instr(m_subql, op1, op2, regmsk(qn));
2 7u83 1588
	    }
7 7u83 1589
	    if (type != DIV) {
1590
		if (b_const) {
1591
		    op1 = make_value(v);
2 7u83 1592
		} else {
7 7u83 1593
		    op1 = make_indirect(REG_SP, 0);
2 7u83 1594
		}
7 7u83 1595
		op2 = make_register(rn);
1596
		make_instr(m_addl, op1, op2, regmsk(rn));
2 7u83 1597
	    }
7 7u83 1598
	    if (!b_const)make_jump(m_bra, lab2);
2 7u83 1599
	}
1600
 
1601
	/* Denominator is positive ? */
7 7u83 1602
	if (!(b_const && v < 0)) {
1603
	    if (!b_const)make_label(lab1);
1604
	    op1 = make_register(rn);
1605
	    make_instr(m_tstl, op1, null, 0);
1606
	    make_jump(m_bge, lab2);
1607
	    if (type != REM) {
1608
		op1 = make_value(1);
1609
		op2 = make_register(qn);
1610
		make_instr(m_subql, op1, op2, regmsk(qn));
2 7u83 1611
	    }
7 7u83 1612
	    if (type != DIV) {
1613
		if (b_const) {
1614
		    op1 = make_value(v);
2 7u83 1615
		} else {
7 7u83 1616
		    op1 = make_indirect(REG_SP, 0);
2 7u83 1617
		}
7 7u83 1618
		op2 = make_register(rn);
1619
		make_instr(m_addl, op1, op2, regmsk(rn));
2 7u83 1620
	    }
1621
	}
1622
 
7 7u83 1623
	make_label(lab2);
1624
	if (!b_const)dec_stack(-32);
2 7u83 1625
    }
1626
 
1627
    /* Move results into place */
7 7u83 1628
    if (sz == 32) {
1629
	if (type != REM)move(sha, qreg, quot);
1630
	if (type != DIV)move(sha, rreg, rem);
2 7u83 1631
    } else {
7 7u83 1632
	if (type != REM)change_var_sh(sha, lsha, qreg, quot);
1633
	if (type != DIV)change_var_sh(sha, lsha, rreg, rem);
2 7u83 1634
    }
1635
 
1636
    /* Restore D1 */
7 7u83 1637
    if (save_d1) {
1638
	pop(slongsh, L32, D1);
1639
	debug_warning("D1 saved on stack during division");
2 7u83 1640
    }
7 7u83 1641
    have_cond = 0;
1642
    return;
2 7u83 1643
}
1644
 
1645
 
1646
/*
1647
    DIVISION INSTRUCTION - FORM ONE
1648
 
1649
    The value top of shape sha is divided by bottom and the result is
1650
    stored in dest.  This is the alternative division operation.
1651
*/
1652
 
1653
void div1
7 7u83 1654
(shape sha, where bottom, where top, where dest)
2 7u83 1655
{
7 7u83 1656
    euclid(sha, bottom, top, dest, zero, DIV, 1);
1657
    return;
2 7u83 1658
}
1659
 
1660
 
1661
/*
1662
    DIVISION INSTRUCTION - FORM TWO
1663
 
1664
    The value top of shape sha is divided by bottom and the result is
1665
    stored in dest.  This is the standard division operation.
1666
*/
1667
 
1668
void div2
7 7u83 1669
(shape sha, where bottom, where top, where dest)
2 7u83 1670
{
7 7u83 1671
    euclid(sha, bottom, top, dest, zero, DIV, 2);
1672
    return;
2 7u83 1673
}
1674
 
1675
 
1676
/*
1677
    REMAINDER INSTRUCTION - FORM ONE
1678
 
1679
    The value top of shape sha is divided by bottom and the remainder is
1680
    stored in dest.  This is the alternative remainder operation.
1681
*/
1682
 
1683
void rem1
7 7u83 1684
(shape sha, where bottom, where top, where dest)
2 7u83 1685
{
7 7u83 1686
    euclid(sha, bottom, top, zero, dest, REM, 1);
1687
    return;
2 7u83 1688
}
1689
 
1690
 
1691
/*
1692
    REMAINDER INSTRUCTION - FORM TWO
1693
 
1694
    The value top of shape sha is divided by bottom and the remainder is
1695
    stored in dest.  This is the standard remainder operation.
1696
*/
1697
 
1698
void rem2
7 7u83 1699
(shape sha, where bottom, where top, where dest)
2 7u83 1700
{
7 7u83 1701
    euclid(sha, bottom, top, zero, dest, REM, 2);
1702
    return;
2 7u83 1703
}
1704
 
1705
 
1706
/*
1707
    DO AN EXACT DIVISION
1708
 
1709
    The value top is divided by bottom and the result is stored in dest.
1710
*/
1711
 
1712
void exactdiv
7 7u83 1713
(shape sha, where bottom, where top, where dest)
2 7u83 1714
{
7 7u83 1715
    euclid(slongsh, bottom, top, dest, zero, DIV, 2);
1716
    return;
2 7u83 1717
}
1718
 
1719
 
1720
/*
1721
    DO A MAXIMUM OR MINIMUM INSTRUCTION
1722
*/
1723
 
1724
static void maxmin
7 7u83 1725
(shape sha, where a1, where a2, where dest, int tst)
2 7u83 1726
{
7 7u83 1727
    where d;
1728
    bool sw;
1729
    long sz = shape_size(sha);
1730
    long lab = next_lab();
1731
    exp jt = simple_exp(0);
1732
    ptno(jt) = lab;
1733
    if (whereis(dest) == Dreg && !interfere(a1, dest) &&
1734
	 !interfere(a2, dest)) {
1735
	d = dest;
2 7u83 1736
    } else {
7 7u83 1737
	d = D0;
2 7u83 1738
    }
1739
    make_comment("maxmin ...");
7 7u83 1740
    move(sha, a1, d);
1741
    sw = cmp(sha, d, a2, tst);
1742
    branch(tst, jt, is_signed(sha), sw, 0);
1743
    move(sha, a2, d);
1744
    make_label(lab);
1745
    move(sha, d, dest);
2 7u83 1746
    make_comment("maxmin done");
7 7u83 1747
    return;
2 7u83 1748
}
1749
 
1750
 
1751
/*
1752
    DO A MAXIMUM INSTRUCTION
1753
*/
1754
 
1755
void maxop
7 7u83 1756
(shape sha, where a1, where a2, where dest)
2 7u83 1757
{
7 7u83 1758
    maxmin(sha, a1, a2, dest, tst_ge);
1759
    return;
2 7u83 1760
}
1761
 
1762
 
1763
/*
1764
    DO A MINIMUM INSTRUCTION
1765
*/
1766
 
1767
void minop
7 7u83 1768
(shape sha, where a1, where a2, where dest)
2 7u83 1769
{
7 7u83 1770
    maxmin(sha, a1, a2, dest, tst_le);
1771
    return;
2 7u83 1772
}
1773
 
1774
 
1775
/*
1776
    DO AN ABSOLUTE OPERATION
1777
*/
1778
 
1779
void absop
7 7u83 1780
(shape sha, where a, where dest)
2 7u83 1781
{
7 7u83 1782
    if (is_signed(sha)) {
1783
	where d;
1784
	bool sw;
1785
	long lab = next_lab();
1786
	exp jt = simple_exp(0);
1787
	ptno(jt) = lab;
1788
	if (whereis(dest) == Dreg) {
1789
	    d = dest;
2 7u83 1790
	} else {
7 7u83 1791
	    d = D0;
2 7u83 1792
	}
7 7u83 1793
	move(sha, a, d);
1794
	sw = cmp(sha, d, zero, tst_ge);
1795
	branch(tst_ge, jt, 1, sw, 0);
1796
	negate(sha, d, d);
1797
	make_label(lab);
1798
	move(sha, d, dest);
2 7u83 1799
    } else {
7 7u83 1800
	move(sha, a, dest);
2 7u83 1801
    }
7 7u83 1802
    return;
2 7u83 1803
}
1804