Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64a-sb
-
10,7/nettst/tullib.mac
There are 4 other files named tullib.mac in the archive. Click here to see a list.
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