Trailing-Edge
-
PDP-10 Archives
-
BB-AS80B-SM_1985
-
sources/eis.mic
There are 5 other files named eis.mic in the archive. Click here to see a list.
.TOC "EXTENDED INSTRUCTION SET DECODING"
.IF/EXTEND
;GET HERE WITH E0 IN BR, (E0) IN AR
; (E0) IS THE OPERATION WORD, AND HAS THE NORMAL -10 INSTRUCTION
; FORMAT -- BITS 0-8 ARE OPCODE, 9-12 IGNORED, 13 @, 14-17 XR,
; AND 18-35 Y. THE AC USED COMES FROM THE EXTEND INSTRUCTION.
; COMPUTE E1 FROM 13-35
.IFNOT/XADDR
;EXTEND:FE_#+AR0-8,#/-32,SKP SCAD0, ;CHECK LEGAL OPERATION
; ARX_AR,AR_BRX ;OPR TO ARX, GET AC FROM BRX
=0
EXT1: AR_BR,J/UUO ;OPCODE > 17 or 31
.IF/MODEL.B ;[246]
AR0-8_FE+#,#/32 ;PLUG OPR INTO EXTEND AC
GEN AR,LOAD IR,AR_ARX
ARL_0.M,EA MOD DISP,J/EXT2
=1100
.IFNOT/MODEL.B ;[246]
AR0-8_FE+#,#/20 ;PLUG OPR INTO EXTEND AC
GEN AR,LOAD IR,AR_ARX,ARL_0.M,
EA MOD DISP
=00
.ENDIF/MODEL.B
EXT2: E1_AR,B DISP,J/EXT5 ;SAVE E1, READY TO SAVE E0
ARL_0.M,AR_ARX+XR,J/EXT2
GEN ARX,A INDRCT,SKP INTRPT,J/EXT3
GEN ARX+XR,A INDRCT,
SKP INTRPT,J/EXT3
=0
EXT3: AR_MEM,ARX_MEM,J/EXT4
AR_MEM,TAKE INTRPT
EXT4: ARL_0.M,EA MOD DISP,J/EXT2
=110
EXT5: AR_BR,J/EXT6 ;TRANSLATE MODE, DO NOT EXTEND
ARL_1S.M,SKP AR18 ;SIGN EXTEND E1 IF NEGATIVE
=0 AR_BR,J/EXT6 ;POS, ALREADY OK
E1_AR,AR_BR ;PUT NEG RESULT IN E1
EXT6: E0_AR,VMA_AR+1,IR DISP,J/2000 ;ENTER EXTENDED INSTR HANDLER
;HERE FOR EXTENDED INSTRUCTION SET DECODING UNDER XADDR
.IF/XADDR
;EXTEND: SC_#+AR0-8,#/-32,SKP SCAD0, ;VALID EXTENDED OPERATION?
; ARX_AR,AR_BR,J/EXTF1 ; OPR TO ARX, AC TO AR
=0
EXTF1: AR_BR,J/UUO ;Opcode is too large.
E0_AR,MQ_AR,AR_BRX ;SAVE E0. GET AC FROM EXTEND
AR0-8_#+SC,#/32,SC/SCAD ;COMBINE EXT OP <32 WITH AC
GEN SC,SKP SCAD NE ;TEST OP CODE
=0 AR_BR,J/UUO ;OP CODE = 0 (UUO) [217][251]
GEN AR,LOAD IR ;MAP THIS OVER THE LUUO SPACE
EXTF2: AR_ARX,EA MOD DISP,J/EXTLA ;GO EVALUATE E1
=0000
EXTXA: GEN ARX,GLOBAL,EXT INDRCT,SKP INTRPT,J/EXTI
GEN ARX+XR,GLOBAL,EXT INDRCT,SKP INTRPT,J/EXTI
GEN ARX,GLOBAL,EXT INDRCT,SKP INTRPT,J/EXTI
GEN ARX+XR,GLOBAL,EXT INDRCT,SKP INTRPT,J/EXTI
GEN ARX,GLOBAL,EXT INDEX,ARX/MQ,J/3077
GEN ARX+XR,GLOBAL,EXT INDEX,ARX/MQ,J/3077
GEN ARX,GLOBAL,EXT INDEX,ARX/MQ,J/3077
GEN ARX+XR,GLOBAL,EXT INDEX,ARX/MQ,J/3077
GET ECL EBUS,J/ILLIND ;[234] illegal indirect word
GET ECL EBUS,J/ILLIND ;[234] illegal indirect word
GET ECL EBUS,J/ILLIND ;[234] illegal indirect word
GET ECL EBUS,J/ILLIND ;[234] illegal indirect word
;
; [325]
; The effective address dispatch logic is quite arcane. It appears
; that MEM/A RD,DISP/DRAM A RD, and SH/2 interact to get the section
; number from either AD (if the AC > 777777) or from VMA section, but
; in order for that to work, we must do something with the VMA, even
; though we don't actually use it here if the address computation
; is complete. Thus the VMA/LOAD has been added for the index case.
;
EXTLA: GEN AR,EXT ADDR,ARX/MQ,J/EXT2
GEN AR+XR,INDEXED,EXT INDEX,ARX/MQ,VMA/LOAD,J/3077 ;[325]
GEN AR,EXT INDRCT,SKP INTRPT,J/EXTI
GEN AR+XR,INDEXED,EXT INDRCT,SKP INTRPT,J/EXTI
=0
EXTI: ARX_MEM,LONG EN,J/EXTI2
ARX_MEM,TAKE INTRPT
EXTI2: AR_ARX,XR,EA MOD DISP,
FE_#,#/24,TIME/3T,J/EXTXA
=010
EXT2: E1_AR,AR_ARX,VMA_ARX+1, ;ESTABLISH E1
IR DISP,J/2000 ;GO TO SPECIFIC HANDLER
ARL_0.M,SKP AR18,J/EXT3 ;OFFSET MODE. EXTEND E1
E1_AR,AR_ARX,VMA_ARX+1, ;[301] Duplicate these to
IR DISP,J/2000 ; distinguish GSNGL (B=5) from
E1_AR,AR_ARX,VMA_ARX+1, ; offset instructions (B=1)
IR DISP,J/2000
=0
EXT3: E1_AR,AR_ARX,VMA_ARX+1, ;ESTABLISH E1
IR DISP,J/2000 ;GO TO SPECIFIC HANDLER
ARL_1S,J/EXT3 ;NEGATIVE OFFSET
.ENDIF/XADDR
; By using "IR DISP,J/2000" we can use the same DRAM for LUUOs as
; for the EXTEND instructions with like opcodes. The LUUOs dispatch
; to addresses in the range 1000-1017; by dispatching with J/2000,
; the EXTEND ops go to 3000-3017 (model B) or 2000-20017 (model A).
.IFNOT/MODEL.B
2005: AR_AC3,J/CMPS ;HIDDEN BEHIND L-CMS
2006: CLR AR,ARX_1S,SC_#,#/15.,J/EDIT ;HIDDEN BEHIND L-EDIT
2010: AR_AC0 COMP,J/DBIN ;HIDDEN BEHIND L-DBIN
2011: AR_AC1,ARL/AD,SC_1,ARX+MQ_0.M,
BYTE DISP,J/BDEC ;HIDDEN BEHIND L-BDEC
2012: AR_AC3,LOAD AR,J/MVST ;HIDDEN BEHIND L-MVS
.IF/MODEL.B
.IFNOT/XADDR
3005: AR_AC3,J/CMPS ;HIDDEN BEHIND L-CMS
3006: CLR AR,ARX_1S,SC_#,#/15.,J/EDIT ;HIDDEN BEHIND L-EDIT
3010: AR_AC0 COMP,J/DBIN ;HIDDEN BEHIND L-DBIN
3011: AR_AC1,ARL/AD,SC_1,ARX+MQ_0.M,
BYTE DISP,J/BDEC ;HIDDEN BEHIND L-BDEC
3012: AR_AC3,LOAD AR,J/MVST ;HIDDEN BEHIND L-MVS
.IF/XADDR
.IFNOT/OWGBP ;[265]
3005: AR_AC3,J/CMPS ;HIDDEN BEHIND L-CMS
3006: CLR AR,ARX_1S,SC_#,#/15.,J/EDIT ;HIDDEN BEHIND L-EDIT
3010: AR_AC0 COMP,J/DBIN ;HIDDEN BEHIND L-DBIN
3011: AR_AC1,ARL/AD,SC_1,ARX+MQ_0.M,
BYTE DISP,J/BDEC ;HIDDEN BEHIND L-BDEC
3012: AR_AC3,LOAD AR,J/MVST ;HIDDEN BEHIND L-MVS
.IF/OWGBP ;[265]
;
; [347] CMPS dispatch rewritten to test bad high length bits first.
;
3005: AR_AC0,FE_#,#/777,CALL [FLGTST] ;[347] Any illegal high bits in len?
3025: FILL_AR,CALL [EXT2WD] ;[310][347] Save fill VMA, test OWG
3035: AR_AC3,MQ_ARX,J/CMPS ;[310][347] Get dest length and go
;
3006: J/EDIT ;HIDDEN BEHIND L-EDIT
3010: J/DBIN ;HIDDEN BEHIND L-DBIN
3011: AR_ARX+1 (AD),J/BDEC ;[344] HIDDEN BEHIND L-BDEC
;
3012: AR_AC0,FE_#,#/77,CALL [FLGTST] ;[347] MVST. Watch out for illegal
3032: LOAD AR,J/MVST ; flags first.
;
; Subroutine to check for bits set that are not allowed to be.
; Enter with AR containing AC0 and FE with relevant bit mask.
; Return 20 if none set; sideways exit to UUO if any are. Note
; that BRX must still contain the EXTEND for this to work.
;
FLGTST: AR_AC3,FE_FE AND AR0-8 ;[347] Get dest length
GEN FE OR AR0-8,SKP SCAD NZ ;[347] Are any high bits set?
=0 AR_ARX+1 (AD),RETURN20 ;[347] No. Start saving fill VMA
AR_BR,J/UUO ;[347] Yes. Blow out of the water
.ENDIF/OWGBP ;[265]
;3042: AR_BR,J/UUO ;[217] INDEXING ON ILL. EXTEND OP.
;
; As first written, locations 3044, 3045, 3046, 3050, 3051, 3052,
; 3144, 3145, 3146, 3147, 3150, 3151, 3152, 3153, and 3154 all were
; B DISP,J/EXT2. The comment: these are index cases because index
; must do AREAD with the DISP function in order to get the correct
; index value for E1.
;
3077: B DISP, J/EXT2 ;[251]
3177: B DISP, J/EXT2 ;[251]
.ENDIF/XADDR
.ENDIF/MODEL.B
.ENDIF/EXTEND
.TOC "ONE WORD GLOBAL BYTE POINTER SUBROUTINES FOR EXTEND"
;
; HERE FOR MVST, EDIT AND CMPS INSTRUCTIONS
; MUST CHECK BOTH AC1 AND AC4 FOR OWGBP
; AND CONVERT TO TWO WORD GLOBAL POINTERS.
; There is also a hack in here for the CMPSx instructions. In
; order to find their fill characters in the right place, we must
; fetch FILL (saved as E0+1) into ARX. [310]
; BDEC ENTERS AT EXT01 FOR AC4 ONLY
.IF/EXTEND
.IF/OWGBP ;[265]
=000
EXT2WD: AR_AC1,CALL [TST2WD] ;AC1 OWGBP ?
CALL [STR2WD] ;YES, CONVERT DONE, STORE
J/EXT01 ;NO, TRY AC4
AC2_AR,AR_BR OR ARX,J/EXT02 ;ADDRESS STORE
EXT01: AR_AC4,CALL [TST2WD] ;AC4 OWGBP ?
ARX_FILL,CALL [STR2WD] ;[310] YES, CONVERT DONE, STORE
ARX_FILL,RETURN10 ;[310][347] NO, CAN'T DO NO MORE
SEL DSTP2 ;[310] DON'T GLITCH ON AC5 STORE
AC5_AR,AR_BR OR ARX ; (See second edit #210)
ARX_BRX,SEL AC4 ;[310] RESTORE ARX AND SELECT AC4
AC4_AR,RETURN10 ;[347] P,S,BIT 12 = 1 TO AC4
EXT02: AC1_AR,J/EXT01 ;P,S,BIT 12 = 1 TO AC1
; HERE FOR DBIN
=00
DB2WD: AR_AC1,CALL [TST2WD] ;AC1 OWGBP ?
CALL [STR2WD] ;YES, CONVRT DONE, STORE
RETURN1 ;NO, GET OUT
AC1_AR,AR_BR OR ARX ;P,S,BIT 12 = 1 TO AC1
AC2_AR,RETURN1 ;ADDRESS TO AC2, DONE
; HERE TO TEST FOR OWGBP IN THE AR AND
; TO CONVERT IT IF IT'S OK
=00
TST2WD: SKP PC SEC0,CALL,J/GTST ;TEST FOR NOT SEC 0 AND OWGBP [266]
RET2: RETURN2 ;[260]NOT TODAY
CALL [CNV2WD] ;YES, CONVERT
MQ_BR,RETURN1 ;GET OUT
; HERE TO GET P,S,BIT 12 = 1 AND A GOOD ADDRESS
; SOME VERY TRICKY STUFF GOING ON HERE
STR2WD: [AR]_FM[EXPMSK], BR/AR,BRX/ARX ;[310] P,S,JUNK TO BR, SAVE ARX
ARX_AR ANDCA BR ;P,S,0 TO ARX
[AR]_[AR]-FM[ADMSK] ;BIT 12 = 1 TO AR
AR_[MQ] AND FM[ADMSK], ;0,ADDRESS TO AR
BR/AR,RETURN2 ;BIT 12=1 TO BR
.ENDIF/OWGBP ;[265]
.ENDIF/EXTEND
.TOC "EIS -- STRING MOVE"
.IF/EXTEND
; HERE FOR MOVE STRING, CHECK FOR OWGBP FIRST
;SLEN IS THE COMPLEMENT OF THE SHORTER STRING LENGTH
;DLEN IS <SRC LEN>-<DST LEN>
.IF/OWGBP
=0*0* ;[347]
MVST: AR_MEM,CALL [RET2] ;[260]GET FILL, WAIT FOR PARITY
FILL_AR,CALL [EXT2WD] ;SAVE FILL, CHECK FOR OWGBP
=1*1* AR_AC3 ;[347] GET DLEN
BR/AR,AR_AC0 ;[347] Copy for length compare
.IFNOT/OWGBP
MVST: BR/AR,AR_MEM, ;HOLD AC3, WAIT FOR FILLER
FE_AR0-8,SKP SCAD NE ;CHECK FOR FLAGS IN DEST LEN
=0 ARX_AC0,J/MVST1 ;GET SRC LEN, FLAGS
NOLENS: AR_E0,J/UUO ;NO FLAGS ALLOWED IN DST LEN
MVST1: FILL_AR,AR_ARX ;SAVE FILL CHAR
.ENDIF/OWGBP
FE_AR0-8,AR0-8_#,#/0 ;SEPARATE FLAGS OFF
ARX_AR,AR_AR-BR,SKP AD0 ;COMPUTE SRC-DST LEN
=0 DLEN_AR,AR_BR COMP,J/MVST2 ;SRC LONGER
DLEN_AR,AR_ARX COMP ;DST LONGER
MVST2: SLEN_AR,ARX_AR,MQ_AR,AR_0S ;-SHORT LEN -1 TO MQ
AR0-8_FE,BRX/ARX ; AND BRX
SFLGS_AR,B DISP
=100 CLR AR,ARX_1S,SC_#,#/12.,J/MOVS2;[220]TRANSLATE, BUILD MASK
AR_DSTP,J/MVSO3 ;OFFSET, MASK DEPENDS ON S
ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1 ;LEFT JUSTIFY
AR_DLEN,SKP AD0,J/MOVRJ ;RIGHT JUSTIFY
MVSO3: SC_S,CLR ARX,AR_1S ;PREPARE TO BUILD MASK
MOVS2: AR_SHIFT,SR_SRC
MSK_AR
=000
MOVELP: AR_SLEN+1,CALL,J/SRCMOD ;PICK UP SOURCE BYTE
AR_DLEN,J/MOVSTX ;(1) LENGTH EXHAUSTED
=100
MOVPUT: SR_SRC+DST,CALL,J/PUTDST ;(4) NORMAL, STORE DST BYTE
I FETCH,AR_DLEN,J/MVABT ;(5) ABORT
=110 SR_SRC,J/MOVELP ;(6) DPB DONE
=
;HERE TO ABORT A STRING MOVE DUE TO TRANSLATE OR OFFSET FAILURE
MVABT: BR/AR,AR_-SLEN,SKP AR0 ;WHICH STRING LONGER?
=0
MVABT1: AC3_AR,FETCH WAIT,J/MVABT2 ;PUT AWAY DEST LEN
AR_AR-BR,J/MVABT1 ;DEST LEN WAS GREATER
MVABT2: AR_SLEN COMP,SKP BR0 ;GET UNDECREMENTED SLEN
=0 AR_AR+BR ;SRC LONGER BY (DLEN)
MVEND: AR_AR*SFLGS,AD/OR,SR_0,J/STAC ;PUT BACK REMAINING LENGTH
;HERE TO BEGIN RIGHT-JUSTIFIED MOVE
=00
MOVRJ: ARX_AR,AR_SRCP,SR_SRC,J/MVSKP ;SRC LONGER, SKIP OVER SOME
SR_DSTF,CALL,J/MOVF1 ;DST LONGER, FILL IT
=11 ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1 ;DONE FILLING
=0
MVSKP: ARX_ARX-1 (AD),FE_#,#/36.,
SIGNS DISP,SKP INTRPT,J/MVSK1
P_FE-S,AR_AR+1,J/MVSKP
=1110
MVSK1: P_P-S,SKP SCAD0,J/MVSKP ;BUMP POINTER
SRCP_AR,GEN ARX,SIGNS DISP,AR_0.M
=1110 BRX/ARX,AR_SLEN COMP,ARX/AD,J/MVSK3 ;INTERRUPTED
DLEN_AR,J/MVSK4 ;DONE FILLING
MVSK3: AC3_AR,AR_ARX*BRX,AD/A+B+1 ;DEST HAS SHORT LEN
SR_0,J/STRPF2 ;FIX UP AC0, SERVE INTRPT
;HERE FOR NO-MODIFICATION STRING MOVES
;[266] Remove edit 244
;;[244] THIS ADDRESS MUST REMAIN SET FOR THE PROBLEM
;; OF THE S FIELD OF THE SOURCE POINTER BEING > 36.
;;
;.IF/MODEL.B
;1300: ;[244]
;MOVST1: SLEN_AR,BRX/ARX, ;PUT UPDATED LEN AWAY
; AR+ARX+MQ_0.M,CALL.M,
; SIGNS DISP,J/GSRC
;1301:
;MOVSTX: SKP AR0,ARX_AR,AR_0S,J/MOVST2 ;SHORT LEN EXHAUSTED
;1302: SR_SRC+DST,CALL,J/PUTDST
;1306:
;MVSK4: ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1
;.IFNOT/MODEL.B ;[244][266]
=000
MOVST1: SLEN_AR,BRX/ARX, ;PUT UPDATED LEN AWAY
AR+ARX+MQ_0.M,CALL.M,
SIGNS DISP,J/GSRC
MOVSTX: SKP AR0,ARX_AR,AR_0S,J/MOVST2 ;SHORT LEN EXHAUSTED
=010 SR_SRC+DST,CALL,J/PUTDST
=110
MVSK4: ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1
=
;.ENDIF/MODEL.B ;[244][266]
=00
MOVST2: TEST ARX,TEST FETCH, ;SKIP IF BOTH LENGTHS =0
AC3_AR,AR_ARX,J/MVEND ;CLEAR DEST LEN, REBUILD SRC
SR_DST,CALL,J/MOVF1 ;SOURCE GONE, FILL OUT DST
=11 AR_SFLGS,VMA_PC+1,J/SFET1 ;DONE FILLING
;NOTE -- IT AIN'T AS EASY AS IT LOOKS TO BUM A CYCLE OUT OF THIS
; ROUTINE, BECAUSE AN INTERRUPT, IF ANY, HAS TO BE TAKEN AFTER THE
; POINTER UPDATE AND BEFORE THE LENGTH UPDATE. GOOD HUNTING!
=01*
MOVF1: AR_FILL,CALL,J/PUTDST
AR_DLEN+1,SKP INTRPT,J/MOVF2
=0
MOVF2: DLEN_AR,SIGNS DISP,J/MOVF3 ;DONE?
SR DISP,J/CLEAN ;BREAK OUT FOR INTERRUPT
=1011
MOVF3: RETURN2 ;YES, DONE
J/MOVF1 ;NO, DO ANOTHER
.ENDIF/EXTEND
.TOC "EIS -- STRING COMPARE"
.IF/EXTEND
;HERE FOR CMPS, CHECK FOR OWGBP FIRST
; [310] E0+1 will be saved in FILL during OWG checking. We restore it
; from ARX to MQ here. This keeps us from fetching bogus fill characters.
.IF/OWGBP
CMPS: BR/AR,ARX_AR,AR_AC0 ;[347]DEST LEN TO BR, GET SRC LEN
SKP AR GT BR ;[347] Which string is longer?
=0 VMA_MQ,J/CMPS1 ;[310] Source shorter
VMA_MQ+1 ;[310] SRC LONGER, GET DST FILLER
CMPS1: LOAD AR,AR_ARX-1,ARX_AR-1,TIME/3T;[347] Decrement lengths, get fill
AR_MEM,BR/AR,BRX/ARX,J/CMPS4 ;DECREMENTED LEN'S TO BR'S
.IFNOT/OWGBP ;[347]
CMPS: BR/AR,ARX_AR,FE_AR0-8,AR_AC0 ;DEST LEN TO BR, GET SRC LEN
FE_FE OR AR0-8, ;GATHER HIGH BITS OF LEN'S
SKP AR GT BR ;WHICH STRING LONGER?
=0 ;[347]
CMPS1: LOAD AR,AR_ARX-1,ARX_AR-1, ;SRC SHORTER
GEN FE,SKP SCAD NE,J/CMPS2 ;CHECK LEN'S PURE
VMA_VMA+1,J/CMPS1 ;SRC LONGER, GET DST FILLER
=0
CMPS2: AR_MEM,BR/AR,BRX/ARX,J/CMPS4 ;DECREMENTED LEN'S TO BR'S
AR_MEM,J/NOLENS ;[275] ILLEGAL BITS IN LEN'S
.ENDIF/OWGBP
;HERE IS THE COMPARE LOOP.
; MQ CONTAINS THE FILL CHARACTER FOR THE SHORTER STRING,
; BR CONTAINS THE REMAINING DESTINATION LENGTH,
; BRX CONTAINS THE REMAINING SOURCE LENGTH
=0
CMPS3: ARX0_MQ35,J/CMPSX ;WE GOT INEQUALITY. GET SIGN
CMPS4: MQ_AR,ARX_AR,FE_#,#/36., ;FILL TO MQ & ARX
AR_BR,SKP ARX0 ;MORE CHARS IN SRC STRING?
=1000 AR_SRCP,ARX_SRCP, ;READY WITH SRC POINTER
SR_ED(S),CALL,J/GSRC1 ;GO GET SRC BYTE
AR_ARX,ARX_0S,SR_0,SIGNS DISP ;SRC DONE. TEST DEST LEN
=1010 T0_AR,AR_MQ,SIGNS DISP,J/CMPS5 ;SRC (OR SRC FILL) TO T0,
=1110 ;TEST FOR END OF DEST STRING
CMPSX: GEN ARX,CMS FETCH,J/NOP ;QUIT WITH COMPARE COND IN ARX
=
;HERE TO GET DESTINATION BYTE. SRC IS IN T0, FILL CHAR IN AR
;HERE WITH SIGNS DISP, TO AVOID CALL ON CMPDST IF DST LEN EXHAUSTED
=1101
CMPS5: SR_ED(+D),CALL,J/CMPDST ;GO FOR DESTINATION BYTE
AR_AR*T0,AD/XOR, ;AR ZERO IF EQUAL
ARX/MQ,MQ_MQ*2 ;FILL TO ARX, CRY TO MQ35
BR/AR,BRX/ARX, ;EQUALITY TO BR, FILL TO BRX
AR_BR,ARX_BRX,SKP BR0 ;LENGTHS TO AR, ARX
=0 AC3_AR,ARX_AR,AR_ARX (AD), ;UPDATE DEST LEN IN AC3
SIGNS DISP,J/CMPS6 ;TEST SRC LEN
ARX_AR,AR_ARX (AD) ;DEST LEN EXHAUSTED
=1110
CMPS6: AC0_AR,AR_ARX-1,ARX_AR-1,J/CMPS7 ;UPDATE SRC LEN IN AC0
AR_ARX-1,ARX_AR-1 ;SRC EXHAUSTED PREVIOUSLY
CMPS7: BR/AR,BRX/ARX, ;LENGTHS TO BR'S
SKP BR EQ,AR/ADX,J/CMPS3 ;CHECK FOR EQUALITY
=0
.IFNOT/MODEL.B
CMPDST: AR_DSTP,ARX_DSTP,FE_#,#/36., ;GET DEST BYTE FOR COMPARE
CALL,J/IDST ;UPDATE DEST POINTER
.IF/MODEL.B
CMPDST: AR_DSTP,ARX_DSTP, ;GET DEST BYTE FOR COMPARE
CALL,J/IDST ;UPDATE DEST POINTER
.ENDIF/MODEL.B
SC_FE+SC,SKP INTRPT,J/LDB1 ;GET DEST BYTE
.ENDIF/EXTEND
.TOC "EIS -- DECIMAL TO BINARY CONVERSION"
.IF/EXTEND
; HERE WITH AC0 (SRC LEN) IN AR COMPLEMENTED
; IN THE LOOP, AC3 CONTAINS 10 (DECIMAL), BR'BRX HAS ACCUMULATED BINARY
.IF/OWGBP
=0
DBIN: CALL [DB2WD] ;CHECK FOR OWGBP
AR_AC0 COMP ;FLAGS TO AR
BR/AR,FE_AR0-8 COMP,AR0-8_#,#/-1 ;FORCE OUT FLAGS
.IFNOT/OWGBP
DBIN: BR/AR,FE_AR0-8 COMP,AR0-8_#,#/-1 ;FORCE OUT FLAGS
.ENDIF/OWGBP
SLEN_AR,AR_0S,ARX_0S,SIGNS DISP
=1101 AR0-8_FE#,MQ_ARX,ARX_AC4,J/DBS1 ;BUILD SFLGS
B DISP ;OFFSET OR TRANSLATE?
=110 AR0-8_FE,J/DBST ;TRANSLATE, LET S FLAG SET LATER
AR0-8_FE OR #,#/400 ;OFFSET, SET S FLAG
DBST: SFLGS_AR,AR_0S,ARX_0S,J/DBS2 ;CLEAR BINARY
DBS1: SFLGS_AR,ARX_ARX*2 ;HERE WHEN SIG ALREADY ON
AR_AC3 ;ACCUMULATED BINARY IN AR
DBS2: BR_AR LONG,AR_1,CLR ARX
AR_AR*10,B DISP,SC_#,#/4 ;GET CONSTANT 10 FOR COMPARE
=110 AC3_AR,AR_ARX,ARX_1S,J/DBS3 ;PREPARE TO BUILD MASK
AC3_AR,AR_1S ;OFFSET
DBS3: AR_SHIFT,SR_DB
MSK_AR,AR_BR LONG ;SAVE MASK, GET INITIAL INPUT
=0*0
DBINLP: BR_AR LONG,AR_SLEN+1, ;BINARY BACK TO BR, COUNT LENGTH
CALL,J/SRCMOD ;PICK UP A DIGIT
SKP AR2,VMA_PC+1,J/DBXIT ;(1) DONE, TEST M FLAG
ARX_AR,AR+MQ_0.M,GEN AR-AC3, ;(4) NORMAL, ADD IN DIGIT
SKP CRY0,J/DBIN2 ;TEST FOR DIGIT >9
AR_SLEN COMP,J/DBABT ;(5) ABORT
;HERE TO ADD IN A DIGIT
=0
DBIN2: BR_AR LONG,AR_BR LONG,J/DBIN3 ;DIGIT TO BR LONG, BINARY TO AR LONG
AR_SLEN COMP,J/DBABT ;DIGIT >9, ABORT
DBIN3: AR_AR*5 LONG ;ALREADY HAVE BINARY *2
AR_2(AR+BR) LONG,J/DBINLP ;ADD IN DIGIT, SHIFT LEFT
;HERE ON ABORT
DBABT: AR_AR*SFLGS,AD/OR ;[230][221]FLAGS +LEN REMAINING
AC0_AR,AR_BR LONG,SC_#,#/35., ;PUT BACK UNUSED LENGTH
VMA_PC+1,J/STOR34 ;END WITH NO SKIP
;HERE AT END
=0
DBXIT: AR_BR LONG,VMA_VMA+1, ; M FLAG=0
SC_#,#/35.,J/STOR34 ;GO FOR NEXT INSTR
AR_-BR LONG,VMA_VMA+1, ;NEGATE
SC_#,#/35.
STOR34: AC3_AR,AR_SIGN,FETCH ;STORE HIGH PART
AR_SHIFT,SR_0 ;GET LOW READY
.IF/MODEL.B
SEL AC4 ;PRESEL NUMBER TO FIX HARDW GLITCH
.ENDIF/MODEL.B
STAC4: AC4_AR,FINISH
.ENDIF/EXTEND
.TOC "EIS -- BINARY TO DECIMAL CONVERSION"
.IF/EXTEND
; AC0,AC1 = BINARY INTEGER INPUT
; AC3 = FLAGS, MAX LENGTH OF DECIMAL STRING
; AC4 = DESTINATION STRING POINTER
; TEMPS ARE USED AS FOLLOWS:
; FILL = VMA of fill character (to preserve through OWGBP check) [344]
; SLEN= # OF SIGNIFICANT DIGITS
; T1,2= 10.**(SLEN) THE LOWEST POWER OF TEN LARGER THAN BINARY
;
;FPD IS SET IF THE INSTRUCTION WAS INTERRUPTED AFTER CONVERSION OF THE
; BINARY INTEGER TO FRACTION FORM (AFTER STORING FILL, IF NEEDED).
.IF/OWGBP
=0*** ;[347]
BDEC: FILL_AR,CALL [EXT01] ;[344] Save fill VMA, check OWGBP
AR_AC1,ARL/AD,SC_1,ARX+MQ_0.M,
BYTE DISP ;GET BIN INTEGER
=011 ARX_SHIFT,AR_AC0,SKP AD0, ;BINARY INTEGER NOW IN AR LONG
SC_#,#/20,J/BD1 ;IS IT NEGATIVE?
.IFNOT/OWGBP
=011
BDEC: ARX_SHIFT,AR_AC0,SKP AD0, ;BINARY INTEGER NOW IN AR LONG
SC_#,#/20,J/BD1 ;IS IT NEGATIVE?
.ENDIF/OWGBP
BDDR1: ARX_AR,AR_AC3,SR_BDT ;RESUME WITH FRACTION IN AR LONG
BR/AR,CLR EXP, ;SEPARATE FLAGS & LENGTH
BRX/ARX,ARX_AC0 ;LOW FRAC TO BRX, HI TO ARX
AR_AR*BR,AD/ANDCA,BR/AR ;JUST FLAGS TO AR, JUST LEN TO BR
AC3_AR,AR_ARX ;GET HI FRAC TO AR
BR/AR,VMA_PC+1, ;FRAC TO BR LONG, GET VMA READY
AR_-BR,SKP CRY0,J/BDDR4 ;CHECK FOR MORE TO GO
=0
BD1: SKP AR NE,AD LONG,J/BD2 ;TEST FOR ZERO LONG
AR_-AR LONG,SC_#,#/30,J/BD3 ;MAKE POSITIVE, SET N&M FLAGS
=00
BD2: BR_AR LONG,AR_1 LONG, ;BINARY RIGHT-ALIGNED IN BR,
SC_#,FE_#,#/20.,J/BD4 ;LOOK FOR LARGER POWER OF TEN
BD3: BR_AR LONG,AR_AC3, ;SAVE POS BINARY, GET AC FLAGS
CALL,J/SETFLG ; SET FLAGS AS NEEDED
=11 AC3_AR,AR_BR*.5 LONG,J/BD2 ;SAVE NEW FLAGS, SHIFT BINARY RIGHT
;HERE TO FIND THE SMALLEST POWER OF TEN LARGER THAN THE BINARY INTEGER.
;BINARY IS IN BR LONG, AND POSITIVE UNLESS IT WAS 1B0. IN THIS CASE THE
;COMPARISON WILL NEVER FIND A LARGER POWER OF TEN, BUT THE COUNT IN FE
;WILL RUN OUT, AND WE WILL CORRECTLY COMPUTE 22 DIGITS REQUIRED.
=010 ;IGNORE BR SIGN
BD4: AR_AR*10 LONG,FE_FE-1,J/BD6 ;THIS POWER IS TOO SMALL
SC_FE-SC-1,T1_AR,AR_ARX,J/BD7 ;THIS POWER IS BIG ENOUGH
FE_FE-1 ;10.**21 IS TOO SMALL, USE 22
SC_FE-SC-1,T1_AR,AR_ARX,J/BD7 ;10.**21 IS BIG ENOUGH
BD6: GEN AR-BR-1,DISP/DIV,J/BD4 ;COMPARE BINARY TO 10**N
;HERE HAVING FOUND THE NUMBER OF DIGITS REQUIRED TO REPRESENT THE
; GIVEN INTEGER. THE ONE'S COMPLEMENT OF THE NUMBER OF DIGITS IS NOW
; IN SC, AND T1/T2 IS GETTING A POWER OF TEN LARGER THAN THE INPUT.
=0*
BD7: T2_AR,AR_1S,CALL,J/GETSC ;SAVE (10**N), GET -# OF DIGITS
SLEN_AR,ARX_AR*4 COMP ;-# OF SIGNIFICANT DIGITS-1
AR_AC3 ;GET FLAGS, LENGTH
FE_AR0-8,AR0-8_#,#/0 ;LEN IN AR, FLAGS IN FE
AR_ARX*.25-AR-1,SKP CRY0, ;-# OF FILL CHARS -1
SC_FE-#,#/400 ;SC0 SET IF S FLAG =0
=0 ARX_AR+1,AR_0.M,J/BD8 ;ENOUGH SPACE. -FILL CNT TO ARX
I FETCH,J/NOP ;OVERFLOW
BD8: AR0-8_FE.M,SKP SC0, ;FLAGS TO AR. S FLAG =0?
GEN ARX COMP,SIGNS DISP ; OR EXACT LENGTH?
=1110 VMA_FM[FILL],LOAD AR,J/BDF1 ;[344] Must fill. GET FILLER
BD9: AC3_AR,J/BDDV1 ;NO FILL. FLAGS TO AC3
BDF1: T0_AR ;[344] Save flags in T0
=00 AR_MEM,SR_BDF,CALL,J/RET1 ;GET FILLER, GO WAIT FOR PARITY
FILL_AR,AR_ARX,CALL,J/MOVF2 ;FILL AS REQUIRED
=11 AR_T0,J/BD9 ;GET FLAGS BACK
;SETUP FOR LONG DIVISION OF BINARY BY 10**N
;BR STILL HAS BINARY RIGHT ALIGNED (IE, LOW SIGN SQUEEZED OUT BY
; SHIFTING HIGH WORD RIGHT). BR IS POSITIVE UNLESS INPUT INTEGER WAS
; 1B0, IN WHICH CASE BR IS -1B1. T1,T2 HAS LARGER POWER OF TEN, UNLESS
; BINARY EXCEEDS 10**21, IN WHICH CASE T1,T2 CONTAINS 10**21. SINCE
; BINARY CANNOT BE AS LARGE AS 2 * 10**21, THE FIRST DIVIDE STEP
; IS GUARANTEED TO GENERATE A 1 IN THIS CASE ONLY, AND TO REDUCE THE
; BINARY TO LESS THAN 10**21.
BDDV1: ARX_T2,CLR AR ;FILL DONE. GET 10**N
=110 AR_T1,MQ_AR, ;D'SOR SET IN AR, MQ CLR
SKP BR0,CALL,J/BDDV2 ; CHK D'END SIGN
ARX_AR,AR_AC0,SET FPD ;DONE, GET FULL QUO IN AR LONG
AR_AR+1 LONG,SR_BDT,J/BDD1 ;PREVENT 9'S DISEASE
=000
BDDV2: AR_BR LONG,BR_AR LONG, ;BEGIN LONG DIVISION
SC_#,FE_#,#/34., ;STEP COUNTS FOR BOTH PARTS
CALL,J/DDVSUB
AR_-BR,ARX/ADX,BR_AR LONG, ;HERE IF BINARY WAS 1B0
SC_#,FE_#,#/34., ; IT'S NOW 1B1
CALL,J/DDVSUB
=011 AC0_AR,AR_MQ,ARL/AD,MQ_0.M, ;HALF DONE WITH DIVISION
FE_SC,J/DDVLP ;RESUME WITH ADD STEP
=101 AC0_AR,AR_MQ,ARL/AD,MQ_0.M,
FE_SC,J/DDVSUB ;RESUME WITH SUBTRACT STEP
=
;HERE WITH QUOTIENT OF <INPUT INTEGER>/<10**N> IN AR LONG, WITH THE
; BINARY POINT BETWEEN BITS 0 AND 1 OF AR. THUS, BIT 0 WILL BE SET
; IFF THE INPUT INTEGER WAS GREATER THAN OR EQUAL TO 10**21.
; SINCE THIS IS A TRUNCATED FRACTION, IT IS NOT GREATER THAN THE TRUE
; QUOTIENT, AND THE ERROR IS LESS THAN 2**-71. WE ADD 2**-71, TO
; GUARANTEE THAT OUR FRACTION IS GREATER THAN THE TRUE QUOTIENT,
; WITH AN ERROR NO GREATER THAN 2**-71. WE WILL THEN MULTIPLY THIS
; FRACTION BY 10 N TIMES, REMOVING THE INTEGER PART AT EACH STEP
; TO EXTRACT THE N DIGITS. SINCE N IS AT MOST 21, THIS IS A MULTIPLI-
; CATION BY AT MOST 10**21, SO THE ERROR IS AT MOST (2**-71)*(10**21).
; SINCE THIS IS LESS THAN ONE, THE ERROR DOES NOT INTRUDE INTO THE
; OUTPUT DIGIT STRING.
;HERE IS LOOP TO EXTRACT DIGITS FROM FRACTION IN AC0,AC1
BDD1: BR_AR LONG,VMA_PC+1, ;START NEXT LOOP ITERATION
AR_SLEN+1,SKP CRY0 ;ANY MORE DIGITS?
=0 ;HERE TO RESUME AFTER INTERRUPT
BDDR4: SLEN_AR,MQ_AR,SC_1, ;YES, SAVE LENGTH REMAINING
AR_BR LONG, ; AND GET FRACTION
SIGNS DISP,J/BDD2 ;CHECK FOR 1ST DIGIT OF 10**21
AR_0S,ARX_0S,CLR FPD, ;NO, DONE. CLEAR AC0 & AC1
VMA_VMA+1
AC0_AR,FETCH,J/STRAC1 ;MOVE FETCH WHEN TIMING FIXED
=1101 ;LOOK AT BR0 ONLY
BDD2: AR_AR*1.25 LONG,SC_#,#/4 ;NEXT DIGIT TO AR0-3
ARX_AR,AR_0S,SKP INTRPT ;READY TO SHIFT IN DIGIT
=0 AR_SHIFT,B DISP,J/BDD3 ;STORE IT
AR_BR LONG,SR_0,J/B2DPF ;UPDATE REGS & QUIT
;HERE TO STORE DIGIT IN AR FOR BDEC
=0
BDD3: VMA_AR+E1,LOAD AR,J/BDD4 ;TRANSLATE: GET TABLE ENTRY
AR_AR+E1,J/BDD7 ;OFFSET AR AND STORE IT
BDD4: SKP MQ EQ -1,TIME/3T,ARX_0.M ;LAST DIGIT?
=0
BDD5: AR_MEM,J/BDD6 ;NO, STORE RH (POS DIGIT)
ARX_AC3,J/BDD5 ;YES, LOOK AT M FLAG
BDD6: SKP ARX2,ARX_AR SWAP,ARL_0.M
=100
BDD7: SR_BDD,CALL,J/PUTDST
AR_ARX,ARL_0.M,J/BDD7 ;M SET ON LAST DIGIT, USE LH
AR_BR LONG,SR_BDT, ;GET FRACTION BACK
SIGNS DISP ;CHECK BR0 FOR INTEGER PART
=
=1101 AR_AR*10 LONG ;DISCARD PREVIOUS DIGIT
P_P AND #,#/37,J/BDD1 ;CLEAR AR0, GO FOR NEXT
.ENDIF/EXTEND
.TOC "EIS -- SRCMOD SUBROUTINE TO GET MODIFIED SOURCE BYTE"
.IF/EXTEND
;SLEN = COMPLEMENT OF LENGTH
;MSK = MASK
;E1 = EFFECTIVE ADDRESS OF OPERATION WORD (SIGN EXTENDED IF OFFSET)
;CALL WITH: AR_SLEN+1,CALL,J/SRCMOD
;RETURNS: 1 LENGTH EXHAUSTED: FLAGS IN AR
; 2 (EDIT ONLY) NO SIGNIFICANCE: FLAGS IN FE
; 3 (EDIT ONLY) SIGNIFICANCE START: BYTE IN AR, FLAGS IN FE
; 4 NORMAL: BYTE IN AR
; 5 ABORT: OUT OF RANGE OR TRANSLATE FAILURE
; BR, BRX, PRESERVED.
; B=0 IF TRANSLATE, =1 IF OFFSET MODE, =2 IF EDIT, =4 IF CVTDBT
;[266] Remove edit 244
;;[244] THIS ADDRESS MUST REMAIN FOR THE PROBLEM OF THE
;; S FIELD OF THE SOURCE POINTER BEING GREATER THAT 36.
;
;.IF/MODEL.B
;1200: ;[244]
;SRCMOD: SLEN_AR,AR+ARX+MQ_0.M,CALL.M, ;PUT LENGTH AWAY, GET BYTE
; SIGNS DISP,J/GSRC ;CHECK FOR LENGTH EXHAUSTION
;1201: AR_SFLGS,SR_0,RETURN1 ;LEN =0, DONE
;1202: E1,TIME/2T,B DISP ;BYTE IN AR
;1206: AR_AR*.5 LONG,E1,J/XLATE ;LOW BIT TO ARX0, BYTE/2 TO AR LOW
;1207: AR_AR+E1,TIME/3T ;OFFSET, ADD OFFSET, TEST MASK
; TEST AR.MSK,SKP CRY0,RETURN4 ;RETURN 4 IF OK, 5 OUT OF RANGE
;.IFNOT/MODEL.B ;[244][266]
=000
SRCMOD: SLEN_AR,AR+ARX+MQ_0.M,CALL.M, ;PUT LENGTH AWAY, GET BYTE
SIGNS DISP,J/GSRC ;CHECK FOR LENGTH EXHAUSTION
AR_SFLGS,SR_0,RETURN1 ;LEN =0, DONE
E1,TIME/2T,B DISP ;BYTE IN AR
=110 AR_AR*.5 LONG,E1,J/XLATE ;LOW BIT TO ARX0, BYTE/2 TO AR LOW
AR_AR+E1,TIME/3T ;OFFSET, ADD OFFSET, TEST MASK
TEST AR.MSK,SKP CRY0,RETURN4 ;RETURN 4 IF OK, 5 OUT OF RANGE
;.ENDIF/MODEL.B ;[244][266]
;HERE ON TRANSLATE-MODE OPERATIONS, WITH THE BYTE/2 IN AR, AND
; THE LEAST SIGNIFICANT BIT OF THE BYTE IN ARX0. PERFORM THE
; TABLE LOOKUP, AND OPERATE AS CONTROLLED BY THE HIGH THREE BITS
; OF THE TABLE ENTRY.
XLATE: VMA_AR+E1,LOAD AR ;GET FUNCTION FROM TABLE
TRNAR: AR_MEM,SKP ARX0,SC_#,#/18. ;WHICH HALF?
=0 ARX_AR,AR0-3 DISP, ;LH, MOVE TO ARX LEFT
AR_SFLGS,J/TRNFNC
ARX_AR SWAP,AR18-21 DISP, ;RH, MOVE THAT TO ARX LEFT
AR_SFLGS,J/TRNFNC
;HERE ON TRANSLATE OPERATION TO PERFORM FUNCTIONS REQUIRED BY
; THE 3 HIGH ORDER BITS OF THE TRANSLATE FUNCTION HALFWORD.
; WE HAVE DISPATCHED ON THOSE THREE BITS, WITH THE FUNCTION
; HALFWORD IN LH(ARX), AND THE FLAGS FROM AC0 IN AR.
=0001
TRNFNC: SFLGS_AR,FE_P,AR_SHIFT, ;SAVE FLAGS, GET FCN IN AR RIGHT
SIGNS DISP,J/TRNRET ;WAS S FLAG ALREADY SET?
TRNABT: SFLGS_AR,FE_P AND #,#/3,RETURN5 ;ABORT
P_P AND #,#/67,J/TRNFNC ;CLEAR M FLAG
P_P OR #,#/10,J/TRNFNC ;SET M FLAG
TRNSIG: P_P OR #,#/20,J/TRNFNC ;SET N FLAG
P_P OR #,#/20,J/TRNABT ;SET N AND ABORT
P_P AND #,#/67,J/TRNSIG ;CLEAR M, THEN SET N
P_P OR #,#/30,J/TRNFNC ;SET N AND M
=1011
TRNRET: ARX_AR*MSK,AD/AND, ;S FLAG IS 0, GET BYTE IN AR
SKP AR18,B DISP,J/TRNSS ;IS THIS EDIT?
AR_AR*MSK,AD/AND,RETURN4 ;RETURN NORMAL SINCE S FLAG SET
=100
TRNSS: AR_DLEN,B DISP,J/TRNNS1 ;NO SIG ON MOVE OR D2B
AR_SFLGS,SC_#,#/40,J/TRNSS1 ;SIG START, SET FLAG
VMA_E0+1,LOAD AR,RETURN2 ;EDIT NO SIG. GET FILL
.IFNOT/MODEL.B
AR_DSTP,FE_#,#/36.,RETURN3 ;EDIT SIG START
.IF/MODEL.B
AR_DSTP,FE_#,#/144,RETURN3 ;EDIT SIG START
.ENDIF/MODEL.B
=0**
TRNNS1: AR_AR-1,J/TRNNS2 ;COMPENSATE FOR IGNORING SRC
AR_SLEN+1,J/SRCMOD ;D2B HAS NO DEST LENGTH
TRNNS2: DLEN_AR,SIGNS DISP
=1011 AR_SLEN,J/SRCMOD ;SLEN = DST LEN, DON'T CHANGE IT
AR_SLEN+1,J/SRCMOD ;SLEN REFLECTS SRC LENGTH
; COUNT DOWN FOR BYTE SKIPPED
TRNSS1: P_P OR SC
SFLGS_AR,AR_ARX,RETURN4 ;RETURN WITH SIG SET
;SUBROUTINE TO GET BYTE FROM SOURCE STRING
; CALL GSRC WITH SIGNS DISP TO CHECK FOR LENGTH EXHAUSTION
; [TIME = 17 + 3(BP OVERFLOW)]
=1011
GSRC: AR_DLEN,RETURN1 ;LEN RAN OUT
GETSRC: AR_SRCP,ARX_SRCP,FE_#,#/36.
;[266] Remove edit 244
;.IF/MODEL.B
; GEN FE-S,SKP SCAD0 ;[244] IS S > 36 ?
;=0 J/GSRC1 ;[244] NO, GO BELOW
; DISP/RETURN,J/501 ;[244] YES, TRICKY WAY TO
; ;[244] GET OUT
;;[244] THIS IS DONE THIS WAY SO THAT WE CAN TAKE THE ERROR
;; RETURN OF THE EXTEND INSTRUCTION. THE TWO PLACES THAT
;; CALL GSRC ARE SET SO THAT A RETURN WITH J FIELD OF 500
;; WILL GO TO HERE.
;1701: RETURN5 ;[244] ERROR RETURN
;.ENDIF/MODEL.B ;[244][266]
=0
GSRC1: P_P-S,SC/SCAD,CALL.M, ;UPDATE POINTER
BYTE DISP,J/GSRC2 ;TEST FOR WORD OVERFLOW
SC_FE+SC,SKP INTRPT,J/LDB1 ;GET BYTE & RETURN TO CALLER
.IFNOT/XADDR
=110
.IF/XADDR
=100
.ENDIF/XADDR
GSRC2: SRCP_AR,ARX_AR,FE_S,VMA_PC, ;STORE POINTER,
EA MOD DISP,J/BFETCH ; GO EVALUATE THE ADDRESS
GSRC3: AR_AR+1,P_FE-S,SC/SCAD,J/GSRC2
.IF/XADDR
ARX_SRCP2,SKP PC SEC0,J/GSRC4 ;GET ADDR PART OF POINTER
ARX_AR,AR_SRCP2,SKP PC SEC0
=0 FE_P,AR_AR+1-AR0,SKP AR0,J/GSRC5
AR_ARX,J/GSRC3 ;OOPS, SEC 0 IS COMPATABLE
=0
GSRC5: P_FE,J/GSRC6 ;EFIW, INCR ALL BUT 0-5
AR_AR+1,INH CRY18 ;IFIW, INCR RIGHT HALF ONLY
=00
GSRC6: SRCP2_AR,AR_ARX,ARX_AR (AD), ;SAVE ADDR PART
CALL,J/RESETP ;GO SET P TO 36-S
=10
GSRC4: SRCP_AR,FE_S,VMA_PC,J/BYTEI ;GO EVALUATE LONG POINTER
SRCP_AR,ARX_AR,FE_S,EA MOD DISP,J/BFETCH
;SUBROUTINE TO LOAD P FROM 36-S
RESETP: P_#-S,#/36.,SC/SCAD,RETURN2 ;START P BACK AT LEFT EDGE
.ENDIF/XADDR
;SUBR TO STORE AR IN DEST STRING
; [TIME = 24 + 3(BP OVERFLOW)]
=00
.IFNOT/MODEL.B
PUTDST: MQ_AR,AR_DSTP,ARX_DSTP,
FE_#,#/36.,CALL,J/IDST
.IF/MODEL.B
PUTDST: MQ_AR,AR_DSTP,ARX_DSTP,CALL,J/IDST
.ENDIF/MODEL.B
AR_MQ,SC_#-SC,#/36.,SKP SCAD0,
CALL,J/DPB1
=11 MEM_AR,RETURN6
;SUBROUTINES TO UPDATE STRING POINTERS
IDST: P_P-S,SC/SCAD,BYTE DISP, ;TEST FOR WORD OVERFLOW
J/IDST2
.IFNOT/XADDR
.IFNOT/MODEL.B
=110
IDST2: DSTP_AR,ARX_AR,FE_S, ;STORE POINTER,
EA MOD DISP,J/BFETCH ; GO GET THE WORD ADDRESSED
AR_AR+1,P_FE-S,SC/SCAD,J/IDST2
.IF/MODEL.B
=110
IDST2: SEL DSTP,J/IDST2B ;PRESEL # TO FIX HARDW GLITCH
IDST2A: FE_#,#/36. ;COULDN'T LOAD FE EARLIER
AR_AR+1,P_FE-S,SC/SCAD,J/IDST2
IDST2B: DSTP_AR,ARX_AR,FE_S,VMA_PC, ;STORE POINTER,
EA MOD DISP,J/BFETCH ; GO GET THE WORD ADDRESSED
.ENDIF/MODEL.B
.IF/XADDR
=100
IDST2: DSTP,J/IDST2B ;PRESEL # TO FIX HARDW GLITCH
AR_AR+1,INH CRY18,J/IDST3
ARX_DSTP2,SKP PC SEC0,J/IDST4 ;GET ADDR PART OF POINTER
ARX_AR,AR_DSTP2,SKP PC SEC0
=0 FE_P,AR_AR+1-AR0,SKP AR0,J/IDST5
AR_ARX+1 (AD),INH CRY18
IDST3: P_#-S,#/36.,SC/SCAD,J/IDST2 ;GO STORE SHORT POINTER AWAY
=0
IDST5: P_FE.C,SEL DSTP2,J/IDST6 ;PRESEL # TO FIX HARDW GLITCH
AR_AR+1,INH CRY18,SEL DSTP2
=00
IDST6: DSTP2_AR,AR_ARX,ARX_AR (AD), ;INCR ADDR PART
CALL,J/RESETP ;GET P BACK TO 36-S
=10
IDST4: SEL DSTP,J/IDST7 ;PRESEL # TO PREVENT HARDW GLITCH
SEL DSTP,J/IDST8 ;PRESEL # TO PREVENT HARDW GLITCH
IDST7: DSTP_AR,FE_S,J/BYTEI
IDST8: DSTP_AR,ARX_AR,FE_S,VMA_PC, ;[300]
EA MOD DISP,J/BFETCH
IDST2B: DSTP_AR,ARX_AR,FE_S,VMA_PC, ;[300]STORE POINTER,
EA MOD DISP,J/BFETCH ; GO GET THE WORD ADDRESSED
.ENDIF/XADDR
.ENDIF/EXTEND
.TOC "EIS -- EDIT FUNCTION"
.IF/EXTEND
; HERE WITH E0, E1 SETUP, 0 IN AR, -1 IN ARX, AND 15 IN SC
.IF/OWGBP
=0*** ;[347]
EDIT: CALL [EXT2WD] ;CHECK FOR OWGBP
CLR AR,ARX_1S,SC_#,#/15. ;SETUP FOR SHIFT
AR_SHIFT,ARX_AC0,SR_ED(PAT) ;MASK TO AR, FLAGS ETC TO ARX
.IFNOT/OWGBP
EDIT: AR_SHIFT,ARX_AC0,SR_ED(PAT) ;MASK TO AR, FLAGS ETC TO ARX
.ENDIF/OWGBP
.IFNOT/MODEL.B
=1*0 MSK_AR,AR_ARX (AD), ;SAVE MASK, GET FLAGS IN AR
VMA_ARX,LOAD AR, ;GET FIRST PATTERN OPERATOR
CALL,J/TRNABT ;GET PBN INTO FE
.IF/MODEL.B
MSK_AR ;SAVE MASK FOR TRAN FUNC
AR_ARX,ARL_0.M,SKP PC SEC0 ;DO WE ALLOW SECTION #?
=0 VMA_ARX,LOAD AR,AR_ARX,J/EDIT1 ;YES. PROVIDE IT
VMA_AR,LOAD AR,AR_ARX ;NO, GIVE 0
EDIT1: FE_P AND #,#/3 ;GET PBN IN FE
.ENDIF/MODEL.B
EDITLP: SC_# AND AR0-8,#/30, ;PBN*8 IN SC
SFLGS_AR,ARX_AR ;UPDATED AC NOW IN AC AND ARX
AR_MEM,SC_FE+SC ;PATTERN IN AR, PBN*9 IN SC
AR_SHIFT,SH DISP,SC_#,#/5 ;PATTERN BYTE TO AR0-8,
=0001 ; DISP ON HIGH 3 BITS
EDDISP: GEN #+AR0-8,#/-5,
SKP SCAD0,J/EDOPR ;(0XX) OPERATE GROUP
AR_AR*8,SKP ARX0,J/EDMSG ;(1XX) MESSAGE
J/EDNOP ;(2XX) UNDEFINED
J/EDNOP ;(3XX) UNDEFINED
J/EDNOP ;(4XX) UNDEFINED
MQ_ARX,ARX_ARX*4,
SC_FE+1,J/EDSKPT ;(5XX) SKIP IF MINUS
MQ_ARX,ARX_ARX*2,
SC_FE+1,J/EDSKPT ;(6XX) SKIP IF NON-ZERO
AR_AR*8,SC_FE+1,J/EDSKP ;(7XX) SKIP ALWAYS
;HERE TO DECODE OPERATE GROUP
=0
EDOPR: J/EDNOP ;OPR .GE. 005 UNDEFINED
SH DISP,J/OPDISP ;(00X), DISP ON LOW 3 BITS
=000
OPDISP: AR_ARX,SC_#,#/-4, ;(000) STOP
VMA_PC+1,J/EDSTOP
SR_ED(S),J/EDSEL ;(001) SELECT
AR_DSTP,SKP ARX0,J/EDSSIG ;(002) START SIGNIFICANCE
AR_ARX,J/EDFLDS ;(003) FIELD SEPARATOR
.IFNOT/MODEL.B
VMA_AC3,LOAD ARX, ;(004) EXCH MARK AND DEST
MQ_ARX,J/EDEXMD
.IF/MODEL.B
.IFNOT/XADDR
AR_DSTP,MQ_ARX,J/EDEXMD ;(004) EXMD
.IF/XADDR
AR_DSTP,ARX/AD,MQ_ARX, ;(004) EXMD
SKP PC SEC0,J/EDEX0
.ENDIF/XADDR
.ENDIF/MODEL.B
=
;HERE TO TERMINATE EDIT INSTRUCTION
; SC HAS -4, FE HAS CURRENT PBN, VMA HAS PC IF ABORT, PC+1 IF DONE
EDSTOP: FE_FE-#,#/3,SKP SCAD0
=0 AR_AR+1,INH CRY18,
P_P AND SC,J/SFET1
P_P+1
SFET1: FETCH+1,J/STORAC
;HERE FOR SKPM & SKPN, WITH APPROPRIATE BIT IN ARX0
EDSKPT: AR_AR*8,SKP ARX0,ARX/MQ ;SKIP DISTANCE TO AR0-5
;HERE AT END OF OPERATION TO UPDATE PBN
=0
EDNOP: FE_FE-#,#/3,SKP SCAD0, ;END OF PATTERN WORD?
AR_ARX,J/EDNXT1
EDSKP: FE_P+SC,J/EDNOP ;ADD SKIP DISTANCE
=0
.IFNOT/XADDR
EDNXT1: AR_AR+1,INH CRY18, ;BUMP TO NEXT WORD
FE_FE-#,#/4, ;REDUCE PBN
SKP SCAD0,J/EDNXT1
SR_ED(PAT)
FE_FE+#,#/4 ;RESTORE PBN POS, INCR IT
SC_P AND #,#/74,VMA_AR,LOAD AR, ;FLAGS & EDIT BIT TO SC, GET PATTERN
SKP INTRPT,J/EDNXT3
.IF/XADDR
EDNXT1: SKP PC SEC0,J/EDNXT2
SR_ED(PAT)
FE_FE+#,#/4,SKP PC SEC0 ;RESTORE PBN POS, INCR IT
=0 SC_P AND #,#/74,VMA_AR,LOAD AR, ;FLAGS & EDIT BIT TO SC,
SKP INTRPT,J/EDNXT3 ; GET PATTERN
SC_P AND #,#/74 ;IN SEC0, MUST NOT LOAD FULL SEC
ARX_AR,ARL_0.M ;CLEAR SEC #
VMA_AR,LOAD AR,AR_ARX, ;GET PATTERN
SKP INTRPT,J/EDNXT3
=0
EDNXT2: AR_AR+1,FE_FE-#,#/4, ;REDUCE PBN
SKP SCAD0,J/EDNXT1
AR_AR+1,INH CRY18, ;BUMP TO NEXT WORD
FE_FE-#,#/4, ;REDUCE PBN
SKP SCAD0,J/EDNXT1
.ENDIF/XADDR
=0
EDNXT3: P_FE OR SC,J/EDITLP ;SET NEW PBN, GO DO NEXT PATTERN
P_FE OR SC,J/PGFAC0 ;GO RESTORE THINGS AND TAKE
; THE INTERUPT
;HERE FOR FIELD SEPARATOR (CLEAR FLAGS IN AC 0-2)
EDFLDS: P_P AND #,#/7,J/EDSEND ;EASY ENOUGH
;HERE FOR SIG START
=00
.IFNOT/XADDR
EDSSIG: VMA_AC3,STORE,CALL,J/EDFLT1 ;SAVE MARK, GET FLOAT
.IF/XADDR
EDSSIG: ARX_AR,VMA_AC3,AR/AD,ARL_0.M,
BYTE DISP,SCADA EN/0S,SCAD/A,
CALL,SKP PC SEC0,J/EDFLT
.ENDIF/XADDR
FE_FE-#,#/3,SKP SCAD0, ;S FLAG ALREADY SET, NOP
AR_ARX,J/EDNXT1
=11
EDSEND: FE_P AND #,#/3,ARX_AR,J/EDNOP ;READY TO DO NEXT OP
;HERE FOR MESSAGE CHAR
=00
EDMSG: VMA_E0+1,LOAD AR,J/EDSFIL ;NO SIG, PUT FILLER
SC_P,AR_0S,CALL,J/GETSC ;GET MESSAGE SELECT IN AR
=11 VMA_AR+E0+1,LOAD AR,J/EDMPUT ;STORE MESSAGE
;HERE TO EXCHANGE MARK AND DESTINATION POINTERS
.IFNOT/MODEL.B ;EASY CASE
EDEXMD: AR_DSTP ;READY TO STORE DEST PTR
FIN XFER,STORE ;WAIT FOR MARK, STORE DSTP
MEM_AR,AR_ARX ;READY TO UPDATE DSTP
DSTP_AR,ARX/MQ,J/EDNOP ;DONE, GET NEXT OPR
.IF/MODEL.B
.IF/XADDR
=0
EDEX0: VMA_AC3,LOAD AR (WR TST), ;GET MARK POINTER
BR/AR,BRX/ARX,J/EDEX2 ;DSTP IN BR & BRX,
.ENDIF/XADDR
EDEXMD: BR/AR,AR_AC3,ARL_0.M
VMA_AR,LOAD AR (WR TST) ;GET MARK FROM SECT 0
AR_MEM
.IFNOT/XADDR
BR/AR,AR_BR,STORE ;STORE DEST POINTER
MEM_AR,AR_BR,SEL DSTP ;DONE. GET MARK AGAIN
;PRESELECT # TO FIX HARDWARE GLITCH
DSTP_AR,ARX/MQ,J/EDNOP ;MARK BECOMES DEST. GET NEXT PAT
.IF/XADDR
=101
EDDSNG: BR/AR,AR_BR,STORE,J/EDEXX ;NEITHER POINTER IS DOUBLE
J/UUO ;SHORT DSTP, LONG MARK ILLEGAL
;;;FLUSH WHEN SURE THIS IS RIGHT
; BR/AR,AR_BR, ;DSTP TO AR, MARK TO BR
; VMA_VMA+1,LOAD ARX ;GET MARK2
; FIN XFER,VMA_VMA-1,STORE,J/EDEXX;NOW STORE DSTP AS NEW MARK
EDEX2: AR_MEM,BYTE DISP ;WAIT FOR MARK, TEST DESTP
=101 BYTE DISP,J/EDDSNG ;NO, CHECK MARK
ARX_DSTP2,BYTE DISP ;YES, CHECK MARK
=101 J/UUO ;LONG DSTP SHORT MARK ABORT
;;;FLUSH WHEN SURE THE UUO IS RIGHT
; BR/AR,AR_ARX, ;MARK TO BR, DSTP2 TO AR
; VMA_VMA+1,STORE,J/EDEXM4 ; STORE DSTP2
BR/AR,AR_ARX,
VMA_VMA+1,LOAD ARX (WR TST) ;GET MARK2
FIN XFER,STORE ;PUT BACK DSTP2
;EDEXM4:
FIN STORE,AR_BRX, ;GET DSTP FROM BRX
VMA_VMA-1,STORE ;PUT THAT DOWN
EDEXX: MEM_AR,AR_BR,SEL DSTP, ;PRESELECT # TO FIX HARDWARE GLITCH
SKP PC SEC0 ;GET MARK FOR NEW DSTP
=0 DSTP_AR,AR_ARX,BYTE DISP,J/EDEX1
DSTP_AR
=101
EDEX1: FE_FE-#,#/3,SKP SCAD0,
AR_MQ,J/EDNXT1
SEL DSTP2 ;PRESELECT # TO FIX HARDWARE GLITCH
DSTP2_AR,J/EDEX1 ;PUT OLD MARK2 AS DSTP2
.ENDIF/XADDR
.ENDIF/MODEL.B
;HERE FOR SELECT
=0*
EDSEL: AR_SRCP,ARX_SRCP,FE_#,#/36.,
CALL,J/GSRC1 ;GO GET SRC BYTE
AR_AR*.5 LONG,E1 ;GOT IT, DIVIDE BY 2
=000 VMA_AR+E1,LOAD AR,CALL,J/TRNAR ;GO TRANSLATE BY HALFWORDS
=010
EDSFIL: AR_MEM,J/EDSF1 ;(2) NO SIGNIFICANCE, STORE FILL
GEN P-S,SKP SCAD0,BRX/ARX,J/EDSFLT ;(3) SIG START, DO FLOAT CHAR
EDSPUT: SR_ED(+D),CALL,J/PUTDST ;(4) NORMAL, STORE AT DST
VMA/PC,SC_#,#/-4,J/EDSTOP ;(5) ABORT
EDFPUT: AR_SFLGS,J/EDSEND ;(6) BUMP PBN AND GO TO NEXT
EDMPUT: AR_MEM,J/EDSPUT ;FILL OR MSG IN AR, STORE IT
;HERE WHEN TIME TO STORE FILL CHAR
EDSF1: SKP AR NE,J/EDFPUT ;IS THERE ONE?
;HERE WHEN SELECT STARTS SIGNIFICANCE
=00
.IFNOT/MODEL.B
EDSFLT: VMA_AC3,STORE,CALL,J/EDFLT ;STORE DEST AT MARK ADDR
.IF/MODEL.B
.IFNOT/XADDR
EDSFLT: ARX_AR,AR_AC3,ARL_0.M,CALL,J/EDFLT
.IF/XADDR
EDSFLT: ARX_AR,VMA_AC3,AR/AD,ARL_0.M,
BYTE DISP,SCADA EN/0S,SCAD/A,
CALL,SKP PC SEC0,J/EDFLT
.ENDIF/XADDR
.ENDIF/MODEL.B
P_FE,AR_AR+1,J/EDSFLT ;FORCE STANDARD POINTER FORM
=11 SFLGS_AR,AR_BRX,J/EDSPUT ;SET S FLAG, GET BYTE, STORE IT
;HERE IS SUBROUTINE TO STORE FLOAT CHAR
.IF/MODEL.B
.IFNOT/XADDR
EDFLT: VMA_AR,AR_ARX,STORE,J/EDFLT1
.IF/XADDR
=100
EDFLT: AR_ARX,STORE,J/EDFLT1 ;SHORT POINTER. STORE IT
VMA_AR,AR_ARX,STORE,J/EDFLT1 ; LIKEWISE. FORCE SECTION 0
AR_ARX,STORE,J/EDFLTX ;LONG POINTER, DO MORE
VMA_AR,AR_ARX,STORE,J/EDFLT1 ; IN SECTION 0, KEEP THERE
EDFLTX: MEM_AR ;FINISH STORE OF 1ST PART
AR_DSTP2,VMA_VMA+1,STORE ;NOW DO SECOND PART
.ENDIF/XADDR
.IFNOT/MODEL.B
EDFLT:
.ENDIF/MODEL.B
EDFLT1: MEM_AR,AR_2 ;MARK STORED, READY FOR FLOAT
=0* VMA_AR+E0,LOAD AR,CALL,J/XFERW
SKP AR NE
=100 AR_SFLGS,SC_#,#/40,J/SETFLG ;NO FLOAT CHR, SET S FLAG
SR_ED(+D),CALL,J/PUTDST ;STORE FLOAT CHR IN DST
=111 AR_SFLGS,SC_#,#/40 ;SET S FLAG AND RETURN
SETFLG: P_P OR SC,RETURN3 ;NO FLOAT CHR, SET S FLAG
.ENDIF/EXTEND