Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
fudge2.mac
There are no other files named fudge2.mac in the archive.
TITLE FUDGE2 V.015
SUBTTL 3-AUG-72 ED YOURDON/VJC/DMN
;FILE UPDATE GENERATOR
;"COPYRIGHT 1968,1969,1970,1971,1972,DIGITAL EQUIPMENT CORP. MAYNARD,MASS. U.S.A."
VFUDGE==15 ;VERSION NUMBER
VUPDATE==0 ;DEC UPDATE LEVEL
VEDIT==45 ;DEC EDIT NUMBER
VCUSTOM==0 ;NON-DEC UPDATE LEVEL
LOC <.JBVER==137>
<VCUSTOM>B2+<VFUDGE>B11+<VUPDATE>B17+VEDIT
RELOC
MLON
;FEATURE TEST SWITCHES
;PURESW=1 GIVES RE-ENTRANT FUDGE
IFNDEF PURESW,<PURESW==1>
;FUDGE ACCUMULATOR DEFINITIONS
A= 1 ;GENERAL COMMUNICATION AC
B= 2 ;SCRATCH ACCUMULATOR
T= 3 ;USED IN /C AND /X ONLY
C= 4 ;SCRATCH ACCUMULATOR
D= 5 ;IO DEVICE NUMBER ACCUMULATOR
E= 6 ;SCRATCH ACCUMULATOR
F= 7 ;FLAG ACCUMULATOR
G= 10 ;DEVICE CHARACTERISTICS AC
H= 11 ;USED IN GETCHR AND GETCMN
SW= 12 ;SWITCH UUO AC
R= 13 ;PROGRAM NAME-USED IN READ,WRITE
S= 14 ;SIXBIT SYMBOL ACCUMULATOR
DIS= 15 ;DISPATCH ACCUMULATOR
EXT= 16 ;FILE NAME EXTENSION ACCUMULATOR
P= 17 ;PUSHDOWN POINTER AC
;FUDGE FLAG DEFINITIONS (RIGHT HALF OF ACCUMULATOR F)
DESTB== 1 ;1-DESTINATION DEVICE SEEN
SAVEB== 2 ;1-SWITCH SEEN,BUT NOT EXECUTED
SWTB== 4 ;1-SWITCH MODE ENTERED IN GETCHR
SLSHB== 10 ;1-SWITCH MODE ENTERED WITH </>
TTYOB== 20 ;1-NON-TTY OUTPUT;USED BY IO
TTYCB== 40 ;1-NON-TTY OUTPUT;USED BY COMMAND
PROGB== 100 ;1-PROGRAM NAME SEEN IN SPECIFICATION
NOLOCB==200 ;1-DELETE LOCAL SYMBOLS ***VJC
DEVB== 400 ;1-DEVICE NAME SEEN IN SPEC.
EXTB== 1000 ;1-EXPLICIT FILE NAME EXTENSION
ERRB== 2000 ;1-ERROR IN ENTRY BLOCK CHECK
INFOB== 4000 ;1-VALID INFORMATION IN COMMAND
CONB== 10000 ;1-CONTEXT OF <.> IS PROGRAM NAME
;0-CONTEXT OF <.> IS FILE NAME
F4IB== 20000 ;1-IGNORE F4 OUTPUT
CRLFTY==40000 ;1-CR,LF TYPED (FOR ERROR MSG)
POPBAK==100000 ;1-XCT POPJ P, ;TO RETURN TO CALLING SEQ.
XFLG== 200000 ;1-INDEX THIS FILE
DTAFLG==400000 ;1-OUTPUT DEVICE IS DTA (SPECIAL INDEX)
;MORE FLAGS (LEFT HALF OF F)
NOWARN==1 ;1-DON'T TYPE WARNING ABOUT INDEX DELETED
SMCPFL==2 ;1-BEEN TO SEMICP ROUTINE FOR THIS FILE
DEFENT==4 ;1-ENTRY DEFERED TIL AFTER LOOKUPS
LSTENT==10 ;1-LIST ENTRY BLOCK
SEMIFL==20 ;1-SEEN A SEMI-COLON, IGNORE TO E-O-L
;HANDY BITS FOR CALLS TO DEVCHR FOR DEVICE CHARACTERISTICS
OUTBIT==1 ;1-DEVICE CAN DO OUTPUT
INBIT== 2 ;1-DEVICE CAN DO INPUT
DRCTRB==4 ;1-DEVICE HAS A DIRECTORY
TTYBIT==10 ;1-DEVICE IS A TTY
DTABIT==100 ;1-DEVICE IS A DTA
LPTBIT==40000 ;1-DEVICE IS LPT
DSKBIT==200000 ;1-DEVICE IS DSK
;OTHER USEFUL PARAMETER ASSIGNMENTS
N== 200 ;SIZE OF MASTER AND TRAN BUFFERS
XP== 20 ;SIZE OF PUSHDOWN LIST
SIZE== 100 ;SIZE OF PURE ENTRY BLOCK
X== SIZE+5 ;SIZE OF ENTRY AND SAVE BLOCKS
IOEOF== 20000 ;1-END-OF-FILE HAS BEEN SEEN
IOBKTL==40000 ;1-BLOCK-TOO-LARGE ERROR
IODATA==100000 ;1-DATA ERROR
IODEV== 200000 ;1-DEVICE ERROR
IOBOT== 4000 ;1-MAG TAPE IS AT BEGINNING OF TAPE
DEVNO==16 ;NUMBER OF DEVICES ALLOWED
RIBALC==11 ;NUMBER OF BLOCKS ALLOCATED
;JOBDAT SYMBOLS
INTERN .JBVER
EXTERN .JBFF,.JBREL
EXTERN .HELPR
TABS1==<^D120/7>-1 ;NO OF TABS FOR OTHER THAN TTY
TABS2==<^D72/7>-1 ;NO OF TABS FOR TTY
OPDEF JSR [PUSHJ P,] ;PURE FOR RE-ENTRANT FUDGE
IFN PURESW,<TWOSEGMENTS
LOW: RELOC 400000>
SUBTTL INITIALIZE AND SETUP OF FUDGE2
;THIS SECTION OF CODING DOES THE FOLLOWING THINGS
; 1.RESETS ALL IO DEVICES BY CALLING [SIXBIT /RESET/]
; 2.INITIALIZES THE TELETYPE IN ASCII-LINE MODE
; 3.TYPES A * TO SIGNIFY READINESS FOR INPUT FROM USER
; 4.SETS UP A PUSHDOWN LIST
; 5.INITIALIZES VARIOUS ACCUMULATORS, CLEARS THE FLAGS,
; AND INITIALIZES THE MSTBUF AND TRNBUF COUNTERS
FUDGE2: JFCL ;INCASE OF CCL ENTRY
RESET ;RESET I/O DEVICES
MOVE [XWD LOW,LOW+1]
SETZM LOW ;CLEAR DATA AREA
BLT LOWTOP-1
IFN PURESW,<
MOVE [XWD HIGH,LOW]
BLT LOWBLK ;MOVE IN IMPURE CODE>
MOVE [XWD 17,11] ;TEST FOR LEVEL D
GETTAB
SETZ ;FAILED, NOT LEVEL D
TLNN (7B9) ;IS IT LEVEL D OR LATER?
TDZA ;NO
HRROI -2 ;THIS IS LEVEL D
MOVEM LEVEL ;STORE STATE
SETZ ;CLEAR ACC'S
MOVEI 17,1 ;WITH A BLT OF ZERO
BLT 17,17 ;FROM 0-17
INIT 0,1 ;INITIALIZE TTY, CHANNEL 0
SIXBIT /TTY/ ;TTY
XWD OBUF, IBUF ;ADDRESSES FOR BUFFER HEADERS
HALT . ;ILLEGAL INSTRUCTION IF NO TTY
OUTPUT 0, ;DUMMY OUTPUT ON TTY
MOVEI A, "*" ;PICK UP A <*>
IDPB A, OBUF+1 ;TYPE IT OUT
OUTPUT 0, ;EMPTY THE BUFFER
MOVE P, XPDLST ;SET UP A PUSHDOWN POINTER
HRROI D,1 ;INITIALIZE DEVICE BUFFER
MOVEM D, DEVBUF ;...
MOVSI A, -N ;GET COUNT OF MSTBUF AND TRNBUF
HRRI A, FILBUF+1 ;INITIALIZE POINTER IN FILBUF
MOVEM A, FILBUF ;SET UP COUNT IN FILE BUFFER
HRRI A, PRGBUF+1 ;INITIALIZE POINTER IN PRGBUF
MOVEM A, PRGBUF ;...
HRRI A,PPNBUF ;INITIAL POINTER IN PPNBUF
MOVEM A,PPNBUF
SUBTTL FUDGE2 COMMAND STRING DISPATCHING
;THIS ROUTINE PICKS UP CHARACTERS FROM THE TELETYPE BUFFER AND
;DISPATCHES TO THE PROPER ROUTINE DEPENDING ON THE TYPE OF
;CHARACTER.A TABLE OF BYTES AND BYTE POINTERS ALLOWS EACH
;CHARACTER IN THE ASCII SET TO BE TREATED INDIVIDUALLY. THE
;ROUTINE MAY BE ENTERED AT GETCHR IF IT IS DESIRED TO ACCUMULATE
;A 6-LETTER SIXBIT SYMBOL IN AC S. SYMBOLS OF DIFFERENT LENGTHS
;MAY BE ACCUMULATED IN DIFFERENT REGISTERS BY SETTING THE CONTENTS
;OF AC B TO THE DESIRED LENGTH, AND PUTTING A BYTE POINTER IN E
;AND ENTERING THE ROUTINE AT GETCHR+4.
GETCHR: TRZE F,POPBAK ;IMMEDIATE RETURN?
POPJ P, ;YES
MOVEI B, 6 ;SET COUNT OF SYMBOL TO 6
MOVE E, SYMPTR ;SET UP A BYTE POINTER FOR AC S
MOVEI S, 0 ;INITIALIZE SYMBOL ACCUMULATOR
GETCMN: SOSG IBUF+2 ;IS TTY BUFFER EMPTY?
INPUT 0, ;YES, FILL IT UP
ILDB A, IBUF+1 ;GET A CHARACTER
MOVE G, A ;GET A COPY OF IT IN AC G
MOVE 0, CURCHR ;SAVE PREVIOUS CHAR
MOVEM 0, LSTCHR ;AS LAST CHAR
MOVEM A, CURCHR ;SAVE CURRENT CHAR
IDIVI G, 11 ;TRANSLATE TO 4-BIT CODE
LDB G, TABLE(H) ;USE PROPER BYTE POINTER
CAIGE G, 4 ;MODIFY CODE IF .GE. 4
TRNN F, SWTB ;MODIFY CODE IF IN SWITCH MODE
ADDI G, 4 ;CHANGE DISPATCH BY ADDING 4
HRRZ H, DSPTCH(G) ;GET PROPER DISPATCH ADDRESS
CAIL G, 10 ;BUT CHANGE IF NOT CORRECT
HLRZ H, DSPTCH-10(G) ;TO A LEFT HALF DISPATCH
TLNE F,SEMIFL ;IF SEEN A SEMI-COLON
JRST IGNOR1 ; IGNORE UNLESS E-O-L
JRST (H) ;EXIT TO APPROPRIATE ROUTINE
SUBTTL COMMAND DISPATCH TABLE AND BYTE POINTERS
DSPTCH: XWD GETCMN,ERR16 ;IGNORED CHAR, BAD CHAR(SWITCH)
XWD SWTCH, SWTCHA ;<(>, LETTER(SWITCH MODE)
XWD COLON, ERR16 ;<:>, NUMBER(SWITCH MODE)
XWD PERIOD,SWTCHE ;<.>, <)>ESCAPE SWITCH MODE
XWD LFTARW,ERR17 ;<_>OR<=>, BAD CHAR (NORMAL MODE)
XWD COMMA, STORE ;<,>, ALPHABETIC CHARACTER(NORMAL)
XWD ALTMOD,STORE ;<$>,NUMERIC CHARACTER(NORMAL)
XWD SLASH, ERR17 ;</>, <)> ILLEGAL ESCAPE
XWD LBRACK, 0 ;LEFT ANGLE BRACKET, OR "["
XWD RBRACK, 0 ;RIGHT ANGLE BRACKET
XWD IGNORE, 0 ;A SEMI-COLON
TABLE: POINT 4, BITE(G), 3
POINT 4, BITE(G), 7
POINT 4, BITE(G), 11
POINT 4, BITE(G), 15
POINT 4, BITE(G), 19
POINT 4, BITE(G), 23
POINT 4, BITE(G), 27
POINT 4, BITE(G), 31
POINT 4, BITE(G), 35
IGNOR1: CAIN G,12+4 ;ALTMODE SEEN?
JRST ALTMOD ;YES
CAIG A,15 ;IF VERTICAL PAPER MOTION
CAIGE A,12 ; CLEAR FLAG AND SEE NEXT LINE
IGNORE: TLOA F,SEMIFL ;DON'T SEE NEXT CHARS
TLZ F,SEMIFL ;END OF LINE SEEN
JRST GETCMN ;READ NEXT CHAR
SUBTTL BYTE TABLE FOR DISPATCHING
;CLASSIFICATION BYTE CODES
; BYTE DISP CLASSIFICATION
; 00 00 ILLEGAL CHARACTER, SWITCH MODE
; 01 01 ALPHABETIC CHARACTER, SWITCH MODE
; 02 02 NUMERIC CHARACTER, SWITCH MODE
; 03 03 SWITCH MODE ESCAPE, SWITCH MODE
; 00 04 ILLEGAL CHARACTER, NORMAL MODE
; 01 05 ALPHABETIC CHARACTER, NORMAL MODE
; 02 06 NUMERIC CHARACTER, NORMAL MODE
; 03 07 SWITCH MODE ESCAPE, SWITCH MODE
; 04 10 IGNORED CHARACTER
; 05 11 ENTER SWITCH MODE WITH A <(>
; 06 12 DEVICE DELIMITER, <:>
; 07 13 FILE EXTENSION DELIMITER, <.>
; (CAN ALSO BE PART OF A PROGRAM NAME)
; 10 14 OUTPUT SPECIFICATION, <LFT ARW> OR <=>
; 11 15 FILE DELIMITER, <,>
; 12 16 COMMAND TERMINATOR, <ALT MODE>=33,175,176
; 13 17 ENTER SWITCH MODE WITH A </>
; 14 20 CHANGE CONTEXT OF PERIOD TO PROG NAME, <<> ,OR "["
; 15 21 CHANGE CONTEXT OF PERIOD TO FILE NAME, <>>
; 16 22 SEMI-COLON, IGNORE UP TO CR_LF7L
;BYTE TABLE CORRESPONDING TO 128 ASCII CHARS
BITE: BYTE (4) 4,0,0,0,0,0,0,0,0 ;NUL
BYTE (4) 4,4,4,4,4,0,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,12 ;^Z=$
BYTE (4) 12,0,0,0,0,11,0,4,0 ;$
BYTE (4) 1,1,0,0,5,3,1,0,11 ;$,%,&,',(,),*,+,,
BYTE (4) 0,7,13,2,2,2,2,2,2 ;-,.,/,0,1,2,3,4,5
BYTE (4) 2,2,2,2,6,16,14,10,15 ;6,7,8,9,:,;,<,=,>
BYTE (4) 0,0,1,1,1,1,1,1,1 ; , , ,B,C,D,E,F,G
BYTE (4) 1,1,1,1,1,1,1,1,1 ;H,I,J,K,L,M,N,O,P
BYTE (4) 1,1,1,1,1,1,1,1,1 ;Q,R,S,T,U,V,W,X,Y
BYTE (4) 1,14,0,0,0,10,0,1,1 ;Z,[, ,], ,_, ,A,B
BYTE (4) 1,1,1,1,1,1,1,1,1 ;C,D,E,F,G,H,I,J,K
BYTE (4) 1,1,1,1,1,1,1,1,1 ;L,M,N,O,P,Q,R,S,T
BYTE (4) 1,1,1,1,1,1,0,0,12 ;U,V,W,X,Y,Z, , ,$
BYTE (4) 12,4 ;$,DEL
SUBTTL ROUTINES TO HANDLE 0-9,A-Z,. CHARACTERS
;IN THE COMMAND STRING. IN NORMAL MODE, THE CHARACTER IS
;DEPOSITED TO FORM A SIXBIT SYMBOL. NOTE THAT "." IS LEGAL IN A PROGRAM NAME.
;E.G. <EXP.1,ALLIO.>, IF ENCLOSED IN< >. IN SWITCH MODE, THE PROPER
;INSTRUCTION IS EXECUTED WITH THE AID OF A DISPATCH TABLE.
;THEN, IF SWITCH MODE WAS ENTERED WITH A SLASH, FUDGE2 EXITS
;FROM SWITCH MODE.
STORE: TRO F,INFOB ; INDICATE VALID INFO SEEN
SOJL B, GETCMN ; JUMP IF NO ROOM FOR CHARACTER
CAIGE A,141 ;WORRY ABOUT LOWER CASE LETTERS
SUBI A, 40 ;CONVERT FROM ASCII TO SIXBIT
IDPB A, E ;STORE CHARACTER ACCORDING TO BYTE
JRST GETCMN ;RETURN FOR NEXT CHARACTER
SWTCHA: MOVSI SW, 072000 ;GET AN MTAPE OPCODE
CAIL A,141 ;ACCEPT LOWER CASE SWITCHES
SUBI A,40
MOVSS DIS ;SAVE PREVIOUS SWITCH
XCT SLIST-101(A) ;EXECUTE PROPER SWITCH INSTRUCTION
TLNN DIS,-1 ;A PREVIOUS SWITCH SET?
JRST .+4 ;NO
TRNE DIS,-1 ;A NEW SWITCH SEEN ALSO?
JRST ERR27 ;YES, TOO MANY
MOVSS DIS ;RESTORE DISPATCH
TRZE F, SLSHB ;SWITCH MODE ENTERED WITH A </>?
TRZ F, SWTB ;YES, EXIT FROM SWITCH MODE
JRST GETCMN ;RETURN FOR MORE CHARACTERS
;THE FOLLOWING THREE ROUTINES HANDLE THE CONTROL CHARACTERS IN
;THE COMMAND STRING WHICH CAUSE FUDGE2 TO ENTER INTO AND EXIT
;FROM SWITCH MODE. THERE ARE TWO TYPES OF SWITCH MODE, DEPENDING
;ON WHETHER THE IT IS ENTERED WITH A </> OR A <(>.
SLASH: TRO F, SLSHB ;ENTER SWITCH MODE WITH A </>
SWTCH: TROA F, SWTB ;ENTER SWITCH MODE WITH A <(>
SWTCHE: TRZ F, SWTB ;EXIT FROM SWITCH MODE WITH A <)>
JRST GETCMN ;RETURN FOR MORE CHARACTERS
SUBTTL LEFT ARROW PROCESSOR
;THE LEFT ARROW PROCESSOR IS ENTERED BY A DISPATCH FROM THE
;COMMAND STRING. IT SIGNALS THE END OF THE DESTINGATION DEVICE
;SPECIFICATION. IF THE SIXBIT SYMBOL ACCUMULATOR S IS NON-
;ZERO, IT ASSUMES THAT THE USER HAS OMITTED THE FILE NAME DE-
;LIMITER, AND CALLS THE FILE NAME ROUTINE. A PROGRAM NAME
;SPECIFICATION IN THE OUTPUT DEVICE IS ILLEGAL.
;FLAG SETTINGS: THE DESTINATION FLAG (DESTB) IS SET TO ONE,
;THE DEVICE FLAG IS SET TO ZERO, AND THE PROGRM NAME FLAG (PROGB)
;IS SET TO ONE SO THAT THE FIRST DEVICE AFTER THE LEFT ARROW
;WILL NOT RESULT IN A CALL TO PUTDEV.
;IF NO OUTPUT DEVICE IS SEEN DSK IS ASSUMED.
;POPBAK IS SET SO CONTROL RETURNS FRON COLON VIA GETCHR
NODEV: PUSH P,S ;SAVE FILE NAME
MOVSI S,(SIXBIT /DSK/);DSK IS DEFAULT DEVICE
TRO F,POPBAK ;RETURN FROM GETCHR
PUSHJ P,COLON ;FAKE A DEVICE SEEN
TRZ F,DEVB ;TO COME AGAIN
POP P,S ;RESTORE FILE NAME
POPJ P, ;RETURN
LFTARW: PUSHJ P, SEMICO ;DO A LOOKUP IF NECESSARY
TRZ F, DEVB ;SET THE DEVICE FLAG TO ZERO
TRO F, PROGB+DESTB ;SET PROGRAM AND DESTINATION FLAGS
JRST GETCHR ;RETURN FOR NEXT SYMBOL
SUBTTL THIS CODE PROCESSES PROJECT-PROGRAMMER NUMBERS
LSQB: SETZ T, ;START WITH ZERO
PUSH P,T ;AND STORE IT
LSQB1: PUSHJ P,TTYIN ;GET NEXT CHAR.
CAIN A,"]" ;MATCHING SQB.?
JRST RSQB ;YES
CAIN A,"," ;COMMA?
JRST SQBCMA ;YES,SORT OUT XWD
CAIL A,"0" ;IS IT AN OCTAL NUMBER?
CAILE A,"9" ;...
JRST ERRISQ ;NO,ERROR
LSH T,3 ;MAKE SPACE FOR NEXT CHAR.
ADDI T,-60(A) ;ADDI IN NEW DIGIT
JRST LSQB1 ;BACK FOR MORE
SQBCMA: HRLZM T,(P) ;STORE LEFT HALF ON STACK
SETZ T, ;START AFRESH
JRST LSQB1 ;AND GET RIGHT HALF
RSQB: HRRM T,(P) ;PUT RIGHT HALF ON STACK
TLNE F,SMCPFL ;ALREADY STORED FILE NAME?
JRST RSQB1 ;YES
POP P,T ;AND POP XWD OFF
MOVEM T,PRJPRG ;SAVE DEFAULT PROJ-PROG
JUMPN S,GETCMN ;AFTER A FILE NAME IS ONLY TEMP.
MOVEM T,DEFPPN ;PERMANENT DEFAULT PPN
JRST GETCMN ;GET NEXT CHAR.
RSQB1: HRRZ T,PPNBUF ;GET LOC OF LAST TEMP. PPN
POP P,(T) ;STORE PPN
JRST GETCMN ;AND DON'T SET DEFPPN
TTYIN: SOSG IBUF+2 ;BUFFER EMPTY
INPUT 0, ;YES, FILL IT UP
ILDB A,IBUF+1 ;GET A CHARACTER
POPJ P, ;AND RETURN
ERRISQ: MOVEI B,[ASCIZ /?Illegal project-programmer number/]
JRST ERROR
SUBTTL DISPATCH TABLE FOR SWITCHES
SLIST: HRRI DIS, APPEND ;A - APPEND INSTRUCTION
PUSHJ P, BSWTCH ;B - BACKSPACE ONE FILE
HRRI DIS, DELCPY ;C - COPY AND DELETE LOCAL SYMBOLS ***VJC
HRRI DIS, DELETE ;D - DELETE INSTRUCTION
HRRI DIS, EXTRCT ;E - EXTRACT INSTRUCTION
JRST ERR16 ;F - ERROR
JRST ERR16 ;G - ERROR
JRST HELPME ;H - HELP
HRRI DIS, INSERT ;I - INSERT INSTRUCTION
JRST ERR16 ;J - ERROR
PUSHJ P, KSWTCH ;K - SKIPFILE
HRRI DIS, LIST ;L - LIST COMMAND
JRST ERR16 ;M - ERROR
JRST ERR16 ;N - ERROR
JRST ERR16 ;O - ERROR
JRST ERR16 ;P - ERROR
JRST ERR16 ;Q - ERROR
HRRI DIS, REPLCE ;R - REPLACE INSTRUCTION
HRRI DIS,LENTRY ;S - LIST ENTRY BLOCK
PUSHJ P, TSWTCH ;T - SKIP TO LOGICAL END OF TAPE
JRST ERR16 ;U - ERROR
JRST ERR16 ;V - ERROR
PUSHJ P, WSWTCH ;W - REWIND MAG TAPE
HRRI DIS,INDEX ;X - INDEX THIS LIBRARY
JRST ERR16 ;Y - ERROR
PUSHJ P, ZSWTCH ;Z - CLEAR DIRECTORY ON DECTAPE
;MAGTAPE AND DECTAPE DEVICE SWITCH HANDLERS
;THE FOLLOWING ROUTINES HANDLE THE B,K,T,W, AND Z SWITCHES
;BY ASSEMBLING THE PROPER CALL OR UUO INSTRUCTION. IF A
;DEVICE HAS ALREADY BEEN SEEN, THE CHANNEL NUMBER IS LOADED
;INTO THE COMMAND, AND THE INSTRUCTION IS EXECUTED. OTHER-
;WISE, EXECUTION IS DEFERRED BY SETTING A FLAG AND STORING
;THE PARTIALLY ASSEMBLED INSTRUCTION. THE INSTRUCTION IS
;EXECUTED LATER, AFTER THE DEVICE HAS BEEN SEEN.
BSWTCH: ADDI SW, 1 ;CODE FOR BACKSPACE IS 17
KSWTCH: ADDI SW, 6 ;CODE FOR SKIPFILE IS 16
TSWTCH: ADDI SW, 7 ;CODE FOR SKIP TO L.E.O.T. IS 10
WSWTCH: AOJA SW,.+2 ;CODE FOR REWIND IS 1
ZSWTCH: MOVE SW, DTCLR ;DIFFERENT UUO FOR /Z
TRNE F,DEVB ;DEVICE SEEN?
JRST XCTSWT ;YES, EXECUTE SWITCH NOW
TRO F, SAVEB ;NO, TURN ON THE SWITCH BIT
POPJ P, ;EXIT
XCTSWT: DPB D,[POINT 4,SW,12]
XCT SW
POPJ P,
SUBTTL PERIOD PROCESSOR
;THE PERIOD PROCESSOR IS CALLED BY A DISPATCH FROM GETCHR. IT
;PRECEDES A FILE NAME EXTENSION, UNLESS THE CONTEXT BIT CONB IS
;A ONE (CONB=1), IN WHICH CASE, THE PERIOD WAS FOUND INSIDE AN
;ANGLE BRACKET, INDICATING THAT IT IS PART OF A PROGRAM NAME.
;THE EXTENSION NAME IS GOTTEN BY ENTERING THE GETCHR ROUTINE
;WITH THE LENGTH SET TO THREE CHARACTERS, AND A BYTE POINTER
;SET TO STORE THE SYMOL IN ACCUMULATOR EXT. THE EXTENSION
;FLAG IS SET BY THIS ROUTINE.
PERIOD: TRNE F, CONB ;IS PERIOD PART OF A PROGRAM NAME?
JRST STORE ;YES, STORE IT IN SYMBOL
TRO F, EXTB ;NO, SET EXTENSION FLAG
SETZ EXT, ;CLEAR OLD EXTENSION
MOVE E, EXTPTR ;GET ANOTHER BYTE POINTER
MOVEI B, 3 ;ASSEMBLE A 3-CHARACTER WORD
JRST GETCMN ;BUT DONT DESTROY S
SUBTTL ROUTINES TO PROCESS ANGLE BRACKETS
;THE FOLLOWING ROUTINES PROCESS THE LEFT ANGLE BRACKET "<"
;AND RIGHT ANGLE BRACKET ">" CHARACTERS. THEY ARE ENTERED BY
;A DISPATCH FROM THE GETCHR ROUTINE. THE ANGLE BRACKETS
;CAN ACT AS FILE NAME OR PROGRAM NAME DELIMITERS, SO A CHECK
;IS MADE TO SEE IF THE SYMBOL ACCUMULATOR IS NON-ZERO. THE
;MAIN FUNCTION OF THE ROUTINES IS TO SET OR CLEAR THE CONTEXT
;BIT CONB, WHOSE INTERPRETATION IS AS FOLLOWS:
;SETTING OF BIT MEANING
; 0 COMMAS DELIMIT FILE NAMES, AND PERIODS
; DELIMIT FILE NAME EXTENSIONS
; 1 COMMAS DELIMIT PROGRAM NAMES, AND PERIODS
; ARE PART OF A PROGRAM NAME
LBRACK: TRNN F, DESTB ;IS THIS THE OUTPUT DEVICE?
JRST ERROR1 ;YES, SYNTAX ERROR
CAIN A,"[" ;PROJECT-PROGRAMMER PAIR?
JRST LSQB ;YES, HANDLE IT
MOVE 0,SDEVCHR ;GET SAVED DEV CHRSTCS
TLNN 0,DTABIT+DSKBIT ;LAST DEVICE DSK OR DTA?
JRST LBRACA ;NO
MOVE 0,LSTCHR ;GET LAST CHAR
CAIN 0,72 ;WAS IT COLON?
JRST ERROR1 ;YES,:< ILLEGAL
LBRACA: ;NO CONTINUE
PUSHJ P, SEMICP ;PROCESS THE FILE NAME
TRO F, CONB ;SET CONTEXT TO PROGRAM NAMES
AOS MATCH ;ADD ONE FOR EACH LEFT < ***VJC
JRST GETCHR ;RETURN FOR MORE CHARACTERS
RBRACK: JUMPE S,.+2 ;IS THERE A SYMBOL TO HANDLE?
PUSHJ P,COMMAP ;YES,PROCESS THE FILE NAME
TRZ F,CONB ;SET CONTEXT TO FILE NAMES
SOS MATCH ;SUBTRACT ONE FOR EACH RIGHT > ***VJC
JRST GETCHR ;RETURN FOR MORE CHARACTERS
SUBTTL COMMA PROCESSOR
;THE COMMA ROUTINE IS ENTERED BY A DISPATCH FROM GETCHR.
;IT DETERMINES WHETHER THE COMMA DELIMITS A FILE NAME OR A
;PROGRAM NAME, AND TRANSFERS CONTROL EITHER TO SEMICP OR TO
;COMMAP.
COMMA: TRNN F, CONB ;FILE NAME OR PRGRAM NAME?
JRST COMMAX ;FILE NAME
PUSHJ P, COMMAP ;PROGRAM NAME
JRST GETCHR ;RETURN FOR MORE CHARACTERS
;COLONB IS ENTERED TO HANDLE MTA:::: ETC
;IT DUMMIES UP A FILE NAME AND ENTERS IT IN LIST
COLONB: MOVEI S,'FOO' ;DUMMY NAME
;FALL INTO COMMAX
;THENCE TO SEMICP
COMMAX: PUSHJ P, SEMICP ;FILE NAME, DO A LOOKUP
SETZM PRJPRG ;CLEAR TEMP. PPN
TLZ F,SMCPFL ;CLEAR FLAG NOW
JRST GETCHR ;RETURN FOR MORE CHARACTERS
SUBTTL COLON PROCESSOR
;THIS ROUTINE IS ENTERED BY A DISPATCH FROM THE GETCHR
;ITS PURPOSE IS TO INITIALIZE DEVICES USED BY FUDGE2 AND
;ASSIGN THEM A CHANNEL NUMBER. IF THE DEVICE IS THE TTY, THE
;ROUTINE EXITS IMMEDIATELY, SINCE THE TTY HAS ALREADY BEEN
;INITIALIZED. IF A PROGRAM WAS NOT SEEN IN THE PREVIOUS DEVICE
;SPECIFICATION, THEN THE PRECEDING FILE HAD NO PROGRAMS
;FOLLOWING IT, AND A ZERO IS PLACED IN THE LIST STRUCTURE IN
;THE 3-WORD FILE BLOCK, SO THAT THE GETDEV ROUTINE WILL
;KNOW THAT THE ENTIRE FILE IS DESIRED. IF THE COLON ROUTINE
;IS CALLED WITH 0 IN ACCUMULATOR S, THE ROUTINE ASSUMES
;THAT SOMETHING LIKE "DTA3:FOO_DTA4:BAR<X,Y,Z>,MTA0:::/R"
;WAS TYPED, AND IT PUTS A PHONY FILE NAME IN FILBUF TO KEEP
;THE BOOK-KEEPING STRAIGHT.
COLON: TRO F, DEVB ;DEVICE WAS SEEN IN THIS SPEC.
TRNE F,POPBAK ;DEFAULT "DSK" BEING SET
JRST .+3 ;SO DON'T CLEAR PROJ-PROG
SETZM DEFPPN ;CLEAR PERMANENT PPN
SETZM PRJPRG ;AND TEMP. ALSO
JUMPE S, COLONB ;NULL S IMPLIES FILES ON MTA,PTR
MOVEM S, COLON2 ;SAVE DEVICE FOR INIT
MOVE G, S ;GET A COPY OF THE DEVICE NAME
DEVCHR G, ;GET ITS CHARACTERISTICS
MOVEM G,SDEVCHR ;SAVE DEV CHRSTCS ***VJC
TLNE G,TTYBIT!LPTBIT ;IF EITHER TTY OR LPT
SETZM LEVEL ;DON'T DO EXTENDED LOOKUPS EVER
TLNE G, TTYBIT ;IS THE DEVICE A TTY?
JRST GETCHR ;YES, RETURN IMMEDIATELY
TRNN F, DESTB ;IS THIS THE OUTPUT DEVICE?
JRST COLON4 ;YES, GO CHECK SEPARATE THINGS
MOVE D, DEVBUF ;GET POINTER TO DEVICE NAME TABLE
COLON6: AOBJP D, COLON7 ;MORE DEVICES TO CHECK?
TLNN G,DSKBIT ;IF DSK CHANGE CHANNEL ALWAYS
CAME S, DEVBUF(D) ;IF NOT COMPARE
JRST COLON6 ;CONTINUE
JRST GETCHR ;GIVE UP
COLON7: CAIL D,DEVNO ;NOT TOO MUCH
JRST [MOVE D,DEVBUF ;IN CASE AOJA
TLZE G,DSKBIT ;NO MORE DSK
AOJA D,COLON6 ;SKIP OUTPUT DEVICE
JRST ERR25] ;TOO MANY DEVICES
MOVE G,SDEVCHR
MOVEM S, DEVBUF(D) ;STORE THE NEW DEVICE NAME
MOVSI A, -1 ;FIX UP THE COUNT IN THE BUFFER
ADDM A, DEVBUF ;...
TLNN G, INBIT ;CAN DEVICE DO INPUT?
JRST ERROR4 ;NO, ERROR
MOVEI S, 0 ;CLEAR OUT THE SYMBOL WORD
TRON F, PROGB ;WAS A PROGRAM NAME SEEN?
PUSHJ P, STNULL ;NO, STORE A NULL IN FILE BLOCK
MOVE A, D ;CALCULATE BUFFER HEADER POSITION
IMULI A, 3 ;3 WORDS PER BUFFER HEADER
ADDI A, IBUF ;ALL BUFFER HEADERS IN IBUF BLOCK
COLON8: AOS NUMDEV ;ONE MORE DEVICE SEEN
MOVEM A, COLON3 ;SAVE WORD FOR INIT
MOVEI A, 14 ;SET MODE TO BINARY
TLNE G,LPTBIT ;IS DEVICE THE LPT?
MOVEI A, 0 ;YES, RESTORE MODE TO ASCII
HRRM A, COLON0 ;SAVE MODE FOR INIT
DPB D, [POINT 4,COLON1,12]
XCT COLON1 ;DO OPEN ON DEVICE
JRST ERROR9 ;DEVICE NOT AVAILABLE
TRNN F, DESTB ;IS THIS THE OUTPUT DEVICE?
JRST GETCHR ;YES, NO MORE CHECKING - EXIT
TLNN G, DRCTRB ;DOES DEVICE HAVE A DIRECTORY?
JRST COLONB ;NO, GIVE IT A PHONY FILE NAME
JRST GETCHR ;RETURN FOR MORE CHARACTERS
;OUTPUT DEVICE ONLY
COLON4: MOVEM S, DEVBUF+1 ;SAVE THE DEVICE NAME
MOVEI D, 1 ;SET DEVICE NUMBER TO 1
TLNN G, OUTBIT ;CAN DEVICE DO OUTPUT?
JRST ERROR4 ;NO, ERROR
TLNE G,DTABIT ;IS DEVICE DTA?
TRO F,DTAFLG ;YES, SET IN CASE INDEXING
MOVSI A, OBUF+3 ;CALCULATE BUFFER HEADER ADDRESS
TRO F, TTYCB ;INDICATE NON-TTY IO
JRST COLON8 ;ENTER MAIN PROCESSING LOOP
SUBTTL FILE NAME PROCESSOR
;THIS ROUTINE IS CALLED BY THE COMMA ROUTINE WHEN IT HAS
;BEEN DETERMINED THAT THE CONTEXT OF THE COMMA IS THAT OF A
;FILE NAME. NULL FILES ARE IGNORED BY THE ROUTINE, AND CAUSE
;AN IMMEDIATE RETURN TO GETCHR. FOR OUTPUT DEVICES, AN ENTER
;IS PERFORMED, WHILE FOR INPUT DEVICES, THE FLOW OF CONTROL IS
;AS FOLLOWS:
; 1. IF THE PREVIOUS FILE HAD NO PROGRAMS, A ZERO IS
; STORED IN THE 3RD WORD OF THE FILE BLOCK OF THAT
; FILE - THE WORD THAT ORDINARILY POINTS TO THE
; PROGRAM SUBLIST.
; 2. THE PROGRAM LIST FOR THE PREVIOUS FILE IS TERMINATED
; BY PUTTING A ZERO IN THE PROGRAM BUFFER, AND PUTTING
; A POINTER TO THE ZERO IN THE 3RD WORD OF THIS FILE
; BLOCK (NOT THE PREVIOUS BLOCK)
; 3. THE FILE NAME AND FILE NAME EXTENSION AND THE DEVICE
; CHANNEL NUMBER OF THE CURRENT FILE ARE STORED.
SEMICP: TLOE F,SMCPFL ;BEEN HERE ONCE ALREADY?
POPJ P, ;YES, JUST RETURN
SEMICO: TRNN F,DEVB ;HAS A DEVICE BEEN SEEN?
PUSHJ P,NODEV ;NO, SO ASSUME "DSK"
CAME SW,DTCLR ;Z SWITCH? YES, OPERATE ON OUTPUT ONLY
DPB D, [POINT 4,SW,12]
TRZE F, SAVEB ;IS THERE A SWITCH TO PROCESS?
XCT SW ;YES, EXECUTE IT
TRNE F,DESTB ;SKIP IF OUTPUT DEVICE
JUMPE S, SEMIC3 ;IGNORE NULL FILES
SEMICA: TRZN F, EXTB ;EXPLICIT EXTENSION SEEN?
HRLI EXT, 624554 ;NO, REPLACE WITH REL"
TRNN F, DESTB ;OUTPUT DEVICE?
JRST SEMIC2 ;YES, PROCESS SEPARATELY
PUSH P, S ;SAVE FILE NAME
MOVEI S, 0 ;PUT IN A ZERO
TRZN F, PROGB ;WAS A PROGRAM SEEN IN PREVIOUS?
PUSHJ P, STNULL ;NO, CLOSE OUT PREVIOUS FILE
PUSHJ P, PUTPRG ;YES, CLOSE OUT PREVIOUS PRGLST
SEMIC4: POP P, S ;RESTORE FILE NAME
CAMN S,[12B5] ;IS IT * ?***DMN
JRST ASTRSK ;YES ***DMN
PUSHJ P, PUTFIL ;NO, STORE FILENAME
MOVE S,DEFPPN ;GET GLOBAL PPN
PUSHJ P,PUTPPN ;SAVE IT
MOVE S, EXT ;GET FILE NAME EXTENSION
PUSHJ P, PUTFIL ;STORE IT
HRRM D, (A) ;STORE CHANNEL NUMBER, ALSO
MOVE S,PRJPRG ;GET TEMP. PPN
PUSHJ P,PUTPPN ;SAVE IT ALSO
HRRZ S, PRGBUF ;GET A POINTER TO PROGRAM LIST
JRST PUTFIL ;STORE IT AND EXIT
STNULL: HRRZ A, FILBUF ;GET ADDRESS OF CURRENT BLOCK
SETZM (A) ;CLOSE OUT THE FILE
POPJ P, ;EXIT
SUBTTL ENTER ON OUTPUT DEVICE DIRECTORY
SEMIC2: TRNN F,TTYCB ;IS OUTPUT DEVICE TTY?
POPJ P, ;YES, DON'T BOTHER WITH ENTER
MOVEM S, EBLOCK ;SAVE FILE NAME FOR ENTER
MOVEM EXT, EBLOCK+1 ;SAVE FILE NAME EXTENSION
MOVEM S,SVENTR ;SAVE FILE NAME
MOVEM EXT,SVENTR+1 ;AND EXT
DPB D, [POINT 4,SEMIC1,12]
SETZM EBLOCK+2 ;CLEAR DATA AND PROTECTION
MOVE T,SDEVCHR ;GET CHARACTERISTICS
TLNN T,DSKBIT ;IF NOT A DSK
SETZM LEVEL ;CLEAR LEVEL D FLAG
TLO F,DEFENT ;DEFER ENTRY TIL AFTER LOOKUPS
MOVEI T,RIBALC ;SET FOR 11 WORD LOOKUP
MOVEM T,EBLOCK-2 ;IN EXTENDED LOOKUP
SEMIC3: POPJ P, ;EXIT
SUBTTL THE PROGRAM NAME PROCESSOR
;THE COMMAP ROUTINE IS ENTERED BY A CALL FROM THE COMMA
;ROUTINE WHEN THE CONTEXT OF A COMMA IS THAT OF A PROGRAM NAME
;DELIMITER. ITS PURPOSE IS TO SAVE UP THE PROGRAM NAMES IT SEES
;IN THE PROGRAM BUFFER PRGBUF. THE PROGRAM NAMES ARE CONVERTED
;TO RADIX 50 REPRESENTATION, AND A CALL TO PUTPRG STORES THE
;PROGRAM NAME FOR LATER REFERENCE BY THE VARIOUS FUDGE SUBROUTINES
;------------------------------------------------------------------
;RADIX50 - SIXBIT CODE CONVERSION TABLE
;CHARACTER SIXBIT RADIX50
;0-9 20-31 01-12
;A-Z 41-72 13-44
;BLANK 00 00
;PERIOD 16 45
;$ 04 46
;-------------------------------------------------------------------
;THE SYMBOL IS ASSUMED TO LEFT-JUSTIFIED UPON ENTERING, AND
;IS RIGHT-JUSTIFIED BEFORE CONVERSION TO RADIX 50.
;FLAG SETTINGS: THE PROGRAM BIT PROGB IS SET TO 1, AND THE FILE
;BIT FILEB IS SET TO 0.
COMMAP: TRO F, PROGB ;SET PROGRAM BIT
TRNN F, DESTB ;IS THIS THE OUTPUT DEVICE?
JRST ERROR1 ;YES, SYNTAX ERROR
MOVE E, SYMPTR ;SET UP A BYTE POINTER TO S
MOVEI B, 6 ;SET COUNTER TO SIX
MOVEI C, 0
JUMPE S, COMMA1 ;NULL SYMBOL?
COMMA3: TRNE S, 77 ;IS SYMBOL RIGHT-JUSTIFIED YET?
JRST COMMA1 ;YES, GO CONVERT TO RADIX 50
ROT S, -6 ;NO, SHIFT IT ONE PLACE RIGHT
JRST COMMA3 ;CHECK AGAIN
COMMA1: IMULI C, 50 ;CONVERT TO RADIX50
ILDB A, E ;PICK UP NEXT CHARACTER IN S
JUMPE A, COMMA4 ;A BLANK IS A BLANK IS A BLANK!
CAIE A, '%' ;IS IT A <%>?
CAIN A, '$' ;IS IT A <$>?
ADDI A, 70 ;YES, COMPENSATE FOR SUBTRACTION
CAIN A, '.' ;IS IT A <.>?
ADDI A, 55 ;YES, COMPENSATE FOR SUBTRACTION
CAILE A, 31 ;TRANSLATE TO RADIX 50 CODE
SUBI A, 7 ;LETTER - SUBTRACT 26
SUBI A, 17 ;NUMBER - SUBTRACT 17
ADD C, A ;COMBINE WITH PARTIAL WORD
COMMA4: SOJG B, COMMA1 ;LOOP FOR SIX CHARACTERS
MOVE S, C ;PUT SYMBOL BACK IN S
JRST PUTPRG ;STORE IT AND EXIT
SUBTTL THE ALTMODE PROCESSOR
;THE ALTMODE SUBROUTINE IS CALLED BY A DISPATCH FROM THE
;GETCHR ROUTINE WHEN A $ IS SEEN IN THE COMMAND STRING. IT SIGNALS
;THE END OF THE COMMAND STRING. A CHECK IS MADE ON THE SYNTAX
;OF THE COMMAND STRING, TO SEE IF AN OUTPUT DEVICE WAS SPEC-
;IFIED, AND TO SEE IF A COMMAND WAS GIVEN. THE LIST
;STRUCTURE FOR THE FILE NAMES AND PROGRAM NAMES IS TERMINATED
;BY TWO CALLS TO SEMICP, THE LAST OF WHICH HAS A FILE NAME OF 0.
;THE POINTERS AT THE TOP OF THE FILBUF,PRGBUF AND DEVBUF BUFFERS
;ARE RESET FOR LATER USER BY THE VARIOUS SUBROUTINES.
ALTMOD: TRNN F,INFOB ; IS THERE A COMMAND?
JRST FUDGE2 ; NO, RESTART
TRNN F,DESTB ;HAS "_" BEEN SEEN?
JRST ERROR1 ;NO, GIVE ERROR MESSAGE OR LOSE FILE
PUSHJ P,CRLF ; ACKNOWLEDGE WITH A CR LF
TRO F,CRLFTY ;INDICATE CR,LF TYPED
PUSHJ P, SEMICP ;STORE THIS FILE NAME
MOVEI S, 0 ;MAKE A NULL FILE NAME
PUSHJ P, SEMICA ;TERMINATE THE LIST STRUCTURE
MOVE A, FILXWD ;SET UP A BLT POINTER TO FIX
BLT A, FILBUF+3 ;THE MASTER FILE PART,1ST WORD OF
SETZM FILBUF+4 ;FILBUF WAS JUNK,NOW 4TH WORD=0
MOVEI A, FILBUF+5 ;RESET POINTER TO TRANS. FILES
MOVEM A, FILBUF ;...
MOVEI A,PPNBUF+3 ;RESET PPNBUF TO TRANS FILE
MOVEM A,PPNBUF
JUMPE DIS, ERR1A ;NO COMMAND SEEN?
TRNN F, DESTB ;NO OUTPUT FILE MENTIONED?
JRST ERROR1 ;SYNTAX ERROR
SKIPE MATCH ;LEFT < EQU RIGHT > ?***VJC
JRST ERROR1 ;SYNTAX ERROR ***VJC
TRNE F, TTYCB ;CHANGE OUTPUT IF ON TTY
TRO F, TTYOB ;...
;AND FALL INTO INBUF0
;SEE HOW MANY 204(8) WORD BLOCKS FIT IN JOBREL-JOBFF.
;DIVIDE THIS NUMBER BY THE NUMBER OF DEVICES
;IN DEVBUF TABLE. THIS GIVES THE NO. OF BLOCKS
;THAT CAN BE ASSIGNED TO EACH DEVICE, IF ZERO,
;NEED MORE CORE. THE REMAINDER OF THE DIVISION
;INDICATES EXTRA BLOCKS THAT MAY BE
;ALLOCATED TO OUTPUT OR INPUT DEVICES
INBUF0: HRRZ A,.JBREL ;GET TOP OF JOB AREA
SUB A,.JBFF ;BUFFER AREA AVAILABLE
IDIVI A, 204 ;NUMBER OF DECTAPE BLOCKS
IDIV A,NUMDEV ;DIVIDED BY NUMBER OF DEVICES
JUMPE A,INBUFG ;NOT ENOUGH CORE
MOVEI E,2 ;START INBUFS ON DEVICE #2
TRNE F, TTYCB ;IS OUTPUT ON TTY?
JRST INBUF1 ;NO, DO AN OUTBUF
INBUF2: MOVE C, A ;PICK UP NUMBER OF BLOCKS
SOJL A+1,.+2 ;ANY EXTRA BLOCKS? (REMAINDER)
AOJ C, ;YES, USE THEM
DPB E, [POINT 4, INBUF3,12]
XCT INBUF3 ;PERFORM THE INBUF
CAMGE E, D ;MORE DEVICES TO TAKE CARE OF?
AOJA E, INBUF2 ;YES, PROCESS THEM
JRST (DIS) ;NO, GO TO APPROPRIATE SUBROUTINE
INBUF1: MOVE C, A ;PICK UP NUMBER OF BLOCKS
SOJL A+1,.+2 ;ANY EXTRA BLOCKS?
AOJ C, ;YES, GIVE ONE TO OUTPUT
INBUF4: OUTBUF 1,(C) ;OUTBUF ON DEVICE #1
JRST INBUF2 ;GO DO SOME INBUFS
;ASK FOR MORE CORE
INBUFG: HRRZ A,.JBREL ;GET ANOTHER K OF CORE
ADDI A,2000
CORE A,
JRST ERR22 ;NOT AVAILABLE
JRST INBUF0 ;TRY TO SET UP BUFFERS
SUBTTL FUDGE2 COMMAND PROCESSORS
;LIST PROCESSOR
;THIS ROUTINE PROCESSES THE L COMMAND IN FUDGE2. BINARY
;PROGRAMS ARE READ, AND THEIR NAMES OUTPUT, UNTIL AN END
;OF FILE IS REACHED.
LENTRY: TLO F,LSTENT ;LIST THE ENTRY BLOCK AS WELL
LIST: TRNN F,TTYOB ;OUTPUT TO TTY?
JRST LIST1 ;MODE MUST BE ASCII
HLRZ T,SVENTR+1 ;GET EXTENSION
CAIN T,'REL' ;HAS IT BEEN SET TO 'REL'
MOVEI T,'LST' ;YES, CHANGE TO 'LST'
HRLM T,SVENTR+1 ;AND REPLACE
MOVE T,FILBUF+1 ;GET MASTER FILE NAME
SKIPN SVENTR ;ENTER NAME ALREADY SET UP?
MOVEM T,SVENTR ;NO, SET FOR DSK OR SPOOLING
GETSTS 1,T ;GET STATUS
TRZN T,14 ;BINARY MODE SET?
JRST LIST1 ;NO, MUST BE ASCII
SETSTS 1,(T) ;CHANGE MODE TO ASCII
MOVSI T,700 ;SET UP NEW BYTE POINTER
MOVEM T,OBUF+4 ;SO WORD COUNT WILL BE CORRECT
LIST1: SETOM END2 ;SIGNAL FIRST TIME THROUGH
PUSHJ P, MSTGET ;GET THE MASTER DEVICE
JRST ERROR6 ;NOT ENOUGH ARGUMENTS
TLO F,NOWARN ;DON'T GIVE WARNING MESSAGE IF INDEX SEEN
LIST2: PUSHJ P, READ ;READ A PROGRAM NAME
JRST [TLNN F,LSTENT ;LISTED ENTRIES?
PUSHJ P,LIST5 ;NO, SO LIST RELOCATION
JRST EXIT] ;FINISHED
TLNE F,LSTENT ;LIST ENTRIES
JRST LIST4 ;YES, SO NO SIZE
SKIPL END2 ;BUT NOT FIRST TIME (NOT SET UP YET)
PUSHJ P,LIST5 ;LIST RELOCATION WORDS
LIST4: MOVE B, A ;GET THE PROGRAM NAME IN B
PUSHJ P, PTYPO ;TYPE IT OUT
TLNE F,LSTENT ;ENTRY BLOCK AS WELL?
JRST LISTE ;YES
JRST LIST2 ;RETURN FOR MORE PROGRAM NAMES
LISTE: HRRZ C,ENTBLK ;GET NUMBER OF ENTRIES
JUMPE C,LIST3 ;NONE IN THIS PROGRAM
MOVNS C ;NEGATE
MOVSS C ;PUT IN LEFT HALF
HRRI C,ENTBLK+2 ;START OF ENTRIES
MOVEI E,TABS1 ;ASSUME NOT TTY
TRNN F,TTYOB ;WAS IT?
MOVEI E,TABS2 ;TTY HAS SHORTER LINE
LISTE1: SKIPN B,(C) ;GET AN ENTRY
AOJA C,.-1 ;IGNORE RELOCATION WORD
PUSHJ P,TYPTAB ;OUTPUT A TAB
PUSHJ P,PTYPO ;FOLLOWED BY SYMBOL
AOBJN C,LISTE1 ;FOR ALL OF BLOCK
LIST3: PUSHJ P, CRLF ;TYPE A CRLF
JRST LIST2 ;RETURN FOR MORE PROGRAM NAMES
LIST5: PUSH P,A ;SAVE NAME
MOVE B,END1 ;GET FIRST END WORD
TRNE B,-1 ;KLUDGE FOR FORTRAN
JRST LISTF ;YES, IT WAS
PUSHJ P,OCTOUT ;OUTPUT OCTAL NUMBER
SKIPE B,END2 ;ONLY IF NOT ZERO
PUSHJ P,OCTOUT ;OUTPUT SECOND WORD
LISTF: PUSHJ P,CRLF ;T YPE CRLF AND RETURN
POP P,A ;RESTOR NAME
POPJ P,
;REPLACE PROCESSOR
;THIS ROUTINE PROCESSES THE R COMMAND IN FUDGE2. THE TOTAL
;COMMAND STRING IS BROKEN INTO A LIST OF PROGRAMS FOR THE MASTER
;DEVICE, AND A LIST OF PROGRAMS FOR THE TRANSACTION DEVICES.
;THE ROUTINE READS THE MASTER FILE UNTIL ONE OF THE DESIRED
;REPLACEMENT PROGRAMS IS REACHED, THEN SWITCHES TO THE
;TRANSACTION DEVICE TO FIND THE PROGRAM WHICH IS TO REPLACE THE
;PROGRAM IN THE MASTER FILE. AFTER THE REPLACEMENT HAS BEEN
;EFFECTED, RESET IS CALLED TO RESTORE THE MASTER DEVICE TO ITS
;OLD POSITION.
REPLCE: PUSHJ P, OUTSTS ;CHECK OUTPUT DEVICE STATUS
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER DEVICE
JRST IPROC7 ;NO MORE, COPY REST OF MASTER
PUSHJ P, COPYTO ;COPY UP TO THE PROGRAM NAME
PUSHJ P, TRNGET ;GET A PROGRAM FROM TRANSACTION
JRST ERROR5 ;USER DID NOT SUPPLY ENOUGH
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
CAIN D, 2 ;HAS THE MASTER DEVICE BEEN MOVED?
PUSHJ P, RESET ;YES, RESET IT
JRST REPLCE ;LOOK FOR MORE REPLACEMENTS
OUTSTS: TRNN F,TTYOB ;IF OUT DEV IS TTY
JRST ERR28A ;LOSE NOW
GETSTS 1,A ;GET OUTPUT DEVICE STATUS
TRC A,14 ;BETTER BE MODE 14
TRCN A,14
POPJ P, ;YES, ALL OK
JRST ERR28 ;NO, U LOSE
SUBTTL INSERT PROCESSOR
;THIS SUBROUTINE PROCESSES THE I COMMAND IN FUDGE. IT READS AND
;WRITES PROGRAMS FROM THE MASTER FILE UNTIL IT FINDS THE
;PROGRAM NAME CURRENTLY POINTED TO, AT WHICH TIME IT STARTS READING
;FROM THE TRANSACTION DEVICE, MAKING AN INSERTION AT THE
;PROPER PLACE.
INSERT: PUSHJ P, OUTSTS ;CHECK OUTPUT DEVICE STATUS
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER FILE
JRST IPROC7 ;NO MORE, COPY REST OF MASTER
PUSHJ P, COPYTO ;COPY UP TO A PROGRAM NAME
MOVEM C, SAVEAC ;SAVE SPECIAL ACCUMULATOR
MOVE D, [XWD ENTBLK,SVEBLK]
BLT D, X+1(C) ;MOVE ENTRY BLOCK INTO SAFE PLACE
PUSHJ P, TRNGET ;GET NEXT TRANSACTION FILE
JRST ERROR5 ;NOT ENOUGH TRANSACTION FILES
PUSHJ P, FINDCP ;FIND TRANSACTION FILE AND COPY
CAIE D, 2 ;HAS MASTER FILE BEEN JIGGLED?
JRST FIXUP ;NO, RESTORE THE ENTRY BLOCK
PUSHJ P, RESET ;YES, RESET IT
JRST INSER1 ;WRITE OUTGO BACK FOR MORE INSERTIONS
FIXUP: MOVE C, SAVEAC ;RESTORE SPECIAL AC
MOVS D, [XWD ENTBLK,SVEBLK]
BLT D, (C) ;RESTORE ENTRY BLOCK
MOVEI D, 2 ;SET UP CHANNEL AC
MOVEI DIS, 6 ;SET UP BUFFER HEADER INDEX
INSER1: PUSHJ P, WRITE ;WRITE OUT THE CURRENT FILE
JRST INSERT ;GO BACK FOR MORE INSERTIONS
IPROC7: PUSHJ P, COPY ;COPY REST OF MASTER FILE
JRST EXIT ;EXIT
SUBTTL EXTRACT PROCESSOR
;THIS ROUTINE PROCESSES THE E COMMAND IN FUDGE. RATHER THAN
;ONE MASTER AND SEVERAL TRANSACTION FILES, ALL FILES ARE
;TREATED THE SAME. AFTER A CALL TO EITHER MSTGET OR TRNGET
;PROGRAMS ARE SEARCHED FOR AND WRITTEN ON THE OUTPUT DEVICE.
EXTRCT: TLO F,NOWARN ;NO WARNING MESSAGE
PUSHJ P, OUTSTS ;CHECK OUTPUT DEVICE STATUS
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER DEVICE
JRST EPROC1 ;ALL DONE WITH MASTER DEVICE
JUMPN R,.+3 ;ANY PROGRAMS THIS FILE? **VJC
PUSHJ P,COPY ;NO, COPY ENTIRE FILE ***VJC
JRST EPROC1 ; ***VJC
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST EXTRCT ;RETURN FOR MORE MASTER PROGRAMS
EPROC1: MOVEI A, FILBUF+5 ;GET PROGRAM FROM TRANS BUFFER
MOVEM A, FILBUF ;INITIALIZE POINTER FIRST
EPROC2: PUSHJ P, GETDEV ;...
JRST EXIT ;ALL DONE
JUMPN R,.+3 ;ANY PROGRAMS THIS FILE? ***VJC
PUSHJ P,COPY ;NO, COPY ENTIRE FILE ***VJC
JRST EPROC2 ; ***VJC
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST EPROC2 ;RETURN FOR MORE TRANS FILES
SUBTTL DELETE PROCESSOR
;THIS ROUTINE PROCESSES THE D COMMAND IN FUDGE2. ONLY ONE
;INPUT FILE WILL BE READ, AND THE PROGRAM NAMES ASSOCIATED
;WITH ITS LIST WILL BE DELETED.
DELETE: PUSHJ P, OUTSTS ;CHECK OUTPUT DEVICE STATUS
PUSHJ P, MSTGET ;GET A PROGRAM TO BE DELETED
JRST IPROC7 ;FINISH OFF THE MASTER FILE
DPROC1: PUSHJ P, READ ;READ A PROGRAM
JRST ERROR7 ;EOF - CANT FIND IT
CAMN R, A ;CORRECT PROGRAM?
JRST DELETE ;YES, GET THE NEXT ONE
PUSHJ P, WRITE ;NO, WRITE THIS ONE OUT
JRST DPROC1 ;TRY AGAIN
;APPEND PROCESSOR
;THIS ROUTINE HANDLES THE A COMMAND IN FUDGE2. IT WILL COPY
;THE ENTIRE MASTER FILE, THEN START OBTAINING TRANSACTION
;DEVICES WITH CALLS TO TRNGET, APPENDING ONE OR MORE
;PROGRAMS FROM EACH FILE.
APPEND: PUSHJ P, OUTSTS ;CHECK OUTPUT DEVICE STATUS
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER FILE
JRST ERROR6 ;NOT ENOUGH ARGUMENTS
PUSHJ P, COPY ;COPY ENTIRE FILE
MOVEI A, FILBUF+5 ;INITIALIZE POINTER FOR TRANS
MOVEM A, FILBUF ;...
APROC3: PUSHJ P, GETDEV ;GET A PROGRAM NAME
JRST EXIT ;ALL DONE
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST APROC3 ;GET NEXT APPENDATION
;THIS ROUTINE PROCESSES THE X COMMAND (INDEX LIBRARY)
;AND FALLS INTO DELETE LOCAL SYMBOLS CODE.
;IF NOT DESIRED SKIP TO DELCPY+1
INDEX: MOVE A,DEVBUF+1 ;GET OUTPUT DEVICE
DEVCHR A, ;GET ITS CHARACTERISTICS
TLNN A,DSKBIT!DTABIT ;ONLY ALLOW DSK AND DTA AS LIBRARY DEVICES
JRST ERR23 ;GIVE ERROR MESSAGE
TLO F,NOWARN ;NO WARNING MESSAGE IF /X
TRO F,XFLG ;SET INDEX FLAG
; TROA F,XFLG ;SET /X BUT NOT /C
;DELETE LOCAL SYMBOLS AND COPY PROCESSOR
;THIS ROUTINE PROCESSES THE C COMMAND
;ONLY THE MASTER FILE IS HANDLED
DELCPY: TRO F, NOLOCB ;SET FLAG TO DELETE LOCAL SYMBOLS
PUSHJ P, OUTSTS ;CHECK OUTPUT DEVICE STATUS
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER FILE
JRST ERROR6 ;NOT ENOUGH ARGUMENTS
PUSHJ P, COPY ;COPY ENTIRE FILE
TRNN F,XFLG ;INDEX FLAG ON?
JRST EXIT ;ALL DONE
JRST INDEX3 ;YES DO PASS 2
SUBTTL FUDGE2 IO SUBROUTINES
;ROUTINES TO COPY FILES, COPY UP TO A GIVEN PROGRAM IN A FILE
;AND TO FIND A GIVEN PROGRAM IN A FILE AND COPY IT.
;THE COPY ROUTINE WILL COPY BINARY PROGRAMS FROM WHEREVER THE
;INPUT DEVICE HAPPENS TO BE WHEN IT IS CALLED, UP TO THE
;END OF FILE. SINCE COPY IS CALLED WITH A PUSHJ, THE END-OF-
;FILE EXIT IN INGET WILL EXIT TO THE PLACE THAT CALLED COPY.
COPY: PUSHJ P, READ ;READ A PROGRAM
POPJ P, ;EXIT WHEN ALL THROUGH FILE
PUSHJ P, WRITE ;WRITE OUT THE PROGRAM
JRST COPY ;RETURN FOR MORE PROGRAMS
;THE COPYTO ROUTINE WILL READ AND WRITE PROGRAMS FROM THE
;INPUT DEVICE UNTIL THE PROGRAM WHOSE NAME IS IN ACCUMULATOR
;R IS FOUND, AT WHICH TIME IT EXITS
COPYTO: PUSHJ P, READ ;READ A PROGRAM
JRST ERROR7 ;EOF - CANT FIND IT
CAMN R, A ;IS IT THE CORRECT PROGRAM?
POPJ P, ;YES, EXIT
PUSHJ P, WRITE ;NO, WRITE IT OUT
JRST COPYTO ;READ SOME MORE PROGRAMS
;THE FINDCP ROUTINE WILL SEARCH THE INPUT FILE FOR A PROGRAM
;WHOSE NAME IS IN ACCUMULATOR R, AND HAVING FOUND IT, WILL
;WRITE IT OUT. IF THE CONTENTS OF AC R ARE ZERO, THE ENTIRE
;FILE IS COPIED.
FINDCP: JUMPE R, COPY ;COPY ENTIRE FILE?
FIND1: PUSHJ P, READ ;READ A PROGRAM FROM INPUT FILE
JRST FIND2 ;EOF, TRY REWINDING AND TRYING AGAIN
CAME R, A ;IS THIS THE RIGHT ONE?
JRST FIND1 ;NO, TRY AGAIN
JRST WRITE ;YES, WRITE IT OUT AND EXIT
FIND2: JUMPE A,ERROR7 ;V3 IF EOF OUTPUT ERROR MESSAGE
PUSHJ P, BACKSP ;BACKSPACE THE MAG TAPE
HRRZ A, FILBUF ;PICK UP THE FILE POINTER
HLLM A, 3(A) ;CLEAR THE LOOKUP FLAG FOR DECTAPE
PUSHJ P, GETDEV ;SET UP THE PROGRAM AGAIN
JRST ERROR3 ;IMPOSSIBLE ERROR RETURN
FIND3: PUSHJ P, READ ;READ A PROGRAM FROM INPUT FILE
JRST ERROR7 ;EOF - REALLY CANT FIND IT
CAME R, A ;IS THIS THE RIGHT ONE?
JRST FIND3 ;NO, TRY AGAIN
JRST WRITE ;YES, WRITE IT OUT AND EXIT
;ROUTINE MSTGET RETRIEVES A PROGRAM NAME FROM THE MASTER
;DEVICE SPECIFICATIONS. IT SAVES THE POINTER IN FILBUF,
;CHANGES IT TO POINT TO ITS OWN BLOCK, THEN CALLS GETDEV
MSTGET: MOVE A, FILBUF ;GET THE POINTER TO CURRENT FILE
MOVEM A, FILSAV ;SAVE THE CURRENT POINTER
MOVEI A, FILBUF+1 ;CHANGE IT TO POINT TO MASTER
MOVEM A, FILBUF ;...
MOVE A,PPNBUF ;SAME FOR PPN POINTERS
MOVEM A,PPNSAV
MOVEI A,PPNBUF+1 ;MASTER
MOVEM A,PPNBUF
JRST GETDEV ;CALL COMMON ROUTINE
;ROUTINE TRNGET RETRIEVES A PROGRAM NAME FROM THE TRANSACTION
;FILES. IT RESETS THE POINTER THAT MSTGET WIPED OUT, AND CALLS
;THE COMMON PROGRAM RETRIEVAL PROGRAM GETDEV.
TRNGET: MOVE A, FILSAV ;GET SAVED POINTER
MOVEM A, FILBUF ;RESTORE IT TO ITS PLACE
MOVE A,PPNSAV
MOVEM A,PPNBUF
JRST GETDEV ;CALL COMMON ROUTINE
;ROUTINE RESET RESTORES THE STATE OF THE MASTER DEVICE TO
;WHAT IT WAS JUST AFTER THE LAST TIME MSTGET WAS CALLED. IT
;SETS THE POINTER OF THE MASTER FILE BACK TO THE PREVIOUS
;PROGRAM, CALLS MSTGET, AND FINDS THE PROGRAM AGAIN
RESET: MOVEI A,FILBUF+5 ;START OF TRANSACTION LIST ***DMN
HLLM A, FILBUF+3 ;NOW CLEAR LOOKUP FLAG ON MASTER
SOS FILBUF+3 ;MOVE POINTER BACK ONE PROGRAM
RESET2: SKIPN (A) ;ANY TRANSACTION FILES ? ***DMN
JRST RESET3 ;NO-ALL DONE ***DMN
HLLM A,2(A) ;CLEAR LOOKUP FLAG ON IT ***DMN
ADDI A,3 ;NEXT FILE ***DMN
JRST RESET2 ;GO BACK FOR MORE ***DMN
RESET3: PUSHJ P, MSTGET ;SET UP THE MASTER DEVICE
JRST ERROR3 ;FUDGE ERROR-NO MASTER!
PUSHJ P, BACKSP ;BACKSPACE IN CASE ITS A MAG TAPE
MOVE A, FILSAV ;DIDDLE THE POINTERS, BECAUSE MSTGET
MOVEM A, FILBUF ;WILL BE CALLED AGAIN IMMEDIATELY
RESET1: PUSHJ P, READ ;READ A PROGRAM FROM MASTER FILE
JRST ERROR3 ;FUDGE ERROR-CANT FIND PROGRAM
CAME R, A ;IS IT THE RIGHT PROGRAM NAME?
JRST RESET1 ;NO, LOOK AGAIN
POPJ P, ;YES, EXIT
BACKSP: DPB D, [POINT 4, BACK0,12]
DPB D, [POINT 4, BACK1, 12]
DPB D, [POINT 4, BACK2,12]
DPB D, [POINT 4,BACK3,12]
JRST BACK0 ;GO TO POSITION MAGTAPE
SUBTTL COMMON PROGRAM RETRIEVAL PROGRAM GETDEV.
;THIS PROGRAM USES VARIOUS POINTERS AND BITS OF INFORMATION
;IN FILBUF AND PRG BUF TO RETURN TO THE USER A RADIX 50
;PROGRAM NAME AS SEEN IN THE COMMAND STRING. THE STRUCTURE
;OF INFORMATION IN THESE TWO BUFFERS IS AS FOLLOWS:
;FILBUF IS A LIST OF 3-WORD BLOCKS OF DATA ABOUT EACH FILE.
;THE FIRST WORD IN FILBUF IS A POINTER WHICH POINTS TO THE
;FIRST WORD OF THE BLOCK CURRENTLY BEING WORKED ON BY
;THE VARIOUS SUBROUTINES OF FUDGE. WHEN THE COMMAND STRING
;IS BEING PROCESSED AND INFORMATION IS BEING STORED IN FILBUF,
;THIS POINTER IS IN THE FORM OF AN AOBJN WORD SO THAT A CHECK
;CAN BE MADE FOR BUFFER OVERFLOW. THE CONTENTS OF THE 3-WORD
;FILE BLOCK IS AS FOLLOWS:
; 1ST WORD - SIXBIT FILE NAME, OR ZERO IF THIS IS THE
; END OF THE LIST .
; 2ND WORD - LEFT HALF CONTAINS A SIXBIT FILE NAME EXTENSION
; RIGHT HALF CONTAINS THE CHANNEL NUMBER FOR
; THIS FILE.
; 3RD WORD - LEFT HALF IS ZERO IS A LOOKUP HAS NOT BEEN
; DONE ON THIS FILE NAME, AND -1 IF IT HAS. A
; LOOKUP CAN THUS BE FORECED BY ZEROING OUT THE
; LEFT HALF OF THE WORD.
; RIGHT HALF CONTAINS A POINTER TO THE LAST
; PROGRAM NAME IN PRGBUF THAT WAS REFERENCED. THE
; RIGHT HALF IS ZERO IF THERE ARE NO PROGRAM
; NAMES ASSOCIATED WITH THE FILE.
;PRGBUF IS A LIST OF PROGRAM NAMES USED BY THE FILES IN FILBUF.
;THE FIRST WORD OF PRGBUF IS A POINTER WORD WHOSE USE IS THE
;SAME AS THE FIRST WORD OF FILBUF.THE ENTRIES IN PRGBUF CONSIST
;OF A LIST OF RADIX50 SYMBOLS, ONE TO A WORD, TERMINATED BY
;A ZERO WORD.
;FUDGE2 WORKS WITH FILBUF AND PRGBUF IN TWO DISTINCTLY
;DIFFERENT WAYS: ONCE WHEN IT IS PROCESSING THE COMMAND STRING
;AND STORING THE VARIOUS FILE NAMES AND PROGRAM NAMES, AND
;ONCE WHEN IT IS USING THE INFORMATION IN THE FILES TO PROCESS
;A FUDGE COMMAND. WHEN A FILE NAME IS SEEN IN THE COMMAND STRING,
;THE STATUS OF THE PREVIOUS FILE IS CHECKED. IF THE PREVIOUS
;FILE HAD NO PROGRAM NAMES, THEN ITS POINTER WORD (3RD WORD) IS
;ZEROED OUT TO INDICATE THE ABSCENCE OF ANY PROGRAMS IN PRGBUF.
;OTHERWISE, PROCESSING BEGINS ON THE CURRENT FILE: THE FILE
;NAME, FILE NAME EXTENSION, AND CHANNEL NUMBER ARE STORED. THE
;CONTENTS OF THE POINTER WORD IN PRGBUF ARE STORED IN THE
;POINTER WORD OF THE FILE BLOCK
;ROOM IS LEFT IN FILBUF SO THAT WHEN THE CARRIAGE RETURN IS
;SEEN, FUDGE2 CAN SHUFFLE THE FIRST FILE BLOCK UP ONE WORD AND
;INSERT ANOTHER NULL. THE EFFECT OF THIS KLUDGE IS THAT WE NOW
;HAVE TWO SEPARATE LISTS IN FILBUF, A MASTER LIST, AND A
;TRANSACTION LIST.
GETDEV: MOVE B, FILBUF ;GET POINTER TO FILE BLOCK
SKIPN (B) ;END OF LIST? (ZERO TERMINATES)
POPJ P, ;YES, EXIT
MOVE A,PPNBUF ;GET POINTER TO PPN'S
MOVE D,(A) ;GET GLOBAL PPN
MOVEM D,DEFPPN ;SAVE AS DEFAULT PPN
MOVE D,1(A) ;GET TEMP. PPN
MOVEM D,PRJPRG ;SAVE AS TEMP. PPN
ADDI A,2 ;INCREMENT POINTER
MOVEM A,PPNBUF ;SAVE NEW POINTER
HRRZ D, 1(B) ;GET DEVICE NUMBER FOR THIS DEVICE
SKIPL 2(B) ;HAS A LOOKUUP BEEN DONE?
JRST GET3 ;NO, GO DO LOOKUP
GET0: MOVEI DIS, 3 ;SET UP AC DIS
IMUL DIS, D ;C(DIS) = 3*C(D)
HRRZ A, 2(B) ;GET POINTER TO PROGRAM NAMES
JUMPE A, GET1 ;NULL PROGRAM LIST (NO POINTER)?
AOS A, 2(B) ;NO, INCREMENT POINTER BY ONE
MOVE R, (A) ;GET A PROGRAM NAME
JUMPN R, CPOPJ1 ;END OF PROGRAM LIST?
ADDI B, 3 ;YES, INCREMENT FILBUF POINTER
MOVEM B, FILBUF ;SAVE NEW POINTER
JRST GETDEV ;TRY NEXT FILE BLOCK
GET1: MOVEI R, 0 ;NO PROGRAMS, RETURN ZERO
ADDI B, 3 ;MOVE FILBUF POINTER TO NEXT BLOCK
MOVEM B, FILBUF ;SAVE THE POINTER
CPOPJ1: AOSA (P) ;GOOD RETURN
POPOUT: POP P,(P) ;POP UP ONE LEVEL
CPOPJ: POPJ P, ;EXIT
GET3: DPB D, [POINT 4,GET3A,12]
XCT GET3A ;CLOSE CURRENT FILE BEFORE DOING...
MOVE A, (B) ;GET FILE NAME OF NEXT FILE
MOVEM A, EBLOCK ;SET UP FOR LOOKUP
HLLZ A, 1(B) ;GET FILE NAME EXTENSION
MOVEM A, EBLOCK+1 ;SAVE IT FOR LOOKUP
HRROS A, 2(B) ;SET FLAG IN LEFT HALF OF 3RD WORD
DPB D, [POINT 4,GET4A,12]
SKIPN A,PRJPRG ;GET TEMP. PPN
MOVE A,DEFPPN ;USE PERMANENT IF NO TEMP.
MOVEM A,EBLOCK+3 ;SAVE IT
MOVEM A,EBLOCK-1 ;FOR LEVEL D ALSO
MOVE A,DEVBUF(D) ;GET DEVICE
DEVCHR A, ;GET ITS CHARACTERISTICS
TLNN A,DSKBIT ;IF NOT A DSK
TDZA T,T ;NO EXTENDED LOOKUP
MOVE T,LEVEL ;GET LEVEL
GET4: XCT GET4A ;DO A LOOKUP ON NEW FILE
JRST .+3 ;NOT FOUND, TRY WITH BLANKS EXT.
SETZM EBLOCK+3 ;CLEAR PROJ-PROG
JRST DOENTR ;SUCCESSFUL RETURN FROM LOOKUP
HLRZ A, 1(B) ;GET THE FILE NAME EXTENSION
CAIE A, 624554 ;IS IT "REL" ?
JRST ERROR8 ;NO, DON'T GIVE HIM ANOTHER CHANCE
HLLM A, 1(B) ;YES, TRY LOOKUP WITH 0 EXTENSION
SETZM EBLOCK+1 ;CLEAR EXTENSION IN LOOKUP BLOCK
JRST GET4 ;TRY AGAIN
DOENTR: TLZN F,DEFENT ;ENTRY STILL TO DO?
JRST DOXSWT ;ENTER DONE ALREADY
MOVS T,[XWD EBLOCK,SVENTR]
BLT T,EBLOCK+1 ;RESTORE EBLOCK
MOVSI T,777000 ;MASK FOR PROTECTION
ANDM T,EBLOCK+2 ;CLEAR DATE AND TIME
SETZM EBLOCK-1 ;CLEAR PPN
MOVE T,LEVEL
XCT SEMIC1 ;DO ENTER
JRST [HRRZ T,EBLOCK+1 ;GET ERROR CODE
CAIN T,17 ;PARTIAL ALLOCATION ONLY?
JRST .+1 ;YES, JUST CONTINUE
JRST ERR14] ;ERROR
SETZM LEVEL ;NEVER AGAIN
DOXSWT: TRNE F,XFLG ;INDEX FLAG ON?
PUSHJ P,INDEX0 ;YES, SET UP POINTERS AND CORE
JRST GET0 ;AND CONTINUE
;SHORT ROUTINES TO STORE WORDS IN THE FILE BUFFER AND PROGRAM
;BUFFER
;ROUTINE PUTFIL STORES THE CONTENTS OF ACCUMULATOR S IN THE
;NEXT FREE LOCATION IN FILBUF. IT CHECKS FOR OVERFLOW.
PUTFIL: MOVE A, FILBUF ;GET POINTER WORD FOR FILBUF
AOBJP A, ERROR2 ;INCREMENT, CHECK FOR OVERFLOW
MOVEM A, FILBUF ;SAVE NEW POINTER
MOVEM S, (A) ;SAVE FILE NAME ENTRY
POPJ P, ;EXIT
;ROUTINE PUTPRG STORES THE CONENTS OF ACCUMULATOR S IN THE
;NEXT FREE LOCATION IN PRGBUF. IT CHECKS FOR OVERFLOW.
PUTPRG: MOVE A, PRGBUF ;GET POINTER WORD FOR BUFFER
AOBJP A, ERROR2 ;INCREMENT, CHECK FOR OVERFLOW
MOVEM A, PRGBUF ;SAVE NEW POINTER WORD
MOVEM S, (A) ;SAVE PROGRAM NAME
POPJ P, ;EXIT
;ROUTINE PUTPPN STORE THE TWO PPPN NUMBER IN PPNBUF
PUTPPN: MOVE A,PPNBUF ;GET POINTER WORD FOR BUFFER
AOBJP A,ERROR2
MOVEM A,PPNBUF ;SAVE NEW POINTER WORD
MOVEM S,(A) ;SAVE PPN
POPJ P, ;EXIT
SUBTTL ROUTINE TO INPUT ONE PROGRAM AT A TIME
;THE FIRST WORD THAT THE PROGRAM READS WILL BE A BLOCK HEADER.
;BLOCKS ARE READ UNTIL AN ENTRY BLOCK IS FOUND, AND THE ENTIRE
;ENTRY BLOCK IS STORED IN AN INTERNAL BUFFER,SIZE PERMITTING.
;FOLLOWING THAT, THE NAME BLOCK IS READ, AND THE NAME OF THE
;PROGRAM IS RETURNED IN ACCUMULATOR A. PROVISION IS MADE FOR
;BLOCKS OF WORD COUNT ZERO. THE SECTION OF CODING AROUND READ2
;DELIBERATELY OMITS THIS CHECK IN ORDER TO READ IN THE NEXT
;BLOCK HEADER WITH A MINIMUM OF INSTRUCTIONS. ORDINARILY, EACH
;PROGRAM WILL BEGIN WITH AN ENTRY BLOCK, BUT THE ROUTINE WILL
;ALSO ALLOW THE PROGRAM TO BEGIN WITH A NAME BLOCK IF NO
;ENTRY BLOCK IS SEEN.
READ: MOVEI C, ENTBLK ;SET UP POINTER TO BUFFER
READ6: JSR GETIN ;GET A BLOCK HEADER
HLRZ B, A ;GET THE BLOCK CODE
CAIN B,14 ;IS IT AN INDEX BLOCK?
JRST READX ;YES, GET RID OF IT
CAIN B, 4 ;IS IT AN ENTRY BLOCK?
JRST READ1 ;YES, PROCESS IT
CAIN B, 6 ;IS IT A NAME BLOCK?
JRST READ7 ;YES, PROCESS IT
CAIE B,401 ;SPECIAL MANTIS BLOCK (F4)?
CAIN B,400 ;F4 SIGNAL WORD?
JRST F4I ;YES, PROCESS F4 BLOCKS
CAIN B,5 ;END BLOCK?
JRST ENDBLK ;YES
CAIL B,100 ;TEST FOR LEGAL BLOCK TYPES
JRST ERR26 ; THESE ARE CLEARLY NOT
PUSHJ P, COUNT ;CALCULATE SIZE OF BLOCK
JUMPE B, READ6 ;WORD COUNT OF ZERO?
READ6A: CAML B, IBUF+2(DIS) ;DOES BLOCK OVERLAP IO BUFFERS?
JRST READ6B ;ADJUST B AND GET ANOTHER BUFFER
MOVE A, IBUF+2(DIS) ;NO, DIDDLE BUFFER HEADER COUNT
SUB A, B ;ELIMINATE BLOCK OF LENGTH C(B)
MOVEM A, IBUF+2(DIS) ;PUT NEW WORD COUNT BACK
ADDM B, IBUF+1(DIS) ;MOVE BYTE POINTER PAST BLOCK
JRST READ6 ;GET NEXT BLOCK
READ6B: SUB B, IBUF+2(DIS) ;ACCOUNT FOR REST OF THIS BUFFER
SETZM IBUF+2(DIS) ;FORCE ANOTHER INBUF
JSR GETIN ;GET ANOTHER BUFFER OF INPUT
JRST READ6A ;CHECK AGAIN
;CODE MODIFIED TO HANDLE MORE THAN ONE ENTRY BLOCK.
;FAIL AND SAIL BOTH ISSUE MULTIPLE ENTRY BLOCKS.
SIZZ==SIZE-<<SIZE+21>/22>-4 ;ACCOUNT FOR HDR BLKS, RELOC WDRS, PROGNAME
READ1: SETZM ENTBLK ;SAME AS (C) AT PRESENT
HRLI C,-1 ;AOBJN WILL OVERFLOW FIRST TIME
TRNE A,-1 ;TEST FOR ZERO WORD COUNT
JRST READ2 ;NO
JSR GETIN ;YES, THROW AWAY RELOCATION WORD
ADDI C,1 ;UPDATE INSERT COUNTER
SETZB A,(C) ;ENTRY BLOCK RELOCATION IS ALWAYS ZERO
;BACK HERE FOR EACH NEW BLOCK
READ2: MOVNI B,400000(A) ;-1 IN LH, 377777-CT IN RH
HRRZS A
ADD A,ENTBLK ;NEW COUNT IF IT FITS
CAILE A,SIZZ ;TOO MUCH NOW?
TROA F,ERRB ;YES, MARK ENTRY BLOCK TOO BIG
MOVEM A,ENTBLK ;NO, UPDATE USED COUNT
;HERE FOR EACH NEW WORD
READ23: TRNN B,377777 ;END OF LOADER BLOCK?
JRST READ55 ;YES, CHECK NEXT
AOBJN B,NXTWRD ;TIME FOR SOME RELOC BITS?
JSR GETIN ;YES, GET THEN AND TOSS THEM AWAY
HRLI B,-22 ;AND RESET COUNT
NXTWRD: JSR GETIN ;GET A DATA WORD
;ROUTINE TAKEN FROM LOADER
AOBJN C,READ22 ;NEED TO INSERT RELOC WORD?
TRNN F,ERRB ;YES, UNLESS NOT INSERTING
SETZM (C) ;ALL ENTRY RELOCS ARE 0
ADD C,[-22,,1] ;LH 0 BEFORE ADD, SET UP NEXT
READ22: TRNN F,ERRB ;ARE WE INSERTING?
MOVEM A,(C) ;YES, PUT IT AWAY
JRST READ23 ;LOOP
READ55: JSR GETIN ;GET NEXT HEADER WORD
HLRZ B,A ;TYPE
CAIN B,4 ;ANOTHER ENTRY?
JRST READ2 ;YES, STORE IT
;PROGRAM NAME - FINISH ENTRY OUT
MOVEI B,4 ;ENTRY BLOCK TYPE
HRLM B,ENTBLK ;NOW CORRECT TYPE,,COUNT
HRLI C,0 ;CLEAR LH COUNT
AOJA C,READ7 ;STORE NAME BLOCK HEADER AND CONTINUE
READ7: MOVEM A, (C) ;STORE NAME BLOCK HEADER
ADDI C,1
READ5: PUSHJ P, COUNT ;CALCULATE SIZE OF BLOCK
JUMPE B, READ9 ;WORD COUNT OF ZERO?
READ3: JSR GETIN ;GET A WORD
MOVEM A, (C) ;STORE IT
AOJ C, ;INCREMENT BUFFER POINTER
SOJG B, READ3 ;DONE READING YET?
CAIN G+1, 2 ;IS THERE A COMMON WORD?
MOVE A, -2(C) ;GET PROGRAM NAME IN A
JUMPE A, READ9 ;IGNORE WORD OF ZERO
MOVE B, A ;GET RID OF EXTRA BLANKS
READ8: IDIVI B, 50 ;TRY DIVIDING IT BY 50
JUMPN B+1, READ9 ;FILTERED OUT ALL THE BLANKS?
MOVE A, B ;NO, STORE SYMBOL AGAIN
JRST READ8 ;TRY ANOTHER DIVISION
READ9: TRNE F, ERRB ;ERROR CONDITION?
JRST ERR10 ;YES
TRNN F,XFLG ;INDEX FLAG ON?
JRST CPOPJ1 ;NO, SKIP EXIT
JRST INDEX1 ;YES SAVE ENTRIES
F4I: TRO F,F4IB ;DONT OUTPUT DURING F4 SEARCH
PUSH P,C ;SAVE ENTRY BLOCK
PUSHJ P,F4 ;PASS F4 BLOCKS
POP P,C ;RESTORE ENTRY BLOCK
TRZ F,F4IB ;TURN OFF IGNORE BIT
HRRZM C,END1 ;FORTRAN CANNOT DO ANY BETTER
SETZM END2 ;CLEAR FIRST TIME FLAG
JRST READ6 ;GO PROCESS NEXT PROGRAM
ENDBLK: PUSHJ P,COUNT ;GET SIZE OF BLOCK
SETZM END1 ;CLEAR STORAGE
SETZM END2
SOJE B,READ6 ;SHOULD N'T BE
JSR GETIN ;GET RID OF BYTE WORD
JSR GETIN ;GET FIRST END WORD
HRLZM A,END1 ;STORE IT
SOJE B,READ6 ;ONLY ONE WORD?
JSR GETIN ;NO
HRLZM A,END2 ;STORE 2ND
SOJE B,READ6 ;SHOULD BE END
JRST READ6A ;JUST IN CASE
READX: TLON F,NOWARN ;DO WE WANT A MESSAGE?
TTCALL 3,[ASCIZ /%WARNING! NO INDEX ON OUTPUT FILE - CONTINUING
/]
SETZM IBUF+2(DIS) ;FORCE ANOTHER INBUF
JSR GETIN ;INPUT THE NEXT BLOCK
JRST READ6+1 ;AND RETURN TO CODE
SUBTTL ROUTINE TO OUTPUT ONE PROGRAM AT A TIME
;THE WRITE SUBROUTINE WILL OUTPUT AN ENTIRE BINARY RE-
;LOCATABLE PROGRAM AS WRITTEN BY MACRO6. IT ASSUMES THAT THE
;ENTRY BLOCK AND NAME BLOCK FOR THE PROGRAM ARE IN THE
;INTERNAL BUFFER ENTBLK, AND OUTPUTS THESE BEFORE PICKING UP
;MORE BLOCKS FROM THE CURRENT INPUT DEVICE. BLOCKS ARE READ
;AND WRITTEN UNTIL THE END BLOCK HAS BEEN PROCESSED. PROVISION I
;IS MADE FOR BLOCKS WITH A WORD COUNT OF ZERO.
WRITE: SUBI C, ENTBLK ;GET COUNT OF ENTRY BLOCK
JUMPE C, WRITE3 ;NOTHING TO OUTPUT?
MOVEI B, ENTBLK ;GET A POINTER IN B
WRITE2: MOVE A, (B) ;GET A BINARY WORD
PUSHJ P, OUT ;OUTPUT IT
AOJ B, ;INCREMENT POINTER
SOJG C, WRITE2 ;KEEP GOING UNTIL BUFFER EMPTY
WRITE3: JSR GETIN ;GET A BLOCK HEADER
HLRZ B,A ;GET THE BLOCK TYPE CODE ***VJC
TRNN F,NOLOCB ;DELETE LOCAL SYMBOLS? ***VJC
JRST .+3 ;NO
CAIN B,2 ;IS IT A SYMBOL BLOCK? ***VJC
JRST DELLOC ;GO DELETE LOCAL SYMBOL ***VJC
;COME BACK TO WRITE3 ***VJC
;UNLESS EXIT ON END-OF-FILE ***VJC
PUSHJ P, OUT ;OUTPUT IT
CAIE B, 401 ;SPECIAL MANTIS F4?
CAIN B, 400 ;IS THIS A FORTRAN IV SIGNAL WORD?
JRST F4 ;YES, PROCESS F4 OUTPUT
MOVEM B, SAVEBT ;SAVE THE BLOCK TYPE
PUSHJ P, COUNT ;NO, GET SIZE OF BLOCK
JUMPE B, WRITE3 ;WORD COUNT OF ZERO?
WRITE4: JSR GETIN ;OUTPUT THE BLOCK
PUSHJ P, OUT ;...
SOJG B, WRITE4 ;LOOP BACK UNTIL DONE
MOVE A, SAVEBT ;RETRIEVE THE BLOCK TYPE
CAIE A, 5 ;WAS IT AN END BLOCK?
JRST WRITE3 ;NO, RETURN FOR MORE BLOCKS
POPJ P, ;YES, EXIT
;THE COUNT SUBROUTINE CALCULATES THE LENGTH OF THE VARIOUS
;BLOCKS READ BY THE WRITE AND READ SUBROUTINES. THE POSITIVE
;WORD COUNT IS FOUND IN THE RIGHT HALF OF THE ENTRY BLOCK
;HEADER, WHICH IS ASSUMED TO BE IN AC A UPON ENTERING. THE
;LENGTH WILL BE RETURNED IN AC B, AND INCLUDES THE DATA WORDS
;(SYMBOLS, ENTRY WORDS, ETC.) AND THE SUBHEADERS, OF WHICH
;THERE IS ONE FOR EVERY 18 (DECIMIAL) DATA WORDS. THE BLOCK
;HEADER IS DESTROYED, AND IS NOT INCLUDED IN THE LENGTH.
COUNT: HRRZ G, A ;GET NUMBER OF WORDS
IDIVI G, 22 ;1SUBHEADER/18 DATA WORDS
ADDI G,(A) ;ADD INTO WORD COUNT
JUMPE G+1,.+2 ;1 EXTRA SUBHEADER FOR
AOJ G, ;STRAY ONES
MOVE B, G ;RESULTS IN AC B
POPJ P, ;EXIT
SUBTTL ROUTINE TO HANDLE FORTRAN OUTPUT
;SUBSECTION OF THE WRITE ROUTINE TO HANDLE OUTPUT FROM THE
;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
;LOOK FOR THE END BLOCK. OTHER BLOCKS ARE MERELY COPIED OUT.
;THE BLOCK TYPES ARE GIVEN BY THE FOLLOWING TABLE
;----------------------------------------------------------------
;BITS 0-17 BITS18-23 BITS 24-35 TYPE
;777777 70 N DATA STATEMENT
;777777 50 N ABSOLUTE MACHINE CODE
;777777 77 N MANTIS DATA
;777777 0 - PROGRAMMER LABELS
;777777 31 - MADE LABELS
;777777 60 - ENTRY LABELS
;777777 777776 END BLOCK
;-----------------------------------------------------------------
F4: JSR GETIN ;GET A FORTRAN IV BLOCK HEADER
PUSHJ P, OUT4 ;OUTPUT IT
TLC A, -1 ;TURN ONES TO ZEROES IN LEFT HALF
TLNE A, -1 ;NO, WAS LEFT HALF ALL ONES?
JRST F4 ;NO, IT WAS CALCULATED MACHINE CODE
CAIN A, -2 ;YES, IS RIGHT HALF = 777776?
JRST ENDST ;YES, PROCESS F4 END BLOCK
LDB B, [POINT 6,A,23];GET CODE BITS FROM BITS 18-23
TRZ A, 770000 ;THEN WIPE THEM OUT
CAIE B, 70 ;IS IT A DATA STATEMENT?
CAIN B, 50 ;IS IT ABSOLUTE MACHINE CODE?
JRST MACHCD ;YES, TREAT IT LIKE DATA STATEMENTS
CAIN B, 77 ;SPECIAL MANTIS DEBUGGER DATA?
JRST MACHCD ;YES, TREAT IT LIKE DATA
JSR GETIN ;NO, ITS A LABEL OF SOME SORT
PUSHJ P, OUT4 ;WHICH CONSISTS OF ONE WORD
JRST F4 ;LOOK FOR NEXT BLOCK HEADER
MACHCD: HRRZ B, A ;GET THE WORD COUNT IN AC B
JSR GETIN ;INPUT A WORD
PUSHJ P, OUT4 ;OUTPUT IT
SOJG B, MACHCD ;LOOP BACK FOR REST OF THE BLOCK
JRST F4 ;GO LOOK FOR NEXT BLOCK
ENDST: MOVEI B,1 ;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
MOVEI C,6 ;TO GO
F4LUP1: JSR GETIN ;GET TABLE MEMBER
F4LUP3: PUSHJ P,OUT4 ;OUTPUT WORD
SOJGE B,F4LUP1 ;LOOP WITHIN A TABLE
JUMPL C,CPOPJ ;LAST TABLE - RETURN
SOJG C,F4LUP2 ;FIRST TWO WORDS AND FIVE TABLES
JUMPE C,F4LUP1 ;COMMON LENGTH WORD
F4LUP2: JSR GETIN ;READ HEADER WORD
MOVE B,A ;COUNT TO COUNTER
JRST F4LUP3 ;STASH
OUT4: TRNN F,F4IB ;DONT DO OUTPUT?
PUSHJ P,OUT ;YES, DO OUTPUT
POPJ P, ;RETURN
SUBTTL ROUTINE TO DELETE LOCAL SYMBOLS FROM SYMBOL BLOCK
;ALL LOCAL AND SUPPRESSED LOCAL SYMBOLS ARE DELETED
;EXTERNALS,INTERNAL AND SUPPRESSED INTERNALS ARE NOT DELETED.
DELLOC: HRRZM A,BSZ ;SIZE OF SYMBOL BBLE
PUSHJ P,DELINI ;CLEAR NEW HEADER & RELOC WORDS
;SET PB = SYMBLK+2
DELGTR: JSR GETIN ;GET RELOCATION WORD
MOVEM A,RELOCS ;SAVE IT
MOVE A,PTGR ;INIT POINTER TO GET
MOVEM A,PTGRS ;RELOCATION WORD
DELGT1: JSR GETIN ;GET FIRST WORD OF PAIR
ILDB 0,PTGRS ;GET RELOCATION BITS & HOLD
TLNE A,(1B2) ;IS SYMBOL LOCAL?
JRST DELDEC ;YES, DON'T COPY
MOVEM A,0(T) ;STORE FIRST WORD
JSR GETIN ;GET SECOND WORD INTO A
MOVEM A,1(T) ;STORE SECOND WORD
IDPB 0,PTSRS ;STORE RELOCATION BITS
MOVEI A,2 ;COUNT WORDS STORED
ADDM A,SYMBLK ;I.E. UPDATE WORD COUNT
ADDI T,2 ;UPDATE NEXT LOCATION TO STORE
MOVE A,PTSRS ;HAVE WE STORED 9
TLNN A,770000 ;SYMBOL PAIRS?
PUSHJ P,DELWRT ;YES, WRITE IT OUT
JRST DELDEC+1 ;ALREADY HAVE 2ND WORD
DELDEC: JSR GETIN ;GET SECOND WORD INTO A
SOS BSZ ;HAVE WE EXHAUSTED
SOSG BSZ ;ALL WORDS IN BLOCK?
JRST DELFIN ;YES, NONE LEFT
MOVE A,PTGRS ;HAVE WE GOT 9
TLNE A,770000 ;SYMBOL PAIRS YET?
JRST DELGT1 ;NO, GET NEXT PAIR
JRST DELGTR ;YES, GET RELOCATION
DELFIN: PUSHJ P,DELWRT ;ORIGINAL BLOCK EMPTY NOW
JRST WRITE3 ;GET NEXT BLOCK
SUBTTL ROUTINE TO WRITE OUT NEW SYMBOL BBLE
DELWRT: SKIPN A,SYMBLK ;ANYTHING TO WRITE
JRST DELINI ;NO, CAN LEAVE
HRRZ 0,A ;GET WORD COUNT
HRLI A,2 ;PUT IN BLOCK TYPE
PUSHJ P,OUT ;WRITE BLOCK HEADER
MOVEI B,SYMBLK ;LOC OF FIRST WORD
DELWRU: ADDI B,1 ;LOC OF RELOC WORD
MOVE A,0(B) ;GET WORD
PUSHJ P,OUT ;OUTPUT
SOJGE 0,DELWRU ;ALL THROUGH?
;ROUTINE TO INITIALIZE NEW SYMBOL BBLE
DELINI: SETZM SYMBLK ;YES, CLEAR COUNT
SETZM SYMBLK+1 ;CLEAR RELOCATION
MOVE A,PTSR ;INIT POINTER
MOVEM A,PTSRS ;FOR STORING NEW RELOC
MOVEI T,SYMBLK+2 ;SET TO STORE FIRST GLOBAL
POPJ P,
SUBTTL ROUTINES TO INDEX THE LIBRARY
COMMENT * THE INDEXING OF LIBRARY FILES IS DONE IN TWO PASSES.
ON PASS 1 THE LIBRARY FILE IS COPIED AND ALL ENTRIES STORED
IN CORE ALLONG WITH A POINTER TO THE BEGINING OF THE BLOCK.
A DUMMY INDEX BLOCK (TYPE 14) IS OUTPUT AT THE BEGINING OF THE
NEW LIBRARY AND ONE IS OUTPUT WHENEVER THE CURRENT INDEX BLOCK
FILLS A BUFFER.
ON PASS 2 THE DUMMY INDEX BLOCKS ARE REPLACED BY REAL ONES.
FUDGE2 USED USETO'S AND DUMP MODE.
IF THE OUTPUT DEVICE IS DTA FUDGE2 USES UGETF UUO'S TO FIND
THE NEXT BLOCK AND NON-STANDARD DUMP MODE TO WRITE THE INDICES.
DESIGN AND CODING BY D.M.NIXON JULY 1970
*
INDEX0: MOVE A,INDEXH ;BLOCK HEADER
TRNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
TRNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
AOS BLKCNT ;START ON BLOCK #1
PUSHJ P,OUT1 ;OUTPUT IT
OUTPUT 1, ;FORCE OUTPUT
MOVE T,OBUF+5 ;BUFFER SIZE
MOVEM T,XCOUNT
MOVEM T,BUFSIZ ;SAVE IT AWAY
AOS OBUF+5 ;COUNT IS OUT BY ONE BECAUSE OF OUTPUT UUO
AOS T,.JBREL ;TO GET 1K MORE
MOVEM T,XPNTR
MOVEM T,XBEG ;START OF INDEX BUFFERS
CORE T,
JRST ERR22 ;NOT ENUF CORE
MOVEI A,1 ;START ON BLOCK #1 (IF DSK)
MOVEM A,@XPNTR ;STORE FIRST BLOCK #
AOS XPNTR
MOVE A,INDEXH
MOVEM A,@XPNTR
AOS XPNTR
SOS XCOUNT
SOS XCOUNT ;RESERVE SPACE FOR NEXT LINK WORD
POPJ P, ;RETURN
;HERE ON PASS 1 TO STORE ENTRIES AND POINTERS.
INDEX1: AOS (P) ;SET SKIP RETURN
HRRZ T,ENTBLK ;GET SIZE OF BLOCK
MOVN A,T
ADDI T,1 ;WORD OF INFO
CAML T,XCOUNT ;ENUF ROOM IN BLOCK?
JRST NOROOM ;NO
MOVE T,ENTBLK ;GET HEADER WORD
MOVEM T,@XPNTR
AOS XPNTR
SOS XCOUNT
HRLS A
HRRI A,ENTBLK+1
INDEXA: SKIPN T,(A)
AOJA A,.-1
MOVEM T,@XPNTR
SOS XCOUNT
AOS XPNTR
AOBJN A,INDEXA
INDEX2: MOVE T,BUFSIZ
SUB T,OBUF+5
HRLI T,1(T) ;WORD COUNT IS CORRECT FOR LOADER
HRR T,BLKCNT
MOVEM T,@XPNTR
SOS XCOUNT
AOS XPNTR
POPJ P,
;HERE WHEN CURRENT INDEX BLOCK IS FULL.
NOROOM: MOVE A,INDEXH ;HEADER BLOCK OF INDEX FOR LOADER
TRNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
PUSHJ P,OUTGO
OUTPUT 1,
AOS OBUF+5 ;COUNT IS OUT BY ONE BECAUSE OF OUTPUT UUO
MOVE T,BLKCNT ;GET INDEX BLOCK #
HRROM T,@XPNTR ;STORE IT WITH -1 IN LEFT HALF
MOVE A,XCOUNT ;PART OF BLOCK NOT FILLED
ADDB A,XPNTR ;START OF NEW BLOCK
ADD A,BUFSIZ ;ENSURE NEXT BUFFER WILL FIT IN CORE
CAMG A,.JBREL ;WILL IT?
JRST .+3 ;YES
CORE A, ;GET ENOUGH CORE
JRST ERR22 ;NOT ENOUGH CORE
MOVE A,BUFSIZ
MOVEM A,XCOUNT
;MARK IT AS AN INDEX INCASE BLOCK FULL
HRROM T,@XPNTR ;SAVE BLOCK # FOR PASS 2
AOS XPNTR
TRNN F,DTAFLG ;NOT IF DTA
AOS BLKCNT ;ONE FOR OUTPUT
MOVE A,INDEXH
TRNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
MOVEM A,@XPNTR
AOS XPNTR
SOS XCOUNT
SOS XCOUNT ;SPACE FOR LINK WORD TO NEXT INDEX
JRST INDEX1+1
;HERE FOR PASS 2. WRITE OUT THE INDEX BLOCKS
INDEX3: SETOM @XPNTR ;TERMINATE WITH END OF INDEX MARKER
OUTPUT 1, ;SO LAST BLOCK IS WRITTEN
TRNE F,DTAFLG ;IS IT DTA?
JRST INDEX5 ;YES, TREAT DIFFERENTLY
SETSTS 1,16
MOVNI A,200
HRLM A,XBEG
INDEX4: SETZM XBEG+1
MOVE A,@XBEG
USETO 1,(A)
OUTPUT 1,XBEG
STATZ 1,760000
JRST ERR15
MOVEI A,200
ADDB A,XBEG
HRRZS A
CAMG A,XPNTR
JRST INDEX4
JRST EXIT
INDEX5: CLOSE 1, ;AND A SEPARATE EOF BLOCK
SETSTS 1,116 ;NONE STANDARD MODE
MOVNI A,200 ;IOWD COUNT
HRLM A,XBEG ;SET IT UP FOR OUTPUT
USETI 1,@BLKCNT ;SET ON LAST BLOCK
INPUT 1,DIRIOW ;READ IT IN
LDB A,[POINT 10,DIRBLK,27] ;GET FIRST BLOCK #
HRRM A,@XBEG ;STORE IT FOR COMMON LOOP
SETZM XBEG+1 ;MAKE SURE IT'S ZERO
INDEX6: MOVE A,@XBEG ;GET BLOCK NUMBER
USETI 1,(A) ;SET FOR INPUT
INPUT 1,DIRIOW ;INPUT BLOCK
MOVE T,DIRBLK ;TO FIND LINK WORD
EXCH T,@XBEG ;PUT IT IN OUTPUT BLOCK
SOS XBEG ;BACK UP POINTER
USETO 1,(A) ;NOW FOR OUTPUT
OUTPUT 1,XBEG ;OUT IT GOES
STATZ 1,760000 ;UNLESS IN ERROR
JRST ERR15 ;DEVICE ERROR
MOVEI A,200 ;GET TO NEXT DUMP BLOCK
ADDB A,XBEG ;ADVANCE POINTER
HRRZS A ;JUST WORD LOCATION
CAMG A,XPNTR ;ALL DONE?
JRST INDEX6 ;NO, LOOP
SETSTS 1,16 ;BACK TO STANDARD MODE TO UPDATE DIR.
JRST EXIT ;YES, FINISH UP
INDEXH: XWD 14,177 ;USED TO SIGNAL INDEX BLOCK TO LOADER
SUBTTL INPUT SERVICE ROUTINE
;THE INPUT ROUTINE GETS CHARACTERS FROM THE DEVICE WHOSE
;CHANNEL NUMBER IS IN ACCUMULATOR D. IT CALCULATES THE POSITION
;OF THE BUFFER HEADER OF THE DEVICE, THEN EITHER LOADS AC A
;FROM THE BYTE POINTER, OR DOES AN INPUT. IF AN END OF FILE
;IS FOUND, THE ROUTINE EXITS WITH A POPJ, SINCE THE READ ROUTINE
;IS CALLED WITH A PUSHJ, FOLLOWED BY AN EOF RETURN. THE NORMAL
;EXIT FROM GETIN IS BY A JRST @GETIN.
GETIN: SOSG IBUF+2(DIS) ;IS APPROPRIATE BUFFER EMPTY?
JRST INGET ;YES, GET ANOTHER BUFFER
GETIN1: ILDB A, IBUF+1(DIS) ;LOAD AC A WITH A CHARACTER
POPJ P,
INGET: DPB D,[POINT 4,INGET2,12]
DPB D,[POINT 4,INGET3,12]
JRST INGET2 ;INPUT A BUFFER OF DATA
;OUTPUT SERVICE ROUTINE
;THE OUT ROUTINE CHECKS THE TTYOB FLAG TO SEE IF THE OUTPUT
;SHOULD BE ON THE TTY. IF SO, IT TRANSFERS CONTROL IMMEDIATELY.
;OTHERWISE, IT ASSUMES OUTPUT IS ON DEVICE #1.
OUT: TRNN F, TTYOB ;SHOULD OUTPUT BE ON TTY?
JRST TYPO ;YES
OUT1: SOSG OBUF+5 ;IS OUTPUT BUFFER EMPTY?
JRST OUTGO ;YES, OUTPUT A BUFFER
OUT2: IDPB A, OBUF+4 ;DEPOSIT CHARACTER
POPJ P, ;EXIT
OUTGO: TRNN F,XFLG ;IF NOT INDEXING
JRST OUTG ;DON'T WASTE TIME
TRNN F,DTAFLG ;IF DTA SKIP
AOSA BLKCNT ;INCR. COUNT IF DSK
UGETF 1,BLKCNT ;GET NEXT BLOCK IF DTA
OUTG: OUT 1, ;OUTPUT A BUFFER
JRST OUT2 ;NO ERRORS
JRST ERR15 ;GO TO ERROR ROUTINE
SUBTTL ROUTINE TO HANDLE ASTERISK FILE NAME *.EXT
;THE DIRECTORY IS SEARCHED FOR FILE NAMES WITH GIVEN EXTENSION OR
;EXTENSION REL IF NONE SPECIFIED. THESE ARE STORED IN FILBUF
;ENTERED BY JRST FROM SEMICP
;EXIT BY POPJ
;DMN 23 MAY 1969
ASTRSK: MOVE B,COLON2 ;GET DEVICE LAST SEEN
MOVEM B,DSKINI+1 ;SAVE IT IN CASE DSK
DEVCHR B, ;GET ITS CHARACTERISTICS
TLNE B,DTABIT ;IS IT A DTA
JRST DTAAST ;YES
TLNN B,DSKBIT ;IS IT THE DSK?
JRST ERR18 ;MUST BE ONE OR THE OTHER
;FALL INTO DSKAST IF OK
DSKAST: PUSH P,.JBFF ;SAVE OLD JOBFF
MOVEI B,DSKHDR ;WHERE BUFFER WILL GO
MOVEM B,.JBFF ;SET IT UP
OPEN 17,DSKINI ;17 IS SAFEST CH.NO.
JRST ERR19 ;CONNOT INIT DSK
INBUF 17,1 ;FORCE SINGLE BUFFERING
MOVE B,COLON2 ;GET DEVICE
DEVPPN B, ;GET PROJ-PROG INCASE SYS: ETC.
GETPPN B, ;FAILED, GET USER PROJ,PROG PAIR
MOVEM B,EBLOCK ;SAVE IT FOR LOOKUP OF UFD
MOVSI B,(SIXBIT/UFD/) ;EXTENSION
MOVEM B,EBLOCK+1
MOVE B,[XWD 1,1] ;TO GET UFD ***VJC
MOVEM B,EBLOCK+3 ;ENTRY BLOCK SET UP
LOOKUP 17,EBLOCK ;DO LOOKUP
JRST ERR20 ;CANNOT DO IT
DSKLUP: PUSHJ P,DSKINP ;INPUT A WORD
MOVEM S,SAVNAM ;SAVE NAME FOR LATER
PUSHJ P,DSKINP ;GET EXT AS WELL
HLLZM S,SAVEXT ;SAVE EXT, CLEAR RH ***VJC
SKIPN SAVNAM ;IS THERE A NAME
JRST DSKLUP ;NO GET NEXT PAIR
CAME EXT,SAVEXT ;EXTENSIONS MATCH
JRST DSKLUP ;NO GET NEXT PAIR
PUSHJ P,STNULL ;CLOSE OUT OLD FILE
MOVE S,SAVNAM ;RECALL NAME
PUSHJ P,PUTFIL ;STORE IT IN FILBUF
MOVE S,SAVEXT ;RECALL EXTENSION
PUSHJ P,PUTFIL
HRRM D,(A) ;GET CHANNEL
HRRZ S,PRGBUF ;POINTER TO PRGBUF
PUSHJ P,PUTFIL ;SAVE IT AS 3RD WORD
JRST DSKLUP ;GO LOOP ROUND ALL
;ROUTINE TO GET NEXT WORD FROM UFD
DSKINP: SOSGE DIRBUF+2 ;USUAL INPUT ROUTINE
JRST DSKIN1 ;GET ANOTHER BUFFER
ILDB S,DIRBUF+1 ;GET A WORD
POPJ P, ;RETURN
DSKIN1: IN 17,0 ;DO INPUT
JRST DSKINP ;NO ERRORS
STATO 17,20000 ;END OF FILE?
JRST ERR21 ;NO, READ ERROR
FIN: POP P,.JBFF ;POP UP ONE LEVEL
POP P,.JBFF ;RESTORE JOBFF
POPJ P, ;RETURN TO COMMAND SCAN
DTAAST: LDB B,[POINT 4,COLON1,12] ;GET CHANNEL
DPB B,[POINT 4,DP+0,12] ;DEPOSIT IT
DPB B,[POINT 4,DP+1,12]
DPB B,[POINT 4,DP+2,12]
DPB B,[POINT 4,DP+3,12]
DPB B,[POINT 4,DP+5,12]
SETZ B, ;INITIAL CONDITION
JRST DP ;INPUT DIRECTORY
DTALUP: CAIL B,26 ;END OF DIRECTORY
POPJ P, ;YES- FINISHED
HLLZ S,DIREXT(B) ;GET EXTENSION
SKIPE DIRNAM(B) ;IF NAME ZERO DON'T BOTHER
CAME S,EXT ;IS EXTENSION SAME
AOJA B,DTALUP ;NO GET NEXT ENTRY
PUSHJ P,STNULL ;TERMINATE LAST ENTRY
MOVE S,DIRNAM(B) ;GET NAME
PUSHJ P,PUTFIL ;STORE IT IN FILBUF
HLLZ S,DIREXT(B) ;AND EXTENSION
PUSHJ P,PUTFIL ;STORE IT
HRRM D,(A) ;SAVECH.
HRRZ S,PRGBUF ;SAVE PRGBUF POINTER
PUSHJ P,PUTFIL ;STORE IT
AOJA B,DTALUP ;GET NEXT ENTRY
SUBTTL ERROR ROUTINES
ERROR1: MOVEI B, EMES1 ;FUDGE COMMAND ERROR
JRST ERROR ;TYPE IT AND EXIT
ERR1A: MOVEI B, EMES1A
JRST ERROR
ERROR2: MOVEI B, EMES2 ;TOO MANY PROGRAM NAMES
JRST ERROR ;TYPE IT AND EXIT
ERROR3: MOVEI B, EMES3 ;FUDGE SYSTEM ERROR
JRST ERROR ;TYPE A MESSAGE AND EXIT
ERROR4: PUSHJ P, DTYPOQ ;TYPE DEVICE NAME
MOVEI B, EMES4 ;"CANNOT DO IO AS REQUESTED"
JUMPN G,ERROR ;TYPE IT
MOVEI B,EMES24 ;NO SUCH DEVICE IF G=0
JRST ERROR ;TYPE IT AND EXIT
ERROR5: MOVEI B, EMES5 ;UNEQUAL NUMBER OF MASTER AND TR.
JRST ERROR ;TYPE IT AND EXIT
ERROR6: MOVEI B, EMES6 ;NOT ENOUGH ARGUMENTS
JRST ERROR ;TYPE IT AND EXIT
ERROR7: PUSHJ P, DTYPOQ ;TYPE OUT THE DEVICE NAME
MOVEI A, 72 ;ASCII COLON
PUSHJ P, TYPO ;TYPE IT OUT
JUMPN R,.+3 ;IF PROG NAME IS 0
MOVNI A,3 ;FILBUF HAS BEEN ADVANCED TOO FAR
ADDM A,FILBUF ;SO BACK IT UP
PUSHJ P, FTYPO ;TYPE OUT THE FILE NAME
MOVEI A, 56 ;ASCII PERIOD
PUSHJ P, TYPO ;TYPE IT OUT
HRRZ A, FILBUF ;GET THE POINTER TO CURRENT FILE
HLRZ S, 1(A) ;GET FILE NAME EXTENSION
PUSHJ P, DTYPO1 ;TYPE IT OUT
MOVEI A, 74 ;ASCII LEFT ANGLE BRACKET
PUSHJ P, TYPO ;TYPE IT OUT
MOVE B, R ;GET PROGRAM NAME
TRZ F, TTYOB ;SET IO BACK TO TTY
PUSHJ P, PTYPO ;TYPE OUT THE PROGRAM NAME
MOVEI A, 76 ;ASCII RIGHT ANGLE BRACKET
PUSHJ P, TYPO ;TYPE IT OUT
MOVEI B, EMES7 ;GET AN ERROR MESSAGE
JUMPN R,ERROR ;CAN NOT FIND PROG
MOVEI B, EMES7A ;ZERO PROG SPECIFIED
JRST ERROR ;TYPE IT OUT AND EXIT
ERROR8: PUSHJ P, DTYPOQ ;TYPE OUT THE DEVICE NAME
MOVEI A, 72 ;ASCII COLON
PUSHJ P, TYPO ;TYPE IT OUT
PUSHJ P, FTYPO ;TYPE OUT FILE NAME
MOVEI A, 56 ;ASCII PERIOD
PUSHJ P, TYPO ;TYPE IT OUT
HRRZ A, FILBUF ;GET THE POINTER TO CURRENT FILE
HLRZ S, 1(A) ;GET FILE NAME EXTENSION
PUSHJ P, DTYPO1 ;TYPE IT OUT
MOVE T,SDEVCHR ;GET CHARACTERISTICS
TLNE T,DSKBIT ;IS IT A DSK?
JRST ERR8A ;YES
MOVEI B, EMES7 ;GET ERROR MESSAGE "NOT FOUND"
JRST ERROR ;TYPE IT OUT AND EXIT
ERROR9: PUSHJ P, DTYPOQ ;TYPE DEVICE NAME
MOVEI B, EMES9B ;GET REMAINDER OF MESSAGE
JRST ERROR ;TYPE IT AND EXIT
ERR10: MOVE C, A ;SAVE PROGRAM NAME IN C
MOVEI B, EMES10 ;"ENTRY BLOCK TOO LARGE, PROGRAM"
PUSHJ P, ETYPO ;TYPE BEGINNING OF MESSAGE
MOVE B, C ;GET PROGRAM NAME IN B
PUSHJ P, PTYPO ;TYPE IT OUT
JRST EXIT1 ;EXIT
ERR11: MOVEI B, EMES11 ;TRANSMISSION ERROR ON INPUT
PUSHJ P, ETYPO ;TYPE THE MESSAGE
PUSHJ P, DTYPO ;TYPE NAME OF OFFENDIN DEVICE
MOVEI A,":"
PUSHJ P,TYPO
MOVEI B,EMS15A ;REST OF MESSAGE
PUSHJ P,ETYPO
MOVE B,[GETSTS ,B]
DPB D,[POINT 4,B,12] ;SETUP CHAN #
XCT B ;GET STATUS INTO B
HRLZS B ;LEFT HALF
PUSHJ P,OTYPO
MOVEI A,")"
PUSHJ P,TYPO
JRST EXIT1 ;EXIT
ERR14: MOVEI D,1 ;OUTPUT DEVICE IS INDEXED BY 1
MOVEI T,EBLOCK ;OUTPUT FILE NAME
MOVEM T,FILBUF ;FAKE IT SO FTYPO WORKS
HRRZ T,EBLOCK+1 ;GET ENTER ERROR CODE
SKIPN T ;OK IF NOT 0
HLLOS EBLOCK+1 ;SET TO -1 SO WE GET RIGHT MESSAGE
MOVE T,SDEVCHR ;GET DEVICE CHARACTERISTICS
TLNE T,DSKBIT ;IS IT A DSK
JRST ERROR8 ;YES
MOVEI B, EMES14 ;DIRECTORY FULL ON OUTPUT
JRST ERROR ;TYPE IT AND EXIT
ERR8A: HRRZ T,EBLOCK+1 ;GET ERROR CODE
CAIN T,-1 ;-1 IS SPECIAL
JRST .+3 ;SKIP SIZE CHECK
CAIL T,TABLND-ETABLE ;LEGAL ERROR?
SKIPA B,TABLND ;NO, USE CATCH ALL MESSAGE
MOVE B,ETABLE(T) ;PICK UP MESSAGE
JRST ERROR
[ASCIZ /(0) illegal file name/]
ETABLE: [ASCIZ /(0) file was not found/]
[ASCIZ /(1) no such project-programmer number/]
[ASCIZ /(2) protection failure/]
[ASCIZ /(3) file was being modified/]
[ASCIZ /(4) rename file name already exists/]
[ASCIZ /(5) illegal sequence of UUOs/]
[ASCIZ /(6) bad UFD or bad RIB/]
[ASCIZ /(7) not a SAV file/]
[ASCIZ /(10) not enough core/]
[ASCIZ /(11) device not available/]
[ASCIZ /(12) no such device/]
[ASCIZ /(13) not two reloc reg. capability/]
[ASCIZ /(14) no room or quota exceeded/]
[ASCIZ /(15) write lock error/]
[ASCIZ /(16) not enough monitor table space/]
[ASCIZ /(17) partial allocation only/]
[ASCIZ /(20) block not free on allocation/]
[ASCIZ /(21) can't supersede (enter) an existing directory/]
[ASCIZ /(22) can't delete (rename) a non-empty directory/]
[ASCIZ /(23) SFD not found/]
[ASCIZ /(24) search list enpty/]
[ASCIZ /(25) SFD nested too deeply/]
[ASCIZ /(26) no-create on for specified path/]
TABLND: [ASCIZ /(?) lookup,enter,or rename error/]
ERR15: MOVEI D, 1 ;SET TO OUTPUT DEVICE
MOVEI B, EMES15 ;DEVICE ERROR ON OUTPUT
PUSHJ P, ETYPO ;TYPE THE MESSAGE
PUSHJ P, DTYPO ;TYPE NAME OF OFFENDING DEVICE
MOVEI A,":"
PUSHJ P,TYPO
MOVEI B,EMS15A
PUSHJ P,ETYPO
GETSTS 1,B ;GET THE STATUS
HRLZS B ;LEFT HALF
PUSHJ P,OTYPO ;OUTPUT IT
MOVEI A,")"
PUSHJ P,TYPO
JRST EXIT1 ;GO AWAY
ERR16: MOVE B,A ;SAVE OFFENDING LETTER
PUSHJ P,CRLF
MOVEI A,77 ;TYPE OUT "?"
PUSHJ P, OUT
MOVE A, B ;GET BACK OFFENDING LETTER
PUSHJ P, OUT ;TYPE OFFENDING LETTER
MOVEI B, EMES16 ;"X" IS AN ILLEGAL SWITCH
TRO F,CRLFTY
JRST ERROR ;TYPE IT AND EXIT
ERR17: MOVE B, A
PUSHJ P,CRLF
MOVEI A, 77
PUSHJ P, OUT
MOVE A, B
PUSHJ P, OUT ;TYPE OFFENDING LETTER
MOVEI B, EMES17 ;"X" IS AN ILLEGAL CHARACTER
TRO F,CRLFTY
JRST ERROR ;TYPE IT AND EXIT
ERR18: MOVEI B,EMES18
JRST ERROR
ERR19: MOVEI B,EMES19
JRST ERROR
ERR20: MOVEI B,EMES20
JRST ERROR
ERR21: MOVEI B,EMES21
JRST ERROR
ERR22: MOVEI B,EMES22
JRST ERROR
ERR23: MOVEI B,EMES23
JRST ERROR
ERR25: MOVEI B,EMES25
JRST ERROR
ERR26: PUSH P,B ;SAVE BLOCK TYPE
PUSHJ P, DTYPOQ ;TYPE OUT THE DEVICE NAME
MOVEI A, 72 ;ASCII COLON
PUSHJ P, TYPO ;TYPE IT OUT
MOVNI A,3 ;FILBUF HAS BEEN ADVANCED TOO FAR
ADDM A,FILBUF ;SO BACK IT UP
PUSHJ P, FTYPO ;TYPE OUT THE FILE NAME
MOVEI A, 56 ;ASCII PERIOD
PUSHJ P, TYPO ;TYPE IT OUT
HRRZ A, FILBUF ;GET THE POINTER TO CURRENT FILE
HLRZ S, 1(A) ;GET FILE NAME EXTENSION
PUSHJ P, DTYPO1 ;TYPE IT OUT
POP P,B ;GET BLOCK TYPE
HRLZS B ;INTO LEFT HALF
MOVEI A," " ;NEED SPACE
PUSHJ P,TYPO
PUSHJ P,OTYPO ;OUTPUT IN OCTAL
MOVEI B,EMES26 ;GET MESSAGE
PUSHJ P,ETYPO
JRST EXIT1 ;AND GIVE UP
ERR27: MOVEI B,EMES27
JRST ERROR
ERR28: SKIPA S,DEVBUF+1 ;GET OUTPUT DEVICE
ERR28A: MOVSI S,'TTY' ;HERE IF DEVICE IS TTY
MOVEI B,EMES28
PUSHJ P,ETYPO
PUSHJ P,DTYPO1 ;TYPE DEVICE
MOVEI A, 72 ;ASCII COLON
PUSHJ P, TYPO ;TYPE IT OUT
JRST EXIT1 ;AND GIVE UP
SUBTTL VARIOUS ERROR ROUTINES AND SMALL TYPE-OUT ROUTINES
ETYPO: HRLI B, 440700 ;MAKE A BYTE POINTER
ETYPO2: ILDB A, B ;GET A CHARACTER
JUMPE A,CPOPJ ;EXIT IF NULL
PUSHJ P, TYPO ;NO, TYPE IT
JRST ETYPO2 ;RETURN FOR MORE CHARACTERS
DTYPOQ: TRON F,CRLFTY ;IS CR,LF TYPED OUT?
PUSHJ P,CRLF ;YES
MOVEI A,77 ;TYPE OUT ? FOR BATCH
PUSHJ P,TYPO
DTYPO: MOVE S, DEVBUF(D) ;GET DEVICE NAME FROM BUFFER
DTYPO1: MOVE C, SYMPTR ;BYTE POINTER TO SYMBOL NAME
MOVEI B, 6 ;LOOP COUNTER FOR 6 CHARACTERS
DTYPO2: ILDB A, C ;GET A CHARACTER
JUMPE A, DTYPO3 ;IGNORE BLANKS
ADDI A, 40 ;CONVERT TO 7-BIT ASCII
PUSHJ P, TYPO ;TYPE IT
DTYPO3: SOJG B, DTYPO2 ;ALL DONE?
POPJ P, ;EXIT
FTYPO: MOVE S, @FILBUF ;PICK UP THE FILE NAME
JRST DTYPO1 ;JUMP INTO DTYPO ROUTINE
PTYPO: MOVEI A, 6 ;SIX CHARACTERS TO GET
TLZ B,740000 ;CLEAR CODE BITS
PTYPO2: IDIVI B, 50 ;CONVERT TO SIXBIT CODE
HRLM B+1, (P) ;STORE CHARACTER ON PD LIST
SOJLE A,.+2 ;ALL DONE?
PUSHJ P, PTYPO2 ;NO, DIVIDE SOME MORE
HLRZ A, (P) ;POP CHARACTERS OFF STACK
JUMPE A, CPOPJ ;IGNORE BLANKS
CAILE A, 12 ;LETTER OR NUMBER?
ADDI A, 7 ;LETTER - ADD 66
ADDI A, 57 ;NUMBER - ADD 57
CAIE A, 135 ;PERCENT SIGN?
CAIN A, 134 ;DOLLAR SIGN?
SUBI A, 70 ;YES, SPECIAL CASE
CAIN A, 133 ;PERIOD?
SUBI A, 55 ;YES, SPECIAL CASE
JRST OUT ;RECURSIVE EXIT FOR MORE CHARS
TYPO: IDPB A, OBUF+1 ;STORE CHARACTER IN BUFFER
CAIN A, 12 ;LINE FEED?
OUTPUT 0, ;YES, EMPTY BUFFER
POPJ P, ;EXIT
OTYPO: HRRI B,1 ;MARKER FOR WHEN DONE
OTYPO1: LSH A,7 ;MAKE SPACE FOR NEW NUMBER
LSHC A,3 ;GET NUMBER FROM B
ADDI A,"0" ;FORM ASCII
PUSHJ P,TYPO ;OUTPUT IT
TRNE B,-1 ;RIGHT HALF ZERO WHEN DONE
JRST OTYPO1 ;NOT YEYT
POPJ P, ;RETURN
CRLF: MOVEI A, 15 ;CARRIAGE RETURN
PUSHJ P, OUT ;OUTPUT IT
MOVEI A, 12 ;LINE FEED
JRST OUT ;OUTPUT IT AND EXIT
OCTOUT: PUSHJ P,TYPTB1 ;ALEAYS NEED A TAB
HRRI B,1 ;MARKER FOR WHEN DONE
OCTOU1: LSH A,7 ;MAKE SPACE FOR NEW NUMBER
LSHC A,3 ;GET NUMBER FROM B
ADDI A,"0" ;FORM ASCII
PUSHJ P,OUT ;OUTPUT IT
TRNE B,-1 ;RIGHT HALF ZERO WHEN DONE
JRST OCTOU1 ;NOT YET
POPJ P, ;RETURN
TYPTAB: SOJG E,TYPTB1 ;NEED A NEW LINE?
PUSHJ P,CRLF ;YES, OUTPUT ONE FIRST
MOVEI E,TABS1-1 ;RESET TAB COUNT
TRNN F,TTYOB
MOVEI E,TABS2-1 ;TTY
TYPTB1: MOVEI A,11 ;A TAB
JRST OUT ;OUTPUT AND RETURN (POPJ P,)
ERROR: TRZ F,TTYOB ;JUST IN CASE , SET OUTPUT TO TTY
TRON F,CRLFTY
PUSHJ P,CRLF
PUSHJ P, ETYPO ;TYPE LAST MESSAGE OF ERROR
EXIT1: TRZ F,TTYOB ;ENSURE TTY OUTPUT OF CR-LF
PUSHJ P,CRLF ;FINISH WITH CR-LF
CLOSE 0, ;FORCE OUTPUT OF LAST LINE
JRST FUDGE2 ;START AGAIN
EXIT: CLOSE 1, ;CLOSE OUT THE OUTPUT CHANNEL
JRST FUDGE2 ;RESTART
SUBTTL ERROR MESSAGES
EMES1: ASCIZ "?FUDGE2 SYNTAX ERROR"
EMES1A: ASCIZ "?COMMAND SWITCH REQUIRED"
EMES2: ASCIZ "?TOO MANY FILE NAMES OR PROGRAM NAMES"
EMES3: ASCIZ "?PROGRAM ERROR WHILE RESETTING MASTER DEVICE"
EMES4: ASCIZ " CANNOT DO IO AS REQUESTED"
EMES5: ASCIZ "?UNEQUAL NUMBER OF MASTER AND TRANSACTION PROGRAMS"
EMES6: ASCIZ "?NOT ENOUGH ARGUMENTS"
EMES7: ASCIZ " NOT FOUND"
EMES7A: ASCIZ " NO PROGRAM NAMES SPECIFIED"
EMES9B: ASCIZ " NOT AVAILABLE"
EMES10: ASCIZ "?ENTRY BLOCK TOO LARGE, PROGRAM "
EMES11: ASCIZ "?INPUT ERROR ON DEVICE "
EMES14: ASCIZ "?DIRECTORY FULL ON OUTPUT DEVICE "
EMES15: ASCIZ "?OUTPUT ERROR ON DEVICE "
EMS15A: ASCIZ " STATUS ("
EMES16: ASCIZ " IS AN ILLEGAL SWITCH"
EMES17: ASCIZ " IS AN ILLEGAL CHARACTER"
EMES18: ASCIZ "?DEVICE FOR * COMMAND MUST BE DSK OR DTA"
EMES19: ASCIZ "?CANNOT INIT DSK"
EMES20: ASCIZ "?LOOKUP FAILURE ON DSK"
EMES21: ASCIZ "?ERROR WHILE READING UFD"
EMES22: ASCIZ "?NOT ENOUGH CORE AVAILABLE "
EMES23: ASCIZ "?OUTPUT DEVICE MUST BE DSK OR DTA"
EMES24: ASCIZ " DOES NOT EXIST"
EMES25: ASCIZ "?TOO MANY DEVICES"
EMES26: ASCIZ " IS AN ILLEGAL BLOCK TYPE"
EMES27: ASCIZ "?TOO MANY SWITCHES"
EMES28: ASCIZ "?ILLEGAL DATA MODE FOR DEVICE "
SUBTTL HELP PROCESSOR
HELPME: MOVE 1,['FUDGE2']
PUSHJ P,.HELPR ;USE STANDARD SUBROUTINE
JRST FUDGE2 ;START AGAIN
SUBTTL IMPURE CODE
IFN PURESW,<
HIGH: PHASE LOW>
COLON1: OPEN ,COLON0 ;INITIALIZATION SEQUENCE
SEMIC1: ENTER , EBLOCK(T)
INBUF3: INBUF ,(C)
BACK0: MTAPE , 17 ;BACKSPACE MAG TAPE ONE FILE
BACK3: MTAPE ,0 ;WAIT FOR BACKSPACE TO FIN.
BACK1: STATO , IOBOT ;ARE WE AT BEGINNING OF TAPE
BACK2: MTAPE , 16 ;NO, SKIP FILE
POPJ P, ;EXIT
GET3A: CLOSE ,
GET4A: LOOKUP , EBLOCK(T)
INGET2: IN 0, ;INPUT A BUFFER OF DATA
JRST GETIN1 ;NO ERRORS
INGET3: STATZ , IOEOF ;END OF FILE?
JRST POPOUT ;YES, HIGH LEVEL EXIT
JRST ERR11 ;ERROR
DP: SETSTS ,117 ;DUMP MODE NON-STANDARD
USETI ,144 ;DIRECTORY BLOCK
INPUT ,DIRIOW ;ONE BLOCK ONLY
STATZ ,760000 ;CHECK ERRORS
JRST DP ;TRY AGAIN
SETSTS ,14 ;BACK TO BINARY
JRST DTALUP
DSKINI: EXP 14
SIXBIT /DSK/ ;MAY GET MODIFIED
EXP DIRBUF
DIRIOW: IOWD 200,DIRBLK ;IOWD FOR DIRECTORY INPUT
0 ;MUST BE IN LOW SEGMENT
IFN PURESW,<
LOWBLK:
DEPHASE>
SUBTTL STORAGE AND BUFFERS
IFN PURESW,< RELOC LOW>
LOW:
IFN PURESW,< BLOCK LOWBLK-LOW>
FILSAV: BLOCK 1
PPNSAV: BLOCK 1 ;SAVE CURRENT PPN WHILE RESETING
BLKCNT: BLOCK 1 ;NUMBER OF BUFFERS OUTPUT
SAVEAC: BLOCK 1
SAVEBT: BLOCK 1
COLON0: BLOCK 1 ;MODE
COLON2: BLOCK 1 ;DEVICE NAME
COLON3: BLOCK 1 ;BUFFER HEADER
FILBUF: BLOCK N
PRGBUF: BLOCK N
PPNBUF: BLOCK N
DEVBUF: BLOCK DEVNO
ENTBLK: BLOCK X+1
SVEBLK: BLOCK X+1
PDLIST: BLOCK XP
BLOCK 2 ;FOR EXTENDED LOOKUP AND ENTERS
EBLOCK: BLOCK 4
BLOCK <RIBALC-6+1> ;MORE EXTENDED STUFF
OBUF: BLOCK 6 ;TTY:, OUTPUT DEV:
IBUF: BLOCK 30 ;INPUT DEVICES (10)
SAVNAM: BLOCK 1 ;SAVED FILE NAME FROM UFD
SAVEXT: BLOCK 1 ;SAVED EXT NAME FROM UFD
DIRBUF: BLOCK 3 ;DIRECTORY BUFFER HEADER
DSKHDR: BLOCK N+2 ;TWO WORDS OF OVERHEAD [P,P]+EXT
DIRBLK=DSKHDR+2
DIRNAM=DIRBLK+123 ;FILENAMES IN DTA DIRECTORY START HERE
DIREXT=DIRNAM+26 ;EXTENSIONS IN DTA DIRECTORY START HERE
BSZ: BLOCK 1 ;SIZE OF OLD SYMBOL BLOCK
PTGRS: BLOCK 1 ;PTGR SAVED
PTSRS: BLOCK 1 ;PTSR SAVED
RELOCS: BLOCK 1 ;ORIGINAL RELOC
SYMBLK: BLOCK ^D20 ;NEW SYMBOL BLOCK
MATCH: BLOCK 1 ;COUNT OF <'S - >'S ***VJC
CURCHR: BLOCK 1 ;SAVED CURRENT CHAR OF CS
LSTCHR: BLOCK 1 ;SAVED LAST CHAR OF CS
SDEVCH: BLOCK 1 ;SAVED DEVICE CHARACTERS
NUMDEV: BLOCK 1 ;NUMBER OF DEVICES
XCOUNT: BLOCK 1
XPNTR: BLOCK 1
BUFSIZ: BLOCK 1
XBEG: BLOCK 2
LEVEL: BLOCK 1 ;-2 IF LEVEL D
DEFPPN: BLOCK 1 ;DEFAULT PROJ-PROG
PRJPRG: BLOCK 1 ;TEMP. PROJ-PROG
SVENTR: BLOCK 2 ;PLACE TO SAVE EBLOCK,+1
END1: BLOCK 1 ;FIRST WORD OF END BLOCK
END2: BLOCK 2 ;SECOND WORD OF END BLOCK
VAR ;JUST IN CASE
LOWTOP:
IFN PURESW,< RELOC>
SUBTTL CONSTANTS,POINTERS AND LITERALS
SYMPTR: POINT 6, S
EXTPTR: POINT 6, EXT
PTSR: POINT 4,SYMBLK+1 ;TO STORE RELOCATION
PTGR: POINT 4,RELOCS ;TO GET RELOCATION
DTCLR: UTPCLR 1,
FILXWD: XWD FILBUF+2, FILBUF+1
XPDLST: XWD -XP,PDLIST-1
END FUDGE2