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

.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 <SRC LEN>-<DST LEN>

.IF/OWGBP
=0*0*					;[347]
MVST:	AR_MEM,CALL [RET2]		;[260]GET FILL, WAIT FOR PARITY
	FILL_AR,CALL [EXT2WD]		;SAVE FILL, CHECK FOR OWGBP
=1*1*	AR_AC3				;[347] GET DLEN
	BR/AR,AR_AC0			;[347] Copy for length compare
.IFNOT/OWGBP
MVST:	BR/AR,AR_MEM,			;HOLD AC3, WAIT FOR FILLER
		FE_AR0-8,SKP SCAD NE	;CHECK FOR FLAGS IN DEST LEN
=0	ARX_AC0,J/MVST1			;GET SRC LEN, FLAGS
NOLENS:	AR_E0,J/UUO			;NO FLAGS ALLOWED IN DST LEN
MVST1:	FILL_AR,AR_ARX			;SAVE FILL CHAR
.ENDIF/OWGBP
	FE_AR0-8,AR0-8_#,#/0		;SEPARATE FLAGS OFF
	ARX_AR,AR_AR-BR,SKP AD0		;COMPUTE SRC-DST LEN
=0	DLEN_AR,AR_BR COMP,J/MVST2	;SRC LONGER
	DLEN_AR,AR_ARX COMP		;DST LONGER
MVST2:	SLEN_AR,ARX_AR,MQ_AR,AR_0S	;-SHORT LEN -1 TO MQ
	AR0-8_FE,BRX/ARX		; AND BRX
	SFLGS_AR,B DISP
=100	CLR AR,ARX_1S,SC_#,#/12.,J/MOVS2;[220]TRANSLATE, BUILD MASK
	AR_DSTP,J/MVSO3			;OFFSET, MASK DEPENDS ON S
	ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1	;LEFT JUSTIFY
	AR_DLEN,SKP AD0,J/MOVRJ		;RIGHT JUSTIFY

MVSO3:	SC_S,CLR ARX,AR_1S		;PREPARE TO BUILD MASK
MOVS2:	AR_SHIFT,SR_SRC
	MSK_AR
=000
MOVELP:	AR_SLEN+1,CALL,J/SRCMOD		;PICK UP SOURCE BYTE
	AR_DLEN,J/MOVSTX		;(1) LENGTH EXHAUSTED
=100
MOVPUT:	SR_SRC+DST,CALL,J/PUTDST	;(4) NORMAL, STORE DST BYTE
	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 <INPUT INTEGER>/<10**N> IN AR LONG, WITH THE
; BINARY POINT BETWEEN BITS 0 AND 1 OF AR.  THUS, BIT 0 WILL BE SET
; IFF THE INPUT INTEGER WAS GREATER THAN OR EQUAL TO 10**21.
; SINCE THIS IS A TRUNCATED FRACTION, IT IS NOT GREATER THAN THE TRUE
; QUOTIENT, AND THE ERROR IS LESS THAN 2**-71. WE ADD 2**-71, TO
; GUARANTEE THAT OUR FRACTION IS GREATER THAN THE TRUE QUOTIENT,
; WITH AN ERROR NO GREATER THAN 2**-71.  WE WILL THEN MULTIPLY THIS
; FRACTION BY 10 N TIMES, REMOVING THE INTEGER PART AT EACH STEP
; TO EXTRACT THE N DIGITS.  SINCE N IS AT MOST 21, THIS IS A MULTIPLI-
; CATION BY AT MOST 10**21, SO THE ERROR IS AT MOST (2**-71)*(10**21).
; SINCE THIS IS LESS THAN ONE, THE ERROR DOES NOT INTRUDE INTO THE
; OUTPUT DIGIT STRING.

;HERE IS LOOP TO EXTRACT DIGITS FROM FRACTION IN AC0,AC1

BDD1:	BR_AR LONG,VMA_PC+1,		;START NEXT LOOP ITERATION
		AR_SLEN+1,SKP CRY0	;ANY MORE DIGITS?
=0					;HERE TO RESUME AFTER INTERRUPT
BDDR4:	SLEN_AR,MQ_AR,SC_1,		;YES, SAVE LENGTH REMAINING
		AR_BR LONG,		; AND GET FRACTION
		SIGNS DISP,J/BDD2	;CHECK FOR 1ST DIGIT OF 10**21
	AR_0S,ARX_0S,CLR FPD,		;NO, DONE.  CLEAR AC0 & AC1
		VMA_VMA+1
	AC0_AR,FETCH,J/STRAC1		;MOVE FETCH WHEN TIMING FIXED
=1101					;LOOK AT BR0 ONLY
BDD2:	AR_AR*1.25 LONG,SC_#,#/4	;NEXT DIGIT TO AR0-3
	ARX_AR,AR_0S,SKP INTRPT		;READY TO SHIFT IN DIGIT
=0	AR_SHIFT,B DISP,J/BDD3		;STORE IT
	AR_BR LONG,SR_0,J/B2DPF		;UPDATE REGS & QUIT

;HERE TO STORE DIGIT IN AR FOR BDEC
=0
BDD3:	VMA_AR+E1,LOAD AR,J/BDD4	;TRANSLATE: GET TABLE ENTRY
	AR_AR+E1,J/BDD7			;OFFSET AR AND STORE IT

BDD4:	SKP MQ EQ -1,TIME/3T,ARX_0.M	;LAST DIGIT?
=0
BDD5:	AR_MEM,J/BDD6			;NO, STORE RH (POS DIGIT)
	ARX_AC3,J/BDD5			;YES, LOOK AT M FLAG
BDD6:	SKP ARX2,ARX_AR SWAP,ARL_0.M
=100
BDD7:	SR_BDD,CALL,J/PUTDST
	AR_ARX,ARL_0.M,J/BDD7		;M SET ON LAST DIGIT, USE LH

	AR_BR LONG,SR_BDT,		;GET FRACTION BACK
		SIGNS DISP		;CHECK BR0 FOR INTEGER PART
=
=1101	AR_AR*10 LONG			;DISCARD PREVIOUS DIGIT
	P_P AND #,#/37,J/BDD1		;CLEAR AR0, GO FOR NEXT

.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