COMMENT ⊗   VALID 00040 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002		TITLE	LEXINT - LEXICAL PRODUCTION INTERPRETER
C00007 00003	ENTER LEXICAL PRODUCTION INTERPRETER
C00010 00004		LDB	T4,PACTF		YES, EXTRACT ACTION NUMBER FIELD
C00013 00005	BYTE POINTERS
C00016 00006	IFN FTDBUG,<
C00018 00007		RELOC	0		ASSEMBLE OUR LOW SEGMENT
C00021 00008		SUBTTL	UUO ENTRY CODE AND DISPATCH TABLES
C00024 00009	GENERATE MAIN UUO DISPATCH TABLE
C00025 00010	GENERATE SUB-UUO DISPATCH CODE AND TABLES
C00027 00011		UUOS
C00028 00012		SUBTTL	CHARACTER AND STRING-HANDLING UUOS
C00030 00013	IFN $NCHFL,<
C00032 00014		LCH	E	READ PREVIOUS CHARACTER INTO LOCATION E
C00034 00015		RCH	E	READ 1 CHARACTER INTO LOCATION E (NO FLAGS)
C00037 00016	UUO ERROR EXIT CODE.  ENTER WITH LOCATION TO BE DISPATCHED TO IN U1.
C00040 00017	SOME DEFINITIONS:
C00044 00018		WASC	E	WRITE ASCIZ STRING AT LOCATION E
C00048 00019	ROUTINE TO EXECUTE NEXT INSTRUCTION IN EDIT LIST.
C00051 00020		SUBTTL	INTEGER OUTPUT CONVERSION UUOS
C00054 00021		SUBTTL	UUOS FOR PRINTING FILE SPECIFICATIONS
C00058 00022		SUBTTL	FILE ERROR HANDLING UUOS
C00061 00023	HERE TO ANALYZE OPEN ERRORS
C00064 00024	TABLE OF POINTERS INTO THE ERROR MESSAGE TABLE.  ENTRIES ARE CODED
C00067 00025		SUBTTL	FILE UTILITY UUOS
C00068 00026		FISEL	E	SELECT THE FILE BLOCK AT E FOR INPUT
C00071 00027	HERE TO OPEN A DEVICE FOR INPUT OR OUTPUT
C00076 00028		SUBTTL IMPUUO	USER UUO PACKAGE FOR IMP CALLS
C00078 00029	HERE TO DO CROSSPATCH WITH ITS FUNNY STATUS BITS
C00080 00030	HANDLE TYPEOUT OF IMP ERRORS
C00082 00031	NAMES OF FUNCTION CODES
C00084 00032	ERROR CODE TEXT
C00086 00033	IDIOT UUO -- ERROR MESSAGE FOR INTERNAL BUGS
C00087 00034		SUBTTL	DEFAULT ERROR HANDLERS
C00089 00035		SUBTTL	PRESERVED REGISTER SAVE/RESTORE ROUTINES
C00092 00036		SUBTTL	ERROR MESSAGE TABLE
C00094 00037		SUBTTL	CHARACTER CLASS TABLE
C00095 00038	DETERMINE THE CLASSES ASSOCIATED WITH EACH CHARACTER
C00097 00039	ASSEMBLE CHARACTER FLAG TABLE ITSELF
C00099 00040	LOW SEGMENT
C00101 ENDMK
C⊗;
	TITLE	LEXINT - LEXICAL PRODUCTION INTERPRETER
	SUBTTL	E.A.TAFT/EAT/EJW JAN. 1975

	SEARCH	MacTen,TULIP
	VERSION	(1,,1,,%LEXINT)

	TWOSEG
	RELOC	400000

	EXTERN	SAVE4,CPOPJ
	INTERN	LEXINT,A.RET,A.SRET,A.CALL,A.POPJ

;THE FOLLOWING SUBPROGRAM ANALYZES INPUT CHARACTERS (READ THRU IFILE
;   IN THE NORMAL MANNER) ACCORDING TO PRODUCTIONS IN A GIVEN PRODUCTION
;   TABLE.
;CALLING SEQUENCE:
;	MOVEI	T1,TABLE
;	PUSHJ	P,LEXINT##
;	  PRODUCTION ROUTINE NON-SKIP RETURN
;	PRODUCTION ROUTINE SKIP RETURN
;	WHERE
;	TABLE = NAME USED AS ARGUMENT TO TBLBEG MACRO. PARSING STARTS
;		STARTS WITH THE FIRST PRODUCTION IN THE TABLE
;RESULT VALUES:
;	T1,T2,T3 WILL BE RETURNED WITH WHATEVER VALUES ARE MOST RECENTLY
;	SET BY THE ACTION ROUTINES.  T4 IS CLOBBERED.
;INTERNAL USE OF PROTECTED AC'S:
;	P1 =	RELATIVE LOCATION IN TABLE OF CURRENT PRODUCTION
;	P2 =	CURRENT CHARACTER UNDER SCAN
;	P3 =	CHARACTER FLAG BITS FOR CHARACTER IN P2
;	P4 =	XWD P1,BASE OF TABLE
;LEXINT RETURNS WHEN A "RET" OR "SRET" ACTION IS EXECUTED AT THE LEVEL
;   OF THE CALL TO LEXINT;  IF THE ACTION IS "SRET", LEXINT WILL SKIP.

;IF FTDBUG IS ON, A COMPLETE DYNAMIC TRACE OF THE PRODUCTIONS MAY BE
;   OBTAINED BY SETTING LEXDBG NONZERO.
;ENTER LEXICAL PRODUCTION INTERPRETER

	ENTRY	LEXINT		;LOAD ON LIBRARY SEARCH
LEXINT:	PUSHJ	P,SAVE4		;PRESERVE P1-P4 WITH AUTOMATIC RESTORATION
	AOS	P4,T1		;GET TABLE ADR AND ADVANCE PAST DISPATCH PTR
	HRLI	P4,P1		;SETUP INDEXING BY P1
	HLRZ	P1,T1		;GET REL ADR OF FIRST PRODUCTION TO EXECUTE
IFN FTDBUG,<
	SKIPE	LEXDBG		;TRACE ON?
	EDISIX	[[SIXBIT/LEXINT %,,%  !/] ;YES, ANNOUNCE ENTRANCE
		WOCTI	(P1)	;LIST ARGS TO LEXINT
		WOCTI	-1(P4)]
>
	RCHF	P2		;ADVANCE THE FIRST CHARACTER

;HERE TO INTERPRET A PRODUCTION
INTNXT:
IFN FTDBUG,<
	SKIPN	LEXDBG		;TRACE ON?
	JRST	INTNX1		;NO
	MOVEI	T4,@P4		;YES, COMPUTE ABS ADR OF PRODUCTION
	ANDI	P3,1←$NCHFL-1	;MASK EXTRANEOUS BITS IN FLAGS
	EXCH	T1,P2		;SETUP CHAR IN A FOR CALL TO SP7CHR
	EDISIX	[[SIXBIT\#P1/ % (=%)  P2/ % P3/ %  PROD !\]
		WOCTI	3,(P1)		;CURRENT RELATIVE PC
		WOCTI	6,(T4)		;CURRENT ABSOLUTE PC
		PUSHJ	P,SP7CHR	;CURRENT CHARACTER
		WOCTI	6,(P3)]		;CURRENT CHARACTER FLAGS
	EXCH	T1,P2		;RESTORE T1 AND P2
	MOVE	T4,@P4		;FETCH THE PRODUCTION
	TLNE	T4,(NEGBIT)	;"-" BIT ON?
	EDISIX	[.+2,,[SIXBIT/-!/]] ;YES, PRINT "-"
	EWSIX	[SIXBIT/ !/]	;NO, PRINT SPACE
	EXCH	T1,T4		;SETUP CHAR IN T1 FOR POSSIBLE CALL TO SP7CHR
	TLNE	T1,(CLSBIT)	;CHAR/CLASS BIT ON?
	EDISIX	[.+2,,[SIXBIT/<%>!/] ;YES, PRINT BITS IN ANGLE BRACKETS
		WOCTI	6,(T1)]
	PUSHJ	P,SP7CHR	;NO, PRINT CHAR AND CHAR CODE
	EXCH	T1,T4		;RESTORE AC'S
INTNX1:
>;END OF FTDBUG CONDITIONAL
	LDB	T4,PTSTBF	;LOAD CHAR/CLASS TEST AND "-" BIT
	HLLZ	T4,TSTINS(T4)	;PUT PROPER TEST INSTRUCTION IN LH
	HRR	T4,@P4		;GET CHAR OR FLAGS TO TEST WITH
	XCT	T4		;SKIP IF TEST PASSES
	AOJA	P1,INTNXT	;NO, GO ON TO NEXT PRODUCTION
	LDB	T4,PACTF		;YES, EXTRACT ACTION NUMBER FIELD
IFN FTDBUG,<
	SKIPN	LEXDBG		;TRACE ON?
	JRST	INTNX2		;NO
	SKIPGE	-1(P4)		;YES, IS ACTION NAME TABLE AVAILABLE?
	EDISIX	[.+2,,[SIXBIT/,%,!/] ;YES, PRINT ACTION NAME
		WASC	@-2(P4)]
	EDISIX	[[SIXBIT/,T1=%,!/] ;NO, PRINT ACTION NUMBER
		WOCTI	2,(T4)]
INTNX2:
>
	ROT	T4,-1		;DIVIDE BY 2, REMAINDER TO SIGN
	JUMPGE	T4,.+2		;DETERMINE CORRECT HALF OF DISP TBL ENTRY
	SKIPA	T4,@-1(P4)	;REMAINDER 1, FETCH RH ENTRY
	MOVS	T4,@-1(P4)	;REMAINDER 0, FETCH LH ENTRY
	PUSHJ	P,(T4)		;CALL ACTION ROUTINE

;HERE UPON RETURN FROM ACTION ROUTINE
ACTRET:	LDB	T4,PSCNF		;LOAD SCAN BITS
	LDB	P1,PNXTF	;FETCH REL ADR OF NEXT PRODUCTION TO INTERPRET
TSTSCN:
IFN FTDBUG,<
	SKIPE	LEXDBG		;TRACE ON?
	EWSIX	[SIXBIT/ !/	;YES, PRINT CHAR FOR SCAN ACTION
		 SIXBIT/←!/
		 SIXBIT/*!/
		 SIXBIT/?!/](T4)
>
	XCT	SCNINS(T4)	;PERFORM " ", "*", OR "←" OPERATION
	JRST	INTNXT		;GO INTERPRET ANOTHER PRODUCTION

;TABLE OF TEST ACTIONS

TSTINS:	CAIE	P2,		;"CHAR" - SKIP IF CHAR MATCHES
	CAIN	P2,		;-"CHAR" - SKIP IF CHAR DOESN'T MATCH
	TRNN	P3,		;<CLASS> - SKIP IF CHAR IS IN CLASS
	TRNE	P3,		;-<CLASS> - SKIP IF CHAR IS NOT IN CLASS

;TABLE OF SCAN FUNCTIONS

SCNINS:	CCHF	P2		;" " - FETCH SAME CHARACTER
	LCHF	P2		;"←" - FETCH PREVIOUS CHARACTER
	RCHF	P2		;"*" - FETCH NEXT CHARACTER
;BYTE POINTERS

PSCNF:	POINT	2,@P4,1		;FETCHES "*" AND "←" BITS
PTSTBF:	POINT	2,@P4,3		;FETCHES CHAR/CLASS AND "-" BITS
PACTF:	POINT	6,@P4,9		;FETCHES ACTION NUMBER FIELD
PNXTF:	POINT	8,@P4,17	;FETCHES NEXT PRODUCTION ADR FIELD

;BUILT-IN ACTION ROUTINES

;CALL - CALL A PRODUCTION SUBROUTINE, RETURN TO .+1 OR .+2 DEPENDING
;   ON WHETHER THAT SUBROUTINE RETURNS WITH A 'RET' OR AN 'SRET'.
;   THE "*" OR "←" OPERATIONS ARE PERFORMED BEFORE THE CALL IS MADE.

A.CALL:	MOVEM	P1,(P)		;SAVE CURRENT PRODUCTION ADR ON STACK,
				;  OVERWRITING RETURN TO LEXINT
	JRST	ACTRET		;GO PERFORM SCAN AND TRANSFER

;SRET - SKIP RETURN FROM A PRODUCTION SUBROUTINE.  NOTE THAT IF THIS IS
;   THE TOP-LEVEL PRODUCTION SUBROUTINE, LEXINT WILL SKIP RETURN TO ITS
;   CALLER.

A.SRET:	AOS	-1(P)		;INCREMENT RETURN ADR OR PC.

;RET - RETURN FROM A PRODUCTION SUBROUTINE.

A.RET:	LDB	T4,PSCNF		;FETCH SCAN FIELD FOR POSSIBLE "*" OR "←"
	POP	P,P1		;THROW AWAY RETURN TO LEXINT
	POP	P,P1		;GET BACK OLD PRODUCTION ADR OR PC
	TLNN	P1,-1		;ARE WE AT LEVEL OF CALL TO LEXINT?
	AOJA	P1,TSTSCN	;NO, RESUME CALLER PRODUCTION ROUTINE
IFN FTDBUG,<
	SKIPE	LEXDBG		;TRACE ON?
	EWSIX	[SIXBIT/ !/	;YES, PRINT CHAR FOR SCAN ACTIOL
		 SIXBIT/←!/
		 SIXBIT/*!/
		 SIXBIT/?!/](T4)
>
	XCT	SCNINS(T4)	;PERFORM FINAL SCAN, IF ANY
IFN FTDBUG,<
	SKIPE	LEXDBG		;TRACE ON?
	EWSIX	[SIXBIT/#EXIT LEXINT#!/]
>
	JRST	(P1)		;RETURN TO CALLER OF LEXINT

;JUMP - ALLOW ACTION ROUTINE TO DISPATCH TO DIFFERENT PART OF PRODUCTION
;  TABLE. ARG: T1/ RELATIVE ADDRESS OF NEW PRODUCTION

A.JUMP::LDB	T4,PSCNF		;GET SCAN BYTE FOR THIS PRODUCTION
	MOVEI	P1,(T1)		;POINT TO NEW PRODUCTION
	POP	P,T1		;REMOVE LEXINT RETURN
	JRST	TSTSCN		;AND FINISH PRODUCTION

	A.POPJ=	CPOPJ		;ACTION "POPJ" IS IN EVERY TABLE
IFN FTDBUG,<
;ROUTINE TO PRINT CHAR IN A BOTH IN READABLE FORM AND AS AN OCTAL CODE.
;   PRINTING IS IN THE FORM   CHAR-REPRESENTATION=ASCII CODE, WHERE
;   EACH TAKES 3 CHARACTERS.  CLOBBERS NO AC'S EXCEPT MASKS T1 TO 177.

SP7CHR:	ANDI	T1,177		;MASK TO 7 BITS
	CAIL	T1,40		;CONTROL CHAR?
	JRST	SP7CH1		;NO
	JUMPN	T1,.+2		;NULL?
	EDISIX	[SP7CHX,,[SIXBIT/NUL=!/]] ;YES
	CAIN	T1,ALT		;ALTMODE (ASCII 33)?
	EDISIX	[SP7CHX,,[SIXBIT/ALT=!/]] ;YES
	CAIL	T1,TAB		;FORMATTING CHARACTER
	CAILE	T1,CR
	EDISIX	[SP7CHX,,[SIXBIT/ ↑%=!/] ;YES, OUTPUT ↑X
		WCHI	100(T1)]
	EWSIX	[SIXBIT/TAB=!/	;NO, OUTPUT SPECIAL MNEMONIC
		 SIXBIT/ LF=!/
		 SIXBIT/ VT=!/
		 SIXBIT/ FF=!/
		 SIXBIT/ CR=!/]-TAB(T1)
	JRST	SP7CHX
SP7CH1:	CAIN	T1,140		;ACCENT GRAVE?
	EDISIX	[SP7CHX,,[SIXBIT/ AG=!/]] ;YES
	CAIG	T1,172		;GREATER THAN LOWER CASE Z?
	EDISIX	[SP7CHX,,[SIXBIT/  %=!/] ;NO, JUST PRINT CHAR
		WCHI	(T1)]
	EWSIX	[SIXBIT/ LB=!/	;YES, OUTPUT SPECIAL MNEMONIC
		 SIXBIT/ VL=!/
		 SIXBIT/ RB=!/
		 SIXBIT/TLD=!/
		 SIXBIT/DEL=!/]-173(T1)
SP7CHX:	EDISIX	[CPOPJ,,[SIXBIT/% !/] ;OUTPUT CHAR CODE AND A SPACE
		WOCTI	3,(T1)]
>;END OF FTDBUG CONDITIONAL
	RELOC	0		;ASSEMBLE OUR LOW SEGMENT

IFN FTDBUG,<
LEXDBG:	BLOCK	1		;SET NONZERO TO ENABLE TRACE FEATURE
>

	RELOC			;HI SEGMENT RELOCATION FOR LITERALS
	LIT
	PRGEND
	TITLE	UUO - STANDARD USER UUO HANDLER     
	SUBTTL	E.A.TAFT/EAT/EJW	--	5-MAR-75

	SEARCH	UUOSym, MacTen,TULIP	;ACCESS PARAMETER DEFINITIONS
	Ifn FtImp,<	Search	Imp	>	; need imp symbols
	VERSION	(1,,3,,%UUO)

	TWOSEG			;ASSEMBLE TWO SEGMENTS
	RELOC	400000		;ASSEMBLE HIGH SEGMENT

	MXUSRC==100		;MAX DEPTH TO SEARCH STACK ON ERRORS

	INTERN	ILERI1,ILERI2,ILERI3,ILERO1,ILERO2,ILERO3
	INTERN	XIT,UERXIT,CPOPJ,CPOPJ1,SAVE1,SAVE2,SAVE3,SAVE4
	INTERN	P1PJ1,P2PJ1,P3PJ1,P4PJ1,UXCT1,UXCT2,UERXIT
	INTERN	USTART,I1BYTE,O1BYTE,IFILE,OFILE,EFILE,TTIBLK,TTOBLK
IFN $NCHFL,<
	INTERN	CHFLTB
>
	EXTERN	.JBUUO,.JBDDT

;PSEUDO-FILE BLOCKS FOR TTY I/O
IFE FTDBUG,<
TIHBLK:	PFILE	TTIBLK,<INCHWL	U1>	;INPUT CHAR LINE MODE
>
IFN FTDBUG,<
TIHBLK:	PFILE	TTIBLK,<INCHRW	U1>	;INPUT CHAR SINGLE CHAR MODE
>
TOHBLK:	PFILE	TTOBLK,<OUTCHR	U1>	;OUTPUT SINGLE CHAR

;ROUTINE TO INITIALIZE THE UUO HANDLING PACKAGE.  INVOKED BY THE
;   "START" MACRO, WHICH EVERY MAIN PROGRAM SHOULD BEGIN WITH.

	ENTRY	USTART		;LOAD ON LIBRARY SEARCH
USTART:	RESET			;RESET I/O, ETC.
	FSETUP	TIHBLK		;SETUP TTY INPUT PSEUDO-FILE BLOCK
	FSETUP	TOHBLK		;SETUP TTY OUTPUT PSEUDO-FILE BLOCK
	SETZB	F,IFILE		;CLEAR FLAGS, INPUT FILE POINTER
	SETZM	OFILE		;CLEAR OUTPUT FILE POINTER
	SETZM	EFILE		;CLEAR ERROR FILE POINTER
	POPJ	P,		;RETURN
	SUBTTL	UUO ENTRY CODE AND DISPATCH TABLES

;WARNING--THE FOLLOWING METHOD OF ENTERING THE UUO HANDLER WILL NOT
;   WORK ON A PDP-6 OR PDP-10/30 SYSTEM UNLESS THE MONITOR GETS SMARTER.
LOC <.JB41==:41>
	PUSHJ	P,UUOH		;ENTER UUO HANDLER
RELOC

;UUO HANDLER AND DISPATCH ROUTINE.
;   THE FOLLOWING ACCUMULATORS ARE PROTECTED AND SET UP BEFORE DISPATCH:
;	U3:	CONTENTS OF AC FIELD OF THE UUO
;	U1:	CONTENTS OF E FIELD OF THE UUO
;	U2:	PROTECTED BUT NOT SETUP
;   THE UUO HANDLER IS REENTRANT AND PURE IF THE FOLLOWING RESTRICTION
;   IS OBSERVED:  THE EFFECTIVE ADDRESS OF THE UUO MAY NOT BE EQUAL
;   TO U3, U1, OR U2 IF IT IS TO BE USED AS AN ADDRESS.

internal UUOH		; in case we need to interface to SAIL

UUOH:	HRRZM	P,UUOPDP	;REMEMBER LEVEL OF INNERMOST UUO
	PUSH	P,U1		;SAVE AC'S USED		**** DON'T
	PUSH	P,U2		;  IN UUO HANDLER	**** CHANGE
	PUSH	P,U3		;   ROUTINES		**** ORDER
	HRRZ	U1,.JBUUO	;FETCH EFFECTIVE ADDRESS OF UUO
	HLRZ	U2,.JBUUO	;GET OPCODE AND AC FIELD
	LSH	U2,-5		;RIGHT-JUSTIFY AC FIELD
	MOVEI	U3,(U2)	;SAVE IT AWAY
	LSH	U2,-4		;RIGHT-JUSTIFY OPCODE FIELD
IFN FTDBUG,<
	EXCH	U2,U3		;SINCE U2 CAN'T BE PRINTED BY DISIX
	CAILE	U3,$UUON	;MAKE SURE THIS IS A DEFINED USER UUO
	EDISIX	[DDTXIT,,[SIXBIT/UNDEFINED USER UUO %#!/]
		WOCTI	(U3)]
	EXCH	U2,U3		;SWAP AC'S BACK AGAIN
>
	TRZA	U3,777760	;EXTRACT AC FIELD IN U3

;COME HERE TO RE-DISPATCH ON A SUBUUO, WITH NEW DISPATCH DISPLACEMENT IN U2

UDSP:	POP	P,U3		;THROW AWAY RETURN PC (UUOXIT)
	ROT	U2,-1		;PUT HIGH 8 BITS INTO RH, LOW INTO SIGN
	JUMPGE	U2,.+2		;LOW ORDER BIT 1 OR 0?
	SKIPA	U2,UUOTAB(U2)	;1, USE RH ENTRY
	MOVS	U2,UUOTAB(U2)	;0, USE LH ENTRY
	PUSHJ	P,(U2)		;CALL UUO ROUTINE	**** DON'T
UUOXIT:	POP	P,U3		;RESTORE AC'S		**** SEPARATE
	POP	P,U2		;  USED IN UUO		**** OR CHANGE
U1POPJ:	POP	P,U1		;  HANDLER ROUTINES	**** ORDER
	POPJ	P,		;RETURN FROM UUO HANDLER
;GENERATE MAIN UUO DISPATCH TABLE

	DEFINE	UUO(OP,LABEL,SUBS) <
IFB <LABEL>,<
	UUOD	(U'OP)		;;USE U'UUONAME IF LABEL NOT SPECIFIED
>
IFNB <LABEL>,<
	UUOD	(LABEL)		;;USE SPECIFIED LABEL IF GIVEN
>>

	HWDGEN	(UUOTAB,UUOS,UUOD)
;GENERATE SUB-UUO DISPATCH CODE AND TABLES

	DEFINE	UUO(OP,LABEL,SUBS) <
IFNB <SUBS>,<IFB <LABEL>,<
IFE FTDBUG,<
U'OP:	MOVEI	U2,2*<X'OP-UUOTAB>(U3) ;;RE-INDEX TO SUBUUO TABLE
>
IFN FTDBUG,<
	CONC	<
U'OP:	CAIL	U3,>,\$'OP,<	;;CHECK FOR SUBUUO IN RANGE
>
	JRST	SUBUER		;;ERROR, GO COMPLAIN
	MOVEI	U2,2*<X'OP-UUOTAB>(U3) ;;RE-INDEX TO SUBUUO TABLE
>
	JRST	UDSP		;;RE-DISPATCH

	HWDGEN	(X'OP,<SUBS>,UUOD) ;;GENERATE SUBUUO DISPATCH TABLE
>>>

	DEFINE	SUUO(OP,LABEL) <
IFB <LABEL>,<
	UUOD	(U'OP)		;;USE U'SUBUUO NAME IF LABEL NOT GIVEN
>
IFNB <LABEL>,<
	UUOD	(LABEL)		;;OTHERWISE, USE GIVEN NAME
>>

IFN FTDBUG,<
;HERE WHEN WE FOUND A SUBUUO OUT OF RANGE
SUBUER:	LDB	U1,[POINT 9,.JBUUO,8] ;GET UUO OPCODE AGAIN
	EDISIX	[DDTXIT,,[SIXBIT\SUBUUO % OF UUO % OUT OF RANGE#!\]
		WOCTI	(U3)		;PRINT SUBUUO NUMBER
		WOCTI	(U1)]		;PRINT UUO NUMBER

;HERE TO EXIT TO DDT IF LOADED, OR ELSE TO MONITOR (SOFTLY)
DDTXIT:	SKIPN	U1,.JBDDT	;IS DDT LOADED?
	MONRT.			;NO, SOFT EXIT TO MONITOR
	JRST	(U1)		;YES, JUMP TO DDT
>;END FTDBUG CONDITIONAL
	UUOS
	SUBTTL	CHARACTER AND STRING-HANDLING UUOS

;	W2CH	E	;WRITE 2 CHARACTERS FROM RIGHT HALF OF LOCATION E
;	W2CHI	E	;WRITE 2 CHARACTERS IMMEDIATE

UW2CH:	MOVE	U1,(U1)		;GET DATA TO BE WRITTEN
UW2CHI:	ROT	U1,-7		;RIGHT-JUSTIFY FIRST CHARACTER
	PUSHJ	P,UWCHI		;WRITE IT OUT
	ROT	U1,7		;RIGHT-JUSTIFY SECOND CHARACTER
	PJRST	UWCHI		;WRITE IT AND RETURN

;	WCH	E	;WRITE 1 CHARACTER FROM RIGHT HALF OF LOCATION E
;	WCHI	E	;WRITE 1 CHARACTER IMMEDIATE

UWCH:	MOVE	U1,(U1)		;FETCH DATA TO BE WRITTEN
UWCHI:	SKIPN	U2,OFILE	;GET OUTPUT FILE BLOCK POINTER
	MOVEI	U2,TTOBLK	;ZERO MEANS TELETYPE
	XCT	FILXCT(U2)	;EXECUTE BYTE OUTPUT INSTRUCTION
	POPJ	P,		;RETURN FROM UUO HANDLER

;DEFAULT BYTE OUTPUT ROUTINE.  OUTPUTS CONTENTS OF U1 TO FILE BLOCK
;   POINTED TO BY U2

A1BYTE==:O1BYTE			;ALSO DEFAULT BYTE APPEND ROUTINE

O1BYTE:	SOSGE	FILCTR(U2)	;CHECK BYTE COUNT
	JRST	XCTOUT		;GO EXECUTE OUT UUO
	IDPB	U1,FILPTR(U2)	;PLACE CHARACTER IN OUTPUT BUFFER
	POPJ	P,		;RETURN FROM UUO

;HERE DURING BUFFERED OUTPUT WHEN A BUFFERFUL MUST BE FORCED OUT
XCTOUT:	PUSHJ	P,UXCT2		;EXECUTE OUT UUO
	  OUT
	  JRST	O1BYTE		;OK, NOW GO WRITE THE CHARACTER
	JRST	FOUERR		;ERROR, GO HANDLE IT
IFN $NCHFL,<
;	RFLG	E	;COMPUTE ATTRIBUTES OF CHARACTER AT LOCATION E
;			;  AND STORE THEM AT E+1.
;	RCHF	E	;READ 1 CHAR INTO E AND STORE FLAGS IN E+1
;	CCHF	E	;STORE CURRENT CHAR AND FLAGS
;	LCHF	E	;STORE PREVIOUS CHAR AND FLAGS

UCCHF:	PUSHJ	P,UCCH		;RETRIEVE CURRENT CHARACTER
	PJRST	URFLG		;STORE FLAGS FOR IT AND RETURN

ULCHF:	PUSHJ	P,ULCH		;FETCH LAST CHARACTER
	PJRST	URFLG		;STORE FLAGS FOR IT AND RETURN

URCHF:	PUSHJ	P,URCH		;READ AND STORE CHARACTER INTO (U1)
URFLG:	MOVE	U2,(U1)		;FETCH CHARACTER
IFN FTDBUG,<
	CAIL	U2,200		;LEGAL ASCII CHARACTER?
	EDISIX	[DDTXIT,,[SIXBIT/INPUT OUT OF RANGE FOR RFLG OPERATION#!/]]
>
	IDIVI	U2,$NBYPW	;DETERMINE CORRECT WORD
	IMULI	U3,$NCHFL	;COMPUTE FLAG BYTE POSITION
	MOVE	U2,CHFLTB(U2)	;PICK UP WORD
	ROT	U2,$NCHFL(U3)	;RIGHT-JUSTIFY SELECTED BYTE FIELD
IFN FTDBUG,<
	ANDI	U2,1←$NCHFL-1	;CLEAR OTHER BITS TO MAKE LIFE EASIER DEBUGGING
>
	MOVEM	U2,1(U1)	;STORE FLAGS
	POPJ	P,		;RETURN FROM UUO
>;END $NCHFL CONDITIONAL
;	LCH	E	;READ PREVIOUS CHARACTER INTO LOCATION E
;			;  (BACKUP CAPABILITY OF ONE CHARACTER ONLY)
;	CCH	E	;READ CURRENT CHAR INTO E.  THIS IS THE SAME
;			;   CHARACTER AS MOST RECENTLY READ BY LCH OR RCH

ULCH:	SKIPN	U2,IFILE	;FETCH INPUT FILE BLOCK POINTER
	MOVEI	U2,TTIBLK	;ZERO MEANS TELETYPE INPUT
	MOVEI	U3,BAKFLG	;SETUP TO SET BACKUP FLAG
	IORB	U3,FILCHN(U2)	;SET IT, ALSO REMEMBER RESULT IN U3
	JRST	UCCH1		;GO RETURN CHARACTER

;HERE FROM RCH PROCESSING WHEN WE WERE BACKED UP
UCCH0:	ANDCAM	U3,FILCHN(U2)	;CLEAR BACKUP FLAG
UCCH:	SKIPN	U2,IFILE	;FETCH INPUT FILE BLOCK POINTER
	MOVEI	U2,TTIBLK	;ZERO MEANS TELETYPE INPUT
	HRRZ	U3,FILCHN(U2)	;FETCH CURRENT VALUE OF BACKUP FLAG
UCCH1:	PUSH	P,U1		;SAVE STORAGE POINTER
	TRNE	U3,BAKFLG	;IS INPUT (TO BE) BACKED UP?
	SKIPA	U1,FILBAK(U2)	;YES, FETCH BACKUP CHARACTER
	MOVE	U1,FILCUR(U2)	;NO, FETCH CURRENT CHARACTER
	JRST	URCHM		;GO STORE CHAR AND RETURN
;	RCH	E	;READ 1 CHARACTER INTO LOCATION E (NO FLAGS)

URCH:	SKIPN	U2,IFILE	;FETCH INPUT FILE BLOCK POINTER
	MOVEI	U2,TTIBLK	;ZERO MEANS TELETYPE INPUT
	MOVEI	U3,BAKFLG	;SETUP BACKUP FLAG TO TEST
	TDNE	U3,FILCHN(U2)	;IS INPUT BACKED UP?
	JRST	UCCH0		;YES, GET CURRENT CHAR RATHER THAN NEXT
	PUSH	P,U1		;NO, SAVE STORAGE POINTER
URCH1:	XCT	FILXCT(U2)	;EXECUTE BYTE INPUT INSTRUCTION
URCH2:	  SKIPA	U3,U1		;NORMAL RETURN, COPY CHARACTER
	JRST	URCH1		;IGNORE BYTE RETURN, GET NEXT
	EXCH	U3,FILCUR(U2)	;PUSH BACK CURRENT AND BACKUP CHARACTERS
	MOVEM	U3,FILBAK(U2)
URCHM:	MOVEM	U1,@(P)		;STORE CURRENT CHARACTER
	JRST	U1POPJ		;RESTORE POINTER TO U1 AND RETURN

;DEFAULT INPUT-A-BYTE ROUTINE.  TAKES INPUT FILE BLOCK POINTER IN U2
;   AND RETURNS THE BYTE IN U1.

I1BYTE:	SOSGE	FILCTR(U2)	;DECREMENT AND TEST INPUT BYTE COUNTER
	JRST	XCTIN		;EMPTY, GO DO AN IN UUO
	ILDB	U1,FILPTR(U2)	;OK, FETCH NEXT BYTE
	POPJ	P,

;HERE DURING BUFFERED INPUT WHEN THE INPUT BUFFER IS EMPTY

XCTIN:	PUSHJ	P,UXCT2		;EXECUTE IN UUO
	  IN
	  JRST	I1BYTE		;OK, NOW GET NEXT CHARACTER
	PUSHJ	P,UXCT2		;ERROR, SEE WHAT KIND
	  STATO	IO.EOF
FOUERR:	  SKIPA	U1,FILER2(U2)	;DEVICE,DATA ERROR, ETC.  GET ERROR DISPATCH
	MOVS	U1,FILER2(U2)	;END OF FILE.  GET EOF DISPATCH
				;   AND FALL INTO UERXIT.
;UUO ERROR EXIT CODE.  ENTER WITH LOCATION TO BE DISPATCHED TO IN U1.
;   THIS ROUTINE WILL RETURN AT THE LEVEL OF THE HIGHEST UUO FOUND
;   ON THE STACK.

UERXIT:	SUB	P,[MXUSRC,,MXUSRC] ;BACK UP THE STACK FOR SEARCHING
UERSRC:	MOVSI	U2,(PC.USR)	;SETUP USER MODE FLAG IN LH
	XOR	U2,(P)		;FETCH WORD W/ USER MODE FLAG COMPLEMENTED
	TLZ	U2,777740-<PC.USR>B53 ;CLEAR BITS WE CAN'T PREDICT
	CAIE	U2,UUOXIT	;IS THIS IN THE MIDDLE OF A UUO CALL?
	AOBJN	P,UERSRC	;NO, KEEP SEARCHING
IFN FTDBUG,<
	JUMPGE	P,USRCER	;CHECK AGAINST SEARCH FAILING
>
UIOErr:	MOVEM	U1,-4(P)	;OK, NOW OVERLAY UUO RETURN PC
	POPJ	P,		;RESTORE AC'S AT THAT LEVEL AND RETURN

IFN FTDBUG,<
;HERE IF NONE OF THE LAST MXUSRC WORDS ON THE STACK SATISFIED THE
;   CONDITIONS FOR "LOOKING LIKE A PC WORD AT UUOXIT", NAMELY:
;	USER MODE FLAG SET
;	BITS 13-17 CLEAR
;	RH EQUAL TO UUOXIT.

USRCER:	EDISIX	[DDTXIT,,[SIXBIT\UERXIT STACK SEARCH FAILED#!\]]
>

;ROUTINE TO EXECUTE AN I/O UUO FOR THE PROPER CHANNEL.
;   ENTER AT UXCT1 WITH ADDRESS OF FILE BLOCK IN U1, OR
;	  AT UXCT2 WITH ADDRESS OF FILE BLOCK IN U2.
;	PUSHJ	P,UXCT[1,2]
;	A UUO TO BE EXECUTED (E.G. IN OR STATZ 740000)
;	  UUO NON-SKIP RETURN
;	UUO SKIP RETURN
;   U3 IS ALWAYS CLOBBERED.  U2 IS CLOBBERED AT UXCT1 ENTRY.

UXCT1:	MOVEI	U2,(U1)		;PUT FILE BLOCK ADDRESS INTO U2
UXCT2:	HLLZ	U3,FILCHN(U2)	;FETCH I/O CHANNEL NUMBER
	IOR	U3,@(P)		;CONSTRUCT UUO FROM IN-LINE ARGUMENT
	AOS	(P)		;SKIP OVER ARGUMENT
	XCT	U3		;EXECUTE THE UUO
	  POPJ	P,		;NON-SKIP RETURN
	JRST	CPOPJ1		;SKIP RETURN
;SOME DEFINITIONS:

;ASCIZ STRING
;   A STRING OF ZERO OR MORE 7-BIT ASCII CHARACTERS TERMINATED WITH
;   A NULL (ASCII 000).  ASCII CODE 001 (CONTROL-A) IS RESTRICTED.

;SIXBIT STRING (INDEFINITE)
;   A STRING OF ZERO OR MORE 6-BIT ASCII (ASCII CODE -40) CHARACTERS
;   TERMINATED WITH AN EXCLAMATION POINT (!).  THE FOLLOWING CHARACTERS
;   ARE RESTRICTED:
;      CHAR  SIXBIT  ASCII  MEANING
;	!      01     041   END OF STRING
;	"      02     042   QUOTES THE NEXT CHARACTER
;	#      03     043   STANDS FOR A CARRIAGE-RETURN LINE-FEED
;	$      04     044   STANDS FOR A TAB
;	%      05     045   RESTRICTED - USED IN EDIT LIST PROCESSING
;	&      06     046   CASE SHIFT (LETTERS TO UPPER OR LOWER CASE)

;EDIT LIST
;   A BLOCK CONSTRUCTED AS FOLLOWS:
;	XWD RETURN ADDRESS,[SIXBIT OR ASCIZ STRING]
;	INSTRUCTION
;	 ...
;	INSTRUCTION
;   THE EDIT OUTPUT UUOS (DISIX, EDISIX, DIASC, EDIASC) TAKE THIS LIST
;   AS AN ARGUMENT, AND OUTPUT THE SIXBIT OR ASCIZ STRING.  FOR EACH
;   OCCURRENCE OF THE EDIT CHARACTER (% IN SIXBIT, CONTROL-A IN ASCII),
;   THE NEXT INSTRUCTION IN THE INSTRUCTION LIST IS EXECUTED.  THESE
;   INSTRUCTIONS ARE PRESUMABLY BUT NOT NECESSARILY OTHER OUTPUT UUOS,
;   AND ARE EXECUTED WITH U1 AND U3 (BUT NOT U2) SETUP AS IN THE
;   ENVIRONMENT OF THE EDIT OUTPUT UUO.

;	DIASC	E	;PROCESS ASCII EDIT LIST AT E
;	EDIASC	E	;SAME, BUT DIRECT OUTPUT TO ERROR DEVICE.

UEDIAS:	PUSHJ	P,ERFWRT	;SAVE OFILE, SETUP OFILE WITH ERROR ADR
UDIASC:	MOVEI	U2,WASC0	;CALL THE WASC UUO ROUTINE
	JRST	UDIXCT

;	DISIX	E	;PROCESS SIXBIT EDIT LIST AT E
;	EDISIX	E	;SAME, BUT DIRECT OUTPUT TO ERROR DEVICE

UEDISI:	PUSHJ	P,ERFWRT	;SAVE OFILE, SETUP OFILE WITH EFILE
UDISIX:	MOVEI	U2,UWSIXZ	;SETUP TO CALL WSIX UUO ROUTINE
UDIXCT:	HRL	U1,UUOPDP	;PUT CURRENT STACK LEVEL IN LH
	PUSH	P,U1		;STACK LOCATION OF EDIT LIST
	MOVE	U1,(U1)		;GET FIRST WORD OF EDIT LIST
	TLNE	U1,-1		;IS A RETURN ADDRESS SPECIFIED?
	HLRZM	U1,@UUOPDP	;YES, STORE IT FOR LATER RETURN
	PUSHJ	P,(U2)		;CALL WASC OR WSIX CODE
	JRST	U1POPJ		;THROW AWAY EDIT POINTER AND RETURN
;	WASC	E	;WRITE ASCIZ STRING AT LOCATION E
;	EWASC	E	;SAME, BUT DIRECT OUTPUT TO ERROR DEVICE

UEWASC:	PUSHJ	P,ERFWRT	;DO FOLLOWING ONTO ERROR DEVICE
UWASC:	TDZA	U3,U3		;MAKE CPOPJ(U3) BE NOP TO PREVENT EDITING
WASC0:	MOVEI	U3,DIEDIT-CPOPJ	;MAKE CPOPJ(U3) BE CALL TO DIEDIT TO ALLOW EDITING
	HRLI	U1,(POINT 7,)	;MAKE ASCII BYTE POINTER TO DATA
WASC1:	ILDB	U2,U1		;GET NEXT CHARACTER
	SOJL	U2,CPOPJ	;RETURN IF END OF STRING
	JUMPN	U2,.+2		;EDIT CHARACTER (CONTROL-A) ?
	PUSHJ	P,CPOPJ(U3)	;YES,  EITHER NOP AND PRINT OR DO EDIT
	  WCHI	1(U2)		;NO, OUTPUT THE CHARACTER NORMALLY
	JRST	WASC1		;GO BACK FOR NEXT CHARACTER

;	WSIX	N,E	;IF N=0, WRITE INDEFINITE SIXBIT STRING AT
;			;  LOCATION E, WITH USUAL SPECIAL CHARACTER PROCESSING
;			;IF N>0, WRITE JUST N CHARACTERS, NO PROCESSING.
;	EWSIX	E	;WRITE INDEFINITE SIXBIT STRING ONTO ERROR DEVICE

	CASFLG==1B17		;CASE FLAG IN LH OF U3 SET AS '&'S ARE SEEN

UEWSIX:	PUSHJ	P,ERFWRT	;DO FOLLOWING ONTO ERROR DEVICE
UWSIXZ:	SETZ	U3,		;CLEAR COUNTER FOR EWSIX, DISIX, ETC.
UWSIX:	HRLI	U1,(POINT 6,)	;SET UP SIXBIT BYTE POINTER
UWSIX1:	ILDB	U2,U1		;PICK UP A SIXBIT CHARACTER
	HRRI	U3,-1(U3)	;DECREMENT CHARACTER COUNT
	TRNN	U3,400000	;WAS IT POSITIVE? (& NOW 0 OR MORE)
	JRST	UWSIX2		;YES, NO SPECIAL CHARACTERS
	CAIL	U2,'A'		;IS THE CHARACTER A LETTER?
	CAILE	U2,'Z'
	JRST	.+3		;NO
	TLNE	U3,(CASFLG)	;YES, IS LOWER CASE TRANSLATE IN EFFECT?
	MOVEI	U2,40(U2)	;YES, CONVERT LETTER TO LOWER CASE
	CAIG	U2,'&'		;A SPECIAL CHARACTER?
	XCT	WSXTAB(U2)	;YES. PERFORM SPECIAL ACTION.
UWSIX2:	  WCHI	40(U2)		;CONVERT CHAR TO ASCII AND OUTPUT IT
UWSIX3:	TRNE	U3,-1		;GO BACK FOR MORE IF INDEFINITE STRING OR
	JRST	UWSIX1		;  CHAR COUNT NOT DONE. OTHERWISE, FALL INTO
				;  TABLE BELOW AND EXIT UUO LEVEL.

;TABLE OF SPECIAL ACTIONS FOR WSIX UUO

WSXTAB:	JFCL			; 0 (BLANK) - NO SPECIAL ACTION
	POPJ	P,		; 1 (!) - END OF STRING
	ILDB	U2,U1		; 2 (") - TAKE NEXT CHARACTER LITERALLY
	PUSHJ	P,WSXCLF	; 3 (#) - OUTPUT CR/LF
	MOVEI	U2,11-40	; 4 ($) - OUTPUT A TAB
	PUSHJ	P,DIEDIT	; 5 (%) - EXECUTE NEXT INST IN EDIT LIST
	TLCA	U3,(CASFLG)	; 6 (&) - COMPLEMENT LOWER CASE DIFFERENCE
				;	   AND SKIP TO SUPPRESS OUTPUT OF %

;ROUTINE TO OUTPUT CR/LF AND SKIP.

WSXCLF:	W2CHI	CRLF		;OUTPUT CR/LF
	JRST	CPOPJ1		;TAKE SKIP RETURN TO SUPPRESS PRINTING #
;ROUTINE TO EXECUTE NEXT INSTRUCTION IN EDIT LIST.
;   THIS ROUTINE EXPECTS THE WORD AT -1(P) ON THE STACK (WITH RESPECT
;   TO THE CALLER) TO CONTAIN   XWD SLOC,ELOC   WHERE
;	SLOC	IS THE POINTER TO THE STACK AT THE LEVEL OF THE
;		DIASC, DISIX, ETC., UUO BEING PROCESSED.
;	ELOC	IS A POINTER TO THE LAST INSTRUCTION EXECUTED IN THE
;		EDIT LIST
;   THIS ROUTINE ALWAYS SKIPS.  U2 IS CLOBBERED.
DIEDIT:	AOS	(P)		;WE ALWAYS SKIP (TO NOT PRINT '%')
	AOS	U2,-2(P)	;GET THE FUNNY ARGUMENT
	PUSHJ	P,USWAP		;SWAP CONTEXTS (U1,U3 ONLY)
	XCT	(U2)		;EXECUTE EDIT LIST INSTRUCTION
;	PJRST	USWAP		;FALL INTO USWAP

USWAP:	MOVS	U2,U2		;PUT STACK POINTER IN RH
	EXCH	U1,1(U2)	;SWAP U1 AND OLD SAVED U1
	EXCH	U3,3(U2)	;SWAP U3 AND OLD SAVED U3
	MOVS	U2,U2		;RESTORE EDIT LIST POINTER TO RH
	POPJ	P,		;RETURN TO DIEDIT OR TO CALLER OF DIEDIT

;ROUTINE TO REDIRECT SUBSEQUENT OUTPUT TO THE ERROR DEVICE, BUT WITH
;   THE OLD OFILE SAVED AND RESTORED.  THIS ROUTINE RETURNS ONE STACK
;   LEVEL DEEPER THAN THE CALL, SUCH THAT WHEN THE SUBSEQUENT CODE
;   RETURNS, CONTROL WILL COME BACK HERE TO RESTORE THE OLD OFILE.

ERFWRT:	MOVE	U2,EFILE	;GET ERROR FILE BLOCK POINTER
	EXCH	U2,OFILE	;DIRECT OUTPUT TO THAT FILE
	EXCH	U2,(P)		;SAVE OLD OFILE AND GET ADR OF CALLER
	PUSHJ	P,(U2)		;EXECUTE SUBSEQUENT CODE DOWN TO NEXT POPJ
	POP	P,OFILE		;RESTORE PREVIOUS OFILE
	POPJ	P,		;RETURN TO CALLER OF CALLER
	SUBTTL	INTEGER OUTPUT CONVERSION UUOS

;	WOCT	N,E	;WRITE WORD AT E AS AN N-DIGIT OCTAL NUMBER
;	WOCTI	N,E	;WRITE THE NUMBER E AS AN N-DIGIT OCTAL NUMBER
;	WDEC	N,E	;WRITE WORD AT E AS AN N-DIGIT DECIMAL NUMBER
;	WDECI	N,E	;WRITE THE NUMBER E AS AN N-DIGIT DECIMAL NUMBER
;   IF N IS TOO SMALL, IT IS IGNORED.  IF N IS TOO LARGE, LEADING BLANKS
;   ARE SUPPLIED, UNLESS LZEFLG IS SET IN F, IN WHICH CASE LEADING
;   ZEROES ARE SUPPLIED.  ALL NUMBERS ARE UNSIGNED.

UWDEC:	SKIPA	U1,(U1)		;WDEC - GET NUMBER AT E
UWOCT:	SKIPA	U1,(U1)		;WOCT - GET NUMBER AT E
UWDECI:	SKIPA	U2,BASE10	;WDECI - SET UP RADIX OF 10
UWOCTI:	MOVEI	U2,↑D8		;WOCTI - SET UP RADIX OF 8
				;  FALL INTO NUMOUT

;CENTRAL NUMERIC OUTPUT CONVERSION ROUTINE.
;ENTER WITH NUMBER IN U1, RADIX IN U2.

NUMOUT:	HRRZM	U2,.JBUUO	;SAVE RADIX IN A CONVENIENT PLACE
NUMCNV:	LSHC	U1,-↑D35	;PREVENT TROUBLE WITH SIGN BIT
	LSH	U2,-1		;  BY USING DOUBLE-PRECISION DIVIDEND
	DIV	U1,.JBUUO	;EXTRACT LOW-ORDER DIGIT
	HRLM	U2,(P)		;SAVE DIGIT ON STACK
	JUMPE	U1,NUMSPC	;JUMP IF NO DIGITS LEFT
	HRREI	U3,-1(U3)	;DECREMENT DIGIT COUNT
	PUSHJ	P,NUMCNV	;RECURSE FOR NEXT DIGIT.

;HERE  ON SUCCESSIVE RETURN

NUMDIG:	HLRZ	U1,(P)		;RECOVER A DIGIT FROM THE STACK
	WCHI	"0"(U1)		;CONVERT TO ASCII AND OUTPUT IT.
BASE10:	POPJ	P,↑D10		;RETURN FOR NEXT DIGIT, OR RETURN FROM UUO.

;HERE WHEN ALL DIGITS ARE ON STACK.
;ACCOUNT FOR LEADING ZEROES IF ANY.

NUMSPC:	Txne	F,LZEFLG	;SUPPRESS LEADING ZEROES?
	MOVEI	U1,"0"-" "	;NO, SET TO USE LEADING ZEROES
	SOJLE	U3,NUMDIG	;ANY CHARACTER POSITIONS LEFT TO FILL?
	WCHI	" "(U1)		;YES. OUTPUT A BLANK OR A ZERO
	JRST	.-2
	SUBTTL	UUOS FOR PRINTING FILE SPECIFICATIONS

;	WNAME	E	;WRITE SIXBIT NAME AT E (UP TO SIX CHARACTERS)
;			;  WITH TRAILING BLANKS SUPPRESSED

UWNAME:	MOVE	U2,(U1)		;GET THE SIXBIT NAME
UWNAM1:	JUMPE	U2,CPOPJ	;RETURN IF NO MORE CHARACTERS
	SETZ	U1,		;CLEAR THE HIGH WORD
	LSHC	U1,6		;SHIFT IN A NEW CHARACTER
	WCHI	40(U1)		;CONVERT TO ASCII AND OUTPUT
	JRST	UWNAM1		;GO BACK FOR NEXT CHAR

;	WPPN	E	;OUTPUT CONTENTS OF E AS A PROJECT,PROGRAMMER NUMBER

UWPPN:	IFN FTCMU,<
	MOVSI	U2,(U1)		;MAKE DECCMU WORD
	HRRI	U2,CMPPN	;ADDR OF DEC IN LH, ADDR OF CMU IN RH
	SETZM	CMPPN+1		;[CFE] DECCMU doesn't always ret ASCIZ
	SETZM	CMPPN+2
	MCALL	U2,[SIXBIT\DECCMU\]
	  JRST	UWPPN1		;NOT AT CMU
	WASC	CMPPN		;MADE IT. PRINT
	POPJ	P,		;AND RETURN
UWPPN1:>
	HLRZ	U2,(U1)		;GET PROJECT NUMBER
	WOCTI	(U2)		;OUTPUT IT
	WCHI	","		;COMMA
	HRRZ	U2,(U1)		;GET PROGRAMMER NUMBER
	WOCTI	(U2)		;OUTPUT IT
	POPJ	P,

;[avsail] additional LUUO to support SFDs
;	WPath	E	; output the path pointer or PPN pointed at by E.

UWPath:	skipe	u2,(u1)		; get the pointer or PPN.  (if none, [0,0])
	 tlne	u2,-1		; is there a left half?
	  jrst	UWPPn		; yes.  we're in the wrong routine
	WPPn	.PtPPn(u2)	; print the PPN from the path
	hrli	u2,-<.PtMax-1-.PtSfd>	; make AOBJN pointer for SFDs
UWPat0:	skipn	.PtSfd(u2)	; is this empty?
	  popj	p,		; yes.  zero indicates end of list.
	WChI	","		; separate from the rest of the path
	WName	.PtSfd(u2)	; and print that SFD
	aobjn	u2,UWPat0	; loop until no more
	popj	p,		; no more
;[avsail] end of additional LUUO

;	WNAMX	E	;OUTPUT CONTENTS OF E AND E+1 AS FILENAME.EXTENSION
;			;  OR N,N.UFD

UWNAMX:	HLRZ	U2,1(U1)	;GET EXTENSION
	CAIE	U2,'UFD'	;IS IT A UFD?
	wname   (u1)		;NO, OUTPUT SIXBIT FILENAME NORMALLY
	CAIN	U2,'UFD'
	WPPN	(U1)		;YES, OUTPUT PROJECT,PROGRAMMER NUMBER INSTEAD
	WCHI	"."		;PERIOD
	WSIX	3,1(U1)		;EXTENSION
	POPJ	P,

;	WFNAME	E	;OUTPUT A COMPLETE FILE SPECIFICATION USING
;			;  THE FILE BLOCK AT LOCATION E;  E.G.
;			;   DEVICE:FILENAME.EXTENSION[PROJECT,PROGRAMMER]
;			;  EXCEPT THAT NAME.EXT AND/OR [PROJ,PROG]
;			;  ARE OMITTED IF ZERO

UWFNAM:	WNAME	FILDEV(U1)	;WRITE DEVICE NAME
	WCHI	":"		;COLON
	SKIPE	FILNAM(U1)	;NONZERO NAME?
	WNAMX	FILNAM(U1)	;WRITE FILENAME.EXT OR N,N.UFD
	SKIPE	FILPPN(U1)	;DON'T WRITE [PROJ,PROG] IF ZERO
	DISIX	[[SIXBIT/[%]!/]
;[avsail]	WPPN	FILPPN(U1)	; print PPN if no SFDs
		WPath	FilPPn(u1)	;[avsail] print this path
		]
	POPJ	P,
	SUBTTL	FILE ERROR HANDLING UUOS

;THE UUOS WHOSE NAMES START WITH "ERR" DIRECT THEIR OUTPUT TO THE
;   ERROR DEVICE IN THE COMPLETE FORM:
;	<CRLF>? DEV:FILE.EXT[PROJ,PROG] (N) REASON FOR ERROR<CRLF>
;   THE UUOS WHOSE NAMES START WITH "WER" OUTPUT TO THE REGULAR
;   OUTPUT DEVICE AND PRINT ONLY THE (N) REASON FOR ERROR<CRLF> PORTION.
;   ALL UUOS TAKE AS THEIR ARGUMENT THE FILE BLOCK POINTED TO BY
;   THE EFFECTIVE ADDRESS OF THE UUO.

;	WERIOP	E	;INPUT OPEN ERROR
;	ERRIOP	E
;	WEROOP	E	;OUTPUT OPEN ERROR
;	ERROOP	E
;	WERLK	E	;INPUT LOOKUP ERROR
;	ERRLK	E
;	WERENT	E	;OUTPUT ENTER ERROR
;	ERRENT	E
;	WERIN	E	;INPUT READ OR CLOSE ERROR
;	ERRIN	E
;	WEROUT	E	;OUTPUT WRITE OR CLOSE ERROR
;	ERROUT	E

UFERRO:	ROT	U3,-2		;DIVIDE AC FIELD BY 4, REMAINDER IN LH
	JUMPGE	U3,UFERR1	;JUMP IF "WERXXX" AND NOT "ERRXXX"
	PUSHJ	P,ERFWRT	;"ERRXXX", DIRECT OUTPUT TO EFILE
	W2CHI	"? "		;PRECEDE WITH QUESTION MARK
	HLRZ	U2,WSPCPT(U3)	;GET DISPATCH BASED ON ERROR TYPE
	PUSHJ	P,(U2)		;TYPE DEVICE AND/OR FILENAME

;HERE TO GET DEVICE CHARACTERISTICS FOR THE GIVEN DEVICE
UFERR1:	MOVE	U2,FILDEV(U1)	;FETCH DEVICE NAME
	SKIPL	FILSTS(U1)	;DEVICE OPEN IN PHYS-ONLY MODE?
	DEVCHR	U2,		;NO, DO NORMAL DEVCHR
	SKIPGE	FILSTS(U1)
	DEVCHR	U2,UU.PHY	;YES, DO PHYSICAL-ONLY DEVCHR
	HRR	U2,WSPCPT(U3)	;FETCH DISPATCH BASED ON ERROR TYPE
	HLR	U3,U2		;PLACE LH DEVCHR BITS IN RH OF U3
	JRST	(U2)		;DISPATCH ON ERROR TYPE

;ERROR TYPE DISPATCH TABLE.  LH ENTRY IS POINTER TO ROUTINE TO TYPE
;   DEVICE AND/OR FILENAME.  RH ENTRY IS WHERE TO GO TO ANALYZE ERROR.
WSPCPT:	WERDVN	,, EROPEN	;OPEN ERROR
	UWFNAM	,, ERLKEN	;LOOKUP/ENTER ERROR
	UWFNAM	,, ERINOU	;INPUT/OUTPUT ERROR

;ROUTINE TO TYPE "DEVICE DEV:" FOR ERRIOP AND ERROOP
WERDVN:	DISIX	[CPOPJ,,[SIXBIT\D&EVICE %:!\]
		WNAME	FILDEV(U1)]	;TYPE DEVICE NAME
;HERE TO ANALYZE OPEN ERRORS
EROPEN:	TRNN	U3,(DV.IN!DV.OUT) ;SKIP IF DEVICE EXISTS
	WSIX	[SIXBIT\& DOES NOT EXIST#!\]
	TRNE	U3,(DV.IN!DV.OUT) ;SKIP IF DEVICE DOES NOT EXIST
	WSIX	[SIXBIT\& NOT AVAILABLE#!\]
	POPJ	P,		;RETURN

;HERE TO ANALYZE LOOKUP/ENTER ERRORS
ERLKEN:	HRRZ	U1,FILEXT(U1)	;FETCH ERROR CODE RETURNED BY LOOKUP/ENTER
	MOVEI	U2,(U1)	;COPY IT
	CAIL	U2,NLKENT	;IN RANGE OF OUR LOOKUP/ENTER ERROR TABLE?
	JRST	UFER1A		;NO, SAY "UNEXPECTED"
	JRST	UFERR2		;YES, PRINT APPROPRIATE MESSAGE

;HERE TO ANALYZE INPUT/OUTPUT ERRORS
ERINOU:	HLLZ	U1,FILCHN(U1)	;FETCH CHANNEL NUMBER
	IOR	U1,[GETSTS U1]	;CONSTRUCT GETSTS FOR GETTING STATUS
	XCT	U1		;DO IT
	TRNE	U1,IO.ERR!IO.EOF ;ANY ERROR BITS SET?
	JFFO	U1,.+3		;YES, FIND POSITION OF FIRST ONE

;HERE WHEN WE DON'T KNOW WHAT THE ERROR IS. SAY "UNEXPECTED"
UFER1A:	MOVEI	U2,UNXER	;SETUP INDEX FOR MESSAGE
	JRST	UFERR3		;PRINT IT WITHOUT FURTHER ADO

;HERE WITH RESULT OF JFFO IN U2
	MOVEI	U2,NLKENT-↑D18(U2) ;CONVERT TO CODE ABOVE LAST LOOKUP ERROR

;HERE WITH THE CORRECT CODE FOR THE MESSAGE IN U2 AND THE LITERAL ERROR
;   INFORMATION IN U1.  PICK MESSAGE ITSELF BASED ON DIRECTION AND
;   DEVICE TYPE.
UFERR2:	TLNN	U3,(1B1)	;INPUT OR OUTPUT?
	SKIPA	U2,ERRPT1(U2)	;INPUT, USE RH OF TABLE
	MOVS	U2,ERRPT1(U2)	;OUTPUT, USE LH OF TABLE
	TRNE	U3,(DV.DTA)	;DECTAPE?
	LSH	U2,-↑D6		;YES, POSITION DECTAPE ENTRY
	TRNE	U3,(DV.DSK)	;DISK?
	LSH	U2,-↑D12	;YES, POSITION DISK ENTRY
	ANDI	U2,77		;MASK OUT OTHER BITS

;HERE WITH DESIRED ERROR NUMBER IN U2
UFERR3:	move	u3,u2			; can't use U2 within DISIX
	DISIX	[CPOPJ,,[SIXBIT\ (%) %#!\]
		WOCTI	(U1)		;TYPE ERROR DATA GIVEN US
		WSIX	@ERRPnt(U3)]	;TYPE CORRECT MESSAGE
;TABLE OF POINTERS INTO THE ERROR MESSAGE TABLE.  ENTRIES ARE CODED
;   AS:  DISK OUTPUT,DTA OUTPUT,OTHER OUTPUT,DISK INPUT,DTA INPUT,OTHER INPUT
;   THE FIRST NLKENT ENTRIES ARE FOR LOOKUP/ENTER ERROR CODES, THE
;   LAST 5 ARE FOR INPUT/OUTPUT ERROR BITS

	DEFINE	ERP(DO,TO,OO,DI,TI,OI) <
	BYTE(6)	DO'ER,TO'ER,OO'ER,DI'ER,TI'ER,OI'ER
>

	SALL

ERRPT1:	ERP	(IFN,IFN,UNX,FNF,FNF,UNX)	;  0 (ENTER/LOOKUP-GETSEG-RUN)
	ERP	(IPP,UNX,UNX,IPP,UNX,UNX)	;  1
	ERP	(PRT,DFL,UNX,PRT,UNX,UNX)	;  2
	ERP	(FBM,FBM,UNX,UNX,UNX,UNX)	;  3
	ERP	(AEF,AEF,UNX,UNX,UNX,UNX)	;  4
	ERP	(ISU,ISU,ISU,ISU,ISU,ISU)	;  5
	ERP	(UFR,TRN,TRN,UFR,TRN,TRN)	;  6
	ERP	(UNX,UNX,UNX,NSF,NSF,NSF)	;  7
	ERP	(UNX,UNX,UNX,NEC,NEC,NEC)	; 10
	ERP	(UNX,UNX,UNX,DNA,DNA,DNA)	; 11
	ERP	(UNX,UNX,UNX,NSD,NSD,NSD)	; 12
	ERP	(UNX,UNX,UNX,ILU,ILU,ILU)	; 13
	ERP	(NRM,UNX,UNX,UNX,UNX,UNX)	; 14
	ERP	(WLK,UNX,UNX,UNX,UNX,UNX)	; 15
	ERP	(NET,UNX,UNX,NET,UNX,UNX)	; 16
	ERP	(PAO,UNX,UNX,UNX,UNX,UNX)	; 17
	ERP	(BNF,UNX,UNX,UNX,UNX,UNX)	; 20
	ERP	(NSP,UNX,UNX,UNX,UNX,UNX)	; 21
	ERP	(DNE,UNX,UNX,UNX,UNX,UNX)	; 22
	ERP	(SNF,UNX,UNX,SNF,UNX,UNX)	; 23
	ERP	(SLE,UNX,UNX,SLE,UNX,UNX)	; 24
	ERP	(LVL,UNX,UNX,LVL,UNX,UNX)	; 25
	ERP	(NCE,UNX,UNX,UNX,UNX,UNX)	; 26
	ERP	(UNX,UNX,UNX,SNS,UNX,UNX)	; 27

	NLKENT==.-ERRPT1	;NUMBER OF LOOKUP/ENTER ENTRIES

	ERP	(WLK,WLK,WLK,WLK,WLK,WLK)	; 18 (BIT FROM GETSTS)
	ERP	(DEV,DEV,DEV,DEV,DEV,DEV)	; 19 (OUTPUT/INPUT)
	ERP	(CKP,CKP,CKP,CKP,CKP,CKP)	; 20
	ERP	(NRM,TFL,BTL,BTL,BTL,BTL)	; 21
	ERP	(UNX,UNX,UNX,EOF,EOF,EOF)	; 22

	XALL
	SUBTTL	FILE UTILITY UUOS

;	FSETUP	E	;MOVE THE ***HIGH*** -SEGMENT FILE
;			;  BLOCK AT LOCATION E TO ITS RUNTIME LOCATION

UFSETU:	MOVE	U2,FHDLOC(U1)	;FETCH AOBJN PTR FOR SETTING UP BLOCK
	MOVE	U3,FHDBTS(U1)	;FETCH BITS MARKING NONZERO WORDS
UFSET1:	PUSH	P,FHDOFS(U1)	;PICK UP A DATA WORD
	JUMPGE	U3,.+2		;NONZERO WORD GOING HERE?
	AOJA	U1,.+2		;YES, ADVANCE HI-SEG POINTER TO NEXT
	SETZM	(P)		;NO, ZERO DATA WORD
	POP	P,(U2)		;STORE WORD IN FILE BLOCK
	LSH	U3,1		;SELECT NEXT BIT IN STORAGE WORD
	AOBJN	U2,UFSET1	;LOOP THRU BLOCK
	POPJ	P,		;RETURN
;	FISEL	E	;SELECT THE FILE BLOCK AT E FOR INPUT
;	FOSEL	E	;SELECT THE FILE BLOCK AT E FOR OUTPUT
;	FIOPEN	E	;SELECT FILE BLOCK AT E AND DO OPEN AND LOOKUP
;	FOOPEN	E	;SELECT FILE BLOCK AT E AND DO OPEN AND ENTER
;	FIGET	E	;SELECT FILE BLOCK AT E AND DO JUST OPEN (INPUT)
;	FOGET	E	;SELECT FILE BLOCK AT E AND DO JUST OPEN (OUTPUT)
;	FLOOK	E	;SELECT FILE BLOCK AT E AND DO JUST LOOKUP
;	FENT	E	;SELECT FILE BLOCK AT E AND DO JUST ENTER
;	FICLOS	E	;SELECT FILE BLOCK AT E AND DO INPUT CLOSE & RELEASE
;	FOCLOS	E	;SELECT FILE BLOCK AT E AND DO OUTPUT CLOSE & RELEASE
;	FICLS	E	;SELECT FILE BLOCK AT E AND DO JUST INPUT CLOSE
;	FOCLS	E	;SELECT FILE BLOCK AT E AND DO JUST OUTPUT CLOSE
;	FREL	E	;DO RELEASE ON FILE BLOCK AT E (DON'T SELECT)
;	FAPEND	E	;SELECT FILE E AND SET UP FOR APPEND

;CODE TO DISPATCH ON THE SUBUUOS OF THE "FUTIL" UUO

	U.LKEN==1B0	;DO LOOKUP/ENTER AFTER OPEN
	U.REL==	1B1	;DO RELEASE AFTER CLOSE
	U.NSTO==1B2	;DON'T STORE FILE BLOCK ADDRESS
	U.APND=1B3	;APPEND COMMAND
	U.OUT==	1B17	;THIS IS AN OUTPUT UUO

UFUTIL:	ROTC	U2,-1		;HALVE U3, PUT LOW BIT IN U2 BIT 0
	LSH	U2,-↑D35	;RIGHT-JUSTIFY EVEN/ODD BIT
	HLL	U1,FUTTBL(U3)	;FETCH SPECIAL BITS INTO U1[LH]
	TLO	U1,(U2)		;SET U.OUT IF AN ODD (OUTPUT) UUO
	TLNN	U1,(U.NSTO)	;UNLESS NO-STORE BIT SET,
	XCT	USTORI(U2)	;  STORE FILE BLOCK ADR IN IFILE OR OFILE
	PJRST	@FUTTBL(U3)	;DISPATCH ON SUBUUO

;INSTRUCTIONS FOR STORING FILE BLOCK ADR
USTORI:	HRRZM	U1,IFILE	;STORE INPUT FILE BLOCK POINTER
USTORO:	HRRZM	U1,OFILE	;STORE OUTPUT FILE BLOCK POINTER

;TABLE FOR DISPATCHING ON AC FIELD /2, AND LOADING LH OF U WITH SPECIAL BITS
FUTTBL:	EXP	CPOPJ		;FISEL,FOSEL (JUST STORE ADR)
	EXP	UOPEN+U.LKEN	;FIOPEN,FOOPEN
	EXP	UOPEN		;FIGET,FOGET
	EXP	ULKEN		;FLOOK,FENT
	EXP	UFClos+U.REL	;FICLOS,FOCLOS
	EXP	UFClos		;FICLS,FOCLS
	EXP	UREL+U.NSTO	;FREL
	EXP	UAPND		;FAPEND
;HERE TO OPEN A DEVICE FOR INPUT OR OUTPUT
UOPEN:	PUSHJ	P,UXCT1		;EXECUTE OPEN UUO
	  OPEN	FILSTS(U1)
	  JRST	EROPN		;ERROR RETURN, GO HANDLE IT
	TLNN	U1,(U.LKEN)	;ALSO DO LOOKUP/ENTER? (FIOPEN,FOOPEN)
	POPJ	P,		;NO (FIGET,FOGET)

;HERE TO DO LOOKUP OR ENTER
ULKEN:	MOVE	U2,FILPPN(U1)	;COPY PERMANENT PPN INTO FIELD THAT
	MOVEM	U2,FILPP1(U1)	;  MONITOR CLOBBERS WITH FILE SIZE
	HLLZ	U2,FILCHN(U1)	;FETCH CHANNEL NUMBER
	IOR	U2,[LOOKUP FILNAM(U1)] ;GENERATE LOOKUP INSTRUCTION
	TLNE	U1,(U.OUT)	;UNLESS OUTPUT DIRECTION
	TLO	U2,(ENTER)	;  IN WHICH CASE MAKE IT AN ENTER
	XCT	U2		;EXECUTE THE LOOKUP/ENTER
	  SKIPA	U1,FILER1(U1)	;ERROR RETURN, GET LOOKUP/ENTER ERROR DISPATCH
	POPJ	P,		;OK RETURN
	JRST	UERXIT		;GO THROUGH UUO ERROR PROCESSING

;HERE TO DO APPEND

UAPND:	MOVE	U2,FILCHN(U1)	;GET THE CHANNEL
	LSH	U2,-5		;PUT IN THE RIGHT PLACE
	HRRI	U2,.FOAPP	;FUNCTION CODE IS APPEND
	TLO	U2,400000	;MAKE SURE 1,2 CAN GET IT...
	MOVEM	U2,FOPBLK+.FOFNC;AND STORE IT
	MOVSI	U2,FILSTS(U1)	;BLT IN THE OPEN BLOCK
	HRRI	U2,FOPBLK+.FOIOS
	BLT	U2,FOPBLK+.FOBRH;ONLY UP TO BUFFER HEADERS
	MOVSI	U2,3		;ALLOCATE 3 BUFFERS
	MOVEM	U2,FOPBLK+.FONBF
	MOVE	U2,FILPPN(U1)	;SAVE PERMANENT PPN
	MOVEM	U2,FILPP1(U1)
	MOVEI	U2,FILNAM(U1)	;PUT IN THE ADDRESS OF THE LOOKUP BLOCK
	MOVEM	U2,FOPBLK+.FOLEB
	MOVE	U2,[XWD .FOLEB+1,FOPBLK] ; DO IT
	FILOP.	U2,
	  JRST	ULKAER		;ERROR, REPORT IT

;POSITION THE BYTE POINTER TO FIRST NON-NULL BYTE, ADJUST COUNT
;(FILOP. POINTS YOU AT THE NEXT FREE WORD)

	HRRZ	U2,FILSTS(U1)	;IF NOT ASCII OR PIM WE'RE O.K.
	CAILE	U2,.IOPIM	;WELL?
	  POPJ	P,		;DON'T HAVE TO WORRY
	MOVE	U3,FILPTR(U1)	;GET THE POINTER
	HRRZ	U2,U3		;AND THE ADDRESS IT'S POINTING TO
	SKIPN	U2		;IF IT'S ZERO, THIS IS A VIRGIN BUFFER
	  POPJ	P,
	PUSH	P,T4		;GET AN AC
	HRRZ	T4,FILPP1(U1)	;IF PROG. NO. NOT CLEARED BY FILOP,
	JUMPN	T4,UAPXIT	;FILE WAS DELETED JUST BEFORE APPEND
	MOVE	T4,FILHDR(U1)	;GET THE ADDRESS OF BUFFER-1
	SOJ	U2,		;BACKUP THE POINTER ONE WORD
;SET UP TO SCAN FOR A NULL BYTE...
	HLL	U2,U3		;OUR NEW POINTER
	MOVEI	T4,5		;BUMP THE COUNT UP
	ADDM	T4,FILCTR(U1)
	MOVE	U3,U2		;KEEP A SPARE TO POINT ONE BYTE
				;BEHIND US
UAPLOP:	ILDB	T4,U2		;GET A BYTE
	JUMPE	T4,UAPSTR	;IF THIS IS NULL WE CAN STOP
	IBP	U3		;BUMP THE POINTER
	SOS	FILCTR(U1)
	JRST	UAPLOP		;LOOK FOR A NULL...
UAPSTR:	MOVEM	U3,FILPTR(U1)	;STORE THE BYTE POINTER
UAPXIT:	POP	P,T4		;RESTORE THE AC.
	POPJ	P,		;AND LEAVE

ULKAER:	MOVE	U1,FILER1(U1)	;HERE ON ERROR, REPORT IT
	JRST	UERXIT		;GO THROUGH UUO ERROR PROCESSING

;HERE TO DO CLOSE
UFClos:	PUSHJ	P,UXCT1		;EXECUTE CLOSE UUO
	  CLOSE
	PUSHJ	P,UXCT1		;EXECUTE STATZ UUO TO CHECK FOR ERRORS
	  STATZ	IO.ERR
	  JRST	ERCLO		;ERROR DETECTED, GO HANDLE IT
	TLNN	U1,(U.REL)	;OK RETURN, ALSO DO RELEASE (FICLOS,FOCLOS)?
	POPJ	P,		;NO (FICLS,FOCLS)

;HERE TO DO RELEASE
UREL:	PUSHJ	P,UXCT1		;EXECUTE RELEASE UUO FOR CHANNEL
	  RELEAS
	POPJ	P,		;RETURN

;HERE ON OPEN AND CLOSE ERRORS

ERCLO:	SKIPA	U1,FILER2(U1)	;CLOSE ERROR - USE INPUT/OUTPUT DISPATCH
EROPN:	HLRZ	U1,FILER1(U1)	;OPEN ERROR - USE OPEN DISPATCH
	JRST	UERXIT		;GO THRU UUO ERROR PROCESSING
	SUBTTL IMPUUO	USER UUO PACKAGE FOR IMP CALLS

Ifn FtImp,<	; lifted from IMPCOM

;VARIOUS ENTRIES TO SET UP AND EXECUTE THE IMP UUOS.
USTAT:	JSP	U2,XCTUUO	; 0	.IUSTT
	JFCL			; 1
	JFCL			; 2
UCONN:	JSP	U2,XCTUUO	; 3	.IUCON
UCLOS0:	JSP	U2,XCTUUO	; 4	.IUCLS
UListe:	Jsp	U2,XctUUO	; 5	.IuLsn
UReque:	JSP	U2,XCTUUO	; 6	.IUReq
	JFCL			; 7
	JFCL			; 8
UXINT:	JSP	U2,XCTUUO	; 9	.IUXNT
UAINT:	JSP	U2,XCTUUO	;10	.IUANT
UVERS:	JSP	U2,XCTUUO	;11	.IUVRS
UDEAS:	JSP	U2,XCTUUO	;12	.IUDEA
ULHOST:	JSP	U2,XCTUUO	;13	.IULHS
	JFCL			;14
	JFCL			;15	.IUGVB
UITTY:	JSP	U2,XCTUUO	;16	.IUITY
	JSP	U2,XCTUUO	;17	.IUXWT
UPESC:	JSP	U2,XCTUUO	;18	.IUPES
URESC:	JSP	U2,XCTUUO	;19	.IURES
UPCPAR:	JSP	U2,XCTUUO	;20	.IUPCP
URCPAR:	JSP	U2,XCTUUO	;21	.IURCP
UXSTAT:	JSP	U2,XCTUUO	;22	.IUXIS
	JSP	U2,XCTUUO	;23	.IUTRC
USETAL:	JSP	U2,XCTUUO	;24	.IUIAL

;THIS BATCH OF ENTRIES SET THE 'DONT WAIT' BIT
UCLOSW:	JSP	U2,NWTXCT	; 4	.IUCLS


;SOME PRIVILEGED UUOS
UNCPNO:	JSP	U2,PRVNST	;64	NOP
UNCPRS:	JSP	U2,PRVNST	;65	RST
	JFCL			;66	ALL
	JFCL			;67	???
	JFCL			;68	???
UNCPEC:	JSP	U2,PRVNST	;69	ECO
UNCPIN:	JSP	U2,PRVNST	;70	SYSTEM INITIALIZE
UNCPDW:	JSP	U2,PRVXCT	;71	SYSTEM DOWN
UNCPUP:	JSP	U2,PRVXCT	;72	SYSTEM UP
;HERE TO DO CROSSPATCH WITH ITS FUNNY STATUS BITS
UXTTY:	HRLI	U1,.IUXTT	;SETUP XPATCH CODE
	Txne	F,ECHSWT	;DO WE WANT TO ECHO?
	TLO	U1,(IF.IEC)	;YES, WE CAN ONLY REMEMBER TO REFUSE
	JRST	XCTUU1		;AND DO IT

;HERE TO SET UP FOR A PRIVILEGED FUNCTION BUT DONT MODIFY THE
;  CONTENTS OF THE SECOND WORD IN THE CONNECTION BLOCK.
PRVNST:	ADDI	U2,.IUNOP-<UNCPNO-USTAT>
	JRST	XCTUUO

;HERE TO SET 'NO WAIT' FLAG AND ADJUST U2 FOR DIFFERENT
;  CALL ADDRESS.
NWTXCT:	ADDI	U2,-<UClosW-UClos0>-<.IUNOP-<UNCPNO-USTAT>>(IF.NWT)

;HERE TO SET UP FOR PRIVILEGED FUNCTIONS
PRVXCT:	ADDI	U2,.IUNOP-<UNCPNO-USTAT>

;HERE TO DO THE UUO
XCTUUO:	SUBI	U2,USTAT+1	;CONVERT ADDRESS TO CODE
	HRLI	U1,(U2)	;AND PUT IN LEFT HALF OF AC
	Move	U2,WaitCd	;GET WAIT CODE
	DPB	U2,[Pointr(U1,If.Tim)] ;PUT IN CALLI AC
	Txne	F,GODSWT	;DOES HE WANT SUPER ACTION?
	TLO	U1,(IF.PRV)	;YES
	Txne	F,NWTSWT	;/NOWAIT?
	TLO	U1,(IF.NWT)	;YES
	Txne	F,ABSSWT	;/ABSOLUTE?
	TLO	U1,(IF.ALS)	;YES
XCTUU1:	TLO	U1,(If.New)	;[96bit] new format UUO
	MOVEM	U1,SAVU1	;SAVE IT FOR ERRORS
	MCALL	U1,IMPUUO	;DO THE UUO
	RETURN			;TAKE ERROR RETURN

;SKIP RETURN TO USER
UUOX1:	AOS	-4(P)
	RETURN

ImpUUO::SixBit	/ImpUUO/	; sixbit call argument.
;HANDLE TYPEOUT OF IMP ERRORS
UIMPER:	SKIPN	U3,SAVU1	;GET SPEC FROM LAST UUO
	  IDIOT	(U1)		;TYPE IDIOT MESSAGE AND RETURN
	LDB	U2,[Pointr(U3,If.Fnc)] ;GET IMP UUO CODE
	CAIN	U2,.IUXIS	;EXTENDED STATUS?
	HRRI	U3,.XSIST-.IBSTT(U3) ;YES, CODE IN DIFFERENT PLACE
	TRZE	U2,↑O100	;SPECIAL?
	ADDI	U2,UICOD1-UICODE
	MOVE	U2,UICODE(U2)	;GET TEXT ADDRESS
	HRRZS	U3		;ADDRESS OF BLOCK
	SAVE	<T1,T2>
	HRRZ	T1,.IBSTT(U3)	;ERROR CODE
	CAIL	T1,IMPERN	;WITHIN TABLES?
	MOVEI	T1,IMPERN	;NO
	MOVE	T2,U2		;CODE TEXT ADDRESS
	EDISIX	[[SIXBIT \? % % &ERROR - %#!\]
		WNAME (U3)	;BLOCK ADDRESS IN OLD U3
		WSIX (T2)	;ADDRESS OF FUNCTION TEXT
		WSIX @IMPERM(T1)]	;ERROR MESSAGE
	RESTORE <T2,T1>
	JUMPN	U1,UIOERR
	RETURN
;NAMES OF FUNCTION CODES
UICODE:	[SIXBIT \S&TATUS!\]
	[SIXBIT \C&ONNECTION!\]
	[SIXBIT \C&LOSE!\]
	[SIXBIT \C&ONNECTION!\]
	[SIXBIT \C&LOSE!\]
	[SIXBIT \L&ISTEN!\]
	[SIXBIT \R&EQUEST!\]
	[SIXBIT \C&ROSSPATCH!\]
	[SIXBIT \T&RANSLATE!\]
	[SIXBIT \I&NTERRUPT!\]
	[SIXBIT \I&NTERRUPT VECTOR!\]
	[SIXBIT \V&ERSION!\]
	[SIXBIT \D&EASSIGN!\]
	[SIXBIT \H&OST NAME!\]
	[SIXBIT \???!\]
	[SIXBIT \G&IVE-BACK!\]
	[SIXBIT \TTY-IMP &TRANSLATION!\]
	[SIXBIT \C&ROSSPATCH WAIT!\]
	[SIXBIT \E&SCAPE CHARACTER SET!\]
	[SIXBIT \E&SCAPE CHARACTER READ!\]
	[SIXBIT \C&ONNECTION PARAMETER SET!\]
	[SIXBIT \C&ONNECTION PARAMETER READ!\]
	[SIXBIT	\E&XTENDED STATUS!\]
	[SIXBIT	\T&RACE!\]
	[SIXBIT	\S&ET ALLOCATION!\]

;NAMES OF PRIVILEGED FUNCTIONS
UICOD1:	[SIXBIT \N&O-OP!\]
	[SIXBIT \R&ESET!\]
	[SIXBIT \A&LLOCATION!\]
	[SIXBIT \???!\]
	[SIXBIT \???!\]
	[SIXBIT \E&CHO!\]
	[SIXBIT \S&YSTEM INITIALIZATION!\]
	[SIXBIT \S&YSTEM DOWN!\]
	[SIXBIT \S&YSTEM UP!\]
;ERROR CODE TEXT
IMPERM:	[SIXBIT \&ILLEGAL OPERATION!\]
	[SIXBIT \&NO &IMP&S AVAILABLE!\]
	[SIXBIT \&DEVICE NOT AVAILABLE!\]
	[SIXBIT \&LOGICAL NAME ALREADY IN USE!\]
	[SIXBIT \&IMPROPER STATE!\]
	[SIXBIT \&connection reset!\]
	[SIXBIT \&SYSTEM FAILURE!\]
	[SIXBIT \&can't get there from here!\]
	[SIXBIT \¬ enough buffer space!\]
	[SIXBIT \&SOCKET NUMBER IN USE!\]
	[SIXBIT \&ILLEGAL HOST NUMBER!\]
	[SIXBIT \&HOST DOWN!\]
	[SIXBIT \&CONNECTION BLOCK ADDRESS CHECK!\]
	[SIXBIT \&TIMEOUT!\]
	[SIXBIT \&PARAMETER SPECIFICATION ERROR!\]
	[SIXBIT \TTY &NOT CONNECTED TO &IMP!\]
	[SIXBIT \&ILLEGAL OR INDISTINCT CHARACTER!\]
	[SIXBIT \&NOT PRIVILEGED!\]
	[sixbit \¬ an &imp!\]
	[sixbit \&network is not up!\]
	[sixbit \&destination unreachable!\]

	IMPERN==.-IMPERM

	[SIXBIT \&UNDEFINED!\]
;IDIOT UUO -- ERROR MESSAGE FOR INTERNAL BUGS
UIDIOT:	WSIX	IDIOTM		;TYPE THE MESSAGE
	WOCTI	@-4(P)		;AND THE ADDRESS
	W2CHI	CRLF
	JUMPN	U1,UIOERR	;TAKE SPECIFIED RETURN
SEXIT:	EXIT	1,		;OR SILENT EXIT IF NOT GIVEN
	EXIT			;JUST IN CASE HE CONTINUES

IDIOTM:	SIXBIT	\? I&NTERNAL IDIOCY AT USER LOC !\

>;	end of ifn FtImp
	SUBTTL	DEFAULT ERROR HANDLERS

;IF ERROR SPECIFICATIONS ARE NOT MADE IN THE FILE MACRO, THE FOLLOWING
;   DEFAULTS ARE ASSEMBLED:
;	INPUT	OUTPUT	TYPE OF ERROR
;	ILERI1	ILERO1	OPEN FAILURE
;	ILERI2	ILERO2	LOOKUP/ENTER FAILURE
;	ILERI3	ILERO3	INPUT/OUTPUT FAILURE (INCLUDING EOF AND CLOSE)
;   THESE ROUTINES PRINT A FULL ERROR MESSAGE ON THE ERROR DEVICE
;   AND THEN EXIT TO THE MONITOR

ILERA1==:ILERO1			;APPEND FAILURES SAME AS OUTPUT FAILURES
ILERA2==:ILERO2
ILERA3==:ILERO3

ILERI1:	PJSP	U2,IDFHND	;INPUT OPEN FAILURE
	ERRIOP	(U1)
ILERO1:	PJSP	U2,ODFHND	;OUTPUT OPEN FAILURE
	ERROOP	(U1)
ILERI2:	PJSP	U2,IDFHND	;LOOKUP FAILURE
	ERRLK	(U1)
ILERO2:	PJSP	U2,ODFHND	;ENTER FAILURE
	ERRENT	(U1)
ILERI3:	PJSP	U2,IDFHND	;INPUT FAILURE (INCL. INPUT CLOSE, EOF)
	ERRIN	(U1)
ILERO3:	PJSP	U2,ODFHND	;OUTPUT FAILURE (INCL. OUTPUT CLOSE)
	ERROUT	(U1)

IDFHND:	SKIPA	U1,IFILE	;ANY INPUT FAILURE, GET INPUT FILE BLOCK
ODFHND:	MOVE	U1,OFILE	;ANY OUTPUT FAILURE, GET OUTPUT FILE BLOCK
	XCT	(U2)		;EXECUTE ERROR UUO
XIT:	EXIT			;FULL EXIT TO THE MONITOR
	SUBTTL	PRESERVED REGISTER SAVE/RESTORE ROUTINES

;CALLING SAVEN (N=1 THRU 4) AT THE BEGINNING OF A SUBROUTINE CAUSES AC'S
;   P1 THROUGH PN TO BE SAVED ON THE STACK.  WHEN THE SUBROUTINE RETURNS,
;   CONTROL PASSES BACK TO SAVEN, WHICH RESTORES THE SAME AC'S AND RETURNS
;   TO THE CALLER OF THE SUBROUTINE.

SAVE1::	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	HRLI	P1,(P)		;REMEMBER WHERE SAVED P1 IS
	PUSHJ	P,SAVJMP	;STACK NEW RETURN PC AND JUMP
	  SOS	-1(P)		;NON-SKIP RETURN, COMPENSATE CPOPJ1
	JRST	P1PJ1		;SKIP RETURN, RESTORE P1 AND SKIP

SAVE2::	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	HRLI	P1,(P)		;REMEMBER WHERE SAVED P1 IS
	PUSH	P,P2		;SAVE P2
	PUSHJ	P,SAVJMP	;STACK NEW RETURN PC AND JUMP
	  SOS	-2(P)		;NON-SKIP RETURN, COMPENSATE CPOPJ1
	JRST	P2PJ1		;SKIP RETURN, RESTORE P2,P1 AND SKIP

SAVE3::	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	HRLI	P1,(P)		;REMEMBER WHERE SAVED P1 IS
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSHJ	P,SAVJMP	;STACK NEW RETURN PC AND JUMP
	  SOS	-3(P)		;NON-SKIP RETURN, COMPENSATE CPOPJ1
	JRST	P3PJ1		;SKIP RETURN, RESTORE P3,P2,P1 AND SKIP

SAVE4::	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	HRLI	P1,(P)		;REMEMBER WHERE SAVED P1 IS
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSH	P,P4		;SAVE P4
	PUSHJ	P,SAVJMP	;STACK NEW RETURN PC AND JUMP
	  SOS	-4(P)		;NON-SKIP RETURN, COMPENSATE CPOPJ1

P4PJ1:	POP	P,P4		;RESTORE P4
P3PJ1:	POP	P,P3		;RESTORE P3
P2PJ1:	POP	P,P2		;RESTORE P2
P1PJ1:	POP	P,P1		;RESTORE P1
CPOPJ1::AOS	(P)		;INCREMENT PC
CPOPJ::	POPJ	P,		;RETURN

;THE FOLLOWING INSTRUCTION RESTORES P1 AND DISPATCHES TO THE CALLER.
SAVJMP:	JRA	P1,(P1)
	SUBTTL	ERROR MESSAGE TABLE

DEFINE	MSG(L,M) <
	[sixbit \M!\]
	L'ER==	ZZ
	ZZ==	ZZ+1
>

	ZZ==	0

	LALL
ERRPnt:	MSG	FNF,<F&ILE NOT FOUND>
	MSG	IFN,<I&LLEGAL FILENAME>
	MSG	IPP,<U&SER &F&ILE &D&IRECTORY NOT FOUND>
	MSG	PRT,<P&ROTECTION VIOLATION>
	MSG	DFL,<D&IRECTORY FULL>
	MSG	FBM,<F&ILE BEING MODIFIED>
	MSG	AEF,<A&LREADY EXISTING FILENAME>
	MSG	ISU,<I&LLEGAL &UUO &SEQUENCE>
	MSG	UFR,<UFD &OR &RIB &ERROR>
	MSG	TRN,<T&RANSMISSION ERROR>
	MSG	NSF,<N&OT A SAVE FILE>
	MSG	NEC,<I&NSUFFICIENT CORE>
	MSG	DNA,<D&EVICE NOT AVAILABLE>
	MSG	NSD,<N&O SUCH DEVICE>
	MSG	ILU,<GETSEG UUO &ILLEGAL>
	MSG	NRM,<D&ISK FULL OR QUOTA EXCEEDED>
	MSG	WLK,<W&RITE-LOCK ERROR>
	MSG	NET,<I&NSUFFICIENT MONITOR TABLE SPACE>
	MSG	PAO,<P&ARTIAL ALLOCATION ONLY>
	MSG	BNF,<B&LOCK NOT FREE ON ALLOCATION>
	MSG	NSP,<A&TTEMPT TO SUPERSEDE DIRECTORY>
	MSG	DNE,<A&TTEMPT TO DELETE DIRECTORY>
	MSG	SNF,<S&UB &F&ILE &D&IRECTORY NOT FOUND>
	MSG	SLE,<S&EARCH LIST EMPTY>
	MSG	LVL,<SFD &NESTED TOO DEEPLY>
	MSG	NCE,<N&O-CREATE FOR SPECIFIED PATH>
	MSG	SNS,<S&EGMENT NOT IN SWAP AREA>
	MSG	DEV,<D&EVICE ERROR>
	MSG	CKP,<C&HECKSUM OR PARITY ERROR>
	MSG	TFL,<T&APE FULL>
	MSG	BTL,<B&LOCK OR BLOCK"# TOO LARGE>
	MSG	EOF,<E&ND OF FILE>
	MSG	UNX,<U&NEXPECTED ERROR>

	SUBTTL	CHARACTER CLASS TABLE

IFN $NCHFL,<

	.XCREF			;CLEAN UP CREF LISTING

;USING THE "CLASSES" MACRO DEFINED IN TULIP.MAC, DETERMINE THE
;   CODES FOR EACH OF THE ASCII CHARACTERS AND STORE THEM
;   AS $CDXXX, WHERE XXX IS THE ASCII CHARACTER CODE.

	SALL

;SET $CDXXX TO ZERO INITIALLY, FOR XXX=0-177

	ZZ==	-1
REPEAT 200,<
	CONC	($CD,\<ZZ==ZZ+1>,==0)
>
;STILL IN $NCHFL CONDITIONAL
;DETERMINE THE CLASSES ASSOCIATED WITH EACH CHARACTER

	DEFINE	CLASS(S,D) <
	$THSCL==S		;;REMEMBER CURRENT CLASS
IRP D	<			;;DO EACH OPERATION FOR THIS CLASS
	D
>>

;  RANGE <L1,U1,L2,U2, ... ,LN,UN> DECLARES ALL CHARACTERS
;   WITH CODES IN RANGES L1-U1, L2-U2, ... , LN-UN TO BE IN
;   CURRENT CLASS

	DEFINE	RANGE(L) <
	$RNGCT==0
IRP L	<
IFN <$RNGCT==1-$RNGCT>,<
	ZZ==	L
>
IFE $RNGCT,<
REPEAT <L>-ZZ+1,<
	CONC	($CD,\ZZ,==$THSCL!$CD,\ZZ)
	ZZ==	ZZ+1
>>>>

;  CODES <A,B,C,D,E> DECLARES CHARACTERS WITH CODES A,B,C,D,E
;   TO BE IN CURRENT CLASS

	DEFINE	CODES(L) <
IRP L	<
	CONC	($CD,\L,==$THSCL!$CD,\L)
>>

;NOW INVOKE THE "CLASSES" MACRO TO DEFINE $CD0-$CD177

	CLASSES

;STILL IN $NCNFL CONDITIONAL
;ASSEMBLE CHARACTER FLAG TABLE ITSELF

CHFLTB:	BYTE($NCHFL)	$CD0,$CD1,$CD2,$CD3,$CD4,$CD5,$CD6,$CD7,$CD10,$CD11,$CD12,$CD13,$CD14,$CD15,$CD16,$CD17,$CD20,$CD21,$CD22,$CD23,$CD24,$CD25,$CD26,$CD27,$CD30,$CD31,$CD32,$CD33,$CD34,$CD35,$CD36,$CD37,$CD40,$CD41,$CD42,$CD43,$CD44,$CD45,$CD46,$CD47,$CD50,$CD51,$CD52,$CD53,$CD54,$CD55,$CD56,$CD57,$CD60,$CD61,$CD62,$CD63,$CD64,$CD65,$CD66,$CD67,$CD70,$CD71,$CD72,$CD73,$CD74,$CD75,$CD76,$CD77,$CD100,$CD101,$CD102,$CD103,$CD104,$CD105,$CD106,$CD107,$CD110,$CD111,$CD112,$CD113,$CD114,$CD115,$CD116,$CD117,$CD120,$CD121,$CD122,$CD123,$CD124,$CD125,$CD126,$CD127,$CD130,$CD131,$CD132,$CD133,$CD134,$CD135,$CD136,$CD137,$CD140,$CD141,$CD142,$CD143,$CD144,$CD144,$CD146,$CD147,$CD150,$CD151,$CD152,$CD153,$CD154,$CD155,$CD156,$CD157,$CD160,$CD161,$CD162,$CD163,$CD164,$CD165,$CD166,$CD167,$CD170,$CD171,$CD172,$CD173,$CD174,$CD175,$CD176,$CD177

	ZZ==	-1		;CLEAN UP SYMBOL TABLE
REPEAT 200,<
	CONC	(PURGE $CD,\<ZZ==ZZ+1>)
>

	XALL
	.CREF			;RESTORE CREF OUTPUT

>	; END OF CONDITIONAL ON $NCHFL
;LOW SEGMENT

	RELOC	0

IFILE:	BLOCK	1		;POINTER TO CURRENT INPUT FILE BLOCK
OFILE:	BLOCK	1		;POINTER TO CURRENT OUTPUT FILE BLOCK
EFILE:	BLOCK	1		;OUTPUT FILE FOR ERROR DISIXS
FOPBLK::BLOCK	.FOLEB+1	;ARG BLOCK FOR FILOP.

UUOPDP:	BLOCK	1		;PUSHDOWN LEVEL OF DEEPEST UUO

IFN FTCMU,<
CMPPN:	BLOCK	3		;TEMP AREA FOR DECCMU
>
ifn FtImp,<
SavU1:	block	1		; place to save U1 in case of error
				; during an ImpUUO.
WaitCd::block	1		; user should put the wait code here
				; before doing an imp uuo if the
				; default is not desired.
>

TTIBLK:	BLOCK	PBSIZE		;TTY INPUT PSEUDO-FILE BLOCK
TTOBLK:	BLOCK	PBSIZE		;TTY OUTPUT PSEUDO-FILE BLOCK


	RELOC			;BACK TO HI SEG RELOCATION

UUOLIT:	LIT			;DUMP LITERALS

	END