Missembling
Vector 5:2, page 105
Transcribed from the printed issue; not yet reviewed. Read it in the PDF of the issue, page 105
The discerning reader will have noticed a couple of howling errors in my previous “Dissembling” article which I feel obliged to correct.
The first was, of course, the absolutely unforgiveable misspelling “wanged”, which should, as all lovers of the English language appreciate, have been “whanged”. My sincere apologies go to all those who were shocked into catatonia by this affront to their sensibilities – if they can still hear me.
The other error was a trivium which merely rendered the Assembler code completely unusable. I refer, of course, to the first Divide instruction which, operating on 52 significant bits (after shifting), produced a quotient requiring more than 31 bits for its expression and so yielded a fixed-point divide exception.
It’s interesting to note that APL, which holds large values in exponential format and migrates freely between formats as the data varies, is unaffected by such narrow limitations. Because I neglected to take this fact into account, the error was not revealed by the simulation which was the subject of the article.
It’s also interesting to note that the fixed point divide exception is the classic trap which lies in wait for the unwary writer of a TOD-clock decoding routine – and I fell headlong into it.
….
Examining the smouldering remains of the program, I confirmed that the first Divide instruction was the critical one. Subsequent divisions would produce results of manageable size once I was over that first hurdle. The question was: how to perform the division?
Eleven year old readers who have passed their mathematics exams will see the answer immediately. Those who, like me, re-sat the same exam at the age of thirty-five – and failed – may find the following description of interest. If not, they can always sneak off to the pub during the heavy bits.
The trick of it is to split the number into two manageable parts, divide them separately, note their quotients and remainders, and then combine them. Since we are working with 32-bit registers, of which the high order bit is reserved for a sign, it seems reasonable to split off the low-order 31 bits.
One snag which we have to watch out for is that the high-order fragment’s remainder and quotient after division are 2*31 times greater than they seem. Consequently, they must be multiplied by shifting, after which the remainder must be divided again. This gives us three quotients and two remainders for respective summing.
The other snag is that, when we sum the two remainders, we may get a result which exceeds the divisor. In this case, we must subtract the divisor from it and increment the sum of the quotients by 1. Since we are summing only two remainders, our result cannot but be smaller than twice the divisor, so a single incrementation is all we’ll ever need.
The following APL function demonstrates the principles involved.
∇ R←DIV ALGORITHM TOD
[1] ⍝
[2] ⍝ Assume TOD contains the 52-bit clock value
[3] ⍝ (ie. the value after shifting) and
[4] ⍝ DIV contains our chosen divisor.
[5] ⍝
[6] HI←⌊TOD÷2*31 ⍝ Get high-order half in HI.
[7] LO←(2*31)|TOD ⍝ Get low-order half in LO.
[8] ⍝
[9] HIQUOT←(2*31)×⌊HI÷DIV ⍝ Divide HI. The multiplication
[10] HIREM←(2*31)×DIV|HI ⍝ by 2*31 reinstates significance.
[11] ⍝
[12] HIQUOT2←⌊HIREM÷DIV ⍝ Divide remainder, giving more
[13] HIREM←DIV|HIREM ⍝ quotient and proper remainder.
[14] ⍝
[15] LOQUOT←⌊LO÷DIV ⍝ Divide LO, giving more quotient
[16] LOREM←DIV|LO ⍝ and more remainder.
[17] ⍝
[18] QUOT←HIQUOT+HIQUOT2+LOQUOT ⍝ Sum all three quotients.
[19] REM←HIREM+LOREM ⍝ Sum both remainders.
[20] ⍝
[21] →(DIV>REM)/END ⍝ If sum of remainders exceeds
[22] REM←REM-DIV ⍝ divisor, subtract divisor from
[23] QUOT←QUOT+1 ⍝ it and increment quotients' sum.
[24] ⍝
[25] END:R←QUOT,REM
∇
Now that the principle has been demonstrated, it’s time to put it to work. The following Assembler code does so. Afterwards, we can look at its simulation in APL.
The code given below replaces just four instructions in the previous article’s example. The original instructions (with their comments) were:
LM 6,7,0(3) . R6-R7 CONTAIN INPUT DWORD DATE.
*
*-------SPLIT SECONDS OFF------
D 6,=F'1000000' . R6=MICROSECONDS OVER. R7=SECONDS.
LR 2,6 . PUT MICROSECS FRACTION ASIDE IN R2.
*
*-------SPLIT DAYS OFF---------
SR 6,6
The replacement instructions are, ahem, a little more extensive:
LM 2,3,0(3) . R2-R3 CONTAIN INPUT DWORD DATE.
SRDL 2,12 . CONVERT TOD VALUE TO MICROSECONDS.
*
*-------SPLIT SECONDS OFF------
*
* AFTER THE ABOVE SHIFT, THE MICROSECS COUNT IS STILL A 52-BIT NUMBER.
* DIVIDING BY 1,000,000 WOULD PRODUCE A RESULT IN EXCESS OF 31 BITS
* AND SO WOULD YIELD A FIXED POINT DIVIDE EXCEPTION.
* THE PROBLEM IS SOLVED BY BREAKING THE MICROSECS COUNT INTO TWO
* HALVES, DIVIDING EACH SEPARATELY, FURTHER DIVIDING THE HIGH ORDER
* HALF'S REMAINDER AND THEN SUMMING ALL THE RESULTS.
*
SLDL 2,1 . PUT LO-ORDER 31 BITS INTO R3 WITH
SRL 3,1 ZERO SIGN-BIT.
LR 7,2 . PUT HIGH ORDER HALF IN R7.
SR 6,6 . CLEAR THE ASSOCIATED EVEN REGISTERS
SR 2,2 READY FOR DIVIDE OPERATIONS.
*
D 2,=F'1000000' . R2=LO MICROSECS R3=LO SECS.
D 6,=F'1000000' . R6=HI MICROSECS R7=HI SECS. (/2*31)
LR 9,6 . R8-9 GET HI MICROSECS/2*31 READY
SR 8,8 FOR FURTHER DIVISION.
SR 6,6 . R6-7 ARE HI SECS/2*31.
SLDL 6,31 . MULTIPLY HI SECS AND MICROSECS BY
SLDL 8,31 2*31 READY FOR ADDITIONS. NOTE
* HI MICROSECS NEEDS ANOTHER DIVISION.
ALR 7,3 . R7 GETS LO SECS + HI SECS.
BC 12,*+8 . IF CARRY OCCURRED OUT OF R7, ADD IT
AH 6,=H'1' INTO R6.
*
D 8,=F'1000000' . RE-DIVIDE HI MICROSECS:
* R8=TRUE HI MICROSECS R9=SECS-ADJUST.
ALR 7,9 . R7=LO SECS + HI SECS + SECS ADJUST.
BC 12,*+8 . IF CARRY OCCURRED OUT OF R7, ADD IT
AH 6,=H'1' INTO R6.
AR 2,8 . R2=LO MICROSECS + TRUE HI MICROSECS.
C 2,=F'1000000' . IF THE SUMMED MICROSECS COUNT
BL GETDAYS EXCEEDS 1,000,000 REDUCE IT BY
S 2,=F'1000000' 1,000,000 AND INCREMENT THE SUMMED
AL 7,=F'1' SECONDS COUNT.
BC 12,*+8 . IF CARRY OCCURRED OUT OF R7, ADD IT
AH 6,=H'1' INTO R6.
*
*-------SPLIT DAYS OFF---------
GETDAYS EQU *
The AL and ALR instructions may require a word of explanation. The usual System/370 fixed point binary Add instructions operate on signed values. The high order bit of a 32-bit register is used to carry a sign: an off-bit denotes a positive value and an on-bit denotes a negative value.
AL (Add Logical) instructions view all 32 bits as data and set the condition code to indicate whether a carry-out occurred. When, as here, we operate on a value which straddles two adjacent registers, we can use the AL and ALR instructions to add values into the low-order register of the pair and, if a carry-out occurs, detect it and increment the high-order register.
The APL function below simulates the Assembler code and uses quite a few dependent functions to simulate System/370 instructions. We’ll take a look at those in a moment.
∇ DIVIDE∆BY∆A∆MILLION INPUT;CK;CC;REGS;TR;X
[1] ⍝
[2] ⍝ INPUT is 16-element vector of base-16 integers representing
[3] ⍝ a recent 64-bit TOD-clock value.
[4] ⍝
[5] ⍝ A typical value is: 9 13 5 11 13 2 12 13 5 14 1 9 10 0 0 0
[6] ⍝ or, in hex: 9D5BD2CD5E19A000
[7] ⍝ denoting the date: 1987 09 22 07 34 28 145 562
[8] ⍝
[9] CK←1 ⍝ Turn on argument-checking.
[10] TR←0 ⍝ Turn off tracing.
[11] CC← 0 0 0 0 ⍝ Start condition-code.
[12] REGS← 16 32 ⍴1 ⍝ Start registers with garbage.
[13] ⍝
[14] X←64 BINARY 16⊥INPUT ⍝ -----ASSEMBLER INSTRUCTIONS-----
[15] REGS[2 3 ;]← 2 32 ⍴X ⍝ LM R2,R3,0(R3)
[16] TRACE 'ON'
[17] SRDL 2,12 ⍝ SRDL R2,12
[18] SLDL 2,1 ⍝ SLDL R2,1
[19] SRL 3,1 ⍝ SRL R3,1
[20] LR 7,2 ⍝ LR R7,R2
[21] SR 6,6 ⍝ SR R6,R6
[22] SR 2,2 ⍝ SR R2,R2
[23] D 2,1000000 ⍝ D R2,=F'1000000'
[24] D 6,1000000 ⍝ D R6,=F'1000000'
[25] LR 9,6 ⍝ LR R9,R6
[26] SR 8,8 ⍝ SR R8,R8
[27] SR 6,6 ⍝ SR R6,R6
[28] SLDL 6,31 ⍝ SLDL R6,31
[29] SLDL 8,31 ⍝ SLDL R8,31
[30] ALR 7,3 ⍝ ALR R7,R3
[31] →BC 12,⎕LC[⎕IO]+2 ⍝ BC 12,*+8
[32] AH 6,1 ⍝ AH R6,=H'1'
[33] D 8,1000000 ⍝ D R8,=F'1000000'
[34] ALR 7,9 ⍝ ALR R7,R9
[35] →BC 12,⎕LC[⎕IO]+2 ⍝ BC 12,*+8
[36] AH 6,1 ⍝ AH R6,=H'1'
[37] AR 2,8 ⍝ AR R2,R8
[38] C 2,1000000 ⍝ C R2,=F'1000000'
[39] →BL GETDAYS ⍝ BL GETDAYS
[40] S 2,1000000 ⍝ S R2,=F'1000000'
[41] AL 7,1 ⍝ AL R7,1
[42] →BC 12,⎕LC[⎕IO]+2 ⍝ BC 12,*+8
[43] AH 6,1 ⍝ AH R6,=H'1'
[44] GETDAYS: ⍝ GETDAYS EQU *
[45] TRACE 'OFF'
[46] ⍝
[47] ' COMPUTED SECS= ',⍕DECIMAL,REGS[6 7 ;]
[48] 'COMPUTED MSECS= ',⍕DECIMAL REGS[2;]
[49] ''
[50] ' SECS SHOULD BE ',⍕⌊(DECIMAL ¯12↓65 BINARY 16⊥INPUT)÷1000000
[51] 'MSECS SHOULD BE ',⍕1000000|DECIMAL ¯12↓65 BINARY 16⊥INPUT
∇
As I said, the function uses quite a few dependent functions. Before we look at them in detail, a general prospectus is perhaps in order.
Simulated System/370 instructions:
| A | Add | AH | Add Halfword |
| AL | Add Logical | ALR | Add Logical Register |
| AR | Add Register | BC | Branch on Condition |
| BCT | Branch on Count | BCTR | Branch on Count Register |
| BH | Branch on High | BL | Branch on Low |
| BNO | Branch if Not Ones | C | Compare |
| CH | Compare Halfword | D | Divide |
| LA | Load Address | LR | Load Register |
| MH | Multiply Halfword | S | Subtract |
| SH | Subtract Halfword | SLA | Shift Left Single |
| SLDL | Shift Left Double Logical | SR | Subtract Register |
| SRDA | Shift Right Double | SRDL | Shift Right Dble Logical |
| SRL | Shift Right Logical |
General services used by the simulated instructions:
| ADDL | performs logical addition |
| ADDR | checks/converts an integer to a 24-bit Boolean |
| ADDS | performs signed addition |
| BIN2HEX | converts a Boolean to hexadecimal representation |
| BINARY | converts a decimal integer (either sign) to Boolean |
| DECIMAL | converts a Boolean to a signed decimal integer |
| FULLWORD | checks/converts a decimal integer to a 32-bit Boolean |
| HALFWORD | checks/converts a decimal integer to a 16-bit Boolean |
| SUBS | performs signed subtraction |
| TRACE | displays regs, condcode and current instruction image |
Listings of all these functions follow. Assembler buffs will confirm that the foregoing represents only a small fraction of the System/370 repertoire. These are easy ones to simulate because they all do things with registers. I have yet to devise a way of simulating mainstorage accesses, although of course it is easy enough to supply literal values directly, as the simulation indeed does.
Not wishing to get caught again by fixed point overflow situations, I have elected to run each simulated register as a row of REGS (a 16 by 32-bit Boolean), program length checks throughout and simulate the System/370 condition code, too.
Many of the dependent functions rely on the existence of REGS and update CC, the condition code. Wherever possible, I’ve programmed checks for System/370 abends. My old friend, the fixed point divide exception, is in there for starters.
You’ll notice that a TRACE function is called all over the place. A glance at TRACE’s code shows it to be a pretty ugly looking customer. However, when Boolean TR is on, it produces very pretty hexadecimal displays of the simulated registers. These proved very useful for debugging both the functions and the Assembler code, besides enhancing the entertainment value of the simulation.
You’ll also notice that a CHECK function is called everywhere. When Boolean CK is on, it checks that function arguments are correctly-formed. If not, it notifies an error. This error might be considered the equivalent of an Assembly error, but I wouldn’t like to strain the metaphor too far.
Before anybody asks: no, this code is not going to do the mile in under four minutes. I take the view that, when I’m having fun, I want it to last as long as possible.
Functions simulating System/370 instructions:
∇ A RV
[1] ⍝ System/370 Add instruction
[2] ⍝ RV[⎕IO] is the target register.
[3] ⍝ RV[⎕IO+1] is the value to be added to it.
[4] ⍝
[5] 'RV' CHECK RV
[6] REGS[RV[⎕IO];]←(REGS[RV[⎕IO];])ADDS FULLWORD RV[⎕IO+1]
[7] 'A' TRACE RV
[8] →(~CC[⎕IO+3])/0
[9] 'A ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---FIXED POINT OVERFLOW!'
[10] ∘
∇
∇ AH RV
[1] ⍝ System/370 Add Halfword instruction
[2] ⍝ RV[⎕IO] is the target register.
[3] ⍝ RV[⎕IO+1] is the value to be added to it.
[4] ⍝
[5] 'RV' CHECK RV
[6] REGS[RV[⎕IO];]←(REGS[RV[⎕IO];])ADDS ¯32↑HALFWORD RV[⎕IO+1]
[7] 'AH' TRACE RV
[8] →(~CC[⎕IO+3])/0
[9] 'AH ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---FIXED POINT OVERFLOW!'
[10] ∘
∇
∇ AL RV
[1] ⍝ System/370 Add Logical instruction
[2] ⍝ RV[⎕IO] is the target register.
[3] ⍝ RV[⎕IO+1] is the value to be added to it.
[4] ⍝
[5] 'RV' CHECK RV
[6] REGS[RV[⎕IO];]←(REGS[RV[⎕IO];])ADDL FULLWORD RV[⎕IO+1]
[7] 'AL' TRACE RV
∇
∇ ALR RR
[1] ⍝ System/370 Add Logical Register instruction
[2] ⍝ RR[⎕IO] is the target register.
[3] ⍝ RR[⎕IO+1] is the register containing the value to be added.
[4] ⍝
[5] 'RR' CHECK RR
[6] REGS[RR[⎕IO];]←(REGS[RR[⎕IO];])ADDL REGS[RR[⎕IO+1];]
[7] 'ALR' TRACE RR
∇
∇ AR RR;A
[1] ⍝ System/370 Add Register instruction
[2] ⍝ RR[⎕IO] is the target register.
[3] ⍝ RR[⎕IO+1] is the register containing the value to be added.
[4] ⍝
[5] 'RR' CHECK RR
[6] REGS[RR[⎕IO];]←(REGS[RR[⎕IO];])ADDS REGS[RR[⎕IO+1];]
[7] 'AR' TRACE RR
[8] →(~CC[⎕IO+3])/0
[9] 'AR ',(⍕RR[⎕IO]),',',(⍕RR[⎕IO+1]),' ---FIXED POINT OVERFLOW!'
[10] ∘
∇
∇ R←BC VA
[1] ⍝ System/370 Branch on Condition instruction
[2] ⍝ VA[⎕IO] is the condition code value.
[3] ⍝ VA[⎕IO+1] is the branch address.
[4] ⍝
[5] 'RA' CHECK VA
[6] R←(∨/CC∧ 2 2 2 2 ⊤VA[⎕IO])/VA[⎕IO+1]
[7] 'BC' TRACE VA
∇
∇ R←BCT RV
[1] ⍝ System/370 Branch on Count instruction
[2] ⍝ RV[⎕IO] is the register.
[3] ⍝ RV[⎕IO+1] is the branch address.
[4] ⍝
[5] 'RA' CHECK RV
[6] REGS[RV[⎕IO];]←32 BINARY(2⊥REGS[RV[⎕IO];])-1
[7] R←(∨/REGS[RV[⎕IO];])/RV[⎕IO+1]
[8] 'BCT' TRACE RV
∇
∇ R←BCTR RR
[1] ⍝ System/370 Branch on Count Register instruction
[2] ⍝ RR[⎕IO] is the register to be decremented.
[3] ⍝ RR[⎕IO+1] is the register containing the branch address.
[4] ⍝
[5] 'RR' CHECK RR
[6] REGS[RR[⎕IO];]←32 BINARY(2⊥REGS[RR[⎕IO];])-1
[7] R←(∨/REGS[RR[⎕IO];])/DECIMAL 0,8↓REGS[RR[⎕IO+1];]
[8] 'BCTR' TRACE RR
[9] →(RR[⎕IO+1]≠0)/0
[10] R←⍬
∇
∇ R←BH A
[1] ⍝ System/370 Branch on High instruction
[2] ⍝ A is the branch address.
[3] ⍝
[4] R←BC 2,A
∇
∇ R←BL A
[1] ⍝ System/370 Branch on Low instruction
[2] ⍝ A is the branch address.
[3] ⍝
[4] R←BC 4,A
∇
∇ R←BNO A
[1] ⍝ System/370 Branch if Not Ones instruction
[2] ⍝ A is the branch address.
[3] ⍝
[4] R←BC 14,A
∇
∇ C RV;A
[1] ⍝ System/370 Compare instruction
[2] ⍝ RV[⎕IO] is the register.
[3] ⍝ RV[⎕IO+1] is the value of comparand.
[4] ⍝
[5] 'RV' CHECK RV
[6] A←DECIMAL REGS[RV[⎕IO];]
[7] CC← 2 2 2 2 ⊤ 4 8 2 [⍬⍴⎕IO+1+×A-DECIMAL FULLWORD RV[⎕IO+1]]
[8] 'C' TRACE RV
∇
∇ CH RV;A
[1] ⍝ System/370 Compare Halfword instruction
[2] ⍝ RV[⎕IO] is the register.
[3] ⍝ RV[⎕IO+1] is the value of comparand.
[4] ⍝
[5] 'RV' CHECK RV
[6] A←DECIMAL REGS[RV[⎕IO];]
[7] CC← 2 2 2 2 ⊤ 4 8 2 [⍬⍴⎕IO+1+×A-DECIMAL HALFWORD RV[⎕IO+1]]
[8] 'CH' TRACE RV
∇
∇ D RV;DIVIDEND;X
[1] ⍝ System/370 Divide instruction
[2] ⍝ RV[⎕IO] is the even-numbered register of the register pair
[3] ⍝ containing the dividend.
[4] ⍝ RV[⎕IO+1] is the divisor.
[5] ⍝
[6] 'RV' CHECK RV
[7] →(1=2|RV[⎕IO])/XSPEC
[8] DIVIDEND←DECIMAL REGS[RV[⎕IO];],REGS[RV[⎕IO]+1;]
[9] ⍝
[10] →(X≠DECIMAL 32 BINARY X←RV[⎕IO+1]|DIVIDEND)/XDIV
[11] →(X≠DECIMAL 32 BINARY X←⌊DIVIDEND÷DECIMAL FULLWORD RV[⎕IO+1])/XDIV
[12] ⍝
[13] REGS[RV[⎕IO];]←32 BINARY RV[⎕IO+1]|DIVIDEND
[14] REGS[RV[⎕IO]+1;]←32 BINARY⌊DIVIDEND÷RV[⎕IO+1]
[15] 'D' TRACE RV
[16] →0
[17] ⍝
[18] XDIV:
[19] 'D ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---FIXED POINT DIVIDE EXCEPTION'
[20] ∘
[21] ⍝
[22] XSPEC:
[23] 'D ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---SPECIFICATION EXCEPTION'
[24] ∘
∇
∇ LA RA
[1] ⍝ System/370 Load Address instruction
[2] ⍝ RA[⎕IO] is the target register.
[3] ⍝ RA[⎕IO+1] is the address.
[4] ⍝
[5] 'RA' CHECK RA
[6] REGS[RA[⎕IO];]←¯32↑ADDR RA[⎕IO+1]
[7] 'LA' TRACE RA
∇
∇ LR RR
[1] ⍝ System/370 Load Register instruction
[2] ⍝ RR[⎕IO] is the target register.
[3] ⍝ RR[⎕IO+1] is the register containing the value to be copied.
[4] ⍝
[5] 'RR' CHECK RR
[6] REGS[RR[⎕IO];]←REGS[RR[⎕IO+1];]
[7] 'LR' TRACE RR
∇
∇ MH RV;X
[1] ⍝ System/370 Multiply Halfword instruction
[2] ⍝ RV[⎕IO] is the target register.
[3] ⍝ RV[⎕IO+1] is the value of the multiplier.
[4] ⍝
[5] 'RV' CHECK RV
[6] X←(DECIMAL REGS[RV[⎕IO];])×DECIMAL HALFWORD RV[⎕IO+1]
[7] REGS[RV[⎕IO];]←32 BINARY X
[8] 'MH' TRACE RV
∇
∇ S RV;A
[1] ⍝ System/370 Subtract instruction
[2] ⍝ RV[⎕IO] is the target register.
[3] ⍝ RV[⎕IO+1] is the value to be subtracted from it.
[4] ⍝
[5] 'RV' CHECK RV
[6] REGS[RV[⎕IO];]←REGS[RV[⎕IO];]SUBS FULLWORD RV[⎕IO+1]
[7] 'S' TRACE RV
[8] →(~CC[⎕IO+3])/0
[9] 'S ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---FIXED POINT OVERFLOW!'
[10] ∘
∇
∇ SH RV;A
[1] ⍝ System/370 Subtract Halfword instruction
[2] ⍝ RV[⎕IO] is the target register.
[3] ⍝ RV[⎕IO+1] is the value to be subtracted from it.
[4] ⍝
[5] 'RV' CHECK RV
[6] REGS[RV[⎕IO];]←REGS[RV[⎕IO];]SUBS ¯32↑HALFWORD RV[⎕IO+1]
[7] 'SH' TRACE RV
[8] →(~¯1↑CC)/0
[9] 'SH ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---FIXED POINT OVERFLOW!'
[10] ∘
∇
∇ SLA RV;A
[1] ⍝ System/370 Shift Left Single instruction
[2] ⍝ RV[⎕IO] is the register containing the value to be shifted.
[3] ⍝ RV[⎕IO+1] is the number of bit-positions through which the
[4] ⍝ value is to be shifted.
[5] ⍝
[6] 'RV' CHECK RV
[7] CC← 0 0 0 0
[8] CC[⎕IO+3]←∨/RV[⎕IO+1]↑,REGS[RV[⎕IO];]
[9] REGS[RV[⎕IO];]←32↑RV[⎕IO+1]↓,REGS[RV[⎕IO];]
[10] →CC[⎕IO+3]/OVER
[11] A←DECIMAL REGS[RV[⎕IO];]
[12] CC← 2 2 2 2 ⊤ 4 8 2 [⍬⍴⎕IO+1+×A-DECIMAL FULLWORD RV[⎕IO+1]]
[13] 'SLA' TRACE RV
[14] →0
[15] OVER:'SLA' TRACE RV
[16] 'SLA ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---FIXED POINT OVERFLOW!'
[17] ∘
∇
∇ SLDL RV
[1] ⍝ System/370 Shift Left Double Logical instruction
[2] ⍝ RV[⎕IO] is the even-numbered register of the register pair
[3] ⍝ containing the value to be shifted.
[4] ⍝ RV[⎕IO+1] is the number of bit-positions through which the
[5] ⍝ value is to be shifted.
[6] ⍝
[7] 'RV' CHECK RV
[8] →(1=2|RV[⎕IO])/XSPEC
[9] REGS[RV[⎕IO]+ 0 1 ;]← 2 32 ⍴64↑RV[⎕IO+1]↓,REGS[RV[⎕IO]+ 0 1 ;]
[10] 'SLDL' TRACE RV
[11] →0
[12] ⍝
[13] XSPEC:
[14] ⎕←'SLDL ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---SPECIFICATION EXCEPTION'
[15] ∘
∇
∇ SR RR
[1] ⍝ System/370 Subtract Register instruction
[2] ⍝ RR[⎕IO] is the target register.
[3] ⍝ RR[⎕IO+1] is the register containing the value to be subtracted.
[4] ⍝
[5] 'RR' CHECK RR
[6] REGS[RR[⎕IO];]←REGS[RR[⎕IO];]SUBS REGS[RR[⎕IO+1];]
[7] 'SR' TRACE RR
[8] →(~CC[⎕IO+3])/0
[9] 'SR ',(⍕RR[⎕IO]),',',(⍕RR[⎕IO+1]),' ---FIXED POINT OVERFLOW!'
[10] ∘
∇
∇ SRDA RV;A
[1] ⍝ System/370 Shift Right Double instruction
[2] ⍝ RV[⎕IO] is the even-numbered register of the register pair
[3] ⍝ containing the value to be shifted.
[4] ⍝ RV[⎕IO+1] is the number of bit-positions through which the
[5] ⍝ value is to be shifted.
[6] ⍝
[7] 'RV' CHECK RV
[8] →(1=2|RV[⎕IO])/XSPEC
[9] REGS[RV[⎕IO]+ 0 1 ;]←2 32⍴64↑(-64+RV[⎕IO+1])↑,REGS[RV[⎕IO]+ 0 1 ;]
[10] A←DECIMAL,REGS[RV[⎕IO]+ 0 1 ;]
[11] CC← 2 2 2 2 ⊤ 4 8 2 [⍬⍴⎕IO+1+×A]
[12] 'SRDA' TRACE RV
[13] →0
[14] ⍝
[15] XSPEC:
[16] ⎕←'SRDA ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---SPECIFICATION EXCEPTION'
[17] ∘
∇
∇ SRDL RV
[1] ⍝ System/370 Shift Right Double Logical instruction
[2] ⍝ RV[⎕IO] is the even-numbered register of the register pair
[3] ⍝ containing the value to be shifted.
[4] ⍝ RV[⎕IO+1] is the number of bit-positions through which the
[5] ⍝ value is to be shifted.
[6] ⍝
[7] 'RV' CHECK RV
[8] →(1=2|RV[⎕IO])/XSPEC
[9] REGS[RV[⎕IO]+ 0 1 ;]←2 32⍴64↑(-64+RV[⎕IO+1])↑,REGS[RV[⎕IO]+ 0 1 ;]
[10] 'SRDL' TRACE RV
[11] →0
[12] ⍝
[13] XSPEC:
[14] ⎕←'SRDL ',(⍕RV[⎕IO]),',',(⍕RV[⎕IO+1]),' ---SPECIFICATION EXCEPTION'
[15] ∘
∇
∇ SRL RV
[1] ⍝ System/370 Shift Right Single Logical instruction
[2] ⍝ RV[⎕IO] is the register containing the value to be shifted.
[3] ⍝ RV[⎕IO+1] is the number of bit-positions through which the
[4] ⍝ value is to be shifted.
[5] ⍝
[6] 'RV' CHECK RV
[7] REGS[RV[⎕IO];]←32↑(-32+RV[⎕IO+1])↑,REGS[RV[⎕IO];]
[8] 'SRL' TRACE RV
∇
General services used by the simulated instructions:
∇ R←A ADDL B
[1] ⍝ Logical addition of Booleans A and B.
[2] ⍝
[3] R←(1+⍴A)BINARY(2⊥A)+2⊥B ⍝ Extra high-order bit
[4] CC←(2×R[⎕IO])⌽4↑(∧/~1↓R)⌽ 0 1 ⍝ detects overflow.
[5] R←1↓R
∇
∇ R←ADDR DEC
[1] ⍝ Convert DEC decimal address to 24-bit Boolean.
[2] R←(24⍴2)⊤DEC
[3] →(DEC=DECIMAL 0,R)/0
[4] ⎕←(⍕DEC),' exceeds 24-bit address capacity.'
[5] ∘
∇
∇ R←A ADDS B;X
[1] ⍝ Signed addition of Booleans A and B.
[2] CC← 0 0 0 1 ⍝ Assume overflow.
[3] X←(DECIMAL A)+DECIMAL B ⍝ Add the values.
[4] →(X≠DECIMAL R←(⍴A)BINARY X)/0 ⍝ If precision lost, overflow.
[5] CC← 2 2 2 2 ⊤ 4 8 2 [⍬⍴⎕IO+1+×X] ⍝ Else set condition code.
∇
∇ R←DIGITS BINARY DEC
[1] ⍝ DIGITS declares the number of bits required in result R.
[2] ⍝
[3] R←(DIGITS⍴2)⊤DEC ⍝ Convert DEC decimal integer to Boolean.
∇
∇ R←BIN2HEX BIN
[1] ⍝ Give hex representation of BIN Boolean
[2] ⍝
[3] R←'0123456789ABCDEF'[⎕IO+((⌈(⍴BIN)÷4)⍴16)⊤2⊥BIN]
∇
∇ REQ CHECK ARG
[1] ⍝ Check ARG data according to REQ request code.
[2] ⍝
[3] →(0=⎕NC 'CK')/0
[4] →(1≠CK)/0
[5] ⍝
[6] →(1≠⍴⍴ARG)/ERR
[7] →(0≠1↑0⍴ARG)/ERR
[8] →(∨/0≠1|ARG)/ERR
[9] →(2≠⍴ARG)/ERR
[10] ⍝
[11] →((3 2 ⍴'RRRVRA')∧.=2↑,REQ)/RR,RV,RA
[12] →0
[13] ⍝
[14] RR:→(∨/15<ARG)/ERR
[15] →(∨/0>ARG)/ERR
[16] →0
[17] ⍝
[18] RV:→(15<1↑ARG)/ERR
[19] →(0>1↑ARG)/ERR
[20] →0
[21] ⍝
[22] RA:→(15<1↑ARG)/ERR
[23] →(∨/0>ARG)/ERR
[24] →((¯1+2*24)<1↓ARG)/ERR
[25] →0
[26] ⍝
[27] ERR:⎕←'ASSEMBLY ERROR!'
[28] ∘
∇
∇ R←DECIMAL BIN
[1] R←⍬⍴2⊥1↓BIN ⍝ Convert BIN Boolean to decimal integer.
[2] →(0=1↑BIN)/0 ⍝ If BIN sign bit is on,
[3] R←⍬⍴-(2*¯1+⍴BIN)-R ⍝ convert R to negative number.
∇
∇ R←FULLWORD DEC
[1] ⍝ Convert DEC decimal integer to 32-bit Boolean.
[2] R←(32⍴2)⊤DEC
[3] →(DEC=DECIMAL R)/0
[4] ⎕←(⍕DEC),' exceeds the capacity of a fullword'
[5] ∘
∇
∇ R←HALFWORD DEC
[1] ⍝ Convert DEC decimal integer to 16-bit Boolean.
[2] R←(16⍴2)⊤DEC
[3] →(DEC=DECIMAL R)/0
[4] ⎕←(⍕DEC),' exceeds the capacity of a halfword'
[5] ∘
∇
∇ R←A SUBL B;X
[1] ⍝ Logical subtraction of Booleans A and B.
[2] ⍝
[3] R←A ADDL(2*1+⍴B)-B
[4] →(~CC[⎕IO])/0
[5] CC←2⌽CC
∇
∇ R←A SUBS B;X
[1] ⍝ Signed subtraction of Booleans A and B.
[2] CC← 0 0 0 1 ⍝ Assume overflow.
[3] X←(DECIMAL A)-DECIMAL B ⍝ Subtract the values.
[4] →(X≠DECIMAL R←(⍴A)BINARY X)/0 ⍝ If precision lost, overflow.
[5] CC← 2 2 2 2 ⊤ 4 8 2 [⍬⍴⎕IO+1+×X] ⍝ Else set condition code.
∇
∇ OPCODE TRACE OPERANDS;I;OPS;R;RR
[1] ⍝ Display status quo for calling instruction
[2] ⍝ and then await user keystroke.
[3] ⍝
[4] →(∧/'ON '=5↑,OPERANDS)/ON
[5] →(0=⎕NC 'TR')/0
[6] →(~TR)/0
[7] →(∧/'OFF '=5↑,OPERANDS)/OFF
[8] R←'CC: ',(⍕CC),(35⍴'-'),'INSTRUCTION: '
[9] OPS←⍕,OPERANDS
[10] OPS[(OPS=' ')/⍳⍴OPS]←','
[11] R←R,(6↑OPCODE),OPS,⎕TCNL
[12] GO:I←⎕IO-1
[13] RR←(-⎕IO)⊖REGS
[14] LOOP:→((1↑⍴RR)<(~⎕IO)+I←I+1)/END
[15] R←R,9↑BIN2HEX RR[I;]
[16] ⍝ R←R,(⍕DECIMAL RR[I;]),' '
[17] →(0≠8|I+~⎕IO)/LOOP
[18] R←R,⎕TCNL
[19] →LOOP
[20] ⍝
[21] OFF:⎕←'TRACE TERMINATED'
[22] TR←0
[23] →0
[24] ON:R←'CC: ',(⍕CC),(44⍴'-'),'COMMENCING TRACE',⎕TCNL
[25] TR←1
[26] →GO
[27] ⍝
[28] END:⎕←R
[29] I←⎕INKEY
[30] →0
∇
At this stage, the simulation has served its purpose and a sensible person would draw a line under it and move on to something else. Unfortunately, I am increasingly tantalised by the vistas which are starting to open up with this thing. After all, when you simulate the instruction set, you simulate the machine itself. If the editors of VECTOR don’t take the precaution of changing their identities and moving to another town you may well be hearing more on this topic.