« back to all changes in this revision
Viewing changes to HP2100/hp2100_cpu3.c
- browse files at revision 9
- compare with another revision
- download diff
- download tarball
- view history from revision 9
- Committer: Bazaar Package Importer
- Author(s): Vince Mulhollon
- Date: 2007-04-13 20:16:15 UTC
- mfrom: (1.1.7 upstream) (2.1.3 lenny)
- Revision ID: james.westby@ubuntu.com-20070413201615-jiar46bgkrs0dw2h
Tags: 3.7.0-1
* New upstream released 03-Feb-2007
* i7094 added which emulates the IBM 7090/7094
* Upstream has converted almost entirely to pdf format for docs
* All manpages updated
* All docs are registered with the doc-base system
* i7094 added which emulates the IBM 7090/7094
* Upstream has converted almost entirely to pdf format for docs
* All manpages updated
* All docs are registered with the doc-base system
- files added:
- 0readme_37.txt
- DOCS
- files removed:
- 0readme_36.txt
- files modified:
- AltairZ80/altairz80_cpu.c
added
removed
HP2100/hp2100_cpu3.c
1
/* hp2100_cpu3.c: HP 2100/1000 FFP/DBI instructions
2
3
Copyright (c) 2005-2006, J. David Bryan
4
5
Permission is hereby granted, free of charge, to any person obtaining a
6
copy of this software and associated documentation files (the "Software"),
7
to deal in the Software without restriction, including without limitation
8
the rights to use, copy, modify, merge, publish, distribute, sublicense,
9
and/or sell copies of the Software, and to permit persons to whom the
10
Software is furnished to do so, subject to the following conditions:
11
12
The above copyright notice and this permission notice shall be included in
13
all copies or substantial portions of the Software.
14
15
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
18
THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21
22
Except as contained in this notice, the name of the author shall not be
23
used in advertising or otherwise to promote the sale, use or other dealings
24
in this Software without prior written authorization from the author.
25
26
CPU3 Fast FORTRAN and Double Integer instructions
27
28
16-Oct-06 JDB Calls FPP for extended-precision math
29
12-Oct-06 JDB Altered DBLE, DDINT for F-Series FFP compatibility
30
26-Sep-06 JDB Moved from hp2100_cpu1.c to simplify extensions
31
09-Aug-06 JDB Added double-integer instruction set
32
18-Feb-05 JDB Add 2100/21MX Fast FORTRAN Processor instructions
33
34
Primary references:
35
- HP 1000 M/E/F-Series Computers Technical Reference Handbook
36
(5955-0282, Mar-1980)
37
- HP 1000 M/E/F-Series Computers Engineering and Reference Documentation
38
(92851-90001, Mar-1981)
39
- Macro/1000 Reference Manual (92059-90001, Dec-1992)
40
41
Additional references are listed with the associated firmware
42
implementations, as are the HP option model numbers pertaining to the
43
applicable CPUs.
44
*/
45
46
#include "hp2100_defs.h"
47
#include "hp2100_cpu.h"
48
#include "hp2100_cpu1.h"
49
50
#if defined (HAVE_INT64) /* int64 support available */
51
#include "hp2100_fp1.h"
52
#else /* int64 support unavailable */
53
#include "hp2100_fp.h"
54
#endif /* end of int64 support */
55
56
57
t_stat cpu_ffp (uint32 IR, uint32 intrq); /* Fast FORTRAN Processor */
58
t_stat cpu_dbi (uint32 IR, uint32 intrq); /* Double-Integer instructions */
59
60
61
/* Fast FORTRAN Processor.
62
63
The Fast FORTRAN Processor (FFP) is a set of FORTRAN language accelerators
64
and extended-precision (three-word) floating point routines. Although the
65
FFP is an option for the 2100 and later CPUs, each implements the FFP in a
66
slightly different form.
67
68
Option implementation by CPU was as follows:
69
70
2114 2115 2116 2100 1000-M 1000-E 1000-F
71
------ ------ ------ ------ ------ ------ ------
72
N/A N/A N/A 12907A 12977B 13306B std
73
74
The instruction codes are mapped to routines as follows:
75
76
Instr. 2100 1000-M 1000-E 1000-F Instr. 2100 1000-M 1000-E 1000-F
77
------ ------ ------ ------ ------ ------ ------ ------ ------ ------
78
105200 -- [nop] [nop] [test] 105220 .XFER .XFER .XFER .XFER
79
105201 DBLE DBLE DBLE DBLE 105221 .GOTO .GOTO .GOTO .GOTO
80
105202 SNGL SNGL SNGL SNGL 105222 ..MAP ..MAP ..MAP ..MAP
81
105203 .XMPY .XMPY .XMPY .DNG 105223 .ENTR .ENTR .ENTR .ENTR
82
105204 .XDIV .XDIV .XDIV .DCO 105224 .ENTP .ENTP .ENTP .ENTP
83
105205 .DFER .DFER .DFER .DFER 105225 -- .PWR2 .PWR2 .PWR2
84
105206 -- .XPAK .XPAK .XPAK 105226 -- .FLUN .FLUN .FLUN
85
105207 -- XADD XADD .BLE 105227 $SETP $SETP $SETP $SETP
86
87
105210 -- XSUB XSUB .DIN 105230 -- .PACK .PACK .PACK
88
105211 -- XMPY XMPY .DDE 105231 -- -- .CFER .CFER
89
105212 -- XDIV XDIV .DIS 105232 -- -- -- ..FCM
90
105213 .XADD .XADD .XADD .DDS 105233 -- -- -- ..TCM
91
105214 .XSUB .XSUB .XSUB .NGL 105234 -- -- -- --
92
105215 -- .XCOM .XCOM .XCOM 105235 -- -- -- --
93
105216 -- ..DCM ..DCM ..DCM 105236 -- -- -- --
94
105217 -- DDINT DDINT DDINT 105237 -- -- -- --
95
96
The F-Series maps different instructions to several of the standard FFP
97
opcodes. We first look for these and dispatch them appropriately before
98
falling into the handler for the common instructions.
99
100
The math functions use the F-Series FPP for implementation. The FPP requires
101
that the host compiler support 64-bit integers. Therefore, if 64-bit
102
integers are not available, the math instructions of the FFP are disabled.
103
We allow this partial implementation as an aid in running systems generated
104
for the FFP. Most system programs did not use the math instructions, but
105
almost all use .ENTR. Supporting the latter even on systems that do not
106
support the former still allows such systems to boot.
107
108
Notes:
109
110
1. The "$SETP" instruction is sometimes listed as ".SETP" in the
111
documentation.
112
113
2. Extended-precision arithmetic routines (e.g., .XMPY) exist on the
114
1000-F, but they are assigned instruction codes in the single-precision
115
floating-point module range. They are replaced by several double
116
integer instructions, which we dispatch to the double integer handler.
117
118
3. The software implementation of ..MAP supports 1-, 2-, or 3-dimensional
119
arrays, designated by setting A = -1, 0, and +1, respectively. The
120
firmware implementation supports only 2- and 3-dimensional access.
121
122
4. The documentation for ..MAP for the 2100 FFP shows A = 0 or -1 for two
123
or three dimensions, respectively, but the 1000 FFP shows A = 0 or +1.
124
The firmware actually only checks the LSB of A.
125
126
5. The .DFER and .XFER implementations for the 2100 FFP return X+4 and Y+4
127
in the A and B registers, whereas the 1000 FFP returns X+3 and Y+3.
128
129
6. The .XFER implementation for the 2100 FFP returns to P+2, whereas the
130
1000 implementation returns to P+1.
131
132
7. The firmware implementations of DBLE, .BLE, and DDINT clear the overflow
133
flag. The software implementations do not change overflow.
134
135
8. The M/E-Series FFP arithmetic instructions (.XADD, etc.) return negative
136
infinity on negative overflow and positive infinity on positive
137
overflow. The equivalent F-Series instructions return positive infinity
138
on both.
139
140
Additional references:
141
- DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)
142
- Implementing the HP 2100 Fast FORTRAN Processor (12907-90010, Nov-1974)
143
*/
144
145
static const OP_PAT op_ffp_f[32] = { /* patterns for F-Series only */
146
OP_N, OP_AAF, OP_AX, OP_N, /* [tst] DBLE SNGL .DNG */
147
OP_N, OP_AA, OP_A, OP_AAF, /* .DCO .DFER .XPAK .BLE */
148
OP_N, OP_N, OP_N, OP_N, /* .DIN .DDE .DIS .DDS */
149
OP_AT, OP_A, OP_A, OP_AAX, /* .NGL .XCOM ..DCM DDINT */
150
OP_N, OP_AK, OP_KKKK, OP_A, /* .XFER .GOTO ..MAP .ENTR */
151
OP_A, OP_RK, OP_R, OP_K, /* .ENTP .PWR2 .FLUN $SETP */
152
OP_RC, OP_AA, OP_R, OP_A, /* .PACK .CFER ..FCM ..TCM */
153
OP_N, OP_N, OP_N, OP_N /* --- --- --- --- */
154
};
155
156
static const OP_PAT op_ffp_e[32] = { /* patterns for 2100/M/E-Series */
157
OP_N, OP_AAF, OP_AX, OP_AXX, /* [nop] DBLE SNGL .XMPY */
158
OP_AXX, OP_AA, OP_A, OP_AAXX, /* .XDIV .DFER .XPAK XADD */
159
OP_AAXX, OP_AAXX, OP_AAXX, OP_AXX, /* XSUB XMPY XDIV .XADD */
160
OP_AXX, OP_A, OP_A, OP_AAX, /* .XSUB .XCOM ..DCM DDINT */
161
OP_N, OP_AK, OP_KKKK, OP_A, /* .XFER .GOTO ..MAP .ENTR */
162
OP_A, OP_RK, OP_R, OP_K, /* .ENTP .PWR2 .FLUN $SETP */
163
OP_RC, OP_AA, OP_N, OP_N, /* .PACK .CFER --- --- */
164
OP_N, OP_N, OP_N, OP_N /* --- --- --- --- */
165
};
166
167
t_stat cpu_ffp (uint32 IR, uint32 intrq)
168
{
169
OP fpop;
170
OPS op, op2;
171
uint32 entry;
172
uint32 j, sa, sb, sc, da, dc, ra, MA;
173
int32 expon;
174
t_stat reason = SCPE_OK;
175
176
#if defined (HAVE_INT64) /* int64 support available */
177
178
int32 i;
179
180
#endif /* end of int64 support */
181
182
if ((cpu_unit.flags & UNIT_FFP) == 0) /* FFP option installed? */
183
return stop_inst;
184
185
entry = IR & 037; /* mask to entry point */
186
187
if (UNIT_CPU_MODEL != UNIT_1000_F) { /* 2100/M/E-Series? */
188
if (op_ffp_e[entry] != OP_N)
189
if (reason = cpu_ops (op_ffp_e[entry], op, intrq)) /* get instruction operands */
190
return reason;
191
}
192
193
#if defined (HAVE_INT64) /* int64 support available */
194
195
else { /* F-Series */
196
if (op_ffp_f[entry] != OP_N)
197
if (reason = cpu_ops (op_ffp_f[entry], op, intrq)) /* get instruction operands */
198
return reason;
199
200
switch (entry) { /* decode IR<4:0> */
201
202
case 000: /* [tst] 105200 (OP_N) */
203
XR = 4; /* firmware revision */
204
SR = 0102077; /* test passed code */
205
AR = 0; /* test clears A/B */
206
BR = 0;
207
PC = (PC + 1) & VAMASK; /* P+2 return for firmware w/DBI */
208
return reason;
209
210
case 003: /* .DNG 105203 (OP_N) */
211
return cpu_dbi (0105323, intrq); /* remap to double int handler */
212
213
case 004: /* .DCO 105204 (OP_N) */
214
return cpu_dbi (0105324, intrq); /* remap to double int handler */
215
216
case 007: /* .BLE 105207 (OP_AAF) */
217
O = fp_cvt (&op[2], fp_f, fp_t); /* convert value and clear overflow */
218
WriteOp (op[1].word, op[2], fp_t); /* write double-precision value */
219
return reason;
220
221
case 010: /* .DIN 105210 (OP_N) */
222
return cpu_dbi (0105330, intrq); /* remap to double int handler */
223
224
case 011: /* .DDE 105211 (OP_N) */
225
return cpu_dbi (0105331, intrq); /* remap to double int handler */
226
227
case 012: /* .DIS 105212 (OP_N) */
228
return cpu_dbi (0105332, intrq); /* remap to double int handler */
229
230
case 013: /* .DDS 105213 (OP_N) */
231
return cpu_dbi (0105333, intrq); /* remap to double int handler */
232
233
case 014: /* .NGL 105214 (OP_AT) */
234
O = fp_cvt (&op[1], fp_t, fp_f); /* convert value */
235
AR = op[1].fpk[0]; /* move MSB to A */
236
BR = op[1].fpk[1]; /* move LSB to B */
237
return reason;
238
239
case 032: /* ..FCM 105232 (OP_R) */
240
O = fp_pcom (&op[0], fp_f); /* complement value */
241
AR = op[0].fpk[0]; /* return result */
242
BR = op[0].fpk[1]; /* to A/B registers */
243
return reason;
244
245
case 033: /* ..TCM 105233 (OP_A) */
246
fpop = ReadOp (op[0].word, fp_t); /* read 4-word value */
247
O = fp_pcom (&fpop, fp_t); /* complement it */
248
WriteOp (op[0].word, fpop, fp_t); /* write 4-word value */
249
return reason;
250
} /* fall thru if not special to F */
251
}
252
253
#endif /* end of int64 support */
254
255
switch (entry) { /* decode IR<4:0> */
256
257
/* FFP module 1 */
258
259
case 000: /* [nop] 105200 (OP_N) */
260
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 M/E-series */
261
return stop_inst; /* trap if not */
262
break;
263
264
#if defined (HAVE_INT64) /* int64 support available */
265
266
case 001: /* DBLE 105201 (OP_AAF) */
267
O = fp_cvt (&op[2], fp_f, fp_x); /* convert value and clear overflow */
268
WriteOp (op[1].word, op[2], fp_x); /* write extended-precision value */
269
break;
270
271
case 002: /* SNGL 105202 (OP_AX) */
272
O = fp_cvt (&op[1], fp_x, fp_f); /* convert value */
273
AR = op[1].fpk[0]; /* move MSB to A */
274
BR = op[1].fpk[1]; /* move LSB to B */
275
break;
276
277
case 003: /* .XMPY 105203 (OP_AXX) */
278
i = 0; /* params start at op[0] */
279
goto XMPY; /* process as XMPY */
280
281
case 004: /* .XDIV 105204 (OP_AXX) */
282
i = 0; /* params start at op[0] */
283
goto XDIV; /* process as XDIV */
284
285
#endif /* end of int64 support */
286
287
case 005: /* .DFER 105205 (OP_AA) */
288
BR = op[0].word; /* get destination address */
289
AR = op[1].word; /* get source address */
290
goto XFER; /* do transfer */
291
292
#if defined (HAVE_INT64) /* int64 support available */
293
294
case 006: /* .XPAK 105206 (OP_A) */
295
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
296
return stop_inst; /* trap if not */
297
298
if (intrq) { /* interrupt pending? */
299
PC = err_PC; /* restart instruction */
300
break;
301
}
302
303
fpop = ReadOp (op[0].word, fp_x); /* read unpacked */
304
O = fp_nrpack (&fpop, fpop, (int16) AR, fp_x); /* nrm/rnd/pack mantissa, exponent */
305
WriteOp (op[0].word, fpop, fp_x); /* write result */
306
break;
307
308
case 007: /* XADD 105207 (OP_AAXX) */
309
i = 1; /* params start at op[1] */
310
XADD: /* enter here from .XADD */
311
if (intrq) { /* interrupt pending? */
312
PC = err_PC; /* restart instruction */
313
break;
314
}
315
316
O = fp_exec (001, &fpop, op[i + 1], op[i + 2]); /* three-word add */
317
WriteOp (op[i].word, fpop, fp_x); /* write sum */
318
break;
319
320
case 010: /* XSUB 105210 (OP_AAXX) */
321
i = 1; /* params start at op[1] */
322
XSUB: /* enter here from .XSUB */
323
if (intrq) { /* interrupt pending? */
324
PC = err_PC; /* restart instruction */
325
break;
326
}
327
328
O = fp_exec (021, &fpop, op[i + 1], op[i + 2]); /* three-word subtract */
329
WriteOp (op[i].word, fpop, fp_x); /* write difference */
330
break;
331
332
case 011: /* XMPY 105211 (OP_AAXX) */
333
i = 1; /* params start at op[1] */
334
XMPY: /* enter here from .XMPY */
335
if (intrq) { /* interrupt pending? */
336
PC = err_PC; /* restart instruction */
337
break;
338
}
339
340
O = fp_exec (041, &fpop, op[i + 1], op[i + 2]); /* three-word multiply */
341
WriteOp (op[i].word, fpop, fp_x); /* write product */
342
break;
343
344
case 012: /* XDIV 105212 (OP_AAXX) */
345
i = 1; /* params start at op[1] */
346
XDIV: /* enter here from .XDIV */
347
if (intrq) { /* interrupt pending? */
348
PC = err_PC; /* restart instruction */
349
break;
350
}
351
352
O = fp_exec (061, &fpop, op[i + 1], op[i + 2]); /* three-word divide */
353
WriteOp (op[i].word, fpop, fp_x); /* write quotient */
354
break;
355
356
case 013: /* .XADD 105213 (OP_AXX) */
357
i = 0; /* params start at op[0] */
358
goto XADD; /* process as XADD */
359
360
case 014: /* .XSUB 105214 (OP_AXX) */
361
i = 0; /* params start at op[0] */
362
goto XSUB; /* process as XSUB */
363
364
case 015: /* .XCOM 105215 (OP_A) */
365
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
366
return stop_inst; /* trap if not */
367
368
fpop = ReadOp (op[0].word, fp_x); /* read unpacked */
369
AR = fp_ucom (&fpop, fp_x); /* complement and rtn exp adj */
370
WriteOp (op[0].word, fpop, fp_x); /* write result */
371
break;
372
373
case 016: /* ..DCM 105216 (OP_A) */
374
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
375
return stop_inst; /* trap if not */
376
377
if (intrq) { /* interrupt pending? */
378
PC = err_PC; /* restart instruction */
379
break;
380
}
381
382
fpop = ReadOp (op[0].word, fp_x); /* read operand */
383
O = fp_pcom (&fpop, fp_x); /* complement (can't ovf neg) */
384
WriteOp (op[0].word, fpop, fp_x); /* write result */
385
break;
386
387
case 017: /* DDINT 105217 (OP_AAX) */
388
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
389
return stop_inst; /* trap if not */
390
391
if (intrq) { /* interrupt pending? */
392
PC = err_PC; /* restart instruction */
393
break;
394
}
395
396
O = fp_trun (&fpop, op[2], fp_x); /* truncate operand (can't ovf) */
397
WriteOp (op[1].word, fpop, fp_x); /* write result */
398
break;
399
400
#endif /* end of int64 support */
401
402
/* FFP module 2 */
403
404
case 020: /* .XFER 105220 (OP_N) */
405
if (UNIT_CPU_TYPE == UNIT_TYPE_2100)
406
PC = (PC + 1) & VAMASK; /* 2100 .XFER returns to P+2 */
407
XFER: /* enter here from .DFER */
408
sc = 3; /* set count for 3-wd xfer */
409
goto CFER; /* do transfer */
410
411
case 021: /* .GOTO 105221 (OP_AK) */
412
if ((int16) op[1].word < 1) /* index < 1? */
413
op[1].word = 1; /* reset min */
414
415
sa = PC + op[1].word - 1; /* point to jump target */
416
if (sa >= op[0].word) /* must be <= last target */
417
sa = op[0].word - 1;
418
419
da = ReadW (sa); /* get jump target */
420
if (reason = resolve (da, &MA, intrq)) { /* resolve indirects */
421
PC = err_PC; /* irq restarts instruction */
422
break;
423
}
424
425
mp_dms_jmp (MA); /* validate jump addr */
426
PCQ_ENTRY; /* record last PC */
427
PC = MA; /* jump */
428
BR = op[0].word; /* (for 2100 FFP compat) */
429
break;
430
431
case 022: /* ..MAP 105222 (OP_KKKK) */
432
op[1].word = op[1].word - 1; /* decrement 1st subscr */
433
434
if ((AR & 1) == 0) /* 2-dim access? */
435
op[1].word = op[1].word + /* compute element offset */
436
(op[2].word - 1) * op[3].word;
437
else { /* 3-dim access */
438
if (reason = cpu_ops (OP_KK, op2, intrq)) { /* get 1st, 2nd ranges */
439
PC = err_PC; /* irq restarts instruction */
440
break;
441
}
442
op[1].word = op[1].word + /* offset */
443
((op[3].word - 1) * op2[1].word +
444
op[2].word - 1) * op2[0].word;
445
}
446
447
AR = (op[0].word + op[1].word * BR) & DMASK; /* return element address */
448
break;
449
450
case 023: /* .ENTR 105223 (OP_A) */
451
MA = PC - 3; /* get addr of entry point */
452
ENTR: /* enter here from .ENTP */
453
da = op[0].word; /* get addr of 1st formal */
454
dc = MA - da; /* get count of formals */
455
sa = ReadW (MA); /* get addr of return point */
456
ra = ReadW (sa++); /* get rtn, ptr to 1st actual */
457
WriteW (MA, ra); /* stuff rtn into caller's ent */
458
sc = ra - sa; /* get count of actuals */
459
if (sc > dc) /* use min (actuals, formals) */
460
sc = dc;
461
462
for (j = 0; j < sc; j++) {
463
MA = ReadW (sa++); /* get addr of actual */
464
if (reason = resolve (MA, &MA, intrq)) { /* resolve indirect */
465
PC = err_PC; /* irq restarts instruction */
466
break;
467
}
468
WriteW (da++, MA); /* put addr into formal */
469
}
470
471
AR = ra; /* return address */
472
BR = da; /* addr of 1st unused formal */
473
break;
474
475
case 024: /* .ENTP 105224 (OP_A) */
476
MA = PC - 5; /* get addr of entry point */
477
goto ENTR;
478
479
case 025: /* .PWR2 105225 (OP_RK) */
480
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
481
return stop_inst; /* trap if not */
482
483
fp_unpack (&fpop, &expon, op[0], fp_f); /* unpack value */
484
expon = expon + (int16) (op[1].word); /* multiply by 2**n */
485
fp_pack (&fpop, fpop, expon, fp_f); /* repack value */
486
AR = fpop.fpk[0]; /* return result */
487
BR = fpop.fpk[1]; /* to A/B registers */
488
break;
489
490
case 026: /* .FLUN 105226 (OP_R) */
491
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
492
return stop_inst; /* trap if not */
493
494
fp_unpack (&fpop, &expon, op[0], fp_f); /* unpack value */
495
AR = (int16) expon; /* return expon to A */
496
BR = fpop.fpk[1]; /* and low mant to B */
497
break;
498
499
case 027: /* $SETP 105227 (OP_K) */
500
j = sa = AR; /* save initial value */
501
sb = BR; /* save initial address */
502
AR = 0; /* AR will return = 0 */
503
BR = BR & VAMASK; /* addr must be direct */
504
505
do {
506
WriteW (BR, j); /* write value to address */
507
j = (j + 1) & DMASK; /* incr value */
508
BR = (BR + 1) & VAMASK; /* incr address */
509
op[0].word = op[0].word - 1; /* decr count */
510
if (op[0].word && intrq) { /* more and intr? */
511
AR = sa; /* restore A */
512
BR = sb; /* restore B */
513
PC = err_PC; /* restart instruction */
514
break;
515
}
516
}
517
while (op[0].word != 0); /* loop until count exhausted */
518
break;
519
520
case 030: /* .PACK 105230 (OP_RC) */
521
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
522
return stop_inst; /* trap if not */
523
524
O = fp_nrpack (&fpop, op[0], /* nrm/rnd/pack value */
525
(int16) (op[1].word), fp_f);
526
AR = fpop.fpk[0]; /* return result */
527
BR = fpop.fpk[1]; /* to A/B registers */
528
break;
529
530
case 031: /* .CFER 105231 (OP_AA) */
531
if ((UNIT_CPU_MODEL != UNIT_1000_E) && /* must be 1000 E-series */
532
(UNIT_CPU_MODEL != UNIT_1000_F)) /* or 1000 F-series */
533
return stop_inst; /* trap if not */
534
535
BR = op[0].word; /* get destination address */
536
AR = op[1].word; /* get source address */
537
sc = 4; /* set for 4-wd xfer */
538
CFER: /* enter here from .XFER */
539
for (j = 0; j < sc; j++) { /* xfer loop */
540
WriteW (BR, ReadW (AR)); /* transfer word */
541
AR = (AR + 1) & VAMASK; /* bump source addr */
542
BR = (BR + 1) & VAMASK; /* bump destination addr */
543
}
544
545
E = 0; /* routine clears E */
546
547
if (UNIT_CPU_TYPE == UNIT_TYPE_2100) { /* 2100 (and .DFER/.XFER)? */
548
AR = (AR + 1) & VAMASK; /* 2100 FFP returns X+4, Y+4 */
549
BR = (BR + 1) & VAMASK;
550
}
551
break;
552
553
default: /* others undefined */
554
reason = stop_inst;
555
}
556
557
return reason;
558
}
559
560
561
/* Double-Integer Instructions.
562
563
The double-integer instructions were added to the HP instruction set at
564
revision 1920 of the 1000-F. They were immediately adopted in a number of HP
565
software products, most notably the RTE file management package (FMP)
566
routines. As these routines are used in nearly every RTE program, F-Series
567
programs were almost always a few hundred bytes smaller than their M- and
568
E-Series counterparts. This became significant as RTE continued to grow in
569
size, and some customer programs ran out of address space on E-Series
570
machines.
571
572
While HP never added double-integer instructions to the standard E-Series, a
573
product from the HP "specials group," HP 93585A, provided microcoded
574
replacements for the E-Series. This could provide just enough address-space
575
savings to allow programs to load in E-Series systems, in addition to
576
accelerating these common operations.
577
578
M-Series microcode was never offered by HP. However, it costs us nothing to
579
enable double-integer instructions for M-Series simulations. This has the
580
concomitant advantage that it allows RTE-6/VM to run under SIMH (for
581
simulation, we must SET CPU 1000-M, because RTE-6/VM looks for the OS and VM
582
microcode -- which we do not implement yet -- if it detects an E- or F-Series
583
machine).
584
585
Option implementation by CPU was as follows:
586
587
2114 2115 2116 2100 1000-M 1000-E 1000-F
588
------ ------ ------ ------ ------ ------ ------
589
N/A N/A N/A N/A N/A 93575A std
590
591
The routines are mapped to instruction codes as follows:
592
593
Instr. 1000-E 1000-F Description
594
------ ------ ------ -----------------------------------------
595
[test] 105320 -- [self test]
596
.DAD 105321 105014 Double integer add
597
.DMP 105322 105054 Double integer multiply
598
.DNG 105323 105203 Double integer negate
599
.DCO 105324 105204 Double integer compare
600
.DDI 105325 105074 Double integer divide
601
.DDIR 105326 105134 Double integer divide (reversed)
602
.DSB 105327 105034 Double integer subtract
603
.DIN 105330 105210 Double integer increment
604
.DDE 105331 105211 Double integer decrement
605
.DIS 105332 105212 Double integer increment and skip if zero
606
.DDS 105333 105213 Double integer decrement and skip if zero
607
.DSBR 105334 105114 Double integer subtraction (reversed)
608
609
On the F-Series, the double-integer instruction codes are split among the
610
floating-point processor and the Fast FORTRAN Processor ranges. They are
611
dispatched from those respective simulators for processing here.
612
613
Notes:
614
615
1. The E-Series opcodes are listed in Appendix C of the Macro/1000 manual.
616
These should be the same opcodes as given in the 93585A manual listed
617
below, but no copy of the reference below has been located to confirm
618
the proper opcodes. This module should be corrected if needed when such
619
documentation is found.
620
621
2. The action of the self-test instruction (105320) is unknown. At the
622
moment, we take an unimplemented instruction trap for this. When
623
documentation explaining the action is located, it will be implemented.
624
625
3. The F-Series firmware executes .DMP and .DDI/.DDIR by floating the
626
32-bit double integer to a 48-bit extended-precision number, calling the
627
FPP to execute the extended-precision multiply/divide, and then fixing
628
the product to a 32-bit double integer. We simulate these directly with
629
64- or 32-bit integer arithmetic.
630
631
Additional references:
632
- 93575A Double Integer Instructions Installation and Reference Manual
633
(93575-90007)
634
*/
635
636
static const OP_PAT op_dbi[16] = {
637
OP_N, OP_JD, OP_JD, OP_J, /* [test] .DAD .DMP .DNG */
638
OP_JD, OP_JD, OP_JD, OP_JD, /* .DCO .DDI .DDIR .DSB */
639
OP_J, OP_J, OP_A, OP_A, /* .DIN .DDE .DIS .DDS */
640
OP_JD, OP_N, OP_N, OP_N /* .DSBR --- --- --- */
641
};
642
643
t_stat cpu_dbi (uint32 IR, uint32 intrq)
644
{
645
OP din;
646
OPS op;
647
uint32 entry, t;
648
t_stat reason = SCPE_OK;
649
650
if ((cpu_unit.flags & UNIT_DBI) == 0) /* DBI option installed? */
651
return stop_inst;
652
653
entry = IR & 017; /* mask to entry point */
654
655
if (op_dbi[entry] != OP_N)
656
if (reason = cpu_ops (op_dbi[entry], op, intrq)) /* get instruction operands */
657
return reason;
658
659
switch (entry) { /* decode IR<3:0> */
660
661
case 000: /* [test] 105320 (OP_N) */
662
t = (AR << 16) | BR; /* set t for nop */
663
reason = stop_inst; /* function unknown; not impl. */
664
break;
665
666
case 001: /* .DAD 105321 (OP_JD) */
667
t = op[0].dword + op[1].dword; /* add values */
668
E = E | (t < op[0].dword); /* carry if result smaller */
669
O = (((~op[0].dword ^ op[1].dword) & /* overflow if sign wrong */
670
(op[0].dword ^ t) & SIGN32) != 0);
671
break;
672
673
case 002: /* .DMP 105322 (OP_JD) */
674
{
675
676
#if defined (HAVE_INT64) /* int64 support available */
677
678
t_int64 t64;
679
680
t64 = (t_int64) op[0].dword * /* multiply values */
681
(t_int64) op[1].dword;
682
O = ((t64 < -(t_int64) 0x80000000) || /* overflow if out of range */
683
(t64 > (t_int64) 0x7FFFFFFF));
684
if (O)
685
t = ~SIGN32; /* if overflow, rtn max pos */
686
else
687
t = (uint32) (t64 & DMASK32); /* else lower 32 bits of result */
688
689
#else /* int64 support unavailable */
690
691
uint32 sign, xu, yu, rh, rl;
692
693
sign = ((int32) op[0].dword < 0) ^ /* save sign of result */
694
((int32) op[1].dword < 0);
695
696
xu = (uint32) abs ((int32) op[0].dword); /* make operands pos */
697
yu = (uint32) abs ((int32) op[1].dword);
698
699
if ((xu & 0xFFFF0000) == 0 && /* 16 x 16 multiply? */
700
(yu & 0xFFFF0000) == 0) {
701
t = xu * yu; /* do it */
702
O = 0; /* can't overflow */
703
}
704
705
else if ((xu & 0xFFFF0000) != 0 && /* 32 x 32 multiply? */
706
(yu & 0xFFFF0000) != 0)
707
O = 1; /* always overflows */
708
709
else { /* 16 x 32 or 32 x 16 */
710
rl = (xu & 0xFFFF) * (yu & 0xFFFF); /* form 1st partial product */
711
712
if ((xu & 0xFFFF0000) == 0)
713
rh = xu * (yu >> 16) + (rl >> 16); /* 16 x 32 2nd partial */
714
else
715
rh = (xu >> 16) * yu + (rl >> 16); /* 32 x 16 2nd partial */
716
717
O = (rh > 0x7FFF + sign); /* check for out of range */
718
if (O == 0)
719
t = (rh << 16) | (rl & 0xFFFF); /* combine partials */
720
}
721
722
if (O)
723
t = ~SIGN32; /* if overflow, rtn max pos */
724
else if (sign)
725
t = ~t + 1; /* if result neg, 2s compl */
726
727
#endif /* end of int64 support */
728
729
}
730
break;
731
732
case 003: /* .DNG 105323 (OP_J) */
733
t = ~op[0].dword + 1; /* negate value */
734
O = (op[0].dword == SIGN32); /* overflow if max neg */
735
if (op[0].dword == 0) /* borrow if result zero */
736
E = 1;
737
break;
738
739
case 004: /* .DCO 105324 (OP_JD) */
740
t = op[0].dword; /* copy for later store */
741
if ((int32) op[0].dword < (int32) op[1].dword)
742
PC = (PC + 1) & VAMASK; /* < rtns to P+2 */
743
else if ((int32) op[0].dword > (int32) op[1].dword)
744
PC = (PC + 2) & VAMASK; /* > rtns to P+3 */
745
break; /* = rtns to P+1 */
746
747
case 005: /* .DDI 105325 (OP_JD) */
748
DDI:
749
O = ((op[1].dword == 0) || /* overflow if div 0 */
750
((op[0].dword == SIGN32) && /* or max neg div -1 */
751
((int32) op[1].dword == -1)));
752
if (O)
753
t = ~SIGN32; /* rtn max pos for ovf */
754
else
755
t = op[0].dword / op[1].dword; /* else return quotient */
756
break;
757
758
case 006: /* .DDIR 105326 (OP_JD) */
759
t = op[0].dword; /* swap operands */
760
op[0].dword = op[1].dword;
761
op[1].dword = t;
762
goto DDI; /* continue at .DDI */
763
764
case 007: /* .DSB 105327 (OP_JD) */
765
DSB:
766
t = op[0].dword - op[1].dword; /* subtract values */
767
E = E | (op[0].dword < op[1].dword); /* borrow if minu < subtr */
768
O = (((op[0].dword ^ op[1].dword) & /* overflow if sign wrong */
769
(op[0].dword ^ t) & SIGN32) != 0);
770
break;
771
772
case 010: /* .DIN 105330 (OP_J) */
773
t = op[0].dword + 1; /* increment value */
774
O = (t == SIGN32); /* overflow if sign flipped */
775
if (t == 0)
776
E = 1; /* carry if result zero */
777
break;
778
779
case 011: /* .DDE 105331 (OP_J) */
780
t = op[0].dword - 1; /* decrement value */
781
O = (t == ~SIGN32); /* overflow if sign flipped */
782
if ((int32) t == -1)
783
E = 1; /* borrow if result -1 */
784
break;
785
786
case 012: /* .DIS 105332 (OP_A) */
787
din = ReadOp (op[0].word, in_d); /* get value */
788
t = din.dword = din.dword + 1; /* increment value */
789
WriteOp (op[0].word, din, in_d); /* store it back */
790
if (t == 0)
791
PC = (PC + 1) & VAMASK; /* skip if result zero */
792
break;
793
794
case 013: /* .DDS 105333 (OP_A) */
795
din = ReadOp (op[0].word, in_d); /* get value */
796
t = din.dword = din.dword - 1; /* decrement value */
797
WriteOp (op[0].word, din, in_d); /* write it back */
798
if (t == 0)
799
PC = (PC + 1) & VAMASK; /* skip if result zero */
800
break;
801
802
case 014: /* .DSBR 105334 (OP_JD) */
803
t = op[0].dword; /* swap operands */
804
op[0].dword = op[1].dword;
805
op[1].dword = t;
806
goto DSB; /* continue at .DSB */
807
808
default: /* others undefined */
809
t = (AR << 16) | BR; /* set t for nop */
810
reason = stop_inst;
811
}
812
813
if (reason == SCPE_OK) { /* if return OK */
814
AR = (t >> 16) & DMASK; /* break result */
815
BR = t & DMASK; /* into A and B */
816
}
817
818
return reason;
819
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1