COMPIL(LUP,<%UUOLNK,%ALLOC,SAVE,RESTR,STACSV,STACRS,INSET,USERERR,$PDLOV,.UINIT,ERMSBF> 
	   ,<CORGET,STCLER,GOGTAB,CONFIG,%ALLCHR,CAT,STRNGC,K.ZERO>
	   ,<INITIALIZATION ROUTINES, UUO HANDLER, UTILITY ROUTINES>
	   ,DT.RET)
IFE ALWAYS,<
INTERNAL %ALLOC,DT.RET
EXTERNAL	ALLPDP,SETLET,INILNK,XJBENB
EXTERNAL	SPLNEK,%OCTRET,%RECOV,%ERRC,%RENSW,%ERGO
EXTERNAL	.DTRT.,.ERSTR,.ERSTP,.ERRP.,.ERRJ.,.ERSTC,.ERBWD,CORREL
EXTERNAL	X11,X22,X44,CORINC,%STDLS,%SPL,KTLNK
EXPO <
EXTERNAL	PPMAX
>;EXPO
>;IFE ALWAYS
NOLOW <			;PUT IN UPPER SEGMENT AND ALL THAT FOLLOWS....
UP <
	USE	DSPCH		;A PC FOR VECTOR JRSTS
	USE
	BLOCK =260		;SPACE FOR THE JRSTS.
>;UP
SUBTTL	 %ALLOC -- Main Allocation Routine
HERE (%ALLOC)
IMSSS<;HACK FOR MISERABLE IMSSS LOADER -- REMOVE WITH NEW LOADER
	SETO	1,			;SET TO REMOVE PAGE
	HRRZ	2,JOBREL		;THAT THE LOADER LEAVES
	LSH	2,-11			;WRITE PROTECTED
	ADDI	2,1
	HRLI	2,400000		;THIS FORK
	JSYS	PMAP			;REMOVE
>;IMSSS
	SETZM	.ERBWD			;INITIALIZE ERROR MESSAGES
	MOVEI	C,MINPDS		;ABOUT 64 WORDS
	PUSHJ	P,CORGET		;THIS USUALLY INITS THE USER TABLE
	 ERR	 <NO CORE FOR ALLOCATION>
	PUSHJ	P,PDPMAK		;A PUSH-DOWN POINTER
	MOVE	P,B			;DITCH THE ALLOC PDL
	MOVEM	B,PDL(USER)		;STORE TEMPORARILY
	PUSH	P,16			;THE RETURN ADDRESS
	ADD	P,X22			;ONE DUMMY ENTRY TO TERMINATE
	SETZM	-1(P)			;0 TERMINATES IT
	MOVE	T,SPLNEK		;LIST OF BLOCKS
	MOVEM	T,%SPL			;LINK BUILT-IN BLOCK EXPLICITLY
	MOVEI	T,%SPL			;ALLOCATE IT FIRST
HACK <
%AL1:	MOVEI	T1,$SPREQ(T)		;PTR TO FIRST REQUEST
>;HACK
NOHACK <
	JRST	VEROK			;FORGET THE BUILTIN BLOCK
%AL1:
	HLRZ	TEMP,$CMVER(T)		;RUNTIME VERSION NUMBER
	CAIE	TEMP,(.VERSION & 777777000000)
	SKIPE	CONFIG		;DON'T DO FOR COMPILER
	JRST	VEROK
	ERR	<POSSIBLE COMPILED CODE-RUNTIME INCOMPATIBILITY
CONTINUE IF YOU DARE>,1
VEROK:
	MOVEI	T1,$SPREQ(T)
>;NOHACK
%AL2:	SKIPN	Q2,(T1)			;OP WORD
	 JRST	 NXTELT			;NO MORE THIS BLOCK
	MOVE	Q1,T1			;SAVE ADDRESS OF REQUEST
	TLNN	Q2,STDSPC		;A BUILT-IN RESADR/TEXT?
	 AOJA	 T1,DRCT		; NO, GET IT HERE
	LDB	Q1,[POINT 6,Q2,17]	;THE INDEX
	LSH	Q1,1			;2-WORD ENTRIES ALL
	ADDI	Q1,%STDLST		;HERE'S WHERE THEY LIVE
	HLL	Q2,(Q1)			;USE STANDARD BITS FROM HERE ON
	TLZ	Q2,MINSZ		;NEVER USED FOR MIN WHEN BY INDEX
DRCT:	HRRZ	Q3,1(Q1)		;ADDRESS OF RESULT
	TLZE	Q2,USRTB		;RESULT IN THE USER TABLE?
	ADD	Q3,GOGTAB		;YES
	MOVEI	A,-1(P)			;FOR SEARCH DOWN STACK
	JRST	%AL4			;GO SEARCH
%AL3:	CAIN	Q3,(TEMP)		;SAME ADDR?
	 JRST	 %AL5			;YES, UPDATE
	SUBI	A,2			;BACK UP ONE
%AL4:	SKIPE	TEMP,(A)		;NEXT SAVED OP WORD
	 JRST	 %AL3			;TRY THIS ONE
	MOVEI	A,1(P)			;BACK TO THE TOP
	ADD	P,X22			;NEW ENTRY
	SETZM	(A)
	SETZM	1(A)			;VIRGIN ENTRY
%AL5:	HLL	Q3,Q2		;NEW BITS,,RESADR
	HRRES	Q2		;NEW SIZE
	MOVE	TEMP,1(A)	;OLD TEX,,SIZ
	MOVE	LPSA,(A)	;OLD BITS,,ADR
	JUMPL	Q2,AOJBAK	;NO ACTION ON NEGATIVE SIZE
	TLNE	Q3,MINSZ	;BEGIN THE HAIRY CASE STUDY
	 JRST	 INMIN		;MIN ON IN NEW
	TLZN	LPSA,MINSZ	;¬NMIN, OMIN? -- OMIN←FALSE
	 JRST	 ADDIT		;not NMIN and not OMIN, ADD
	JUMPN	Q2,%AL6		;not NMIN and OMIN, NSIZ?
	TLOA	Q3,MINSZ	;not NMIN and OMIN and not NSIZ,
%AL6:	HLLZS	TEMP	;not NMIN and OMIN and NSIZ,
	JRST	ADDIT		;not NMIN and OMIN, EITHER NSIZ OR OSIZ
INMIN:	TRNE	TEMP,-1		;OSIZ?
	TLZA	Q3,MINSZ	;NMIN and OSIZ, OSIZ unchg, NMIN←FALSE
	TLZA	LPSA,MINSZ	;NMIN and not OSIZ, OSIZ←NSIZ, NMIN←TRUE
	MOVEI	Q2,0		;NMIN and OSIZ again, OSIZ unchg over add
ADDIT:	OR	Q3,LPSA		;COLLECT BITS
	ADD	Q2,TEMP		;AND SIZE
	TLNN	Q2,-1		;ANY TEXT ADDR?
	HLL	Q2,1(Q1)	;NO, GET FROM OLD IF ANY
	MOVEM	Q3,(A)		;PUT NEW AWAY
	MOVEM	Q2,1(A)
AOJBAK:	AOJA	T1,%AL2		;NEXT ELEMENT THIS BLOCK
NXTELT:	SKIPN	T,(T)		;NEXT BLOCK IN ALLOC LIST?
	 JRST	 NOELT		;NO MORE.
LEP <
	SKIPL	$GITNO(T)	;LEAP REQUESTED?
	JRST	%AL1		;NO.
	MOVE	B,GOGTAB	;WILL PLAY WITH USER TABLE
	SETOM	HASMSK(B)	;SOMEONE WANTS LEAP.
>;LEP
	JRST 	%AL1		;CONTINUE DOWN ALLOC BLOCKS.
NOELT:
	MOVE	TEMP,PDL(USER)
	PUSH	P,4(TEMP)
	PUSH	P,5(TEMP)	;MAKE SURE P-REQUEST ON TOP
	SETZM	4(TEMP)		;AND THAT IT DOESN'T HAPPEN TWICE
	SETZM	%ALLCHR		;NO QUESTIONS YET
	SKIPN	%RENSW		;WAS THERE A REENTER?
	 JRST	 NONTR		; NO
	TERPRI
	PRINT	<ALLOC? >
	PUUO	0,B		;ASK LEADING QUESTION AND GET ANSWER
	TERPRI
	TRZ	B,40		; SO CAN USE LOWER CASE
	CAIN	B,"Y"		;YES?
	SETOM	%ALLCHR		;YES
	CAIN	B,"N"		;NO, BUT LET ME SEE IT?
	AOS	%ALLCHR		;RIGHT
	SETZM	%OCTRET		;WHEN ON, NO MORE ASKING
NONTR:
ALOC:	SKIPN	T,-1(P)		;WERE THERE ANY ENTRIES?
	 JRST	 DONEE		; MAYBE, BUT NONE LEFT
	MOVS	A,(P)		;SIZE, TEXT
	TRNE	A,-1
	SKIPL	%ALLCHR		;IF TEXT ADDR AND WANTS TO DO IT,
	 JRST	 NOASK		; MUST ASK QUESTIONS
	PUUO	3,(A)		;PRINT IT
	PRINT	< (>
	HLRZ	C,A		;DEFAULT (+"REQUIRE"d) VALUE
	DECPNT	C		;  "SYSTEM PDL (64) = "
	PRINT	<) = >
	PUSHJ	P,DECIN
	HRL	A,C		;REPLACE REQUESTED SIZE BY OVERRIDE
NOASK:	HLRZ	C,A		;IN CASE NOBODY ELSE DID
	JUMPE	C,PRIN		;DON'T ALLOCATE 0 AREAS
	HRRZ	TEMP,T		;DEST ADDR
	CAIE	TEMP,PDL(USER)	;THE ONE AND ONLY?
	 JRST	 NOEXP		; NO
	HRRZ	B,PDL(USER)	;GET PREV INITIAL CORGET ADDRESS
	CAIGE	C,MINPDS	;MUST BE BIGGER
	 MOVEI	 C,MINPDS	; SO MAKE IT BIGGER
	HRL	A,C		;KEEP EVERYBODY UP TO DATE
	ADDI	B,1		;CORGET ADDR
	CAIG	C,MINPDS
	 JRST	 PDPRET		;NO PROBLEM
	SUBI	C,MINPDS	;AMOUNT TO INCREASE BY
	HRLZ	TEMP,C		;UPDATE P RIGHT NOW
	SUB	P,TEMP		;SIZE FIELD ONLY
	PUSHJ	P,CORINC	;INCREMENT TO PROPER SIZE
	 ERR	 <DRYROT -- NO CORE FOR SYSTEM!PDL>
	ADDI	C,MINPDS	;TOTAL SIZE
	JRST	PDPRET
NOEXP:	PUSHJ	P,CORGET	;GET A BLOCK
	 ERR	 <NO CORE AT ALLOCATION>
PDPRET:	TLNN	T,WNTADR	;WANT THE ADDRESS STORED?
	 JRST	 .+3
	MOVEM	B,(T)		;YES, STORE IT
	ADDI	T,1
	TLNN	T,WNTEND
	 JRST	 NOND
	MOVE	D,C		;SIZE
	ADD	D,B		;END ADDR
	MOVEM	D,(T)
	ADDI	T,1
NOND:	PUSHJ	P,PDPMAK
	TLNE	T,WNTPDP
	MOVEM	B,(T)		;WANTS PDP
PRIN:
SUBJMP:	SUB	P,X22		;SO MUCH FOR THAT ONE	
	JRST	ALOC		;GET THE NEXT
DONEE:	SKIPN	%ALLCHR		;BLABBING?
	 JRST	 .+3		; NO
	TERPRI
	TERPRI
	SUB	P,X44		;PNT TO RETURN ADDRESS (DUMMY AND SYSPDL ENTRIES)
	SETZM	%RENSW		;DON'T ASK EACH TIME
	MOVE	SP,SPDL(USER)	;STRING STACK POINTER
	MOVEI	A,4		;Update ST(USER) to include a .HDRSIZ-word
	ADDB	A,ST(USER)	; header, preceding ST(USER). Call new addr. "SPC".
	HRLI	A,(<POINT 7,0>)	;USER TABLE ENTRIES:
	MOVEM	A,TOPBYTE(USER)	; TOPBYTE ← POINT 7,SPC
	HRRZM	A,STLIST(USER)	; STLIST ← SPC
	MOVE	B,STTOP(USER)	; STINCR ← size(SPC)*5,,size(SPC)+.HDRSIZ
	MOVEM	B,.STTOP(A)	; STREQD ← size(SPC)/8*5,,size(SPC)/8
	SUBI	B,(A)		; REMCHR ← -(size(SPC)*5)+=15
	MOVEM	B,.SIZE(A)	;SPC's header entries:
	SETZM	.LIST(A)	; .LIST ← .NEXT ← 0
	SETZM	.NEXT(A)	; .SIZE ← size(SPC)  (STTOP-new ST)
	MOVEI	TEMP,.HDRSIZ(B)	; .STTOP ← STTOP(USER)
	HRRM	TEMP,STINCR(USER)
	LSH	TEMP,-3
	HRRM	TEMP,STREQD(USER)
	IMULI	TEMP,5
	HRLM	TEMP,STREQD(USER)
	IMULI	B,5
	HRLM	B,STINCR(USER)
	SUBI	B,=15
	MOVNM	B,REMCHR(USER)
	SKIPE	CONFIG		;COMPILER?
	 SETOM	 SGLIGN(USER)	; YES, STRNGC AND FRIENDS MUST ALIGN STRINGS
	HRROI	TEMP,KTLNK
	POP	TEMP,KNTLNK(USER)
	POP	TEMP,SGROUT(USER)
	POP	TEMP,SETLNK(USER)
	POP	TEMP,SPLNK(USER)
	POP	TEMP,STRLNK(USER);TRANSFER LISTS TO USER TABLE
	PUSHJ	P,STCLER	;CLEAR OUT ALL STRINGS
	MOVEI	TEMP,7		;INITIAL DIGS SETTING
	MOVEM	TEMP,DIGS(USER) ;FOR FLOATING POINT OUTPUT
	MOVEI	TEMP,CHANS(USER);IF CHNL HAS A VALID CHANNEL #,
	HRLI	TEMP,CHNL	; @CDBLOC(USER) REFERS TO ITS
	MOVEM	TEMP,CDBLOC(USER);CDB ADDR IN THE CHANS TABLE
	SETZM	XJBENB		; WHERE APR INTERRUPT ENABLINGS ARE REMEMBERED
	SETZM	%ERGO		;REINITIALIZE ERROR PRINTER
	PUSH	P,[=256]
	PUSHJ 	P,ERMSBF
REC <
UP <
	SKIPN	$FSLIS(USER)	;IF NOTHING ON $FSLIS THEN GET SOMETHING
	PUSHJ	P,$FSINI	;THERE
>;UP
>;REC
IFNDEF JOBVER,<EXTERNAL JOBVER>
	MOVEI	LPSA,SPLNEK	;For each element of the space
CHKVRS:	SKIPN	LPSA,(LPSA)	; list, if there is a non-zero 
	 JRST	 ENDINT		; version request, use it (lh is
	SKIPN	TEMP,$VRNO(LPSA); SAIL version, rh is user version).
	 JRST	 CHKVRS		;But if there was a previous non-zero
	HLL	TEMP,JOBVER	; request, and if it is not the
	EXCH	TEMP,JOBVER	; same as this one, complain first.
	TRNE	TEMP,-1
	CAMN	TEMP,JOBVER
	 JRST	 CHKVRS
	ERR	<VERSION NUMBER MISMATCH>,1
	 JRST	 CHKVRS
ENDINT: PUSHJ	P,K.ZERO	;NZERO OUT THE COUNTERS
INIPDS:	HRRZ	A,PDLNK		;PD LINK
INI1PD:	JUMPE	A,INILST	;IF ANY PROCEDURES
	HRRZ	TEMP,PD.LLW+1(A);POINT AT LVI
	HRRZ	A,(A)		;NEXT ONE
	JUMPE	TEMP,INI1PD
PDLLL:	MOVE	LPSA,(TEMP)	;GET AN ENTRY
	TLNN	LPSA,740000	;A 0 MEANS DONE
	JRST	INI1PD
	TLNE	LPSA,37		;INDEX MEANS DO NOTHING
	AOJA	TEMP,PDLLL
	LSH	LPSA,-=32	;ALL HAVE LEFT IS TYPE CODE
	CAIE	LPSA,10		;A CLEANUP IS EXEMPT
	CAIN	LPSA,17		;AS IS A BLOCK END
	AOJA	TEMP,PDLLL
	SETZM	@(TEMP)		;MAKE IT VIRGIN
	AOJA	TEMP,PDLLL	;
INILST:	
	SKIPN	TEMP,INILNK
	POPJ	P,
	MOVE	USER,GOGTAB	;JUST TO BE SURE
	SKIPA	A,[XWD -SYSPHS,0]	;XWD #SYS PHASES,0
DOPHS:	HRRZ	TEMP,INILNK	;LIST OF THEM
NXLNK:	
	PUSH	P,TEMP		;SAVE LINK
NXIN:	ADDI 	TEMP,1		;LOOK AT NNEXT ENTRY
	SKIPN	B,(TEMP)	;END OF LINK LIST
	JRST	NXIN.1		;YES
	HLRZ	C,B		;PHASE NUMBER OF THIS
	CAIE	C,(A)		;THIS PHASE
	JRST	NXIN		;NO
	PUSH	P,A
	PUSH	P,TEMP
	PUSH	P,USER
	PUSHJ	P,(B)
	POP	P,USER
	POP	P,TEMP
	POP	P,A
	JRST	NXIN		;GO DO NEXT IN THIS
NXIN.1:	POP	P,TEMP
	HRRZ	TEMP,(TEMP)
	JUMPN	TEMP,NXLNK
NXPHS:	AOBJN	A,DOPHS		;GO ON TO NEXT PHASE
	POPJ	P,		;
HERE(.UINIT)
	MOVE	A,[XWD -USRPHS,400000] ;DO USER PHASES
	SKIPN  INILNK
	POPJ	P,
	JRST	DOPHS
PDPMAK:	MOVNS	C
	SUBI	B,1		;PDP
	HRL	B,C
	POPJ	P,
>;NOLOW
DECIN:
OCTIN:	AOS	(P)
	SKIPE	%OCTRET		;IMMEDIATE RETURN?
	 POPJ	 P,		; YES
	SETZB	C,D
OCTIN1:	PUUO	4,B		;	;; INCHWL, was 0,B (INCHRW)
	CAIN	B,175		;ALTMODE?
	 JRST	 SETRET
	CAIN	B,12		;LINE FEED?
	 JRST	 EPOP		;YES
	CAIL	B,"0"
	CAILE	B,"9"		;I KNOW IT'S CALLED OCTIN,
	 JRST	 OCTIN1		; BUT INPUT IS IN DECIMAL!!
	SETOM	D		;FOUND SOMETHING LIKE A NUMBER
	IMULI	C,=10		;GOOD OLD NUMBER CONVERSION
	ADDI	C,-"0"(B)
	JRST	OCTIN1		;THIS IS A LOOP
SETRET:	SETOM	%OCTRET		;WILL RETURN IMMEDIATELY HENCEFORTH
	TERPRI
EPOP:	SKIPE	D		;FIND ANYTHING?
	SOS	(P)		;YES
CPOPJ:	POPJ	P,
SUBTTL	%UUOLNK -- UUO Handler (Dispatch Vector Just Below)
NOLOW <			;INCLUDE IN UPPER SEGMENT.....
HERE(%UUOLNK)
UUOCON: PUSH	P,FF		;SAVE REGISTER 0
	PUSH	P,A		;AND REGISTER 1
	MOVE	FF,@JOBUUO	;ARGUMENT BEFORE CLOBBERING AC'S
	LDB	A,[POINT 9,JOBUUO,8] ;GET OP CODE.
	JRST	@UUOTBL(A)	;DISPATCH TO CORRECT ROUTINE.
RETM:	POP	P,D		;RESTORE SAVED AC'S
	POP	P,C
	POP	P,B
USRXIT:	POP	P,A
	POP	P,FF		;RESTORED AC'S
	POPJ	P,		;AND RETURN!
SAVM:	PUSH	P,B		;SAVE AC'S -- CALLED WITH JSP 0
	PUSH	P,C
	PUSH	P,D		;ENUF
	PUSH	P,[RETM]
	JRST	@FF		;RETURN
SAVALL:	PUSH	P,2		;SAVES ACS 2-15 (ASSUMES 0,1 TOP 2 ELTS)
	HRLZI	2,-13		;NUMBER LEFT TO SAVE
	PUSH	P,3(2)		;SAVE AN AC
	AOBJN	2,.-1		;COUNT DOWN
	PUSH	P,[RSTALL]	;POPJ WILL FALL INTO RSTALL
	JRST	@FF		;RETURN
RSTALL:	HRLZI	15,-15(P)	;ASSUMES STACK HAS (RETADR, ACS 0-15)
	BLT	15,15		;RESTORE THE ACS
	SUB	P,[XWD 16,16]	;GIVE BACK THE SPACE
	POPJ	P,		;RETURN
UUOTBL:	JRST	ILLUUO		;0
	JRST	ILLUUO		;1
	JRST	FLOAQ		;2 -- FLOAT A NUMBER
	JRST	FIXQ	   	;3 -- FIX A NUMBER
	JRST	IOERRR		;4 -- I/O ERROR
	JRST	ERRR		;5 -- STANDARD ERROR UUO
	JRST	PSIXQ		;6 -- SIXBIT PRINT
	JRST	ARERRR		;7 -- ARRAY ERROR
	JRST	RUUO		;10 -- RECUUO
	JRST	DECPNQ		;11 -- PRINT DECIMAL NUMBER
	JRST	OCTPNQ		;12 -- PRINT OCTAL NUMBER
	JRST	ILLUUO		;13
	JRST	ILLUUO		;14
	JRST	PRINIT		;15 -- HANDLE TERMINAL
HERE($PDLOV)			;PLACE TO COME WHEN A STACK
	MOVEI	TEMP,TEMP	;IS EXHAUSTED.
	POP	TEMP,TEMP	;THIS WILL CAUSE PDLOV
	JRST	(USER)		;RETURN IF USER CAN.
↑RUUO:	LDB	A,[POINT 4,JOBUUO,=12]	;AC FIELD IS THE MINOR OPCODE
	CAILE	A,RDLAST		;
	JRST	USRUUO			;DEFAULT CASE IS USRUUO
	JUMPN	A,@RDISP(A)		;DISPATCH
RDREF:	SKIPE	A,FF			; DE-REFERENCE -- DO WE HAVE A RECD?
	SOSLE	-1(A)			; DROP COUNT BY ONE
	JRST	USRXIT			; GO EXIT FROM UUO LEVEL
UINCUU:	AOS	-1(A)			; SINCE WILL DO DEREFERENCING SOS AGAIN
USRUUO:	MOVE	A,FF			;A GETS THE RECORD ADDRESS
	JSP	FF,SAVALL		;SAVE ALL THOSE ACS
USRUUX:	LDB	FF,[POINT 4,JOBUUO,=12]	;GET MINOR OP AGAIN
UCALL0:	PUSH	P,FF			; OP CODE
	PUSH	P,A			; RECORD ID
	PUSH	P,[0]			; A PLACE HOLDER
	PUSHJ	P,@(A)			; CALL THE USER ROUTINE (POSSIBLY $REC$)
	POPJ	P,
USRUU1:	MOVE	A,FF			;LIKE USRUUO BUT RETURNS AC1
	JSP	FF,SAVALL		;SAVE SOME ACS
	PUSHJ	P,USRUUX		;DO THE REST
	MOVEM	A,-15(P)		;WHERE AC1 IS STORED ON THE STACK
	POPJ	P,			;RETURN WILL FALL INTO RSTALL
RDISP:	JRST	RDREF	;0 -- DEREFERENCE E.G RECUUO 0,RECVAR
	JRST	USRUU1	;1 -- ALLOCATE: E.G RECUUO 1,[CLASSID]
	JRST	UINCUU	;2
RDLAST ←← (.-RDISP)-1	
OCTPNQ: MOVE	A,FF		;GET ARGUMENT
	JSP	FF,SAVM		;SAVE MORE AC'S
OCTO:	SKIPA	C,[PUUO 1,B]
OCTOB:	MOVE	C,[PUSHJ P,.PUTBE]
	MOVEI	FF,10		;KEEP RADIX IN FF.
	JUMPGE	A,PNT
	MOVEI	FF,=12		;JUST PRINT THE BYTES
PNTO.1:	MOVEI	B,0		;
	ROTC	A,3		;
	IORI	B,"0"		;
	XCT	C		;PUT IT OUT
	CAIN	FF,7		;FOR THE SPACE
	JRST	PNTO.2		;IN THE MIDDLE
	SOJG	FF,PNTO.1	;COUNT DOWN
	POPJ	P,		;DONE 
PNTO.2:	MOVEI	B,","		;PUT OUT ,,
	XCT 	C
	XCT	C
	SOJA	FF,PNTO.1	;GO ON
DECPNQ:	MOVE	A,FF		;GET ARGUMENT
	JSP	FF,SAVM
DECO:	SKIPA	C,[PUUO 1,B]
DECOB:	MOVE	C,[PUSHJ P,.PUTBE]
	MOVEI	FF,=10
	JUMPGE	A,PNT		; GREATER 0.
	MOVEI	B,"-"
	XCT	C
	MOVMS	A		; FOO1 ← ABS(FOO1)	;
PNT:	IDIV	A,FF		;FAMOUS DEC RECURSIVE NUMBER PRINTER.
	IORI	B,"0"
	HRLM	B,(P)
	SKIPE	A
	PUSHJ	P,PNT
	HLRZ	B,(P)
	XCT	C		;EITHER PRINT IT OR STORE IT
	POPJ	P,		;RETURN TO RETM
.PUTBE:	SOSG	.ERSTC		;ROOM LEFT????
	JRST	PRA.NO		;NO ROOM
	IDPB	B,.ERSTP	;YES
	POPJ	P,
FIXQ:	MULI	FF,400		;THIS ALGORITHM STOLEN FROM F4.
	TSC	FF,FF
	EXCH	FF,A
	ASH	FF,-243(A)
	JRST	FXFLT		;STORE IN RIGHT PLACE.
FLOAQ:	IDIVI	FF,400000
	SKIPE	FF
	TLC	FF,254000
	TLC	A,233000
	FAD	FF,A
FXFLT:	LDB	A,[POINT 4,JOBUUO,12] ;RESULT REGISTER
	CAIG	A,1		;NUMBER OF AC'S SAVED
	 ADDI	 A,-1(P)	;ADJUST TO FIND STACK SPOT
	MOVEM	FF,(A)		;AND RETURN RESULT
	JRST	USRXIT		;AND RETURN TO USER
PRINIT:				;IF NOT ASSEMBLED, FALL INTO ILLUUO
TENX <
	LDB	A,[POINT 4,JOBUUO,12]
	HRRZ	FF,JOBUUO
	TRNN	FF,777776	;IF ADDR. IS FF OR A GET ARG AND/OR
	ADDI	FF,-1(P)	;PUT ANSWER ON STACK WORD FOR FF OR A
	JRST	@.+1(A)
	TTC0
	TTC1
	TTC2
	TTC3
	TTC4
	TTC5
	ILLUUO
	ILLUUO
	ILLUUO
	TTC11
	TTC12
	TTC13
	TTC14
	ILLUUO
	ILLUUO
	ILLUUO
TTC4:	;EFFECTIVELY SAME AS TTC0 GIVEN 10X WAKEUP BEHAVIOR
TTC0:	MOVEM	B,TTCSVB	;SAVE B.
TTC01:	HRRZI	1,100	;B34 of RFMOD word returned in 2 says
	JSYS	RFMOD	;that BKJFN has been done since last char was
	JSYS	PBIN	;read, i.e. this PBIN will get a re-run. This is
	CAIN	1,37	;best EOL-to-CRLF conversion hack I can devise.
	 JRST	TTCEOL	;It's impossible to stick a linefeed back in
TTC0RT:	MOVE	B,TTCSVB	;tty input buffer IN FRONT OF extant type-ahead.
	MOVEM	A,@FF
	JRST	USRXIT	;Returning just CR causes SAIL to look for non-
TTCEOL:	TRNE	2,2	;existent LF following. And setting a flag loses
	 JRST	TTC0BK	;when some random other code does a PBIN. This
	HRRZI	1,100	;way, random other code gets a 37 too (Oh well).
	JSYS	BKJFN	;but at least the pending LF is cleared (since
	 JFCL		;the BKJFN bit is cleared). This code returns a
	HRRZI	A,15	;CR on first reading of EOL and a LF on second.
	JRST	TTC0RT
TTC0BK:	HRRZI	A,12	;Second reading of eol here.
	JRST	TTC0RT	;"flag" is effectively cleared by PBIN.
TTC1:	HRRZ	1,@FF
	JSYS	PBOUT
	JRST	USRXIT
TTC2: ;Effectively same as TTC 5.
TTC5:	HRRZI	A,100
	MOVEM	B,TTCSVB ;SAVE B - NEW SIBE: B←CNT OF CHRS WAITING IF ANY
	JSYS	SIBE
	 AOSA	-2(P)	;Get char and skip return
	JRST	USRXIT	;NOSKIP, NO CHAR, B UNCHANGED
	JRST	TTC01
TTC3:	HRRO	1,FF
	JSYS	PSOUT
	JRST	USRXIT
TTC11:	HRRZI	1,100
	JSYS	CFIBF
	JRST	USRXIT
TTC12:	HRRZI	1,101
	JSYS	CFOBF
	JRST	USRXIT
TTC13:
TTC14:	HRRZI	A,100
	JSYS	SIBE
	 AOS	-2(P)		;CHAR HAS BEEN TYPED, SKIP RET (BUT
	JRST	USRXIT		;NOTHING, NOSKIP.
>;TENX
NOTENX <
IFN 0,<
	MOVE	A,FF		;SAVE ARGUMENT
	JSP	FF,SAVM		;GET MORE AC'S
	LDB	C,[POINT 4,JOBUUO,12]
	JRST	@PTBL(C)
PTBL:	GCH			;0 -- GET A CHAR
	PCH			;1 -- PRINT A CHAR
	0
	PST			;3 -- PRINT A STRING
PST:	TTCALL	3,@JOBUUO	;CALL SYSTEM
	POPJ	P,
PCH:	TTCALL	1,A		;PRINT CHAR
	POPJ	P,
GCH:	HRRZ	B,JOBUUO	;GET EFF ADDRESS
	CAIG	B,D
	 ADDI	 B,-5(P)	;RELOCATE INTO STACK.
	TTCALL	0,(B)		;AND READ A CHAR
	POPJ 	P,
>;0
>;NOTENX
ILLUUO:	MOVE	A,[ERR <Illegal UUO>]
	MOVEM	A,JOBUUO
ERRR:	JSP	FF,SAVM		;SAVE MORE AC'S
	LDB	B,[POINT 4,JOBUUO,12] ;CODE IN AC FIELD
	JRST	ERRW
ARERRR:	JSP	FF,SAVM		;SAVE MORE AC'S
	MOVSI	D,4		;PRINTING INSTRUCTIONS
	MOVEI	B,20		;ERROR CODE -- FATAL
	JRST	ERRX
IOERRR:	JSP	FF,SAVM		;SAVE MORE AC'S
	MOVEI	B,16		;ERROR CODE -- FATAL
ERRW:	MOVEI	D,0
ERRX:	ROT	B,-1		;CONTINUE BIT TO SIGN BIT
	MOVEM	B,%RECOV	;AND SAVE FOR TESTING LATER
	MOVE	C,-6(P)		;RETURN ADDRESS
	MOVEM	C,.DTRT.	;SAVE AS DDT RETURN ADDRESS
	SKIPN	C,.ERBWD	;INITIALIZED ??
	MOVE	C,[XWD .ERSWC*5*40,.ERSTR] ;.ERSWC*5 CHARS IN .ERSTR
	MOVEM	C,.ERBWD	;BE SURE PUT AWAY OK
	LSH	C,-5		;THE COUNT FIELD
	HLRZM	C,.ERSTC	;REMEMBER THE COUNT
	MOVEI	C,@.ERBWD
	HRLI	C,(<POINT 7,0>)	;MAKE UP THE BYTE PTR
	MOVEM	C,.ERSTP
	MOVEI	A,[BYTE(7) 15,12,0]
	PUSHJ	P,PRA		;BEGIN EACH ERROR MESSAGE WITH CRLF.
	MOVE	A,JOBUUO	;GET UUO BACK
	TLZN	D,4		;DO NOT PRINT EFF ADDR OF ARRAY UUO
	 PUSHJ	 P,PRA		;PRINT ACSIZ STRING INTO ERSTR
	MOVE	A,JOBUUO
	PUSHJ	P,@URTBL(B)	;AND DO SPECIAL-CASE STUFF
	MOVEI	A,[BYTE(7) 15,12,0]
	PUSHJ	P,PRA		;TERMINATE WITH CRLF
	IDPB	FF,.ERSTP	;AND A ZERO.
	SKIPE	D,%ERRC		;IF USERRR LEFT A POINTER
	 JRST	[MOVE D,1(D)	;GET BYTE POINTER
		 ILDB D,D	;GET FIRST RESPONSE CHARACTER
		 JRST .+1]
	SKIPN	.ERRP.		;DOES USER HAVE A ROUTINE?
	 JRST	 NOUSRR		;NO
	MOVE	C,[XWD D-15,D+1] ;AOBJN POINTER TO DO PUSHES
	PUSH	P,(C)		;PUSHES WILL CAUSE PDLOV
	AOBJN	C,.-1		;COUNT DOWN
	MOVE	USER,GOGTAB
	MOVE	C,[XWD -13,RACS] ;ALSO SAVE RUNTIME AC'S
	ADDI	C,(USER)	;RELOCATE
	PUSH	P,(C)
	 AOBJN	 C,.-1
	PUSH	P,UUO1(USER)	;SAVE RUNTIME RETURN ADDRESS
	SETZM	.ERRJ.		;ASSUME NO USER TRANSFER ADDRESS
	MOVE	A,-33(P)	;UUO RETURN ADDRESS
	SUBI	A,1
	PUSH	P,SP		;SAVE STRING STACK POINTER (OR,
	SKIPL	CONFIG		;IF IN COMPILER, GENERATE
	 JRST	 .+4
	MOVEI	SP,(P)		;A FAKE STACK BECAUSE OF CONFLICT
	HRLI	SP,-5		;WITH PARSE STACK
	ADD	P,X44
	PUSH	P,A		;ADDR OF UUO = ARG TO PROC.
	HRRZ	A,.ERSTP	;NOW COMPUTE LENGTH OF STRING
	SUBI	A,@.ERBWD	;SAVED AWAY
	IMULI	A,5
	LDB	B,[POINT 6,.ERSTP,5]
	IDIVI	B,7
	MOVN	B,B
	ADDI	A,4(B)		;TOTAL NUMBER OF CHARACTERS (NOT INCL NULL)
	PUSH	SP,A		;TO STRING STACK.
	MOVEI	A,@.ERBWD
	HRLI	A,(<POINT 7,0>)	;MAKE UP THE BYTE PTR
	PUSH	SP,A
	SKIPN	A,%ERRC		;TRACKS LEFT BY USERRR??
	 MOVEI	 A,[0
		    0]		;NO
	PUSH	SP,(A)
	PUSH	SP,1(A)
	PUSHJ	P,@.ERRP.
	SKIPGE	CONFIG		;IF IN COMPILER, THEN
	 SUB	 P,X44		;BACK UP THE STACK.
	POP	P,SP		;RESTORE STRING STACK.
	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;RESTORE THINGS
	MOVEI	B,12
	MOVEI	C,RACS+12(USER)
	POP	P,(C)
	SUBI	C,1
	 SOJGE	 B,.-2		;TILL DONE
	HRLZI	FF,D+1-15(P)	;FROM HERE ON STACK
	HRRI	FF,D+1		;FIRST AC TO RESTORE
	BLT	FF,15		;GET THEM BACK
	SUB	P,[XWD 15-D,15-D] ;ADJUST
	MOVEM	A,D		;SAVE PRINTING INSTRUCTIONS
	SKIPE	B,.ERRJ.	;IF USER SPECIFIED RETURN ADDRESS
	 MOVEM	 B,-6(P)	;REPLACE CURRENT ONE.
NOUSRR:	
	TLZN	D,1		;IF INHIBITED,
	 PUUO	 3,@.ERBWD	;PRINT ERROR STRING.
	MOVE	A,-6(P)		;RETURN ADDRESS
	TLZN	D,2		;IF NOT INHIBITED,
	 PUSHJ	 P,CALLEDFROM	;PRINT SAIL MESSAGE
	SETZM	%ERRC		;NO MORE USERRR SPEC.
	PUSHJ	P,WATNOW	;GO GET A RESPONSE.
	 MOVEM	 A,-6(P)	;REPLACE RETURN ADDRESS
	POPJ	P,
HERE(DT.RET)			;JRST HERE TO GET BACK FROM DDT
	JRST	@.DTRT.		;GONE.
CALLEDFROM:
	PRINT	<Called from >
	MOVEI	A,-1(A)
	PUSHJ	P,OCTO		;PRINT IT IN OCTAL
	SKIPGE	CONFIG		;RUNTIMES
	 JRST	NOLSCL
	PRINT	 <  Last SAIL call at >
	MOVE	A,GOGTAB
	HRRZ	A,UUO1(A)
	SOS	A
	PUSHJ	P,OCTO
NOLSCL:	TERPRI
	POPJ	P,		;END OF CALLEDFROM ROUTINE.
WATNOW:	
IMSSS<;IMSSS KLUDGE FOR STUDENT SYSTEM
	PUSHJ	P,KIDCHK	
>;IMSSS
	MOVE	A,GOGTAB	;ADDRESS OF USER TABLE
	HRRZ	FF,TOPBYTE(A)	;CURRENT STRING POINTER
	CAMLE	FF,STTOP(A)	;IN RANGE?
	 JRST	 [TERPRI <String space exhausted unexpectedly.
Any attempt to continue will cause a restart.>
		  MOVEI FF,[JRST @JOBREN]
		  MOVEM FF,-7(P) ;NEW RETURN ADDRESS.
		SETZB	D,%ERGO
		  JRST .+1]
	SKIPE	%ERGO		;CONTINUOUS CONTINUE?
	JRST	GOTRY		;AUTOMATIC CONTINUE SET
	SKIPE	A,D		;IF A RESPONSE CHARACTER IS SPECIFIED,
	 JRST	 RESGOT		;GO USE IT.
QUES:	PUUO	2,A		;INCHRS
	 JRST	 PRMPT		;NO CHARACTER -- PROMPT
	PUUO	11,0		;CLEAR INPUT BUFFER
	CAIN	A,12		;IF FEED, USE IT
	 JRST	 RESGOT		;CAN ONLY TYPE AHEAD LF.
PRMPT:	MOVEI	A,"?"		;PRINT ? FOR IRRECOVERABLE ERRORS,
	SKIPGE	%RECOV		; ↑ FOR RECOVERABLE ONES.
	MOVEI	A,"↑"		;SOMETHING PRINTABLE.
	PUUO	1,A		;PRINT IT
	PUUO	0,A		;GET RESPONSE CHAR
	CAIN	A,15		;IF RESPONSE CR, THEN
	 PUUO	 2,FF		; INCHRS
	 JFCL			; DON'T DO INCHRW HERE BECAUSE OF PTY'S
RESGOT:
	CAIL	A,"a"		;lower case?
	SUBI	A,40		;YES, CONVERT TO UPPER
	CAIN	A,"E"		;RE-EDIT?
	 JRST	 EDIT		; YES
	CAIN	A,"T"		;TVEDIT?
	 JRST	 TVEDIT
	CAIN	A,"S"		;START?
	 JRST	 STRTIT		;YES
	CAIN	A,"X"		;EXIT
	 JRST	 XIT
	CAIN	A,"D"		;DDT
	 JRST	 DDIT		;.
	CAIE	A,"A"
	CAIN	A,12		;CONTINUE AUTOMATISCH?
	 SETOM	 %ERGO		;YES
	CAIN	A,"C"		;CONTINUE AT ALL COSTS?
	 JRST	EPOPJ		;YES -- SKIP RETURN.
	CAILE	A,15		;TRY TO CONTINUE?
	 JRST	 BADRSP		;INCORRECT RESPONSE
GOTRY:	SKIPGE	%RECOV		;CAN WE CONTINUE?
	 JRST	 EPOPJ		;YES -- SKIP RETURN
	TERPRI	<Can't continue>
	JRST	QUES
STRTIT:	HRRZ	A,JOBSA
	JRST	(A)		;AWAY WE GO!
IMSSS<;KLUDGE FOR STUDENT SYSTEM
KIDCHK:	PUSH	P,A
	PUSH	P,B
	MOVEI	A,101		;PRIMARY INPUT
	JSYS	RFMOD
	TRNE	B,1B33 		;A STUDENT JOB?
	  JRST	ISKIDY		;YES
	POP	P,B
	POP	P,A
	POPJ	P,
ISKIDY:	HRROI	A,[ASCIZ/
Sorry, system error.
/]
	JSYS	PSOUT
	SETO	A,
	JSYS	KLGOT		;LOG HIM OUT
>;IMSSS
NOTENX <
DDIT:	SKIPN	JOBDDT
	 JRST	 [TERPRI <No DDT>
		  JRST QUES]	;NO SUCH ANIMAL
EXPO <
	TERPRI	<
TYPE DT.RET$G TO CONTINUE
>
>;EXPO
	SKIPA	A,[[JRST @JOBDDT]] ;PREPARE TO CALL DDT
XIT:
	MOVEI	A,[CALL6 (EXIT)]	;PREPARE TO EXIT
	POPJ	P,		;NON SKIP RETURN.
EPOPJ:	AOS	(P)		;SKIP RETURN
	POPJ	P,
>;NOTENX
TENX <	;TENEX CODE TO GET UDDT (DEFINED IN THE FILSPC SECTION OF HEAD) 
DDTORG←←770000
DDTPAG←←770
UDTSYM←←DDTORG+1			;UDDT KEEPS A SYMBOL TABLE POINTER HERE
DDIT:	SKIPE	JOBDDT
	  JRST [HRROI	1,[ASCIZ/
Type DT.RET$G to continue.
/]
		JSYS	PSOUT
		MOVEI 	A,[JRST @JOBDDT]
		POPJ	P,]
	PUSH	P,1
	PUSH	P,2
	MOVE	1,[XWD 400000,DDTPAG]	;XWD THIS FORK, PAGE 770	
	JSYS	RPACS			;TEST FOR PAGE 770
	TLNN	2,10000			;DOES PAGE 770 EXIST?
	   JRST	GTUDDT			;NOPE
	MOVE	1,DDTORG
	CAME	1,[JRST DDTORG+2]	;DOES IT LOOK LIKE UDDT?		
	   JRST	GTUDDT			;NOPE
GOTUDT:	HRROI	1,[ASCIZ/
Type DT.RET$G to continue.
/]
	JSYS	PSOUT
	POP	P,2
	POP	P,1	
	MOVEI	1,[JRST DDTORG]		;SET UP FOR CALL
	POPJ	P,
GTUDDT:	MOVSI	1,1
	HRROI	2,[UDTFIL]
	JSYS	GTJFN
	   JRST	[HRROI	1,[ASCIZ/
Cannot GTJFN file:
/]
		 JSYS PSOUT
		 HRROI	1,[UDTFIL]
		 JSYS PSOUT		
		 JSYS HALTF
		]
	PUSH	P,1			;SAVE JFN
	MOVEI	1,400000		;THIS FORK
	JSYS	GEVEC			;GET ENTRY VECTOR INTO 2
	POP	P,1			;JFN FOR UDDT FILE	
	HRLI	1,400000		;THIS FORK
	JSYS	GET
	MOVEI	1,400000		;THIS FORK
	JSYS	SEVEC			;PUT BACK THE ENTRY VECTOR
	MOVE	1,JOBSYM		;SET UP SYMBOL TABLE POINTER
	MOVEM	1,@UDTSYM		;SAVE FOR USER
	JRST	GOTUDT			;AND RETURN
XIT:	MOVEI	A,[JRST DOHLTF]		;TENEX VERSION OF EXIT CODE
	POPJ	P,
EPOPJ:	AOS	(P)			;SKIP RETURN
	POPJ	P,
DOHLTF:	HRROI	A,-1
	JSYS	CLOSF				;CLOSING ALL FILES
	  JFCL				;IS PROBABLY DONE 
	JSYS	HALTF			;AUTOMATICALLY ON
	JRST 	.-1			;THE DEC SYSTEM
>;TENX
BADRSP:	TERPRI	<Reply [CR] to continue,
[LF] to continue automatically,
"D" for DDT, "E" to edit,
"X" to exit, "S" to restart>
	JRST	QUES		;GET ANOTHER RESPONSE.
SUBTTL	  Special Printing Routines For Error Handler
↑↑URTBL:UPOPJ		; 0- 1 -- NO ACTION
	.PRSM		; 2- 3 -- PRINT SYMBOL PTD TO BY LPSA (SAIL)
	PRASC		; 4- 5 -- PRINT SYMBOL PTD TO BY UUO INSTR
	ACPRT		; 6- 7 -- PRNT VAL OF AC IN INSTR PRECDNG UUO
	UUOPRT		;10-11 -- PRINT THE UUO
	AC1PRT		;12-13 -- PRINT AC FIELD ASSUMING RETURN FROM
	SIXPRT		;14-15 --PRINT LPSA AS SIXBIT
	IOER2		;16-17 --SECOND HALF OF IOERR
	ARER2		;20-21 --SECOND HALF OF ARRERR
UUOPRT: PUSH	P,A		;SAVE UUO
	HLRZ	A,A
	PUSHJ	P,OCTOB		;TYPE IT
	POP	P,A		;RESTORE
	HRRZS	A
	JRST	OCTOB		;TYPE IT TOO
	$PNAME ←← 1
.PRSM:	HRRI	A,$PNAME(LPSA)	;PTR TO STRING DESCRIPTOR
PRASC:	HRRZ	B,(A)		;#CHARACTERS
	MOVE	A,1(A)		;STRING BP
	MOVEI	C,0		;NO ADJUSTMENT
	MOVE	D,[PUSHJ P,.PUTFE]
	JRST	PRSL1
IOER2:	TLNN	A,740		;AC FIELD SPECIFIED?
	 POPJ	 P,		;NO -- DONE
SIXPRT:	MOVE	D,[PUSHJ P,.PUTFE]
	SKIPA	A,[POINT 6,LPSA];GET FROM HERE
PSIX:	HRLI	A,(<POINT 6,0>) ;UUO ADDR IS ADDR OF SIXBIT
	MOVEI	C,40		;ADJUSTMENT
	MOVEI	B,6		;PRINT 6 CHARS
	JRST	PRSL1
PRSL:	ILDB	FF,A		;CHARACTER
	ADDI	FF,(C)		;ADJUSTMENT
	XCT	D		;PUSH TO ERROR STRING OR TYPE IT.
PRSL1:	SOJGE	B,PRSL
UPOPJ:	POPJ	P,
AC1PRT:	MOVE	A,GOGTAB	;GET USER TABLE PTR
	SKIPA	A,UUO1(A)	;SOMEONE STORED RIGHT THING HERE
ACPRT:	HRRZ	A,-7(P)		;RETURN ADDRESS
	LDB	A,[POINT 4,-2(A),12] ;AC # FROM PREV INSTR
	CAIG	A,D		;IF BIN SAVED AC'S
	 ADDI	 A,-6(P)	;RELOCATE
	MOVE	A,(A)		;PICK UP VALUE.
	JRST	DECOB		;PRINT IT IN DECIMAL
ARER2:	PUSH	P,A		;SAVE UUO
	MOVEI	A,[ASCIZ /Invalid index for array /]
	PUSHJ	P,PRA		;TO ERROR STRING.
	MOVE	A,(P)		;GET POINTER TO ARRAY NAME
	PUSHJ	P,PRASC		;PRINT ARRAY NAME
	MOVEI	A,[ASCIZ /. Index no. /]
	PUSHJ	P,PRA
	POP	P,A		;RESTORE UUO
	LDB	A,[POINT 4,A,12]
	PUSHJ	P,DECOB		;PRINT INDEX NUMBER
	MOVEI	A,[ASCIZ /. Value is /]
	PUSHJ	P,PRA
	JRST	ACPRT		;PRINT VALUE IN PRECEDING AC.
PSIXQ:	MOVE	A,JOBUUO	;UUO
	JSP	FF,SAVM		;GET STACK AND AC'S
	MOVE	D,[PUUO 1,FF]	;PRINT DIRECTLY
	JRST	PSIX		;TYPE IT.
PRA:	HRLI	A,(<POINT 7,0>)	;PUSH STRING TO ERROR BUFFER
PRA.CK:	SOSG	.ERSTC		;ENOUGH ROOM ??
	JRST	PRA.NO		;NOPE
	ILDB	FF,A
	JUMPE	FF,UPOPJ	;DONE AT ZZERO BYTE
	IDPB	FF,.ERSTP
	JRST	PRA.CK		;LOOP
PRA.NO:	SKIPL	.ERSTC		;ALREADY COMPLAINED??
	TERPRI	<.... ERROR MESSAGE TOO LONG .... 
>
	POPJ	P,
.PUTFE:	SOSG	.ERSTC			;ROOM???
	JRST	PRA.NO		;NOPE
	IDPB	FF,.ERSTP	;YEP
	POPJ	P,
HERE (USERERR)
	MOVE	USER,GOGTAB
	MOVEI	A,1		;BE SURE THAT DONT GC AT BAD TIME
	AOSL	REMCHR(USER)	;
	PUSHJ	P,STRNGC	;
	IBP	TOPBYTE(USER)	;BE SURE THAT HAVE NEITHER STRING AT TOP
	PUSHJ	P,INSET		;GET TO FW BNDRY
	PUSH	SP,[1]		;CONCATENATE A NULL TO END OF RSP STRING
	PUSH	SP,[POINT 7,[0]]
	PUSHJ	P,CAT
	MOVE	TEMP,-3(SP)	;EXCHANGE RESPONSE AND MSG STRINGS ON STACK
	EXCH	TEMP,-1(SP)
	MOVEM	TEMP,-3(SP)
	MOVE	TEMP,-2(SP)
	EXCH	TEMP,(SP)
	MOVEM	TEMP,-2(SP)
	PUSHJ	P,INSET		;
	PUSH	SP,[1]		;CONCATENATE A NULL FOR TTCALL
	PUSH	SP,[POINT 7,[0]]
	PUSHJ	P,CAT
	MOVEI	TEMP,-3(SP)	;ADDRESS OF RESPONSE STRING.
	MOVEM	TEMP,%ERRC	;SAVE FOR ERROR UUO.
	POP	P,UUO1(USER)
	SKIPG	TEMP,(P)	;IS CODE 0?
	ERR.	@(SP)		;YES, NO CONTINUATION POSSIBLE
	CAIN	TEMP,1		;IS CODE 1?
	ERR.	1,@(SP)		;YES, JUST PRINT ERROR, ALLOW CONT
	CAIGE	TEMP,2		;IS IT SOMETHING ELSE
	JRST	USERBAK		;NO
	MOVE	TEMP,-1(P)	;YES, SET UP SO ERR. GUY WILL PRINT VALUE
	ERR.	7,@(SP)		; AND DO IT
USERBAK:
	SUB	SP,X44
	SUB	P,X22
	JRST	@UUO1(USER)	;RETURN FROM ROUTINE.
HEREFK(ERMSBF,.ERMBF)
	PUSHJ	P,SAVE
	MOVE	A,-1(P)		;GET NEW BUFFER, IF NEED IT
	MOVEI	B,0		;
	CAIGE	A,.ERSWC*5	;WILL .ERSTR WORK ??
	JRST	FROLD		;YES THE 0 WILL FORCE ITS USE BY NEXT ERR UUO
	MOVE	C,A		;HOW MANY WORDS??
	IDIVI	C,5		;
	ADDI	C,1		;FOR SAFETY'S SAKE
	PUSHJ	P,CORGET	;TRY & GET A BLOCK
	ERR	<CORGET OUT OF ROOM>
	DPB	A,[POINT =13,B,12] ; COUNT INTO B
FROLD:	EXCH	B,.ERBWD	;
	JUMPE	B,ERSXT		;WAS NULL BEFORE ??
	MOVEI	B,@B		;GET ADDRESS
	CAIE	B,.ERSTR	;WAS .ERSTR BEFORE ??
	PUSHJ	P,CORREL	;NO, MUST BE A CORGET BLOCK
ERSXT:	MOVE	LPSA,X22
	JRST	RESTR		;GO QUIT
SUBTTL	  Code to Handle Linkage to Editors
NOTENX <
TVEDIT:	TDZA	13,13		;FLAG AS TV
EDIT:	MOVNI	13,1
	PUSH	P,13
	SETZB	13,14		;PREPARE FOR PROVIDING
	SETZB	15,16		;STOPGAP WITH FILE NAME,
	SETZB	11,12		; PAGE AND LINE NUMBERS, SEQUENTIAL LINE #
	PUUO	0,B		;SEE IF FILE NAME SPECIFIED
	CAIE	B,15		;CR?
	 JRST	 GTNAM		; NO, NAME SPECIFIED
	PUUO	0,B		;SNARF UP LINE FEED AFTER CR
	SKIPL	CONFIG		;IF IN THE COMPILER,
	 JRST	 GTIT
	PUSH	P,[0]		;USE SPECIAL CALL TO SET UP AC'S
	PUSHJ	P,@.ERRP.	;...
	JRST	GTIT		;GO PROCESS.
GTNAM:	CAIE	B," "		;DELETE LEADING BLANKS
	 JRST	 MKNAMM
	PUUO	0,B
	JRST	GTNAM
MKNAMM:	CAIN	B,15		;GO BACK ON CR
	 JRST	 AUTO
	MOVE	C,[POINT 6,13] ;COLLECT FILE NAME HERE
MKNLP:	CAIE	B," "		;DONE?
	CAIN	B,15
	 JRST	 GTIT1		; YES
	SUBI	B,40
	CAIN	B,"."-40
	SKIPA	C,[POINT 6,14] ;ADJUST TO GET EXTENSION
	IDPB	B,C		;CHAR OF FILENAME
	PUUO	0,B
	JRST	MKNLP
GTIT1:	CAIN	B,15
	PUUO	0,B
GTIT:	POP	P,A		;TV/SOS FLAG
	EXCH	13,14		;EXT IN REG PRECEDING NAME?
NOEXPO <
	MOVEI	P,2
	LOAD6	(2,<SYS>)	;ASSUME GET TO EDITOR VIA RPG
	LOAD6	(4,<DMP>)
	MOVEI	6,0
	MOVEI	5,777777	;TELLS RPG: "EDIT"
	LOAD6	(3,<RPG>)
	JUMPE	14,SWAPIT
	MOVEI	5,1		;START AT RPG LOC IN EDITOR
	LOAD6	(3,<SOS>)	;NOW ASSUME SOS
	JUMPL	A,SWAPIT	;YES
	LOAD6	(3,<E>)	 	;NO, TV (ACTUALY E.DMP)
	MOVE	15,12		;GET SEQUENTIAL LINE NUMBER
SWAPIT:	CALL6	(P,SWAP)	;SEE YOU AROUND
>;NOEXPO
NOCMU <
EXPO <
	JUMPN	14,EDITG	;IF FILE, FIRE UP SOS
	MOVE	P,[XWD -1,[SIXBIT /SYS/
			   SIXBIT /COMPIL/
			   0 
			   0
			   0
			   0 ]]
	CALL6	(P,RUN)		;GO RUN IT.
	JRST	4,0
EDITG:	PUSHJ	P,RPGDSK ;SET UP FOR FILE
	MOVE	2,14 	;GET THE FILE
	PUSHJ	P,SXCON
	MOVEI	1,"."
	SKIPN	2,13     ;EXTENSION
	JRST	NOEXT
	PUSHJ	P,OUT1
	HLLZS	2	;EXTENSION.
	PUSHJ	P,SXCON
NOEXT:	SKIPN	11		;PROJ,PROG #
	JRST	NOPPN
	MOVEI	1,"["
	PUSHJ	P,OUT1
	HLRZ	1,11
	PUSHJ	P,OCTQ	;OUTPUT OCTAL
	MOVEI	1,","
	PUSHJ	P,OUT1
	HRRZ	1,11
	PUSHJ	P,OCTQ
	MOVEI	1,"]"
	PUSHJ	P,OUT1
NOPPN:	PUSHJ	P,CRLF
	JUMPE	15,GOED10	;IF NO LINE NUMBER, DO NOT DO THIS.
	MOVEI	1,"P"
	PUSHJ	P,OUT1
	MOVE	2,15		;LINE NUMBER
	TRZ	2,1	;FOR SURE?
ASCO:	MOVEI	1,0
	LSHC	1,7
	PUSHJ	P,OUT1
	JUMPN	2,ASCO
	MOVEI	1,"/"
	PUSHJ	P,OUT1
	MOVE	1,16	;PAGE NUMBER
	PUSHJ	P,OUTDEC
	PUSHJ	P,CRLF
GOED10:	MOVE	1,PPMAX+2 ;SIZE
	ADDI	1,4
	IDIVI	1,5	  ;TO WORDS
	MOVNS	1
	HRLS	1
	HRR	1,PPMAX	  ;BUFFER START
	ADDI	1,1
	MOVEM	1,PPMAX+2
	MOVSI	1,'EDT'
	EXCH	1,PPMAX+1
	MOVE	2,[XWD 3,PPMAX+1]
	CALLI	2,44	;WRITE IT
	JRST	DSKIT
EDT10R:	MOVE	P,[XWD 1,[SIXBIT /SYS/
			  SIXBIT /SOS/
			  0
			  0
			  0
			  0]]
	CALL6	(P,RUN)
	JRST	4,.
DSKIT:	SETSTS	1,16	;DO NOT LOSE BUFFERS
	MOVEM	1,PPMAX+1
	CALLI	2,30	;JOB NUMBER
	MOVSI	1,'EDT'	;TO FILE NAME
	MOVEI	4,3
DGLP:	IDIVI	2,=10
	IORI	1,20(3)
	ROT	1,-6	
	SOJG	4,DGLP
	MOVSI	2,'TMP'
	SETZB	3,4
	ENTER	1,1
	CALLI	12		;FATAL
	SETSTS	1,0
	CLOSE	1,0		;FINISH
	JRST	EDT10R
RPGDSK:	CALLI
	INIT	1,0
	SIXBIT	/DSK/
	XWD	PPMAX,0
	CALLI	12
	OUTBUF	1,0
	OUTPUT	1,0
	SETZM	PPMAX+2
	MOVEI	1," "
OUT1:	AOS	PPMAX+2
	IDPB	1,PPMAX+1
	POPJ	P,
SXCON:	MOVEI	1,0
	LSHC	1,6
	ADDI	1,40
	PUSHJ	P,OUT1
	JUMPN	2,SXCON
	POPJ	P,
OCTQ:	IDIVI	1,10
	HRLM	2,(P)
	SKIPE	1
	PUSHJ	P,OCTQ
	HLRZ	1,(P)
	ADDI	1,"0"
	JRST	OUT1
OUTDEC:	IDIVI	1,=10
	HRLM	2,(P)
	SKIPE	1
	PUSHJ	P,OUTDEC
	HLRZ	1,(P)
	ADDI	1,"0"
	JRST	OUT1
CRLF:	MOVEI	1,15
	PUSHJ	P,OUT1
	MOVEI	1,12
	JRST	OUT1
>;EXPO
>;NOCMU
CMU < ;;
EDITG: 	MOVEI	P,[SIXBIT /SYS/
		   SIXBIT /LINED/
		  0 ↔ 0 ↔ 0 ↔ 0 ]
	SKIPE	14	;DID HE TYPE "E FILE"?
	HRLI	P,1	;YES
RNNIT:	CALL6(P,RUN)	;RUN IT
	JRST	4,0	;HALT
>;CMU
>;NOTENX
TENX <
NOIMSSS<
EDIT:
TVEDIT:	TERPRI <
Automatic switching to editors not implemented >
	JRST	WATNOW
>;NOIMSSS
IMSSS<
EDIT:	TDOA	A,[-1]	;INDICATE STOPGAP
TVEDIT:	SETZ	A,	;INDICATE TERMINAL-DEPENDENT EDITOR
	SKIPE	.ERRP.	;ANYTHING THERE?
	  JRST	TVEDI1	;YES
	TERPRI <You cannot edit from here.>
	JRST	WATNOW
TVEDI1:
	PUSH	P,A	;INFORMATION ABOUT WHICH EDITOR TO THE STACK
	MOVEI	A,1		;INDICATE THAT WE WANT AN EDIT
	PUSHJ	P,@.ERRP. ;FOR COMPILER, TO MYERR
	JRST	WATNOW	;WHAT -- IT CONTINUED?
>;IMSSS
>;TENX
SUBTTL	SAVE, RESTR, INSET -- General Utility Routines
↑SAVE:	MOVE	USER,GOGTAB	; LOAD PTR TO USER RE-ENTRANT TABLE
	HRRZI	TEMP,RACS(USER)	;XWD FF,SAVEADDR
	BLT	TEMP,RACS+RF(USER) ;SAVE FF THRU RF  
	MOVE	TEMP,-1(P)	;RETURN ADDR FROM I/O CALL
	MOVEM	TEMP,UUO1(USER)	;STORE RETURN
	POPJ	P,
↑RESTR:	MOVSI	TEMP,RACS(USER)	;XWD SAVEADDR,FF
	CAME	RF,RACS+RF(USER) ;TEMPORARY CHECK TO MAKE SURE NOT CLOBBERED.
	 ERR	 <DRYROT: RF CLOBBERED AT RESTR>,1
	BLT	TEMP,RF		;RESTORE
	SUB	P,LPSA		;ADJUST STACK
	JRST	@UUO1(USER)	;RETURN
↑STACSV:
	MOVE	15,GOGTAB
	HRRZI	14,STACS(15)
	BLT	14,STACS+13(15)
	POPJ	P,
↑STACRS:	MOVE	15,GOGTAB
	HRLZI	14,STACS(15)
	BLT	14,13
	POPJ	P,
↑INSET:	MOVE	USER,GOGTAB	;MAKE SURE
	HLL	TEMP,TOPBYTE(USER)
	HRRI	TEMP,[BYTE (7) 0,4,3,2,1,0]
	ILDB	TEMP,TEMP	;ADJUSTMENT NEEDED.
	ADDM	TEMP,REMCHR(USER)	;UPDATE REMCHR.
	SKIPL	TEMP,TOPBYTE(USER)
	ADDI	TEMP,1
	HRLI	TEMP,440700	;POINT 7, WORD
	MOVEM	TEMP,TOPBYTE(USER)	;AND SAVE
	POPJ	P,
>;NOLOW
ENDCOM(LUP)