.TOC "EXTENDED INSTRUCTION SET DECODING" ;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 ;HERE FOR EXTENDED INSTRUCTION SET DECODING UNDER XADDR .DCODE 123: R, J/EXTEND ;Adjacent to FIX .UCODE 1411: ;Must be near FIX EXTEND: GEN #+AR0-8,#/-20,SKP SCAD NZ ;[427] Dispatch XBLT quickly =0 ARX_AC0,SKP AD NZ,J/XBLT ;[427] XBLT. Is count null? .IF/EXTEXP SC_#+AR0-8,#/-32,SKP SCAD0, ;[427] VALID EXTENDED OPERATION? ARX_AR,AR_BR ; OPR TO ARX, AC TO AR .IFNOT/EXTEXP ;Don't allow G floating exponents SC_#+AR0-8,#/-21,SKP SCAD0, ;[427] VALID EXTENDED OPERATION? ARX_AR,AR_BR ; OPR TO ARX, AC TO AR .ENDIF/EXTEXP =0 AR_BR,J/UUO ;Opcode is too large. E0_AR,MQ_AR,AR_BRX ;SAVE E0. GET AC FROM EXTEND .IF/EXTEXP AR0-8_#+SC,#/32,SC/SCAD ;COMBINE EXT OP <32 WITH AC .IFNOT/EXTEXP AR0-8_#+SC,#/21,SC/SCAD ;COMBINE EXT OP <21 WITH AC .ENDIF/EXTEXP 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 ;[427] GO EVALUATE E1 ; ; [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. ; =1100 ;[427] EXTLA: GEN AR,EXT ADDR,ARX/MQ,J/EXT2 GEN AR+XR,INDEXED,EXT INDEX,ARX/MQ,VMA/LOAD,J/BEXT2;[325][414] GEN AR,EXT INDRCT,SKP INTRPT,J/EXTI GEN AR+XR,INDEXED,EXT INDRCT,SKP INTRPT =00 ;[427] EXTI: ARX_MEM,LONG EN,CALL [BYTIND] ;[427] Unwind indirection ARX_MEM,TAKE INTRPT ;Interrupted. Bust out of here XR,EA MOD DISP,TIME/3T,J/EXTLA ;[427] Local word at end. Decode it XR,EA MOD DISP,TIME/3T ;[427] Global word. Is it indexed? =1110 GEN ARX,GLOBAL,EXT INDEX,ARX/MQ,;[414] No. Generate final address J/BEXT2 GEN ARX+XR,GLOBAL,EXT INDEX, ;[414][427] Yes. Add index to ARX/MQ ; final word ; ; 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 is no longer the same, either. [414] ; 3177: BEXT2: B DISP ;[251][427] Test for offset mode =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 ; 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). .DCODE 001: EA, SJCL, J/L-CMS ;CMSX HIDDEN BENEATH LUUO EA, SJCE, J/L-CMS EA, SJCLE, J/L-CMS 004: EA, B/2, J/L-EDIT ;EDIT EA, SJCGE, J/L-CMS EA, SJCN, J/L-CMS EA, SJCG, J/L-CMS 010: EA, B/1, J/L-DBIN ;CVTDBO EA, B/4, J/L-DBIN ;CVTDBT EA, B/1, J/L-BDEC ;CVTBDO EA, B/0, J/L-BDEC ;CVTBDT 014: EA, B/1, J/L-MVS ;MOVSO EA, B/0, J/L-MVS ;MOVST EA, B/2, J/L-MVS ;MOVSLJ EA, B/3, J/L-MVS ;MOVSRJ .UCODE .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. .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/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 ; ; TST2WD--TEST FOR OWG IN THE AR AND TO CONVERT IT IF IT'S OK. ; Return 1 if converted OK, 2 if not OWG. [437] ; TST2WD: SC_P-#,#/45,BYTE DISP,SKP PC SEC0;[437] Is this, in fact, an OWG? =110 BR/AR,ARX_VMA HELD,J/CNV2WD ;[437] Yes. Convert to TWG RET2: RETURN2 ;No. Just leave ; ;CNV2WD -- ROUTINE TO CALCULATE NEW P FIELD OF ONE WORD GLOBAL BYTE ;POINTER AND STORE NEW POINTER. A TABLE IS IN THE EPT STARTING AT 700 ;AND THIS IS USED TO CONVERT THE OWGBP TO A TWO WORD GLOBAL POINTER ;AND TO CALCULATE THE NEW P FOR THE STORE. ; CNV2WD: MQ_ARX,AR0-8_SC,FE/SCAD ;[437] SAVE VMA. Set P-45 =0* AR_ARX (AD),ARX_AR,SC_#,#/8, ;[437] Divide by two and right CALL [SHIFT] ; align in AR VMA_#+AR32-35,#/700 ;POINT TO RIGHT WORD LOAD AR,EPT REF CACHE ;GET AND CACHE DATA FROM EPT [260] MB WAIT,GEN FE AND #,#/1, ;[437] Wait for EPT word. Is this SKP SCAD NZ ; an odd offset? =0 CNV01: FE_S,ARX_AR,J/CNV02 ;SKIP SWAP AR_AR SWAP,J/CNV01 ;SWAP HALVES FOR ODD CNV02: BRX/ARX,GEN AR,SKP AD NE ;DID WE GET 0 DATA ? =0 BR/AR,J/UUO ;P=77 OR EPT NOT SET UP RSTR VMA_MQ ;[307][326][347] NO, RESTORE VMA 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] .TOC "EIS -- STRING MOVE" ; HERE FOR MOVE STRING, CHECK FOR OWGBP FIRST ;SLEN IS THE COMPLEMENT OF THE SHORTER STRING LENGTH ;DLEN IS - .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 AR_DLEN,J/MVABT ;(5) ABORT [437] =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,J/MVABT2 ;[437] PUT AWAY DEST LEN AR_AR-BR,J/MVABT1 ;DEST LEN WAS GREATER MVABT2: AR_SLEN COMP,SKP BR0,I FETCH ;[437] GET UNDECREMENTED SLEN =0 AR_AR+BR ;SRC LONGER BY (DLEN) MVEND: AR_AR*SFLGS,AD/OR,SR_0,J/STAC ;PUT BACK REMAINING LEN, don't skip ;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 .TOC "EIS -- STRING COMPARE" ;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 CMPDST: AR_DSTP,ARX_DSTP, ;GET DEST BYTE FOR COMPARE CALL,J/IDST ;UPDATE DEST POINTER SC_FE+SC,SKP INTRPT,J/LDB1 ;GET DEST BYTE .TOC "EIS -- DECIMAL TO BINARY CONVERSION" ; HERE WITH AC0 (SRC LEN) IN AR COMPLEMENTED ; IN THE LOOP, AC3 CONTAINS 10 (DECIMAL), BR'BRX HAS ACCUMULATED BINARY ; First take care of OWG conversion. [441] .IF/OWGBP =00 DBIN: AR_AC1,CALL [TST2WD] ;[441] AC1 OWGBP ? CALL [STR2WD] ;YES, CONVRT DONE, STORE DBFLGS: AR_AC0 COMP,J/DBINGO ;[441] Maybe no. FLAGS TO AR AC2_AR,AR_BR OR ARX ;[407] Address to AC2 AC1_AR,J/DBFLGS ;[407] P,S,bit 12 = 1 to AC1 ; DBINGO: BR/AR,FE_AR0-8 COMP,AR0-8_#,#/-1;[441] 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 SEL AC4 ;PRESEL NUMBER TO FIX HARDW GLITCH STAC4: AC4_AR,FINISH .TOC "EIS -- BINARY TO DECIMAL CONVERSION" ; 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 /<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 .TOC "EIS -- SRCMOD SUBROUTINE TO GET MODIFIED SOURCE BYTE" ;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 AR_DSTP,FE_#,#/144,RETURN3 ;EDIT SIG START =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,VMA_PC,CALL.M, ;[352] Increment pointer, init VMA BYTE DISP,J/GSRC2 ; section, test word overflow SC_FE+SC,SKP INTRPT,J/LDB1 ;GET BYTE & RETURN TO CALLER =100 GSRC2: SRCP_AR,ARX_AR,FE_S, ;[352] STORE POINTER, EA MOD DISP,J/BFETCH ; GO EVALUATE THE ADDRESS GSRC3: ARR_AR+1,ARX/AD,INH CRY18, ;[352] Update address for ARX (used P_FE-S,SC/SCAD,J/GSRC2 ; in EA MOD DISP) and set P 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,J/BYTEI ;[352] 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 ;SUBR TO STORE AR IN DEST STRING ; [TIME = 24 + 3(BP OVERFLOW)] =00 PUTDST: MQ_AR,AR_DSTP,ARX_DSTP,CALL,J/IDST AR_MQ,SC_#-SC,#/36.,SKP SCAD0, CALL,J/DPB1 =11 MEM_AR,RETURN6 ;SUBROUTINES TO UPDATE STRING POINTERS IDST: VMA_PC,P_P-S,SC/SCAD,BYTE DISP, ;[352] Init VMA section and J/IDST2 ; TEST FOR WORD OVERFLOW =100 IDST2: DSTP,ARX_AR,J/IDST2B ;[352] PRESEL #, fix ARX address 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, ;[352][300] EA MOD DISP,J/BFETCH IDST2B: DSTP_AR,ARX_AR,FE_S, ;[352][300]STORE POINTER, EA MOD DISP,J/BFETCH ; GO GET THE WORD ADDRESSED .TOC "EIS -- EDIT FUNCTION" .IF/EDIT ; 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 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 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 AR_DSTP,ARX/AD,MQ_ARX, ;(004) EXMD SKP PC SEC0,J/EDEX0 = ;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 .ENDIF/EDIT ;Other things need this SFET1: FETCH+1,J/STORAC .IF/EDIT ;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 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 =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 EDSSIG: ARX_AR,VMA_AC3,AR/AD,ARL_0.M, BYTE DISP,SCADA EN/0S,SCAD/A, CALL,SKP PC SEC0,J/EDFLT 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 =0 EDEX0: VMA_AC3,LOAD AR (WR TST), ;GET MARK POINTER BR/AR,BRX/ARX,J/EDEX2 ;DSTP IN BR & BRX, EDEXMD: BR/AR,AR_AC3,ARL_0.M VMA_AR,LOAD AR (WR TST) ;GET MARK FROM SECT 0 AR_MEM =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 ;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 EDSFLT: ARX_AR,VMA_AC3,AR/AD,ARL_0.M, BYTE DISP,SCADA EN/0S,SCAD/A, CALL,SKP PC SEC0,J/EDFLT 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 =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 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 .ENDIF/EDIT ;Other stuff needs this SETFLG: P_P OR SC,RETURN3 ;NO FLOAT CHR, SET S FLAG