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

TITLE	NULL - COVER MODULE

COMMENT	\

THIS MODULE REPRESENTS WORK DONE BY HARVARD UNIVERSITY AND OTHERS IN THE
PUBLIC DOMAIN. THEREFORE, THIS MODULE IS NOT COPYRIGHTED BY DIGITAL
EQUIPMENT CORP.

\

PRGEND

	TITLE	LEXINT - LEXICAL PRODUCTION INTERPRETER
	SUBTTL	E.A.TAFT/EAT/EJW JAN. 1975

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

	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/EJW/EAT	--	12-APR-75

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

	VERSION	(1,A,4,,%UUO)

	TWOSEG			;ASSEMBLE TWO SEGMENTS
	RELOC	400000		;ASSEMBLE HIGH SEGMENT

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


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

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,$UUOMX##	;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

UUODSP::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

;UUO DISPATCH TABLE IS ASSEMBLED EITHER IN USER'S PROGRAM OR IN
;  SUBPROGRAM "UUODSP".


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

	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

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

O1BYT1:	HRRZ	U3,FILBIO(U2)	;GET ADDRESS OF ROUTINE TO OUTPUT BUFFER
	PUSHJ	P,(U3)		;CALL IT, DISAPPEAR IF ERROR OCCURS
O1BYTE::SOSGE	FILCTR(U2)	;CHECK BYTE COUNT
	JRST	O1BYT1		;GO EXECUTE OUT UUO
	IDPB	U1,FILPTR(U2)	;PLACE CHARACTER IN OUTPUT BUFFER
	POPJ	P,		;RETURN FROM UUO

;DEFAULT BUFFER OUTPUT ROUTINE, NORMALLY CALLED BY O1BYTE ABOVE

O1BUFF::PUSHJ	P,UXCT2		;EXECUTE OUT UUO
	  <OUT>
	  POPJ	P,		;NO ERRORS, RETURN WITH NEW BUFFER AVAILABLE
	JRST	FOUERR		;ERROR, GO HANDLE IT

;	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,CHRTAB##(U2)	;PICK UP WORD
	ROT	U2,$NCHFL##(U3)	;RIGHT-JUSTIFY SELECTED BYTE FIELD
IFN FTDBUG,<
	ANDI	U2,$CFMSK##	;CLEAR OTHER BITS TO MAKE LIFE EASIER DEBUGGING
>
	MOVEM	U2,1(U1)	;STORE FLAGS
	POPJ	P,		;RETURN FROM UUO

;	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

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

I1BYT1:	HRRZ	U1,FILBIO(U2)	;CALL ROUTINE TO READ A BUFFER (USUALLY
	PUSHJ	P,(U1)		; I1BUFF, BELOW)
I1BYTE::SOSGE	FILCTR(U2)	;DECREMENT AND TEST INPUT BYTE COUNTER
	JRST	I1BYT1		;EMPTY, GO DO AN IN UUO
	ILDB	U1,FILPTR(U2)	;OK, FETCH NEXT BYTE
	POPJ	P,

;DEFAULT ROUTINE FOR FILLING INPUT BUFFERS

I1BUFF::PUSHJ	P,UXCT2		;EXECUTE IN UUO
	  <IN>
	  POPJ	P,		;RETURN WITH FULL BUFFER
	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
>
	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:	TRNE	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
	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,

;	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/[%]!/]
		WPPN	FILPPN(U1)]
	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:	IDIVI	U2,4		;COMPUTE DISPLACEMENT INTO BYTE TABLE
	LDB	U3,ERRPT2(U3)	;FETCH RELATIVE ADR OF MESSAGE ITSELF
	DISIX	[CPOPJ,,[SIXBIT\ (%) %#!\]
		WOCTI	(U1)		;TYPE ERROR DATA GIVEN US
		WSIX	ERRMSG(U3)]	;TYPE CORRECT MESSAGE

;BYTE POINTER TABLE FOR GETTING BYTES OUT OF ERRPT3
ERRPT2:	POINT	9,ERRPT3(U2),8	;FIRST BYTE
	POINT	9,ERRPT3(U2),17	;SECOND BYTE
	POINT	9,ERRPT3(U2),26	;THIRD BYTE
	POINT	9,ERRPT3(U2),35	;FOURTH BYTE

;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
	ERP	(FCU,UNX,UNX,UNX,UNX,UNX)	; 30
	ERP	(UNX,UNX,UNX,LOH,LOH,LOH)	; 31
	ERP	(UNX,UNX,UNX,NLI,NLI,NLI)	; 32
	ERP	(ENQ,UNX,UNX,ENQ,UNX,UNX)	; 33
	ERP	(UNX,UNX,UNX,BED,BED,BED)	; 34
	ERP	(UNX,UNX,UNX,BEE,BEE,BEE)	; 35
	ERP	(UNX,UNX,UNX,DTB,DTB,DTB)	; 36
	ERP	(UNX,UNX,ENC,UNX,UNX,ENC)	; 37
	ERP	(UNX,UNX,TNA,UNX,UNX,TNA)	; 40
	ERP	(UNX,UNX,UNN,UNX,UNX,UNN)	; 41

	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)
;	2 DUMMIES FOR FILLER
;	FAPEND	E	;SELECT FILE E AND SET UP FOR APPEND (INCL. OPEN, L/E)

;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]
	TLC	U1,(U2)		;SET U.OUT IF AN ODD (OUTPUT) UUO (BUT SEE FAPEND)
	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	UCLOS+U.REL	;FICLOS,FOCLOS
	EXP	UCLOS		;FICLS,FOCLS
	EXP	UREL+U.NSTO	;FREL
	EXP	UOPEN+U.LKEN+U.APND+U.OUT ;FAPEND

;HERE TO OPEN A DEVICE FOR INPUT OR OUTPUT
UOPEN:	TLNE	U1,(U.APND)	;IF APPENDING, MAKE SURE
	HLRS	FILHDP(U1)	;THAT HEADER RING IS SET UP CORRECTLY
	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
	  JRST	ULKAER		;ERROR - CHECK IF DONE WHILE APPEND SETUP
	TLZN	U1,(U.APND)	;IF APPEND - TURN OFF TO PREVENT LOOPING
	POPJ	P,		;OK RETURN

;HERE IF WE ARE OPENING A FILE FOR APPENDING. IT WILL
;  AUTOMATICALLY CREATE A FILE IF NONE EXISTS (UNLESS THE USER SPECIFIES
;  HE WANTS TO HANDLE HIS OWN LOOKUP ERRORS.) POSITIONING IS DONE TO
;  THE BYTE FOLLOWING THE LAST ONE. IN ASCII MODES, THIS WILL OFTEN
;  BE IN MID-WORD.


	MOVE	U3,FILPPN(U1)	;RESET ENTER BLOCK
	MOVEM	U3,FILPP1(U1)
	HLLZS	FILEXT(U1)
	PUSHJ	P,UXCT1		;ENTER
	  ENTER	FILNAM(U1)
	  JRST	[MOVE U2,FILER1(U1) ;BAD RETURN
		 JRST UERXIT]
	PUSH	P,T4		;NEED ANOTHER REGISTER
	HLRE	T4,FILPP1(U1)	;GET FILE SIZE
	JUMPE	T4,UAPNDF	;IF 0, THEN WE'RE ALL DONE
	PUSHJ	P,UXCT1		;SETUP OUTPUT BUFFERS
	  OUTPUT
	MOVSI	U2,400000	;MAKE BUFFERS LOOK VIRGIN AGAIN
	IORM	U2,FILHDR(U1)
	JUMPG	T4,UAPND1	;IF POSITIVE BLOCK COUNT RETURNED
	MOVM	T4,T4		;MAKE NEGATIVE WORD COUNT POSITIVE
	ADDI	T4,177		;AND CONVERT TO BLOCKS
	ASH	T4,-7		;....
UAPND1:	PUSHJ	P,UXCT1		;POSITION TO LAST BLOCK
	  USETI	(T4)
	PUSHJ	P,UXCT1		;AND READ IT
	  IN
	  JRST	UAPND2		;COPY FIND END OF DATA
	POP	P,T4
	JRST	FOUERR		;ERROR - EXIT

UAPND2:	PUSHJ	P,UXCT1		;NOW FORCE OUTPUT TO BE LAST BLOCK
	  USETO	-1
	PUSH	P,FILCTR(U1)	;GET BYTES IN LAST BLOCK
	HRRZ	U2,FILSTS(U1)	;GET IO MODE
	MOVEI	T4,5		;ASSUME ASCII
	CAIL	U2,.IOIMG	;BUT FOR IMAGE, BINARY, ETC.
	MOVEI	T4,1		;USE ONE BYTE PER WORD
	MOVEI	U2,200		;SHOULD BE THE SIZE OF A DSK DDB
	IMULI	U2,(T4)		;CALCULATE THE BYTES IN A BUFFER
	SUB	U2,(P)		;BYTES LEFT IN LAST BLOCK
	ADD	U2,T4		;AND ANOTHER WORD'S WORTH THAT WE'LL SEARCH
	MOVEM	U2,FILCTR(U1)	;STORE THAT, GET BYTES USED
	POP	P,U2		;GET BYTES USED IN LAST BLOCK
	IDIV	U2,T4		;WHILE FINDING NUMBER OF WORDS
	SOS	U2		;(WORD BEFORE LAST)
	ADDB	U2,FILPTR(U1)	;WITH WHICH TO ADJUST POINTER
;NOTE: POINTER NOW POINTS TO WORD BEFORE LAST WORD. NECESSARY TO FIND THE
;      NULL BYTE IN THE LAST WORD, AND SET BYTE POINTER TO BYTE BEFORE IT.
;      HENCE, THESE COMPLICATED SHENANIGANS, BECAUSE THERE IS NO SUCH
;      INSTRUCTION AS "DECREMENT POINTER"!
UAPNDC:	ILDB	U3,U2		;COPY OF POINTER PUT IN U2 (WEREN'T YOU LOOKING?)
	JUMPE	U3,UAPNDF	;FOUND A NULL?!
	IBP	FILPTR(U1)	;NO...SAFE TO MOVE REAL POINTER
	SOS	FILCTR(U1)	;ALSO KEEP AN EYE ON COUNTER
	SOJG	T4,UAPNDC	;COUNT DOWN BYTES PER WORD. GUARDS AGAINST
				;CASE OF LAST BLOCK BEING EXACTLY FULL.
UAPNDF:	POP	P,T4		;RETURN BORROWED REG
	POPJ	P,		;DONE!

;HERE ON LOOKUP/ENTER ERROR. IF APPEND, IF FILE-NOT-FOUND, AND
; USER HAS NOT SUPPLIED HIS OWN ROUTINE, DO AN OPEN-ENTER SEQUENCE FOR
; A NEW FILE. THUS HE DOES NOT HAVE TO CHECK FOR AN EXISTING FILE FIRST.

;								DK OCT/75

ULKAER:	TLZN	U1,(U.APND)	;APPENDING?
	 JRST	ULKAEX
	HRRZ	U2,FILER1(U1)	;APPEND. WILL USER HANDLE TROUBLE HIMSELF?
	CAIE	U2,ILERO2
	 JRST	ULKAEX
	HRRZ	U2,FILEXT(U1)	;GET ERROR CODE.
	CAIE	U2,ERFNF%	;IS IT FILE-NOT-FOUND?
	 JRST	ULKAEX		;NO...
	HLLZS	FILHDP(U1)	;SET UP I/O BUFFER FOR OUTPUT ONLY
	SETZ	U2,		;CLEAR REST OF CREATION DATE - DATE75
	DPB	U2,[POINT 12,FILDAT(U1),35] ;DEPENDENCY - SHAFTED AGAIN
	TLO	U1,(U.LKEN!U.OUT) ;ASK FOR OPEN AND ENTER
	XCT	USTORO		;AND SET OFILE
	JRST	UOPEN		;OPEN. (AUTOMATICALLY RELEASES OLD OPEN)

ULKAEX:	MOVE	U1,FILER1(U1)	;ORDINARY ERROR. USE ORDINARY HANDLER
	JRST	UERXIT

;HERE TO DO CLOSE
UCLOS:	MOVE	U2,FILHDP(U1)	;CHECK IF DOING APPEND -
	TSC	U2,FILHDP(U1)	;OBUF AND IBUF ARE THE SAME
	JUMPN	U2,UCLOS1
	PUSHJ	P,UXCT1		;APPEND - DO SPECIAL CLOSE FIRST
	 CLOSE	CL.IN		;CLOSING INPUT SIDE...
UCLOS1:	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	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

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


;EQUATES FOR APPEND GLOBALS

ILERA1==:ILERO1
ILERA2==:ILERO2
ILERA3==:ILERO3
A1BYTE==:O1BYTE
A1BUFF==:O1BUFF

	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	LITERALS

	LIT

	SUBTTL	ERROR MESSAGE TABLE

	DEFINE	MSG(L,M) <
	L'ER==	ZZ
IFN ZZ,<IFE ZZ&3,<
			BYTE(9)	EMSG0,EMSG1,EMSG2,EMSG3
	EMSG0==	<EMSG1==<EMSG2==<EMSG3==0>>>
>>
	CONC	EMSG,\<ZZ&3>,<==[SIXBIT\M!\]>
	ZZ==	ZZ+1
>

	ZZ==	0

ERRPT3:	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 AND &LOSEG& LOCKED>
	MSG	FCU,<F&ILE CANNOT BE UPDATED>
	MSG	LOH,<LOSEG& AND &HISEG& OVERLAP>
	MSG	NLI,<N&OT LOGGED IN>
	MSG	ENQ,<F&ILE IS LOCKED>
	MSG	BED,<B&AD &EXE& DIRECTORY>
	MSG	BEE,<B&AD &EXE& EXTENSION>
	MSG	DTB,<EXE& EXTENSION TOO BIG>
	MSG	ENC,<N&ETWORK CAPACITY EXCEEDED>
	MSG	TNA,<T&ASK NOT AVAILABLE>
	MSG	UNN,<N&ODE WENT OFFLINE>

	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>
			BYTE(9)	EMSG0,EMSG1,EMSG2,EMSG3

;THE MESSAGES THEMSELVES ARE ASSEMBLED HERE

ERRMSG:	PHASE	0
	XLIST			;JUST A PILE OF SIXBIT TEXT
	LIT
	LIST			;END OF LITERALS
	DEPHASE

;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

UUOPDP:	BLOCK	1		;PUSHDOWN LEVEL OF DEEPEST UUO

IFN FTCMU,<
CMPPN:	BLOCK	2		;TEMP AREA FOR DECCMU
>

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

	PRGEND

	TITLE	UUOTAB -- DEFAULT UUO DISPATCH TABLE
	SUBTTL	E.A.TAFT	--	12-APR-75

	TWOSEG
	RELOC	400000

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

	ENTRY	UUOTAB		;LOAD ON LIB SEARCH IF UNSATISFIED

	UUOTAB			;CALL MACRO TO ASSEMBLE THE TABLE

	PRGEND

	TITLE	CHRTAB -- DEFAULT CHARACTER CLASS TABLE
	SUBTTL	E.A.TAFT	--	12-APR-75

	TWOSEG
	RELOC	400000

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

	ENTRY	CHRTAB		;LOAD ON LIB SEARCH IF UNSATISFIED

	CHRTAB			;CALL MACRO TO ASSEMBLE THE TABLE

	END