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