53d02f7fa7
1. New Features 1.1 3.7-0 1.1.1 SCP - Added SET THROTTLE and SET NOTHROTTLE commands to regulate simulator execution rate and host resource utilization. - Added idle support (based on work by Mark Pizzolato). - Added -e to control error processing in nested DO commands (from Dave Bryan). 1.1.2 HP2100 - Added Double Integer instructions, 1000-F CPU, and Floating Point Processor (from Dave Bryan). - Added 2114 and 2115 CPUs, 12607B and 12578A DMA controllers, and 21xx binary loader protection (from Dave Bryan). 1.1.3 Interdata - Added SET IDLE and SET NOIDLE commands to idle the simulator in wait state. 1.1.4 PDP-11 - Added SET IDLE and SET NOIDLE commands to idle the simulator in wait state (WAIT instruction executed). - Added TA11/TU60 cassette support. 1.1.5 PDP-8 - Added SET IDLE and SET NOIDLE commands to idle the simulator in wait state (keyboard poll loop or jump-to-self). - Added TA8E/TU60 cassette support. 1.1.6 PDP-1 - Added support for 16-channel sequence break system. - Added support for PDP-1D extended features and timesharing clock. - Added support for Type 630 data communications subsystem. 1.1.6 PDP-4/7/9/15 - Added SET IDLE and SET NOIDLE commands to idle the simulator in wait state (keyboard poll loop or jump-to-self). 1.1.7 VAX, VAX780 - Added SET IDLE and SET NOIDLE commands to idle the simulator in wait state (more than 200 cycles at IPL's 0, 1, or 3 in kernel mode). 1.1.8 PDP-10 - Added SET IDLE and SET NOIDLE commands to idle the simulator in wait state (operating system dependent). - Added CD20 (CD11) support. 2. Bugs Fixed Please see the revision history on http://simh.trailing-edge.com or in the source module sim_rev.h.
819 lines
41 KiB
C
819 lines
41 KiB
C
/* hp2100_cpu3.c: HP 2100/1000 FFP/DBI instructions
|
|
|
|
Copyright (c) 2005-2006, J. David Bryan
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a
|
|
copy of this software and associated documentation files (the "Software"),
|
|
to deal in the Software without restriction, including without limitation
|
|
the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
|
and/or sell copies of the Software, and to permit persons to whom the
|
|
Software is furnished to do so, subject to the following conditions:
|
|
|
|
The above copyright notice and this permission notice shall be included in
|
|
all copies or substantial portions of the Software.
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
|
THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
|
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
|
|
Except as contained in this notice, the name of the author shall not be
|
|
used in advertising or otherwise to promote the sale, use or other dealings
|
|
in this Software without prior written authorization from the author.
|
|
|
|
CPU3 Fast FORTRAN and Double Integer instructions
|
|
|
|
16-Oct-06 JDB Calls FPP for extended-precision math
|
|
12-Oct-06 JDB Altered DBLE, DDINT for F-Series FFP compatibility
|
|
26-Sep-06 JDB Moved from hp2100_cpu1.c to simplify extensions
|
|
09-Aug-06 JDB Added double-integer instruction set
|
|
18-Feb-05 JDB Add 2100/21MX Fast FORTRAN Processor instructions
|
|
|
|
Primary references:
|
|
- HP 1000 M/E/F-Series Computers Technical Reference Handbook
|
|
(5955-0282, Mar-1980)
|
|
- HP 1000 M/E/F-Series Computers Engineering and Reference Documentation
|
|
(92851-90001, Mar-1981)
|
|
- Macro/1000 Reference Manual (92059-90001, Dec-1992)
|
|
|
|
Additional references are listed with the associated firmware
|
|
implementations, as are the HP option model numbers pertaining to the
|
|
applicable CPUs.
|
|
*/
|
|
|
|
#include "hp2100_defs.h"
|
|
#include "hp2100_cpu.h"
|
|
#include "hp2100_cpu1.h"
|
|
|
|
#if defined (HAVE_INT64) /* int64 support available */
|
|
#include "hp2100_fp1.h"
|
|
#else /* int64 support unavailable */
|
|
#include "hp2100_fp.h"
|
|
#endif /* end of int64 support */
|
|
|
|
|
|
t_stat cpu_ffp (uint32 IR, uint32 intrq); /* Fast FORTRAN Processor */
|
|
t_stat cpu_dbi (uint32 IR, uint32 intrq); /* Double-Integer instructions */
|
|
|
|
|
|
/* Fast FORTRAN Processor.
|
|
|
|
The Fast FORTRAN Processor (FFP) is a set of FORTRAN language accelerators
|
|
and extended-precision (three-word) floating point routines. Although the
|
|
FFP is an option for the 2100 and later CPUs, each implements the FFP in a
|
|
slightly different form.
|
|
|
|
Option implementation by CPU was as follows:
|
|
|
|
2114 2115 2116 2100 1000-M 1000-E 1000-F
|
|
------ ------ ------ ------ ------ ------ ------
|
|
N/A N/A N/A 12907A 12977B 13306B std
|
|
|
|
The instruction codes are mapped to routines as follows:
|
|
|
|
Instr. 2100 1000-M 1000-E 1000-F Instr. 2100 1000-M 1000-E 1000-F
|
|
------ ------ ------ ------ ------ ------ ------ ------ ------ ------
|
|
105200 -- [nop] [nop] [test] 105220 .XFER .XFER .XFER .XFER
|
|
105201 DBLE DBLE DBLE DBLE 105221 .GOTO .GOTO .GOTO .GOTO
|
|
105202 SNGL SNGL SNGL SNGL 105222 ..MAP ..MAP ..MAP ..MAP
|
|
105203 .XMPY .XMPY .XMPY .DNG 105223 .ENTR .ENTR .ENTR .ENTR
|
|
105204 .XDIV .XDIV .XDIV .DCO 105224 .ENTP .ENTP .ENTP .ENTP
|
|
105205 .DFER .DFER .DFER .DFER 105225 -- .PWR2 .PWR2 .PWR2
|
|
105206 -- .XPAK .XPAK .XPAK 105226 -- .FLUN .FLUN .FLUN
|
|
105207 -- XADD XADD .BLE 105227 $SETP $SETP $SETP $SETP
|
|
|
|
105210 -- XSUB XSUB .DIN 105230 -- .PACK .PACK .PACK
|
|
105211 -- XMPY XMPY .DDE 105231 -- -- .CFER .CFER
|
|
105212 -- XDIV XDIV .DIS 105232 -- -- -- ..FCM
|
|
105213 .XADD .XADD .XADD .DDS 105233 -- -- -- ..TCM
|
|
105214 .XSUB .XSUB .XSUB .NGL 105234 -- -- -- --
|
|
105215 -- .XCOM .XCOM .XCOM 105235 -- -- -- --
|
|
105216 -- ..DCM ..DCM ..DCM 105236 -- -- -- --
|
|
105217 -- DDINT DDINT DDINT 105237 -- -- -- --
|
|
|
|
The F-Series maps different instructions to several of the standard FFP
|
|
opcodes. We first look for these and dispatch them appropriately before
|
|
falling into the handler for the common instructions.
|
|
|
|
The math functions use the F-Series FPP for implementation. The FPP requires
|
|
that the host compiler support 64-bit integers. Therefore, if 64-bit
|
|
integers are not available, the math instructions of the FFP are disabled.
|
|
We allow this partial implementation as an aid in running systems generated
|
|
for the FFP. Most system programs did not use the math instructions, but
|
|
almost all use .ENTR. Supporting the latter even on systems that do not
|
|
support the former still allows such systems to boot.
|
|
|
|
Notes:
|
|
|
|
1. The "$SETP" instruction is sometimes listed as ".SETP" in the
|
|
documentation.
|
|
|
|
2. Extended-precision arithmetic routines (e.g., .XMPY) exist on the
|
|
1000-F, but they are assigned instruction codes in the single-precision
|
|
floating-point module range. They are replaced by several double
|
|
integer instructions, which we dispatch to the double integer handler.
|
|
|
|
3. The software implementation of ..MAP supports 1-, 2-, or 3-dimensional
|
|
arrays, designated by setting A = -1, 0, and +1, respectively. The
|
|
firmware implementation supports only 2- and 3-dimensional access.
|
|
|
|
4. The documentation for ..MAP for the 2100 FFP shows A = 0 or -1 for two
|
|
or three dimensions, respectively, but the 1000 FFP shows A = 0 or +1.
|
|
The firmware actually only checks the LSB of A.
|
|
|
|
5. The .DFER and .XFER implementations for the 2100 FFP return X+4 and Y+4
|
|
in the A and B registers, whereas the 1000 FFP returns X+3 and Y+3.
|
|
|
|
6. The .XFER implementation for the 2100 FFP returns to P+2, whereas the
|
|
1000 implementation returns to P+1.
|
|
|
|
7. The firmware implementations of DBLE, .BLE, and DDINT clear the overflow
|
|
flag. The software implementations do not change overflow.
|
|
|
|
8. The M/E-Series FFP arithmetic instructions (.XADD, etc.) return negative
|
|
infinity on negative overflow and positive infinity on positive
|
|
overflow. The equivalent F-Series instructions return positive infinity
|
|
on both.
|
|
|
|
Additional references:
|
|
- DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)
|
|
- Implementing the HP 2100 Fast FORTRAN Processor (12907-90010, Nov-1974)
|
|
*/
|
|
|
|
static const OP_PAT op_ffp_f[32] = { /* patterns for F-Series only */
|
|
OP_N, OP_AAF, OP_AX, OP_N, /* [tst] DBLE SNGL .DNG */
|
|
OP_N, OP_AA, OP_A, OP_AAF, /* .DCO .DFER .XPAK .BLE */
|
|
OP_N, OP_N, OP_N, OP_N, /* .DIN .DDE .DIS .DDS */
|
|
OP_AT, OP_A, OP_A, OP_AAX, /* .NGL .XCOM ..DCM DDINT */
|
|
OP_N, OP_AK, OP_KKKK, OP_A, /* .XFER .GOTO ..MAP .ENTR */
|
|
OP_A, OP_RK, OP_R, OP_K, /* .ENTP .PWR2 .FLUN $SETP */
|
|
OP_RC, OP_AA, OP_R, OP_A, /* .PACK .CFER ..FCM ..TCM */
|
|
OP_N, OP_N, OP_N, OP_N /* --- --- --- --- */
|
|
};
|
|
|
|
static const OP_PAT op_ffp_e[32] = { /* patterns for 2100/M/E-Series */
|
|
OP_N, OP_AAF, OP_AX, OP_AXX, /* [nop] DBLE SNGL .XMPY */
|
|
OP_AXX, OP_AA, OP_A, OP_AAXX, /* .XDIV .DFER .XPAK XADD */
|
|
OP_AAXX, OP_AAXX, OP_AAXX, OP_AXX, /* XSUB XMPY XDIV .XADD */
|
|
OP_AXX, OP_A, OP_A, OP_AAX, /* .XSUB .XCOM ..DCM DDINT */
|
|
OP_N, OP_AK, OP_KKKK, OP_A, /* .XFER .GOTO ..MAP .ENTR */
|
|
OP_A, OP_RK, OP_R, OP_K, /* .ENTP .PWR2 .FLUN $SETP */
|
|
OP_RC, OP_AA, OP_N, OP_N, /* .PACK .CFER --- --- */
|
|
OP_N, OP_N, OP_N, OP_N /* --- --- --- --- */
|
|
};
|
|
|
|
t_stat cpu_ffp (uint32 IR, uint32 intrq)
|
|
{
|
|
OP fpop;
|
|
OPS op, op2;
|
|
uint32 entry;
|
|
uint32 j, sa, sb, sc, da, dc, ra, MA;
|
|
int32 expon;
|
|
t_stat reason = SCPE_OK;
|
|
|
|
#if defined (HAVE_INT64) /* int64 support available */
|
|
|
|
int32 i;
|
|
|
|
#endif /* end of int64 support */
|
|
|
|
if ((cpu_unit.flags & UNIT_FFP) == 0) /* FFP option installed? */
|
|
return stop_inst;
|
|
|
|
entry = IR & 037; /* mask to entry point */
|
|
|
|
if (UNIT_CPU_MODEL != UNIT_1000_F) { /* 2100/M/E-Series? */
|
|
if (op_ffp_e[entry] != OP_N)
|
|
if (reason = cpu_ops (op_ffp_e[entry], op, intrq)) /* get instruction operands */
|
|
return reason;
|
|
}
|
|
|
|
#if defined (HAVE_INT64) /* int64 support available */
|
|
|
|
else { /* F-Series */
|
|
if (op_ffp_f[entry] != OP_N)
|
|
if (reason = cpu_ops (op_ffp_f[entry], op, intrq)) /* get instruction operands */
|
|
return reason;
|
|
|
|
switch (entry) { /* decode IR<4:0> */
|
|
|
|
case 000: /* [tst] 105200 (OP_N) */
|
|
XR = 4; /* firmware revision */
|
|
SR = 0102077; /* test passed code */
|
|
AR = 0; /* test clears A/B */
|
|
BR = 0;
|
|
PC = (PC + 1) & VAMASK; /* P+2 return for firmware w/DBI */
|
|
return reason;
|
|
|
|
case 003: /* .DNG 105203 (OP_N) */
|
|
return cpu_dbi (0105323, intrq); /* remap to double int handler */
|
|
|
|
case 004: /* .DCO 105204 (OP_N) */
|
|
return cpu_dbi (0105324, intrq); /* remap to double int handler */
|
|
|
|
case 007: /* .BLE 105207 (OP_AAF) */
|
|
O = fp_cvt (&op[2], fp_f, fp_t); /* convert value and clear overflow */
|
|
WriteOp (op[1].word, op[2], fp_t); /* write double-precision value */
|
|
return reason;
|
|
|
|
case 010: /* .DIN 105210 (OP_N) */
|
|
return cpu_dbi (0105330, intrq); /* remap to double int handler */
|
|
|
|
case 011: /* .DDE 105211 (OP_N) */
|
|
return cpu_dbi (0105331, intrq); /* remap to double int handler */
|
|
|
|
case 012: /* .DIS 105212 (OP_N) */
|
|
return cpu_dbi (0105332, intrq); /* remap to double int handler */
|
|
|
|
case 013: /* .DDS 105213 (OP_N) */
|
|
return cpu_dbi (0105333, intrq); /* remap to double int handler */
|
|
|
|
case 014: /* .NGL 105214 (OP_AT) */
|
|
O = fp_cvt (&op[1], fp_t, fp_f); /* convert value */
|
|
AR = op[1].fpk[0]; /* move MSB to A */
|
|
BR = op[1].fpk[1]; /* move LSB to B */
|
|
return reason;
|
|
|
|
case 032: /* ..FCM 105232 (OP_R) */
|
|
O = fp_pcom (&op[0], fp_f); /* complement value */
|
|
AR = op[0].fpk[0]; /* return result */
|
|
BR = op[0].fpk[1]; /* to A/B registers */
|
|
return reason;
|
|
|
|
case 033: /* ..TCM 105233 (OP_A) */
|
|
fpop = ReadOp (op[0].word, fp_t); /* read 4-word value */
|
|
O = fp_pcom (&fpop, fp_t); /* complement it */
|
|
WriteOp (op[0].word, fpop, fp_t); /* write 4-word value */
|
|
return reason;
|
|
} /* fall thru if not special to F */
|
|
}
|
|
|
|
#endif /* end of int64 support */
|
|
|
|
switch (entry) { /* decode IR<4:0> */
|
|
|
|
/* FFP module 1 */
|
|
|
|
case 000: /* [nop] 105200 (OP_N) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 M/E-series */
|
|
return stop_inst; /* trap if not */
|
|
break;
|
|
|
|
#if defined (HAVE_INT64) /* int64 support available */
|
|
|
|
case 001: /* DBLE 105201 (OP_AAF) */
|
|
O = fp_cvt (&op[2], fp_f, fp_x); /* convert value and clear overflow */
|
|
WriteOp (op[1].word, op[2], fp_x); /* write extended-precision value */
|
|
break;
|
|
|
|
case 002: /* SNGL 105202 (OP_AX) */
|
|
O = fp_cvt (&op[1], fp_x, fp_f); /* convert value */
|
|
AR = op[1].fpk[0]; /* move MSB to A */
|
|
BR = op[1].fpk[1]; /* move LSB to B */
|
|
break;
|
|
|
|
case 003: /* .XMPY 105203 (OP_AXX) */
|
|
i = 0; /* params start at op[0] */
|
|
goto XMPY; /* process as XMPY */
|
|
|
|
case 004: /* .XDIV 105204 (OP_AXX) */
|
|
i = 0; /* params start at op[0] */
|
|
goto XDIV; /* process as XDIV */
|
|
|
|
#endif /* end of int64 support */
|
|
|
|
case 005: /* .DFER 105205 (OP_AA) */
|
|
BR = op[0].word; /* get destination address */
|
|
AR = op[1].word; /* get source address */
|
|
goto XFER; /* do transfer */
|
|
|
|
#if defined (HAVE_INT64) /* int64 support available */
|
|
|
|
case 006: /* .XPAK 105206 (OP_A) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
|
|
return stop_inst; /* trap if not */
|
|
|
|
if (intrq) { /* interrupt pending? */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
|
|
fpop = ReadOp (op[0].word, fp_x); /* read unpacked */
|
|
O = fp_nrpack (&fpop, fpop, (int16) AR, fp_x); /* nrm/rnd/pack mantissa, exponent */
|
|
WriteOp (op[0].word, fpop, fp_x); /* write result */
|
|
break;
|
|
|
|
case 007: /* XADD 105207 (OP_AAXX) */
|
|
i = 1; /* params start at op[1] */
|
|
XADD: /* enter here from .XADD */
|
|
if (intrq) { /* interrupt pending? */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
|
|
O = fp_exec (001, &fpop, op[i + 1], op[i + 2]); /* three-word add */
|
|
WriteOp (op[i].word, fpop, fp_x); /* write sum */
|
|
break;
|
|
|
|
case 010: /* XSUB 105210 (OP_AAXX) */
|
|
i = 1; /* params start at op[1] */
|
|
XSUB: /* enter here from .XSUB */
|
|
if (intrq) { /* interrupt pending? */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
|
|
O = fp_exec (021, &fpop, op[i + 1], op[i + 2]); /* three-word subtract */
|
|
WriteOp (op[i].word, fpop, fp_x); /* write difference */
|
|
break;
|
|
|
|
case 011: /* XMPY 105211 (OP_AAXX) */
|
|
i = 1; /* params start at op[1] */
|
|
XMPY: /* enter here from .XMPY */
|
|
if (intrq) { /* interrupt pending? */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
|
|
O = fp_exec (041, &fpop, op[i + 1], op[i + 2]); /* three-word multiply */
|
|
WriteOp (op[i].word, fpop, fp_x); /* write product */
|
|
break;
|
|
|
|
case 012: /* XDIV 105212 (OP_AAXX) */
|
|
i = 1; /* params start at op[1] */
|
|
XDIV: /* enter here from .XDIV */
|
|
if (intrq) { /* interrupt pending? */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
|
|
O = fp_exec (061, &fpop, op[i + 1], op[i + 2]); /* three-word divide */
|
|
WriteOp (op[i].word, fpop, fp_x); /* write quotient */
|
|
break;
|
|
|
|
case 013: /* .XADD 105213 (OP_AXX) */
|
|
i = 0; /* params start at op[0] */
|
|
goto XADD; /* process as XADD */
|
|
|
|
case 014: /* .XSUB 105214 (OP_AXX) */
|
|
i = 0; /* params start at op[0] */
|
|
goto XSUB; /* process as XSUB */
|
|
|
|
case 015: /* .XCOM 105215 (OP_A) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
|
|
return stop_inst; /* trap if not */
|
|
|
|
fpop = ReadOp (op[0].word, fp_x); /* read unpacked */
|
|
AR = fp_ucom (&fpop, fp_x); /* complement and rtn exp adj */
|
|
WriteOp (op[0].word, fpop, fp_x); /* write result */
|
|
break;
|
|
|
|
case 016: /* ..DCM 105216 (OP_A) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
|
|
return stop_inst; /* trap if not */
|
|
|
|
if (intrq) { /* interrupt pending? */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
|
|
fpop = ReadOp (op[0].word, fp_x); /* read operand */
|
|
O = fp_pcom (&fpop, fp_x); /* complement (can't ovf neg) */
|
|
WriteOp (op[0].word, fpop, fp_x); /* write result */
|
|
break;
|
|
|
|
case 017: /* DDINT 105217 (OP_AAX) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
|
|
return stop_inst; /* trap if not */
|
|
|
|
if (intrq) { /* interrupt pending? */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
|
|
O = fp_trun (&fpop, op[2], fp_x); /* truncate operand (can't ovf) */
|
|
WriteOp (op[1].word, fpop, fp_x); /* write result */
|
|
break;
|
|
|
|
#endif /* end of int64 support */
|
|
|
|
/* FFP module 2 */
|
|
|
|
case 020: /* .XFER 105220 (OP_N) */
|
|
if (UNIT_CPU_TYPE == UNIT_TYPE_2100)
|
|
PC = (PC + 1) & VAMASK; /* 2100 .XFER returns to P+2 */
|
|
XFER: /* enter here from .DFER */
|
|
sc = 3; /* set count for 3-wd xfer */
|
|
goto CFER; /* do transfer */
|
|
|
|
case 021: /* .GOTO 105221 (OP_AK) */
|
|
if ((int16) op[1].word < 1) /* index < 1? */
|
|
op[1].word = 1; /* reset min */
|
|
|
|
sa = PC + op[1].word - 1; /* point to jump target */
|
|
if (sa >= op[0].word) /* must be <= last target */
|
|
sa = op[0].word - 1;
|
|
|
|
da = ReadW (sa); /* get jump target */
|
|
if (reason = resolve (da, &MA, intrq)) { /* resolve indirects */
|
|
PC = err_PC; /* irq restarts instruction */
|
|
break;
|
|
}
|
|
|
|
mp_dms_jmp (MA); /* validate jump addr */
|
|
PCQ_ENTRY; /* record last PC */
|
|
PC = MA; /* jump */
|
|
BR = op[0].word; /* (for 2100 FFP compat) */
|
|
break;
|
|
|
|
case 022: /* ..MAP 105222 (OP_KKKK) */
|
|
op[1].word = op[1].word - 1; /* decrement 1st subscr */
|
|
|
|
if ((AR & 1) == 0) /* 2-dim access? */
|
|
op[1].word = op[1].word + /* compute element offset */
|
|
(op[2].word - 1) * op[3].word;
|
|
else { /* 3-dim access */
|
|
if (reason = cpu_ops (OP_KK, op2, intrq)) { /* get 1st, 2nd ranges */
|
|
PC = err_PC; /* irq restarts instruction */
|
|
break;
|
|
}
|
|
op[1].word = op[1].word + /* offset */
|
|
((op[3].word - 1) * op2[1].word +
|
|
op[2].word - 1) * op2[0].word;
|
|
}
|
|
|
|
AR = (op[0].word + op[1].word * BR) & DMASK; /* return element address */
|
|
break;
|
|
|
|
case 023: /* .ENTR 105223 (OP_A) */
|
|
MA = PC - 3; /* get addr of entry point */
|
|
ENTR: /* enter here from .ENTP */
|
|
da = op[0].word; /* get addr of 1st formal */
|
|
dc = MA - da; /* get count of formals */
|
|
sa = ReadW (MA); /* get addr of return point */
|
|
ra = ReadW (sa++); /* get rtn, ptr to 1st actual */
|
|
WriteW (MA, ra); /* stuff rtn into caller's ent */
|
|
sc = ra - sa; /* get count of actuals */
|
|
if (sc > dc) /* use min (actuals, formals) */
|
|
sc = dc;
|
|
|
|
for (j = 0; j < sc; j++) {
|
|
MA = ReadW (sa++); /* get addr of actual */
|
|
if (reason = resolve (MA, &MA, intrq)) { /* resolve indirect */
|
|
PC = err_PC; /* irq restarts instruction */
|
|
break;
|
|
}
|
|
WriteW (da++, MA); /* put addr into formal */
|
|
}
|
|
|
|
AR = ra; /* return address */
|
|
BR = da; /* addr of 1st unused formal */
|
|
break;
|
|
|
|
case 024: /* .ENTP 105224 (OP_A) */
|
|
MA = PC - 5; /* get addr of entry point */
|
|
goto ENTR;
|
|
|
|
case 025: /* .PWR2 105225 (OP_RK) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
|
|
return stop_inst; /* trap if not */
|
|
|
|
fp_unpack (&fpop, &expon, op[0], fp_f); /* unpack value */
|
|
expon = expon + (int16) (op[1].word); /* multiply by 2**n */
|
|
fp_pack (&fpop, fpop, expon, fp_f); /* repack value */
|
|
AR = fpop.fpk[0]; /* return result */
|
|
BR = fpop.fpk[1]; /* to A/B registers */
|
|
break;
|
|
|
|
case 026: /* .FLUN 105226 (OP_R) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
|
|
return stop_inst; /* trap if not */
|
|
|
|
fp_unpack (&fpop, &expon, op[0], fp_f); /* unpack value */
|
|
AR = (int16) expon; /* return expon to A */
|
|
BR = fpop.fpk[1]; /* and low mant to B */
|
|
break;
|
|
|
|
case 027: /* $SETP 105227 (OP_K) */
|
|
j = sa = AR; /* save initial value */
|
|
sb = BR; /* save initial address */
|
|
AR = 0; /* AR will return = 0 */
|
|
BR = BR & VAMASK; /* addr must be direct */
|
|
|
|
do {
|
|
WriteW (BR, j); /* write value to address */
|
|
j = (j + 1) & DMASK; /* incr value */
|
|
BR = (BR + 1) & VAMASK; /* incr address */
|
|
op[0].word = op[0].word - 1; /* decr count */
|
|
if (op[0].word && intrq) { /* more and intr? */
|
|
AR = sa; /* restore A */
|
|
BR = sb; /* restore B */
|
|
PC = err_PC; /* restart instruction */
|
|
break;
|
|
}
|
|
}
|
|
while (op[0].word != 0); /* loop until count exhausted */
|
|
break;
|
|
|
|
case 030: /* .PACK 105230 (OP_RC) */
|
|
if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */
|
|
return stop_inst; /* trap if not */
|
|
|
|
O = fp_nrpack (&fpop, op[0], /* nrm/rnd/pack value */
|
|
(int16) (op[1].word), fp_f);
|
|
AR = fpop.fpk[0]; /* return result */
|
|
BR = fpop.fpk[1]; /* to A/B registers */
|
|
break;
|
|
|
|
case 031: /* .CFER 105231 (OP_AA) */
|
|
if ((UNIT_CPU_MODEL != UNIT_1000_E) && /* must be 1000 E-series */
|
|
(UNIT_CPU_MODEL != UNIT_1000_F)) /* or 1000 F-series */
|
|
return stop_inst; /* trap if not */
|
|
|
|
BR = op[0].word; /* get destination address */
|
|
AR = op[1].word; /* get source address */
|
|
sc = 4; /* set for 4-wd xfer */
|
|
CFER: /* enter here from .XFER */
|
|
for (j = 0; j < sc; j++) { /* xfer loop */
|
|
WriteW (BR, ReadW (AR)); /* transfer word */
|
|
AR = (AR + 1) & VAMASK; /* bump source addr */
|
|
BR = (BR + 1) & VAMASK; /* bump destination addr */
|
|
}
|
|
|
|
E = 0; /* routine clears E */
|
|
|
|
if (UNIT_CPU_TYPE == UNIT_TYPE_2100) { /* 2100 (and .DFER/.XFER)? */
|
|
AR = (AR + 1) & VAMASK; /* 2100 FFP returns X+4, Y+4 */
|
|
BR = (BR + 1) & VAMASK;
|
|
}
|
|
break;
|
|
|
|
default: /* others undefined */
|
|
reason = stop_inst;
|
|
}
|
|
|
|
return reason;
|
|
}
|
|
|
|
|
|
/* Double-Integer Instructions.
|
|
|
|
The double-integer instructions were added to the HP instruction set at
|
|
revision 1920 of the 1000-F. They were immediately adopted in a number of HP
|
|
software products, most notably the RTE file management package (FMP)
|
|
routines. As these routines are used in nearly every RTE program, F-Series
|
|
programs were almost always a few hundred bytes smaller than their M- and
|
|
E-Series counterparts. This became significant as RTE continued to grow in
|
|
size, and some customer programs ran out of address space on E-Series
|
|
machines.
|
|
|
|
While HP never added double-integer instructions to the standard E-Series, a
|
|
product from the HP "specials group," HP 93585A, provided microcoded
|
|
replacements for the E-Series. This could provide just enough address-space
|
|
savings to allow programs to load in E-Series systems, in addition to
|
|
accelerating these common operations.
|
|
|
|
M-Series microcode was never offered by HP. However, it costs us nothing to
|
|
enable double-integer instructions for M-Series simulations. This has the
|
|
concomitant advantage that it allows RTE-6/VM to run under SIMH (for
|
|
simulation, we must SET CPU 1000-M, because RTE-6/VM looks for the OS and VM
|
|
microcode -- which we do not implement yet -- if it detects an E- or F-Series
|
|
machine).
|
|
|
|
Option implementation by CPU was as follows:
|
|
|
|
2114 2115 2116 2100 1000-M 1000-E 1000-F
|
|
------ ------ ------ ------ ------ ------ ------
|
|
N/A N/A N/A N/A N/A 93575A std
|
|
|
|
The routines are mapped to instruction codes as follows:
|
|
|
|
Instr. 1000-E 1000-F Description
|
|
------ ------ ------ -----------------------------------------
|
|
[test] 105320 -- [self test]
|
|
.DAD 105321 105014 Double integer add
|
|
.DMP 105322 105054 Double integer multiply
|
|
.DNG 105323 105203 Double integer negate
|
|
.DCO 105324 105204 Double integer compare
|
|
.DDI 105325 105074 Double integer divide
|
|
.DDIR 105326 105134 Double integer divide (reversed)
|
|
.DSB 105327 105034 Double integer subtract
|
|
.DIN 105330 105210 Double integer increment
|
|
.DDE 105331 105211 Double integer decrement
|
|
.DIS 105332 105212 Double integer increment and skip if zero
|
|
.DDS 105333 105213 Double integer decrement and skip if zero
|
|
.DSBR 105334 105114 Double integer subtraction (reversed)
|
|
|
|
On the F-Series, the double-integer instruction codes are split among the
|
|
floating-point processor and the Fast FORTRAN Processor ranges. They are
|
|
dispatched from those respective simulators for processing here.
|
|
|
|
Notes:
|
|
|
|
1. The E-Series opcodes are listed in Appendix C of the Macro/1000 manual.
|
|
These should be the same opcodes as given in the 93585A manual listed
|
|
below, but no copy of the reference below has been located to confirm
|
|
the proper opcodes. This module should be corrected if needed when such
|
|
documentation is found.
|
|
|
|
2. The action of the self-test instruction (105320) is unknown. At the
|
|
moment, we take an unimplemented instruction trap for this. When
|
|
documentation explaining the action is located, it will be implemented.
|
|
|
|
3. The F-Series firmware executes .DMP and .DDI/.DDIR by floating the
|
|
32-bit double integer to a 48-bit extended-precision number, calling the
|
|
FPP to execute the extended-precision multiply/divide, and then fixing
|
|
the product to a 32-bit double integer. We simulate these directly with
|
|
64- or 32-bit integer arithmetic.
|
|
|
|
Additional references:
|
|
- 93575A Double Integer Instructions Installation and Reference Manual
|
|
(93575-90007)
|
|
*/
|
|
|
|
static const OP_PAT op_dbi[16] = {
|
|
OP_N, OP_JD, OP_JD, OP_J, /* [test] .DAD .DMP .DNG */
|
|
OP_JD, OP_JD, OP_JD, OP_JD, /* .DCO .DDI .DDIR .DSB */
|
|
OP_J, OP_J, OP_A, OP_A, /* .DIN .DDE .DIS .DDS */
|
|
OP_JD, OP_N, OP_N, OP_N /* .DSBR --- --- --- */
|
|
};
|
|
|
|
t_stat cpu_dbi (uint32 IR, uint32 intrq)
|
|
{
|
|
OP din;
|
|
OPS op;
|
|
uint32 entry, t;
|
|
t_stat reason = SCPE_OK;
|
|
|
|
if ((cpu_unit.flags & UNIT_DBI) == 0) /* DBI option installed? */
|
|
return stop_inst;
|
|
|
|
entry = IR & 017; /* mask to entry point */
|
|
|
|
if (op_dbi[entry] != OP_N)
|
|
if (reason = cpu_ops (op_dbi[entry], op, intrq)) /* get instruction operands */
|
|
return reason;
|
|
|
|
switch (entry) { /* decode IR<3:0> */
|
|
|
|
case 000: /* [test] 105320 (OP_N) */
|
|
t = (AR << 16) | BR; /* set t for nop */
|
|
reason = stop_inst; /* function unknown; not impl. */
|
|
break;
|
|
|
|
case 001: /* .DAD 105321 (OP_JD) */
|
|
t = op[0].dword + op[1].dword; /* add values */
|
|
E = E | (t < op[0].dword); /* carry if result smaller */
|
|
O = (((~op[0].dword ^ op[1].dword) & /* overflow if sign wrong */
|
|
(op[0].dword ^ t) & SIGN32) != 0);
|
|
break;
|
|
|
|
case 002: /* .DMP 105322 (OP_JD) */
|
|
{
|
|
|
|
#if defined (HAVE_INT64) /* int64 support available */
|
|
|
|
t_int64 t64;
|
|
|
|
t64 = (t_int64) op[0].dword * /* multiply values */
|
|
(t_int64) op[1].dword;
|
|
O = ((t64 < -(t_int64) 0x80000000) || /* overflow if out of range */
|
|
(t64 > (t_int64) 0x7FFFFFFF));
|
|
if (O)
|
|
t = ~SIGN32; /* if overflow, rtn max pos */
|
|
else
|
|
t = (uint32) (t64 & DMASK32); /* else lower 32 bits of result */
|
|
|
|
#else /* int64 support unavailable */
|
|
|
|
uint32 sign, xu, yu, rh, rl;
|
|
|
|
sign = ((int32) op[0].dword < 0) ^ /* save sign of result */
|
|
((int32) op[1].dword < 0);
|
|
|
|
xu = (uint32) abs ((int32) op[0].dword); /* make operands pos */
|
|
yu = (uint32) abs ((int32) op[1].dword);
|
|
|
|
if ((xu & 0xFFFF0000) == 0 && /* 16 x 16 multiply? */
|
|
(yu & 0xFFFF0000) == 0) {
|
|
t = xu * yu; /* do it */
|
|
O = 0; /* can't overflow */
|
|
}
|
|
|
|
else if ((xu & 0xFFFF0000) != 0 && /* 32 x 32 multiply? */
|
|
(yu & 0xFFFF0000) != 0)
|
|
O = 1; /* always overflows */
|
|
|
|
else { /* 16 x 32 or 32 x 16 */
|
|
rl = (xu & 0xFFFF) * (yu & 0xFFFF); /* form 1st partial product */
|
|
|
|
if ((xu & 0xFFFF0000) == 0)
|
|
rh = xu * (yu >> 16) + (rl >> 16); /* 16 x 32 2nd partial */
|
|
else
|
|
rh = (xu >> 16) * yu + (rl >> 16); /* 32 x 16 2nd partial */
|
|
|
|
O = (rh > 0x7FFF + sign); /* check for out of range */
|
|
if (O == 0)
|
|
t = (rh << 16) | (rl & 0xFFFF); /* combine partials */
|
|
}
|
|
|
|
if (O)
|
|
t = ~SIGN32; /* if overflow, rtn max pos */
|
|
else if (sign)
|
|
t = ~t + 1; /* if result neg, 2s compl */
|
|
|
|
#endif /* end of int64 support */
|
|
|
|
}
|
|
break;
|
|
|
|
case 003: /* .DNG 105323 (OP_J) */
|
|
t = ~op[0].dword + 1; /* negate value */
|
|
O = (op[0].dword == SIGN32); /* overflow if max neg */
|
|
if (op[0].dword == 0) /* borrow if result zero */
|
|
E = 1;
|
|
break;
|
|
|
|
case 004: /* .DCO 105324 (OP_JD) */
|
|
t = op[0].dword; /* copy for later store */
|
|
if ((int32) op[0].dword < (int32) op[1].dword)
|
|
PC = (PC + 1) & VAMASK; /* < rtns to P+2 */
|
|
else if ((int32) op[0].dword > (int32) op[1].dword)
|
|
PC = (PC + 2) & VAMASK; /* > rtns to P+3 */
|
|
break; /* = rtns to P+1 */
|
|
|
|
case 005: /* .DDI 105325 (OP_JD) */
|
|
DDI:
|
|
O = ((op[1].dword == 0) || /* overflow if div 0 */
|
|
((op[0].dword == SIGN32) && /* or max neg div -1 */
|
|
((int32) op[1].dword == -1)));
|
|
if (O)
|
|
t = ~SIGN32; /* rtn max pos for ovf */
|
|
else
|
|
t = op[0].dword / op[1].dword; /* else return quotient */
|
|
break;
|
|
|
|
case 006: /* .DDIR 105326 (OP_JD) */
|
|
t = op[0].dword; /* swap operands */
|
|
op[0].dword = op[1].dword;
|
|
op[1].dword = t;
|
|
goto DDI; /* continue at .DDI */
|
|
|
|
case 007: /* .DSB 105327 (OP_JD) */
|
|
DSB:
|
|
t = op[0].dword - op[1].dword; /* subtract values */
|
|
E = E | (op[0].dword < op[1].dword); /* borrow if minu < subtr */
|
|
O = (((op[0].dword ^ op[1].dword) & /* overflow if sign wrong */
|
|
(op[0].dword ^ t) & SIGN32) != 0);
|
|
break;
|
|
|
|
case 010: /* .DIN 105330 (OP_J) */
|
|
t = op[0].dword + 1; /* increment value */
|
|
O = (t == SIGN32); /* overflow if sign flipped */
|
|
if (t == 0)
|
|
E = 1; /* carry if result zero */
|
|
break;
|
|
|
|
case 011: /* .DDE 105331 (OP_J) */
|
|
t = op[0].dword - 1; /* decrement value */
|
|
O = (t == ~SIGN32); /* overflow if sign flipped */
|
|
if ((int32) t == -1)
|
|
E = 1; /* borrow if result -1 */
|
|
break;
|
|
|
|
case 012: /* .DIS 105332 (OP_A) */
|
|
din = ReadOp (op[0].word, in_d); /* get value */
|
|
t = din.dword = din.dword + 1; /* increment value */
|
|
WriteOp (op[0].word, din, in_d); /* store it back */
|
|
if (t == 0)
|
|
PC = (PC + 1) & VAMASK; /* skip if result zero */
|
|
break;
|
|
|
|
case 013: /* .DDS 105333 (OP_A) */
|
|
din = ReadOp (op[0].word, in_d); /* get value */
|
|
t = din.dword = din.dword - 1; /* decrement value */
|
|
WriteOp (op[0].word, din, in_d); /* write it back */
|
|
if (t == 0)
|
|
PC = (PC + 1) & VAMASK; /* skip if result zero */
|
|
break;
|
|
|
|
case 014: /* .DSBR 105334 (OP_JD) */
|
|
t = op[0].dword; /* swap operands */
|
|
op[0].dword = op[1].dword;
|
|
op[1].dword = t;
|
|
goto DSB; /* continue at .DSB */
|
|
|
|
default: /* others undefined */
|
|
t = (AR << 16) | BR; /* set t for nop */
|
|
reason = stop_inst;
|
|
}
|
|
|
|
if (reason == SCPE_OK) { /* if return OK */
|
|
AR = (t >> 16) & DMASK; /* break result */
|
|
BR = t & DMASK; /* into A and B */
|
|
}
|
|
|
|
return reason;
|
|
}
|