Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

.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]