Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50347/tullib.mac
There are 4 other files named tullib.mac in the archive. Click here to see a list.
TITLE LEXINT - LEXICAL PRODUCTION INTERPRETER
SUBTTL E.A.TAFT/EAT/EJW JAN. 1975
SEARCH C,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 C,TULIP ;ACCESS PARAMETER DEFINITIONS
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.
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
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
>
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?
WSIX 6,(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
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)
;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.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 UCLOS+U.REL ;FICLOS,FOCLOS
EXP UCLOS ;FICLS,FOCLS
EXP UREL+U.NSTO ;FREL
;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 CLOSE
UCLOS: 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
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>
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
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,$CD145,$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
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
END