SEARCH HDRFIL
COMPIL(LUP,<%UUOLNK,%ALLOC,SAVE,RESTR,STACSV,STACRS,INSET,USERERR,$PDLOV,.UINIT,ERMSBF,EDFILE,SPLICE,SPLPRT>
	   ,<CORGET,STCLER,GOGTAB,CONFIG,%ALLCHR,CAT,STRNGC,K.ZERO,INIACS>
	   ,<INITIALIZATION ROUTINES, UUO HANDLER, UTILITY ROUTINES>
	   ,DT.RET)
IFE ALWAYS,<
INTERNAL %ALLOC,DT.RET
EXTERNAL	ALLPDP,SETLET,INILNK,XJBENB,.UUOCN
EXTERNAL	SPLNEK,%OCTRET,%RECOV,%ERRC,%RENSW,%ERGO
EXTERNAL	.DTRT.,.ERSTR,.ERSTP,.ERRP.,.ERRJ.,.ERSTC,.ERBWD,CORREL
EXTERNAL	X11,X22,X33,X44,CORINC,%STDLS,%SPL,KTLNK,PDLNK
EXPO <
EXTERNAL	PPMAX
>;EXPO
RGC <
EXTERNAL	RECCHN,RGCLST
>;RGC
>;IFE ALWAYS
NOLOW <			;PUT IN UPPER SEGMENT AND ALL THAT FOLLOWS....
UP <
	USE	DSPCH		;A PC FOR VECTOR JRSTS
	USE
?DSPBAS:	BLOCK DSPLEN		;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
	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)
%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
NRC <	
	PUSHJ	P,$RCINI	;ALSO, INTIALIZE ALL RECORDS IN WORLD
>;NRC
>;UP
RGC <	
	SETZM	RECCHN		;CHAIN OF ALL RECORDS IN THE WORLD
	SETZM	RGCLST		;CHAIN OF USER-ADDED GC ROUTINES
>;RGC
>;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	PNQSPL		;6 -- SIXBIT PRINT
	JRST	ARERRR		;7 -- ARRAY ERROR
	JRST	RUUO		;10 -- RECUUO
	JRST	PNQSPL		;11 -- PRINT DECIMAL NUMBER
	JRST	PNQSPL		;12 -- PRINT OCTAL NUMBER
	JRST	SPLERR		;13 -- ERROR UUO WITH SPLICE PARAM LIST
	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.
PNQSPL:	JSP	FF,SAVM		;B,C,D
	MOVEI	B,-6(P)
	HRRZ	A,JOBUUO	;EFFECTIVE ADDR
	CAIG	A,D		;MUST RELOCATE IF SMALL
	 ADDM	B,JOBUUO
	LDB	A,[POINT 9,JOBUUO,8]	;OP CODE FIELD
	MOVEI	A,-6+[	ASCIZ/@F/	;SIXBIT
			0		;HOLE FOR ARERR
			0		;HOLE FOR RUUO
			ASCIZ/@D/	;DECIMAL
			ASCIZ/@B/](A) 	;OCTAL
	MOVEI	B,-1+URTBL2+2	;WHAT TO PRINT (PWORD @JOBUUO)
	JRST	SPLPRT
	SUBTTL	SPLICE -- A FANCY STRING MAKER
HEREFK(SPLICE,SPLIC.)
	HRLI	A,440700	;make byte pointer
	PUSH	P,A		;input byte pointer
	PUSH	P,B		;addr of argument pointers
SPL.1:	ILDB	A,-1(P)		;char
	JUMPE	A,SPLDON	;ASCIZ control
	CAIN	A,"@"
	 JRST	SPLPRM		;a parameter
SPL.C:	PUSHJ	P,SPLDPB	;deposit and count
	JRST	SPL.1
SPLPRM:	ILDB	A,-1(P)		;type code
	CAIL	A,"A"		;check bounds
	CAILE	A,"J"
	 JRST	SPL.C		;out of bounds or second @
	MOVEI	B,(A)
	AOS	A,(P)		;addr of next arg pointer
	LDB	A,(A)		;arg value
	JRST	@.-"@"(B)	;select proper routine
FOR @& TYP E <ABCDEFGHIJ> <
	SPL.&TYP	>
SPLDON:	SUB	P,[2,,2]	;pushes done at start
	POPJ	P,
SPL.A:	SETZ	B,		;break only on null
	HRLI	A,440700	;supply left half of byte pointer
	JRST	SPL.HA
SPL.B:	TLNN	A,-1		;anything in left half?
	 JRST	SPL.B1		;no
	MOVEM	A,%ALLCHAR	;yes, save value
	MOVEI	A,[ASCIZ /@B,,@B/]	; and recurse!
SPLREC:	MOVEI	B,-1+[	PLEFT	%ALLCHAR
			PRIGHT	%ALLCHAR]
SPLRC1:	PUSHJ	P,SPLICE
	JRST	SPL.1
SPL.D:	JUMPGE	A,SPL.D1	;FRNP only works for positive values
	MOVM	B,A		;get absolute value
	MOVEI	A,"-"
	PUSHJ	P,SPLDPB
	MOVE	A,B		;value in A
SPL.D1:	PUSH	P,[=10]
	JRST	.+2
SPL.B1:	PUSH	P,[10]
	EXCH	FF,(P)		;stack old FF, radix into new FF
	PUSHJ	P,SPLFRN
	POP	P,FF		;retrieve FF
	JRST	SPL.1
SPLFRN:	IDIV	A,FF		;recursive number printer
	HRLM	B,(P)
	JUMPE	A,.+2
	 PUSHJ	P,SPLFRN
	HLRZ	A,(P)
	ADDI	A,"0"
SPLDPB:
NOSTANFO<
	CAIN	A,30		;Stanford underbar
	 MOVEI	A,"!"		;into exclamation
	CAIN	A,33		;not equal [ASCII escape]
	 MOVEI	A,"#"		;into hash
>;NOSTANFO
	AOBJP	C,.+2		;no room left
	IDPB	A,D		;unload char
	POPJ	P,
SPL.E:	LSHC	A,-=36		;5 char ASCII in B, 0 in A
	ANDCMI	B,1		;clear line number bit
	JUMPE	B,SPL.1		;ignore trailing blanks
	LSHC	A,7		;char from B into A
	PUSHJ	P,SPLDPB
	JRST	.-3
SPL.F:	LSHC	A,-=36		;SIXBIT into B, 0 into A
	JUMPE	B,SPL.1		;ignore trailing blanks
	LSHC	A,6		;char from B into A
	JUMPE	A,.-1		;ignore leading blanks
	ANDI	A,77
	ADDI	A,40		;convert to ASCII
	PUSHJ	P,SPLDPB
	JRST	SPL.F+1
SPL.G:	JUMPE	A,SPL.1		;0 PPN is null string
	MOVEM	A,%ALLCHAR	;recurse
NOCMU<
IFN SIXSW,<
	MOVEI	A,[ASCIZ /[@F,@F]/]	;sixbit ppn
>;IFN SIXSW
IFE SIXSW,<
	MOVEI	A,[ASCIZ /[@B,@B]/]	;octal ppn
>;IFE SIXSW
	JRST	SPLREC
>;NOCMU
CMU<
	MOVE	A,[%ALLCHAR,,%ALLCHAR]
	DECCMU	A,
	 JRST	SPL.1		;error in converting ppn
	MOVEI	A,[ASCIZ /[@A]/]
	MOVEI	B,-1+[	PWORD	<[IPCHAR %ALLCHAR]>]
	JRST	SPLRC1
>;CMU wierdos
SPL.H:	AOS	B,(P)		;addr of b.p. to break char
	LDB	B,(B)		;break char
SPL.HA:	PUSH	P,A		;b.p. to input
SPL.H2:	ILDB	A,(P)		;char
	JUMPE	A,SPL.H1	;break on nulls
	CAIN	A,(B)		;or break chars
	 JRST	SPL.H1		;broken
	PUSHJ	P,SPLDPB
	JRST	SPL.H2
SPL.H1:	POP	P,A
	JRST	SPL.1
SPL.I:	MOVE	B,@(P)		;POINT 36,word2
	MOVEI	B,@B		;addr of word2; POINT could use indexing
	HRRZ	B,-1(B)		;char count
	PUSH	P,A		;SAIL b.p.
	JUMPE	B,SPL.H1	;done
	ILDB	A,(P)
	PUSHJ	P,SPLDPB
	SOJGE	B,.-3
SPL.J:	MOVEI	A,-1(A)		;called from addr of PUSHJ return word
	JRST	SPL.B
↑RUUO:
NONRC <
	LDB	A,[POINT 4,JOBUUO,=12]	;AC FIELD IS THE MINOR OPCODE
NORGC <
	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
>;NORGC
RGC  <
	CAIG	A,RDLAST		;ONE WE CAN DISPATCH ON ??
	JRST	@RDISP(A)		;YES
>;RGC
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:
NORGC <
	JRST	RDREF	;0 -- DEREFERENCE E.G RECUUO 0,RECVAR
	JRST	USRUU1	;1 -- ALLOCATE: E.G RECUUO 1,[CLASSID]
	JRST	UINCUU	;2
>;NORGC
RGC <
	JRST	USRUUO	;0 -- DEREFERENCE (ACTUALLY AN ERROR)
	JRST	USRUU1	;1 -- ALLOCATE: E.G RECUUO 1,[CLASSID]
>;RGC
RDLAST ←← (.-RDISP)-1	
>;NONRC
NRC <
	ERR	<RECUUO CALLED IN NEW RECORD SYSTEM.  RECOMPILE.>,1
	POPJ	P,
>;NRC
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:	
	SKIPN	.UUOCN		;DID THE USER GIVE US SOMETHING ELSE TO TRY
	JRST	.ILL.		;NOPE, MUST BE AN ERROR
	POP	P,A		;GET BACK TO A MORE VIRGINAL STATE
	POP	P,FF		;NOW ALL ACS ARE BACK (P IS ONE TOO DEEP, BUT...)
	XCT	.UUOCN		;
	POPJ	P,
.ILL.:	MOVE	A,[ERR <Illegal UUO>]
	MOVEM	A,JOBUUO
ERRR:	JSP	FF,SAVM		;SAVE MORE AC'S
	LDB	D,[POINT 4,JOBUUO,12] ;CODE IN AC FIELD
	JRST	ERRW
ARERRR:	JSP	FF,SAVM		;SAVE MORE AC'S
	LDB	A,[POINT 6,@JOBUUO,11]	;SIZE FIELD OF A BYTE POINTER
	CAIE	A,07		;THE NORMAL VALUE FOR STRINGS?
	 AOS	JOBUUO		;NO, POINT TO WD2
	MOVSI	B,4		;PRINTING INSTRUCTIONS
	MOVEI	D,20		;ERROR CODE -- FATAL
	JRST	ERRX
IOERRR:	JSP	FF,SAVM		;SAVE MORE AC'S
	MOVEI	D,16		;ERROR CODE -- FATAL
ERRW:	MOVEI	B,0
ERRX:
	MOVEI	A,[BYTE (7) 15, 12, "@", "A"]	;BEGIN WITH CRLF
	HRRI	B,-1+[PRIGHT	JOBUUO]	;JOBUUO HAS ADDR OF ASCIZ
ERRY:	ROT	D,-1		;CONTINUE BIT TO SIGN BIT
	MOVEM	D,%RECOV	;AND SAVE FOR TESTING LATER
	MOVE	C,-6(P)		;RETURN ADDRESS
	MOVEM	C,.DTRT.	;SAVE AS DDT RETURN ADDRESS
	LDB	C,[POINT 4,-2(C),12]	;AC FIELD OF PRECEDING INSTR
	CAIG	C,D		;IF IN SAVED ACS,
	 ADDI	C,-5(P)		; RELOCATE
	MOVEM	C,%ALLCHAR	;SAVE ADDRESS
	MOVE	C,GOGTAB	;NOW DO SAME THING FOR ADDR IN UUO1
	HRRZ	C,UUO1(C)	;ADDR+1 OF LAST CALL
	CAIL	C,2		;TRY TO PREVENT ILL MEM REFS
	LDB	C,[POINT 4,-2(C),12]
	CAIG	C,D
	 ADDI	C,-5(P)
	MOVEM	C,%OCTRET
	PUSHJ	P,.ERSWD	;SETUP ERROR COUNT AND OUTPUT B.P.
	TLZN	B,4		;DON'T PRINT NOW FOR ARERR
	 PUSHJ	P,SPLICE	;DO FIRST PART
	MOVE	B,%RECOV	;WHAT TO DO NOW
	MOVEI	A,URTBL1(B)	;WHAT TO PRINT NEXT
	MOVEI	B,URTBL2-1(B)	;WITH WHAT PARAMS
	PUSHJ	P,SPLICE
	MOVEI	A,[BYTE (7) 15,12]	;END MESSAGE WITH CRLF
	PUSHJ	P,SPLICE
	JUMPL	C,.+3		;IF RH(C) HAS CORRECT COUNT
	 LDB	C,[POINT 13,.ERBWD,12]	;ELSE USE MAX
	 MOVEI	C,-1(C)		;MINUS 1 FOR ZERO BYTE
	HRRZM	C,.ERSTC	;CHAR COUNT
	SETZ	B,
	IDPB	B,D		;ASCIZ
	MOVEM	D,.ERSTP	;UPDATED BYTE POINTER
	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.
	PUSH	SP,.ERSTC	;CHAR COUNT
	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
	MOVSI	C,-12(P)	;FROM
	HRRI	C,RACS(USER)	;TO
	BLT	C,RACS+12	;RESTORE RACS
	SUB	P,[XWD 13,13]	;ADJUST STACK
	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
	PUSH	P,D
	TLZN	D,2		;IF NOT INHIBITED,
	 PUSHJ	 P,CALLEDFROM	;PRINT SAIL MESSAGE
	POP	P,D
	MOVEI	D,(D)	;ONLY THE CHAR, PLEASE
	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.
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		;.
BAIL<
	CAIN	A,"B"		;BAIL?
	 JRST	 BAILIT
>;BAIL
	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
BAIL<
BAILIT:	SKIPN	BAILOC(USER)
	 JRST	 [TERPRI <No BAIL>
		  JRST QUES]
	MOVEI	A,[PUSH P,.DTRT.	;ADDR+1 OF UUO
		   JRST @BAILOC(USER)]	;HEAVE-HO!
	POPJ	P,		;NON-SKIP RETURN.
>;BAIL
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
NOBAIL<
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.
>;NOBAIL
BAIL<
BADRSP:	TERPRI	<Reply [CR] to continue,
[LF] to continue automatically,
"D" for DDT, "E" to edit, "B" for BAIL,
"X" to exit, "S" to restart>
	JRST	QUES		;GET ANOTHER RESPONSE.
>;BAIL
SUBTTL	  Special Printing Routines For Error Handler
URTBL1:	ASCIZ	//	; 0- 1 -- NO ACTION
	ASCIZ	/@I/	; 2- 3 -- SYMBOL PTD TO BY LPSA
	ASCIZ	/@I/	; 4- 5 -- SYMBOL PTD TO BY UUO
	ASCIZ	/@D/	; 6- 7 -- VAL OF AC IN INSTR BEFORE UUO
	ASCIZ	/@B/	;10-11 -- THE UUO ITSELF
	ASCIZ	/@D/	;12-12 -- VAL OF AC IN INSTR BEFORE CALL FROM UUO1(GOGTAB)
	ASCIZ	/@F/	;14-15 -- LPSA IN SIXBIT
	ASCIZ	//	;16-17 -- IOERR SECOND HALF
	ASCIZ	/
Invalid index for array @I. Index no. @D, value is @D/
$PNAME←←1
URTBL2:	0			;NO ACTION
	PWORD	$PNAME+1(LPSA)	; 2- 3 -- SYMBOL PTD TO BY LPSA
	PWORD	@JOBUUO		; 4- 5 -- SYMBOL PTD TO BY UUO
	PWORD	@%ALLCHAR	; 6- 7 -- VAL OF AC IN INSTR BEFORE UUO
	PWORD	JOBUUO		;10-11 -- THE UUO ITSELF
	PWORD	@%OCTRET	;12-13 -- VAL OF AC IN INSTR BEFORE CALL FROM UUO1(GOGTAB)
	PWORD	LPSA		;14-15 -- LPSA IN SIXBIT
	PWORD	0		;16-17 -- IOERR PASS2 (NO-OP)
	PWORD	@JOBUUO			;START OF ARERR
	POINT	4,JOBUUO,12		; INDEX
	PWORD	@%ALLCHAR		; VALUE
.ERSWD:	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
	MOVN	C,.ERSTC	;NEGATE
	MOVSI	C,(C)		;AOBJN POINTER
	MOVEI	D,@.ERBWD
	HRLI	D,(<POINT 7,0>)	;MAKE UP THE BYTE PTR
	MOVEM	D,.ERSTP
	POPJ	P,
CALLEDFROM:
	MOVEM	A,%ALLCHAR
	MOVE	A,GOGTAB
	HRRZ	A,UUO1(A)
	MOVEM	A,%OCTRET
	MOVEI	A,[ASCIZ/Called from @J  Last SAIL call at @J
/]
	SKIPGE	CONFIG
	MOVEI	A,[ASCIZ/Called from @J
/]
	MOVEI	B,-1+[PWORD	%ALLCHAR
			PWORD	%OCTRET]
HEREFK(SPLPRT,SPLPR.)		;CALL SPLICE AND PRINT THE RESULT TO TTY; ENTER WITH A,B SETUP
	PUSHJ	P,.ERSWD	;SET UP C AND D
	PUSHJ	P,SPLICE
	SETZ	B,
	IDPB	B,D		;AT LEAST ONE CHAR REMAINS DUE TO WAY C IS SET UP
	PUUO	3,@.ERBWD
	POPJ	P,
SPLERR:	JSP	FF,SAVM		;JUST LIKE ERR UUO
	LDB	D,[POINT 4,JOBUUO,12]	;CODE IN AC FIELD
	MOVE	B,JOBUUO	;ADDR-1 OF POINT BLOCK
	MOVE	A,(B)		;ADDR OF ASCIZ CONTROL STRING
	JRST	ERRY		;SICK 'EM
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.
NOBAIL<
	POP	P,UUO1(USER)
	SKIPG	TEMP,(P)	;IS CODE 0?
>;NOBAIL
BAIL<
	POP	P,UUO1(USER)	;ADDR+1 OF CALL
	PUSH	P,UUO1(USER)	;MUST NO FIDDLE WITH STACK, OR BAIL WON'T WORK
	SKIPG	TEMP,-1(P)	;IS CODE 0?
>;BAIL
	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
NOBAIL<
	MOVE	TEMP,-1(P)	;YES, SET UP SO ERR. GUY WILL PRINT VALUE
>;NOBAIL
BAIL<
	MOVE	TEMP,-2(P)	;YES, SET UP SO ERR. GUY WILL PRINT VALUE
>;BAIL
	ERR.	7,@(SP)		; AND DO IT
USERBAK:
	SUB	SP,X44
NOBAIL<
	SUB	P,X22
>;NOBAIL
BAIL<
	SUB	P,X33
>;BAIL
NOBAIL<
	JRST	@UUO1(USER)	;RETURN FROM ROUTINE.
>;NOBAIL
BAIL<
	JRST	@3(P)		;RETURN--UUO1 MAY HAVE BEEN CLOBBERED BY BAIL
>;BAIL
HERE(ERMSBF)
	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	4,B		;SEE IF FILE NAME SPECIFIED
	CAIE	B,15		;CR?
	 JRST	 GTNAM		; NO, NAME SPECIFIED
	PUUO	4,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	4,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
STANFO<
	CAIN	B,175>;STANFORD
NOSTANFO<
	CAIN	B,33>;NOSTANFORD
	 JRST	[POP	P,13	;RESTORE STACK DEPTH
		JRST	QUES]
	TRZN	B,100		;MAKE SIXBIT
	TRZA	B,40
	TRO	B,40		
	CAIN	B,'.'
	SKIPA	C,[POINT 6,14] ;ADJUST TO GET EXTENSION
	IDPB	B,C		;CHAR OF FILENAME
	PUUO	4,B
	JRST	MKNLP
IFNDEF FILNAM,<EXTERNAL FILNAM>
HEREFK(EDFILE,EDFIL.)
	MOVE	USER,GOGTAB
	PUSHJ	P,FILNAM	;TURN STRING INTO FNAME,EXT,PRPN(USER)
	 JFCL		;SOME ERROR IN FILE NAME
	MOVE	14,FNAME(USER)
	MOVE	13,EXT(USER)
	MOVE	11,PRPN(USER)
	POP	P,16	;JUNK THE RETURN ADDRESS
	POP	P,16	;CREATE/READONLY BITS
	LSH	16,=15	;INTO TOP 3 BITS OF RIGHT HALF
	HRRI	13,(16)	;OVER INTO EXT WORD
	POP	P,16	;PAGE NUMBER
	POP	P,15	;LINE NUMBER
	MOVE	12,15	;HERE, TOO
	TLNN	15,600000	;CHECK TOP 2 BITS OF LINE NUMBER
	TDZA	7,7	;NO BITS THERE, USE E
	SETO	7,	;SOME BITS ON, ASSUME ASCID, USE SOS
	JRST	GTIT+2	;OFF TO THE RACES
STANFORD<	;SWAP BACK ACS
	MOVE	0,INIACS+0	;FILE NAME
	MOVE	1,INIACS+1	;EXT
	MOVE	6,INIACS+6	;DEVICE
>;STANFORD
NOSTANFORD<
	MOVE	0,INIACS+0	;FILE
	MOVE	7,INIACS+7	;PPN
	MOVE	11,INIACS+11	;DEVICE
	MOVE	17,INIACS+17	;EXT
>;NOSTANFORD
GTIT1:	CAIN	B,15
	PUUO	4,B
GTIT:	POP	P,7		;TV/SOS FLAG
	EXCH	13,14		;EXT IN REG PRECEDING NAME?
NOEXPO <
	MOVSI	2,'SYS'		;DEV
	MOVSI	3,'RPG'		;FILE
	MOVSI	4,'DMP'		;EXT
	MOVEI	5,777777	;TELLS RPG: "EDIT"
	JUMPE	14,SWAPIT	;IF FILE TO EDIT IS NULL
	MOVEI	5,1		;START AT RPG LOC IN EDITOR
	MOVSI	3,'SOS'		;ASSUME SOS
	JUMPL	7,SWAPIT	;YES
	MOVSI	3,'E  ' 	;NO, E
	MOVE	15,12		;ATT CNT,,SEQ LIN NO.
SWAPIT:
	MOVEI	P,2		;ADDR OF GET BLOCK FOR SWAP
	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 ]
	HRLI	P,1	;YES
RNNIT:	CALLI	P,-22	;RUN IT
	JRST	4,0	;HALT
>;CMU
>;NOTENX
TENX <
HEREFK(EDFILE,EDFIL.)
	ERR	<EDFILE not available on TENEX>,1
	SUB	SP,X22
	SUB	P,X44
	JRST	@4(P)
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,
HERE(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)
END