* 05-039 R05 (+ JJ MODS)
* MODEL 70 MICRO-PROGRAM
* NOV 2, 1971
*
INITAL  DC     0                TRAP
        L      RAL,L(INTENT)    POWER UP
*
*
*PHASE 1 ENTRY POINT, INDEXED RS
AMODRS  A      MDR,MDR          FORM EFFECTIVE OPERAND
        D      PC+CLR           GO TO PHASE 2
*
*
*PHASE 1 ENTRY POINT, UNINDEXED RX
NMODRX  L      MAR,MDR          'A' TO MAR
        D      PC+MR+CLR        FETCH OP, GO TO PHASE 2
*
*
*PHASE 1 ENTRY POINT, INDEXED RX
AMODRX  A      MAR,MDR          'A+(X2)' TO MAR
        D      PC+MR+CLR        FETCH OP, GO TO PHASE 2
        ORG    X'A'
* COMMON PHASE 3 ENTRY POINT
*
ABORT   L      AR,2
        C      CUT+CB
        S      LOC,LOC,NC
        T      OP               TEST FORMAT
        B      L,P3HELP         SHORT FORMAT
        S      LOC,LOC,NC       LONG FORMAT
*
* DETERMINE NATURE OF INTERRUPT
*
P3HELP  T      MALF+PPF+CATN+SNGL
        B      G,HELP
        T      DC
        B      G,DCR            DATA CHANNEL REQUEST
*
* ASSUME I/O ATTENTION
TEST    L      FLR,PSW,CS+NC    TEST PSW04
        B      C,HSSVC          IMMEDIATE INTERRUPT
*
* IF PSW04 RESET, NORMAL INTERRUPT SERVICE
        L      MAR,L(OIPSW)
*
* GENERALIZED PSW SWAP
*
GENSWP  L      MDR,PSW          STORE OLD STATUS
        C      PW               PROTECT OVERRIDE
        L      AR,2
        A      MAR,MAR,NF+NC
        L      MDR,LOC
        C      PW+CB+CUT        STORE OLD LOCCNT
        A      LOC,MAR,NC
        D      MR+INC           FETCH NEW STATUS
*
*
LPST    L      PSW,MDR,NC       LOAD STATUS
        D      MR+JAM           LOAD CC,FETCH NEW LOC
        L      LOC,MDR          LOAD LOCCNT
*
TEST1   L      FLR,PSW,CS       TEST PSW 06
        B      G,USREBL         QUEUE SVC ENABLE
*
TEST2   L      AR,PSW,SL+CO     TEST PSW 00
        B      C,WAIT
*
P3EXIT  L      MAR,LOC          ADRS NEXT INSTR
        D      PC+MR+INC+CLR    GO
*
*
*
HSSVC   L      SRH,IO,ACK       ACKNOWLEDGE
*
IOSVC   L      AR,SRH,SL+NC     2*DEVICE NUMBER
        A      MAR,L(SPTABL)    INDEX SVC PNTR TABLE
        C      MR+CUT+CB        FETCH SERVICE POINTER
*
*
DOIT    L      RAH,H(ISBSVC)    OFF PAGE
        L      AR,2
        L      FLR,MDR          TEST SVC PNTR BIT 15
        L      MAR,MDR
        B      L,L(ISBSVC)         PROCESS ISB
* IMMEDIATE INTERRUPT
        L      MDR,PSW          STORE OLD STATUS
        C      PW              PROTECT OVERRIDE
        A      MAR,MAR,NF+NC
        L      MDR,LOC
        C      PW               STORE LOCATION COUNT
        A      LOC,MAR,NC
        D      MR+INC           FETCH NEW PSW STATUS
        L      PSW,MDR,NC
* NO NEW LOC VALUE IS NEEDED
* NEXT SEQUENTIAL ADRS CONTAINS FIRST
* INSTRUCTION OF SERVICE SUBROUTINE
*
        D      PC+MR+INC+JAM+CLR DO IT
*
ENTHLP D CWA RESET WAIT INDICATOR
*
HELP T PPF
 B G,PWRDWN
 L MAR,L(OMPSW)
 T MALF
 B G,MMFSWP MACHINE MALFUNCTION INTERRUPT
*
 T CATN+SNGL
 B G,CONSER
*
TEST3 T PPF+MALF+CATN
 B G,HELP
TEST4 T DC
 B G,DCR DATA CHANNEL REQUEST
*
 T ATN
 B G,TEST
 L RAL,L(TEST2)
*
* QUEUE SERVICE INTERRUPT ENABLED, TEST LIST
*
USREBL L MAR,X'80'
 C MR+CB FETCH POINTER
 L AR,X'FF'
 L FLR,0
 L MAR,MDR LIST START ADRS
 C MR
 L MAR,X'82' ADRS QUEUE SVC PSW
 N AR,MDR TEST NO USED TALLY
 B G,GENSWP NOT EMPTY, DO SWAP
*
 L RAL,L(TEST2) LIST EMPTY, NO INTERRUPT
*
* CHECK FLPT ARITHMETIC FAULT ENABLE
*
FLPENB L MAR,L(OFPSW)
 L FLR,PSW,CS TEST PSW 05
 B V,GENSWP DO SWAP
 L RAL,L(P3EXIT)
*
* SIMULATE INTERRUPT
*
SINT L AR,X'FF'
 N SRH,MDR ISOLATE DEVICE NO
 L RAL,L(IOSVC)
*
* INTERRUPTABLE WAIT
*
WAIT D SWA+CLR SET WAIT INDICATOR
WAIT1 T MALF+PPF+CATN+DC+ATN
 B L,WAIT1 LOOP
*
 D CWA RESET WAIT INDICATOR
 L RAL,L(P3HELP)
*
* CONSOLE SERVICE
*
DISPLY L FLR,IR,NC
 B C,REGDIS GENERAL REGISTER
 B V,PSWDIS PROGRAM STATUS WORD
 B G,INSDIS INSTRUCTION REGISTER
*
* IDLE LOOP
*
IDLE D SWA+CLR SET WAIT INDICATOR
IDLE1 T PPF
 B G,ENTHLP
 T CATN
 B L,IDLE1 LOOP
*
 D CWA RESET WAIT INDICATOR
 T SNGL
 B G,CLRWIT VARIBALE, EXIT
*
*
CONSER L SRH,1 DISPLAY DEVICE NO
 L IO,SRH,ADRS
 L IR,IO,STAT STATUS TO IR
 T SNGL
 B G,DISPLY VARIABLE MODE
 L FLR,IR4 INTERRUPT
 B L,MWSL MEMORY WRITE OR ADDRESS
 B G,MREAD MEMORY READ
 B V,DISPLY SINGLE OR HALT
*
* RUN MODE
 L FLR,IR,NC TEST REGISTER SELECT
 B CVGL,CLRWIT
*
* NO REGISTER SELECTED
 L FLR,PSW,CS+NC TEST PSW04
 B C,IOSVC CONSOLE INTERRUPT
*
* SPECIAL INTERRUPT HANDLER NOT ENABLED
CLRWIT L PSW,PSW,SL+NC
 L PSW,PSW,SR+NC RESET WAIT BIT
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2N GO
*
*
MREAD L MAR,LOC ADRS OF DATA
 D MR+INC FETCH
 L RAL,L(DISMEM) AND SHOW
*
*
MWSL L MDR,IO,DR LOW BYTE TO MDL
 L MAR,LOC ADRS TO MAR MUST BE EVEN
 L MDR,IO,DR+CS HIGH BYTE TO MDH
 B G,SL STATUS 02=ADRS
*
* MEMORY WRITE
 D PW+INC STORE IT
*
DISMEM L SRH,MAR 2ND OUTPUT REGISTER
 L SRL,MDR 1ST OUTPUT REGISTER
 L RAL,L(OUTDIS)
*
*
SL L MDR,MDR,SR+NC RESET BIT 15
 L LOC,MDR,SL+NC TO GUARANTEE EVEN
*
*
PSWDIS L SRH,PSW 2ND OUTPUT REGISTER
 L SRL,LOC 1ST OUTPUT REGISTER
*
* OUTPUT DATA TO DISPLAY
*
OUTDIS L IO,SRL,DA DISPLAY 2,LOW
 L IO,SRL,DA+CS DISPLAY 2, HIGH
 L IO,SRH,DA DISPLAY 1,LOW
 L IO,SRH,DA+CS DISPLAY 1,HIGH
 L RAL,L(IDLE)
*
*
REGDIS L IR,IR,SL+NC
 L SRH,YS 2ND OUTPUT REGISTER
 L AR,1
 O IR,IR
 L SRL,YS 1ST OUTPUT REGISTER
 L RAL,L(OUTDIS)
*
*
INSDIS L MAR,LOC
 C MR FETCH MS 16 BITS
 L AR,2
 L SRH,MDR 2ND OUTPUT REGISTER
 A MAR,MAR,NC
 C MR
 L SRL,MDR 1ST OUTPUT REGISTER
 L RAL,L(OUTDIS)
*
* POWER DOWN SEQUENCE
PWRDWN L MAR,L(LOC)
 L MDR,LOC
 C PW SAVE LOCCNT
 L MAR,L(PSW)
 L MDR,PSW
 C PW SAVE PSW
 L MAR,L(PNTR)
 C MR+SUT FETCH REGISTER SAVE POINTER
 L PSW,0 FORCE SUPERVISOR MODE
 L IR,0
 L MAR,MDR
*
* STORE MULTIPLE
*
STM L AR,IR4 YD FIELD TO AR
 S CTR,X'10' 2'S COMP & SET COUNT
 L SRH,LOC SAVE LOC
 L AR,X'10'
 L LOC,MAR
*
STMLP L MDR,YD
 D MW+INC SAVE RESGISTER
 A IR,IR BUMP YD FIELD
 B CTR,STMLP DECREMENT CTR
*
 L LOC,SRH RESTORE LOC
 T UT
 B L,P3EXIT
 D POW SYSTEM RESET
*
* PROCESSOR LOCKS ON POWER DOWN
* POWER UP RESTARTS AT LOCATION 0
*
* INITIALIZE, POWER-UP SEQUENCE
INTENT L MAR,L(PSW)
 C MR FETCH PSW VALUE
 L PSW,MDR,NC UPDATE STATUS
 L MAR,L(LOC)
 D MR+JAM UPDATE CC,FETCH LOC
 L LOC,MDR
 L MAR,L(PNTR)
 C MR+SUT REGISTER SAVE POINTER
 L IR,0
 L MAR,MDR
*
* LOAD MULTIPLE
*
LM L AR,IR4 YD FIELD TO AR
 S CTR,X'10' 2'S COMP & SET COUNT
 L SRH,LOC SAVE LOC
 L AR,X'10'
 L LOC,MAR
*
LMLOOP D MR+INC FETCH
 L YD,MDR LOAD REGISTER
 A IR,IR INCREMENT YD FIELD
 B CTR,LMLOOP
*
 L LOC,SRH RESTORE LOC
 T UT
 B L,P3EXIT
*
 L SRH,1 DISPLAY DEVICE NO
 L IO,SRH,ADRS
 L IR,IO,STAT DISPLAY STATUS TO IR
 L FLR,IR4 TEST MODE
 B VGL,NRUN NOT RUN
*
 L MAR,L(OMPSW)
 T ARST RESTART
 B L,DISPLY
 L IR,PSW,CS
 L FLR,IR4 TEST PSW 02
 B G,GENSWP DO SWAP
*
NRUN T ARST
 B G,CONSER
 L RAL,L(DISPLY)
*
* LOAD PROGRAM STATUS WORD
*
LPSW L LOC,MDR A+(X2)
 D MR+INC FETCH NEW PSW VALUE
 L RAL,L(LPST)
*
* EXCHANGE PROGRAM STATUS
*
EPSR L YD,PSW STATUS TO R1
 L PSW,YS,NC R2 TO PSW
 D JAM LOAD CC
 L RAL,L(TEST1)
*
* DATA CHANNEL REQUEST
*
DCR L IO,NULL,DCAK DATA CHANNEL ACKNOWLEDGE
 T DRD READ OR WRITE
 B L,DCREAD
*
* DATA CHANNEL WRITE
DCWRIT L MAR,IO,DR HALFWORD ADRS TO MAR
 C MR+CB FETCH
 L IO,MDR,DA OUTPUT HALFWORD DATA
 L RAL,L(TEST3)
*
* DATA CHANNEL READ
DCREAD L MAR,IO,DR HALFWORD ADRS TO MAR
 L MDR,IO,DR HALFWORD DATA TO MDR
 C PW+CB STORE IT
 L RAL,L(TEST3)
 ORG X'00F0'
MMFSWP L MDR,PSW
 C PW SAVE PSW
 L AR,2
 A MAR,MAR,NF+NC
 L MDR,LOC
 C PW+CB+CUT SAVE LOC
 A LOC,MAR,NC
 D MR+INC
 L PSW,MDR,NC LOAD NEW STATUS
 D MR+JAM+ALRM FLR OR ALARM TO CC
 L LOC,MDR LOAD NEW LOC
 L RAL,L(TEST1)
*
PNTR EQU X'22'
PSW EQU X'24'
LOC EQU X'26'
OFPSW EQU X'28'
OTPSW EQU X'30'
OMPSW EQU X'38'
OIPSW EQU X'40'
ODPSW EQU X'48'
SPTABL EQU X'D0'
 ORG X'0100'
*
* ILLEGAL INSTRUCTION INTERRUPT
*
ILLEG L AR,2
 T OP
 B L,ILEG1 RR
 L AR,4
ILEG1 S LOC,LOC,NC DECREMENT LOCCNT
 L MAR,L(OTPSW)
 L RAH,H(GENSWP)
 L RAL,L(GENSWP) PSW SWAP
*
* BRANCH INSTRUCTIONS
*
* BRANCH AND LINK
BALR L MAR,YS ADRS TO MAR
BAL L YD,LOC LINK TO YD
 L LOC,MAR DO BRANCH
 D P2N GO
*
* BRANCH ON TRUE CONDITION
BCTR T MSK
 B L,NRRB NO BRANCH, EXIT
 L LOC,YS DO BRANCH
NRRB D P2N GO
*
BTC T MSK
 B L,NRXB NO BRANCH EXIT
 L LOC,MAR DO BRANCH
 D P2N GO
*
* BRANCH ON FALSE CONDITION
BFCR T MSK
 B G,NRRB NO BRANCH, EXIT
 L LOC,YS DO BRANCH
 D P2N GO
*
BFC T MSK
 B G,NRXB NO BRANCH, EXIT
 L LOC,MAR DO BRANCH
 D P2N GO
*
* BRANCH ON INDEX
BXLH L AR,IR,NC
 L FLR,IR,CS+NC OP DOWN
 N AR,X'F0'
 O AR,IR4,NF YD FIELD=YS FIELD
 A IR,X'10'
 L SRL,YD SRL=INCREMENT
 A IR,X'20'
 L AR,SRL
 A YS,YS,NF+NC ADD INCREMENT TO INDEX
 L AR,YS
 B L,XLE BXLE
* BXH
 S AR,YD,CO COMPARAND MINUS INDEX
 B C,BRANCH DO BRANCH
NOBRAN D P2N NO BRANCH, GO
*
XLE S AR,YD,CO COMPARAND MINUS INDEX
 B C,NOBRAN
BRANCH L LOC,MDR DO BRANCH
 D P2N GO
BXH EQU BXLH
BXLE EQU BXLH
*
* STORE HALFWORD
STH L MDR,YD 1ST OP TO MDR
 C MW STORE IT
NRXB L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
* AND HALFWORD
NHR N YD,YD EXECUTE AND
 D P2J GO
*
NH L AR,MDR 2ND OP TO AR
 N YD,YD EXECUTE AND
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
NHI EQU NH
*
* COMPARE LOGICAL HALFWORD
CLHR S AR,YD,CO SUB TO SET FLAGS
 D P2J GO
*
CLH L AR,MDR 2ND OP TO AR
 S AR,YD CO SUB TO SET FLAGS
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
CLHI EQU CLH
*
* OR HALFWORD
OHR O YD,YD EXECUTE OR
 D P2J GO
*
OH L AR,MDR 2ND OP TO AR
 O YD,YD EXECUTE OR
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
OHI EQU OH
*
* EXCLUSIVE OR HALFWORD
XHR X YD,YD EXECUTE XOR
 D P2J GO
*
XH L AR,MDR 2ND OP TO AR
 X YD,YD EXECUTE XOR
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
XHI EQU XH
*
* LOAD HALFWORD
LHR O YD,YS,NA LOAD & SET FLAGS
 D P2J GO
*
LH O YD,MDR,NA LOAD & SET FLAGS
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
LHI EQU LH
*
* COMPARE HALFWORD (ARITHMETIC)
CH L AR,MDR 2ND OP TO AR
CHR X SRH,YD COMPARE SIGNS
 B L,DIFFER
* SIGNS ALIKE
 L FLR,0
 S AR,YD SUB TO SET FLAGS
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
* IF SIGNS DIFFER, SET FLAGS TO 1ST OP
DIFFER L AR,YD,SL+CO 1ST OP SIGN TO C
 O AR,YD,NA+NC SET GL
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
CHI EQU CH
*
* ADD (WITH CARRY) HALFWORD
ACHR L FLR,PSW,NC PROPOGATE FLAGS
AHR A YD,YD EXECUTE ADD
 D P2J GO
*
ACH L FLR,PSW,NC PROPOGATE FLAGS
AH L AR,MDR,NC 2ND OP TO AR
 A YD,YD EXECUTE ADD
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
AHI EQU AH
*
* SUBTRACT (WITH CARRY) HALWORD
SCHR L FLR,PSW,NC PROPOGATE FLAGS
SHR S YD,YD EXECUTE SUBTRACT
 D P2J GO
*
SCH L FLR,PSW,NC PROPOGATE FLAGS
SH L AR,MDR,NC 2ND OP TO AR
 S YD,YD EXECUTE SUBTRACT
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
SHI EQU SH
*
* ADD HALFWORD TO MEMORY
AHM L AR,YD 1ST OP TO AR
 A MDR,MDR EXECUTE ADD
 C MW STORE RESULT
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
*
* TEST HALFWORD IMMEDIATE
THI L AR,YD 1ST OP TO AR
 N AR,MDR
 D P2J GO
*
* SHIFT INSTRUCTIONS
*
* SHIFT RIGHT HALFWORD LOGICAL LONG OR SHORT
SRHL L AR,MDR
 N CTR,X'F' LOAD CTR
 C RPT
 L YD,YD,SR+CO DO SHIFT
 O YD,YD,NA+NC SET FLAGS
 D P2J GO
SRLS EQU SRHL
*
* SHIFT LEFT HALFWORD LOGICAL LONG OR SHORT
SLHL L AR,MDR
 N CTR,X'F' LOAD CTR
 C RPT
 L YD,YD,SL+CO DO SHIFT
 O YD,YD,NA+NC SET FLAGS
 D P2J GO
SLLS EQU SLHL
*
* SHIFT RIGHT HALFWORD ARITHMETIC
SRHA L AR,MDR
 N CTR,X'F' LOAD CTR
 L YD,YD,SL+CO MOVE SIGN TO CARRY
 C RPT
 L YD,YD,SR+CI DO SHIFT
 L YD,YD,SR COMPENSATE PRESHIFT
 O YD,YD,NA+NC SET FLAGS
 D P2J GO
*
* SHIFT LEFT HALFWORD ARITHMETIC
SLHA L AR,MDR
 N CTR,X'F' LOAD CTR
 L YD,YD,SL+CO SIGN TO CARRY FLAG
 L AR,NULL,SR COPY TO AR 00
 C RPT
 L YD,YD,SL+CO
 L YD,YD,SR+NC COMPENSATE PRESHIFT
 O YD,YD,NC INSERT SIGN, SET FLAGS
 D P2J GO
*
* BYTE HANDLING INSTRUCTIONS
*
* STORE BYTE
STBR N AR,X'FF'
 X SRH,YS RESET 2ND OP
 L AR,YD
 N AR,X'FF' ISOLATE LO 1ST OP
 O YS,SRH INSERT
 D P2N GO
*
STB L MDR,YD,CS INSERT BYTE
 C MW RESTORE HALFWORD
 L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
* LOAD BYTE
LBR N YD,X'FF' LOAD LO 2ND OP
 D P2N GO
*
LB L AR,MDR,CS 2ND OP TO AR
 N YD,X'FF' LOAD LO ONLY
 L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
* COMPARE LOGICAL BYTE
CLB L AR,YD 1ST OP
 N SRH,X'FF' ISOLATE LO
 L SRH,X'FF' ISOLATE LO
 L AR,MDR,CS 2ND OP
 N AR,X'FF' ISOLATE BYTE
 S AR,SRH,CO SUB TO SET FLAGS
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
*
* EXCHANGE BYTE
EXBR L YD,YS,CS DO CROSS SHIFT
 D P2N GO
*
* BYTE INPUT/OUTPUT AND CONTROL
*
* WRITE DATA
WDR L IO,YD,ADRS DEVICE ADDRESS
 L IO,YS,DA OUTPUT DATA
 D P2J GO
*
WD L IO,YD,ADRS DEVICE ADDRESS
 L IO,MDR,DA+CS OUTPUT DATA
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
*
* READ DATA
RDR L IO,YD,ADRS DEVICE ADDRESS
 L YS,IO,DR INPUT DATA
 D P2J GO
*
RD L IO,YD,ADRS DEVICE ADDRESS
 L MDR,IO,DR+CS INPUT DATA
 C MW STORE
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
*
* ACKNOWLEDGE INTERRUPT/SENSE STATUS
AIR L YD,IO,ACK INPUT DEVICE ADRS
SSR L IO,YD,ADRS DEVICE ADDRESS
 L YS,IO,STAT INPUT STATUS
 L FLR,YS,NC COPY TO FLR
 D P2J GO
*
AI L YD,IO,ACK INPUT DEVICE ADRS
SS L IO,YD,ADRS DEVICE ADDRESS
 L MDR,IO,STAT+CS INPUT STATUS
 C MW STORE
 L FLR,MDR,CS+NC COPY TO FLR
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
*
* OUTPUT COMMAND
OCR L IO,YD,ADRS DEVICE ADDRESS
 L IO,YS,CMD OUTPUT COMMAND
 D P2J GO
*
OC L IO,YD,ADRS DEVICE ADDRESS
 L IO,MDR,CMD+CS OUTPUT COMMAND
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
*
* AUTOLOAD
AL L SRH,MAR END ADRS
 L MAR,X'78' BINDV SPECIFICATION
 C MR
 L SRL,MDR,CS
 L IO,SRL,ADRS DEVICE ADDRESS
 L IO,MDR,CMD OUTPUT COMMAND
 L MAR,X'80' START ADRS TO MAR
*
INAL L FLR,IO,STAT STATUS CHECK
 B VGL,END BAD STATUS
 B C,INAL JUST BUSY
 L SRL,IO,DR READ CHARACTER
 O SRL,SRL,NA
 B CVGL,INFST NON-ZERO
 L RAL,L(INAL) SKIP LEADER
*
INFST C MR FETCH HALFWORD
 L MDR,SRL,CS INSERT DATA BYTE
 C MW RESTORE
 L AR,1
 A MAR,MAR,NC BUMP ADDRESS
 L AR,MAR
 S AR,SRH,CO COMPARE TO FINAL
 B C,EXIT DONE
*
LOOPIN L FLR,IO,STAT
 B VGL,END BAD STATUS
 B C,LOOPIN JUST BUSY
 L SRL,IO,DR
 L RAL,L(INFST) LOOP
*
EXIT L FLR,0 CLEAR FLAGS
END L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
*
* SHORT FORM IMMEDIATES
*
* LOAD IMMEDIATE SHORT
LIS L AR,X'F' MASK TO AR
 N YD,IR LOAD
 D P2J GO
*
* LOAD COMPLEMENT SHORT
LCS L AR,IR
 N AR,X'F' VALUE TO AR
 S YD,NULL,NC 2'S COMP & LOAD
 D P2J GO
*
* ADD IMMEDIATE SHORT
AIS L AR,IR
 N AR,X'F' VALUE TO AR
 A YD,YD EXECUTE ADD
 D P2J GO
*
* SUBTRACT IMMEDIATE SHORT
SIS L AR,IR
 N AR,X'F' VALUE TO AR
 S YD,YD EXECUTE SUBTRACT
 D P2J GO
 ORG X'200'
*
* WRITE BLOCK/READ BLOCK
*
WBR C SUT QUEUE WRITE
RBR L SRH,YS START ADRS
 L AR,1
 A IR,IR
 L MDR,YS END ADRS
 L RAL,L(COMBK)
*
WB C SUT QUEUE WRITE
RB L SRH,MDR START ADRS
 L AR,2
 A MAR,MAR
 C MR
*
COMBK L MAR,SRH START ADRS TO MAR
 L AR,SRH
 S SRH,MDR END MINUS START
 B C,FINIS END LESS THAN START
 L AR,1
 L IO,YD,ADRS ADDRESS DEVICE
 T UT
 B L,STATRB READ BLOCK
*
* WRITE BLOCK
LOOPW C MR
STATWB L FLR,IO,STAT
 B CVGL,TESTW
 L IO,MDR,DA+CS
 S SRH,SRH DECREMENT COUNT
 B C,FINIS DONE
 A MAR,MAR,NC INCREMENT ADRS
 L RAL,L(LOOPW)
*
TESTW B VGL,FIN BAD STATUS
 L RAL,L(STATWB) JUST BUSY
*
* READ BLOCK
LOOPR S SRH,SRH DECREMENT COUNT
 B C,FINIS DONE
 A MAR,MAR,NC INCREMENT ADRS
STATRB C MR FETCH HALFWORD
STATR1 L FLR,IO,STAT
 B CVGL,TESTR
 L MDR,IO,DR+CS INSERT BYTE
 C MW RESTORE HALFWORD
 L RAL,L(LOOPR)
*
TESTR B VGL,FIN BAD STATUS
 L RAL,L(STATR1) JUST BUSY
*
FINIS L FLR,0 CLEAR FLAGS
FIN L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
*
* MULTIPLY HALFWORD
MH L AR,MDR 2ND OP TO AR
MHR C SB
 L FLR,2
 O MR2,NULL MULTIPLIER TO MR2
 B G,MH1 IS POSITIVE
* MULTIPLIER NEGATIVE
 S MR2,NULL,NC 2'S COMP
 O SRL,YDP1,NA
 B G,MH2 MULTIPLICAND IS POSITIVE
 L AR,SRL
 S SRL,NULL,NC 2'S COMP
* MULTIPLY, LIKE SIGNS
MH3 L SRH,0 CLEAR HI PRODUCT
 L AR,MR2
 C MPY DO MULTIPLY
 L YD,SRH,SR LOAD HI PRODUCT
 L YDP1,SRL,SR+CI LOAD LO PRODUCT
 L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
MH1 O SRL,YDP1,NA
 B G,MH3 POSITIVE MULTIPLICAND
 L AR,SRL
 S SRL,NULL,NC 2'S COMP
* MULTIPLY, UNLIKE SIGNS
MH2 L SRH,0 CLEAR HI PRODUCT
 L AR,MR2
 C MPY DO MULTIPLY
 L YD,SRH,SR HI PRODUCT
 L AR,SRL,SR+CI
 S YDP1,NULL,CO 2'S COMP PRODUCT
 L AR,YD,NC
 S YD,NULL,CI
 L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
*MULTIPLY HALFWORD UNSIGNED
MHU L AR,MDR 2ND OP TO AR
MHUR L SRL,YDP1 1ST OP TO SRL
 L SRH,0 CLEAR HI PRODUCT
 C MPY
 L YD,SRH,SR LOAD HI PRODUCT
 L YDP1,SRL,SR LOAD LO PRODUCT
 L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
* DIVIDE HALFWORD
DH L AR,MDR DIVISOR TO AR
DHR C SUT+SB
 O MR2,NULL LOAD MR2, TEST SIGN
 B L,OKDIV NEGATIVE DIVISOR
 B G,COMSOR POSITIVE
* DIVISOR IS ZERO
* CHECK DIVIDE FAULT ENABLE
OVDIV C CB
 L RAH,H(GENSWP)
 L MAR,L(ODPSW)
 L SRL,PSW,SR+NC
 L FLR,SRL,CS+NC TEST PSW 03
 B C,L(GENSWP) DO SWAP
 L RAL,L(P3EXIT)
*
COMSOR S MR2,NULL,NC 2'S COMP DIVISOR
 C CUT
 L SRL,YDP1 LOAD DIVIDEND
 O SRH,YD,NA TEST SIGN
 B G,DIVQP QUOTIENT WILL BE PLUS
 L AR,SRL
 S SRL,NULL,CO 2'S COMP DIVIDEND
 L AR,SRH,NC
 S SRH,NULL,CI
DIVQM C TUT
 L AR,MR2
 A MR2,SRH TRIAL SUBTRACT
 B C,OVDIV OVERFLOW
 C DIV DO DIVIDE
 L AR,SRL
 S SRL,NULL,NC 2'S COMP QUOTIENT
 B L,BCKDV OK
 B CVGL,FIX
*
OKDIV L SRL,YDP1 LOAD DIVIDEND
 O SRH,YD,NA TEST SIGN
 B G,DIVQM QUOTIENT WILL BE MINUS
 L AR,SRL
 S SRL,NULL,CO 2'S COMP DIVIDEND
 L AR,SRH,NC
 S SRH,NULL,CI
DIVQP L AR,MR2
 A MR2,SRH TRIAL SUBTRACT
 B C,OVDIV OVERFLOW
 C DIV DO DIVIDE
 O SRL,SRL,NA TEST SIGN
 B L,OVDIV OVERFLOW
*
BCKDV T UT MAKE REMAINDER SIGN
 B L,EXDIV SAME AS DIVIDEND SIGN
 L AR,SRH
 S SRH,NULL,NC 2'S COMP
EXDIV L YD,SRH LOAD REMAINDER
 L YDP1,SRL LOAD QUOTIENT
 L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
* SHORT BRANCHES
*
* BRANCH ON FALSE CONDITION FORWARD OR REVERSE
BFFR T MSK
 B G,NRSB NO BRANCH
DOFRB L AR,2
 S LOC,LOC POINT TO HERE
 L AR,IR,SL
 N AR,X'1E' DISPLACEMENT TO AR
 L FLR,IR,CS OP DOWN
 B L,FRWD FORWARD
* BACKWARD
 S LOC,LOC,NC DECREMENT LOC
 D P2N GO
*
FRWD A LOC,LOC,NC INCREMENT LOC
 D P2N GO
* BRANCH ON TRUE CONDITION FORWARD OR REVERSE
BTFR T MSK
 B G,DOFRB DO BRANCH
NRSB D P2N NO BRANCH, G
BTBS EQU BTFR
BTFS EQU BTFR
BFBS EQU BFFR
BFFS EQU BFFR
*
* FLOATING POINT INSTRUCTIONS
*
* FLOATING POINT STORE
STE L AR,IR4,SL+NC
 L SRH,MAR SAVE STORE ADRS
 N MAR,X'1C'
 C MR FETCH HI 1ST OP
 L AR,MAR
 L MAR,SRH
 C MW STORE HI
 A MAR,2
 C MR FETCH LO 1ST OP
 L AR,SRH
 A MAR,2
 C MW STORE LO
 L MAR,LOC ADRS NEXT INSTR
 D P2N GO
*
* FLOATING POINT LOAD
LER L AR,IR,SL
 N MAR,X'1C' ADRS 2ND OP
 C MR
*
LE L RAH,H(NRMAL)
 L AR,IR,SR+NC
 N IR,X'70' MASK YD FIELD
 L AR,X'FF'
 N SRH,MDR HI 2ND OP
 L AR,SRH
 X SRL,MDR,NF EXPONENT & SIGN
 L AR,SRL,SL+CO SIGN TO CARRY
 L IR,IR,SL+CI SIGN TI IR15
 O IR,IR,NF EXPONENT TO IR
 L AR,MAR
 A MAR,2
 C MR+SB
 O SRL,MDR,NA LOAD LO 2ND OP
 B GL,L(NRMAL) MORMALIZE
* OPERAND ZERO, CLEAR & TERMINATE
 C CB
 L RAL,L(ZRORST)
*
*
SER C SUT
COMFRR L AR,IR,SL
 N MAR,X'1C' ADRS 2ND OP
 C MR+TUT
*
SE C TUT
COMFRX L SRH,MDR LOAD HI 2ND OP
 L RAH,H(BREAK)
 L AR,2
 A MAR,MAR,NC
 C MR+SB FETCH LO 2ND OP
 L AR,IR4,SL+NC
 L SRL,MDR SRH,SRL=2ND OP
 N MAR,X'1C'
 C MR FETCH HI 1ST OP
 L AR,2
 L MR0,MDR
 A MAR,MAR,NC
 C MR FETCH LO 1ST OP
 L AR,SRH
 L MR1,MDR MR0,MR1=1ST OP
 X AR,MR0 COMPARE SIGNS
 B G,L(BREAK) SIGNS ALIKE
 C TUT SIGNS DIFFER
*
 L FLR,IR,CS TEST OP
 B V,L(MEDE) MULTIPLY OR DIVIDE
 B G,L(AESE) ADD OR SUBTRACT
*
* FLOATING POINT COMPARE
 C CB
 L RAH,H(COMP)
COMP L AR,MR0,SL+CO ASSIGN TO CARRY
 T UT
 B L,ALIKE SIGNS ALIKE
*
* SIGNS DIFFER, SET GL & EXIT
 O AR,MR0,NA+NC
 L RAL,L(CEXIT)
*
* SIGNS ALIKE, SUBTRACT TO COMPARE MAGNITUDES
ALIKE B C,COMPEM 2'S COMP IF NEGATIVE
 B CVGL,COMPR
*
*
COMPEM C SB
 L AR,MR1 2'S COMP
 S MR1,NULL,CO BOTH OPERANDS
 L AR,MR0,NC
 S MR0,NULL,CI
 L AR,SRL
 S SRL,NULL,CO
 L AR,SRH,NC
 S SRH,NULL,CI
*
COMPR L FLR,0
 L AR,SRL LO 2ND OP
 S AR,MR1,CO FROM LO 1ST OP
 L AR,SRH,NC HI 2ND OP
 S AR,MR0 FROM HI 1ST OP
CEXIT L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
AER EQU COMFRR
AE EQU COMFRX
CER EQU COMFRR
CE EQU COMFRX
MER EQU COMFRR
ME EQU COMFRX
DER EQU COMFRR
DE EQU COMFRX
*
* JJ PATCH
FIX L FLR,0
 O SRL,SRL,NA
 B G,OVDIV
 B CTR,BCKDV
 ORG X'300'
*
BREAK L FLR,IR,CS
 B V,MEDE MULTIPLY OR DIVIDE
 B G,AESE ADD OR SUBTRACT
 C CB
 L RAH,H(COMP)
 L RAL,L(COMP) COMPARE
*
* FLOATING POINT ADD & SUBTRACT
AESE L MR2,MR0,SL+NC 1ST OP SIGN OUT
 L AR,SRL
 S AR,MR1 1ST OP MINUS 2ND OP
 L AR,SRH,SL+NC
 S AR,MR2
 B C,BGTRA B GREATER THAN A
* B EQUAL TO OR LESS THAN A
 B CTR,CONT
 DC 0 FILLER
*
BGTRA L MR2,IR,CS
 L MR2,MR2,SR+CO
 L AR,NULL,SR+CI 0000 IF ADD, 8000 IF SUB
* SWAP OPERANDS SO MR0,1 > SRH,SRL
 L MR2,MR1
 L MR1,SRL
 L SRL,MR2
 L MR2,MR0
 X MR0,SRH,NF
 L SRH,MR2
*
CONT L AR,IR,SR
 N MDR,X'70' MASK YD FIELD
 L AR,MR0,CS HI EXPONENT
 N MR2,X'7F' STRIP SIGN
 L MDR,MR2,CS
 L AR,MR0,SL+CO TO IR 0:6
 L IR,MDR,SL+CI RESULT SIGN TO IR15
*
 L AR,SRH,CS LO EXPONENT
 N AR,X'7F'
 L FLR,0
 S MDR,MR2 EXPONENT DIFFERENCE
 L AR,X'FF'
 N MR0,MR0,NF REMOVE
 N SRH,SRH,NF EXPONENTS
 B G,EQENT EXPONENTS DIFFER
* EXPONENTS ALIKE
EXFUNC L AR,SRL
 T UT CHECK OPERATOR
 B L,EXADD SUM REQUIRED
* DIFFERENCE REQUIRED
EXSUB L FLR,0
 S SRL,MR1
 L AR,SRH,NC
 S SRH,MR0
 B G,NRMAL RESULT NOT ZERO
 B CTR,ZRORST
*
EQENT L AR,6
 L CTR,MDR EXPONENT DIFFERENCE
 S MDR,MDR TEST
 B L,EQULIZ SOME SIGNIFICANCE
 L SRH,0 WOULD LOSE
 L SRL,0 SIGNIFICANCE
 L CTR,X'26' SO SET TO ZERO
*
EQULIZ C SR1 SHIFT SMALLER NUMBER
 C SR1 RIGHT
 C SR1
 C SR1
 B CTR,EQULIZ
* EXPONENTS EQUALIZED
 L AR,SRL
 T UT TEST OPERATOR
 B G,EXSUB DIFFERENCE REQUIRED
* SUM REQUIRED
EXADD L FLR,0
 A SRL,MR1
 L AR,SRH,NC
 A SRH,MR0
 B G,CRYTST RESULT NOT ZERO
 B CTR,ZRORST  
*
* NORMALIZE
NRMAL L MR2,0 SET COUNT = 0
NRLOOP L AR,X'F0'
 L FLR,0
 N AR,SRH TEST MS DIGIT
 B G,NRMFIN DONE
 L AR,2
 A MR2,MR2 BUMP COUNT
 C SL1
 C SL1
 C SL1
 C SL1
 B CVGL,NRLOOP
*
NRMFIN L AR,MR2,CS
 S IR,IR DECREMENT EXPONENT
 B C,EXPUF EXPONENT UNDERFLOW
 B CVGL,FEND
*
* FLOATING POINT MULTIPLY & DIVIDE
*
MEDE L AR,X'FF'
 L FLR,0
 N MR2,SRH CHECK 2ND OP
 B GL,CFOP
* SECOND OP IS ZERO
 L FLR,IR,CS TEST OP
 B L,DFAULT DIVIDE FAULT
 B CTR,MDCLR ZERO
*
CFOP L FLR,0
 N MR2,MR0 CHECK 1ST OP
 B GL,EXPON NOT ZERO
 B CTR,MDCLR ZERO
*
EXPON L MR2,MR0,SL+NC 2 * EXPONENTS
 L MDR,SRH,SL+NC
 N MR0,MR0 MASK OUT
 N SRH,SRH EXPONENTS
 L MAR,X'FE'
 L AR,MAR,CS X'FE00'
 N MR2,MR2 JUST EXPONENTS
 N MDR,MDR
 L IR,IR,SR+NC
 L FLR,8
 T UT MOVE SIGN FROM UT
 B G,CTEST TO IR15
 L FLR,0
CTEST L IR,IR,SL+CI
 L FLR,IR,CS TEST OP
 L MAR,NULL,SR+CI X'8000'
 L AR,MAR
 X MR2,MR2,NF+NC CONVERT EXPONENTS
 X MDR,MDR,NF+NC TO 2'S COMPLEMENT
 L AR,IR,NC
 N IR,X'E1' STRIP OP CODE
 L AR,MDR,NC 2ND OP EXPONENT
 B L,CFDIV DO DIVIDE
*
* MULTIPLY, ADD EXPONENTS
*
 L FLR,0
 A AR,MR2
 B V,WRONG OVERFLOW OR UNDERFLOW
 A AR,MAR,NC BACK TO EXCESS 64
 O IR,IR
 L MR2,SRL
 L SRL,SRH
 L SRH,0
 L MR0,MR0,CS
 L AR,MR1,CS
 N AR,X'FF'
 O MR0,MR0
 L MR1,MR1,CS
 X MR1,MR1
 L CTR,X'18' COUNT=24
*
MPYLP C SR1+CI+CO SHIFT MULTIPLIER
 L MR2,MR2,SR
 B C,ONE MULTIPLIER BIT SET
 B CTR,MPYLP
 B CVGL,MEND
*
ONE L AR,MR1 ADD MULTIPLICAND
 A SRL,SRL,CO TO PRODUCT
 L AR,MR0,NC
 A SRH,SRH
 B CTR,MPYLP
*
MEND C SR1+CI FINAL SHIFT
 L MR2,X'F0'
 L AR,MR2,CS
 L FLR,0
 L CTR,8
 N MR2,SRH TEST IF NORMALIZED
 B GL,FINAL YES
 L MR2,2
 L AR,MR2,CS
 S IR,IR DECREMENT EXPONENT
 B C,EXPUF EXPONENT UNDERFLOW
 L CTR,4
*
FINAL C RPT
 C SR1+CO FOUR OR EIGHT
ROUND A SRL,SRL,NA AND ROUND
 A SRH,SRH,NA
*
* TEST FOR CARRY
*
CRYTST L FLR,SRH,CS
 B CVGL,RTSHFT DID CARRY
 B CTR,FEND NO CARRY, EXIT
*
* FLOATING POINT DIVIDE
*
CFDIV L FLR,0
 S AR,MR2 SUBTRACT EXPONENTS
 B V,WRONG
 A AR,MAR,NC BACK TO EXCESS 64
 O IR,IR
*
* RESULT EXPONENT ESTABLISHED, CONTINUE DIVIDE
*
 L MR2,MR1
 L AR,SRL 2'S COMP
 S MR1,NULL,CO DIVISOR
 L SRL,MR2,NC
 L MR2,MR0,NC
 L AR,SRH,NC
 S MR0,NULL,CI
 L SRH,MR2
 L AR,SRL
 A MDR,MR1,CO
 L AR,SRH,NC
 A MR2,MR0
 B C,ADJST
 B CVGL,FSTRT
*
ADJST L MR2,2
 L AR,MR2,CS
 A IR,IR INCREMENT EXPONENT
 B C,EXPOF OVERFLOW
 L CTR,4 SHIFT DIVISOR LEFT
ADJLP L MR1,MR1,SL+CO ONE HEX POSITION
 L MR0,MR0,SL+CI
 B CTR,ADJLP
*
FSTRT L MR2,0 CLEAR
 L MDR,0 QUOTIENT
 L CTR,X'1A' COUNT=26
*
FDVLP L AR,SRL
 A MAR,MR1,CO
 L AR,SRH,NC
 A AR,MR0
 B C,QUOT
 B CVGL,SHFT
*
QUOT O SRH,NULL,NC
 L SRL,MAR,NC
*
SHFT L MDR,MDR,SL
 L MR2,MR2,SL
 C SL1+CI
 B CTR,FDVLP
*
 L SRH,MR2,SR+CO
 L SRL,MDR,SR
 B CVGL,ROUND
*
RTSHFT L CTR,4
 C RPT
 C SR1
 L MR2,2
 L AR,MR2,CS
 A IR,IR,CO INCREMENT EXPONENT
 B C,EXPOF
*
* COMMON FLOATING POINT EXIT
*
FEND C SB
 L AR,IR,SR+CO SIGN TO CARRY
 L AR,IR,SR+CI SIGN & EXPONENT
 L MR2,X'FF'
 L MR2,MR2,CS X'FF00'
 N AR,MR2 MASK
 O SRH,SRH,NF INSERT OVER FRACTION
 L AR,IR4,SL
 A MAR,2
 L FLR,IR,SR+NC
 O MDR,SRL,NA
 C PW STORE LO RESULT
 L MAR,IR4,SL+NC
 O MDR,SRH,NA
 C PW+CB STORE HI RESULT
DFAULT D JAM FLR TO CC
 B V,FFAULT
 L MAR,LOC,NC ADRS NEXT INSTR
 D P2J GO
*
WRONG B L,EXPOF EXPONENT OVERFLOW
*
* EXPONENT UNDERFLOW
EXPUF L AR,8
 O IR,IR SET V FLAG QUEUE
*
ZRORST L AR,X'EE'
CCLR N IR,IR RESET EXPONENT & SIGN
 L SRH,NULL CLEAR HI
 L SRL,NULL AND LO RESULT
 B CTR,FEND
*
* EXPONENT OVERFLOW
EXPOF L SRH,X'FF' HIGH RESULT = X'FF'
 L AR,SRH,CS
 O SRL,SRH LO RESULT= X'FFFF'
 O AR,8 EXPONENT = X'FF'
 O IR,IR SET V FLAG QUEUE
 B CVGL,FEND
*
FFAULT D CLR
 L RAH,H(FLPENB) FLOATING POINT
 L RAL,L(FLPENB) ARITHMETIC FAULT
*
MDCLR L AR,X'E0' CLEAR V FLAG QUEUE
 B CTR,CCLR
 ORG X'400'
*
* HALFWORD I/O
*
* WRITE HALFWORD
WHR L MDR,YS DATA
WH L MAR,LOC ADRS NEXT INSTR
 L IO,YD ADRS ADDRESS DEVICE
 L IO,MDR,DA+CS OUTPUT HI
 L IO,MDR,DA OUTPUT LO
 D P2J GO
 D P2J GO
*
* READ HALFWORD
RHR L IO,YD,ADRS DEVICE ADDRESS
 L YS,IO,DR+CS INPUT HI
 L AR,IO,DR INPUT LO
 O YS,YS,NF COMBINE
 D P2J GO
 DC 0 FILLER
 DC 0 FILLER
RH L IO,YD,ADRS DEVICE ADDRESS
 L SRH,IO,DR+CS INPUT HI
 L AR,IO,DR INPUT LO
 O SRH,SRH,NF COMBINE
 L MDR,SRH
 C MW STORE
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
*
* FULLWORD SHIFTS & ROTATES
*
* SHIFT RIGHT LOGICAL FULLWORD
SRL L SRH,YD FETCH HI
 L SRL,YDP1 FETCH LO
 L CTR,MDR LOAD COUNTER
 C RPT
 C SR1+CO DO SHIFT
 O YDP1,SRL,NA+NC LOAD LO
 O YD,SRH,NA+NC LOAD HI
 D P2J
*
* SHIFT LEFT LOGICAL FULLWORD
SLL L SRH,YD FETCH HI
 L SRL,YDP1 FETCH LO
 L CTR,MDR LOAD COUNTER
 C RPT
 C SL1+CO DO SHIFT
 O YDP1,SRL,NA+NC LOAD LO
 O YD,SRH,NA+NC LOAD HI
 D P2J GO
*
* SHIFT RIGHT FULLWORD ARITHMETIC
SRA L SRL,YDP1,SL+CO
 L SRH,YD,SL LOAD HI
 L CTR,MDR,NC
 C RPT
 C SR1+CI DO SHIFT
 C SR1+CI+CO COMPENSATE PRESHIFT
 O YDP1,SRL,NA+NC LOAD LO
 O YD,SRH,NA+NC LOAD HI
 D P2J GO
*
* SHIFT LEFT FULLWORD ARITHMETIC
SLA L SRL,YDP1,SL+CO FETCH LO
 L SRH,YD,SL FETCH HI & SIGN TO CARRY
 L CTR,MDR,NC LOAD CTR
 L AR,NULL,SR SAVE SIGN
 C RPT
 C SL1+CO DO SHIFT
 C SR1 COMPENSATE PRESHIFT
 O YDP1,SRL,NA+NC LOAD LO
 O YD,SRH,NC LOAD HI, INSERT SIGN
 D P2J GO
*
* ROTATE RIGHT LOGICAL FULLWORD
RRL L SRH,YD FETCH HI
 L SRL,YDP1 FETCH LO
 L AR,X'1F'
 N CTR,MDR LOAD & TEST CTR
 B G,RRL1
 L RAL,L(RRX) CTR=0
RRL1 L FLR,0
RRLL L AR,SRL,SR+CO LSB TO CARRY
 C SR1+CI+CO DO ROTATE
 B CTR,RRLL
RRX O YDP1,SRL,NA LOAD LO
 O YD,SRH,NA+NC LOAD HI
 D P2J GO
*
* ROTATE LEFT LOGICAL FULLWORD
RLL L SRH,YD FETCH HI
 L SRL,YDP1 FETCH LO
 L AR,X'1F'
 N CTR,MDR LOAD & TEST CTR
 B G,RLL1
 L RAL,L(RLX) CTR=0
RLL1 L FLR,0
RLLL L AR,SRH,SL+CO MSB TO CARRY
 C SL1+CI+CO DO ROTATE
 B CTR,RLLL
RLX O YDP1,SRL,NA LOAD LO
 O YD,SRH,NA+NC LOAD HI
 D P2J GO
*
* REMOVE FROM TOP/BOTTOM OF LIST
*
RTBL L SRL,1
 L AR,SRL,CS X'0100'
 L SRH,MDR,CS NO. USED/MAX. SLOT
 S SRH,SRH DECREMENT NO. USED TALLY
 B C,VFLAG LIST EMPTY (UNDERFLOW)
* LIST NOT EMPTY
 L SRH,SRH,CS
 L MDR,SRH
 C MW+SB RESTORE
 L AR,SRL,CS
 S SRH,SRH DECREMENT MAX. SLOT
 L AR,2
 A MAR,MAR,NC
 A MR0,MAR,NC ADRS OF SLOT 0
 C MR CUR. TOP/NEXT BOTTOM
 L AR,IR,CS OP-CODE DOWN
 N AR,1
 O MAR,MAR FORCE ODD IF RBL
 L AR,MDR,CS GET POINTER
 N MR1,X'FF' CUR. TOP IF RTL
 L AR,MAR,SR+CO NEXT BOTTOM IF RBL
 L AR,1
 B C,RBL REMOVE FROM BOTTOM
* REMOVE FROM TOP
 A MR2,MR1 INCREMENT CURRENT TOP
 L AR,SRH,CS
 N AR,X'FF'
 L FLR,0
 X AR,MR1 COMPARE TO MAX
 B G,RTL
* TABLE WRAP; SET CURRENT TOP TO ZERO
 L MR2,0
RTL L AR,MR1,SL+NC USE OLD VALUE
 C CB
 L RAL,L(REMOV)
*
* REMOVE FROM BOTTOM
RBL S MR2,MR1,CO DECREMENT NEXT BOTTOM
 B C,UNDER WRAP
 B CVGL,RBL1 NO WRAP
*
UNDER L AR,SRH,CS
 N MR2,X'FF' SET TO MAX
RBL1 L AR,MR2,SL+NC USE NEW VALUE
*
REMOV L MDR,MR2,CS RESTORE UPDATED
 C MW+CB POINTER
 L FLR,0
 A MAR,MR0,NF+NC SLOT ADRS
 C MR FETCH ELEMENT
 L AR,X'FF'
 N AR,SRH TEST NO. USED TALLY
 L YD,MDR LOAD ELEMENT
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
*
VFLAG L FLR,4 SET OVERFLOW
 L MAR,LOC ADRS NEXT INSTR
 D P2J GO
*
* SUPERVISOR CALL
*
SVC L MAR,X'94'
 C PW STORE PARAMETER A+(X2)
 L MAR,X'96'
 L MDR,PSW
 C PW STORE STATUS
 L AR,IR4,SL+NC
 L MAR,X'98'
 L MDR,LOC
 C PW STORE LOCCNT
 N AR,X'1E' 2*R1 FIELD
 L MAR,X'9A'
 C MR
 L PSW,MDR,NC NEW STATUS
 A MAR,X'9C' 2*R1 FIELD + X'9C'
 D MR+JAM FETCH NEW LOC, LOAD CC
 L LOC,MDR
 D P2N GO
 ORG X'500'
*
* INTERRUPT SERVICE BLOCK PROCESSING
*
ISBSVC C MR+SB FETCH FUNCTION WORD
 L MR0,MAR,SR+NC ISB ADRS
 L MR0,MR0,SL+NC FORCED EVEN
 L SRH,SRH,CS DEVICE NUMBER
 L IR,MDR
 L IR,IR,CS
 A MAR,MR0,NC
 L FLR,IR4,NC
 B CVG,NIO1 INIT+NOP+NULL+DMT
*
* READ OR WRITE
SVC1 C MR+SB FETCH START ADRS
 A MAR,MAR,NC
 L IO,SRH,ADRS+CS ADDRESS THE DEVICE
 L MR2,MDR SAVE START ADRS
 L AR,IO,STAT
 O SRH,SRH DEVNO/STATUS
 C MR FETCH FINAL ADRS
 L AR,IR,CS NO. BYTES/INTERRUPT
 N CTR,X'0F'
 L FLR,IR,CS
 B CVGL,SVC2
 L CTR,X'10' 16 LIMIT
SVC2 L FLR,SRH,NC TEST STATUS
 B CVGL,BSTAT BAD STATUS
* STATUS CLEAR
 L MR1,MDR FINAL ADDRESS
 L MAR,MR2 START ADDRESS
 L AR,1
 L FLR,IR4 TEST FUNCTION
 B L,WRITE
*
READ C MR
 L MR2,IO,DR READ DATA
 L MDR,MR2,CS INSERT BYTE
 C PW STORE IT
 A MAR,MAR,NC INCREMENT ADRS
 B CTR,READ
*
END1 L MDR,MAR INCREMENTED START ADRS
 L AR,2
 A MAR,MR0
 C PW+CB RESTORE
 L AR,MDR
 S AR,MR1 COMPARE START:FINAL
 B C,TERM1 DONE
*
 L FLR,IR
 B V,TCHAR
*
END3 T UT TEST QUEUE FLAG
 B G,FLAGS
* NO USER INTERRUPT QUEUED
 D CLR
 L RAH,H(TEST4)
 L RAL,L(TEST4)
 ORG X'533'
*
WRITE C MR
 L IO,MDR,DA+CS OUTPUT BYTE
 L MR2,MDR,CS
 A MAR,MAR,NC INCREMENT ADRS
 B CTR,WRITE
 B CVGL,END1
*
NIO1 C CB
 B V,END3 NOP
 B C,NIO2 INIT
*
NIO3 L IR,IR,CS
 B L,TERM2 NULL
*
* DECREMENT MEMORY & TEST
 C MR+SB FETCH COUNT
 L FLR,0
 L AR,1
 S MDR,MDR DECREMENT
 C PW+CB RESTORE
 B GL,END3 NOT ZERO
* COUNT IS ZERO
 L RAL,L(TERM2)
*
NIO2 L IR,IR,CS
 L IR,IR,SL+NC RESET INIT
 L IR,IR,SR+NC
 L MAR,MR0
 L MDR,IR
 C PW RESTORE
 L FLR,IR4,NC TEST FUNCTION BIT 8
 B C,OC1 OUTPUT COMMAND
 L IR,IR,CS
 A MAR,MAR,NC
 L FLR,IR4 TEST FUNCTION BIT 2
 B G,NIO3 DMT OR NULL
 B CTR,SVC1
*
BSTAT L AR,X'C3' SET INIT, NOP, QUEUE
 O AR,IR
 X IR,1 CLEAR HI/LO
 L AR,IR,CS
 O AR,X'30'
 X IR,X'30' RESET CHAIN & DO IT
 B CVGL,TERM4
*
OC1 L AR,6
 A MAR,MR0,NC
 C MR+CB FETCH COMMAND BYTE
 L IO,SRH,ADRS+CS ADDRESS THE DEVICE
 L IO,MDR,CMD+CS OUTPUT COMMAND
 L RAL,L(END3)
*
FLAGS L FLR,PSW,CS TEST PSW06
 L RAH,H(GENSWP)
 L MAR,X'82'
 B G,L(GENSWP)
 T ATN+DC
 B G,L(P3HELP)
 L RAL,L(TEST2)
*
TCHAR L AR,6
 A MAR,MR0,NC
 C MR+CB
 L AR,X'FF'
 N SRL,MR2 LAST CHAR TRANSFERRED
 N AR,MDR TERMINAL CHARACTER
 L FLR,0
 X AR,SRL COMPARE
 B G,END3 NO MATCH
*
TERM1 L AR,IR
 O IR,X'40' SET NOP
 L IR,IR,CS
*
TERM4 L MDR,IR MODIFIED FUNCTION
 L MAR,MR0
 C PW RESTORE
TERM2 L AR,2
 S MAR,MR0
 L MDR,SRH
 C PW+CB STORE DEVNO/STATUS
*
 L FLR,IR,CS TEST FUNCTION BIT 6
 B G,QUEUE
*
TERM3 L FLR,IR4 TEST FUNCTION BIT 10
 B G,CHAIN
 L RAL,L(END3)
*
CHAIN L AR,4
 S MAR,MR0,NF+NC
 C MR+CB FETCH CHAIN VALUE
 L RAH,H(DOIT)
 L AR,SRH,CS
 N SRH,X'FF' DEVICE NO
 L AR,SRH,SL+NC
 A MAR,L(SPTABL) ADRS SERVICE POINTER
 C PW STORE NEW POINTER
 B L,L(DOIT) GO ON IF FUNCTION 11 SET
 L RAH,H(END3)
 L RAL,L(END3)
 DC 0 FILLER
 DC 0 FILLER
*
QUEUE L MAR,X'80'
 C MR+CB ADRS OF QUEUE
 L SRL,PSW SAVE PSW
 L PSW,0 FORCE SUPERVISOR MODE
 L MAR,MDR
 C MR+SUT SET QUEUE FLAG
*
* ADD TO TOP/BOTTOM OF LIST
*
ATBL L AR,MDR MAX SLOT/NO USED
 L SRH,MDR,CS NO USED/MAX SLOT
 S AR,SRH COMPARE
 B C,ADDTO
* OVERFLOW IF NO USED EQUAL OR GREATER
 T UT UT SET IF CHANNEL IO
 B G,LISTOV QUEUE OVERFLOW INTERRUPT
 L FLR,4 SET OVERFLOW
 L RAL,L(COMEX)
*
ADDTO A MDR,MDR,NA+CI INCREMENT NO USED TALLY
 C MW+SB RESTORE
 L AR,2
 A MAR,MAR,NC
 C MR CUR, TOP/NEXT BOTTOM
 L AR,IR,CS OP-CODE DOWN
 N AR,1
 O MAR,MAR FORCE ODD IF ABL
 L AR,MDR,CS GET POINTER
 N MR1,X'FF' CUR TOP IF ATL
 L AR,MAR,SR+CO NEXT BOTTOM IF ABL
 L AR,1
 B C,BOTTOM ADD TO BOTTOM
* ADD TO TOP
 S MR2,MR1,CO DECREMENT CUR TOP
 B C,ATL1 WRAP
 B CVGL,ATL
* LIST WRAP; SET CURRENT TOP TO MAX
ATL1 S AR,SRH,NA+CI MAX SLOT NUMBER
 N MR2,X'FF'
ATL L AR,MR2,SL+NC USE NEW VALUE
*
ADDIT L MDR,MR2,CS INSERT UPDATED
 C MW+CB POINTER & RESTORE
 A AR,MAR,NC
 A MAR,2 SLOT ADRS
 T UT UT SET IF CHANNEL IO
 B L,ALIST NOT SET IF CHANNEL IO
 L MDR,MR0 GET ELEMENT
 C PW STORE IT
 L AR,2
 S MAR,MR0
 C MR FETCH DEVNO/STATUS
 L PSW,SRL RESTORE PSW
 L SRH,MDR
 L RAL,L(TERM3) RETURN
*
ALIST L MDR,YD GET ELEMENT
 D MW+CLR STORE IT
*
COMEX L MAR,LOC ADRS NEXT INSTR
 D P2J GO
*
* ADD TO BOTTOM
BOTTOM A MR2,MR1,NC INCREMENT NEXT BOTTOM
 S AR,SRH,NC MAX SLOT NUMBER
 N AR,X'FF'
 L FLR,0
 X AR,MR1 COMPARE TO MAX
 B G,ABL
* LIST WRAP; SET NEXT BOTTOM TO ZERO
 L MR2,0
ABL L AR,MR1,SL+NC USE OLD VALUE
 B CTR,ADDIT
*
LISTOV L MAR,X'8A'
 L MDR,MR0
 D PW+CLR SAVE ABORTED ELEMENT
 L PSW,SRL RESTORE PSW
 L MAR,X'8C'
 L RAH,H(GENSWP)
 L RAL,L(GENSWP)
*
        END


0
BALR
BCTR
BFCR
NHR
CLHR
OHR
XHR
LHR
CHR
AHR
SHR
MHR
DHR
ACHR
SCHR

0(16)

BTBS
BTFS
BFBS
BFFS
LIS
LCS
AIS
SIS
LER
CER
AER
SER
MER
DER
0(2)

0(16)

STH
BAL
BTC
BFC
NH
CLH
OH
XH
LH
CH
AH
SH
MH
DH
ACH
SCH

0(16)

STE
AHM
0(2)
ATL
ABL
RTL
RBL
LE
CE
AE
SE
ME
DE
0(2)

0(16)

0(16)

SRLS
SLLS
STBR
LBR
EXBR
EPSR*
WBR*
RBR*
WHR*
RHR*
WDR*
RDR*
MHUR

SSR*
OCR*
AIR*

0(16)

0(16)

BXH
BXLE
LPSW*
THI
NHI
CLHI
OHI
XHI
LHI
CHI
AHI
SHI
SRHL
SLHL
SRHA
SLHA

STM
LM
STB
LB
CLB
AL*
WB*
RB*
WH*
RH*
WD*
RD*
MHU
SS*
OC*
AI*

0
SVC
SINT*
0(7)
RRL
RLL
SRL
SLL
SRA
SLA

0(16)