HP 3000 Instruction Set Notes ============================= ========== Series III ========== NOTE!!! uc p85 has three patches for these routines: 1. DSEG (2355) 2. IXI2 (2554) 3. SIO (1617) Does IOP illegal memory access set CPX1? --------------- CPU Diagnostics --------------- Diagnostics do not have test coverage for these conditions: 1. Data Segment Absent trap. 2. DISP while enabled and not on ICS. 3. IXIT while an external interrupt is pending. 4. Interruptibility of MVBW, CMPB, SCW, SCU, and MVLB. Diagnostics did not catch these errors directly (but rather indirectly): 1. SIN did not pop the stack. 2. IXIT (and EXIT) did not restore the status if return was to a different segment. 3. EXIT had the wrong SR adjust (was 1, should have been 0). 4. SXIT had the wrong SR adjust (was 0, should have been 1). 5. LDPN had the wrong SR adjust (was 1, should have been 0). Diagnostics did not catch these errors at all: 1. CMPB CCE was wrong if a stack adjust > 0 was specified. The cpu_pop calls changed RA before the test for RA = 0 was performed, so a CCE on RA = 0 was lost when RA changed. (Failure in MPE INITIAL when validating the boot option entered.) 2. XCHD exchanged DB and RA but copied DBANK to RB instead of exchanging. (Failure in MPE INITIAL when an extra data segment in a different bank was used.) 3. SCU cleared carry when test and terminal bytes were the same, but should have set carry. (Failure in MPE CI parameter processing; entering "RUN" produced "PARAMETER EXCEEDS 255 CHARACTERS", e.g.) 4. PCAL to a segment in the CSTX set STA to (segment_number - 192) rather than to (segment_number). (System halt occurred when running LISTDIR2 if HELP is entered.) 5. MOVE, MVB, etc. bounds checking was off-by-one, i.e., trapped incorrectly when the ending address was equal to SM (MOVE) or PB (MVB). (Bounds violation aborts of a number of programs.) 6. PSEB did not inhibit dispatcher entry if on the ICS. (Failure of automatic volume recognition when a tape was newly mounted.) 7. LDB S-0 failed with a bounds violation if the TOS was in a register because the negative byte address test checked the EA against SM and not SM + SR. (Pascal compiler failed on invocation.) 8. ADDS with SM wraparound was caught as an underflow, not an overflow. (QUERY "ADD" command aborted with stack underflow.) 9. SCAN,X overflowed the X register if X = %177777 on entry. The X register adds were not masked to 16 bits, so X could overflow to %200000. (BASIC call to DBEXPLAIN caused a bounds violation when a subsequent MVB used the X register value.) 10. FSUB with a zero minuend and subtrahend returned "negative zero," which is an undefined value. (BASIC "10 A=0-0 / 20 PRINT A" reports "UNDEFINED VALUE IN LINE 20".) 11. STB,X fails if X is negative. X register adds were not masked to 16 bits, so displacement could overflow to %200000. This is OK, except for STB, where the displacement is right-shifted before adding to the base register. Right- shifting produces %100000, which puts the EA in the wrong half of the bank. -------------------------- COBOL Firmware Diagnostics -------------------------- Diagnostics do not have test coverage for these conditions: 1. ICPS suboperation of EDIT instruction (ICPS test actually tests ICP subop). Subprograms are in memory from 00.025361-025460 (note that trying to display this range with EXAMINE -E produces: 00.025361: SST0 ICP ' ' 00.025362: TE MN 243 00.025363: ICP '!' 00.025364: TE [...] ...but this isn't right; it should be: 00.025361: SST0 ICP ' ' 00.025362: TE 040 00.025363: SST0 ICP '!' 00.025364: TE [...] ...but 040 gobbles up the next byte containing the SST0! 2. Interruptibility. 3. Odd byte offsets. ------------ Data Formats ------------ - Multiword data values have MSW in lower address and LSW in higher address. So in memory, ptr = MSW and ptr+1 = LSW. And in stack, RB = MSW and RA = LSW. Memory Reference Instructions (opcodes 04-17) Address Resolvers AC1D/S/P: DQSP relative for /LOAD, CMPM, ADDM, SUBM, MPYM, INCM, DECM, /LDX - 04, 06, 07, 10, 11, 12, 13 AC4D/S/P: DQS relative for TBA, MTBA, TBX, MTBX, /STOR - 05 BRD/S/P: for BR, BCC - 14 AC3D/S, ALSB: DQS relative for /LDB, /LDD - 15 AC5D/S/P: DQS relative for /STD - 16 AC2D/S/P: DQSP relative for /LRA - 17 ?: P relative for LDPP, LDPN - 03 ?: DQS relative for /STB - 06 get_effective_address CIR => bus_cycle, address cpu_read_memory bus_cycle, address => value Forms: - PD255IX: LOAD, CMPM, ADDM, SUBM, MPYM, LDX, LRA - D255IX: STOR, INCM, DECM, BR (indirect), LDB, LDD, STB, STD - PS255: TBA, MTBA, TBX, MTBX - PS255IX: BR (direct) - PS31I: BCC Note that INCM, LDB, STB have bit 6 = 0 but are NOT P-relative! Direct: EA = PBANK.(P + disp) EA = DBANK.(DB + disp) EA = SBANK.(Q,S + disp) Indirect cell contains self-relative (P) or DB-relative (DQS) address. Indirect: EA,I = PBANK.(P + disp + M [PBANK.(P + disp)]) EA,I = DBANK.(DB + M [DBANK.(DB + disp)]) EA,I = DBANK.(DB + M [SBANK.(Q,S + disp)]) Indexing adds X register value to displacement. Indexing occurs after indirect. Indexed: EA,X = EA + X Indirect Indexed: EA,I,X = EA,I + X Microcode Note (from 30000-90023, Aug-1976, pp. B-6 to B-7): 7. In order to simplify the micro-code in the memory-reference address calculations, a FF has been put in the CPU to provide automatic bank register selection between the DB bank register and the stack bank register. It works as follows: The micro-code always specifies the DB bank for DQS address calculations. If, for mem. ref. instructions (and not loop control (TBAs etc.)), Q- or S-rel. addressing is specified, the FF is set. When the memory reference is made, the bank reg. pointed to by this FF is appended to the leading bits of the calculated address to form the 18 bit address. The FF is cleared (so that the MCU option "ROD" always points to the DB bank) by the spec. field option "CLIB", or by "NEXT" or "System Reset". This is a special-purpose FF which can only be set through sub-ops 04-17, and hence is of no use to the general-purpose micro-programmer. For LOAD, the microcode does: - preadds CIR displacement with X if not indirect - jump via LUT to AC1D/S/P AC1D/S: - form EA and start a read on M[EA] using DBANK or SBANK as indicated - tests bounds (DL <= EA <= S, else BNDV if NPRV) and read from TOS register if accessed - if indirect, then start a read on M[DB + OPND + XC] using DBANK or SBANK as indicated - tests bounds (DL <= EA <= S, else BNDV if NPRV) and read from TOS register if accessed - jumps via LUT to LOAD AC1P: - form EA (with P-1, as P points to NIR) and start a read on M[EA] using PBANK - test bounds (PB <= EA <= PL, else BNDV if NPRV) - if indirect, then start a read on M[EA + OPND + XC] using PBANK - test bounds (PB <= EA <= PL, else BNDV if NPRV) - jumps via LUT to LOAD LOAD: - if SR = 4, then if SM + 1 > Z, then STOV, else q_down / SM++ / SR-- - PUSH, RA = OPND, set CCA Note that EA bounds violations occur before STOV. TOS test in microcode is: - if CIR & Bit7 (Q- or S-rel) and not testing indirect cell [is stack rel] or else DB-BANK = S-BANK [or is data rel and dataseg = stackseg] then operand = Rx[ea] else operand = M[ea] Note that if testing indirect cell, EA is always DB-relative, regardless of CIR mode. In simulation, LOAD would be: - ea, class = EA (CIR & opmask) -- forms final EA - val = cpu_read (class, ea) -- tests bounds, reads from Rx if indicated - if SR = 4 then QDWN - PUSH - RA = val ----- Interrupts from three sources: - external, i.e., devices. - internal after instruction completion (deferred). bits are set in CPX1 during instruction execution; detected between instructions e.g., overflow, parity error. common interrupt setup checks CPX1 to determine source. - internal instruction aborts. instruction execution doesn't complete; microcode jumps to interrupt setup e.g., stack overflow, system halt. each target microroutine sets up its own interrupt. Bounds violation is odd in that it sets CPX1 bit and enters through the normal interrupt location (ROM address 3) but also results from an abort (BNDT or UBND microinstruction). The interrupt microcode effectively executes a PCAL to stack the machine state and enter the software interrupt processor. The simulator uses an enumeration type, IRQ_CLASS, which has an enumerator for each type of interrupt, to indicate the interrupt source. External and internal deferred interrupts are checked in the instruction loop by testing CPX1 for set interrupt source bits (e.g., CPX1 & CPX1_IRQ). When an interrupt id detected, a routine (cpu_run_mode_interrupt) is called that determines the interrupt type and then sets up the emulated PCAL (set_interrupt_state), based on the IRQ_CLASS enumerator. Microcode aborts are implemented by a setjmp/longjmp to an abort handler just before the instruction loop. A MICRO_ABORT macro calls longjmp with the supplied IRQ_CLASS parameter. The abort handler calls set_interrupt_state, which returns with the machine ready to execute the first instruction of the software interrupt processor. The abort handler then drops into the instruction loop to continue execution. -------------- EXIT N, SR >= 0 (02455, p63): - SP1 = Q - if Q > SM, PSHA (push all TOS registers) - RB = Q - N - 4 (returned S), set F1 (EXI1: IXIT enters here with F1 clear and RA=RQ) - if exit, RA = Q - M [SP1] (stack) (returned Q, i.e., Q - DQ), SR = 0 (we're discarding the stack values) - SM = Q - if RB > Z or RA > Z, goto EX11 (stack overflow) with SP1 = 0 (EXI2) - RD = M [SP1 - 1] (stack) (returned STA) - if exit, if (RA < DB or RB < DB) and RD:0 = 0 (going NPRV), goto STUN (stack underflow) - RC = M [SP1 - 2] (stack) (returned DP) - SP3 = RD (save returned status)) - if NPRV and (RD:0 = 1 or RD:1 /= STA:1), goto TRP6 (privilege violation; can't go priv or change I bit) - STA = STA ~ I (turn off interrupts) - SP1 = RD & 377 (new segment number) - X = M [SP1 - 3] (stack) (returned X), clear F1 - if SP1 < 192, OPND = M [0] else OPND = M [1] (absolute) (get CST pointer) - set F2 - if SP1 = STA & 377, goto PCL6 [2423] (returning to same segment) - UBUS = RC, JSB SSEG [2712] (different segment; set it up) - if RD:0 = 1 and NPRV, goto TRP6 (privilege violation; can't go priv from unpriv) - F1 = RC:0 or SP2:0 (F1 = trace or absent) - RD = SP3 (restore returned status) - if ~F1, goto PCL5 [2422] (no trace or absent; finish like PCAL) (EXI8 - 1) - clear F1, SP3 = PADD (N), goto EXI2 [2521] (EXI8: handle trace or absent segment trap from PCAL/INT) - ... PCL5 (2422, p62): return to same segment - UBUS = RC & 037777 (mask off T and M bits, 0-1) - fall into PCL6 PCL6 (2423, p62): return to same segment - SP0 = RC (ubus) + PB (DP + PB, i.e., new P) - if SP0 < PB or SP0 > PL, BNDV - NIR = M [SP0] (program) - P = SP0 + 1 - STA = RD - Q = RA - if exit or ixit, SM = RB - NEXT SSEG (2712, p68): subroutine to set up code segment (called from cold load too) enter with SP1 = segment number, SP0 = 0 or 1, OPND = M[0 or 1] = CSTP return with F2 = not absent, RD = new status, SP2 = AMRT/length from CST entry - RD = STA & 177400 | SEG# - if SEG# >= 192, SEG# = SEG# - 192 - if SEG# == 0, CST Violation trap [CSTV 3122] - SP0 = CSTP + 4 * segment number - if SEG# > table length, sys halt [via EX10 2522 because SEG# < 2] - PBANK = M [SP0 + 2] - M [SP0] = M [SP0] | R-bit - PL = (M [SP0] & 007777) * 4 - 1 (get length - 1) - if M [SP0] & M-bit, RD = RD | 100000 (set priv) - if not M [SP0] & A-bit, PL = PL + M [SP0 + 3] - PB = M [SP0 + 3] - RSB -------------- PCAL, EXIT instruction descriptions in Machine Instruction Set note 13, pp 2-51 through 2-55. (if N = 0, label is on TOS, else label is at PL-N) SCAL (2411, p62): - SP0 = -PB - 1, set F2 - fall into PCAL PCAL (2412, p62): - if N = 0, goto PCL0 - read (PL - N) - SP1 = PL - N - if SR > 0, PSHA - RC = operand (label) - if SM > Z, goto EX11 (STOV) PCL1 (2417, p62): - if F2 (SCAL), goto PCL2 - RD = STA - call STMK - SP2 = RC (label), if bit 0 = 1 (external), goto PCL3 - fall into PCL5 PCL5 (2422, p62): return to same segment - UBUS = RC & 037777 (mask off T and M bits, 0-1) - fall into PCL6 PCL6 (2423, p62): return to same segment - SP0 = RC (ubus) + PB (delta P + PB, i.e., new P) - if SP0 < PB or SP0 > PL, BNDV - NIR = M [SP0] (program) - P = SP0 + 1 - STA = RD - if exit or ixit, Q = RA and SM = RB - NEXT PCL0 (2433, p63): fetch label from TOS - SP1 = 0 - if SR = 0, QUP - pop (label now in RD) - if SR > 0, PSHA - if SM > Z, push label back, goto EX11 (STOV) - RC = RD (label) - goto PCL1 PCL2 (2441, p63): SCAL continuation - if RC bit 0 = 1 (external), goto CLA2 (STTV) - push P + SP0 (i.e., P - PB - 1 return address) - F2 = 0 - RD = STA, goto PCL5 STMK (2672, p68): stack four-word marker (DOES NOT check for STOV!) - M [SM + 1] = X - SP0 = SM = SM + 4 - M [SM] = Q - SM - Q = SM - SP0 = SP0 - 1 - M [SP0] = STA - M [SP0 - 1] = P + 1 - PB - return NOTE: SRM 4-12, "If a call from within a segment is made to STT 0, the reference will be taken from the top of the stack instead of from the STT. A call from outside a segment to STT 0 starts execution at P = PB after checking the U bit." PCL3 (3077, p72): PCAL/interrupt to external label (SP2 = label, F1 = pon) NOTE: DOES SII, SIII NEED UCODE UPDATE FOR MPE/V? STT format changed! (NO! only V/E and not V/P and V/R!) Local vs. external label detection different (not OPND[0:0])! - SP1 = label & 0377 (segment number) - SP0 = 0 if SP1 < 192 else 1 - RC = label & 077400 (STT #) - SP3 = label; call SSEG (set up code segment) - RC = RC >> 8 (STT #) - OPND = M [PL] (STT length) - if label & 0140000 (T,A bits) then goto EXI8 (2520) - SP1 = 0 - SP2 = RC (STT #); call CLAB (2705, check for STTV) - SP2 = 0120401 (uncallable label 33,1) - if OPND[0:0] then goto CLA2 (STTV if label not local) - F2 = 0; if OPND[1:1] and NPRV then goto INT5 (3067, uncallable) - if RC = 0 then goto PCL5 (STT # zero) - RC = OPND (local label from STT); goto PCL5 SSEG (2712, p68): subroutine to set up code segment (called from cold load too) enter with SP1 = segment number, SP0 = 0 or 1, OPND = M [0 or 1] (CST Pointer) return with F2 = not absent, RD = new status, SP2 = AMRT/length from CST entry - RD = STA & 177400 | SP1 (old status with new segment number) - SP0 = M [0 or 1] (CST pointer), read abs (CST length) - if SP1 < 192 then SP2 = 1 else SP2 = 2, SP1 = SP1 - 192 - if SP1 = 0 then CST Violation trap [CSTV 3122] (seg 0 and 192 do not exist) - SP0 = SP0 + 4 * SP1, read abs (CSTE[0]) - if SP1 > OPND (CST length), goto EX10 (2522, SYSH if SEG# < 2 else CSTV) - SP1 = SP0 + 1 (CSTE[1]) - SP0 = SP1 + 1, read abs (CSTE[2]) - SP2 = CSTE[0] | R-bit - PL = (CSTE[0] & 007777) * 4 - 1 (i.e., PL = length - 1) - SP0 + 1, read abs (CSTE[3]) - PBANK = CSTE[2] - F2 = 0 - if CSTE[0] & M-bit then RD = RD | 100000 (set priv) - SP1 - 1, write abs (CSTE[0] = SP2) - if not CSTE[0] & A-bit then F2 = 1, PL = PL + CSTE[3] - PB = CSTE[3] - RSB CLAB (2705, p68): check STT for label enter with OPND = M [PL], SP2 = STT# exit with OPND = label at PL - STT# - if SP2 > M [PL] & 0377 then [CLA2 2711] RD = STA, goto EXI9 (STTV) - OPND = M [PL - SP2] - RSB -------------- CC (STA 6-7) logic is on PDF page 72 of the schematics (SSF 2/4, D16-E16) Uses ALPHA and NUMERIC signals from (RBUS 1/3, E8-F8) ---- SETR: Microcode PDF page 48 (001476). Load order is left-to-right. Must be privileged if bits 8-11 are set. If not privileged, only bits 2 and 4-7 are loaded into STA; otherwise, all bits are loaded. Microcode wants SR=4 on entry. If SBANK is to be loaded, it's done at the end after all other registers are set from the current SBANK (so must be stored to temp when popped). Bit 9 loads DB and DBANK in that order from the stack. All stack registers are QDWNed before setting S (so S = SM). Q and S are bounds-checked before setting. microcode does a JSB PSHA at 1542 to "empty TOS registers" without POPping the S value. This leaves the S value on the stack. However, that's doesn't matter, as we're resetting S! Actually, except for the memory store, it's effectively setting SR = 0, which is all that matters (must flush TOS registers when changing stacks). ---- STACK-OP B: - [CIR] BPENDING asserts on NIR[0:3] = 0 * NIR[10:15] /= 0 (i.e., if NIR has stack-op and B-op is not NOP). - [SSF] INCP asserts on ~INTRP * ~STATUS3 * NXT+1 - [SSF] NIRTOCIR asserts on NXTFINH FF ~Q * NEXT - [SSF] NXTFINH FF (74S112): - clocks on FCLK+ - clears on NEXT - sets (toggles) on NEXT * ~STATUS3 * BPENDING * ~INTRP1 - [SSF] STATUS3 (R) FF (74S112): - clocks on FCLK+ - sets on NIRTOCIR * BPENDING * ~INTRP1 - clears on NEXT * ~INTRP1 - [CIR] CIR clocks on FCLK+, enabled if NIRTOCIR - [SBUS] P (74161) clocks on FCLK+, increments if INCP NEXT when NIR contains a non-stack instruction: - NEXT => BPENDING = 0, INCP = 1, NIRTOCIR := 1, STATUS3 := 0, CIR := NIR, NIR := M [P], P := P + 1 - non-stack instruction executes NEXT when NIR contains a stack instruction and B-op is NOP: - NEXT => BPENDING = 0, INCP = 1, NIRTOCIR := 1, STATUS3 := 0, CIR := NIR, NIR := M [P], P := P + 1 - stack instruction A executes NEXT when NIR contains a stack instruction and B-op is not NOP: - NEXT => BPENDING = 1, INCP = 0, NIRTOCIR := 1, STATUS3 := 1, CIR := NIR, NIR := M [P], P := P - stack instruction A executes - NEXT => BPENDING = x, INCP = 1, NIRTOCIR := 0, STATUS3 := 0, CIR := CIR, NIR := NIR, P := P + 1 - stack instruction B executes BPENDING might be 0 or 1 at the stackop A NEXT, depending on whether the next instruction is also a stackop with A and B. The R bit (STATUS3) clears on each NEXT and sets only on stackop A with B pending. Note: INCP inhibited during an interrupt, so P does not increment. ---- while stopped, P points to instruction to execute in hardware: - run - CCPX = 040001 (clear panel FFs, set run FF) - NIR = M [P] - P = P + 1 - (NEXT) CIR = NIR - (NEXT) NIR = M [P] - (NEXT) PADD = P +/ offset if P-relative memory reference - (NEXT) P = P + 1 - loop - execute instruction (HALT skips NEXT actions) - (NEXT) CIR = NIR - (NEXT) NIR = M [P] - (NEXT) PADD = P +/ offset if P-relative memory reference - (NEXT) P = P + 1 - halt - P = P - 1 - CCPX = 100001 (clear panel FFs, clear run FF) - CNTR = SR - PSHA instr loop (now): - on entry - P points at the instruction to execute - CIR, NIR are irrelevant (they are read-only and retain values at exit) - user might have changed PBANK, P, or M [P] (i.e., CIR instruction) - prelude - NIR = M [P] - P = P + 1 > if NIR <> CIR, R = 0 ? - if R and NIR is a stackop - CIR = NIR - NIR = M [P] - P = P + 1 - loop - polls - interrupts - paused check (skips rest of loop) - if not R or else CIR not a stackop, do NEXT - CIR = NIR - NIR = M [P] - P = P + 1 - R = 0 [can rely on stackop to clear IF resuming current stackop] - execute instruction - postlude - if rerun or paused or R=1, P = P - 2, else P = P - 1 Maybe micro_state = (loading, pausing, pending, complete) ? - loading = cold load - pausing = PAUS - pending = USTOP, PSTOP, DSTOP, SYSHALT, R=1 - complete = everything else if pending or pausing then P = P - 2 else if complete then P = P - 1 cancel R in prelude if ? - P <> last P - PBANK <> last PBANK - CIR <> last CIR [or maybe this one is the only one required?] -------------- BOV (0434, p29, PADD = displacement +/- CIR 11-15): - if STA(4) = 1, CTR = 77 - STA(4) = 0 - if CTR /= 77, NEXT (BCC2, 0424, common branch-and-check code) - UBUS = P - 2 ("P points to NIR+1") - SP1 = PADD + UBUS - NIR = OPND = M [SP1] (BCC3, 0427) - if SP1 < PB or SP1 > PL, BNDV - if CIR(4) = 0, P = SP1 + 1; NEXT (not indirect) - if CIR(4) = 1, SP1 = SP1 + OPND; NIR = M [SP1]; goto BCC3 Notes: - on entry, P points at NIR+1 - on exit, NIR loaded from P, P = P + 1 -------------- ~CARRY (ALU 1/A5) - 3000: C = Cn+4 output of MSB ALU - hp2100: C = (v > 0177777) - hp3000: C = (v > DV_MAX) ~OVFL (ALU 1/A3) - 1000: O = "max pos or neg number exceeded"; sets if S15 = L15 /= ALU15 - 3000: O = - hp2100: O = (~S ^ L) & (S ^ ALU) & 0100000 - hp3000: O = (~R ^ S) & (S ^ T) & SIGN16 O = a + b + c + d a = ~DCAD * R0 * (S0 xor ~RORT10) * ~F0 \ d = ~DCAD * ~R0 * ~(S0 xor ~RORT10) * F0 / integer overflow b = DCAD * RILG \ c = DCAD * SILG / decimal overflow ADDD, SUBD, etc. RILG = R0 * R1 + R0 * R2 + R4 * R5 + R4 * R6 + ... SILG = S0 * S1 + S0 * S2 + S4 * S5 + S4 * S6 + ... DCAD = Function micro-order DCAD (Decimal Add) RORT10 = functions that cause an ADD OFCENB = CADO + SUBO + ADDO + INCO NOTE!!! Per the '181 datasheet, "Subtraction is performed by ones-complement addition, where the ones-complement of the subtrahend is generated internally. The resultant output is A-B-1, which requires an end-around or forced carry to provide A-B." CADO ("complement and add") generates A-B-1, and SUBO generates A-B. BUT...the microcode uses "RA [ ] CADO" for decrement. This adds the R-Bus to the ones-complement of the S-Bus. In the case of RA = 0, it adds 0 + (-1) = -1 WITHOUT A CARRY!!! But for RA = 1, 1 + (-1) = 0 DOES GENERATE A CARRY. So decrements must be modelled as adds of D16_UMAX to get the carries correct. Answer: '181 carry output is also "not borrow", e.g., carry inactive indicates borrow. Because C bit is direct Cn+4 output from most-significant ALU slice, it has the opposite polarity of borrow after a subtraction. Correct borrow is B = Minuend < Subtrahend. Can model SUBO as M - S with C = M >= S. (Maybe create "r = add_16 (a, b)" and "r = sub_16 (m, s)" to perform calculation, set carry and overflow, and trap on overflow.) ---- PSHR: Microcode PDF page 47 (001446). Push order is right-to-left. Must be privileged if bits 8-9 are set. Microcode wants SR=0 on entry but checks for S+9 < Z. Bit 9 pushes DBANK and DB in that order to the stack. All stack registers are QDWNed before setting S (so S = SM). ---- #define UBNT(l, ea, u) ...? #define BNDT(l, ea, u) ...? #define SBNT(l, ea, u) ...? Bounds Checks: - PB <= ea <= PL program transfers priv and user - PB <= ea <= PL program references user (except moves) - DL <= ea <= S data references user - SM > Z stack overflow priv and user - SM < DB stack underflow user Stack checking: Source TCHK Mode Bounds Test Viol Operation ------ ---- ---- ----------- ---- ----------------------- CPU yes NPRV DB <= ea BNDV XEQ reference CPU no both ea <= Z STOV BNDC (ea = SM for push) CPU no NPRV DB <= ea STUN BNDC (ea = SM for pull) BNDC: Q and S (SETR), S (ADDS, SUBS), S (SXIT) test: ea <= Z else STOV, DB <= ea else STUN if NPRV Source Class Access TCHK Mode Bounds Test Viol Operation ------ -------- -------- ---- ---- -------------- ---- ----------------------- IOP dma dma no both none none device data transfer CPU fetch fetch no both none none instruction fetch CPU system absolute no both none none SSEG, etc. IOP system absolute no both none none SIO program access CPU absolute absolute yes both none none PLDA/PSTA reference CPU branch fetch no both PB <= ea <= PL BNDV branch target fetch CPU branch fetch no both PB <= ea <= PL BNDV subroutine return fetch CPU program program no NPRV PB <= ea <= PL BNDV P-relative reference CPU data data yes NPRV DL <= ea <= SM BNDV DB-relative reference CPU stack stack yes NPRV DL <= ea <= SM BNDV Q-relative reference CPU stack stack yes NPRV DL <= ea <= SM BNDV S-relative reference when dma when fetch when system value = M [ea] when branch if PB <= ea <= PL then value = M [ea] else BNDV when program if PB <= ea <= PL or PRIV then value = M [ea] else BNDV when absolute if ea > SM and ea - SM <= SR and bank = SBANK then value = TR [ea - SM] else value = M [ea] when data when stack if ea > SM and ea - SM <= SR and bank = SBANK then value = TR [ea - SM - 1] else if DL <= ea <= SM + SR or PRIV then value = M [ea] else BNDV ------ CPU Stops - unimplemented instruction (STOP_UNDEF) - no stop: irq_Unimplemented - bypass: irq_Unimplemented - resume: if USTOP then STOP_UNDEF else irq_Unimplemented - PAUS instruction (STOP_PAUS) - no stop: pause until irq - bypass: NOP - resume: if PSTOP then STOP_PAUS else pause until irq - BR P+0 instruction (STOP_INFLOOP) - no stop: branch * - bypass: branch * - resume: if LSTOP then STOP_INFLOOP else branch * - undefined I/O device (STOP_NODEV) - no stop: CCL/syshalt - bypass: CCL/syshalt - resume: if DSTOP then STOP_NODEV else CCL/syshalt ----- HALT, STOP, WAIT, SYSH, PAUS, CPRS (2757-2765) HALT is PRIV HALT, STOP decrement P HALT, STOP, WAIT clear run FF HALT is called: - by executing a HALT instruction STOP is called: - (3002) if RUN/HALT is pressed while CPU is running - (3006) run-time interrupt entry with no run-mode interrupts pending i.e., a halt-mode interrupt occurred while running - (3165) halt-time interrupt entry with no halt-mode interrupts pending WAIT is called: - (3170) after Load Register or Load Address switch is serviced - (3201) after Load Memory or Display Memory switch is serviced - (3353) after cold dump completes - (3550) if RUN/HALT pressed during panel register test - (3701) after panel register test completes - (3705) after panel I/O test completes - (3716) if RUN/HALT pressed during panel memory test - (7757) after DIO disc dump completes SYSH is called: - (1730) IOP timeout and CNTR is non-zero (note: NEXT clears CNTR) - (2523) segment 0 or 1 trace or absent - (2531) stack overflow or absent on ICS - (2635) LOCK instruction with external interrupts disabled - (2663) PSEB instruction with M [QI-18] = 0 - (7543) IOP timeout during DIO cold load from 264X terminal PAUS is called: - by executing a PAUS instruction - (2640) LOCK instruction with lockword non-zero CPRS is called: - (0002) CPU is reset, i.e. jump to location 1 - (2751) power restored and CPU was halted at power failure ----- SXIT: - if PL < PB or RA > PL - PB, BNDV - SP0 = RA + PB - NIR = M [SP0] - if SR > 0 and CIR(8:15) <> 0, flush TOS - SP1 = SM - CIR(8:15) - BNDC on SP1 (ea <= Z else STOV, DB <= ea else STUN if NPRV) - P = SP0 + 1 - SM = SP1 - NEXT ----- Extract and deposit bit fields. For both instructions, if K is larger than the number of bits remaining to the right in the word, the extra bits are circularly pulled from the left. For example, a starting bit of 15 and a width of 2 would extract or deposit bits 15 and 0. EXF (1400, p46): J = starting bit, K = number of bits - CNTR = J - SP3(12:15) = (J + K) MOD 16 - CNTR = -(16 - K) - repeat SP0 = UBUS >> 1 until CNTR = max (shift K bits right-justified) - CNTR = -(16 - ((J + K) MOD 16)) - repeat SP2 = RA ROR 1 until CNTR = max (rotate RA until K bits are right-justified) - RA = SP2 & SP0 - CCA (RA) logically: - RA = RA CRS (16 - (J + K) MOD 16) AND %177777 LRS (16 - K) - form the right-justified mask of K bits by logically right-shifting an all-ones value by 16 - K positions - right-justify the selected RA field of K bits (with wraparound) by circularly right-shifting RA by 16 - (J + K) MOD 16 positions (same as circularly left-shifting RA by (J + K) MOD 16 positions) - complete the extraction into RA by ANDing the aligned mask In simulation, the mask is calculated as (1 << K) - 1, the shift is calculated as (J + K) MOD 16, and the opposite shift (left for right) is employed, as a circular right shift of 16 - N bits is identical to a circular left shift of N bits. DPF (1400, p65): J = starting bit, K = number of bits - CNTR = J - SP3(12:15) = (J + K) MOD 16 - CNTR = -(16 - K) - repeat SP0 = UBUS >> 1 until CNTR = max (shift K bits right-justified) - CNTR = -(16 - ((J + K) MOD 16)) - RA = SP0 & RA (RA = field to be deposited in RB) - repeat RA = UBUS ROL 1 until CNTR = MAX (align RA to RB) - CNTR = -(16 - ((J + K) MOD 16)) - repeat SP2 = SP0 ROL 1 until CNTR = MAX (align mask to RB) - RB = RB & ~SP2 | RA - POP, CCA (RB) logically: - RB = RB AND NOT (%177777 LRS (16 - K) CLS (16 - (J + K) MOD 16) OR (RA AND %177777 LRS (16 - K)) CLS (16 - (J + K) MOD 16) - form the right-justified mask of K bits by logically right-shifting all-ones value right by 16 - K positions - remove the bits to be replaced from RB by circularly left-shifting the mask by 16 - (J + K) MOD 16 positions and ANDing the complement - obtain the replacement bits from RA by ANDing the mask and then circularly left-shifting the result by 16 - (J + K) MOD 16 positions - complete the deposit into RB by ORing the aligned replacement bits from RA In simulation, the mask is calculated as (1 << K) - 1, the shift is calculated as (J + K) MOD 16, and the opposite circular shift (right for left) is employed, as a circular left shift of 16 - N bits is identical to a circular right shift of N bits. Also, as the shifted mask is already available, Notes: CRS is "operand >> count | operand << 16 - count" masked to 16 bits CLS is "operand << count | operand >> 16 - count" masked to 16 bits ----- maybe (loading, pending, pausing, next), where "next" causes a NEXT after the instruction completes next = P - 1 pending or pausing = P - 2 loading = P on entry, "pending" if R set, otherwise "next" or maybe "next" unless CIR = PAUS (then state = pausing) instead of R=1 to avoid NEXT, use "next" to allow NEXT clear R if GO has an address (RUN resets CPU, which clears R anyway) so changing addresses clears R unless it's done by setting P and then CONT What if M[P] changed to a non-stackop? check on entry and clear R? start of cpu_machine_instruction sets state = next and left stackop sets state = pending if USTOP, etc., state = pending for exit NOTE: USTOP on 2nd stackop stops with R clear! (because it's cleared before the undef is detected) Should stop with R set for instruction resumption. ---- DIV, DIVL overflow (for W = U / V) - DIVL pops one item before testing overflow - ovfl on division by zero - ovfl if divisor >= dividend MSW - NO ovfl if W = 0 or sign(w) = sign (u) xor sign (v) ovfl if quotient <> 0 and sign (quotient) <> sign (dividend) xor sign (divisor) ---- generic shift routine? need arithmetic, logical, and circular shifts of 16, 32, 48, and 64-bit values operating on RA, RA-RB, RA-RB-RC, or RA-RB-RC-RD 16 and 32-bit shifts provide all six possibilities; 48-bit provide arith left/right and normalizing left only 64-bit provide arith left/right only needs SET_CCA for all sizes CIR [5:6] = 00 -> 16-bit, 10 -> 32-bit, 01 -> 48-bit microcode uses CTSS/CTSD CIR [7:8] = 00 -> arithmetic, 01 -> logical, 1x -> circular CIR [9] = 0 -> left, 1 -> right (16/32/48-bit only) maybe a generic routine for 16/32, and inline routines for 48/64? generic right shift: result = (fill << (size - count) | value >> count) & size_mask where: - size = 16 or 32 - arithmetic fill = value & size_SIGN ? ~0 : 0 - logical fill = 0 - circular fill = value 48/64-bit shifts can be performed as two 32-bit shifts (high and low double-word) ----- eliminate DV_nnnn values in favor of D8, D16, etc. plus addition of R_MASK (register mask) for masking when storing into a register need unchecked_program and unchecked_data accesses to memory for MOVE instructions actually, need accesses that DON'T check for TOS overlap but checking is done on the full memory range before starting the move NOTE that we already have "unchecked_branch" (fetch) and "unchecked_absolute" (internal) so we really need to generalize the concept and rename the foregoing for consistency generalizing SET_CCA(n) into SET_CCA(u,l) won't harm code because with SET_CCA(n, 0) (a constant), optimization will remove the lower word checks! will also work for unsigned values via SET_CCA(0, n); again, optimization removes checks is SET_CCC(a,b) better than SEXT() if we test (a ^ D16_SIGN > b ^ D16_SIGN), as this converts to an unsigned test? ----- DBBC (2321, p60): SP2 = relative byte address, SP1 = SM, OPND = +1/-1 if checking ending address too if split stack (SBANK <> DBANK or DB>Z or DB> 1 - if DBANK <> SBANK or DB > Z or DB < DL then return - if RD < DL or RD > SM then RD = RD + %100000 - if RD < DL or RD > SM and NPRV then BNDV - if single address check or PRIV then return - SP2 = RD + (OPND + (SP2 & 1)) ASR 1 - if SP2 < DL or SP2 > SM and NPRV then BNDV - return ----- Section 4 of the CPU diagnostic does: - LOAD %167403 (M I T r O C CC? 003) - SETR STATUS - NOP,NOP ...and expects that an irq_User_Trap will occur. Note that the CC is set to 11, which is undefined per the SRM. SRM 3-12 says that if T is set, "an interrupt to segment 1 will occur in lieu of setting the Overflow indicator (except for integer overflow, which causes both results to happen)." In hardware, overflow (~OVFL) is generated on ALU 1/A3 for integer and decimal overflows. ~OVFL is passed to SSF 2/G16, where it sets the O bit in the status word (bit 4) if OFCENB (overflow function enable) is true, which it is for each of the "overflow enabled" micro-orders (e.g., ADDO). If the O bit is set while the T bit (status bit 2) is also set, OVFLINT is true. An STSTATUS (store status) signal will also set the status values from the UBUS. In either case, OVFLINT is passed to CIR 2/G22, where it presents as CPX1.0 and also generates the INTRP signal. INTRP passes to SSF 1/C11, where it inhibits incrementing P and also generates INTG. INTG passes to CIR 1/G10, where it forces the micromachine to location 3 to start interrupt processing. The interrupt vectors through ROM 3 to IR (3001) and then to TR1E (1251) if CPX1.0 is set. TR1E sets SP3 = 0 and jumps to TRP1 (3133). TR1E is also called if a floating point FIX overflows due to a large exponent; this does not generate a hardware interrupt but instead does a microcode abort. TRP1 (3133) sets the parameter to 1 for integer overflow (TRP2, TRP3, etc. set the parameter to 2, 3, etc. for other traps), creates label 25/1, and clears the overflow bit in the status word (clearing CPX1.0). If user traps are disabled in STA, it sets overflow in the status word and continues with the next instruction. If user traps are enabled, a jump to INT7 is performed instead. NOTE: SRM 6-13 says, "If multiple interrupts occur simultaneously, they stack their markers in the following order, and are therefore serviced in the reverse order: integer overflow, system parity error, memory address parity error, data parity error, non-responding module, bounds violation, illegal address, module interrupt, external interrupt, and power fail." However, the Series II microcode checks multiple interrupts in left-to-right bit order appearance in CPX1, i.e.: integer overflow, bounds violation, illegal address, non-responding module, system parity error, address parity error, data parity error, module interrupt, external interrupt, and power fail interrupt. That is: SRM stack order Microcode stack order --------------------- --------------------- integer overflow integer overflow system parity error bounds violation address parity error illegal address data parity error non-responding module non-responding module system parity error bounds violation address parity error illegal address data parity error module interrupt module interrupt external interrupt external interrupt power fail power fail Interrupt and trap overviews (traps are TRP6 3117 mode violation through TRP0 3134 unused): Integer overflow External interrupt ICS internal Non-ICS internal Traps ================ ================== ============= ================ ============= - ROM 0003 - ROM 0003 - ROM 0003 - ROM 0003 - IR 3001 - IR 3001 - IR 3001 - IR 3001 - INT0 3020 - INT0 3020 - TR1E 1251 - INT1 3024 - INT1 3024 - TRP1 3133 - PSHA 1744 - PSHA 1744 - TRP6 3117 - INT7 3140 - STMK 2672 - STMK 2672 - INT7 3140 - INT7 3140 - PSHA 1744 - INT2 3033 - INT2 3033 - PSHA 1744 - PSHA 1744 - STMK 2672 - INT3 3045 - INT4 3055 - STMK 2672 - STMK 2672 - INT5 3067 - INT4 3055 - INT5 3067 - INT5 3067 - INT5 3067 - INT6 3071 - INT6 3071 - INT6 3071 - INT6 3071 - INT6 3071 - PCL3 3077 - PCL3 3077 - PCL3 3077 - PCL3 3077 - PCL3 3077 - SSEG 2712 - SSEG 2712 - SSEG 2712 - SSEG 2712 - SSEG 2712 - CLAB 2705 - CLAB 2705 - CLAB 2705 - CLAB 2705 - CLAB 2705 - PCL5 2422 - PCL5 2422 - PCL5 2422 - PCL5 2422 - PCL5 2422 - PCL6 2423 - PCL6 2423 - PCL6 2423 - PCL6 2423 - PCL6 2423 - NEXT - NEXT - NEXT - NEXT - NEXT IR (3001): hardware vector from ROM location 3 - if CPX2.15 (run flip-flop state) = 0, goto HMOD (3143) to handle the halt-mode interrupt - if CPX2.0 (run switch) = 1, goto STOP (2760) to halt the machine - SP3 = CPX1.0-CPX1.9 (the set of run-time interrupts) - if CPX1.8 (external interrupt) is the only bit set, goto INT1 with SP2 = 0 to handle the external interrupt - CNTR = CPX1.4-CPX1.9 - if SP3 = 0, goto STOP (2760) because a halt-time interrupt occurred - if CPX1.0 (integer overflow) = 1, goto TR1E (1251) to handle the overflow - if CPX1.9 (power fail) = 1, call PWR (2742) to write CPX2 at ZI+1 - sets CNTR to 0-8 for the first bit within CPX1.1-CPX1.9 (left-to-right) that is set - [BNDV 3013] if CNTR = 7 (external interrupt), goto INT1 with SP2 = 0 to handle the external interrupt - SP2 = %100001 | (CNTR + 1) << 8 (external label CNTR+1,1) - SP3 = SP2 (parameter = label) - F2 = 1 - [INT0 3020] F1 = 0 - if STT = 7 (module interrupt), SP3 = module number - if STT < 4, goto INT7 (3140) to use the user's stack, else fall into INT1 (3024) to use ICS >>> ext int SRM p.150; ixit instr desc SRM p.166 INT1 (3024): entry for DISP/PSEB and some ICS interrupts - call PSHA to push all stack registers on the user's stack - call STMK to write a stack marker on the user's stack - RA = CPX1 & %000010 (in dispatcher flag) - SP0 = SM + 1 - M [SP0] = DBANK - SP0 = SP0 + 1 - M [SP0] = DB - fall into INT2 INT2 (3033): entry for PON and CLD - SBANK = 0 - SP1 = 5 (CPU1) or 9 (CPU2) [MOD + 1] - if CPX1 & %000020 (executing on ICS flag) = 0, then goto INT3 (3045) - OPND = M [Q] (read delta Q) - if RA = 0, then goto INT4 (3055) (jump if not in dispatcher) - CPX1 = CPX1 & ~RA (clear the dispatcher flag) - M [Q] = OPND | %100000 (set delta Q.0 = 1 to indicate the dispatcher was interrupted) - goto INT4 (3055) INT3 (3045): not on ICS - OPND = M [SP1 + 1] (read ZI) - Q = OPND (Q = QI) - CPX1 = CPX1 | %000020 (set ICS flag) - SP1 = Q - 5 - OPND = M [SP1 + 1] (read stack DB at QI - 4) - Z = OPND (Z = ZI) - SR = 0 (for cold load) - DL = %177777 - M [SP1 - 1] = SP0 - OPND (write delta S [SM + 2 - ZI] to QI - 6) - fall into INT4 (3055) INT4 (3055): entry for extern interrupts detected by IXIT - SM = Q + 2 - if SP2 (label) /= 0, then goto INT5 (jump if not ext int) - SP3 = IOA - SP0 = IOA * 4 + 2 (interrupt database) - DB = M [SP0] - DBANK = 0 - STA = %140000 (priv, interrupt) - CNTR = %10 - SP2 = M [SP0 - 1] (label) - goto INT6 INT5 (3067): entry for some non-ICS interrupts - STA = %100000 - if SP2.0 = 0 (internal label), goto IXI6 (2601) (if DISP or PSEB execution) - fall into INT6 INT6 (3071) - M [SM + 1] = SP3 (write parameter to stack in memory) - SM = SM + 1 - X = CIR - if F2 = 1, clear indicated interrupt source from CPX1 (value is in CNTR) - fall into PCL3 (3077) TR1E (1251): various instructions enter at TR1E if integer overflow is detected in firmware - SP3 = 0 (set parameter) - goto TRP1 (3133) to trap TRP1 (3133): TRP5 through TRP0 set SP3 (parameter) to 5 through 0 and fall through TRP1 - SP2 = %114401 (label 25,1) - clear overflow - if STA.2 (T) = 0, set overflow and NEXT to continue instruction sequence, else fall into INT7 INT7 (3140): - call PSHA to push all stack registers on the user's stack - call STMK to write a stack marker on the user's stack - goto INT5 (3067) with SP2 = label, SP3 = param, F2 to clear interrupt ----- explicit interrupt tests and jumps to interrupt handler (IRD 3000) in microcode: - 1603 for LLSH after each link - 2023 for MOVE after each word - 2073 for MVB after each byte - 2126 for MVBW after each byte - 2136 for CMPB after each byte - 2225 for SCU and SCW after each word (two bytes) scanned - 2265 for MFDS and MTDS after each word and also before stack deletion ----- EXI8 (2520): TRACE, ABS, STTV, CSTV, and STOV system halt checks PCAL, EXIT, IXIT set new status before trapping trace, abs enter at EXI8 with RD = new status (target segment number) sttv enters at EXI9 with RD = source segment number cstv enters at EX10 with RD = target segment number stov enters at EX11 - STA = RD - call STMK (2672) [EXI9] - SP2 = %120001 [EX10] - if RD & 0377 < 2 then goto SYSH (2762) - if cstv then goto CSTV (3122) - if sttv then goto STTV (3123) - CNTR = 0 - if trace then goto INT5 (3067) [EX11] - SP2 = %117401 - CNTR = 0 - if CPX1.11 (ICS) = 1, then goto SYSH (2762) for ABS or STOV - if abs, then goto INT5 (3067) - SP2 = %114001 - SP3 = SP2 (label) - goto INT0 (3020) ...So a PCAL trace would have to pass "new_status" and "label/N/0" to the "trap_Trace" routine. A CSTV would have to pass "new_status" to pass the segment number but not actually set the status in STA. That is, these trap routines need the segment number (to check for SYSH) and the parameter. Maybe have a "trace_trap (label, new_status)" routine that sets STA, checks the segment number, and then calls either MICRO_ABORT (trap_System_Halt) or MICRO_ABORT (TO_DWORD (label, trap_Trace)). Ditto for "cstv_trap (new_status)" except that it only checks the segment number. ----- SYSH checks: - EXI8 for trace or absent; called from PCL3 (3107) - EXI9 for STTV; called from CLAB (2705), CLA2 (2711) - CLAB for label within STT check; called from LLBL (2404), PCL3 (3110) - CLA2 for STTV; called from LLBL (2407), SCAL (2441), PCL3 (3112) - EX10 for CSTV; called from SSEG (2723) - EX11 for STOV; called from IXI4 (2600) direct calls: - STTV; called from EXI9 (2525) - CSTV; called from EX10 (2524), SSEG (2717) ----------------------- Interrupt Control Stack ----------------------- Absolute location 5 = QI (permanent ICS stack marker pointer) Absolute location 6 = ZI (permanent ICS stack limit) ICS global data area (32002-90003 p.454): 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | PSEB/PSDB counter | [Q - 18] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | | [Q - 17] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | | [Q - 16] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | | [Q - 15] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | | [Q - 14] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Trace flag (set non-zero on IXIT away from ICS) | [Q - 13] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | | [Q - 12] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | | [Q - 11] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Stack-DB-relative Z | [Q - 10] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Stack-DB-relative DL | [Q - 7] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Stack-DB-relative S | [Q - 6] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | S-Bank | [Q - 5] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Absolute stack DB | [Q - 4] +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Permanent (dispatcher) ICS stack marker: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Dispatcher initial X register value | [Q - 3] X +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Dispatcher PB-relative starting address | [Q - 2] P + 1 - PB +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Dispatcher status register value | [Q - 1] STA +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | D | zero | [Q - 0] delta Q +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Dispatcher DB-Bank value | [Q + 1] DBANK +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Dispatcher DB value | [Q + 2] DB +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Key: D = dispatcher is scheduled; set by DISP, reset by IXIT and PSDB The segment field of the status register value contains the CST entry for the dispatcher. Interrupt ICS stack marker: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | X register value | [Q - 3] X +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | PB-relative return address | [Q - 2] P + 1 - PB +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Status register value | [Q - 1] STA +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | D | Delta Q value | [Q - 0] S - Q +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | DB-Bank value | [Q + 1] DBANK +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | DB value | [Q + 2] DB +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Parameter | [Q + 3] device number +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Key: D = dispatcher was interrupted ---------------- IXIT Instruction ---------------- Operations: 1. exit from dispatcher to new process launch 2. return to an interrupted process 2a. return to an interrupted process requesting redispatch but PSDB 3. return to an interrupted lower-priority interrupt 4. return to the interrupted dispatcher 4a. return to the interrupted dispatcher requesting redispatch but PSDB 5. start dispatcher for an interrupted process requesting redispatch and PSEB 6. restart dispatcher for the interrupted dispatcher requesting redispatch and PSEB Operation selection: - if dispatcher flag = 1, then launching a process (1) - if M [Q].0 = 0, then if Q = QI, then returning to a process (2), else returning to another interrupt (3) - if M [Q].0 = 1 and M [QI].0 = 0, then returning to the interrupted dispatcher (4) - if M [Q].0 = 1 and M [QI].0 = 1, then the dispatcher has been scheduled: - if M [QI - 18] = 0, then returning to start the dispatcher (5)(6) - if M [QI - 18] /= 0, then if Q = QI, then returning to a process (2a), else returning to the interrupted dispatcher (4a) Flowchart: if Dispatcher_Flag = 1 then in-dispatcher-exit-to-process (1) else if Segment /= 1 then send-RIN-to-device if M [Q].0 = 0 then if Q = QI then return-to-interrupted-process (2) else return-to-interrupted-lower-priority-interrupt (3) elsif M [QI].0 = 0 then return-to-interrupted-dispatcher (4) elsif M [QI - 18] = 0 then start-or-restart-dispatcher (5)(6) elsif Q = QI then PSDB-return-to-interrupted-process (2a) else PSDB-return-to-interrupted-dispatcher (4a) Operation exit paths: (1) (2) IXI2 IXI4 (2A) IXI6 IXI2 IXI4 (3) IXI3 IXI4 (4) (4A) IXI6 IXI3 IXI4 (5) (6) IXI6 IXI4 Logic: if Dispatcher_Flag = 0 if segment > 1 send RIN if M [Q].0 = 1 then IXI6 if Dispatcher_Flag = 1 or Q = QI and (M [Q].0 = 0 or M [QI - 18] /= 0) then IXI2 if Dispatcher_Flag = 0 and Q /= QI and (M [Q].0 = 0 or M [QI].0 = 0 or M [Qi - 18] /= 0) then IXI3 IXI4 IXIT (2535): entry only if CIR(12:15) = 0000 - SP1 = Q, read stack (Q) - SP0 = Q - 5 - CNTR = 8 - SR = 0 - SP2 = CPX1 & cpx1_DISPFLAG - if SP2 /= 0, then goto IXI2 (2554) - SP3 = STA & %000376 (i.e., SP3 > 0 if segment number > 2) - read stack (Q + 3, device number) - RD = M [SP1] (delta Q) - if SP3 = 0, then goto IXI1 (2552) - SP3 = M [Q + 3] | %102000 (form RIL command from device number) - call IOPA to send the command - if CPX1 & cpx1_EXTINTR /= 0, then goto INT4 (3055) - fall into IXI1 IXI1 (2552): do not send the RIL if not an external interrupt - if RD.0 = 1, then goto IXI6 (2601) (dispatcher was interrupted) - if RD /= 0, then goto IXI3 (2572) (return to interrupted routine) - fall into IXI2 with [Q] = 0 IXI2 (2554): return to process; set SBANK, Q, DL, Z; clear ICS and DISP flags - read absolute (QI - 4, stack DB) - SP2 = %000030 - read absolute (QI - 5, SBANK) - RC = M [Q - 4] (patch) M [Q - 13] = -1 (set trace flag) - SP0 = SP0 - 1, read absolute (QI - 6, S) - SBANK = M [Q - 5] - SP0 = SP0 - 1, read absolute (QI - 7, DL) - Q = RC + M [Q - 6] - 2 (i.e., reset Q for four-word stack marker) - SP0 = SP0 - 1, read absolute (QI - 8, Z) - DL = RC + M [Q - 7] - CPX1 = CPX & ~SP2 (i.e., cpx1_ICSFLAG | cpx1_DISPFLAG) - SP1 = Q, read stack (delta Q) - Z = RC + M [Q - 8] - OPND = M [Q] - goto IXI3 + 1 (2573) IXI3 (2572): - OPND = RD & %077777 (remove dispatcher interrupted bit) (IXI3 + 1) - RB = SP1 - 4 (return S value) - RA = SP1 - OPND (return Q value) - fall into IXI4 (2575) IXI4 (2575): set DBANK, DB from (Q+1), (Q+2); finish like EXIT - DBANK = M [SP1 + 1] (stack read) - DB = M [SP1 + 2] (stack read) - goto EXI1 (2463) IXI6 (2601): (re)start or return to the dispatcher - SP2 = 18 - CPX1 = CPX1 | cpx1_DISPFLAG - RA = M [5] (absolute read, QI) - RB = RA + 2 (QI + 2) - if M [RA].0 = 0, then goto IXI3 (2572) (jump if returning to dispatcher) - OPND = M [RA - SP2] (i.e., QI - 18, PSEB/PSDB counter) - if Q = RA (i.e., QI) and OPND /= 0, then goto IXI2 (i.e., return to process if PSDB) - if Q /= RA (i.e., QI) and OPND /= 0, then goto IXI3 (i.e., return to dispatcher if PSDB) - SP1 = RA (i.e., QI) - M [SP1] = 0 (i.e., M [QI] = 0, restart dispatcher) - Q = SP1 (i.e., Q = QI) - goto IXI4 (2575) (start or restart dispatcher) ----- DISP/PSEB/PSDB (2643): request redispatch/disable/enable dispatcher - OPND = M [5] (absolute read, QI) - CNTR = CPX1 & (cpx1_ICSFLAG | cpx1_DISPFLAG) (i.e., non-zero if on ICS) - SP1 = -18 - SP0 = OPND + SP1 (i.e., QI - 18) - if CIR.15 = 1, then goto PSDE (2655) - OPND = M [SP0] (absolute read, QI - 18) - M [M [5]] = %100000 (i.e., M [QI] = %100000, set dispatcher-scheduled bit in stack marker) - if OPND = 0 and CNTR = 0, then set CCE, goto INT1 (3024) (i.e., if M [QI - 18] = 0 and not on ICS, then start dispatcher) else set CCG, NEXT PSDE (2655): - F2 = CIR & %000002 (i.e., F2 is set if PSEB, clear if PSDB) - if F2 is clear, then M [SP0] = M [SP0] + 1 (i.e., if PSDB then increment M [QI - 18]), NEXT else M [SP0] = M [SP0] - 1 (i.e., if PSEB then decrement M [QI - 18]) - if M [SP0] /= 0 and M [SP0] /= -1, then set CCG, NEXT (i.e., if M [QI - 18] was not 1 or 0) - if M [SP0] = -1, goto then SYSH (2762) (i.e., if M [QI - 18] was 0 then system halt) - if CPX1 & cpx1_DISPFLAG = 0, then set CCE, goto PSD2 (2670) (i.e., if not in dispatcher) - M [M [5]] = 0 (absolute write, M [QI]), set CCG, NEXT ("clear any start dispatcher requests") (PSD2) - if M [M [5]].0 = 0, then set CCG, NEXT ("test start dispatcher if requested") (DSP2) - if CPX1 & (cpx1_ICSFLAG | cpx1_DISPFLAG) = 0, then set CCE, goto INT1 (3024) (i.e., if M [QI - 18] = 0 and not on ICS, then start dispatcher) else set CCG, NEXT ---------- Interrupts [incomplete] ---------- Hardware setup: - CPX1.cpx1_DISPFLAG is set when dispatcher is executing and cleared otherwise - CPX1.cpx1_ICSFLAG is set when the ICS is in use and cleared otherwise - Absolute location 5 contains QI (points at the delta Q location of the dispatcher marker) - Absolute location 6 contains ZI (stack limit for the ICS) A non-ICS trap writes a four-word marker on the user's stack and executes on the user's stack. Return is via EXIT. Nested non-ICS traps link stack frames on the user's stack. An external interrupt or ICS trap writes a six-word marker on the user's stack and then switches to the ICS. Return is via IXIT. Nested ICS interrupts and traps link stack frames AFTER THE FIRST on the ICS. An interrupt may occur in these situations: - while executing a process (user code or non-ICS interrupt routine) - while executing an ICS interrupt routine - while executing the dispatcher (on the ICS) Operations: 1. exit from dispatcher to new process launch 2. return to an interrupted process 2a. return to an interrupted process requesting redispatch but PSDB 3. return to an interrupted lower-priority interrupt 4. return to the interrupted dispatcher 4a. return to the interrupted dispatcher requesting redispatch but PSDB 5. start dispatcher for an interrupted process requesting redispatch and PSEB 6. restart dispatcher for the interrupted dispatcher requesting redispatch and PSEB Conditions: - if dispatcher flag = 1, launching a process - if M [QI].0 = 1, requesting redispatch - if M [Q].0 = 1 and Q /= QI, dispatcher was interrupted - if M [QI - 18] /= 0, dispatcher is pseudo-disabled ------- Store into a TOS register: - writes through into memory for STOR, STD - writes only TOS register for STB, INCM, DECM, and PSTA TSCK (0272): check if (E) in TOS; if so, OPND := MREG, else F1 cleared if (E) in memory - 0055 (AC1S) read - 0111 (AC2S) read - 0132 (AC3S) read - 0147 (LDD) - 0161 (AC4S) read - 0174 (AC5S) read - 0206 (STD) stores RA in memory, then stores in MREG if F1; jumps to STOR - 0217 (STOR) stores RA in memory, then stores in MREG if F1 - 0257 (STB) stores RA in memory if NF1 else stores in MREG - 0407 (BR) TSC1 (0274): - 0313 (PSTA) stores RA in memory if NF1 else stores in MREG [only absolute read/write that checks for TOS] ----------------------- Floating-Point Routines ----------------------- 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | S | exponent biased by +256 | positive mantissa | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ NORM (1041): normalize [RB,SP3,SP1], round and pack [RB,SP3] into [RB,RA] entry with [RB,SP3,SP1] = absolute mantissa, F1 = sign, SP0 = +/- exponent - (normalize) increment CNTR and shift RB,SP3,SP1 left until BIT8 - (round) SP3 = SP + 1; if carry, RB = RB + 1 - shift RB,SP3,SP1 right 1 to restore after rounding - if NF1, CCG else CCL - UBUS = SP0 - CNTR + 254 (same as SP0 - (CNTR - 2) - 256) (CNTR is +1 from test on bit 8 instead of bit 9 and +1 from increment before test) - RB = RB + UBUS, F1 to bit 0 (exponent increments +1 from 1 in bit 9, and optionally +1 from rounding carry) - RA = RBUS + SBUS circular left shift by 1, F1 = bit 0, jump to FOV if bit 15 = 1 (if exponent < -256 or exponent = -256 and mantissa = 0, RA = SP3, underflow) (if exponent > 255, RA = SP3, overflow) FOV (1056) - SP3 = 0, if F1 = 0, jump to TRP2 (3132) (overflow) else RA = SP3, jump to TRP3 (3131) (underflow) --------------- CMD Instruction --------------- The instruction sends the word at S-K to the MCU Control Register with the CRL micro-order and the word in RA to the ACOR with the CMD instruction. It then pops the TOS and returns. CMD starts at microaddress 1670. If the addressed module responds with a Central Data Bus message of its own, a Module Interrupt then occurs. The module address and reply MOP is the parameter to the interrupt. The control register specifies the module number in bits 13-15 and the module operation in bits 10-11. For memory, the commands are NOP (00), Write (01), Read (10), and Read/Write Ones (11). The latter is only implemented for the Series II; the Series III treats it as a NOP. The CPU04 diagnostic step 17 tests the CMD instruction. 30000-90018 (Series II System Service Manual) pages 4-58 to 4-64 describe the memory operations. 30000-90143 (Series III Reference/Training Manual) pages 6-6 to 6-8 describe the MCU operation. Each MCU, MCL, or Port Controller is identified by a Module Control Priority Number, as follows: 0 - Memory, lower bank 1 - " 2 - Memory, higher bank 3 - " 4 - Selector Channel Port Controller 5 - CPU/IOP 6 - (unused) 7 - (unused) The two MCLs respond to module numbers 0 and 1 or 2 and 3. If the system is configured for less than 128K (Series II) or 512K (Series III) of memory, then addressing modules 2 or 3 will cause a CPU Timeout interrupt. The MCL responds to a received command with a NOP returned to the FROM address. The Port Controller ignores MOPs from non-memory modules, so addressing module 4 will cause a CPU Timeout interrupt. The CPU is capable of commanding itself (i.e., FROM = module 5, TO = module 5). In this case, the MOP given in the CMD instruction is reflected in the module interrupt parameter along with the CPU module number. Addressing modules 6 or 7 always cause a CPU Timeout interrupt. ---------------------- Word Move Instructions ---------------------- The following instructions use the same sort of loop setup: - MOVE [2000] calls MVWS [2353] to move words - MVBL [2226] calls MVWS [2353] to move words - MVLB [2226] calls MVWS [2353] to move words - MFDS [2240] calls MVWS [2353] to move words - MTDS [2240] calls MVWS [2353] to move words - MABS [2266] calls MVWS [2353] to move words - MDS [2267] calls MVWS [2353] to move words - subroutine DBWC [2313] checks DB-relative starting and ending word addresses - subroutine MVWS [2353] is the loop that moves words and updates RC, RB, and RA - subroutine DSEG [2355] sets up data segments for MFDS, MTDS, and MDS if (RA != 0) { cpu_queue_down (); status = move_words (src_class, src_base, dst_class, dst_base); // if class = absolute, base is bank in high word, offset in low word // offset must be added modulo 16! } if (status == SCPE_OK) decrement_stack (decrement); (swap RC and RD for call and then swap back if necessary) - MOVE [+/-] program (PB) or data (DB) => data (DB) - MVBL [+/-] data (DB) => stack (DL) - MVLB [+/-] stack (DL) => data (DB) - MFDS [+] absolute (bank, offset) => data (DB) [exch RC and RD] - MTDS [+] data (DB) => absolute (bank, offset) - MABS [+/-] absolute (RC, 0) => absolute (target_bank, 0) [exch RC and RD] - MDS [+/-] absolute (srcbank, srcoff) => absolute (dstbank, dstoff) [exch RC and RD] ---------------------- Byte Move Instructions ---------------------- The following instructions use the same sort of loop setup: - MVBW [2025] uses MB10 [2066] loop to move bytes - MVB [2046] uses MB10 [2066] loop to move bytes - CMPB [2046] uses CMPB [2135] loop to compare bytes - SCU [2161] calls GSCB [2217] to get each source byte - SCW [2162] calls GSCB [2217] to get each source byte - subroutine DBBC [2321] checks DB-relative starting and ending byte addresses - MVBW [*] data (DB) => data (DB) - MVB [+/-] program (PB) or data (DB) => data (DB) - CMPB [+/-] program (PB) or data (DB) <=> data (DB) [read only] - SCU [*] data (DB) [read only] - SCW [*] data (DB) [read only] NOTE: MVBW UPSHIFTS EVERYTHING IN %140-177 RANGE, NOT JUST LCASE (141-172) BY ANDING WITH ~40. OF COURSE, IF IT'S NOT ALPHABETIC, THE MOVE WILL BE TERMINATED, SO THIS IS OK! NOTE: CIR FLAGS ALPHA 01 AND NUMERIC 10 SHIFTED AND ANDED WITH CC AFTER CCB. EXPECTS CCL 01 FOR ALPHA AND CCE 10 FOR NUMERIC; AND RESULT <> 0 IF OK. BUT CCB SETS CCL 01 FOR SPECIAL, CCE 10 FOR ALPHA, AND CCG 00 FOR NUMERIC. HOWEVER, CC COPIES STA(6:7) TO SBUS(8:9) AND SETS SBUS(7) IF CCG, SO OK! Calling cpu_ea to obtain the effective address with bounds checking: - MVB x2 (range) - checked - SCW/SCU (start) - checked - MVBW x2 (start) - checked - CMPB x2 (range) - checked - ALGN x2 (range) - checked - ABSN (range) - checked - CMPS x2 (range) - checked - CMPT x2 (range) - checked, x1 (start) - unchecked - LDW (range) - checked - LDDW (range) - checked - TR x2 (range) - checked, x1 (start) - unchecked - ABSD/NEGD (range) - UNCHECKED [trace only], (start) - unchecked - CVND x2 (range) - checked - EDIT x3 (start) - unchecked ----------------------------- Effective Address Calculation ----------------------------- Bounds checking and TOS register mapping: - Executors that call TSCK/TSC1/AS_K check for TOS accesses. - TSCK: LOAD, STOR, CMPM, ADDM, SUBM, MPYM, DECM, INCM, LDX, LDD, STD, LDB, STB [data_map_ck, stk_ck]. - TSC1: PLDA, PSTA check for absolute addressing (priv, so no bndt) [abs_map]. - AS_K: SIO, RIO, WIO, TIO, CIO, SIN, CMD check for stack addressing (all priv, so no bndt) [stk]. - Also: XEQ explicit check for stack addressing (E > DB) [stk]. - All other data accesses access memory only, even if they are between SM and SM + SR. TOS mapping: - absolute may or may not map - program never maps - data may or may not map (but only if DBANK = SBANK) - stack always maps Bounds checking: - absolute never checks - program may or may not check - data may or may not check - stack may or may not check So the memory access modes needed are: - abs, abs_map, - fetch, fetch_ck, - prog, prog_ck, - data, data_ck, data_map, data_map_ck, - stk, stk_ck ---------------------------------- Non-Canonical Instruction Encoding ---------------------------------- Undefined (non-canonical) instruction encodings, where reserved bit fields are treated as "don't care" by the instruction decoder, execute as their canonical encodings. The Series III instructions that fall into this category are: Canonical Reserved Inst Encoding Bits Defined As Decoded As ---- --------- -------- ------------ ------------ SCAN 010600 10-15 0 0 0 0 0 0 x x x x x x TNSL 011600 10-15 0 0 0 0 0 0 x x x x x x MOVE 020000 12-13 - - 0 0 - - - - x x - - MVB 020040 12-13 - - 0 0 - - - - x x - - MVBL 020100 13 - - - 0 - - - - - x - - SCW 020120 13 - - - 0 - - - - - x - - MVLB 020140 13 - - - 0 - - - - - x - - SCU 020160 13 - - - 0 - - - - - x - - CMPB 020240 12-13 - - 0 0 - - - - x x - - RSW 020300 12-14 - - 0 0 0 - - - x x x - LLSH 020301 12-14 - - 0 0 0 - - - x x x - PLDA 020320 12-14 - - 0 0 0 - - - x x x - PSTA 020321 12-14 - - 0 0 0 - - - x x x - LSEA 020340 12-13 - - 0 0 - - - - x x - - SSEA 020341 12-13 - - 0 0 - - - - x x - - LDEA 020342 12-13 - - 0 0 - - - - x x - - SDEA 020343 12-13 - - 0 0 - - - - x x - - PAUS 030020 12-15 - - 0 0 0 0 - - x x x x Undefined (non-canonical) instruction encodings, where reserved fields are decoded, may execute as different instructions. The Series III instructions that fall into this category are: Canonical Reserved Inst Encoding Bits Defined As Decoded As ---- --------- -------- ---------- ---------- IXIT 020360 12-15 0 0 0 0 0 0 0 0 LOCK 020361 12-15 0 0 0 1 n n 0 1 PCN 020362 12-15 0 0 1 0 n n n 0 UNLK 020363 12-15 0 0 1 1 n n 1 1 SED 030040 12-15 0 0 0 x n n n x XCHD 030060 12-15 0 0 0 0 0 0 0 0 PSDB 030061 12-15 0 0 0 1 n n 0 1 DISP 030062 12-15 0 0 1 0 n n n 0 PSEB 030063 12-15 0 0 1 1 n n 1 1 SMSK 030100 12-15 0 0 0 0 0 0 0 0 SCLK 030101 12-15 0 0 0 1 n n n n RMSK 030120 12-15 0 0 0 0 0 0 0 0 RCLK 030121 12-15 0 0 0 1 n n n n Where: x = 0 or 1 n = any collective value other than 0 In hardware, the SED instruction works correctly only if opcodes 030040 and 030041 are used. Opcodes 030042-030057 also decode as SED, but the status register is set improperly (the I bit is cleared, bits 12-15 are rotated right twice and then ORed into the status register). In simulation, opcodes 030042-030057 work correctly but will cause an UNDEF simulation stop if enabled. ---------------- Machine Variants ---------------- The HP 3000 instruction set has changed with the introduction of various models. In general, only privileged instruction have been changed or added. However, a few user instructions change between the original 3000 and the Series II. These instructions are common to all 3000s: - all subop 00 (stack operation) - all subop 01 (shift/branch/test operations) except QASL, QASR - all subop 02 (move operations) except MABS, MTDS, MDS, MFDS - all subop 02 (special operations) except LSEA, SSEA, LDEA, SDEA, IXIT, LOCK, PCN, UNLK - all subop 02 (immediate operations) except DMUL, DDIV - all subop 03 (program/immediate/memory operations) except TSBM - all subop 04-17 (memory reference operations) The following instructions are specific, either to the CPU model or to optional firmware extensions. The key in the tables below is: * = standard O = optional - = not available These single-word base-set instructions are CPU-specific: Opcode Inst I II III 3x 4x 5x 6x Description ------ ---- - -- --- -- -- -- -- -------------------------------------- 0117xx QASL - * * * * * * Quad arithmetic shift left 0157xx QASR - * * * * * * Quad arithmetic shift right 02011x MABS - * * * * * * Move words using absolute address 02013x MTDS - * * * * * * Move to data segment 02015x MDS - * * * * * * Move using data segments 02017x MFDS - * * * * * * Move from data segment 020340 LSEA - * * * * * * Load single word from extended address 020341 SSEA - * * * * * * Store single word to extended address 020342 LDEA - * * * * * * Load double word from extended address 020343 SDEA - * * * * * * Store double word to extended address 020360 IXIT - * * * * * * Interrupt exit 020361 LOCK - * - - - - - Lock resource 020362 PCN - * * * * * * Push CPU number 020363 UNLK - * - - - - - Unlock resource 020570 DMUL - * * * * * * Double integer multiply 020571 DDIV - * * * * * * Double integer divide 03000x LST - * * * * * * Load from system table 030061 PSDB - * * * * * * Pseudo interrupt disable 030062 DISP - * * * * * * Dispatch 030063 PSEB - * * * * * * Pseudo interrupt enable 030101 SCLK - * * * * * * Store clock 030121 RCLK - * * * * * * Read clock 03016x SIO * * * - - - - Start I/O 03020x RIO * * * - - - - Read I/O 03022x WIO * * * - - - - Write I/O 03024x TIO * * * - - - - Test I/O 03026x CIO * * * - - - - Control I/O 03030x CMD * * * - - - - Command module 03032x SIRF * - - - - - - Set external interrupt reference flag 03032x SST - * * - - - - Store to system table 03034x SIN * * * - - - - Set interrupt 0360xx TSBM * - - - - - - Test and set bits in memory These two-word base-set instructions beginning with 020104 are CPU-specific: Opcode Inst I II III 3x 37 4x 5x 6x Description ------ ---- - -- --- -- -- -- -- -- -------------------------------------- 000000 RCCR - - - * * * * * Read system clock counter 000001 SCLR - - - * * * * * Set system clock limit register 000002 TOFF - - - * * * * * Hardware timer off 000003 TON - - - * * * * * Hardware timer on 000004 SBM - - - - - * * - Set bank mask 000004 MCMD - - - - - - - * Message communication 000005 FLSH - - - - - - - * Flush cache 000010 SINC - - - * * * * * Set system clock interrupt 000014 RDCU - - - - - - - * Read DCU log 000015 ISTR - - - - - - - * Initialize System Table Registers 000016 ENPF - - - - - - - * Enable Performance Enhancement 000017 RTOC - - - - * - - - Read time-of-century clock 000020 WTOC - - - - * - - - Write time-of-century clock 000021 PFL - - - - * - - - Power fail 000022 FVER - - - - * - - - Set firmware version 000023 OSIG - - - - * - - - Operating system signal These two-word base-set instructions beginning with 020302 are CPU-specific: Opcode Inst I II III 3x 4x 5x 6x Description ------ ---- - -- --- -- -- -- -- -------------------------------------- 000000 SIOP - - - * * * * Start I/O program 000001 HIOP - - - * * * * Halt I/O program 000002 RIOC - - - * * * - Read I/O channel 000003 WIOC - - - * * * - Write I/O channel 000004 ROCL - - - * - - - Roll Call 000005 IOCL - - - * - - - I/O Clear 000006 INIT - - - * * * * Initialize I/O channel 000007 MCS - - - * * * - Memory Command and Status 000010 SEML - - - * - - - Semaphore load 000011 STRT - - - * * * * Initiate warmstart 000012 DUMP - - - * * * * Load soft dump program 000013 RIOA - - - - - - * Read I/O adapter 000014 WIOA - - - - - - * Write I/O adapter These single-word instructions are specific to the Extended Instruction Set firmware: Opcode Inst I II III 3x 4x 5x 6x Description ------ ---- - -- --- -- -- -- -- -------------------------------------- 020400 EADD O - - - - - - Extended precision add (3-word) 020401 ESUB O - - - - - - Extended precision subtract (3-word) 020402 EMPY O - - - - - - Extended precision multiply (3-word) 020403 EDIV O - - - - - - Extended precision divide (3-word) 020404 ENEG O - - - - - - Extended precision negate (3-word) 020405 ECMP O - - - - - - Extended precision compare (3-word) 020410 EADD - * * * * * * Extended precision add (4-word) 020411 ESUB - * * * * * * Extended precision subtract (4-word) 020412 EMPY - * * * * * * Extended precision multiply (4-word) 020413 EDIV - * * * * * * Extended precision divide (4-word) 020414 ENEG - * * * * * * Extended precision negate (4-word) 020415 ECMP - * * * * * * Extended precision compare (4-word) 020601 DMPY - * * * * * * Double logical multiply 020602 CVAD - * * * * * * Convert ASCII to decimal 020603 CVDA - * * * * * * Convert decimal to ASCII 020604 CVBD - * * * * * * Convert binary to decimal 020605 CVDB - * * * * * * Convert decimal to binary 020606 SLD - * * * * * * Shift left decimal 020607 NSLD - * * * * * * Normalizing shift left decimal 020610 SRD - * * * * * * Shift right decimal 020611 ADDD - * * * * * * Add decimal 020612 CMPD - * * * * * * Compare decimal 020613 SUBD - * * * * * * Subtract decimal 020614 MPYD - * * * * * * Multiply decimal These single-word instructions are specific to the COBOL Instruction Set firmware: Opcode Inst I II III 3x 4x 5x 6x Description ------ ---- - -- --- -- -- -- -- -------------------------------------- 020460 ALGN - O O * * * * Align numeric, bit 15 S-decrement 020461 ALGN - O O * * * * Align numeric, bit 15 S-decrement 020462 ABSN - O O * * * * Absolute numeric, bit 15 S-decrement 020463 ABSN - O O * * * * Absolute numeric, bit 15 S-decrement 020470 EDIT - O O * * * * Edited move, PB-relative 020471 EDIT - O O * * * * Edited move, DB-relative 020472 CMPS - O O * * * * Compare string, PB-relative 020473 CMPS - O O * * * * Compare string, DB-relative 020474 XBR - O O * * * * External branch 020475 PARC - O O * * * * Paragraph procedure call 020476 ENDP - O O * * * * End paragraph These two-word instructions beginning with 020477 are specific to the COBOL Instruction Set firmware: Opcode Inst I II III 3x 4x 5x 6x Description ------ ---- - -- --- -- -- -- -- -------------------------------------- 000006 CMPT - O O * * * * Compare translated strings 00001x TCCS - O O * * * * Test condition code and set 00002x CVND - O O * * * * Convert numeric display 000040 LDW - O O * * * * Load word 000042 LDDW - O O * * * * Load double-word 000044 TR - O O * * * * Translate 000046 ABSD - O O * * * * Absolute decimal 000050 NEGD - O O * * * * Negate decimal --------------------- Two-Word Instructions --------------------- All of the Series II and Series III base-set instructions are represented in single words. From the Machine Instruction Set manual (30000-90022 June 1984), there are three opcodes that introduce two-word instructions: - 020477 (HP 32234A Language Extension Instructions, a.k.a. COBOL-II firmware) - 020104 (Series 3x/4x/6x, except as noted) - 020302 (Series 3x/4x, except as noted) The specific encodings are as follows: 020477 (firmware extension) 000006 - CMPT (Compare translated strings, PB-relative) 000007 - CMPT (Compare translated strings, DB-relative) * 000010 - TCCS (Test condition code and set, bits 13-15 options) through * 000017 - TCCS (Test condition code and set, bits 13-15 options) 000020 - CVND (Convert numeric display, bits 12-15 options) 000037 - CVND (Convert numeric display, bits 12-15 options) 000040 - LDW (Load word, bit 15 S-decrement) 000041 - LDW (Load word, bit 15 S-decrement) 000042 - LDDW (Load double-word, bit 15 S-decrement) 000043 - LDDW (Load double-word, bit 15 S-decrement) 000044 - TR (Translate, PB-relative) 000045 - TR (Translate, DB-relative) 000046 - ABSD (Absolute decimal, bit 15 S-decrement) 000047 - ABSD (Absolute decimal, bit 15 S-decrement) 000050 - NEGD (Negate decimal, bit 15 S-decrement) 000051 - NEGD (Negate decimal, bit 15 S-decrement) * This instruction is not present in the Machine Instruction Set manual but is tested by the COBOL-II Firmware Diagnostic. 020104 (undefined; decodes as MVBL 0 in Series II/III) 000000 - RCCR (Read system clock counter) 000001 - SCLR (Set system clock limit register) 000002 - TOFF (Hardware timer off) 000003 - TON (Hardware timer on) / 000004 - SBM (Set bank mask; Series 44 only) \ 000004 - MCMD (Message communication; Series 6x only) 000005 - FLSH (Flush cache; Series 6x only) * 000010 - SINC (Set system clock interrupt; Series 3x/37/4x) 000014 - RDCU (Read DCU log; Series 6x only) 000017 - RTOC (Read time-of-century clock; Series 37 only) 000020 - WTOC (Write time-of-century clock; Series 37 only) 000021 - PFL (Power fail; Series 37 only) 000022 - FVER (Set firmware version; Series 37 only) 000023 - OSIG (Operating system signal; Series 37 only) * SPL accepts and system debug prints "SINC" for this instruction. The use of SCIN in the Machine Instruction Set manual is probably a typo. 020302 (undefined; decodes as RSW in Series II/III) 000000 - SIOP (Start I/O program; Series 3x/4x/6x) 000001 - HIOP (Halt I/O program; Series 3x/4x/6x) 000002 - RIOC (Read I/O channel) 000003 - WIOC (Write I/O channel) 000004 - ROCL (Roll Call) 000005 - IOCL (I/O Clear) 000006 - INIT (Initialize I/O channel; Series 3x/4x/6x) 000007 - MCS (Memory Command and Status; Series 3x/37/4x) 000010 - SEML (Semaphore load; Series 3x only) 000011 - STRT (Initiate warmstart; Series 3x/37/4x/6x) 000012 - DUMP (Load soft dump program; Series 3x/4x/6x) 000013 - RIOA (Read I/O adapter channel; Series 6x only) 000014 - WIOA (Write I/O adapter channel; Series 6x only) ------------------------ Extended Instruction Set ------------------------ The 3000 CX EIS supplied these three-word floating-point instructions: Opcode Oper ------ ---- 020400 EADD 020401 ESUB 020402 EMPY 020403 EDIV 020404 ENEG 020405 ECMP The 3000 Series II EIS replaced them with these four-word instructions: Opcode Operation ------ ------------------------------------- 020410 EADD (Extended precision add) 020411 ESUB (Extended precision subtract) 020412 EMPY (Extended precision multiply) 020413 EDIV (Extended precision divide) 020414 ENEG (Extended precision negate) 020415 ECMP (Extended precision compare) 020416 (undefined) 020417 (undefined) The firmware simulator refers to these as QADD, QSUB, etc. EIS also adds these additional instructions: Opcode Operation ------ ------------------------------------- 020600 (undefined) 020601 DMPY (Double logical multiply) 020602 CVAD (Convert ASCII to decimal) 020603 CVDA (Convert decimal to ASCII) 020604 CVBD (Convert binary to decimal) 020605 CVDB (Convert decimal to binary) 020606 SLD (Shift left decimal) 020607 NSLD (Normalizing shift left decimal) 020610 SRD (Shift right decimal) 020611 ADDD (Add decimal) 020612 CMPD (Compare decimal) 020613 SUBD (Subtract decimal) 020614 MPYD (Multiply decimal) 020615 (undefined) 020616 (undefined) 020617 (undefined) This module implements the HP 30012A Extended Instruction Set firmware consisting of extended floating point and decimal arithmetic instructions. The set contains these instructions: Name Description ---- ------------------------------ EADD Extended precision add ESUB Extended precision subtract EMPY Extended precision multiply EDIV Extended precision divide ENEG Extended precision negate ECMP Extended precision compare ADDD Add decimal CMPD Compare decimal CVAD Convert ASCII to decimal CVBD Convert binary to decimal CVDA Convert decimal to ASCII CVDB Convert decimal to binary DMPY Double logical multiply MPYD Multiply decimal NSLD Normalizing shift left decimal SLD Shift left decimal SRD Shift right decimal SUBD Subtract decimal The floating-point instructions occupy the the firmware extension range 020400-020417. For each instruction, addresses of the operand(s) and result as DB+ relative word offsets reside on the stack. They are encoded as follows: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 0 0 0 0 | 1 0 0 0 | EADD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Add the four-word floating-point number addressed by RA to the four-word floating-point number addressed by RB and store the result in the four-word target area addressed by RC. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 0 0 0 0 | 1 0 0 1 | ESUB +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Subtract the four-word floating-point number addressed by RA from the four-word floating-point number addressed by RB and store the result in the four-word target area addressed by RC. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 0 0 0 0 | 1 0 1 0 | EMPY +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Multiply the four-word floating-point number addressed by RA to the four-word floating-point number addressed by RB and store the result in the four-word target area addressed by RC. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 0 0 0 0 | 1 0 1 1 | EDIV +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Divide the four-word floating-point number addressed by RA into the four-word floating-point number addressed by RB and store the result in the four-word target area addressed by RC. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 0 0 0 0 | 1 1 0 0 | ENEG +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Negate in place the four-word floating-point number addressed by RA. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 0 0 0 0 | 1 1 0 1 | ECMP +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Compare the four-word floating-point number addressed by RB to the four-word floating-point number addressed by RA and set the condition code appropriately. The decimal arithmetic instructions occupy the the firmware extension range 020600-020777. For most instructions, addresses of the source and target operands as DB+ relative byte (for packed decimal) or word (for binary) offsets reside on the stack. They are encoded as follows: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 0 0 | 0 0 0 1 | DMPY +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Multiply the double-word unsigned integer contained in RB and RA to the double-word unsigned integer contained in RD and RC and leaves the four-word unsigned integer product on the stack. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 0 | S | 0 0 1 0 | CVAD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 0 = delete 2 words 1 = delete 4 words Convert the external decimal number designated by RA (count) and RB (address) to a packed decimal number designated by RC (count) and RD (address). 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 | sign | S | 0 0 1 1 | CVDA +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 0 = delete 1 word 1 = delete 3 words Sign Control: 00 = target sign is source sign 01 = target sign is negative if source negative else unsigned 10 = target sign is unsigned 11 = target sign is unsigned Convert the packed decimal number designated by RA (address) to an external decimal number designated by RB (count) and RC (address). The number of digits converted is also designated by RB. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 0 | S | 0 1 0 0 | CVBD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 0 = delete 2 words 1 = delete 4 words Convert the binary number designated by RA (count) and RB (address) to a packed decimal number designated by RC (count) and RD (address). 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 0 | S | 0 1 0 1 | CVDB +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 0 = delete 2 words 1 = delete 3 words Convert the packed decimal number designated by RA (count) and RB (address) to a binary number designated by RC (address). The number of target words is determined by the source digit count. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 | sdec | 0 1 1 0 | SLD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 00 = delete no words 01 = delete 2 words 10 = delete 4 words Shift the packed decimal number designated by RA (count) and RB (address) left by the number of digits specified by the X register and store the result in a packed decimal number designated by RC (count) and RD (address). Digits shifted off the end of the number are lost. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 | sdec | 0 1 1 1 | NSLD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 00 = delete no words 01 = delete 2 words 10 = delete 4 words Shift the packed decimal number designated by RA (count) and RB (address) left by the number of digits specified by the X register and store the result in a packed decimal number designated by RC (count) and RD (address). If shifting would lose significant digits off the end of the number, the shift count is reduced to leave the most-significant digit at the start of the packed number. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 | sdec | 1 0 0 0 | SRD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 00 = delete no words 01 = delete 2 words 10 = delete 4 words Shift the packed decimal number designated by RA (count) and RB (address) right by the number of digits specified by the X register and store the result in a packed decimal number designated by RC (count) and RD (address). Digits shifted off the end of the number are lost. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 | sdec | 1 0 0 1 | ADDD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 00 = delete no words 01 = delete 2 words 10 = delete 4 words Add the packed decimal number designated by RA (count) and RB (address) to the packed decimal number designated by RC (count) and RD (address) and store the result in the target area addressed by RD. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 | sdec | 1 0 1 0 | CMPD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 00 = delete no words 01 = delete 2 words 10 = delete 4 words Compare the packed decimal number designated by RA (count) and RB (address) to the packed decimal number designated by RC (count) and RD (address) and set the condition code appropriately. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 | sdec | 1 0 1 1 | SUBD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 00 = delete no words 01 = delete 2 words 10 = delete 4 words Subtract the packed decimal number designated by RA (count) and RB (address) from the packed decimal number designated by RC (count) and RD (address) and store the result in the target area addressed by RD. 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 1 | 1 0 | sdec | 1 1 0 0 | MPYD +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ S-Decrement: 00 = delete no words 01 = delete 2 words 10 = delete 4 words Multiply the packed decimal number designated by RA (address) and the packed decimal number designated by RB (count) and RC (address) and store the result in the target area addressed by RB and RC. Packed decimal (also known as COMPUTATIONAL-3, BCD, and binary-coded decimal) numbers contain from 1 to 28 digits that are stored in pairs in successive memory bytes in this format: 0 1 2 3 4 5 6 7 +---+---+---+---+---+---+---+---+ | unused/digit | digit | +---+---+---+---+---+---+---+---+ | digit | digit | +---+---+---+---+---+---+---+---+ [...] +---+---+---+---+---+---+---+---+ | digit | digit | +---+---+---+---+---+---+---+---+ | digit | sign | +---+---+---+---+---+---+---+---+ The sign is always located in the lower four bits of the final byte, so numbers with an even number of digits will not use the upper four bits of the first byte. Digits are represented by four-bit values from 0-9 (i.e., in Binary-Coded Decimal or BCD), with the most-significant digit first and the least-significant digit last. The sign is given by one of these encodings: 1100 - the number is positive 1101 - the number is negative 1111 - the number is unsigned All other values are interpreted as meaning the number is positive; however, only one of the three values above is generated. Numbers may begin at an even or odd byte address, and the size of the number (in digits) may be even or odd, so there are four possible cases of packing the starting digits into 16-bit words: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 addr/size +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | unused | digit | ... | ... | even/even +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | digit | digit | ... | ... | even/odd +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | ... | ... | unused | digit | odd/even +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | ... | digit | digit | odd/odd +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Numbers always end with the sign in the lower half of the byte, so there are two possible cases of packing the ending digits into 16-bit words, depending on the total number of digits: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | digit | sign | ... | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | ... | ... | digit | sign | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ External decimal (also known as DISPLAY, numeric display, and ASCII) values contain contain from 1 to 28 digits that are stored as ASCII characters in successive memory bytes in this format: 0 1 2 3 4 5 6 7 +---+---+---+---+---+---+---+---+ | digit | +---+---+---+---+---+---+---+---+ | digit | +---+---+---+---+---+---+---+---+ [...] +---+---+---+---+---+---+---+---+ | digit | +---+---+---+---+---+---+---+---+ | digit and sign | +---+---+---+---+---+---+---+---+ The number begins with the most-significant digit. The sign is combined with the least-significant digit in the final byte. Each digit except the LSD must be in the ASCII range "0" through "9". Leading blanks are allowed, and the entire number may be blank, but blanks within a number are not. The least-signifiant digit and sign are represented by either: "0" and "1" through "9" for an unsigned number "{" and "A" through "I" for a positive number "}" and "J" through "R" for a negative number Numbers may begin at an even or odd byte address, and the size of the number (in digits) may be even or odd, so there are four possible cases of packing into 16-bit words: - the number completely fills the words - the number has an unused leading byte in the first word - the number has an unused trailing byte in the last word - the number has an unused byte at each end Any unused bytes are not part of the number and are not disturbed. Eight user traps may be taken by these instructions if the T bit is on in the status register: Parameter Description --------- ------------------------------------------------ 000010 Extended Precision Floating Point Overflow 000011 Extended Precision Floating Point Underflow 000012 Extended Precision Floating Point Divide by Zero 000013 Decimal Overflow 000014 Invalid ASCII Digit 000015 Invalid Decimal Digit 000016 Invalid Source Word Count 000017 Invalid Decimal Length 000020 Decimal Divide by Zero Each decimal number consists of from 1 to 28 BCD digits plus a trailing sign digit, requiring a maximum of 15 bytes. Numbers always end with the sign in the lower half of the last byte, so the first byte contains an unused digit in the upper half if the number of digits is even. That unused digit is not modified by any instruction other than CVAD, which inserts a zero, so a read-modify-write cycle is needed to handle the leading byte. The Decimal instructions microcode loads the operand, or one of the two operands, into registers. If the operand is contained in four or fewer words, registers RA-RD are used. Otherwise, registers PL, DL, DB, and Q are used in addition. The registers are freed by pushing them on the stack. All instructions except DMPY, which is not a decimal instruction, and SLD, NSLD, and SRD check for three free stack words immediately upon entry. If the space is unavailable, a stack overflow trap occurs. The three shift instruction first mask the X register to five bits and then check for stack overflow. The diagnostic verifies this behavior. The SRD instruction: - masks X to the lower five bits - checks for enough space on the stack to save registers - traps if either operand length is greater than 28 - exits if either operand length is 0 - checks for bounds violations for each argument (source and destination) - reads the the source operand into registers - scans the operand and traps if an illegal digit is present - performs the indicated shift Note that it checks the source operand digits before performing the shift and consequently the store to the destination. So an illegal source digit will result in no change to the destination. The arithmetic instructions (ADDD, etc.) appear to check the operand digits on the fly as part of the operations, rather than at the start of the instruction. However, the trap is taken before the result is stored, so it should be equivalent to checking when the operands are read. Except for NSLD and MPYD, low-order digits are stored even if there is an overflow condition (target digit count is too small). NSLD stores nothing, and MPYD stores the left-truncated result if the full result could be contained in 28 digits; otherwise it stores nothing. ---------------- CVAD Instruction ---------------- The CVAD instruction checks for invalid source ASCII digits. The check is executed from right to left, and an Invalid ASCII Digit trap occurs if the check fails. If a trap occurs, a partial decimal conversion may be done. The rules are a bit arcane, and the diagnostic tests for expected results for bad source strings. The sign is checked first, so if it is bad, nothing is written. Thereafter, words are written as they are converted until an invalid character is seen, whereupon an immediate trap is taken, and the word in which the bad character would appear is not written. Because the decimal target may end in either the upper or lower byte of the last word, an illegal character as the next-to-last digit may or may not write a target word. If the target ends in the upper byte, that word is written; if it ends in the lower byte, that word is not written. The situation is complicated by embedded blanks. Because processing occurs from right to left, encountering one or more contiguous blanks may or may not be illegal, depending on whether any additional digits appear to the left of the blank(s). Working backward, the first space encountered is replaced by a zero, and a flag is set to require all additional characters to be spaces (i.e., it assumes that it is processing leading spaces). If a non-space character is subsequently encountered, the trap is taken at that point, and any prior blanks encountered are stored as valid zeros. This means, for example, that an embedded space that would go in the MSD of a word will write that word with a zero in the MSD and then trap on the NEXT valid digit. So processing "1234 67" will write an "067F" word before trapping, but processing "12345 7" or "1234-67" will write nothing. As another example, if the ASCII string consists of a "1" followed by eight blanks followed by the sign, and the target ends in the right-hand byte, a word of four zeros and a word of three zeros plus a sign would be written before the trap is taken. However, if the string contained a "1" followed by two blanks followed by the sign, nothing would be written. The diagnostic checks these three cases: Step 463, source 7,"1234 67", result 3,"067F" AAAA FFFF 067F FFFF FFFF FFFF FFFF FFFF FFFF AAAA Step 464, source 9,"9=7654321", result 5,"54321F" AAAA FFFF 5432 1FFF FFFF FFFF FFFF FFFF FFFF AAAA Step 465, source 10,"0+2345678R", result 7,"3456789D" AAAA FFFF 3456 789D FFFF FFFF FFFF FFFF FFFF AAAA The simulation is currently written to handle the single blank case properly, but multiple embedded blanks will trap after the first blank and so will write fewer words than the hardware. ------------------------------- SLD, NSLD, and SRD Instructions ------------------------------- RIGHT SHIFT ~~~~~~~~~~~ | .... .... .... .... .... .... 1234 .... .... .... .... .... ..00 0000 X = 2 | | .... .... .... .... .... 1234 5678 .... .... .... .... .... ..00 0000 X = 1 | | .... .... .... .... .... 1234 5678 .... .... .... .... .... ..00 0000 X = 4 | | .... .... .... .... .... 1234 5678 X = 3 .... .... .... 0000 0000 0000 0000 | if target_start > significant_index + X -- significant digits lost then source_index = target_start - X target_index = target_start else source_index = significant_index -- skip zero source digits target_index = source_index + X if target_index < max -- all shifted off left end then move_count = max - target_index else move_count = 0 target_significance = max - target_index LEFT SHIFT ~~~~~~~~~~ | .... .... .... .... .... .... 1234 .... .... .... .... .... ..00 0000 X = 2 | | .... .... .... .... .... 1234 5678 .... .... .... .... .... ..00 0000 X = 1 | | .... .... .... .... .... 1234 5678 X = 3 .... .... .... 0000 0000 0000 0000 | if target_start + X > significant_index -- significant digits lost then source_index = target_start + X target_index = target_start set carry else source_index = significant_index -- skip zero source digits target_index = source_index - X if source_index < max -- all shifted off left end then move_count = max - source_index else move_count = 0 target_significance = max - target_index LEFT NORMALIZING ~~~~~~~~~~~~~~~~ if source->significant_count > target->digit_count then set carry return Decimal Overflow -- must fit with some X >= 0 source_index = significant_index if X > source_index - target_start then target_index = target_start X = X - (source_index - target_start) set carry else target_index = source_index - X -- SLD from here on move_count = max - source_index -- significant count target_significance = max - target_index if carry set then must scan for new significance ----------------------- EIS Diagnostic Coverage ----------------------- 2027 CKLM does: - SP1 := SM + 7 - if SM + 7 > Z goto STOV - if RA > 28 goto TA17 - if RC > 28 goto TA17 - clear Overflow - if RA = 0 goto 2537 ADZL (JSB PSHA, JMP APOP) [ decrement_stack clears Overflow if no trap; everybody calls it ] 1374 PSHA does: - QDWN until SR = 0 - clear Overflow - return 2220 APOP does: - if CIR & 060 = 0 then NEXT - SM = SM - 2 - if CIR & 040 = 0 then NEXT - SM = SM - 2 - NEXT Trap 17 calls PSHA Traps 13, 15, 17 clear SR (pop four words from stack) These instruction tests are missing the following coverage: --> 2403 ADDD Add decimal --> 2402 SUBD Subtract decimal * source count > 28 or target count > 28 (trap %17) * source count > 0 and target count > 0 (does nothing) * addend 0, sum = augend * augend 0, sum = addend, enough target space * augend 0, sum = addend, not enough target space (trap %13) * addend > augend, no decimal overflow * addend = -augend, result 0 * carry out of MSD with room available (no trap) --> 2402 CMPD Compare decimal * first count > 28 or second count > 28 (trap %17) * first count = 0 or second count = 0 (does nothing) * first signif > second signif [CCL] * first signif < second signif [CCG] * both negative and abs (first) > abs (second) [CCG] * both negative and abs (first) < abs (second) [CCL] * first - second + [CCG] --> 2566 MPYD Multiply decimal * multiplier zero, multiplicand negative * operands would overflow 29 digits (trap 13, no result) * operands overflow 28 digits (trap 13, no result) * operands just fit in 28 digits --> shift instructions - bounds violation if SM + SR + 3 > Z * X > 31 masked to the lower five bits * source count > 28 or target count > 28 (trap %17) * source count > 0 and target count > 0 (does nothing) [ does mask X, check stack, RA > 28, CLO (via CKLM), RC > 28, RA or RC = 0, etc. ] --> 2251 SRD Shift right decimal NO! SIMPLY TRUNCATES! * loss of significant digits because target is too small (trap 13 decimal overflow) [ does CCRY, mask X, check stack, RA > 28, CLO (via CKLM), RC > 28, RA or RC = 0, etc. ] --> 2023 NSLD Normalizing shift left decimal * non-zero shift that doesn't overflow and doesn't carry (i.e., shift fits) --> 2024 SLD Shift left decimal * OK --> 1641 CVAD Convert ASCII to decimal * successive embedded blanks (trap %14) * truncated conversion (no check for ASCII digits that won't fit) * longer target (leading zero fill) * bad conversion, target ends on even byte * bad conversion, target ends on odd byte --> 3323 CVDA Convert decimal to ASCII * OK --> 3112 CVBD Convert binary to decimal * RA > 6 words (trap %16) * RC > 28 digits (trap %17) * first count = 0 or second count = 0 (does nothing) * good conversion of 1 binary word --> 3450 CVDB Convert decimal to binary * source decimal zero (result = 0) * source decimal negative --> 1275 DMPY Double logical multiply * OK SUBD, ADDD, MPYD (not 29), NSLD, CVBD does trap 13 (packed decimal overflow) CVAD does trap 14 (invalid external digit) MPYD, SRD, SLD, ADDD, CVDA, CVDB does trap 15 (invalid packed digit) nobody does trap 16 (source word count > 6) CVDA, CVAD, CVDB, MPYD does trap 17 (invalid decimal length) STOR sets F1 if significant digits truncated for insufficient space --------------------- COBOL II Instructions --------------------- The instructions listed in the Machine Instruction Set manual as "Language Extension Instructions" are required to run COBOL II programs and, at least in some cases, the COBOL II compiler itself. Otherwise, the program aborts with PROGRAM ERROR #7 :ILLEGAL INSTRUCTION. There is no firmware emulation provided, and there appears to be no way to suppress generation of these instructions in favor of software replacements. The instructions appear to be a part of the base set for the Series 37 -- at least, the compiler and compiled programs run properly on this machine. The product number is 32234A, the "COBOL II Extended Instruction Set" and it provides a set of ROMs that plug into the ROM PCA. Jumper W4 must be removed from the CIR PCA to enable the instruction set. The opcodes occupy the range 020460-020477, as follows: 020460 - ALGN [p.334] (Align numeric, bit 15 S-decrement) 020461 - ALGN [p.334] (Align numeric, bit 15 S-decrement) 020462 - ABSN [p.330] (Absolute numeric, bit 15 S-decrement) 020463 - ABSN [p.330] (Absolute numeric, bit 15 S-decrement) 020464 - (undefined) 020465 - (undefined) 020466 - (undefined) 020467 - (undefined) 020470 - EDIT [p.362] (Edited move, PB-relative) 020471 - EDIT [p.362] (Edited move, DB-relative) 020472 - CMPS [p.313] (Compare string, PB-relative) 020473 - CMPS [p.313] (Compare string, DB-relative) 020474 - XBR [p.313] (External branch) 020475 - PARC [p.312] (Paragraph procedure call) 020476 - ENDP [p.313] (End paragraph) 020477 - (two-word instructions) 000006 - CMPT [p.313] (Compare translated strings, PB-relative) 000007 - CMPT [p.313] (Compare translated strings, DB-relative) * 000010 - TCCS [p.318] (Test condition code and set, bits 13-15 options) * 000017 - TCCS [p.318] (Test condition code and set, bits 13-15 options) 000020 - CVND [p.352] (Convert numeric display, bits 12-15 options) 000037 - CVND [p.352] (Convert numeric display, bits 12-15 options) 000040 - LDW [p.306] (Load word, bit 15 S-decrement) 000041 - LDW [p.306] (Load word, bit 15 S-decrement) 000042 - LDDW [p.308] (Load double-word, bit 15 S-decrement) 000043 - LDDW [p.308] (Load double-word, bit 15 S-decrement) 000044 - TR [p.326] (Translate, PB-relative) 000045 - TR [p.326] (Translate, DB-relative) 000046 - ABSD [p.1800] (Absolute decimal, bit 15 S-decrement) 000047 - ABSD [p.] (Absolute decimal, bit 15 S-decrement) 000050 - NEGD [p.1801] (Negate decimal, bit 15 S-decrement) 000051 - NEGD [p.] (Negate decimal, bit 15 S-decrement) * These instructions are not present in the Machine Instruction Set manual. From the Series 64 microcode, it appears that bits 13-15 are "> = <" flags. If any flag matches the current condition code, -1 is pushed on the stack. Otherwise, 0 is pushed on the stack. There are two diagnostics for these instructions: - PD441A COBOLII A F/W DIAG - PD442A COBOLII B F/W DIAG I do not have the manual for these diagnostics. The CE Handbook 30000-90172 page 9-37 describes the diagnostic operating sequence. Per a comment in the UNIMPLEMENTEDINSTRUCTION procedure in MPE module 10, double-word instructions trap with P+1 if the firmware is missing, and with P+2 if the firmware is present but the second word is not defined. HP 32234A COBOL II Instructions for the Series II, III are on the September 1982 price list, as is HP 32236A for the Series 30, 33. The price is $700. The HP 32233A COBOL II compiler is mentioned in the June 1980 configuration guide. It is not mentioned in the October 1979 guide. First mention in the Communicator/3000 is March 1980 (Issue 24). In the section for ordering information, after listing the product numbers for the compiler, it says, "In addition to the above products, systems shipped prior to January 1, 1980 require a firmware instruction set" and then lists the 32234A and 32236A products. So it seems that the COBOL II instructions became standard equipment at that point. There seem to be various names used for the firmware: - Language Extension Instructions (Machine Instruction Set 2/80 & 6/84) - COBOL II/3000 Extended Instruction Set (Communicator/3000 3/80) - COBOLII Firmware (Diagnostic; Communicator/3000 3/80) - COBOL II Firmware Instruction Set (Series 64/68/80 Microcode 10/86) - COBOL II Extended Instruction Set (HP 3000 Computer Systems Price Guide 9/82) The last name is used in a number of price and configuration guides from September 1982 through the removal of the Series III. The March 1980 Communicator also has the first mention of product 32232A, the "COBOL Library." The description on page 118 says that this product "includes the COBOL II runtime library procedures." At some point, it appears that this product was merged into the system SL, as the V/R SL contains several COBLIBnn segments. However, it appears that the COBOL II procedures (e.g., IO'CLOSE'FILES) are missing, meaning that some COBOL II programs won't bind. There is a brief description of the XBR, PARC, and ENDP instructions in Communicator/3000 Issue 26 (February 1981) on pages 50-51. The Series 64/68/70 Computer Systems Microcode Manual contains the source for the COBOL II instructions. There seem to be reasonable introductory comments for each firmware instruction. That said, the microcode source occupies 88 pages! The instructions trap for two conditions: Parameter Description --------- ---------------------- 000014 Invalid ASCII Digit 000017 Invalid Decimal Length If the T bit in the STA register is off, the O bit is set instead, and execution continues. Note that "Invalid Decimal Length" is different from "Invalid Source Word Count". The latter trap is used with EIS instructions CVBD when n < 0 or n > 6. With regard to the traps, the Machine Instruction Set manual 30000-90022 "Instruction Commentary" for the LEI section says: If the User Traps bit (STA.2) is not set, the Overflow bit (STA.4) is set, the stack is popped in accordance with the instruction, and execution continues with the following instruction. If the Traps bit is set, the Overflow bit is not set, the stack is not popped, and a trap to the Traps segment, segment 1, is taken. However, the 6x microcode for, e.g., the ALGN instruction does a "JSZ TRPR" after unconditionally popping the stack (PDF page 340). TRPR checks STA.2 and either starts trap processing if it is set or sets Overflow and proceeds to the next instruction if it is clear. So, for the 6x at least, the stack is popped in both cases. The same statement is made for the Decimal Arithmetic instructions in the EIS, and both the 6x and Series II microcode show that the decision to pop the stack is made after checking the Trap bit. So the MIS manual is correct for the EIS stack behavior. ---------------- EDIT Instruction ---------------- The EDIT instruction is interruptible. At instruction start, RA is set to 177777 (from 000000) to indicate that the instruction is executing. When the interrupt handler returns to the instruction, RA = 177777 is the indication that the instruction was interrupted. When an interrupt is detected within the instruction execution, two words are pushed onto the stack before the interrupt handler is called. These words hold the current significance trigger, loop count, float character, and fill character, in this format: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 | TOS +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | S | 0 0 0 0 0 0 0 | loop count | TOS - 1 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | fill character | float character | TOS - 2 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: S = significance trigger (0/1) The fill and float characters word is written over the zero that resides at the TOS on instruction entry, and then the significance trigger/loop count word and a word of all ones are pushed. Subinstructions and operands: Page Opcode SubOp Mnem Movement Action ---- ------ ----- ---- -------- --------------------------------------- 367 00 - MC s => t move characters 368 01 - MA s => t move alphabetics 369 02 - MN s => t move numerics 369 03 - MNS s => t move numerics suppressed 369 04 - MFL s => t move numerics with floating insertion 372 05 - IC c => t insert character 372 06 - ICS c => t insert character suppressed 373 07 - ICI p => t insert characters immediate 373 10 - ICSI p => t insert characters suppressed immediate 374 11 - BRIS (none) branch if significance 375 12 - SUFT (none) subtract from target 375 13 - SUFS (none) subtract from source 378 14 - ICP c -> t insert character punctuation 378 15 - ICPS c -> t insert character punctuation suppressed 379 16 - IS p => t insert character on sign 384 17 00 TE (none) terminate edit 385 17 01 ENDF c -> t end floating point insertion 386 17 02 SST1 (none) set significance to 1 386 17 03 SST0 (none) set significance to 0 387 17 04 MDWO s -> t move digit with overpunch 388 17 05 SFC (none) set fill character 389 17 06 SFLC (none) set float character 389 17 07 DFLC (none) define float character 390 17 10 SETC (none) set loop count 391 17 11 DBNZ (none) decrement loop count and branch Where: s = source byte address t = target byte address p = program byte address c = character operand -> = move 1 byte => = move n bytes 0 1 2 3 4 5 6 7 +---+---+---+---+---+---+---+---+ | 0 0 0 0 | imm. operand | MC - move characters +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 0 0 0 1 | imm. operand | MA - move alphabetics +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 0 0 1 0 | imm. operand | MN - move numerics +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 0 0 1 1 | imm. operand | MNS - move numerics suppressed +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 0 1 0 0 | imm. operand | MFL - move numerics with floating insertion +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 0 1 0 1 | imm. operand | IC - insert character +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ | character to insert | +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 0 1 1 0 | imm. operand | ICS - insert character suppressed +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ | character to insert | +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 0 1 1 1 | imm. operand | ICI - insert characters immediate +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ | character 1 to insert | +---+---+---+---+---+---+---+---+ ... +---+---+---+---+---+---+---+---+ { | character n to insert | } (present if operand > 1) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 0 0 0 | imm. operand | ICSI - insert characters suppressed immediate +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ | character 1 to insert | +---+---+---+---+---+---+---+---+ ... +---+---+---+---+---+---+---+---+ { | character n to insert | } (present if operand > 1) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 0 0 1 | imm. operand | BRIS - branch if significance +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 0 1 0 | imm. operand | SUFT - subtract from target +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 0 1 1 | imm. operand | SUFS - subtract from source +---+---+---+---+---+---+---+---+ { | extended operand | } (present if imm. operand = 0) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 0 1 1 | imm. operand | ICP - insert character punctuation +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 0 0 | imm. operand | ICPS - insert character punctuation suppressed +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 0 | imm. operand | IS - insert character on sign +---+---+---+---+---+---+---+---+ | positive sign character 1 | +---+---+---+---+---+---+---+---+ ... +---+---+---+---+---+---+---+---+ { | character n to insert | } (present if operand > 1) +---+---+---+---+---+---+---+---+ | negative sign character 1 | +---+---+---+---+---+---+---+---+ ... +---+---+---+---+---+---+---+---+ { | character n to insert | } (present if operand > 1) +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 0 0 0 | TE - terminate edit +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 0 0 1 | ENDF - end floating point insertion +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 0 1 0 | SST1 - set significance to 1 +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 0 1 1 | SST0 - set significance to 0 +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 1 0 0 | MDWO - move digit with overpunch +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 1 0 1 | SFC - set fill character +---+---+---+---+---+---+---+---+ | fill character | +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 1 1 0 | SFLC - set float character +---+---+---+---+---+---+---+---+ | float character | +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 0 1 1 1 | DFLC - define float character +---+---+---+---+---+---+---+---+ | positive float character | +---+---+---+---+---+---+---+---+ | negative float character | +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 1 0 0 0 | SETC - set loop count +---+---+---+---+---+---+---+---+ | loop count | +---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+---+ | 1 1 1 1 | 1 0 0 1 | DBNZ - decrement loop count and branch +---+---+---+---+---+---+---+---+ | branch displacement | +---+---+---+---+---+---+---+---+ ---------------- ALGN Instruction ---------------- The ALGN instruction shifts, truncates, and/or zero-fills to align a source value with a target value at the decimal point location. The source value is effectively shifted left or right to place the (assumed) decimal point in the desired location and then stored in the target location with leading and trailing truncation and zero-filling as needed. In addition to the source and target byte addresses, the source and target length and trailing-digit counts are passed on the stack. From these, the leading-digit counts may be derived. If the source is signed (overpunched), the target will have the same sign, although the digit on which the sign is placed may not be the same as the source (due to truncation or zero-fill). Note that there seems to be no indication if significant digits are truncated. The instruction sets the Overflow indicator if user-trapping is disabled and an invalid digit or count is detected. It does not appear to set Overflow if the source overflows the target. Algorithm: -- source_lead and target_lead are unsigned store = true while source_count > 0 or target_count > 0 loop if source_lead < target_lead or source_count = 0 byte := '0' else store := source_lead = target_lead get a source byte source_byte_address++ source_count-- if source_count = 0 strip_overpunch (byte, sign) if source_lead > 0 source_lead-- if store and target_count > 0 store the target byte target_byte_address++ target_count-- if target_lead > 0 target_lead-- end loop overpunch last target byte with sign ---------------- CVND Instruction ---------------- The CVND instruction is used to convert a USAGE IS DISPLAY value when the SIGN IS LEADING, SIGN IS LEADING SEPARATE, or SIGN IS TRAILING SEPARATE clauses are used. Each of these forms may be converted into the default SIGN IS TRAILING format. The actions depend on the "sign control field." The 6x microcode does this: 0 (LS): - get leading sign source byte - move N-1 bytes with zero fill and validation - overpunch last target byte with sign and rewrite 1 (TS): - move N-1 bytes with zero fill and validation - get trailing sign source byte - overpunch last target byte with sign and rewrite 2 (LO): - get leading overpunch source byte - strip overpunch from byte; if blank, replace with 0 - store first target byte - move N-1 bytes with zero fill and validation - overpunch last target byte with sign and rewrite 3 (TO): - move N-1 bytes with zero fill and validation - get trailing sign source byte - strip overpunch from byte; if blank, and all preceding bytes are blank, replace with 0 - store last target byte - overpunch last target byte with sign and rewrite 4-7 (UN): - move N bytes with zero fill and validation Leading blanks are allowed and converted to zeros in all cases except case 2 (LO) when the leading sign byte is NOT blank. A special case is when N = 1 with separate sign. In this case, there are no bytes to move, so a zero is placed in the target in preparation for overpunching. Algorithm: while count > 0 loop get a source byte if first byte then if LS then validate and set sign and skip else if LO then if byte is blank then byte = 0 and sign is unsigned else validate and strip overpunch and set sign; blanks NOT OK else if last byte then if TS then validate and set sign and skip else if TO then if byte is blank and blanks OK then byte = 0 and sign is unsigned else validate and strip overpunch and set sign if byte is blank and blanks OK then byte = 0 else validate byte 0-9 store a target byte decrement count increment source and target addresses end loop ------------------------ Stack Decrement Encoding ------------------------ The "move" base set instructions (subopcode 02, opcode 00, move opcodes 0-5) contain "S-decrement" fields that indicate the counts of parameters to remove from the stack when the instructions complete. These fields are two or three bits that indicate a stack adjustment of 0-3 or 0-7 words, respectively. In addition, certain "decimal arithmetic" instructions of the optional Extended Instruction Set and certain "numeric conversion and load" instructions of the optional Language Extension Instructions contain one or two S-decrement bits, but these encode the stack adjustment rather than expressing the adjustment directly. The encodings are: Stack decrements Set Name Bits 0 1 2 3 --- ---- ----- --- --- --- --- EIS CVAD 11 2 4 EIS CVDA 11 1 3 EIS CVBD 11 2 4 EIS CVDB 11 2 3 EIS ADDD 10-11 0 2 4 4 EIS SUBD 10-11 0 2 4 4 EIS CMPD 10-11 0 2 4 4 EIS SLD 10-11 0 2 4 4 EIS NSLD 10-11 0 2 4 4 EIS SRD 10-11 0 2 4 4 EIS MPYD 10-11 0 2 4 4 LEI ALGN 15 3 4 LEI CVND 15 2 3 LEI ABSN 15 1 2 LEI ABSD 15 1 2 LEI NEGD 15 1 2 LEI LDW 15 0 1 LEI LDDW 15 0 1 The SPL "ASMB" statement accepts the EIS instructions above with the stack adjustment given as the encoded value. So, e.g., CVAD 0 and CVAD 1 are accepted, with the former deleting two words and the latter deleting four words from the stack. --------------- PCN Instruction --------------- CPU numbers: 1 = Series II 2 = Series III 3 = Series 39/40/42/44 (ICF/44), 5x (per DMAEXR) 4 = Series 64/68/70 (ICF/55) 5 = Series 37 6 = MICRO 3000XE (tiogamouse) 7 = MICRO 3000 (micromouse) 8 = Series 30/33 Series 48 42XP 58 ? --------------- Stack Preadjust --------------- Each instruction execution begins with a preadjustment of the stack. This is done so that the TOS values used by the instruction are present in the TOS registers (RA-RD) prior to microcode execution. This ensures that the microcode needs only to refer to the registers, unless the instruction has more than four stack operands. The IMB machines define a stack underflow as SM <= Q, whereas the IOP machines define it as SM <= DB. The former makes more sense -- if the stack drops below the stack marker, then there have been more pops than pushes. However, it means that the stack preadjust becomes critical. As an example, the SETR instruction uses from one to nine TOS values, depending on the instruction options. On the Series III uses a preadjust of 3. This is fine when comparing SM to DB, as the intervening stack marker is four words. However, on the Seriex 58 (e.g.), if the instruction only sets one register and therefore pops one stack value, and the instruction executes in the main block immediately after initialization, where SM = Q, then the preadjust will leave SM below Q, and a stack underflow trap will occur. Most instructions on the Series III use a stack preadjust value equal to the number of stack operands expected. However, a few do not, typically because a decoding field is shared by two or more instructions, and the preadjust is done for the instruction with the largest requirement. These didn't cause a problem when DB was the lower limit, but with Q as the lower limit, it's imperative that the preadjust reflect only the actual stack locations used. These instructions have preadjusts larger than required on the Series III: Opcode Series III Series 64 ------ ---------- --------- SETR 4 0 p.398 queue down to 0 MVBL 4 3 MVLB 4 3 RSW 4 0 PSDB 2 0 PSEB 2 0 DISP 2 0 XEQ 1 0 p.396 queue down to 0 LST 1 0 p.262 preadjust 1 if k = 0 SST 2 1 p.263 preadjust 2 if k = 0 ADDS 1 0 p.397 preadjust 1 if k = 0 SUBS 1 0 p.397 preadjust 1 if k = 0 On the Series III, all firmware extension instructions start with a preadjust of 4. These are correct for DMUL and DDIV but should not be done for the others, including all unimplmented instructions. These COBOL firmware extension instructions require the indicated preadjusts: Opcode Series 64 ------ --------- ABSD 2 ABSN 2 ALGN 4 CMPS 4 CMPT 4 CVND 3 EDIT 4 ENDP 4 LDDW 1 LDW 1 NEGD 2 PARC 3 TCCS 0 TR 4 XBR 2 These EIS firmware extension instructions require the indicated preadjusts: Opcode Series 64 ------ --------- EADD 3 ESUB 3 EMPY 3 EDIV 3 ENEG 1 ECMP 2 ADDD 4 CMPD 4 CVAD 4 CVBD 4 CVDA 3 CVDB 3 DMPY 4 MPYD 4 NSLD 4 SLD 4 (the machine instruction set manual says 3, but this is wrong) SRD 4 SUBD 4 ---------------- SETR Instruction ---------------- The SETR instruction must be constructed differently for the Series III and the Series 4x/5x, for two reasons. First, the 4x/5x version restores all of the changed registers if an underflow is detected, whereas the Series III version does not. Second, the IMB machines trap for stack underflow when SM <= Q, rather than SM <= DB. This means that the number of parameters pulled from the stack must be only those needed by the instruction, as the instruction must execute without a stack underflow if there is nothing on the stack other than the variable number of instruction parameters. So no preadjustment can be done. The new behavior [p.398] does queue down until SR = 0. Then for each register to set, it saves the old value, checks for stack underflow, reads the stack value, decrements SM, and sets the new value. If underflow is detected, all of the registers that have been set are unset by restoring the old values before trapping. ======== Starfish ======== Reference: - HP 30341A HP-IB Interface Module Reference/Training Manual (30341-90002) [ do not have ] The HP 30341A HP-IB Interface Module ("Starfish") uses a Series 33 processor card containing modified firmware that implements the Series 33 HP-IB I/O instruction set and the Channel Program Processor. The I/O instructions are executed in the Series III by a specially configured SIO instruction whose program pointer on the stack is %177777 and whose DRT word 0 contains one of the following opcodes: Inst Opcode Action ---- ------ ----------------------------- SIOP 000000 Start I/O Program HIOP 000001 Halt I/O Program RIOC 000002 Read I/O Channel WIOC 000003 Write I/O Channel SED2 000004 Enable/Disable CPP interrupts IOCL 000005 I/O Clear INIT 000006 Initialize I/O Channel SLFT 000007 Initiate self-test The SED2 and SLFT instructions are specific to the Starfish. The others are standard HP-IB machine instructions listed in the Machine Instruction Set manual. ============== HP-IB Machines ============== --> The Machine Instruction Set manual 30000-90022 June 1984 page 6-2 (pdf page 242) says that the Set Firmware Version instruction (Series 37 only) configures the microcode to use MPE-V/P and earlier or MPE-V/E and later. In addition, it says that the microcode version affects these instructions: PCAL, EXIT, IXIT, SCAL, LLBL, LST, SST, DISP, PARC (COBOL), ENDP (COBOL), XBR (COBOL), LRA/PCAL 0 (BASIC), "and the interrupt handler." --> The Series 6x Microcode manual 30140-90045 October 1986 page 1 (pdf page 7) says that the CST changes affect these instructions: PCAL, EXIT, IXIT, SCAL, LLBL, LST, SST, PARC, XBR, LAP, LAIP, and "also affects" INT8, INT9, CLFN, STTV, and CSTV. --> The MPE V Tables Manual for MPE V/E Version G.00.00 (32033-90010) shows that System Global Area word %220 (absolute address %1220) is the "Mapping Firmware Flag (Non-Zero = MPE V/E Microcode)." MPE V/E source code tests this word and handles some things differently, depending. So maybe V/E will run on a CPU without V/E firmware. Or, like RTE-6/VM, it may have originally but then lost that capability somewhere down the road. I can't find where in the Series 6x microcode this word is set, although one bit in it is set in the "ENPF" (enable performance firmware) instruction (PDF pages 258 and 261). --> INITIAL says that, "The mapping firmware will store a 1 at QI-9 on coldload as an indication that is exists." It is INITIAL that copies this word to location %1220. QI is contained in absolute memory location 5. The 6x firmware writes 1 to QI-9 on PDF p.64 just before setting up the cold load trap. --> The tables manual says that the LST/SST instructions use pointers with this format: address bits 0-10, bank bits 11-15. For pre-expansion microcode, the bank is always zero; new firmware allows the bank to be non-zero. It also says that the "address is the whole word with the bank masked out to 0." -------------------- New CPU Instructions -------------------- There are two code points that introduce new two-word instructions. The Amigo I/O instructions begin with %020302 and are of the form: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 0 | 1 1 0 0 0 | 0 1 0 | Amigo I/O +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 | I/O operation | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ The I/O operations supported vary by CPU model: Op Inst 3x 4x 5x 6x Description -- ---- -- -- -- -- ---------------------- 00 SIOP X X X X Start I/O program 01 HIOP X X X X Halt I/O program 02 RIOC X X X - Read I/O channel 03 WIOC X X X - Write I/O channel 04 ROCL X - - - Roll Call 05 IOCL X - - - I/O Clear 06 INIT X X X X Initialize I/O channel 07 MCS X X X - Memory Command and Status 10 SEML X - - - Semaphore load 11 STRT X X X X Initiate warmstart 12 DUMP X X X X Load soft dump program 13 RIOA - - - X Read I/O adapter 14 WIOA - - - X Write I/O adapter All of the instructions are privileged. The leading word decodes as RSW for the Series II and III. The Amigo Clock instructions begin with %020104 and are of the form: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 1 0 | 0 0 0 0 | 0 1 0 | 0 0 1 0 0 | Amigo clock +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 | operation | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ These operations also vary by CPU model: Op Inst 3x 37 4x 5x 6x Description -- ---- -- -- -- -- -- --------------------------------- 00 RCCR X X X X X Read system clock counter 01 SCLR X X X X X Set system clock limit register 02 TOFF X X X X X Hardware timer off 03 TON X X X X X Hardware timer on 04 SBM - - X X - Set bank mask 04 MCMD - - - - X Message communication 05 FLSH - - - - X Flush cache 10 SINC X X X X X Set system clock interrupt 14 RDCU - - - - X Read DCU log 15 ISTR - - - - X Initialize System Table Registers 16 ENPF - - - - X Enable Performance Enhancement 17 RTOC - X - - - Read time-of-century clock 20 WTOC - X - - - Write time-of-century clock 21 PFL - X - - - Power fail 22 FVER - X - - - Set firmware version 23 OSIG - X - - - Operating system signal All of the instructions are privileged. The leading word decodes as MVBL for the Series II and III. ------------ System Clock ------------ The HP-IB machines do not have a dedicated hardware counter for the process clock. Instead, there is a simple 1 msec. CPU counter that provides periodic interrupts that the firmware intercepts and uses to provide a software process clock and a software programmable timer. Five instructions provide control over this counter. All are two-word instructions whose first word is 020104 octal, and all are privileged: Word 2 Code Description ------ ---- ------------------------------- 000000 RCCR Read system clock counter 000001 SCLR Set system clock limit register 000002 TOFF Hardware timer off 000003 TON Hardware timer on 000010 SINC Set system clock interrupt Note that TOFF and TON do not actually affect the hardware timer or the software counting of timer interrupts. Instead, they affect whether the resulting timer interrupt generates a trap to the system clock handler (STT %14). These reserved locations in memory are affected (per the tables manual): Address Description ------- -------------------------------------------- 000021 Interrupt interval (LR reset value) 000022 Temporary storage of limit register (TEMPLR) 000023 System clock limit register (LR) 000024 (unused) 000025 Time since last soft timer interrupt (TR) 000026 System clock status (SCST) 000027 System clock last count (SCLC) The clock instructions are entered via CLKI (page 266), which does: %25 -> SP4A M [%25] -> OPA -- TR 0 -> SP0A -- parameter %24 -> RH A jump is then made through the table on page 267 to the specific instruction executor. The instructions descriptions follow [page 268]. Note that the microcode refers to locations %23 and %25 as TR and LR, respectively, while the MPE tables manuals refer to them as LR and TR. The microcode references are used below. The microcode uses these internal registers: Register Name Description -------- ------ -------------------------------------------- XR15 CPX? bit 8 = timer on/off, bit 0 = set "SINCBIT", bit 15 = "cold load", bit 14 = cold dump) XR20 PCLK Process clock XR31 CR Counter register The microcode uses these memory locations: Address Name Used by Description ------- ------ --------- ------------------------------------------ 000021 LR MPE bits 1-15 = storage for interrupt interval 000022 TEMPLR MPE Temporary storage of limit register 000023 TR microcode Time since last soft timer interrupt 000024 -- -- (unused) 000025 LR microcode System clock limit register 000026 SCSR MPE System clock status register 000027 SCLC MPE System clock last count Regarding TEMPLR, HARDRES says, "This location is used by TICK because the limit register is updated by the firmware before it gets to TICK." In the instructions below, LR is the count starting value and CR is the negative count remaining. Therefore, LR + CR is the positive count transpired, i.e., the number of ticks since the last reset. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 0 1 | 0 0 0 | 1 0 0 | RCCR +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action: SP3B := M [%25] + XR31B -- LR + CR TOS := SP3B + M [%23] -- LR + CR + TR Read the system clock counter register and push the value onto the stack. The counter register is the negative number of clock ticks until the next clock interrupt, so the positive reset value in the limit register is added to the clock register to get a positive number of ticks elapsed. This value is then added to the total register to include any missed ticks in case the interrupt system was off when the count expired. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 0 1 | 0 0 0 | 1 0 0 | SCLR +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RA = New clock limit Action: SP3B := M [%25] + XR31B -- LR + CR M [%23] := SP3B + M [%23] -- TR := LR + CR + TR M [%25] := RA -- LR := RA XR31B := - RA -- CR := - RA POP Set the system clock limit register. The current elapsed clock tick count is added to the total register and saved. Then the value on the top of the stack is stored in the limit register and negated and stored in the clock register. This action resets the clock register to the new limit. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 0 1 | 0 0 0 | 1 0 0 | TOFF +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action: XR15A := XR15A and %177577 -- clear bit 8 The timer enable bit is cleared. This does not stop the clock or inhibit incrementing of the count register negative value; instead, it inhibits the clock interrupt. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 0 1 | 0 0 0 | 1 0 0 | TON +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action: XR15A := XR15A or %000200 -- set bit 8 if STA(1) = 1 and XR15(0) = 1 then -- if interrupts are on and SINC bit is set handle deferred clock interrupt -- [CSNC p.26] end if The timer enable bit is set. If the counter register has rolled over while the timer interrupt was disabled, a clock interrupt is asserted now, rather than waiting for the counter to roll over again. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 0 1 | 0 0 0 | 1 0 0 | SINC +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action: M [%26] := M [%26] or %100000 -- set status bit 0 for SINC instruction if STA(1) /= 0 then -- if interrupts are on param := 0 -- interrupt caused by SINC instruction trap STT %14 -- take system clock trap else -- interrupts are off XR15 := XR15 or %100000 -- set SINC bit set defer FF -- set deferred interrupt FF end if A system clock interrupt is initiated. Bit 0 of memory word 26 octal (the System Clock Status Register) is set to indicate that the interrupt comes from this instruction. If interrupts are enabled, an immediate system clock trap is taken. Otherwise, the clock interrupt will occur when the interrupt system is reenabled. Note: the Machine Instruction Set manual says that if interrupts are disabled, the SCSR is incremented. However, this action does not appear in the Series 64 microcode, nor does MPE (HARDRES) apparently make any use of the lower 15 bits of the SCSR. The AID statement STARTCLOCK [n], "Initiates operation of the system clock and causes a counter increment every interval as specified in the optional parameter (default is 1 millisecond)." [page 833-73] TOFF LOAD [n] SCLR TON The AID statement READCLOCK , "Reads the content of a register which contains the amount of clock intervals as specified in the STARTCLOCK statement; this statement also stops the system clock from further interrupts." [page 833-69] TOFF AID expects STT %14 to handle the system clock interrupt. It does: RCCR TON LOAD [n] SCLR <> LDXI %26 PLDA STOR HOLD ZERO PSTA MPE ININ also expects STT %14 to handle the system clock interrupt. It does: SED 0 ? -------------------------------- The Deferred Interrupt Flip-Flop -------------------------------- Several places in the Series 64 microcode refer to a Deferred Interrupt Flip-Flop, DINTFF. This is set when an interrupt is indicated but the interrupt system is off (i.e., the I bit in the STA register is clear). If this flip-flop is set when the interrupt system is reenabled, either by a SED 1 instruction or an EXIT instruction that reloads the STA register with a value that includes the I bit, then a deferred interrupt handler is executed. To illustrate, TCLK [page 149] is the clock interrupt handler. It does: if not ICSFLAG then -- if not on the ICS XR20 := XR20 + 1 -- increment PCLK end if XR31 := XR31 + 1 -- increment CR if XR31 = 0 then -- count has expired CR := - M [%25] -- reset CR to count limit if STA(1) = 1 and XR15(8) = 1 then -- if I bit and TON bit are both set param := M [%23] + M [%25] -- parameter is TR + LR XR15 := XR15 and %077377 -- clear SINC and TON bits M [%23] := 0 -- clear TR trap STT %14 -- system clock trap else -- otherwise defer clock interrupt XR15 := XR15 or %100000 -- set SINC bit M [%23] := M [%23] + M [%25] -- add limit to TR to count missed ticks set defer FF -- set deferred interrupt FF end if end if -- resume execution DIMS [page 25] is the deferred interrupt handler. It is entered when a SED 1 is executed if the deferred interrupt flip-flop (reflected in CPX2 bit 15 is set. CSNC [page 26] is the deferred clock interrupt handler. It is entered with interrupts on and the SINC and TON bits set. It does: XR15 := XR15 and %077377 -- clear SINC and TON bits if M [%26] /= 0 then -- if clock status is non-zero param := 0 -- interrupt caused by SINC instruction else param := M [%23] -- interrupt caused by clock rollover M [%23] := 0 -- clear TR end if trap STT %14 -- take system clock trap There is no description of this flip-flop in the Series 64 R/T manual. However, this machine uses a message mechanism between the CPU and the IMB I/O interface to communicate IMB IRQ assertions. It's possible that this message occurs only once, when the line transitions. Therefore, once it has been detected and acknowledged by the interrupt handler microcode, it would not be received again until a new interrupt occurs. If the interrupt system was off when this occurs, then indeed some sort of deferred state would have to be maintained by the CPU to ensure that the the interrupt is not lost. On the Series III, the EXTINT bit in CPX1 stays on until the interrupt is acknowledged. The Series 44 presents the IMB IRQ signal on bit 3 of the Status and Interrupt Rregister (SIR), and this signal is ANDed with the I bit of the STA register to assert an interrupt. So it appears that the interrupt deferral state is needed only for the Series 64 and can be ignored in the earlier machines simply by setting the external or timer interrupt bits when the corresponding interrupts occur. They will be processed normally when the next pass through the instruction loop is made. ---------------------- HP-IB I/O Instructions ---------------------- [ HP 300 Architecture Guide, 31000-90004, pp. 148, etc. have descriptions ] The Series 4x I/O instruction set would appear to contain the following instructions. All are two-word instruction beginning with %20302: Inst Word 2 Action ---- ------ ----------------------------- SIOP 000000 Start I/O Program HIOP 000001 Halt I/O Program RIOC 000002 Read I/O Channel WIOC 000003 Write I/O Channel ROCL 000004 Roll Call IOCL 000005 I/O Clear INIT 000006 Initialize I/O Channel MCS 000007 Memory Command and Status SEML 000010 Semaphore Load STRT 000011 Initiate Warmstart DUMP 000012 Load Soft Dump Program The Machine Instruction Set manual says that SEML is for Series 3x only. The ROCL instruction is not documented. However, the DUS-III AID manual page 833-122 describes the ROCL (Roll Call) command, which presumably uses the ROCL instruction. Several of the instructions take a channel number or channel/device number on the stack. The format is: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - - - - - - | Channel | Device | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ The HP 300 Architecture Guide, page 5-49 (PDF page 148) says, "If Chan/Dev# is illegal (i.e., not in the range %10-177), a trap to segment 1, STT 12 will occur." For the 300, the trap is "I/O Instruction Failure." This trap is undefined for the Series III and may not be correct for the HP-IB machines (not checked). The RIOC and WIOC instructions take a command/register/channel/device number on the stack. The device number is not used by the channel command but is required by the mircocode to determine the DRT entry. The format is: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Command | Register | - | Channel | Device | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ If the channel number is zero, a system halt %16, "Non-responding channel" occurs. The IOCL and INIT instructions alter the system interrupt mask word, as does the SMSK instruction. Per the MPE IV/V Tables Manuals, the Series 3x/4x stores the mask word at location 7. The Series 6x stores four mask words for the four possible IMB adapters at locations %32-%35. The Series III stores the mask words at location 7 for CPU 1 or at location %13 for CPU 2, per the Machine Instruction Set manual. For the Starfish, the CPP mask word is stored at location %13, as the Series III uses location 7 for its own mask word. The MPE HARDRES module defines MASK'HPIB as location %13, but this location is never referenced. The DUS-III AID manual (30341-90006) says that INIT clears the mask bit in location %13. Also for the Starfish, IOCL and INIT must set up the PHI to put it back online as the controller, and both also must do a SMSK to reenable the mask FF on the GIC. Otherwise, the GIC diagnostic fails. The instructions are encoded as follows: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | SIOP +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RB = Channel and device RA = Channel program pointer Action: if DRT3(2) = 1 then -- power fail in progress CCL elsif DRT3(0..1) = 00 -- halted or DRT3(0..1) = 01 and DRT3(15) = 1 then -- halting in WAIT state DRT0 := RA DRT3 := %140000 -- set RUN state IMB (SIOP) CCE else CCG end if S := S - 2 If bit 2 of DRT word 3 (the abort bit) is 1, the instruction is aborted, and CCL is set. If bits 0 and 1 of DRT word 3 are 00 (the channel program is halted), or if bits 0, 1, and 15 are 011 (an HIOP instruction has been issued but not yet serviced and the channel is in a wait instruction state), then the channel program pointer is written to DRT word 0, bits 0 and 1 of DRT word 3 are set to 11 (SIO starting state; actually, entire word set to %140000), an SIOP command is sent to the channel, and CCE is set. Otherwise if the above conditions are not met, CCG is set. Traps: stack underflow, non-responding device. Privileged. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | HIOP +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RA = Channel and device Action: if DRT3(0..1) = 00 then -- already halted CCE else if DRT3(0) = 1 then -- running if DRT3(1) = 1 then -- run still pending DRT3 := DRT3 and %17 or %040001 -- set halting at wait else -- running free DRT3 := DRT3 and %17 or %040000 -- set halting end if IMB (HIOP) end if if DRT3(15) = 1 -- halting at wait CCE else -- halting not at wait CCG end if end if S := S - 1 If bits 0, 1, and 15 of DRT word 3 are 010 or 100, then set CCG, else set CCE. CCE indicates that the channel program was halted or in a WAIT state when the instruction was executed, or had been issued SlOP earlier but had not yet been serviced. Then set DRT word 3 to %040001 so that it looks like an HIOP request from the wait state. Issue an HIOP command to the channel to request service on behalf of the device if DRT word 3 was %040000. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | RIOC +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RA = Command, register, channel, and device Action: if DRT3(2) = 1 then -- abort bit set CCL else RA := IMB (RA) CCE end if If the abort bit is not set for the device, the command is sent to the channel, or channels if global, and is popped from the stack. The returned word is pushed on the stack. CCL if an error occurred, else CCE. Traps: stack underflow, non-responding device. Privileged. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | WIOC +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RB = Command, register, channel, and device RA = Data word to write Action: if DRT3(2) = 1 then -- abort bit set CCL else IMB (RB, RA) CCE S = S - 2 end if If the abort bit is not set for the device, the data word and command are sent to the channel, or channels if global, and both are popped from the stack. CCL if an error occurred, else CCE. Traps: stack underflow, non-responding device. Privileged. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | ROCL +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Each channel on the bus sets a bit corresponding to its channel number. The resulting word is returned on the top of the stack. This instruction does not appear in the Machine Instruction Set manual. A roll call is performed by executing an RIOC instruction with the IMB ROCL bus command (%120000). 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | IOCL +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Memory location 7 (the interrupt mask word) is cleared, and then an IOCL bus command is issued. This causes all channels to terminate operations in progress, clear all interrupt enable bits, set all registers to their initial values, and set the HP-IB bus to the idle state. This instruction does not appear in the Machine Instruction Set manual. An I/O clear is performed by executing a WIOC instruction with the IMB IOCL bus command (%120000). 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | INIT +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RA = Channel and device (device is ignored) Action: M (%13)(RA LSR 3) := 0 -- clear channel mask bit in memory for Device in 0..7 loop -- clear DRT3 for each channel/device DRT DRT3 := 0 end loop IMB (INIT) if reg14 (15) = 1 then -- not GIC (ucode says bit 3 ?!?) CCG elsif reg1 (12) = 0 then -- not system controller CCG else reg6 := %000010 -- set parallel poll response reg7 := %100200 -- set PHI online (bit 0 not used, says PHI) reg6 := %000060 -- assert REN and IFC delay 100 usec reg6 := %000040 -- deny IFC reg2 := %177777 -- clear any interrupt conditions if reg1 (11) = 0 then -- PHI is not the controller reg7 := 0 -- set PHI offline CCG else -- PHI is the controller (REN asserted) CCE end if end if S := S - 1 The channel's bit in the interrupt mask word is cleared, DRT word 3 is cleared for devices 0-7 on the channel, and an INIT command is sent to the channel. If the channel is not a GIC or is not the system controller, set CCG and exit. Otherwise, initialize the channel by asserting parallel poll response, going online to HP-IB, asserting IFC and REN, waiting 100 usec, clearing IFC leaving REN asserted, and then clearing all interrupt conditions. If the channel is not the controller, set CCG and take the channel offline again. Otherwise, set CCE. The microcode seems to set CCG if INIT is not directed to a GIC (e.g., when directed to the ADCC), but the HP 300 description says CCE is the response. If the channel number is 0, a system halt with firmware error 000E will occur. For the Starfish, INIT must do a SMSK to reenable the mask FF on the GIC. If this is not done, the GIC diagnostic fails. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | MCS +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RB = Upper 8 bits of IMB memory address RA = Lower 16 bits of IMB memory address An IMB MCS cycle is performed, using the 24-bit address formed by RB and RA. The value returned on the IMB data bus is pushed onto the TOS. The two address words remain on the stack in RB and RC. The condition code is not affected. Traps: stack overflow, non-responding device. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | SEML +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RB = Upper 16 bits of memory address RA = Lower 16 bits of memory address The contents of the addressed memory location is read by a special memory operation that reads the location and replaces its contents with %177777 in one step. The original contents of the location is pushed onto the stack. CCA on RA. Carry set if pushed value is %177777. Traps: stack underflow, non-responding device. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | STRT +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RA = Channel and device A cold load from the specified device is initiated. If the load is successful, the cold load trap is taken. Otherwise, a system halt occurs. Traps: stack underflow, non-responding device. The Series 3x/4x load and dump procedures are outlined in the Machine Instruction Set Reference Manual (July 1984) pages 2-125 through 2-130. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 | 0 1 0 | 0 0 0 | 0 1 1 | 0 0 0 | 0 1 0 | DUMP +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ RA = Channel and device The Soft Dump Program is loaded from the specified device. If the load is successful, the cold load trap is taken. Otherwise, a system halt occurs. Traps: stack underflow, non-responding device. ------------------------- Channel Program Processor ------------------------- The CPP interacts with the Device Reference Table (DRT) entries for channel devices. There is a 1:1 mapping between channel/device combinations and DRT entry numbers. The DRT number = Channel * 8 + Device, and the DRT address is the entry number times four. So: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 0 | channel | device | DRT entry +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 | channel | device | 0 0 | DRT address +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ The Device Reference Table contains one four-word entry for each device. DRT entries are calculated from device 0 = address 0. For the Series II/III, the first available device number is 4, so the DRT starts at %20. For the HP-IB machines, channel 0 is reserved, so the DRT starts at %40, which corresponds to channel 1 device 0. The DRT entry layout for Starfish HP-IB peripherals is modified slightly from the Series 4x format to accommodate the Series III interrupt microcode. Specifically, words 1 and 2 are interchanged. The unused Series III word 3 is redefined to hold the channel status. The Starfish DRT entry format is: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Channel program absolute address | DRT 0 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Interrupt handler program label | DRT 1 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | CPVA absolute address | DRT 2 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | R | P | F | - - - - - - - - - | S | A | D | W | DRT 3 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: R = Channel program is running P = SIOP or HIOP instruction is pending F = Power fail recovery in progress S = Waiting for device status request A = Waiting for GIC FIFO to empty D = Waiting for DMA transfer to complete W = Waiting for PPR in WAIT instruction DRT3 is described in comments in MPE source files S23S002C, S44S033C, etc. Only one of bits 12-15 may be set at any one time, per Series 6x microcode manual [p.193]. These are examined when the channel processor is reentered after a CSRQ to determine how to handle the request. The sources of these wait bits are as follows: Bit Wait Condition Originating Instruction --- ---------------------- --------------------------------------------- 12 device status request Identify, DSJ, Read (1-byte burst) 13 GIC FIFO empty Interrupt, Read, Write, DSJ, Identify, Clear, Command HPIB 14 DMA transfer complete Read, Write, Execute DMA 15 Parallel poll response Wait The instructions waiting on bit 12 expect to be reentered when the wait is satisfied. Differentiation between initial and reentry execution is made by detecting the presence of bit 12 in the status word. The instructions for bit 13 check the "outbound FIFO empty" bit in Register 2 on entry and only wait if the FIFO still contains bytes waiting to be sent. Reentry is therefore detected automatically, based on the state of that bit. DMA completion is handled separately from DMA initiation and is differentiated by the presence of bit 14 in the status word. No reentry of the original instruction is performed. A parallel poll response in bit 15 resumes execution with the next instruction following the Wait. So reentry is not relevant. The Channel Program Variable Area (CPVA) is described in Appendix B of the 7906/20/25 Disc Verifier Manual (30070-60068 Volume 2) starting on PDF page 392. 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Channel Program Abort Code | 0 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Interrupt Code | 1 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Interrupt Code | 2 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Interrupt Code | 3 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | DMA Abort Upper Address | 4 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | DMA Abort Lower Address | 5 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ The first word is used by the CPP to store status information after I/O channel aborts. Any of the first four words may receive Interrupt instruction codes, although word 0 is recommended to be reserved for abort codes. Channel program aborts are indicated in word 0 by the following codes: Interrupt Instruction: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 1 0 0 0 | Interrupt Instruction Code | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ HIOP During Active Service: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 1 0 1 | 0 0 0 0 0 0 0 0 0 0 0 0 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ This format is used when an HIOP instruction is executed while the channel program is running free, i.e., not in the WAIT state. In this case, the HIOP instruction will return CCG to indicate that an interrupt will occur when the program finally halts. This code will accompany the interrupt. DMA Abort: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 1 1 0 | Register B Bits 0-12 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ A DMA abort stores the upper 13 bits of the DMA Status register (Register B) in bits 3-15 of CPVA word 0, and sets CPVA words 4 and 5 to the abort address. Channel Program Execution Error: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 1 1 1 | 0 | A | P | C | L | H | S | Q | M | N | T | D | I | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: A = Address rollover (non-DMA) P = Parity error detected on received bus command C = Status has changed L = Device Clear (DCL) universal command has been received H = Processor handshake aborted due to FIFO overflow/underflow S = Serial poll error Q = Illegal CSRQ M = Memory parity error N = Non-responding IMB module T = Channel hardware timeout D = Data chain error I = Invalid instruction The Series 64 CPP implements round-robin servicing of the channels. This is new for the Series 6x, as noted in the March 1982 HP Journal (page 18), and need not be implemented for the Series 4x. Also, the Series 64 translates CSRQ and IRQ signals from the IMB into CSB messages for the CPU (HPJ page 20), which set the Message Interrupt flag in the CPX1 register. The CPP consists of four basic operations: - Entry via CSRQ assertion to start or resume execution. - Execution of channel program instructions. - Exit with program suspension until CSRQ indicates resumption. - Exit with program completion, either normal or aborted. The operations are described below. CSRQ Entry [CSRQ p.225] ~~~~~~~~~~~~~~~~~~~~~~~ When CSRQ is asserted, the the microcode jumps to TCSQ [p.227] and from there to CSRQ [p.225]. This routine performs these steps: 1. Send out SPOLL to determine the channel(s) requesting service. 2. Check if channel 0 is requesting service; this is mainly for running the diagnostics with ADCC. 3. Do round-robin on the SPOLL response and the channel number last serviced. 4. Issue an OBSI to the channel to obtain the type of service request. 5. Read register 1 to determine if the channel is controller-in-charge; if not, then proceed with request diagnosis. 6. If it is controller-in-charge, then check if the OBSI response is a channel request (DMA completion); if so, then proceed with request diagnosis. 7. If the response is a device request, then enable the PHI interrupt mask by writing !7FFF to register 3. 8. Dispatch the request. The remainder of the Series 6x CSRQ code performs the round-robin servicing if multiple devices are requesting simultaneously. Action: F1 := 1 -- [CSRQ p.225] set F1 poll := IMB (SPOL2) -- get service poll response if poll = 0 then -- [CKCH p.301] exit -- [CPEX p.203] write to IMBI to enable the CSRQ/IRQ masks elsif poll(1) = 1 then -- if channel 1 (ADCC) request obsi := IMB (OBSI, 1) dispatch_request -- [PAUL p.191] end if chan := PRIORITY(poll) -- get high pri channel from poll response resp := IMB (OBSI, chan) -- get OBSI response if reg1(11) = 1 -- if controller and then resp(6) = 1 then -- and device request reg3 := %077777 -- unmask all interrupts end if dispatch_request -- [PAUL p.191] CSRQ Dispatch [PAUL p.191] ~~~~~~~~~~~~~~~~~~~~~~~~~~ After receiving the OBSI response from the channel, The cause of the CSRQ is determined by these steps: 1. If the "not valid" bit is set, then exit. 2. Read the DRT bank and offset values from absolute memory locations %10 and %11 (these might be non-zero only on Series 37/6x/7x CPUs) and determine the pointer to the DRT associated with the channel and device numbers. 3. If the "channel request" and "timeout" bits are set, then exit with error code !E004. 4. If the "channel request" and "DMA abort" bits are set, then copy the DMA upper and lower addresses from registers 8 and 9 to CPVA locations 4 and 5 and exit with an error code of !C000 plus the value in register 11 shifted right three places. 5. If neither the "channel request" nor "device request" bits are set, then exit with error code !E020 (illegal CSRQ). 6. Either a channel request or a device request is present, so dispatch on the program state. At dispatch, these registers are set up: Register Contains -------- ----------------------------------------------------------- XR13 the CPVA error code XR26 the device number XR27 the address of DRT word 0 SP2B the address of the next channel instruction, i.e., M [XR27] SP1B the channel instruction, i.e., M [SP2B] SP0A the instruction operand, i.e., M [SP2B + 1] XR3 the CPVA address, i.e., M [XR27 + 1] XR4 the channel status word, i.e., M [XR27 + 3] F1 1 (set) During instruction execution, SP2B points at the current instruction operand word. Action: chan := obsi(9..12) -- [PAUL p.191] isolate the channel number if obsi(8) = 1 then -- if not valid exit -- [CPEX p.203] F1 exit channel service end if bank := M [%10] -- DRT bank (non-zero only for Series 37/6x/7x) offs := M [%11] -- DRT offset (non-zero only for Series 37/6x/7x) drta := M [offs + obsi(9..15) * 4] -- address of DRT from channel/device F2 := M [drta + 3](13) -- set F2 if wait was for incoming data F1 := 0 -- clear F1 if obsi(7) = 1 then -- [DMCK p.192] channel request if obsi(3) = 1 then -- channel timeout error_exit (!E004) -- [CHR p.194] NF1 timeout error elsif obsi(4) = 1 then -- DMA abort error drt2 := M [drta + 2] -- CPVA pointer M [drt2 + 4] := reg8 -- save DMA upper address M [drt2 + 5] := reg9 -- and lower address in CPVA4 and 5 error_exit (!C000 or reg11 lsr 3) -- [CHR p.194] NF1 DMA abort error else -- must be DMA completion F1 := 1 -- set F1 for channel request end if elsif obsi(6) = 0 then -- neither channel nor device request error_exit (!E020) -- [CHR p.194] NF1 illegal request error else -- device request F1 := 0 -- clear F1 for device request end if dispatch_state -- [EXAM p.192] dispatch the program state Program State Dispatch [EXAM p.192] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Either a channel request (F1) or a device request (NF1) is present, so the program status in DRT3 is examined to determine how to proceed: 1. If bits 0 and 1 are 00 (program is halted), then exit with error code !E020 (illegal CSRQ). 2. If bits 0 and 1 are 01 (program is halting), then: 2a. If this is a device request, and the program is not waiting for a channel condition (DRT3 bits 12-14 are clear), then halt program execution; otherwise, exit with error code !E020 (illegal CSRQ). 2b. If this is a channel request, and the program is not waiting for a channel condition (DRT3 bits 12-14 are clear), then clean up and halt program execution. 2c. If this is a channel request, and the program is waiting for DMA completion (DRT3 bit 14 is set), then clean up DMA and halt program execution. 2d. If this is a channel request, and the program is waiting for device status or FIFO data (DRT bit 12 or 13 is set), then write the device number to Register 15, unmask all interrupts in Register 3, and fetch the next instruction, as the program cannot be halted at this point. 3. If bits 0 and 1 are 11 (program is starting), then: 3a. Set SIOP to the channel with bit 12 set to clear the CSRQ. 3b. If the channel is the CIC (Register 1 bit 11 is set), then assert REN and enable parity freeze (Register 6 bits 9 and 10 are set), and unmask the parallel poll response for the device (Register 4). 3c. Set DRT bits 0 and 1 to 10 (program is running), write the device number to Register 15, unmask all interrupts in Register 3, and fetch the next instruction. 4. If bits 0 and 1 are 10 (program is running) then: 4a. If the program is not waiting for a channel condition (DRT3 bits 12-14 are clear), then mask DRT3 to bits 0-2 and write it back, unmask all interrupts in Register 3, and fetch the next instruction. 4b. If this is a device request, and the program is waiting for a channel condition (DRT3 bit 12, 13, or 14 is set), then exit with error code !E020 (illegal CSRQ). 4c. If this is a channel request, and the program is waiting for DMA completion (DRT3 bit 14 is set), then clean up DMA and fetch the next instruction. Otherwise, write the device number to Register 15, unmask all interrupts in Register 3, and fetch the next instruction. Action: if drt3(0) = 0 then -- [EXAM p.192] if halting (0xx...xxxx) if NF1 then -- [NRUN p.193] NF1 => device request, obsi(7) = 0 if drt3(1) = 0 then -- [NRNB p.194] halted (00x...xxxx) error_exit (!E020) -- [CHR p.194] NF1 illegal request error else -- otherwise halting (01x...xxxx) F1 := 1 -- set F1 if drt3(12..14) = 000 then -- if not waiting for condition (01x..000x) halt -- [HLTP p.202] F1 else -- otherwise error_exit (!E020) -- [CHR p.194] F1 illegal request error end if end if else -- F1 => channel request F1 := 0 -- [NRUN p.193] clear F1 if drt3(1) = 0 then -- if halted (00x...xxxx) error_exit (!E020) -- [CHR p.194] NF1 illegal request error elsif drt3(12..14) = 000 then -- otherwise if halting (01x...000x) cleanup_and_halt -- [CHRA p.202] NF1 (part of INT/H) => HLTP elsif drt3(14) = 1 then -- [EXM1 p.193] if halting while waiting for DMA completion [DMAM] -- [DMAM p.213] NF1 RH := reg11 and %100 else -- halting while waiting for device status or FIFO data reg15 := device -- [AD p.193] NF1 write device number reg3 := %077777 -- [AE p.193] unmask all interrupts drt3 := drt3 and %160000 -- mask to just R/P/F bits fetch -- [FCH1 p.195] fetch next instruction end if end if elsif drt3(1) = 1 then -- else if starting (11x...xxxx) F1 := 0 -- [STRT p.194] clear F1 IMB (SIOP, device + %10) -- clear new status bit if reg1(11) = 1 then -- if controller reg6 := %000140 -- assert REN and set parity freeze reg4(device) := 1 -- unmask poll response for device end if reg15 := device -- [AD p.193] write device number reg3 := %077777 -- [AE p.193] unmask all interrupts drt3 := %100000 -- running fetch -- [FCH1 p.195] fetch next instruction else -- else running (10x...xxxx) if drt3(15) = 1 -- [0936] in wait state (10x...xxx1) or drt3(12..15) = 0000 then -- [0937] free (10x...0000) reg3 := %077777 -- [AE p.193] unmask all interrupts drt3 := drt3 and %160000 -- mask to just R/P/F bits fetch -- [FCH1 p.195] fetch next instruction elsif NF1 then -- [0937] device request, obsi(7) = 0 error_exit (!E020) -- [CHR p.194] NF1 illegal request error elsif drt3(14) = 1 then -- [EXM1 p.193] F1 waiting for DMA completion F1 := 0 -- [DMAM p.213] clear F1 reg3 := %077777 -- unmask all interrupts opcode := M [drt0] -- refetch opcode instr := (opcode lsr 8) - 3 -- move instruction opcode to lower byte and bias if instr = 11 -- if Execute DMA or instr and %12 = 0 then -- or Read/Write [Control] operand := M [drt0 + 1] -- [CGE2 p.222] NF1 get byte count -- [CGE2 p.222] part of DCH if operand = 0 then -- if the byte count is zero if opcode and %360 = 0 -- if not chained error_exit (!E002) -- [DCER p.215] NF1 then data chain error else -- [DCJP p.223] chain := opcode lsr 4 and %17 -- data chain number drt0 := drt0 + chain * 5 -- point at current chain entry operand := M [drt0 + 1] -- and get byte count if operand = 0 then -- [DCNB p.222] if the current byte count is zero error_exit (!E002) -- [DCER p.215] NF1 then data chain error else -- otherwise opcode := M [drt0] -- replace the current opcode end if end if end if chain := opcode lsr 4 and %17 -- (new) data chain number burst := M [drt0 + 2] and %377 -- get burst length if burst = 0 then -- [CGET p.222] burst of zero burst := 256 -- means burst of 256 end if flags := M [drt0 + 3] -- get flags word -- return from DCH if flags(0) = 0 -- if record mode or operand < burst then -- or last burst operand := 0 -- [DMRR p.213] then zero the byte count else -- otherwise operand := operand - burst -- drop the byte count by the burst size end if operand := operand + reg10 -- [DMR1 p.213] add any DMA residue to byte count if flags(5) = 0 then -- if not suppressing updates (U bit = 0) M [drt0 + 1] := operand -- then update byte count M [drt0 + 4] := reg9 -- update the DMA memory address if reg11(9) = 1 then -- if DMA ended with the left byte flags := flags or %40000 -- then set the R bit next else -- otherwise flags := flags and %137777 -- clear the R bit end if M [drt0 + 3] := flags -- update the flags word end if -- RDT -- nominal operation: -- if record mode and chain > 0 then keep address else unaddress -- --> if burst mode or chain = 0 then unaddress else keep address -- if record mode and (EOI or abort or chain /= 0) then keep fifos else clear fifos -- --> if burst mode or reg11(5..6) = 10 and chain = 0 then clear fifos else keep fifos -- inbound FIFO wants to be cleared for burst mode or if DMA ends for byte count or abort. -- for EOI, fifo need not be cleared, as no bytes will follow. if instr and 1 then -- [DMR2 p.213] NF1 if Read [Control] completion if flags(0) = 1 -- [RDT p.214] if burst mode or reg11(5..6) = 10 -- or record mode DMA count done and chain = 0 then -- and last or only chain F2 := 1 -- set flag 2 -- CLFF begin if reg2(14) = 1 then -- [CLFF p.204] if outbound fifo is empty reg0 := !405F -- untalk reg0 := !403F -- unlisten reg6 := %000140 -- enable parity freeze, assert REN else -- [IFC p.205] otherwise outbound FIFO has data reg6 := reg6 and %140 or %60 -- set REN, IFC wait 100 usec reg6 := reg6 xor %21 -- clear IFC, clear outbound fifo end if while reg2(13) = 1 loop -- [CLIF p.204] while inbound fifo not empty dummy := reg0 -- read and toss it end loop -- at CLFF end, XR9 = upper byte of CP instruction -- for Read [Control], XR9 is odd, so jumps to [RTCL p.215] -- which clears XR9 and jumps to RDTB because F2 is set -- RDTB is the return point from the CLFF call, so effectively CLFF was a subroutine end if -- In burst mode, end with DMA count done (10) is an error because PHI and DMA -- were both set up to end on the same count. The PHI count (01) takes -- precedence in reporting, so if end is DMA, then DMA counted more bytes -- than PHI did. if flags(0) = 1 then -- [RDTB p.214] if burst mode if reg11(5..6) = 00 then -- 00 = EOI seen drt0 := drt0 + 5 + chain * 5 -- [RDEN p.217] continue at * + 0 fetch -- and get next instruction elsif reg11(5) = 1 then -- 1X = DMA count or error error_exit (!C000 or reg11 lsr 3) -- [DMAB p.192] NF1 DMA abort error else -- 01 = PHI count done; NF2 jump via RDEN if operand /= 0 then -- if transfer is incomplete displ := 2 -- then continue at * + 2 elsif chain /= 0 then -- otherwise if chaining -- DCPU begin head := M [drt + 0] -- [DCPU p.223] then get head of chain if drt0 < head then -- if current < head of chain error_exit (!E002) -- NF1 then chain error else -- otherwise if drt0 = head then -- if current = head of chain opcode := opcode and %177417 or %20 -- then set chain field to 1 else -- otherwise opcode := M [head] + %20 -- increment chain field end if if opcode and %360 = 0 then -- if chain field overflowed error_exit (!E002) -- NF1 then chain error else -- otherwise M [head] := opcode -- rewrite chain head end if end if -- DCPU end else -- otherwise displ := SEXT8 (UPPER_BYTE (M [drt0 + 2])) -- [RDBE p.218] continue at * + TD end if drt0 := drt0 + 5 + chain * 5 + displ -- continue as directed fetch -- and get next instruction end if else -- record mode if reg11(5..6) = 00 then -- 00 = EOI seen reg0 := !405F -- [RDEN p.217] untalk reg0 := !403F -- unlisten drt0 := drt0 + 5 + chain * 5 -- continue at * + 0 fetch -- and get next instruction elsif reg11(6) = 1 then -- X1 = DMA count or abort error_exit (!C000 or reg11 lsr 3) -- [DMAB p.192] DMA abort error else if chain = 0 then -- 01 = count done, no chain displ := SEXT8 (UPPER_BYTE (M [drt0 + 2])) -- [RDBE p.218] continue at * + TD drt0 := drt0 + 5 + chain * 5 + displ -- continue as directed fetch -- and get next instruction else -- [RDT3 p.215] 01 = count done, chain -- DCPU begin head := M [drt + 0] -- [DCPU p.223] then get head of chain if drt0 < head then -- if current < head of chain error_exit (!E002) -- NF1 then chain error else -- otherwise if drt0 = head then -- if current = head of chain opcode := opcode and %177417 or %20 -- then set chain field to 1 else -- otherwise opcode := M [head] + %20 -- increment chain field end if if opcode and %360 = 0 then -- if chain field overflowed error_exit (!E002) -- NF1 then chain error else -- otherwise M [head] := opcode -- rewrite chain head end if end if -- DCPU end -- DCNB begin drt0 := drt0 + 5 -- [DCNB p.222] point at next chain entry operand := M [drt0 + 1] -- get new byte count if operand = 0 then -- if byte count zero error_exit (!E002) -- NF1 then abort with chain error else -- otherwise flags := M [drt0 + 3] -- get new flags word opcode := M [drt0] -- and the new opcode chain := opcode lsr 4 and %17 -- and data chain number [DCNB end] end if -- DCNB end -- DMON begin reg8 := flags and %377 -- [DMON p.210] DMA upper address reg9 := M [drt0 + 4] -- DMA lower address reg10 := operand -- DMA byte count drt3 := drt3 and %160000 or 2 -- set DMA wait bit dma := flags lsr 8 and %340 -- position DMA control bits if flags(4) = 1 -- no memory increment dma := dma or %400 -- set address increment disable end if reg11 := dma or %20 or device -- set control and start DMA exit -- wait for DMA completion -- DMON end end if end if -- WDT elsif instr = 0 then -- otherwise if Write [Control] completion if flags(0) = 1 then -- [WDT p.215] if burst mode then terminate burst -- WDTB begin if count = 0 and chain /= 0 then -- [WDTB p.221] if current chain is complete [DCPU] -- update data chain pointers end if if count = 0 and chain = 0 then -- [WDTB p.221] if transaction is complete drt0 := drt0 + 5 -- then move to next instruction else -- otherwise drt0 := drt0 + chain * 5 + 7 -- skip an instruction at end of chain end if reg6 := %140 -- [WUNL p.221] reset to freeze + REN (dma dir = in) reg0 := !403F -- unlisten fetch -- [CRCS p.226] -- WDTB end elsif chain = 0 -- otherwise if last or only record reg6 := %140 -- [WUNL p.221] reset to freeze + REN (dma dir = in) reg0 := !403F -- unlisten fetch -- [CRCS p.226] else -- otherwise chained record [DCPU] -- update data chain pointers [DCNB] -- point at next chain entry if chain = 0 then -- [WRXD p.212] if last chain flags := flags and %157777 -- then tag with EOI else -- otherwise flags := flags or %20000 -- do not tag with EOI end if -- WBX1 begin reg6 := reg6 and %140 or %42 -- [WBX1 p.212] freeze + REN + outbound reg3 := %100002 -- enable DMAREQ on outbound FIFO empty [DMON] -- set up DMA and execute -- WBX1 end end if end if else -- [0A3A p.213] otherwise Execute DMA completion reg6 := reg6 and %140 or 1 -- clear FIFO, retain freeze and REN if flags(3) = 1 then -- [0A3D p.214] if write if flags(0) = 1 and operand > 0 then -- if burst and count > 0 displ := 2 -- continue at * + 2 else -- otherwise record or count = 0 displ := 0 -- continue at * + 0 end if else -- [XTIN p.214] if read if reg11(5..6) = 00 then -- if EOI displ := 0 -- continue at * + 0 elsif flags(0) = 0 then -- else if record mode if reg11(6) = 1 then -- if abort (same as 5..6 = 11) error_exit (!C000 or reg11 lsr 3) -- [DMAB p.192] NF1 DMA abort error else -- 01 = count done displ := SEXT8 (UPPER_BYTE (M [drt0 + 2])) -- continue at * + TD end if elsif reg11(5..6) = 11 then -- else if burst mode abort error_exit (!C000 or reg11 lsr 3) -- [DMAB p.192] NF1 DMA abort error elsif operand > 0 then -- if count > 0 displ := 2 -- continue at * + 2 else -- 01/10 = burst mode count done displ := SEXT8 (UPPER_BYTE (M [drt0 + 2])) -- continue at * + TD end if end if drt0 := drt0 + 5 + displ -- continue as directed fetch -- and get next instruction end if else -- otherwise not R/W/X DMA F1 := 0 -- [V p.224] clear F1 M [drt + 0] := drt0 -- save the program pointer error_exit (!E001) -- NF1 invalid request for DMA completion end if else -- otherwise general wait reg15 := device -- [AD p.193] write device number reg3 := %077777 -- [AE p.193] unmask all interrupts drt3 := drt3 and %160000 -- mask to just R/P/F bits fetch -- [FCH1 p.195] fetch next instruction end if end if Program Instruction Fetch and Execute [FCH1 p.195] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Action: if powerfail then exit else opcode := M [drt0] operand := M [drt0 + 1] case opcode lsr 8 of when %00..%21 => execute instruction when others => error_exit (!E001) -- [CHR p.194] NF1 illegal request end case end if Program Suspension Exit [SUSP p.207] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This routine checks that the outbound FIFO is empty before allowing execution of the current instruction. It is called by each instruction that writes to Register 0 on the channel. First, Register 2 is read, and the parity error, status has changed, processor handshake abort, and Device Clear received bits are checked. If any are set, the routine exits with an error code. Otherwise, if the FIFO is not empty (Register 2 bit 14 is 0), then the program is suspended until it is empty. Otherwise, the routine returns to the caller to proceed with channel instruction execution. Action: if reg2 and %040301 = 0 then -- mask to parity, status, handshake aborts, DCL if reg2 and %2 = 1 then -- fifo empty return -- return to caller else -- fifo not empty reg3 := %100002 -- [SUSC p.224] unmask outbound fifo empty interrupt reg15 := %200 + device -- disable CSRQ drt3 := drt3 and %160000 or 4 -- set waiting for fifo data bit exit -- exit to wait for CSRQ end if else -- errors ecode := !E000 if reg2 and %200 then -- status error ecode := ecode or !0200 end if if reg2 and %40000 then -- parity error ecode := ecode or !0400 end if if reg2 and %1 then -- DCL error ecode := ecode or !0100 end if if reg2 and %100 then -- handshake error ecode := ecode or !0080 end if F1 := 0 -- clear flag error_exit (ecode) -- [CHR p.194] NF1 error end if Program Error Exit [CHR p.194] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Check the CPVA address. If it is less than %40, then no interrupt is generated, as that would write into the CPU reserved memory area. Action: if drt2 > %40 then -- CPVA pointer above reserved memory M [drt2 + 0] := ecode -- write error code to CPVA0 reg12 := device + %10 -- assert IRQ for device end if if F1 then -- F1 halt [HLTP] -- [HLTP p.202] else -- NF1 cleanup and halt [CHRA] -- [CHRA p.202] end if Program Halt Exits [CHRA and HLTP p.202] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When halting the channel program, two actions are performed. First, the channel and I/O Bus are cleaned up. Then the HIOP command is issued to the channel. To abort the current program cleanly: 1. Read Register B (DMA Status), mask to bits 9-11 and 13-15 (device), and write it back. 2. Set Register 3 (Interrupt Mask) to %7FFF to unmask all interrupts. 3. If the channel is not the controller-in-charge, then write to Register 6 to clear the device request bits and keep the parity freeze. 4. If the channel is the controller-in-charge, clean up the I/O bus by resetting the PHI interrupt conditions, idling all devices, and clearing the outbound and inbound FIFOs. Action [CHRA p.202]: reg15 := reg11 and %160 or device -- retain R/E/D configuration reg3 := %077777 -- unmask individual interrupts if reg1(11) = 1 then -- if is controller reg2 := %177777 -- [CHRC p.204] clear interrupt conditions if reg2(14) = 1 then -- [CLFF p.204] if fifo is empty reg0 := !405F -- untalk reg0 := !403F -- unlisten reg6 := %000140 -- enable parity freeze, assert REN else -- [IFC p.205] reg6 := reg6 and %140 or %60 -- set REN, IFC wait 100 usec reg6 := reg6 xor %21 -- clear IFC, clear outbound fifo end if while reg2(13) = 1 loop -- [CLIF p.204] while inbound fifo not empty dummy := reg0 -- read and toss it end loop reg0 := !4019 -- serial poll disable (SPD) else -- is not controller reg6 := reg6 and %100 -- reset control except parity freeze end if halt -- fall into the halt routine Action [HLTP p.202]: IMB (HIOP clear) -- clear new status bit on channel drt3 := drt3 and %020000 -- clear all but powerfail bit if reg1(11) = 1 then -- if is controller reg4(device) := 0 -- [RMW p.195] mask off PPR for device while reg2(14) = 0 loop -- [CHRS p.205] while outbound fifo not empty if timeout then -- wait a maximum of 20 usec [CHRZ p.224] reg6 := reg6 and %140 or %60 -- [IFC p.205] set REN, IFC wait 100 usec reg6 := reg6 xor %21 -- clear IFC, clear outbound fifo reg7 := 0 -- set PHI offline reg6 := %151 -- set parity freeze, REN, ppoll, clear FIFO reg7 := %200 -- set PHI online reg6 := reg6 and %140 or %60 -- [IFC p.205] set REN, IFC wait 100 usec reg6 := reg6 xor %21 -- clear IFC, clear outbound fifo reg2 := %077777 -- clear interrupt conditions exit loop end if end loop reg3 := %100240 -- [CHRX p.205] unmask status change and ppoll interrupts end if exit -- [CPEX p.203] write to IMBI to enable the CSRQ/IRQ masks Program Completion Exit [CPEX p.203] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Action: [...] -- write to IMBI to enable the CSRQ/IRQ masks next -- execute next machine instruction Channel Program Behavior after HIOP Execution ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The description of the HIOP instruction on page 2-83 of the Machine Instruction Set manual says: "If DRT3 (0:2) of that device indicates that the device channel program is starting or running, a halt I/O program [command] is sent to the channel to stop execution of that device's channel command program at the occurence of the next WAIT channel command. [...] If now the channel program is halting but not yet halted and not in a WAIT instruction, CC is set to CCG. [...] If the channel program was not [at] a wait instruction when the HIOP was issued, an interrupt request will be generated when the channel program is halted." Pages 5-50 to 5-51 (PDF pages 149-150) of the HP 300 Architecture Guide say the same thing. Assuming the channel program is running, HIOP returns CCE if the wait bit is set and CCG otherwise. As CCG implies an interrupt will occur when the program halts, execution must terminate without an interrupt in response to the CSRQ generated by the HIOP IMB command if DRT3 bit 15 (the wait bit) is set. Otherwise, an interrupt must be generated when the program eventually terminates. The description of CPVA word 0 on pages B-1 and B-2 (PDF pages 392-393) of the 7906/20/25 Disc Verifier Manual says that code %120000 is used to indicate a channel program abort due to an "HIOP during active service:" "This format is used if an HIOP instruction was previously issued while the channel program was running and not in the WAIT state. Referring to the description of the HIOP that was issued, the program simply halts without an interrupt, but if the program was being serviced, then it will not halt until the next WAIT. In this case, an interrupt will be generated when it finally halts because the HIOP instruction had returned a condition code of 'greater than,' telling the software to expect an interrupt when the channel program halts." The Series 6x microcode for the WAIT instruction (PDF page 197) shows that if bit 0 of DRT3 is zero, indicating that the program is not running, then it jumps to the CHR routine (via DCER) to abort execution with error code %120000 and to set an interrupt. However, a channel program that does not contain a WAIT instruction also can be halted by HIOP (or at least so it seems). Another peculiarity is that after an HIOP, the channel program will abort as sson as it waits for anything, e.g., for inbound FIFO data. HIOP changes DRT3 status to the halt-pending state and sends an HIOP IMB command to the GIC. This sets the New Status register bit, which in turn asserts CSRQ for a device request (not quite -- see below!). In the halt-pending state, the microcode dispatches a CSRQ device request where DRT3 bits 12-14 are non-zero by aborting execution with error code !E020 (illegal CSRQ). The path is EXAM -> NRUN -> NRNB -> CHR if DRT3[12..14] /= 0 or -> HLTP if DRT3 [12..14] = 0. The latter path terminates the channel program without generating an interrupt. The microcode dispatches a CSRQ channel request where DRT3 bits 12-14 are zero by cleaning up and halting the program; the path is EXAM -> NRUN -> CHRA. If bits 12-14 are non-zero, i.e., a channel wait was in progress, execution is resumed in the halt-pending state, presumably to wait for a more propitious time. Given the following DRT3 entry states, executing an HIOP instruction produces these actions: Entry Bits Exit Bits -- IMB -- 0,1 15 0,1 15 HIOP IRQ CCA Entry Meaning --- --- --- --- ---- --- --- ------------------------------- 00 0 00 0 N N CCE Channel is stopped 00 1 00 1 N N CCE Channel is stopped at WAIT (?) 01 0 01 0 N Y CCG Channel is halting 01 1 01 1 N N CCE Channel is halting at WAIT 10 0 01 0 Y Y CCG Channel is running 10 1 01 1 Y N CCE Channel is running at WAIT 11 0 01 1 Y N CCE Channel is starting 11 1 01 1 Y N CCE Channel is starting at WAIT (?) CSRQ entry into the channel program processor produces these actions: Request Wait Bits Wait Action IRQ Execution Path ------- --------- ------ ------ --- ---------------- Device 0000 None Halt No HLTP Device 0001 PPR Halt No HLTP Device 0010 DMA Abort Yes CHR (E020) Device 0100 FIFO Abort Yes CHR (E020) Device 1000 Status Abort Yes CHR (E020) Channel 0000 None Halt No CHRA Channel 0001 PPR Halt No CHRA Channel 0010 DMA Exec No EXM1 -> DMAM Channel 0100 FIFO Exec No EXM1 -> FCH0 Channel 1000 Status Exec No EXM1 -> FCH0 What makes all of this work is that the HIOP issued to the GIC does NOT generate CSRQ until a parallel poll is conducted. HIOP sets the selected bit in the New Status register, which feeds the 74148 octal priority encoder. But the encoder's enable, ~EI, must be asserted low before the ~GS output pulls low to assert the DEVRQ (device request) signal and thus CSRQ. ~EI is driven from the ~NSEN signal, which is the output of a 74LS51 AOI gate. It has two three-input AND gates, so to assert the ~NSEN output (thus enabling the New Status register to generate CSRQ), all three inputs of one or the other gate must be high. One gate has these inputs: I1 = ~CSRQDIS I2 = DMAINACT I3 = ~CICB This gate enables the New Status CSRQ only when the PHI is not the CIC, DMA is inactive, and the Inhibit CSRQ bit is not set in Register B. As the PHI is always the CIC, except perhaps during diagnostics, this gate has no effect on the New Status CSRQ. The other gate has these inputs (two are connected together): I1 = I2 = ATNB * EOIB * DMAINACT * CICB * ~CSRQDIS * ~DMARQPLA I3 = ~OBSIDOF This gate enables the New Status CSRQ only when the PHI is the CIC, DMA is inactive, the PHI DMA request is inactive (inbound FIFO is empty), a parallel poll is in progress, the Inhibit CSRQ bit is not set in Register B, and an OBSI command is not being executed. This gate controls the New Status register's ability to generate CSRQ in normal operation. In particular, an HIOP will NOT generate a CSRQ until a parallel poll is active. In the case of IOMAP, Identify commands do not do parallel polls, so commands issued to non-existent devices will hang until either the GIC timeout occurs, or the channel program issues an INIT. This is why CS80DIAG does not expect the !E020 channel abort that it is seeing with the current GIC implementation! ---------------------------- Channel Program Instructions ---------------------------- Hex Octal Instruction ---- ------ ------------------------ 0000 000000 Relative Jump 01xx 000400 Interrupt 020x 001000 Wait 03xx 001400 Read 04x0 002000 Write 05xx 002400 Device Specified Jump 0600 003000 Identify 07xx 003400 Read Control 08xx 004000 Write Control 09xx 004400 Clear 0A0x 005000 Read-Modify-Write 0B0x 005400 Read Register 0C0x 006000 Write Register 0D0x 006400 Command HP-IB 0E00 007000 Execute DMA 0Fxx 007400 Write Relative Immediate 10xx 010000 CRC Initialize 11xx 010400 CRC Compare DUS-III AID does not appear to provide the CRC Initialize or CRC Compare instructions. The PHI chip used on the GIC reports that it does not support CRC operations. Channel programs begin or resume execution as a result of CSRQ assertion. From the Series 6x microcode, they appear to run continuously until the program suspends to wait for some channel action, such as the outbound FIFO emptying, data arriving in the inbound FIFO, or a parallel poll response. In particular, a program containing an infinite loop, e.g., a JUMP to itself, should lock the machine, as it alternates CP instruction fetches and JUMP execution. However, the AID manual shows that the HIOP instruction will stop such a program, and that indeed does occur when tested on a Series 37. The mechanism by which this works is not clear. Relative Jump: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 0 | - - - - - - - - | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Displacement | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [ITAB p.190]: drt0 := drt0 + 2 + operand fetch The signed displacement (-32768..32767) is added to the address of the following word to determine the next instruction to fetch. Interrupt: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 0 1 | H | - - - - - | CPVA | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 | Interrupt Code | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: H = Halt / Run (1/0) Action [INTH p.201]: if opcode(8) = 1 and reg2(14) = 0 then -- if halt and outbound fifo is not empty suspend -- [SUSP p.207] exit to wait for CSRQ else cpva := opcode and %3 code := operand and %7777 M [drt2 + cpva] := code or %100000 -- store interrupt code reg12 := %000010 + device -- set interrupt if opcode(8) = 0 -- if run fetch -- fetch next instruction else -- if halt cleanup_and_halt -- [CHRA p.202] end if If the halt bit is set, the CPP stops the program and exits to execute the next machine instruction. Otherwise, the CPP fetches the next channel instruction and continues executing. The CPVA field specifies the CPVA word number in which to store the interrupt code in bits 4-15; bits 0-3 of the CPVA word will be set to 1000. Wait: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ / | 0 0 0 0 0 0 1 0 | C | I | - - - - - | S | Series III/3x | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ \ | 0 0 0 0 0 0 1 0 | C | I | - - - | S | CPVA | Series 4x/5x/6x +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 | Serial Poll Response / Interrupt Code | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: S = Wait for selected conditions C = Perform CRC comparison I = Perform CRC initialization Action [WAIT p.197]: if drt3(0) = 0 then -- program not running error_exit (!A000) -- [CHR p.194] non-run state else drt3 := drt3 and %160000 or 1 -- set wait bit if opcode(15) = 1 then -- wait for selected conditions reg15 := %200 + device -- disable CSRQ on parallel poll elsif reg1(11) = 1 then -- is CIC if reg2(14) = 1 then -- outbound fifo is empty if opcode(8) = 1 then -- perform CRC comparison crcd end if reg3 := %100240 -- unmask status change and ppoll interrupts end if end if exit -- [CPEX p.203] exit to wait for CSRQ end if This instruction causes a suspension of the channel program execution until the device again requests service, allowing the channel to start polling all of the devices. 1. If DRT3=<0x..xxxx>, JSB CHR, which means the the program is in the non-run state and terminates itself with interrupt code !A000. 2. Update the DRT3 saving DRT3(0:3), set bit 15, and save the pointer in DRT0. 3. If bit 15 of the instruction is 1, the channel will wait for whatever conditions are selected prior to the wait instruction to cause assertion of CSRQ (e.g. DMA completion or some conditions selected in register 3 of the GIC). This mode is invoked to facilitate operating the channel as an HP-IB device. This is accomplished by writing register F := !0080 + device number of the current channel program. 4. If bit 15 is 0, and if it is not controller-in-charge, same as #3 above, except that no change in register F. 5. If bit 15 is 0, and is controller-in-charge, then the channel will be set to issue CSRQ when parallel poll, SRQ, SIOP, or HIOP device request occurs or if an HP-IB status change occurs on the channel controller, register 3 := !80A0. This will happen provided bit 8 of the 1st instruction is 0 and the outbound FIFO is idle. If not, bits 8 and 9 of the instruction may be used to perform CRC initialization and comparison. 6. After all these, wait about 2 usec to allow prior CSRQ to deny before exiting. Read: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 0 1 1 | Data Chain | Modifier | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Byte Count / Residue Count | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Termination Displacement | Burst Length | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | B | R | L | - | N | U | - - | Extended Memory Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Memory Address / Residue Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: B = Record / Burst mode (0/1) R = Start with Left / Right byte (0/1) L = Terminate on LF (Read) N = No memory address increment U = Do not update instruction words after execution Action [READ p.216]: -- DCH begin M [drt + 0] := drt0 -- [DCH p.222] save current instr pointer if reg2(14) = 0 then -- if outbound fifo is not empty suspend -- [SUSP p.207] exit to wait for CSRQ else -- fifo is empty if operand = 0 then -- if the byte count is zero if opcode and %360 = 0 then -- if not chained error_exit (!E002) -- then data chain error else -- [DCJP p.223] chain := opcode lsr 4 and %17 -- data chain number drt0 := drt0 + chain * 5 -- point at current chain entry operand := M [drt0 + 1] -- and get byte count if operand = 0 then -- if the current byte count is zero error_exit (!E002) -- then data chain error else -- otherwise opcode := M [drt0] -- replace the current opcode end if end if end if chain := opcode lsr 4 and %17 -- (new) data chain number burst := M [drt0 + 2] and %377 -- get burst length if burst = 0 then -- [CGET p.222] burst of zero burst := 256 -- means burst of 256 end if flags := M [drt0 + 3] -- get flags word -- DCH end if reg2(13) = 0 then -- if inbound fifo is empty reg0 := !403E -- [TLK1 p.198] listen 30 reg0 := !4040 + device -- talk reg0 := !4060 + (opcode and %17) -- secondary if flags(0) = 1 and burst = 1 then -- if single-byte burst if flags(2) = 1 then -- then if end on LF reg0 := %000001 -- then skip LF suppression else -- otherwise reg0 := %140001 - request LF suppression end if suspend -- [SUSB p.224] wait for inbound data else if flags(0) = 0 then -- if record mode reg0 := %140000 -- [RRE1 p.210] set for uncounted read else if burst < operand then -- [DMA p.211] if a full burst remains operand := burst -- then use the burst count for xfer end if if flags(2) = 1 then -- if terminate on LF reg0 := operand -- then set read count else -- otherwise reg0 := %100000 or operand -- set count with ignore LF flag end if end if -- DMON begin reg8 := flags and %377 -- [DMON p.210] DMA upper address reg9 := M [drt0 + 4] -- DMA lower address reg10 := operand -- DMA byte count drt3 := drt3 and %160000 or 2 -- set DMA wait bit dma := flags lsr 8 and %340 -- position DMA control bits if flags(4) = 1 then -- no memory increment dma := dma or %400 -- set address increment disable end if reg11 := dma or %20 or device -- set control and start DMA exit -- wait for DMA completion -- DMON end end if else -- inbound data is available for single-byte burst byte := reg0 -- get the byte from the device bank := flags and & %377 -- upper address offs := M [drt0 + 4] -- lower address data := M [bank, offs] -- get data word if flags(1) = 1 then -- if R bit is set data := REPLACE_LOWER (data, byte) -- then store to the right byte else -- otherwise data := REPLACE_UPPER (data, byte) -- store to the left byte end if M [bank, offs] := data -- replace the word operand := operand - 1 -- [BYRS p.223] decrement the byte count if flags(5) = 0 then -- if not suppressing updates (U = 0) M [drt0 + 1] := operand -- then write back the decremented count flags := flags xor %20000 -- flip the L/R bit M [drt0 + 3] := flags -- and write the flags word back if flags(1) = 0 then -- if just did right byte M [drt0 + 4] := M [drt0 + 4] + 1 -- then increment the memory address end if if M [drt0 + 4] = 0 then -- if memory rolled over error_exit (!E800) -- then exit with a memory error end if end if reg0 := !405F -- untalk reg0 := !403F -- unlisten if count = 0 and chain /= 0 then -- [RDE1 p.217] if current chain is complete -- DCPU begin head := M [drt + 0] -- [DCPU p.223] then get head of chain if drt0 < head then -- if current < head of chain error_exit (!E002) -- then chain error else -- otherwise if drt0 = head then -- if current = head of chain opcode := opcode and %177417 or %20 -- then set chain field to 1 else -- otherwise opcode := M [head] + %20 -- increment chain field end if if opcode and %360 = 0 then -- if chain field overflowed error_exit (!E002) -- then chain error else -- otherwise M [head] := opcode -- rewrite chain head end if end if -- DCPU end end if if byte(1) = 1 then -- [RDEN p.217] if EOI -- if flags(0) = 0 then -- if record mode [not for singe-byte burst!] -- reg0 := !405F -- untalk -- reg0 := !403F -- unlisten -- end if displ := 0 -- continue at * + 0 elsif count = 0 and chain = 0 then -- [RDBE p.218] otherwise if transaction complete displ := SEXT8 (UPPER_BYTE (M [drt0 + 2])) -- then continue at * + TD else -- otherwise burst complete displ := 2 -- continue at * + 2 end if drt0 := drt0 + 5 + chain * 5 + displ -- continue as directed fetch -- and get next instruction end if end if The Modifier is sent as a secondary address in the range 00-0F after the device is addressed with the Talk command. Transfers can be made in Record Mode or Burst Mode. Record Mode sets up a transfer for the full Byte Count. Burst Mode transfers a count of bytes corresponding to the smaller of the Burst Length and the Byte Count; a Burst Length of zero is interpreted as a 256-byte burst. Burst Mode generally requires multiple executions to transfer the full Byte Count, and the device is unaddressed between bursts to free the bus. Read transactions always terminate if a byte tagged with EOI is received. Setting the L bit also terminates a transaction if a line feed byte is received. DMA is used for all transfers except Burst Mode with Burst Length = 1. The N bit determines whether all transfers are made to the same address, or whether the address is incremented after each word is transferred. Unless the U (no update) bit is set in the instruction, the byte count in the second word, the R (left/right) bit in word 4, and the memory address in word 5 are updated and written back into the instruction after each transfer. The Data Chain field is used for data chaining. If the field in the initial instruction is zero, then the Byte Count specifies the entire transfer length. If the field is a non-zero value N, then the instruction is the first of N-1 consecutive instructions that collectively form a single bus transaction, with each succeeding instruction's field indicating the number of remaining fields that follow. This allows subsets of the full transfer length to be written to different memory addresses. Chained Record Mode transfers are performed consecutively as a single bus transaction. DMA completion of the current chained transfer is immediately followed by the initiation of the next chained transfer. The device is addressed at the start of the chained sequence and unaddressed at the end of the sequence. Receipt of a byte tagged with EOI terminates the entire transaction, regardless of where in the chained sequence it occurs. Chained Burst Mode transfers perform one burst per execution, and the device is addressed only for the duration of the burst. Receipt of a byte tagged with EOI during a burst skips any remaining chained instructions and terminates the transaction. Otherwise, after the current burst is transferred, and regardless of whether that transfer exhausts the Byte Count for the current intermediate chain entry, any remaining chained instructions in the sequence are skipped, and channel program execution resumes after the final chained entry. The sequence must be executed in a loop to perform the entire transaction. As each chained entry's Byte Count is exhausted, bursts continue with the succeeding entry. The transaction concludes when the final chain entry's Byte Count is exhausted or when EOI is received. Execution of an instruction or chained instruction sequence ends with control transferring to one of three locations. If the transaction ends with receipt of a data byte tagged with EOI, then execution continues with the next instruction following the sequence. If a Burst Mode transfer ends with a remaining Byte Count, then the next two-word instruction is skipped, and execution continues with the following instruction. If the transaction ends with Byte Count exhaustion, then the signed Termination Displacement (-128..127) is added to the address of the next instruction to determine where execution continues. In tabular form, where * represents the first location following the instruction or instruction sequence: Location Reason for Read Termination -------- ----------------------------------------- * + 0 End of transaction on EOI receipt * + 2 End of burst transfer but not transaction * + TD End of transaction on Byte Count An end-of-burst exit is typically followed by a WAIT for a poll response, a DSJ to confirm success of the transfer, and then a JUMP back to the start of the instruction sequence. The loop continues until the end-of-transaction exit occurs. Write: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 1 0 0 | Data Chain | Modifier | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Byte Count / Residue Count | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - - - - - | Burst Length | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | B | R | E | - | N | U | - - | Extended Memory Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Memory Address / Residue Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: B = Record / Burst mode (0/1) R = Start with Left / Right byte (0/1) E = Do not tag last byte of burst with EOI N = No memory address increment U = Do not update instruction words after execution Action [WRIT p.219]: M [drt + 0] := drt0 -- [DCH p.222] save current instr pointer if reg2(14) = 0 then -- if outbound fifo is not empty suspend -- [SUSP p.207] exit to wait for CSRQ else -- fifo is empty if operand = 0 then -- if the byte count is zero if opcode and %360 = 0 then -- if not chained error_exit (!E002) -- then data chain error else -- [DCJP p.223] chain := opcode lsr 4 and %17 -- data chain number drt0 := drt0 + chain * 5 -- point at current chain entry operand := M [drt0 + 1] -- and get byte count if operand = 0 then -- if the current byte count is zero error_exit (!E002) -- then data chain error else -- otherwise opcode := M [drt0] -- replace the current opcode end if end if end if chain := opcode lsr 4 and %17 -- (new) data chain number burst := M [drt0 + 2] and %377 -- get burst length if burst = 0 then -- [CGET p.222] burst of zero burst := 256 -- means burst of 256 end if flags := M [drt0 + 3] -- get flags word -- DCH returns with: -- XR0 = SP0A = byte count -- XR1 = burst count -- XR2 = address of byte count in next instruction -- SP1B = flags word reg0 := !405E -- [TLK1 p.198] talk 30 reg0 := !4020 + device -- listen reg0 := !4060 + (opcode and %17) -- secondary -- set up the EOI condition -- -- if DC = 0 and (record mode or byte count <= burst count) -- then EOI -- else if DC /= 0 and record mode -- then no EOI -- else -- if byte count > burst count or DC /= 0 -- then EOI = E bit if chain = 0 -- [WRXD p.212] if last or only chain and (flags(0) = 0 -- and record mode or operand <= burst) then -- or final burst of burst mode flags := flags and %157777 -- then tag with EOI elsif chain /= 0 -- otherwise if not last chain and flags(0) = 0 then -- and record mode flags := flags or %20000 -- then do not tag with EOI end if -- otherwise tag unless E bit is set if flags(0) = 1 and burst = 1 then -- [0A82 p.220] if single-byte burst bank := flags and & %377 -- upper address offs := M [drt0 + 4] -- lower address data := M [bank, offs] -- get data word if flags(1) = 1 then -- if R bit is set data := LOWER_BYTE (data) -- [0A84] then use the right byte else -- otherwise data := UPPER_BYTE (data) -- [0A85] use the left byte end if if flags(2) = 0 -- [0A85] if E bit = 0 or byte count = 1 -- [0A87] or is the last byte and data chain = 0 then -- of the transaction reg0 := !8000 + data -- [0A88] then output byte + EOI else -- otherwise reg0 := data -- output byte without EOI end if operand := operand - 1 -- [BYRS p.223] decrement the byte count if flags(5) = 0 then -- if not suppressing updates (U = 0) M [drt0 + 1] := operand -- then write back the decremented count flags := flags xor %20000 -- flip the L/R bit M [drt0 + 3] := flags -- and write the flags word back if flags(1) = 0 then -- if just did right byte M [drt0 + 4] := M [drt0 + 4] + 1 -- then increment the memory address end if if M [drt0 + 4] = 0 then -- if memory rolled over error_exit (!E800) -- then exit with a memory error end if end if -- WDTB begin if count = 0 and chain /= 0 then -- [WDTB p.221] if current chain is complete -- DCPU begin head := M [drt + 0] -- [DCPU p.223] then get head of chain if drt0 < head then -- if current < head of chain error_exit (!E002) -- then chain error else -- otherwise if drt0 = head then -- if current = head of chain opcode := opcode and %177417 or %20 -- then set chain field to 1 else -- otherwise opcode := M [head] + %20 -- increment chain field end if if opcode and %360 = 0 then -- if chain field overflowed error_exit (!E002) -- then chain error else -- otherwise M [head] := opcode -- rewrite chain head end if end if -- DCPU end end if if count = 0 and chain = 0 then -- [WDTB p.221] if transaction is complete drt0 := drt0 + 5 -- then move to next instruction else -- otherwise drt0 := drt0 + chain * 5 + 7 -- skip an instruction at end of chain end if reg6 := %140 -- [WUNL p.221] reset to freeze + REN (dma dir = in) reg0 := !403F -- unlisten fetch -- [CRCS p.226] -- WDTB end else -- otherwise record mode or multibyte burst mode if flags(0) = 1 -- [DMA p.211] if burst mode and burst < operand then -- and burst count is smaller than byte count operand := burst -- then use the burst count for xfer end if -- WBX1 begin reg6 := reg6 and %140 or %42 -- [WRXD p.212] -> [WBX1 p.212] freeze + REN + outbound reg3 := %100002 -- enable DMAREQ on outbound FIFO empty -- DMON begin reg8 := flags and %377 -- [DMON p.210] DMA upper address reg9 := M [drt0 + 4] -- DMA lower address reg10 := operand -- DMA byte count drt3 := drt3 and %160000 or 2 -- set DMA wait bit dma := flags lsr 8 and %340 -- position DMA control bits if flags(4) = 1 then -- no memory increment dma := dma or %400 -- set address increment disable end if reg11 := dma or %20 or device -- set control and start DMA exit -- wait for DMA completion -- DMON end -- WBX1 end end if end if The Modifier is sent as a secondary address in the range 00-0F after the device is addressed with the Listen command. Transfers can be made in Record Mode or Burst Mode. Record Mode sets up a transfer for the full Byte Count. Burst Mode transfers a count of bytes corresponding to the smaller of the Burst Length and the Byte Count; a Burst Length of zero is interpreted as a length of 256 bytes. Burst Mode generally requires multiple executions to transfer the full Byte Count, and the device is unaddressed between bursts to free the bus. The E (EOI) bit is ignored for Record Mode transfers; the final byte is always tagged with EOI. For Burst Mode transfers, the E bit specifies whether the final byte of each intermediate burst is tagged with EOI. Regardless of the E bit, the final byte of the final burst is always tagged. DMA is used for all transfers except Burst Mode with Burst Length = 1. For the latter, E = 0 tags the byte with EOI, whereas E = 1 tags the byte with EOI only if it is the last byte of the transaction (i.e., Byte Count = 0). The N bit determines whether all transfers are made from the same address, or whether the address is incremented after each word is transferred. Unless the U (no update) bit is set in the instruction, the byte count in the second word, the R (left/right) bit in word 4, and the memory address in word 5 are updated and written back into the instruction after each transfer. The Data Chain field is used for data chaining. If the field in the initial instruction is zero, then the Byte Count specifies the entire transfer length. If the field is a non-zero value N, then the instruction is the first of N-1 consecutive instructions that collectively form a single bus transaction, with each succeeding instruction's field indicating the number of remaining fields that follow. This allows subsets of the full transfer length to originate from different memory addresses. Chained Record Mode transfers are performed consecutively as a single bus transaction. DMA completion of the current chained transfer is immediately followed by the initiation of the next chained transfer. The device is addressed at the start of the chained sequence and unaddressed at the end of the sequence. EOI tags the final byte of the final transfer. After all transfers in the chained instruction sequence are made, channel program execution continues with the next instruction following the sequence. Chained Burst Mode transfers perform one burst per execution, and the device is addressed only for the duration of the burst. After the current burst is transferred, and regardless of whether that transfer exhausts the Byte Count for the current intermediate chain entry. any remaining chained instructions in the sequence are skipped, and channel program execution resumes after the final chained entry. The sequence must be executed in a loop to perform the entire transaction. As each chained entry's Byte Count is exhausted, bursts continue with the succeeding entry. The transaction concludes only when the final chain entry's Byte Count is exhausted. Execution of a Burst Mode instruction or chained instruction sequence ends with control transferring to one of two locations. If the transaction ends with Byte Count exhaustion, then execution continues with the next instruction following the sequence. If the transfer ends with a remaining Byte Count, then the next two-word instruction is skipped, and execution continues with the following instruction. In tabular form, where * represents the first location following the instruction or instruction sequence: Location Reason for Write Termination -------- ----------------------------------------- * + 0 End of transaction * + 2 End of burst transfer but not transaction An end-of-burst exit is typically followed by a WAIT for a poll response, a DSJ to confirm success of the transfer, and then a JUMP back to the start of the instruction sequence. The loop continues until the end-of-transaction exit occurs. Device Specified Jump: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 1 0 1 | Maximum Response (N) | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - - - - - | Returned Byte | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Relative Displacement for Byte 0 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Relative Displacement for Byte 1 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | ... | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Relative Displacement for Byte N | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [DSRJ p.200]: if reg2(14) = 0 then -- outbound fifo is not empty suspend -- exit to wait for CSRQ else if reg2(13) = 0 -- inbound fifo is empty reg0 := !403E -- listen 30 reg0 := !4040 + device -- talk reg0 := !4070 -- secondary 10 reg0 := !C001 -- remove ATN, receive 1 byte suspend -- [SUSB p.224] wait for inbound data else -- inbound FIFO has data dsj := reg0 and %377 -- get DSJ byte M [DRT0 + 1] = dsj -- write to memory reg0 := !405F -- untalk reg0 := !403F -- unlisten max := M [DRT0] and %377 -- maximum response if dsj > max then -- beyond end of table DRT0 := DRT0 + max + 3 -- point at next instruction else DRT0 := DRT0 + max + 3 + M [DRT0 + 2 + dsj] -- point at DSJ target end if fetch end if This instruction has a variable number of words. If the DSJ byte returned from the device is greater than the number of displacement entries, the instruction following this one is executed. Otherwise, the signed displacement (-32768..32767) corresponding to the DSJ value is added to the address of the word following this instruction to determine the next instruction to fetch. The upper byte of the operand word is set to zero by the microcode when the lower byte is written. Note also that the microcode appears to assume that the byte is returned immediately, as it does not suspend to wait for the inbound FIFO to fill. This will not work with our Amigo and CS/80 implementations, which insert a controller delay between command reception and byte return. Identify: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 1 1 0 | - - - - - - - - | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | First Returned Byte | Second Returned Byte | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [IDY p.198]: if reg2(14) = 0 then -- outbound fifo is not empty suspend -- exit to wait for CSRQ elsif reg2(13) = 0 then -- inbound fifo is empty reg0 := !403E -- listen 30 reg0 := !405F -- untalk reg0 := !4060 + device -- secondary address reg0 := !C002 -- remove ATN, receive 2 bytes reg3 := %100004 -- [SUSB p.224] SF2 unmask inbound data interrupt reg15 := %200 + device -- disable CSRQ drt3 := drt3 and %160000 or 8 -- set waiting for inbound data bit exit -- [CPEX p.203] exit to wait for CSRQ else -- inbound fifo contains data id := reg0 lsl 8 -- read first byte id := id or reg0 -- read second byte M [DRT0 + 1] = id -- write id to memory reg0 := !405E -- talk 30 reg0 := !403F -- unlisten fetch end if NOTE: The microcode appears to be in error. The Identify command should call SUSB routine with F2 set (to wait for incoming data) and not F2 clear (to wait for the outbound FIFO to empty). The above sequence has been corrected. The DUS-III IOMAP program recognizes these ID codes: Hex Device ---- ---------------------------------------------------- 0002 HP 12745 HP-IB Adapter for the 13037 Disc Controller 0081 HP 7902 or 9895 Flexible Disc Drive 0176 HP 7976 Magnetic Tape Unit 2004 HP 2680 Page Printer 6000 GIC as a connected device Additional codes recognized by the Series 4x IOMAP: Hex Device ---- ---------------------------------------------------- 0174 HP 7974 Magnetic Tape Unit 0183 HP 7970E Magnetic Tape Controller 4080 ADCC Read Control: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 0 1 1 1 | Data Chain | Modifier | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Byte Count / Residue Count | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Termination Displacement | Burst Length | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | B | R | L | - | N | U | - - | Extended Memory Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Memory Address / Residue Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: B = Record / Burst mode (0/1) R = Start with Left / Right byte (0/1) L = Terminate on LF (Read) N = No memory address increment U = Do not update instruction words after execution Action [READ p.216]: same as the Read instruction The Modifier is sent as a secondary address in the range 10-1F after the device is addressed with the Talk command. Otherwise, this command is identical in operation to the Read command. Write Control: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 0 0 0 | Data Chain | Modifier | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Byte Count / Residue Count | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - - - - - | Burst Length | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | B | R | E | - | N | U | - - | Extended Memory Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Memory Address / Residue Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: B = Record / Burst mode (0/1) R = Start with Left / Right byte (0/1) E = Do not tag last byte with EOI N = No memory address increment U = Do not update instruction words after execution Action [WRIT p.219]: same as the Write instruction The Modifier is sent as a secondary address in the range 10-1F after the device is addressed with the Listen command. Otherwise, this command is identical in operation to the Write command. Clear: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 0 0 1 | Control Byte | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - - - - - - - - - - - - - | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [CLER p.199]: if reg2(14) = 0 then -- outbound fifo is not empty suspend -- exit to wait for CSRQ else reg0 := !405E -- talk 30 reg0 := !4020 + device -- listen reg0 := !4070 -- Amigo Clear reg0 := !8000 + control byte -- control byte + EOI reg0 := !4004 -- Selected Device Clear reg0 := !403F -- unlisten fetch end if Sends an Amigo Clear sequence to the channel. Read-Modify-Write: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 0 1 0 | - - - - | Register | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - - - - - - - - | S | Bit Number | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: S = Set/Clear bit (1/0) Action [RMW p.195]: An I/O Read command is issued for the register contained in bits 12-15 of the opcode word. The bit specified by bits 12-15 of the operand word is set or cleared as directed by bit 11 of the operand. An I/O Write command is then issued to write the updated register value back. Read Register: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 0 1 1 | - - - - | Register | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Returned Word | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [RRG p.195]: An I/O Read command is issued for the register contained in bits 12-15 of the opcode word. The value returned is stored in the operand word. Write Register: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 1 0 0 | - - - - | Register | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Supplied Word | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [Inline 090C]: An I/O Write command is issued for the register contained in bits 12-15 of the opcode word. The value to write is presented on the data bus. Command HP-IB: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 1 0 1 | - - - - - | Count | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Command 1 | Command 2 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Command 3 | Command 4 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Command 5 | Command 6 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Command 7 | Command 8 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: Count = Count of commands (0 = eight commands) Action [CMD p.196]: If the outbound FIFO is not empty, then suspend. Otherwise, do an I/O Write to register 0 for each byte specified by the count, with bits 0-1 set to 01 to have the PHI assert ATN with each byte. Execute DMA: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 1 1 0 | - - - - - - - - | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Byte Count / Residue Count | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Termination Displacement | Burst Length | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | B | R | T | D | N | U | - - | Extended Memory Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Memory Address / Residue Address | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: B = Record / Burst mode (0/1) R = Start with Left / Right byte (0/1) T = Terminate on LF (Read) / Do not tag EOI (Write) D = DMA direction (0/1 = inbound/outbound) N = No memory address increment U = Do not update instruction words after execution Action [XDMA p.211]: burst := M [drt0 + 2] and %377 -- get burst length if burst = 0 then -- burst of zero burst := 256 -- means burst of 256 end if count := M [drt0 + 1] -- get byte count if count = 0 then -- if the byte count is zero error_exit (!E002) -- then data chain error end if if flags(0) = 1 -- [DMA p.211] if burst mode and burst < count then -- and burst count is smaller than byte count count := burst -- then use the burst count for xfer end if if flags(3) = 0 then -- if read if flags(0) = 0 then -- if record mode if reg1(11) = 1 then -- [RREC p.210] if controller reg0 := %160000 -- then receive uncounted end if else if reg1(11) = 1 then -- if controller if flags(2) = 1 then -- if terminate on LF reg0 := count -- then set read count else -- otherwise reg0 := %100000 or count -- set count with ignore LF flag end if end if end if flags := flags and %044377 -- mask to just R and N bits else -- [WBXD p.212] write if flags(0) = 0 then -- if record mode flags := flags and %054377 -- mask to just R, D, and N bits else -- burst mode flags := flags and %074377 -- mask to just R, T, D, and N bits end if reg6 := reg6 and %140 or %42 -- [WBX1 p.212] mask to parity and REN, set REN and outbound reg3 := %100002 -- PHI interrupt on FIFO empty end if -- DMON begin reg8 := flags and %377 -- [DMON p.210] DMA upper address reg9 := M [drt0 + 4] -- DMA lower address reg10 := count -- DMA byte count drt3 := drt3 and %160000 or 2 -- set DMA wait bit dma := flags lsr 8 and %340 -- position DMA control bits if flags(4) = 1 then -- no memory increment dma := dma or %400 -- set address increment disable end if reg11 := dma or %20 or device -- set control and start DMA exit -- wait for DMA completion -- DMON end This command is identical to the Read and Write commands, except that data chaining is not supported, and no HP-IB commands (such as Talk and Listen) are sent. This command is used by diagnostics to send and receive "bare" data when verifying bus transmission between two GICs. A burst-mode read can end either on the burst count or additionally on reception of a line feed (if the T bit is set). A record-mode read terminates only on EOI; the T bit is ignored [says the microcode]. Execution of a DMA Read instruction ends with control transferring to one of three locations. If the transaction ends with receipt of a data byte tagged with EOI, then execution continues with the next instruction following the sequence. If a Burst Mode transfer ends with a remaining Byte Count, then the next two-word instruction is skipped, and execution continues with the following instruction. If the transaction ends with Byte Count exhaustion, then the signed Termination Displacement (-128..127) is added to the address of the next instruction to determine where execution continues. Execution of DMA Write instruction ends with control transferring to one of two locations. If the transaction ends with Byte Count exhaustion, then execution continues with the next instruction following the sequence. If the transfer ends with a remaining Byte Count, then the next two-word instruction is skipped, and execution continues with the following instruction. In tabular form, where * represents the first location following the instruction: Location Reason for Read Termination -------- ----------------------------------------- * + 0 End of transaction on EOI receipt * + 2 End of burst transfer but not transaction * + TD End of transaction on Byte Count Location Reason for Write Termination -------- ----------------------------------------- * + 0 End of transaction * + 2 End of burst transfer but not transaction Write Relative Immediate: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 0 1 1 1 1 | Displacement | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | Data | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [WRIM p.210]: The signed displacement (-128..127) is added to the address of the following word to determine the location to which the operand word is written. CRC Initialize: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 1 0 0 0 0 | - - - - - - - - | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - - - - - - - - - - - - - | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Action [CRCI p.208]: This command tests whether the channel has CRC capability by reading register 7 and seeing if bit 0 = 1. If not, the instruction is a NOP. The PHI does not have CRC capability; the ABI does. CRC Compare: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | 0 0 0 1 0 0 0 1 | H | I | - - - - | CPVA | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | - - - - | Interrupt Code | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ Where: H = Halt / Run (1/0) I = Interrupt on CRC match Action [CRCC p.209]: This command tests whether the channel has CRC capability by reading register 7 and seeing if bit 0 = 1. If not, the instruction is a NOP. The PHI does not have CRC capability; the ABI does. ====================== CST Expansion Firmware ====================== References: - Communicator/3000 Volume 2 Issue 1, 5955-1770, July 1984. - MPE V Tables Manual, MPE V/E (VUF G.08.00), MPE V Release 23, pages 11-14 (32033-90147 October 1991) - Series 64/68/70 Computer Systems Microcode Manual, pages 36-37 (30140-90045 October 1986) - Architectural Changes for MPE V/E, HP 3000 IUG Proceedings, pp. 1030-1054 (October 1983) The CST expansion firmware that was released with MPE V/E made two changes in the opertion of the instruction set. First, interpretation of the code segment number in the status register and affected instructions is now split into physically and logically mapped values. Second, pointers in the system global (SYSGLOB) table that accessed via the LST and SST instructions now include a bank number as well as an offset. The new microcode stores a 1 at QI-9 just before setting up the cold load trap to differentiate itself from the old microcode. QI is contained in absolute memory location 5. The new code segment interpretation affects the PCAL, EXIT, IXIT, SCAL, LLBL, PARC (COBOL), XBR (COBOL), ENDP (COBOL), LRA/PCAL 0 (BASIC), and the interrupt handler. The SYSGLOB pointer change affects the LST and SST instructions. -------------------- Code Segment Numbers -------------------- The CPU Status Register has an eight-bit field to indicate the currently executing code segment number. This number is used to reference the four-word CST entry that describes the segment. Entries reside in one of two tables: the CST (Code Segment Table) and the CSTX (Code Segment Table Extension). The actual CST and CSTX areas are contiguous and reside in a data segment. The CST holds permanent entries for MPE and system SL segments, and dynamic entries for user SL segments. The CSTX holds entries for user program segments; each executing program has its own set of CSTX entries. Translation of the code segment number to the table entry changes with the advent of the new MPE V/E firmware. During cold load, the new firmware sets bit 15 of the ninth word preceding the word pointed to by absolute address 5. This bit is subsequently transferred to the word at absolute location %1220 by INITIAL. The old firmware correlates the segment number to a CST entry as follows: - The lower eight bits of the external label give the segment number. - If the number is between 1 and 191, it is the index into the table pointed to by absolute address 0. - If the number is between 193 and 255, it is the index into the table pointed to by absolute address 1. - If the number is 0 or 192, a CST violation occurs (these are the header elements). - If the index is greater than the number of table entries in element 0 or 192, then a CST violation occurs. The new firmware correlates the segment number to a CST entry as follows: - The lower eight bits of the external label give the segment number. If the number is 0, a CST violation occurs. - Bit 0 of the external label indicate whether the CST entry is mapped (0, "logical") or unmapped (1, "physical"). - If the entry is unmapped, then the segment number is the index into the table pointed to by absolute address 0. If the number is greater than the number of table entries shown in element 0, a CST violation occurs. - If the entry is mapped and the segment number is less than or equal to the number of code segments in the current program given in absolute address %1223, then it is the index into the table pointed to by absolute address 1. - If the entry is mapped and the segment number is greater than the number of code segments in the current program given in absolute address %1223, then it is the index into the Logical Segment Transfer Table (LSTT) pointed to by absolute address %1221 (bank) and %1222 (offset). If the LSTT pointer is NULL, a CST violation occurs. Otherwise, word 0 of the selected element gives the CST index, and word 1 points to the STT to use for the segment or is zero to indicate that the STT in the segment is used. The new firmware keeps track of the current segment's mapping status in register XR12, which is set to %40000 if the segment is unmapped (physical) or 0 if the segment is mapped (logical). XR12 is initialized to %40000 at cold-load time, as INITIAL is unmapped. It is set from the external program label during a PCAL and reset from the stack marker during an EXIT or IXIT. The value is used to set the mapping flag in the stack marker during a PCAL or interrupt. ----- The CST holds entries for MPE segments, system SL segments, and user/group SL segments, and is shared among all processes. MPE segments and system SL segments identified as permanently allocated are assigned static CST entries by INITIAL. System and user/group SL segments that are referenced by running programs are allocated CST entries dynamically. Without MPE V/E mapping firmware, this table is always 192 entries in size. With mapping firmware, this table can be as large as 2048 entries, with the first 192 entries reserved for MPE segments. For the latter, the first 255 entries are in the "physical domain" CST, and the remainder are in the "logical domain" CST. The CSTX holds sets of entries for all loaded programs, with one set for the code segments of each program. This table can be as large as 8191 entries. Without mapping firmware, each set can be as large as 63 entries. With mapping firmware, each set can be as large as 255 entries. The entries are all assigned dynamically when programs are loaded or :ALLOCATEd. ---------------- SYSGLOB Pointers ---------------- With old firmware, SYSGLOB pointers indicate the 16-bit offset in bank 0 of the start of the specified table. With new firmware, the pointer is divided into an 11-bit offset and a 5-bit bank number. The offset is multiplied by 32 to get the word offset of the table within the indicated bank (multiplying by 32 is the same as masking the bank number bits to zero). --------------------- Modified Instructions --------------------- The following instructions are modifed for the CST expansion firmware, based on the "CSTX" indicator in the 6x microcode: - [INT8 p.19] Non-ICS interrupt entry - [PSHL p.21] Trap entry - [INT9 p.27] ICS interrupt entry - [PCL3 p.36] Code segment setup for PCAL - [LLBL p.38] LLBL instruction - [EXIT p.40] EXIT instruction - [EXI8 p.42] Code segment setup for EXIT - [IXT7 p.46] IXIT path - [SCAL p.51] SCAL instruction - [LAP p.55] LRA instruction - [LAIP p.55] LRA instruction - [CLFN p.64] cold load setup - [LST p.262] LST instruction - [SST p.263] SST instruction - [PARC p.312] PARC instruction - [XBR p.313] ENDP and XBR instructions - [CSEG p.315] CST extension changes for PARC, ENDP, and XBR instructions Most of the changes are in support of code segment mapping. The LRA changes involve detecting PCAL 0 in the NIR and executing it as though the TOS contains a local label (the local label case is removed for PCAL 0 executing directly). The LST and SST changes allow the SYSGLOB pointers to reference tables in memory banks other than bank 0. In addition, a new physical/logical flag is added that keeps track of the current segment's mapping status. This is needed to be able to interpret the code segment number in the stack marker when returning to another segment. ---------------- PCAL Instruction ---------------- In addition to working with the new code segment number interpretation, PCAL is changed to remove the internal label case for PCAL 0; the label is now always external. However, the PCAL microcode can be called from the LRA microcode with F1 set to indicate that the label on the TOS is to be interpreted as internal; this is to provide compatibility with the BASIC compiler, which uses the LRA/PCAL 0 calling sequence to call user-defined functions. New microcode action [PCAL p.34]: with DSPL = STT entry containing label or 0 if label on TOS if DSPL = 0 then -- if label is on the TOS label := RA -- then get it if lebel.seg = 0 then -- if the segment number is zero cst'violation -- then trap for a CST violation F1 := 0 -- the label is external if SM + 4 > Z then -- if no room for the stack marker stack'overflow -- then trap for a stack overflow end if mark'stack (map'flag) -- mark stack with current mapping bit set at Q - 2 go to PCL3 -- set up new code segment else -- label is in STT num'int := M [PL].high'byte -- get number of internal labels from STT num'lab := M [PL].low'byte -- and the total number of labels F1 := DSPL <= num'int -- set F1 if label is internal if SM + 4 > Z then -- if no room for the stack marker stack'overflow -- then trap for a stack overflow end if mark'stack (map'flag) -- mark stack with current mapping bit set at Q - 2 if DSPL > num'lab then -- if index > number of labels stt'violation -- then trap for an STT violation end if label := M [PL - DSPL] -- read the label from the STT if DSPL > num'int then -- if the label is external goto PCL3 -- then set up the code segment else -- otherwise the label is local if label.address > PL - PB then -- if address is outside of segment bounds'violation else -- otherwise address is OK p := new P -- set up new P next -- next instruction end if end if end if New microcode action [PCL3 p.36]: with SP1B = external program label RH = number of internal labels from STT header DSPL = STT entry containing label or 0 if label on TOS STA = caller's status register if label.0 = 0 then -- if external label is mapped seg'count := M [01223] -- get count of program segments if 1 <= label.seg <= seg'count -- if non-zero and program segment cstp := M [1] -- then use CSTX base else -- user SL segment cstp := M [0] -- use CST base lstt'bank := M [01221] -- get LSTT bank lstt'offset := M [01222] -- and offset if lstt'bank = 0 and lstt'offset = 0 then -- if the LSTT is not defined cst'violation -- then a CST violation occurs lstt'count := M [lstt'base] -- get the number of LSTT entries if label.seg = 0 then -- [011F p.37] if the segment is 0 if sta.seg > lstt'count then -- then if the current segment isn't in the table stt'violation -- then an STT violation occurs end if lstt'stt := M [lstt'base + sta.seg * 2 + 1] -- get the offset to the STT header num'int := M [PL].high'byte -- get number of internal labels from STT label := M [lstt'base + lstt'stt - (label.stt - num'int)] -- and new label from LSTT end if end if end if if label.seg = 0 then -- if the segment is 0 cst'violation -- then a CST violation occurs end if if label.0 = 1 then -- if the (new) label is unmapped cst'index :- label.seg -- then CST index is segment number else -- else label is mapped cst'index := M [lstt'base + label.seg * 2] -- so CST index is in LSTT end if ---------------- LLBL Instruction ---------------- New microcode action [LLBL p.39]: with DSPL = STT entry containing label num'int := M [PL].high'byte -- get number of internal labels from STT num'lab := M [PL].low'byte -- and the total number of labels if DSPL > num'lab then stt'violation end if label := M [PL - DSPL] -- read the label from the STT if DSPL > num'int then -- if label is external if label.seg > 0 then -- [LLB3 p.39] if segment > 0 RA := label -- then push label onto TOS else -- otherwise segment is 0 if label.0 = 1 then -- if unmapped stt'violation -- then an STT violation occurs end if lstt'bank := M [01221] -- get LSTT bank lstt'offset := M [01222] -- and offset if lstt'bank = 0 and lstt'offset = 0 then -- if the LSTT is not defined cst'violation -- then a CST violation occurs end if -- lstt'count := M [lstt'base] -- get the number of LSTT entries -- -- if sta.seg > lstt'count then -- if the current segment isn't in the table -- stt'violation -- then an STT violation occurs -- end if lstt'stt := M [lstt'base + sta.seg * 2 + 1] -- get the offset to the STT header RA := M [lstt'base + lstt'stt - (label.stt - num'int)] -- get the new label from LSTT end if else -- otherwise label is internal if DSPL > 127 -- if conversion to external not possible stt'violation -- then STT violation end if RA := map'flag or DSPL << 8 or STA.seg -- push external label end if ---------------- EXIT Instruction ---------------- New microcode action [EXIT p.40]: --------------- LST instruction --------------- The old microcode logic is: if K = 0 then -- if the displacement field is zero index = RA -- then get the index from the TOS pop else -- otherwise index = K -- use the displacement as the index endif ptr := M [%1000 + index] -- get the desired pointer from the SYSGLOB table push RA := M [%1000 + ptr + X] -- push the value at the pointer indexed by X For the new microcode, the pointer in the table is changed from a simple offset to a combined bank and offset with this format: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | offset * 32 | bank | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ The target offset is always aligned with a 32-word boundary, so the access becomes: RA := M [TO_PA (ptr and %37, %1000 + (ptr and %177760) + x)] --------------- SST instruction --------------- The old microcode logic is: if K = 0 then -- if the displacement field is zero index = RA -- then get the index from the TOS pop else -- otherwise index = K -- use the displacement as the index endif ptr := M [%1000 + index] -- get the desired pointer from the SYSGLOB table M [%1000 + ptr + X] := RA -- store the value into memory at the pointer indexed by X For the new microcode, the pointer in the table is changed from a simple offset to a combined bank and offset with this format: 0 | 1 2 3 | 4 5 6 | 7 8 9 |10 11 12 |13 14 15 +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ | offset * 32 | bank | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ The target offset is always aligned with a 32-word boundary, so the access becomes: M [TO_PA (ptr and %37, %1000 + (ptr and %177760) + x)] := RA