Trailing-Edge
-
PDP-10 Archives
-
ksu2_130
-
extend.mic
There is 1 other file named extend.mic in the archive. Click here to see a list.
.TOC "EXTEND -- DISPATCH ROM ENTRIES"
.DCODE
001: I, SJCL, J/L-CMS
I, SJCE, J/L-CMS
I, SJCLE, J/L-CMS
I, B/2, J/L-EDIT
I, SJCGE, J/L-CMS
I, SJCN, J/L-CMS
I, SJCG, J/L-CMS
010: I, B/1, J/L-DBIN ;CVTDBO
I, B/4, J/L-DBIN ;CVTDBT
I, B/1, J/L-BDEC ;CVTBDO
I, B/0, J/L-BDEC ;CVTBDT
014: I, B/1, J/L-MVS ;MOVSO
I, B/0, J/L-MVS ;MOVST
I, B/2, J/L-MVS ;MOVSLJ
I, B/3, J/L-MVS ;MOVSRJ
020: I, J/L-XBLT ;XBLT
I, J/L-SPARE-A ;GSNGL
I, J/L-SPARE-B ;GDBLE
I, B/0, J/L-SPARE-C ;GDFIX
I, B/1, J/L-SPARE-C ;GFIX
I, B/2, J/L-SPARE-C ;GDFIXR
I, B/4, J/L-SPARE-C ;GFIXR
I, B/10, J/L-SPARE-C ;DGFLTR
;30: ;GFLTR
;GFSC
.UCODE
1740:
L-CMS: LUUO
1741:
L-EDIT: LUUO
1742:
L-DBIN: LUUO
1743:
L-BDEC: LUUO
1744:
L-MVS: LUUO
1746:
L-XBLT: LUUO
1747:
L-SPARE-A: LUUO
1750:
L-SPARE-B: LUUO
1751:
L-SPARE-C: LUUO
;NOTE: WE DO NOT NEED TO RESERVE 3746 TO 3751 BECAUSE THE CODE
; AT EXTEND DOES A RANGE CHECK.
.TOC "EXTEND -- INSTRUCTION SET DECODING"
;EACH INSTRUCTION IN THE RANGE 1-23 GOES TO 1 OF 2 PLACES
; 1740-1747 IF NOT UNDER EXTEND
; 3740-3747 IF UNDER EXTEND
.DCODE
123: I,READ/1, J/EXTEND
.UCODE
1467:
EXTEND: MEM READ, [BR]_MEM ;FETCH INSTRUCTION
=0** TL [BR], #/760740, ;IN RANGE 0-17 (AND AC#=0)
CALL [BITCHK] ;TRAP IF NON-ZERO BITS FOUND
[BRX]_[HR].AND.# CLR RH, ;SPLIT OUT AC NUMBER
#/000740 ; FROM EXTEND INSTRUCTION
[BR]_[BR].OR.[BRX], ;LOAD IR AND AC #
HOLD RIGHT, LOAD IR ; ..
READ [BR], LOAD BYTE EA, ;LOAD XR #
J/EXTEA0 ;COMPUTE E1
EXTEA0: WORK[E0]_[AR]
EXTEA1: EA MODE DISP
=100*
EXTEA: [BR]_[BR]+XR
EXTDSP: [BR]_EA FROM [BR], LOAD VMA,
B DISP, J/EXTEXT
[BR]_[BR]+XR, START READ, PXCT EXTEND EA, LOAD VMA, J/EXTIND
VMA_[BR], START READ, PXCT EXTEND EA
EXTIND: MEM READ, [BR]_MEM, HOLD LEFT, LOAD BYTE EA, J/EXTEA1
;HERE TO EXTEND SIGN FOR OFFSET MODES
=1110
EXTEXT: WORK[E1]_[BR], ;SAVE E1
DISP/DROM, J/3400 ;GO TO EXTENDED EXECUTE CODE
READ [BR], SKIP DP18 ;NEED TO EXTEND SIGN
=0 WORK[E1]_[BR], ;POSITIVE
DISP/DROM, J/3400
[BR]_#, #/777777, HOLD RIGHT, ;NEGATIVE
J/EXTEXT
.TOC "EXTEND -- MOVE STRING -- SETUP"
;HERE TO MOVE A STRING
;COME HERE WITH:
; AR/ E0
; BR/ E1
;
3744:
MVS: [AR]_[AR]+1, ;GO FETCH FILL
LOAD VMA, ; BYTE
START READ, ; ..
CALL [GTFILL] ;SUBROUTINE TO COMPLETE
3754: [BR]_AC[DLEN] ;GET DEST LENGTH AND FLAGS
=0** TL [BR], #/777000, ;ANY FLAGS SET?
CALL [BITCHK] ;SEE IF ILLEGAL
[AR]_AC ;GET SRC LENGTH AND FLAGS
=0 [BRX]_[AR].AND.# CLR RH, ;COPY FLAGS TO BRX
#/777000, ; ..
CALL [CLRFLG] ;CLEAR FLAGS IN AR
;NEW DLEN IS <SRC LEN>-<DST LEN>
AC[DLEN]_[AR]-[BR], 3T, ;COMPUTE DIFFERENCE
SKIP DP0 ;WHICH IS SHORTER?
=0 [AR]_.NOT.[BR], ;DESTINATION
J/MVS1 ;GET NEGATIVE LENGTH
[AR]_.NOT.[AR] ;SOURCE
MVS1: WORK[SLEN]_[AR], ; ..
B DISP ;SEE WHAT TYPE OF MOVE
;SLEN NOW HAS -<LEN OF SHORTER STRING>-1
=1100
STATE_[SRC], J/MOVELP ;TRANSLATE--ALL SET
[BR]_AC[DSTP], J/MVSO ;OFFSET BUILD MASK
[ARX]_[AR], ;LEFT JUSTIFY
J/MOVST0 ; ..
[ARX]_AC[DLEN], ;RIGHT JUSTIFY
SKIP DP0, 4T, ;WHICH IS SHORTER?
J/MOVRJ
MVSO: READ [BR], FE_S+2 ;GET DST BYTE SIZE
Q_0, BYTE STEP ;BUILD AN S BIT MASK
=0*
MVSO1: GEN MSK [AR], BYTE STEP, J/MVSO1
[AR]_.NOT.Q ;BITS WHICH MUST NOT BE SET
WORK[MSK]_[AR].AND.[MASK], ;SAVE FOR SRCMOD
J/MOVLP0 ;GO ENTER LOOP
.TOC "EXTEND -- MOVE STRING -- OFFSET/TRANSLATE"
;HERE IS THE LOOP FOR OFFSET AND TRANSLATED MOVES
=000
MOVELP: [AR]_WORK[SLEN]+1, ;UPDATE STRING LENGTH
CALL [SRCMOD] ;GET A SOURCE BYTE
=001 [ARX]_[AR], SKIP DP0, ;(1) LENGTH EXHAUSTED
J/MOVST2 ; SEE IF FILL IS NEEDED
=100 [AR]_-WORK[SLEN], ;(4) ABORT
J/MVABT ; ..
STATE_[SRC+DST], ;(5) NORMAL--STORE DST BYTE
CALL [PUTDST] ; ..
=111
MOVLP0: STATE_[SRC], J/MOVELP ;(7) DPB DONE
=
;HERE TO ABORT A STRING MOVE DUE TO TRANSLATE OR OFFSET FAILURE
MVABT: [BR]_AC[DLEN], ;WHICH STRING IS LONGER
SKIP DP0, 4T
=0
MVABT1: AC[DLEN]_[AR], J/MVABT2 ;PUT AWAY DEST LEN
[AR]_[AR]-[BR], ;DEST LEN WAS GREATER
J/MVABT1 ;STICK BACK IN AC
MVABT2: [AR]_.NOT.WORK[SLEN] ;GET UNDECREMENTED SLEN
READ [BR], SKIP DP0 ;NEED TO FIXUP SRC?
=0 [AR]_[AR]+[BR] ;SRC LONGER BY (DLEN)
MVEND: [AR]_[AR].OR.[BRX] ;PUT BACK SRC FLAGS
END STATE, J/STAC ;ALL DONE
.TOC "EXTEND -- MOVE STRING -- MOVSRJ"
=00
MOVRJ: [AR]_AC[SRCP], J/MVSKP ;SRC LONGER, SKIP OVER SOME
STATE_[DSTF], ;DST LONGER, FILL IT
CALL [MOVFIL] ; ..
=11 [ARX]_WORK[SLEN]+1, ;DONE FILLING
J/MOVST1 ;GO MOVE STRING
;HERE TO SKIP OVER EXTRA SOURCE BYTES
MVSKP: AC[SRCP]_[AR], SKIP -1MS ;[121] Is there a timer interrupt?
=0 WORK[SV.AR]_[AR], J/MVSK2 ;[121][123] Yes, save regs for interrupt.
[ARX]_[ARX]-1, 3T, ;DONE SKIPPING?
SKIP DP0
=0 IBP DP, IBP SCAD, ;NO--START THE IBP
SCAD DISP, SKIP IRPT, ;4-WAY DISPATCH
3T, J/MVSKP1 ;GO BUMP POINTER
AC[DLEN]_0, ;LENGTHS ARE NOW EQUAL
J/MOVST4 ;GO MOVE STRING
=00
MVSKP1: [AR]_[BR], J/MVSKP ;NO OVERFLOW
[AR]_.NOT.WORK[SLEN], ;INTERRUPT
J/MVSK3 ; ..
SET P TO 36-S, ;WORD OVERFLOW
J/MVSKP2 ;FIXUP Y
[AR]_.NOT.WORK[SLEN] ;[121] INTERRUPT or timer.
MVSK3: AC[DLEN]_[AR] ;RESET DLEN
=0 [AR]_[AR]+[ARX],
CALL [INCAR] ;ADD 1 TO AR
AC_[AR].OR.[BRX], ;PUT BACK FLAGS
J/ITRAP ;DO INTERRUPT TRAP
MVSKP2: [AR]_[AR]+1, HOLD LEFT, ;BUMP Y
J/MVSKP ;KEEP GOING
;BEGIN EDIT [123]
MVSK2: WORK[SV.BR]_[BR] ;SAVE ALL
WORK[SV.ARX]_[ARX] ;THE REGISTERS
WORK[SV.BRX]_[BRX] ;FOR THE TICK
=0* CALL [TICK] ;UPDATE CLOCK AND SET INTERUPT
[AR]_WORK[SV.AR] ;NOW PUT
[BR]_WORK[SV.BR] ;THEM ALL
[ARX]_WORK[SV.ARX] ;BACK SO WE
[BRX]_WORK[SV.BRX], ;CAN CONTINUE
J/MVSKP
;END EDIT [123]
.TOC "EXTEND -- MOVE STRING -- SIMPLE MOVE LOOP"
;HERE FOR NO-MODIFICATION STRING MOVES
MOVST0: [ARX]_[ARX]+1 ;CANT DO [ARX]_[AR]+1
MOVST1: STATE_[SRC] ;PREPARE FOR PAGE FAIL
=000
WORK[SLEN]_[ARX], ;GO GET A SOURCE BYTE
SKIP DP0, CALL [GSRC] ; ..
MOVSTX: [ARX]_[AR], ;SHORT STRING RAN OUT
SKIP DP0, J/MOVST2 ;GO SEE IF FILL NEEDED
=010 STATE_[SRC+DST], ;WILL NEED TO BACK UP BOTH POINTERS
CALL [PUTDST] ;STORE BYTE
=110
MOVST4: [ARX]_WORK[SLEN]+1, ;COUNT DOWN LENGTH
J/MOVST1 ;LOOP OVER STRING
=
=00
MOVST2: AC[DLEN]_0, J/MOVST3 ;CLEAR DEST LEN, REBUILD SRC
STATE_[DST], CALL [MOVFIL] ;FILL OUT DEST
=11 AC_[BRX], J/ENDSKP ;ALL DONE
MOVST3: AC_[ARX].OR.[BRX] ;REBUILD SRC
END STATE, J/SKIPE ; ..
.TOC "EXTEND -- COMPARE STRING"
3740:
CMS: [ARX]_AC[DLEN] ;GET DEST LEN
=0** TL [ARX], #/777000, CALL [BITCHK]
[BRX]_AC ;GET SRC LEN
=0** TL [BRX], #/777000, CALL [BITCHK]
[BRX]-[ARX], 3T, SKIP DP0 ;WHICH STRING IS LONGER?
=0 [AR]_[AR]+1 ;SRC STRING IS LONGER
VMA_[AR]+1, START READ ;DST STRING
=0 [AR]_0, ;FORCE FIRST COMPARE TO BE
;EQUAL
CALL [LOADQ] ;PUT FILL INTO Q
WORK[FILL]_Q, ;SAVE FILLER
J/CMS2 ;ENTER LOOP
;HERE IS THE COMPARE LOOP.
; ARX/ CONATINS REMAINING DEST LENGTH
; BRX/ CONTAINS REMAINING SOURCE LENGTH
=0
CMS3: ;BYTES ARE NOT EQUAL
END STATE, ;NO MORE SPECIAL PAGE FAIL ACTION
SKIP-COMP DISP ;SEE SKIP-COMP-TABLE
CMS4: [AR]_AC[SRCP] ;GET BYTE POINTER
READ [BRX], SKIP DP0 ;MORE IN SOURCE STRING?
=00 STATE_[EDIT-SRC], ;PREPARE FOR PAGE FAIL
CALL [GETSRC] ; GO GET BYTE
READ [ARX], SKIP DP0, ;NO MORE SRC--SEE IF MORE DEST
J/CMS5 ; ..
WORK[CMS]_[AR] ;SAVE SRC BYTE
=
AC_[BRX] ;PUT BACK SRC LEN
STATE_[COMP-DST] ;HAVE TO BACK UP IF DST FAILS
READ [ARX], SKIP DP0 ;ANY MORE DEST?
=00
CMS6: CALL [CMPDST] ;MORE DEST BYTES
[AR]_WORK[FILL], ;OUT OF DEST BYTES
J/CMS7 ;GO DO COMPARE
AC[DLEN]_[ARX] ;GOT A BYTE, UPDATE LENGTH
=
CMS7: [AR]_[AR].AND.[MASK], ;MAKE MAGNITUDES
WORK[CMS] ;WARM UP RAM
[BR]_[MASK].AND.WORK[CMS], 2T ;GET SRC MAGNITUDE
[AR]_[BR]-[AR] REV ;UNSIGNED COMPARE
CMS2: [ARX]_[ARX]-1 ;UPDATE LENGTHS
[BRX]_[BRX]-1 ; ..
READ [AR], SKIP AD.EQ.0, J/CMS3 ;SEE IF EQUAL
=0
CMS5: Q_WORK[FILL], J/CMS8 ;MORE DST--GET SRC FILL
[AR]_0, J/CMS3 ;STRINGS ARE EQUAL
CMS8: STATE_[EDIT-DST] ;JUST DST POINTER ON PAGE FAIL
WORK[CMS]_Q, J/CMS6 ;MORE DST--SAVE SRC FILL
=0
CMPDST: [AR]_AC[DSTP], ;GET DEST POINTER
CALL [IDST] ;UPDATE IT
READ [AR], ;LOOK AT BYTE POINTER
FE_FE.AND.S#, S#/0770, ;MASK OUT BIT 6
BYTE DISP, J/LDB1 ;GO LOAD BYTE
.TOC "EXTEND -- DECIMAL TO BINARY CONVERSION"
3742:
DBIN: [AR]_[777777] XWD 0 ;IF WE ARE IN OFFSET MODE
WORK[MSK]_[AR] ; ONLY ALLOW 18 BITS
;RANGE CHECKED (0-10) LATER
[AR]_AC ;GET SRC LENGTH
[BRX]_[AR].AND.# CLR RH, ;SPLIT OUT FLAGS
#/777000 ; ..
=0* [ARX]_AC[BIN1], ;GET LOW WORD
CALL [CLARX0] ;CLEAR BIT 0 OF ARX
AC[BIN1]_[ARX] ;STORE BACK
=0 READ [BRX], SKIP DP0, ;IS S ALREADY SET?
CALL [CLRBIN] ;GO CLEAR BIN IF NOT
[AR]_[AR].AND.#, ;CLEAR FLAGS FROM LENGTH
#/000777, HOLD RIGHT, ; ..
B DISP ;SEE IF OFFSET OR TRANSLATE
=1110
DBIN1: STATE_[CVTDB], J/DBIN2 ;TRANSLATE--LEAVE S ALONE
[BRX]_[BRX].OR.#, ;OFFSET--FORCE S TO 1
#/400000, HOLD RIGHT,
J/DBIN1
DBIN2: WORK[SLEN]_.NOT.[AR] ;STORE -SLEN-1
;HERE IS THE MAIN LOOP
=0*0
DBINLP: [AR]_WORK[SLEN]+1, CALL [SRCMOD] ;(0) GET MODIFIED SRC BYTE
TL [BRX], #/100000, ;(1) DONE, IS M SET?
J/DBXIT
[AR]_.NOT.WORK[SLEN], ;(4) ABORT
J/DBABT ; ..
[AR]-#, #/10., ;(5) NORMAL--SEE IF 0-9
4T, SKIP DP18 ; ..
=0 [AR]_.NOT.WORK[SLEN], ;DIGIT TOO BIG
J/DBABT ;GO ABORT CVT
;HERE TO ADD IN A DIGIT
[BR]_AC[BIN0], 4T, ;GET HIGH BINARY
SKIP AD.EQ.0 ;SEE IF SMALL
=00
DBSLO: [ARX]_AC[BIN1], ;TOO BIG
CALL [DBSLOW] ;GO USE DOUBLE PRECISION PATHS
[BR]_AC[BIN1], ;GET LOW WORD
J/DBFAST ;MIGHT FIT IN 1 WORD
J/DBINLP ;RETURN FROM DBSLOW
;GO DO NEXT DIGIT
=
DBFAST: TL [BR], #/760000 ;WILL RESULT FIT IN 36 BITS?
=0 J/DBSLO ;MAY NOT FIT--USE DOUBLE WORD
[BR]_AC[BIN1]*2 ;COMPUTE AC*2
[BR]_[BR]*2, AC[BIN1] ;COMPUTE AC*4
=0 [BR]_[BR]+AC[BIN1], 2T, ;COMPUTE AC*5
CALL [SBRL] ;COMPUTE AC*10
AC[BIN1]_[AR]+[BR], 3T, ;NEW BINARY RESULT
J/DBINLP ;DO NEXT DIGIT
;HERE IF NUMBER DOES NOT FIT IN ONE WORD
=000
DBSLOW: [BR]_AC[BIN0], ;FETCH HIGH WORD
CALL [MULBY4] ;MULTIPLY BY 4
[ARX]_[ARX]+AC[BIN1], ;COMPUTE VALUE * 5
SKIP CRY1, 4T, ;SEE IF OVERFLOW
CALL [ADDCRY] ;GO ADD CARRY
=101 [BR]_[BR]+AC[BIN0] ;ADD IN HIGH WORD
=
=000 CALL [DBLDBL] ;MAKE * 10
[ARX]_[ARX]+[AR], 3T, ;ADD IN NEW DIGIT
SKIP CRY1, ;SEE IF OVERFLOW
CALL [ADDCRY] ;ADD IN THE CARRY
=101 AC[BIN1]_[ARX] ;PUT BACK ANSWER
=
AC[BIN0]_[BR], ; ..
RETURN [2] ;GO DO NEXT BYTE
;HERE TO DOUBLE BR!ARX
=000
MULBY4: CALL [DBLDBL] ;DOUBLE TWICE
DBLDBL: [BR]_[BR]+[BR] ;DOUBLE HIGH WORD FIRST
;(SO WE DON'T DOUBLE CARRY)
[ARX]_[ARX]+[ARX], ;DOUBLE LOW WORD
SKIP CRY1, 3T, ;SEE IF CARRY
CALL [ADDCRY] ;ADD IN CARRY
=110 RETURN [1] ;ALL DONE
=
;HERE TO ADD THE CARRY
=0
ADDCRY: RETURN [4] ;NO CARRY
CLEAR [ARX]0 ;KEEP LOW WORD POSITIVE
[BR]_[BR]+1, ;ADD CARRY
RETURN [4] ;ALL DONE
;HERE TO ABORT CONVERSION
DBABT: [BRX]_[BRX].OR.[AR] ;PUT BACK UNUSED LENGTH
[PC]_[PC]-1, HOLD LEFT, ;DO NOT SKIP
J/DBDONE ;GO FIX UP SIGN COPY
;HERE AT END
=0
DBXIT: [ARX]_AC[BIN1], ;GET LOW WORD
J/DBNEG ;GO NEGATE
DBDONE: [AR]_AC[BIN1] ;FETCH LOW WORD
[BR]_AC[BIN0], 4T, ;GET HIGH WORD
SKIP DP0 ;WHAT SIGN
=0 CLEAR [AR]0, J/DBDN1 ;POSITIVE
[AR]_[AR].OR.#, #/400000, HOLD RIGHT
DBDN1: AC[BIN1]_[AR] ;STORE AC BACK
=0 AC_[BRX] TEST, ;RETURN FLAGS
SKIP DP0, CALL [CLRBIN] ;CLEAR BIN IS S=0
ENDSKP: END STATE, J/SKIP ;NO--ALL DONE
DBNEG: CLEAR ARX0 ;CLEAR EXTRA SIGN BIT
[ARX]_-[ARX], 3T, ;NEGATE AND SEE IF
SKIP AD.EQ.0, AC[BIN0] ; ANY CARRY
=0 [AR]_.NOT.AC[BIN0], 2T, J/STAC34 ;NO CARRY
[AR]_-AC[BIN0], 3T, ;CARRY
SKIP AD.EQ.0 ;SEE IF ALL ZERO
=0 [ARX]_[400000] XWD 0 ;MAKE COPY OF SIGN
; UNLESS HIGH WORD IS ZERO
STAC34: AC[BIN0]_[AR] ;PUT BACK ANSWER
AC[BIN1]_[ARX], J/DBDONE ; ..
;HELPER SUBROUTINE TO CLEAR AC[BIN0] AND AC[BIN1] IF S=0
;CALL WITH:
; READ [BRX], SKIP DP0, CALL [CLRBIN]
;RETURNS 1 ALWAYS
=0
CLRBIN: AC[BIN0]_0, J/CLRB1
RETURN [1]
CLRB1: AC[BIN1]_0, RETURN [1]
.TOC "EXTEND -- BINARY TO DECIMAL CONVERSION"
3743:
BDEC: [BRX]_AC[DLEN], ;GET LENGTH AND FLAGS
SKIP FPD ;CONTINUE FROM INTERUPT?
=0 [BRX]_[BRX].AND.#, ;JUST KEEP THE FLAGS
#/777000, ; ..
J/BDEC0 ;COMPUTE NEW FLAGS
DOCVT: [AR]_AC, J/DOCVT1 ;ALL SET PRIOR TO TRAP
BDEC0: [ARX]_AC[1] ;GET LOW BINARY
[AR]_AC, SC_20. ;GET HIGH WORD, SET STEP COUNT
=0* WORK[BDL]_[ARX], ;SAVE IN CASE OF ABORT
CALL [CLARX0] ;MAKE SURE BIT 0 IS OFF
WORK[BDH]_[AR], ;SAVE HIGH WORD AND
SKIP DP0 ; TEST SIGN
=0
BDEC1: [BRX]_0, HOLD LEFT, ;POSITIVE, CLEAR RH OF BRX
J/BDEC3 ;COMPUTE # OF DIGITS REQUIRED
[BRX]_[BRX].OR.#, ;NEGATIVE, SET M
#/100000, HOLD RIGHT ; ..
=0*
BDEC2: CLEAR ARX0, CALL [DBLNG1] ;NEGATE AR!ARX
AC_[AR] TEST, ;PUT BACK ANSWER
SKIP DP0 ;IF STILL MINUS WE HAVE
; 1B0, AND NO OTHER BITS
=0 AC[1]_[ARX], J/BDEC1 ;POSITIVE NOW
[ARX]_[ARX]+1 ;JUST 1B0--ADD 1
[BRX]_[BRX].OR.#, ;AND REMEMBER THAT WE DID
#/040000, HOLD RIGHT, ; IN LEFT HALF OF AC+3
J/BDEC2 ; NEGATE IT AGAIN
=0
BDEC3: [AR]_AC, J/BDEC4 ;GET HIGH AC
[BRX]_[BRX].OR.#, ;NO LARGER POWER OF 10 FITS
#/200000, ;SET N FLAG (CLEARLY NOT 0)
HOLD RIGHT, J/BDEC5 ;SETUP TO FILL, ETC.
=001
BDEC4: [ARX]_AC[1], ;GET HIGH WORD
CALL [BDSUB] ;SEE IF 10**C(BRX) FITS
=011 [BRX]_[BRX]+1, ;NUMBER FITS--TRY A LARGER ONE
STEP SC, J/BDEC3 ;UNLESS WE ARE OUT OF NUMBERS
=111 TR [BRX], #/777777 ;ANY DIGITS REQUIRED?
=
=0 [BRX]_[BRX].OR.#, ;SOME DIGITS NEEDED,
#/200000, HOLD RIGHT, ; SET N FLAG
J/BDEC5 ;CONTINUE BELOW
[BRX]_[BRX]+1 ;ZERO--FORCE AT LEAST 1 DIGIT
=0
BDEC5: [AR]_AC[DLEN], ;GET LENGTH
CALL [CLRFLG] ;REMOVE FLAGS FROM AR
[BR]_0
[BR]_[BRX], HOLD LEFT ;GET # OF DIGITS NEEDED
[BR]_[BR]-[AR], ;NUMBER OF FILLS NEEDED
SKIP AD.LE.0 ;SEE IF ENOUGH ROOM
=0 [ARX]_WORK[BDL], ;DOES NOT FIT IN SPACE ALLOWED
J/BDABT ; DO NOT DO CONVERT
READ [BRX], SKIP DP0 ;IS L ALREADY SET
=0 AC[DLEN]_[BRX], ;NO--NO FILLERS
J/DOCVT ;GO CHURN OUT THE NUMBER
;HERE TO STORE LEADING FILLERS
[AR]_[BRX], HOLD RIGHT ;MAKE SURE THE FLAGS GET SET
AC[DLEN]_[AR] ; BEFORE WE PAGE FAIL
[AR]_WORK[E0] ;ADDRESS OF FILL (-1)
[AR]_[AR]+1, LOAD VMA, ;FETCH FILLER
START READ
MEM READ, [T0]_MEM ;GET FILLER INTO AR
STATE_[EDIT-DST] ;PAGE FAILS BACKUP DST
WORK[SLEN]_[BR]-1, 3T ;SAVE # OF FILLERS
BDFILL: [AR]_[T0], WORK[SLEN] ;RESTORE FILL BYTE AND
; WARM UP RAM FILE
[BR]_WORK[SLEN]+1, 3T, ;MORE FILLERS NEEDED?
SKIP DP0
=000 AC[DLEN]_[BRX], J/DOCVT ;ALL DONE FIX FLAGS AND CONVERT
=001 WORK[SLEN]_[BR], ;SAVE UPDATED LENGTH
CALL [PUTDST] ; AND STORE FILLER
=111 [BR]_AC[DLEN]-1 ;COUNT DOWN STRING LENGTH
=
AC[DLEN]_[BR], J/BDFILL ;KEEP FILLING
;HERE TO STORE THE ANSWER
DOCVT1: [ARX]_AC[1], ;GET LOW WORD
J/DOCVT2 ;ENTER LOOP FROM BOTTOM
=010
BDECLP: [BR]_[BR]+1, ;COUNT DIGITS
CALL [BDSUB] ;KEEP SUBTRACTING 10**C(BRX)
=110 WORK[BDH]_[AR] ;SAVE BINARY
=
[AR]_[BR]+WORK[E1], ;OFFSET DIGIT
B DISP ;SEE WHICH MODE
=1110 READ [AR], LOAD VMA, ;TRANSLATE, START READING TABLE
START READ, J/BDTBL ; GO GET ENTRY FROM TABLE
BDSET: WORK[BDL]_[ARX] ;SAVE LOW BINARY
=00* STATE_[EDIT-DST], CALL [PUTDST]
=11* [BR]_AC[DLEN]-1 ;UPDATE STRING LENGTH
[AR]_WORK[BDH]
[ARX]_WORK[BDL]
TL [BR], #/040000 ;ARE WE CONVERTING 1B0?
=0 [ARX]_[ARX]+1, J/BDCFLG ;YES--FIX THE NUMBER AND CLEAR FLAG
DOCVT3: AC_[AR]
AC[1]_[ARX]
AC[DLEN]_[BR] ;STORE BACK NEW STRING LENGTH
DOCVT2: [BRX]_[BRX]-1, 3T, SKIP DP18
=0 [BR]_-1, SET FPD, 3T, J/BDECLP
END STATE, CLR FPD, J/SKIP
;HERE TO TRANSLATE 1 DIGIT
=0
BDTBL: END STATE, ;DON'T CHANGE BYTE POINTER IF
; THIS PAGE FAILS
CALL [LOADAR] ;GO PUT WORD IN AR
TR [BRX], #/777777 ;LAST DIGIT
=0 [AR]_0, HOLD RIGHT, J/BDSET
TL [BRX], #/100000 ;AND NEGATIVE
=0 [AR]_[AR] SWAP ;LAST AND MINUS, USE LH
[AR]_0, HOLD RIGHT, J/BDSET
BDABT: [AR]_WORK[BDH], J/DAC
BDCFLG: [BR]_[BR].AND.NOT.#, ;CLEAR FLAG THAT TELLS US
#/040000, HOLD RIGHT, ; TO SUBTRACT 1 AND
J/DOCVT3 ; CONTINUE CONVERTING
;SUBROUTINE TO SUBRTACT A POWER OF 10 FROM AR!ARX
;CALL WITH:
; AR!ARX/ NUMBER TO BE CONVERTED
; BRX(RIGHT)/ POWER OF 10
;RETURNS:
; 2 RESULT IS STILL POSITIVE
; 6 RESULT WOULD HAVE BEEN NEGATIVE (RESTORE DONE)
=0
BDSUB: [T0]_[BRX]+#, 3T, WORK/DECLO, ;ADDRESS OF LOW WORD
J/BDSUB1 ;NO INTERRUPT
J/FIXPC ;INTERRUPT
=0*
BDSUB1: [T1]_[T0], LOAD VMA, ;PUT IN VMA,
CALL [CLARX0] ;FIX UP SIGN OF LOW WORD
[ARX]_[ARX]-RAM, 3T, ;SUBTRACT
SKIP CRY1 ;SEE IF OVERFLOW
=0 [AR]_[AR]-1 ;PROCESS CARRY
[T0]_[BRX]+#, 3T, WORK/DECHI ;ADDRESS OF HIGH WORD
READ [T0], LOAD VMA ;PLACE IN VMA
[AR]_[AR]-RAM, 4T, ;SUBTRACT
SKIP DP0 ;SEE IF IT FIT
=0
CLARX0: CLEAR ARX0, ;IT FIT, KEEP LOW WORD +
RETURN [2] ; AND RETURN
[AR]_[AR]+RAM ;RESTORE
READ [T1], LOAD VMA
[ARX]_[ARX]+RAM, 3T, SKIP CRY1
=0
BDSUB2: CLEAR ARX0, ;KEEP LOW WORD +
RETURN [6] ;RETURN OVERFLOW
[AR]_[AR]+1, ;ADD BACK THE CARRY
J/BDSUB2 ;COMPLETE SUBTRACT
.TOC "EXTEND -- EDIT -- MAIN LOOP"
;HERE FOR EDIT INSTRUCTION
;CALL WITH:
; AR/ E0 ADDRESS OF FILL, FLOAT, AND MESSAGE TABLE
; BR/ E1 TRANSLATE TABLE
;
3741:
EDIT: VMA_[AR]+1, START READ, ;FIRST GET FILL BYTE
CALL [GTFILL] ;GO GET IT
3751: [BRX]_AC ;GET PATTERN POINTER
=0** TL [BRX], #/047777, ;MAKE SURE SECTION 0
CALL [BITCHK] ; ..
EDITLP: VMA_[BRX], START READ ;FETCH PATTERN WORD
END STATE ;NO SPECIAL PAGE FAIL ACTION
[BR]_[BRX] SWAP ;GET PBN IN BITS 20 & 21
=0 [BR]_[BR]*4, ; ..
CALL [LOADAR] ;GET PATTERN WORD
READ [BR], 3T, DISP/DP LEFT
=1100
[AR]_[AR] SWAP, SC_7, J/MOVPAT ;(0) BITS 0-8
[AR]_[AR] SWAP, J/MSKPAT ;(1) BITS 9-17
[AR]_[AR]*.5, SC_6, J/MOVPAT ;(2) BITS 18-27
[AR]_[AR].AND.#, #/777, J/EDISP ;(3) BITS 28-35
=0
MOVPAT: [AR]_[AR]*.5, STEP SC, J/MOVPAT ;SHIFT OVER
MSKPAT: [AR]_[AR].AND.#, #/777
;HERE WITH PATTERN BYTE RIGHT ADJUSTED IN AR
EDISP: [BR]_[AR]*.5, SC_2 ;SHIFT OVER
=0
EDISP1: [BR]_[BR]*.5, STEP SC, J/EDISP1
READ [BR], 3T, DISP/DP ;LOOK AT HIGH 3 BITS
=0001 ;(0) OPERATE GROUP
[AR]-#, #/5, 4T, ; SEE IF 0-4
SKIP DP18, J/EDOPR
;(1) MESSAGE BYTE
READ [BRX], SKIP DP0,
J/EDMSG
;(2) UNDEFINED
J/EDNOP
;(3) UNDEFINED
J/EDNOP
;(4) UNDEFINED
J/EDNOP
;(5) SKIP IF M SET
TL [BRX], #/100000,
J/EDSKP
;(6) SKIP IF N SET
TL [BRX], #/200000,
J/EDSKP
;(7) SKIP ALWAYS
J/EDSKP
.TOC "EXTEND -- EDIT -- DECODE OPERATE GROUP"
;HERE FOR OPERATE GROUP. SKIP IF IN RANGE
=0
EDOPR: J/EDNOP ;OUT OF RANGE
READ [AR], 3T, DISP/DP ;DISPATCH ON TYPE
=1000 [PC]_[PC]+1, J/EDSTOP ;(0) STOP EDIT
STATE_[EDIT-SRC], ;(1) SELECT SOURCE BYTE
J/EDSEL
READ [BRX], SKIP DP0, ;(2) START SIGNIFICANCE
J/EDSSIG
[BRX]_[BRX].AND.#, ;(3) FIELD SEPERATOR
#/77777, HOLD RIGHT,
J/EDNOP
[BR]_AC[MARK] ;(4) EXCHANGE MARK AND DEST
VMA_[BR], START READ,
J/EDEXMD
=
.TOC "EXTEND -- EDIT -- STOP EDIT"
;HERE TO END AN EDIT OPERATION. PC IS SET TO SKIP IF NORMAL END
; OR NON-SKIP IF ABORT
EDSTOP: [BR]_.NOT.[BRX], ;AD WILL NOT DO D.AND.NOT.A
FE_S#, S#/10 ;PRESET FE
[AR]_[BRX], 3T, FE_FE+P ;MOVE POINTER, UPBATE PBN
[BR].AND.#, 3T, ;WAS OLD NUMBER 3?
#/030000, SKIP ADL.EQ.0 ; ..
=0
EDSTP1: [AR]_P, J/STAC ;NO--ALL DONE
[AR]_[AR]+1, ;YES--BUMP WORD #
FE_FE.AND.S#, S#/0700, ;KEEP ONLY FLAG BITS
J/EDSTP1 ;GO STOP EDIT
.TOC "EXTEND -- EDIT -- START SIGNIFICANCE"
;HERE WITH DST POINTER IN AR
=110
EDSSIG: CALL [EDFLT] ;STORE FLT CHAR
J/EDNOP ;DO NEXT PATTERN BYTE
.TOC "EXTEND -- EDIT -- EXCHANGE MARK AND DESTINATION"
;HERE WITH ADDRESS OF MARK POINTER IN BR
=0
EDEXMD: Q_AC[DSTP], ;GET DEST POINTER
CALL [LOADAR] ;GO PUT MARK IN AR
START WRITE ;START WRITE. SEPERATE STEP TO AVOID
; PROBLEM ON DPM5
MEM WRITE, MEM_Q ;PUT OLD DEST IN MARK
AC[DSTP]_[AR], J/EDNOP ;PUT BACK DEST POINTER
.TOC "EXTEND -- EDIT -- PROCESS SOURCE BYTE"
=0*
EDSEL: [AR]_AC[SRCP], ;PICK UP SRC POINTER
CALL [GETSRC] ;GET SOURCE BYTE
[AR]_[AR]*.5, WORK[E1] ;PREPARE TO TRANSLATE
=000 [AR]_[AR]+WORK[E1], ;GO TRANSLATE BY HALFWORDS
2T, CALL [TRNAR] ; ..
=010
EDFILL: READ [AR], ;(2) NO SIGNIFICANCE, GO FILL
SKIP AD.EQ.0, ; SEE IF ANY FILLER
J/EDFIL1 ; GO TO IT
STATE_[EDIT-SRC], ;(3) SIG START, DO FLOAT CHAR
J/EDSFLT
=100 J/EDSTOP ;(4) ABORT
=101
EDSPUT: STATE_[EDIT-S+D], ;(5) NORMAL, STORE AT DST
CALL [PUTDST] ; ..
=111
J/EDNOP ;(7) BYTE STORED
=
;HERE TO COMPLETE STORING FILL
=0
EDFIL1: J/EDSPUT ;STORE FILLER
J/EDNOP ;NO FILLER TO STORE
;HERE TO DO FLOAT BYTE
=110
EDSFLT: WORK[FSIG]_[ARX], ;SAVE SIG CHAR
CALL [EDFLT] ;STORE FLOAT CHAR
[AR]_WORK[FSIG] ;RESTORE CHAR
[AR]_[AR].AND.# CLR LH, ;JUST KEEP THE BYTE IN CASE
#/77777, ; DEST BYTE .GT. 15 BITS
J/EDSPUT ;GO STORE CHAR WHICH STARTED THIS ALL
;SUBRUTINE TO PROCESS FLOAT CHAR
;CALL WITH:
; AR/ POINTER TO STORE @ MARK
;RETURN 7 WITH FLOAT STORED
EDFLT: [BR]_AC[MARK] ;ADDRESS OF MARK POINTER
VMA_[BR], START WRITE ;READY TO STORE
[BR]_AC[DSTP] ;GET DST POINTER
MEM WRITE, MEM_[BR] ;STORE POINTER
=0 [AR]_0 XWD [2], ;FETCH FLOAT CHAR
CALL [EDBYTE] ;GET TBL BYTE
MEM READ, [AR]_MEM, ;GET FLOAT CHAR
SKIP AD.EQ.0 ;SEE IF NULL
=000
[FLG]_[FLG].OR.#, ;REMEMBER TO BACKUP DST POINTER
STATE/EDIT-DST, ; WILL ALSO BACKUP SRC IF CALLED
HOLD LEFT, ; FROM SELECT
CALL [PUTDST] ; STORE FLOAT
=001 [BRX]_[BRX].OR.#, #/400000,
HOLD RIGHT, J/EDFLT1 ;NULL
=110 [BRX]_[BRX].OR.#, #/400000,
HOLD RIGHT, J/EDFLT1 ;MARK STORED
=
EDFLT1: AC_[BRX], ;SAVE FLAGS SO WE DON'T
;TRY TO DO THIS AGAIN IF
;NEXT STORE PAGE FAILS
RETURN [7] ;AND RETURN
.TOC "EXTEND -- EDIT -- MESSAGE BYTE"
;HERE WITH SKIP ON S
=0
EDMSG: [AR]_WORK[FILL], ;GET FILL BYTE
SKIP AD.EQ.0, 4T, ;SEE IF NULL
J/EDMSG1 ;GO STORE
[AR]_[AR].AND.# CLR LH, ;GET OFFSET INTO TABLE
#/77
=0 [AR]_[AR]+1, WORK[E0], ;PLUS 1
CALL [EDBYTE] ;GET TBL BYTE
MEM READ, [AR]_MEM ;FROM MEMORY
=000
EDMSG1: STATE_[EDIT-DST], ;WHAT TO DO ON PAGE FAILS
CALL [PUTDST] ;STORE MESSAGE BYTE
=001 J/EDNOP ;NULL FILLER
=110 J/EDNOP ;NEXT BYTE
=
EDBYTE: [AR]_[AR]+WORK[E0] ;GET OFFSET INTO TABLE
VMA_[AR], START READ, ;START MEMORY CYCLE
RETURN [1] ;RETURN TO CALLER
.TOC "EXTEND -- EDIT -- SKIP"
=0
;HERE TO SKIP ALWAYS
EDSKP: [AR]_[AR].AND.#, #/77, ;JUST KEEP SKIP DISTANCE
J/EDSKP1 ;CONTINUE BELOW
;HERE IF WE DO NOT WANT TO SKIP
J/EDNOP
EDSKP1: [AR]_([AR]+1)*2 ;GIVE 1 EXTRA SKIP
READ [AR], SCAD/A*2, ;PUT THE ADJUSTMENT
SCADA/BYTE5, 3T, LOAD SC, ; THE SC
J/EDNOP1 ;JOIN MAIN LOOP
.TOC "EXTEND -- EDIT -- ADVANCE PATTERN POINTER"
EDNOP: SC_0 ;NO SKIP
EDNOP1: READ [BRX], 3T, FE_P ;PUT PBN IN FE
FE_FE.AND.S#, S#/30 ;JUST BYTE #
FE_FE+SC ;ADD IN ANY SKIP DISTANCE
FE_FE+S#, S#/10 ;BUMP PBN
[AR]_FE, ;GET NUMBER OF WORDS
LOAD SC ;PUT MSB WHERE IT CAN BE TESTED
; QUICKLY
[AR]_[AR].AND.# CLR LH, ;KEEP ONLY 1 COPY
#/170, SKIP/SC ; ..
=0
EDN1A: [AR]_[AR]*.5, SC_0,
J/EDNOP2 ;READY TO SHIFT OFF BYTE WITHIN
; WORD
[AR]_[AR].OR.#, #/200, ;GET THE SIGN BIT OF THE FE
HOLD LEFT, ; INTO THE AR. ONLY HAPPENS ON
J/EDN1A ; SKP 76 OR SKP 77
=0
EDNOP2: [AR]_[AR]*.5, STEP SC, J/EDNOP2
[BRX]_[BRX]+[AR], ;UPDATE WORD ADDRESS
HOLD LEFT
[AR]_P ;PUT PBN BACK IN BRX
[BRX]_[BRX].AND.#, ;JUST KEEP FLAGS
#/700000, ; ..
HOLD RIGHT
[AR]_[AR].AND.#, ;JUST KEEP PBN
#/030000
[BRX]_[BRX].OR.[AR], ;FINAL ANSWER
HOLD RIGHT
AC_[BRX], J/EDITLP ;DO NEXT FUNCTION
.TOC "EXTEND SUBROUTINES -- FILL OUT DESTINATION"
;CALL WITH
; AC[DLEN]/ NEGATIVE NUMBER OF BYTES LEFT IN DEST
; FILL/ FILL BYTE
; RETURN [2] WITH FILLERS STORED
;
;NOTE: THIS ROUTINE NEED NOT TEST FOR INTERRUPTS ON EACH BYTE
; BECAUSE EVERY BYTE STORE DOES A MEMORY READ.
;
=01*
MOVF1: [AR]_WORK[FILL], 2T, ;GET FILL BYTE
CALL [PUTDST] ;PLACE IN DEST
[AR]_AC[DLEN] ;AMOUNT LEFT
AC[DLEN]_[AR]+1, 3T, ;STORE UPDATED LEN
SKIP DP0 ; AND SEE IF DONE
=0 RETURN [2] ;DONE
MOVFIL: WORK[FILL], J/MOVF1 ;DO ANOTHER BYTE
;ENTERING HERE SAVES 150NS
; PER BYTE BUT COSTS 300NS
; PER FIELD MOVED. I ASSUME (BUT DO
; NOT KNOW) THAT THIS SPEEDS
; THINGS UP.
.TOC"EXTEND SUBROUTINES -- GET MODIFIED SOURCE BYTE"
;CALL WITH:
;SLEN = MINUS LENGTH OF STRING
;MSK = MASK FOR BYTE SIZE (1 IF BIT MUST BE ZERO)
;E1 = EFFECTIVE ADDRESS OF OPERATION WORD (SIGN EXTENDED IF OFFSET)
; [AR]_WORK[SLEN]+1, CALL [SRCMOD]
;RETURNS:
; 1 LENGTH EXHAUSTED
; 2 (EDIT ONLY) NO SIGNIFICANCE
; 3 (EDIT ONLY) SIGNIFICANCE START:
; 4 ABORT: OUT OF RANGE OR TRANSLATE FAILURE
; 5 NORMAL: BYTE IN AR
;
;DROM B SET AS FOLLOWS:
; 0 TRANSLATE
; 1 OFFSET
; 2 EDIT
; 4 CVTDBT
=00
SRCMOD: WORK[SLEN]_[AR], ;PUT BACK SOURCE LENGTH
SKIP DP0, ;SEE IF DONE
CALL [GSRC] ;GET A SOURCE BYTE
END STATE, RETURN [1] ;DONE
WORK[E1], B DISP ;OFFSET OR TRANSLATE?
=
=1110 [AR]_[AR]*.5, J/XLATE ;TRANSLATE
FIX [AR] SIGN, WORK[E1] ;IF WE ARE PROCESSING FULL WORD
; BYTES, AND THEY ARE NEGATIVE,
; AND THE OFFSET IS POSITIVE THEN
; WE HAVE TO MAKE BITS -1 AND -2
; COPIES OF THE SIGN BIT.
[AR]_[AR]+WORK[E1], 2T ;OFFSET
[AR].AND.WORK[MSK], ;VALID BYTE?
SKIP AD.EQ.0, 4T, ;SKIP IF OK
RETURN [4] ;RETURN 4 IF BAD, 5 IF OK
.TOC "EXTEND SUBROUTINES -- TRANSLATE"
;HERE WITH BYTE IN AR 1-36. FETCH TABLE ENTRY.
XLATE: [AR]_[AR]+WORK[E1] ;COMPUTE ADDRESS
TRNAR: READ [AR], LOAD VMA, ;FETCH WORD
START READ ; ..
=0 [AR]_[AR]*2, ;GET BACK LSB
;BIT 36 IS NOT PRESERVED
; BY PAGE FAILS
CALL [LOADARX] ;PUT ENTRY IN ARX
TR [AR], #/1 ;WHICH HALF?
=0
XLATE1: [AR]_[ARX], 3T, ;RH -- COPY TO AR
DISP/DP LEFT, ;DISPATCH ON CODE
J/TRNFNC ;DISPATCH TABLE
[ARX]_[ARX] SWAP, ;LH -- FLIP AROUND
J/XLATE1 ;START SHIFT
;HERE ON TRANSLATE OPERATION TO PERFORM FUNCTIONS REQUIRED BY
; THE 3 HIGH ORDER BITS OF THE TRANSLATE FUNCTION HALFWORD. WE
; DISPATCH ON FUNCTION AND HAVE:
; BRX/ FLAGS
; ARX/ TABLE ENTRY IN RH
;
=0001
;(0) NOP
TRNFNC: READ [BRX], SKIP DP0, ;S FLAG ALREADY SET?
J/TRNRET ; ..
;(1) ABORT
RETURN [4]
;(2) CLEAR M FLAG
[BRX]_[BRX].AND.NOT.#,
#/100000, HOLD RIGHT,
J/TRNFNC
;(3) SET M FLAG
[BRX]_[BRX].OR.#,
#/100000, HOLD RIGHT,
J/TRNFNC
;(4) SET N FLAG
TRNSIG: [BRX]_[BRX].OR.#,
#/200000, HOLD RIGHT,
J/TRNFNC
;(5) SET N FLAG THEN ABORT
[BRX]_[BRX].OR.#,
#/200000, HOLD RIGHT,
RETURN [4]
;(6) CLEAR M THEN SET N
[BRX]_[BRX].AND.NOT.#,
#/100000, HOLD RIGHT,
J/TRNSIG
;(7) SET N AND M
[BRX]_[BRX].OR.#,
#/300000, HOLD RIGHT,
J/TRNFNC
;HERE TO COMPLETE A TRANSLATE
=0
TRNRET: READ [ARX], SKIP DP18, ;S-FLAG IS ZERO
B DISP, SKIP DP18, ;SEE IF EDIT OR SIG START
J/TRNSS ; ..
TRNSS1: [AR]_[ARX].AND.# CLR LH, ;S IS SET, JUST RETURN BYTE
#/77777, RETURN [5] ; ..
=1100
TRNSS: [AR]_AC[DLEN], ;NO SIG ON MOVE OR D2B
B DISP, J/TRNNS1 ;SEE IF D2B
[BRX]_[BRX].OR.#, ;SIG START ON MOVE OR D2B
#/400000, HOLD RIGHT,
J/TRNSS1 ;RETURN BYTE
[AR]_WORK[FILL], ;EDIT--NO SIG RETURN FILL
RETURN [2] ; ..
[AR]_AC[DSTP], ;EDIT--START OF SIG
RETURN [3] ; ..
=1011
TRNNS1: [AR]_[AR]-1, J/TRNNS2 ;COMPENSATE FOR IGNORING SRC
[AR]_WORK[SLEN]+1, ;DEC TO BIN HAS NO DEST LENGTH
J/SRCMOD ;JUST UPDATE SRC LENTH
TRNNS2: AC[DLEN]_[AR] TEST, ;PUT BACK DLEN AND
SKIP DP0 ; SEE WHICH IS NOW SHORTER
=0 [AR]_WORK[SLEN], ;DEST IS SHORTER. DO NOT CHANGE
J/SRCMOD ; AMOUNT LEFT
[AR]_WORK[SLEN]+1, ;GO LOOK AT NEXT BYTE
J/SRCMOD
.TOC "EXTEND SUBROUTINES -- GET UNMODIFIED SOURCE BYTE"
;CALL:
; GSRC WITH SKIP ON SOURCE LENGTH
; GETSRC IF LENGHT IS OK
;WITH:
; AC1/ SOURCE BYTE POINTER
;RETURNS:
; 1 IF LENGTH RAN OUT
; 2 IF OK (BYTE IN AR)
;
=0
GSRC: [AR]_AC[DLEN], ;LENGTH RAN OUT
RETURN [1] ;RESTORE AR AND RETURN
GETSRC: [AR]_AC[SRCP] ;GET SRC PTR
IBP DP, IBP SCAD, ;UPDATE BYTE POINTER
SCAD DISP, 3T ;SEE IF OFLOW
=01 [AR]_[BR], J/GSRC1 ;NO OFLOW
SET P TO 36-S ;RESET P
[AR]_[AR]+1, HOLD LEFT ;BUMP Y
GSRC1: AC[SRCP]_[AR] ;STORE UPDATED POINTER
=0 READ [AR], LOAD BYTE EA,;SETUP TO FIGURE OUT
FE_P, 3T, CALL [BYTEAS] ; EFFECTIVE ADDRESS
READ [AR], ;LOOK AT POINTER
BYTE DISP, ;SEE IF 7 BIT
FE_FE.AND.S#, S#/0770, ;MASK OUT P FIELD
J/LDB1 ;GO GET THE BYTE
.TOC "EXTEND SUBROUTINES -- STORE BYTE IN DESTINATION STRING"
;CALL WITH:
; AR/ BYTE TO STORE
; AC4/ DESTINATION BYTE POINTER
;RETURNS:
; AR & AC4/ UPDATED BYTE POINTER
; ARX/ BYTE TO STORE
; BR/ WORD TO MERGE WITH
; 6 ALWAYS
;
PUTDST: [ARX]_[AR] ;SAVE BYTE
=0 [AR]_AC[DSTP], ;GET DEST POINTER
CALL [IDST] ;BUMP DEST POINTER
AD/A+B, A/ARX, B/ARX, ;SHIFT 7-BIT BYTE TO
SCAD/A, 3T, ; NATURAL PLACE, AND PUT
SCADA/BYTE5, LOAD FE ; INTO FE
=0* READ [AR], BYTE DISP, ;GO PUT BYTE IN MEMORY
CALL [DPB1] ; ..
RETURN [6] ;ALL DONE
.TOC "EXTEND SUBROUTINES -- UPDATE DEST STRING POINTERS"
;SUBROUTINE TO BUMP DST POINTERS
;CALL WITH:
; AR/ AC[DSTP]
; RETURN 1 WITH UPDATED POINTER STORED
;
IDST: IBP DP, IBP SCAD, SCAD DISP, 3T
=0* [AR]_[BR], LOAD DST EA, J/IDSTX
SET P TO 36-S
[AR]_[AR]+1, HOLD LEFT, LOAD DST EA
IDSTX: AC[DSTP]_[AR], 3T, ;STORE PTR BACK
FE_P, DISP/EAMODE ;SAVE P FOR CMPDST
=100*
DSTEA: VMA_[AR]+XR, START READ, PXCT BYTE DATA, 3T, J/BYTFET
VMA_[AR], START READ, PXCT BYTE DATA, J/BYTFET
VMA_[AR]+XR, START READ, PXCT/BIS-DST-EA, 3T, J/DSTIND
VMA_[AR], START READ, PXCT/BIS-DST-EA, J/DSTIND
DSTIND: MEM READ, [AR]_MEM, HOLD LEFT, LOAD DST EA
EA MODE DISP, J/DSTEA
;HERE TO TEST ILLEGAL BITS SET
;CALL WITH:
; SKIP IF ALL BITS LEGAL
; RETURN [4] IF OK, ELSE DO UUO
;
3556: ;EXTEND OF 0 COMES HERE
BITCHK: UUO
3557: RETURN [4]
;HERE TO PUT FILL IN [AR] AND WORK[FILL]
GTFILL: MEM READ, ;WAIT FOR DATA
[AR]_MEM ;PLACE IN AR
WORK[FILL]_[AR], ;SAVE FOR LATER
RETURN [10] ;RETURN TO CALLER
;SUBROUTINE TO CLEAR FLAGS IN AR
CLRFLG: [AR]_[AR].AND.#, ;CLEAR FLAGS IN AR
#/000777, ; ..
HOLD RIGHT, RETURN [1]
.TOC "EXTEND -- PAGE FAIL CLEANUP"
;BACK UP SOURCE POINTER
=0
BACKS: [AR]_AC[SRCP],
CALL [BACKBP] ;BACKUP BP
AC[SRCP]_[BR], J/CLDISP
CMSDST: [AR]_WORK[SV.BRX] ;GET OLD SRC LEN
AC_[AR]+1, 3T ;BACK UP
;BACK UP DESTINATION POINTER
=0
BACKD: [AR]_AC[DSTP],
CALL [BACKBP]
AC[DSTP]_[BR], J/CLDISP
;FAILURES DURING MOVE STRING (BACKUP LENGTHS)
STRPF: [AR]_-WORK[SLEN] ;GET AMOUNT LEFT
STRPF0: [BR]_AC[DLEN], 4T, ;WHICH STRING IS LONGER?
SKIP DP0
=0
STRPF1: AC[DLEN]_[AR], J/STPF1A ;SRC LONGER
[ARX]_[AR] ;COPY SRC LENGTH
=0 [ARX]_[ARX].OR.WORK[SV.BRX], ;REBUILD FLAGS
CALL [AC_ARX] ;RESET AC]SLEN]
[AR]_[AR]-[BR] ;MAKE DEST LEN
STRPF3: AC[DLEN]_[AR], ;PUT BACK DEST LEN
J/CLDISP ;DO NEXT CLEANUP
STPF1A: [AR]_[AR]+[BR], J/STRPF2
PFDBIN: [AR]_-WORK[SLEN] ;RESTORE LENGTH
STRPF2: [AR]_[AR].OR.WORK[SV.BRX]
PFGAC0: AC_[AR], J/CLDISP ;PUT BACK SRC LEN AND FLAGS
STRPF4: [AR]_.NOT.WORK[SLEN], J/STRPF0
BACKBP: IBP DP, SCAD/A+B, SCADA/BYTE1, SCADB/SIZE, ;P_P+S
RETURN [1]