Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/libary.mac
There are 12 other files named libary.mac in the archive. Click here to see a list.
; UPD ID= 3392 on 2/11/81 at 9:54 AM by NIXON
TITLE LIBARY VERSION 12B
SUBTTL COBOL LIBRARY MAINTENANCE PROGRAM AL BLACKINGTON/CAM/JEF
;COPYRIGHT (C) 1974, 1981 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
EDIT==30
VERSION==1202
TWOSEG ;TWO-SEGMENT PROGRAM
SEARCH INTERM,UUOSYM
IFN TOPS20,< SEARCH MONSYM, MACSYM>
IFE TOPS20,< SEARCH MACTEN>
LOC 137
XWD VERSION,EDIT
EXTERN .HELPR
SALL
RELOC 400000
;EDIT HISTORY
;** VERSION 12A RELEASED **
;1/2/79 DELETE EDITOR AND RENUMBERING CODE
;EDIT 30 PREVENT LOOPING "?INCORRECT COMMAND" ERROR
;EDIT 27 ADD SFD SUPPORT AND IMPROVE ERROR MESSAGES
;EDIT 26 FIX BUG IN /D CAUSED BY EDIT 24
;EDIT 25 PUT TAB AFTER LINE NUMBER ON LISTING FILE
;EDIT 24 PUT PAGE NUMBER ON LISTING OF LIBRARY
;EDIT 23 MAKE LIBARY RECOGNISE LOWER CASE COMMANDS
;EDIT 22 FIX LOOKUP DONE WHEN "END" COMMAND ENCOUNTERED
;EDIT ** ADD SWITCH /S - LIBRARY IS IN CARD IMAGE FORMAT
;EDIT 21 NEW SWITCH /D - DIRECTORY LIST ONLY THE PROGRAM NAME
;EDIT 20 OUTPUT LAST LIST BUFFER BEFORE GOING BACK FOR NEW COMMAND
;EDIT 17 FIX COMMAND SCANNER AFTER /L AND CLOSE BEFORE RENAME
;EDIT 16 CLEAR PROG COUNTER SO RESTART WORKS PROPERLY
;EDIT 15 MAKE LEADING SPACE BE IGNORED IN TEXT
;EDIT 14 FIX BAD ERROR MSG IF INPUT IS "*"
;EDIT 13 FIX JOBDAT SYMBOLS
;EDIT 12 FIX LINE NUMBER ROUTINE TO NOT GET 'ADDR CHECK'
;EDIT 11 FIX PROBLEM STEMMING FROM USING EXTRACT,DELETE
; WITHOUT AN END BETWEEN THEM.
;
; EXTRACT XXXXXX,FOO.EXT
; DELETE YYYYYY
; END
; ***********************
; WHICH KILLS THE OUTPUT DIRECTORY AND
; RENDERS THE LIBARY USELESS.
; MDS MAY 22/74.
;
;EDIT 10 FIX "I/O TO UNASSIGNED CHANNEL" WHEN INSERTING ILG 25-JAN-74
;ACCUMULATORS
SW=0 ;SWITCH REGISTER
TA=1 ;TEMPORARY
TB=2 ;TEMPORARY
TC=3 ;TEMPORARY
TD=4 ;TEMPORARY
TE=5 ;TEMPORARY
TF=6 ;TEMPORARY
TG=7 ;TEMPORARY
TH=10 ;TEMPORARY
DN=11 ;DEVICE NAME FROM "GETDEV"
FN=12 ;FILE-NAME FROM "GETDEV"
EX=13 ;EXTENSION FROM "GETDEV"
PJ=14 ;PROJ-PROG NUMBER FROM "GETDEV"
CP==TH ;POINTER TO 'COMSAV' AREA
PN==DN ;POINTER TO FINE TABLE (/L ONLY)
FT==FN ;RELATIVE ADDRESS OF FINE TABLE (/L ONLY)
WD=14 ;I/O WORD
LN=15 ;LINE NUMBER
CH=16 ;TTY CHARACTER
PP=17 ;PUSH-DOWN POINTER
;I/O CHANNELS
TTY==1 ;TELETYPE
TOD==2 ;TEMPORARY OUTPUT DIRECTORY
TOF==3 ;TEMPORARY OUTPUT FILE
TID==4 ;TEMPORARY INPUT DIRECTORY
OIF==5 ;ORIGINAL INPUT FILE
FOF==6 ;FINAL OUTPUT FILE
LST==7 ;LISTING FILE
OFF==10 ;'OFF-LINE' FILE
;MISCELLANEOUS
RUFPTR: IOWD 200,RUFTAB+1
LINPAG==^D58 ;[24] LINES PER PRINTED PAGE (EXCLUDING HEADING)
SEQFLG==40 ;PROGRAM IS SEQUENCED
;SWITCH REGISTER FLAGS
ENDP==1B18 ;END OF INPUT PROGRAM SEEN
ENDF==1B19 ;END OF OUTPUT PROGRAM SEEN
FSRC==1B20 ;INPUT FILE HAS BEEN MOVED
REGET==1B21 ;GET PREVIOUS CHARACTER FROM TTY
INDIR==1B22 ;INPUT FILE IS A DIRECTORY DEVICE
NOINP==1B23 ;THERE IS NO INPUT FILE
OUTDIR==1B25 ;OUTPUT DEVICE HAS A DIRECTORY
LISTIT==1B26 ;THERE IS A LISTING FILE
DOLIST==1B27 ;LIST THIS FILE AS IT IS WRITTEN
NOTTY==1B28 ;COMMAND FILE IS NOT TTY
LSWICH==1B29 ;WE ARE DOING LISTING OF ENTIRE FILE ONLY
ENDCOM==1B30 ;NO MORE COMMANDS FROM COMMAND FILE
HAVS04==1B31 ;WE ARE READING 'JJJS04' AS INPUT
LSTTY==1B32 ;LISTING IS ON CONSOLE
CHAR1==1B34 ;[15] THIS IS THE FIRST CHARACTER OF TEXT
DSWICH==1B35 ;/ DIRECTORY HEADER SO LIST ONLY THE PROGRAM NAME
DEFINE ERRORA (X),<
PUSHJ PP,TYPEQA
OUTSTR [ASCIZ "'X'
"]
>
DEFINE ERRORB (X),<
PUSHJ PP,TYPEQB
OUTSTR [ASCIZ "'X'
"]
>
DEFINE ERRORC (X),<
PUSHJ PP,TYPEQA
OUTSTR [ASCIZ "'X'"]
>
;SPECIAL CHARACTERS
$HT==11
$LF==12
$VT==13
$FF==14
$CR==15
$DLE==20
$DC4==24
$CZ==32
$SP==40
START: JSP TA,INITTY ;INITIALIZE TTY
START1: HLRZ TA,.JBSA ;[13]SAVE ENOUGH
ADDI TA,406 ; ROOM FOR TWO
MOVEM TA,SAVJFF ; DISK BUFFERS FOR COMMAND FILE
HRRM TA,.JBFF ;[13]
MOVE PP,PPOINT ;SET UP PUSH-DOWN POINTER
MOVE TA,[XWD IMPVAL,LOWIMP] ;SET UP IMPURE AREA
BLT TA,HIIMP
SETZM LOCLR ;CLEAR SOME IMPURE AREA
MOVE TA,[XWD LOCLR,LOCLR+1]
BLT TA,HICLR
IFE TOPS20,<
SETOM MYPATH ;[27] MY JOB,,GET PATH FUNCTION
MOVE TA,[11,,MYPATH] ;[27]
PATH. TA, ;[27] GET DEFAULT PATH
SETZM MYPPN ;[27] FAILED
>
IFN TOPS20,<
GETPPN TA, ;[27] GET LOGGED-IN PPN
JFCL ;[27] JUST INCASE JACCT ON
MOVEM TA,MYPPN ;[27] STORE IT
>
PUSHJ PP,DATIME ;SET UP DATE AND TIME FOR HEADER
PUSHJ PP,GETDEV
TRNE SW,LSWICH ;IS THIS "/L" FUNCTION?
JRST LSTFIL ;YES
PJOB TA, ;GET JOB NUMBER
PUSHJ PP,CONVBD
HLLM TC,TOFNAM
HLLM TC,TODNAM
HLLM TC,TIDNAM
SETZB TA,TOEXTN
OPEN TOF,TOFDAT
JRST NODSK
OPEN TOD,TODDAT
JRST NODSK
TRNE SW,NOINP ;ANY INPUT FILE?
JRST START7 ;NO
;SKIP OVER ROUGH TABLE
OPEN TID,TIDDAT
JRST NODSK
MOVE TA,RUFPTR
START2: PUSHJ PP,GETOIF
MOVEM WD,0(TA)
AOBJN TA,START2
;COPY INPUT DIRECTORY TO DISK
SETZM TIDNAM+3
SETZM TIDNAM+2
MOVEI TA,TIDNAM ;[27] IN CASE OF ERROR
ENTER TID,TIDNAM
JRST NOEDSK
MOVE TA,.JBFF ;[13]
MOVEM TA,TIDBUF
OUTBUF TID,2
START3: PUSHJ PP,GETOIF
PUSHJ PP,PUTTID
AOJE WD,START4
PUSHJ PP,GETOIF
PUSHJ PP,PUTTID
JRST START3
START4: CLOSE TID,
START5: SKIPN TA,TIDBUF
MOVE TA,.JBFF ;[13]
MOVEM TA,TIDBUF
MOVEM TA,.JBFF ;[13]
INBUF TID,1
SETZM TIDNAM+3
MOVEI TA,TIDNAM ;[27] IN CASE OF ERROR
LOOKUP TID,TIDNAM
JRST NOLDSK
PUSHJ PP,COPYL3
;SET UP OUTPUT SCRATCH FILES
START7: SETZM TODNAM+3
SETZM TODNAM+2
MOVEI TA,TODNAM ;[27] IN CASE OF ERROR
ENTER TOD,TODNAM
JRST NOEDSK
MOVE TA,.JBFF ;[13]
MOVEM TA,TODBUF
OUTBUF TOD,2
SETZM TOFNAM+3
SETZM TOFNAM+2
MOVEI TA,TOFNAM ;[27] IN CASE OF ERROR
ENTER TOF,TOFNAM
JRST NOEDSK
MOVE TA,.JBFF ;[13]
MOVEM TA,TOFBUF
OUTBUF TOF,2
SETZM PRGCTR ;[16] CLEAR PROGRAM COUNTER FOR RESTART
SETOM RUFTAB
MOVE TA,[XWD RUFTAB,RUFTAB+1]
BLT TA,RUFTAB+177
SETZM RUFCTR
MOVEI TA,RUFTAB
MOVEM TA,RUFLOC
MOVEI TA,200
MOVEM TA,OFFSET
MOVEM TA,FINCTR
SETZM TOFCTR
SETZM OUTNAM
;GET ANOTHER MAJOR COMMAND FROM TTY
NEWCOM: MOVE PP,PPOINT
SETZM SEQ
PUSHJ PP,GETCOM
NEWCM1: ANDCMI SW,DOLIST ;TURN OFF "LIST THIS PROG" FLAG
PUSHJ PP,TSTCOM ;SEE IF THIS IS A VALID COMMAND
JUMPN TA,(TA) ;IF IT IS--GO TO APPROPRIATE ROUTINE
ERRORA <Improper command>
PUSHJ PP,SKPTTY ;[30] CLEAR REST OF BAD COMMAND
JRST NEWCOM
;FIND NEXT MAJOR COMMAND IN CCL FILE AFTER ERROR
SKPCOM: TRNN SW,NOTTY ;CCL COMMANDS?
JRST NEWCOM ;NO
SKPCM1: MOVE PP,PPOINT
PUSHJ PP,GETCOM
ANDCMI SW,DOLIST
PUSHJ PP,TSTCOM
JUMPN TA,(TA) ;GO EXECUTE VALID COMMAND
SKPCM2: PUSHJ PP,GETTY ;SKIP TO END OF INVALID LINE
CAIL CH,$LF
CAILE CH,$FF
JRST SKPCM2
JRST SKPCM1 ;IGNORE INVALID COMMAND
;INSERT A NEW PROGRAM
INSERT: PUSHJ PP,SEARCH ;GET TO INSERTION POINT
JRST SKPCOM ;OOPS, PASSED IT!
JRST INSRT0 ;GOT TO THE RIGHT PLACE
ERRORA <That program already exists>
JRST SKPCOM
INSRT0: SKIPN OFFDEV ;ANY 'OFF-LINE' FILE?
JRST INSRE0 ;NO, COMPLAIN
PUSHJ PP,SETOFF ;SET UP 'OFF-LINE' FILE
JRST SKPCOM ;TROUBLE--FORGET THE WHOLE THING
INSRT1: MOVE TA,SEQ ;GET SEQ FLAG
MOVEM TA,OUTSEQ
PUSHJ PP,PUTNNM ;PUT NAME IN OUTPUT DIRECTORY
SETOM OUTLIN
;COPY PROGRAM FROM 'OFF-LINE' FILE
PUSHJ PP,COPOFF
MOVNI WD,1
PUSHJ PP,LSTFIN ;[20] PUT OUT LAST LISTING BUFFER
PUSHJ PP,PUTTOF
JRST NEWCOM
INSRE0: ERRORA <Need input file for insertion>
JRST SKPCOM
;DELETE A PROGRAM
DELETE: PUSHJ PP,SEARCH ;FIND THE PROGRAM
JRST SKPCOM
JRST NOPROG ;IT DOESN'T EXIST
SKIPE OFFDEV ;ANY 'OFF-LINE' FILE?
JRST DELET1 ;YES--ERROR
PUSHJ PP,PASSP ;SKIP OVER THE PROGRAM
JRST NEWCOM
DELET1: ERRORA <File name not allowed with this command>
JRST SKPCOM
;REPLACE A PROGRAM
REPLAC: PUSHJ PP,SEARCH ;FIND THE PROGRAM
JRST SKPCOM
JRST NOPROG ;IT DOESN'T EXIST
SKIPN OFFDEV ;'OFF-LINE' FILE REQUIRED
JRST REPLE0 ; NOT GIVEN.. COMPLAIN
PUSHJ PP,SETOFF ;SET UP ANY 'OFF-LINE' FILE
JRST SKPCOM ;ERROR--QUIT
PUSHJ PP,PASSP ;SKIP OVER THE PROGRAM
JRST INSRT1 ;COPY 'OFF-LINE' FILE INSTEAD
REPLE0: ERRORA <Input file required for replacing>
JRST SKPCOM
;EXTRACT A PROGRAM
XTRACT: PUSHJ PP,SEARCH ;FIND THE PROGRAM
JRST SKPCOM ;IT HAS BEEN PASSED
JRST NOPROG ;IT DOESN'T EXIST
SKIPN OFFDEV ;ANY 'OFF-LINE' FILE?
JRST XTRAC8 ;NO--ERROR
SKIPN TA,OFFBUF ;YES--SET IT UP
HRRZ TA,.JBFF ;[13]
MOVEM TA,OFFBUF
HRRM TA,.JBFF ;[13]
MOVEI TA,.IOASC ;ASCII MODE
MOVE TB,OFFDEV
MOVSI TC,OFFBH
OPEN OFF,TA
JRST NOOFFD
OUTBUF OFF,2
MOVE TE,[XWD OFFNAM,TA]
BLT TE,TD
ENTER OFF,TA
JRST NOEOFF
MOVE TA,INSEQ ;GET SEQ FLAG OF INPUT PROG
MOVEM TA,OUTSEQ
PUSHJ PP,PUTNNM ;PUT NAME IN OUTPUT DIRECTORY
SETOM OUTLIN
SKIPA WD,INLIN
XTRAC3: PUSHJ PP,GETOIF ;GET NEXT WORD FROM INPUT
PUSHJ PP,PUTTOF
TRNN WD,1 ;IF NOT A LINE NUMBER
JRST XTRAC5 ; IT GOES TO EXTRACTION FILE
AOJE WD,XTRAC4 ;IF END OF PROG, WE ARE ALMOST DONE
JRST XTRAC3 ; AND LOOP
XTRAC4: IORI SW,ENDP ;SET 'END OF PROGRAM'
JRST XTRAC9 ;FINISH UP
;EXTRACT A PROGRAM (CONT'D)
XTRAC5: MOVE TA,[POINT 7,WD] ;WRITE
XTRAC6: ILDB CH,TA ; WORD
JUMPE CH,XTRA6B ; ONTO
CAIL CH,$LF ; EXTRACTION
CAILE CH,$FF ; FILE
TRNA
JRST XTRAC7 ; *
XTRA6A: PUSHJ PP,PUTOFF ; *
XTRA6B: TLNE TA,760000 ; *
JRST XTRAC6 ; *
JRST XTRAC3 ;BACK FOR ANOTHER WORD
XTRAC7: PUSH PP,CH
MOVEI CH,$CR
PUSHJ PP,PUTOFF
POP PP,CH
JRST XTRA6A
XTRAC8: ERRORA <Need output file for extraction>
JRST SKPCOM
XTRAC9: CLOSE OFF, ;CLOSE OUT
STATO OFF,IO.ERR ;IF NO ERROR,
JRST XTRA9A ; SKIP THE ERROR TYPEOUT
ERRORA <Output error when extraction file closed>
XTRA9A: RELEASE OFF,
PUSHJ PP,COPYL3
PUSHJ PP,LSTFIN ;[20] OUTPUT LAST LISTING BUFFER
ANDCMI SW,ENDP ;[11] CLEAR END OF PROGRAM FLAG
;[11] BEFORE GOING BACK TO TTY FOR NEXT COMMAND
JRST NEWCOM
;RESTART MAINTENANCE.
;TEMPORARY OUTPUTS BECOME INPUTS.
RESTRT: LDB CH,TTYIB+1
CAIL CH,$LF
CAILE CH,$FF
JRST REST10
ANDCMI SW,REGET
PUSHJ PP,CLOSOT
TRNN SW,NOINP
JRST REST1
OPEN TID,TIDDAT
JRST REST9
MOVE TA,TIDNAM
MOVSI TB,'TMP'
SETZB TC,TD
LOOKUP TID,TA
JRST REST7
REST1: CLOSE TID,
SETZB TA,TB
SETZB TC,TD
RENAME TID,TA
JRST REST9
REST2: MOVE TA,TIDNAM
MOVSI TB,'TMP'
SETZB TC,TD
RENAME TOD,TA
JRST REST9
TRNN SW,NOINP
JRST REST3
MOVEI TA,.IOBIN
MOVSI TB,'DSK'
MOVEI TC,OIFIB
OPEN OIF,TA
JRST REST9
SKIPN TA,OIFBUF
MOVE TA,.JBFF ;[13]
MOVEM TA,OIFBUF
MOVEM TA,.JBFF ;[13]
INBUF OIF,2
;RESTART MAINTENANCE (CONT'D)
REST3: CLOSE OIF,
MOVE TA,TOFNAM ;LOOK FOR FILE 'JJJS04.TMP'
HRRI TA,'S04'
MOVSI TB,'TMP'
SETZB TC,TD
LOOKUP OIF,TA
JRST REST8 ;IT DOESN'T EXIST (OR POSSIBLY TROUBLE)
CLOSE OIF, ;OK--NOW DELETE IT
SETZB TA,TB
SETZB TC,TD
RENAME OIF,TA
JRST REST9 ;TROUBLE
REST4: MOVE TA,TOFNAM ;RENAME 'TOF' TO BE 'JJJS04.TMP'
HRRI TA,'S04'
MOVSI TB,'TMP'
SETZB TC,TD
RENAME TOF,TA
JRST REST9 ;TROUBLE
SETZB TC,TD ;OK--NOW OPEN THAT FILE FOR INPUT
LOOKUP OIF,TA
JRST REST9
ANDCMI SW,ENDF!NOINP!ENDP
IORI SW,HAVS04 ;REMEMBER THE RESTART
JRST START5
REST7: TRNN TB,-1 ;[27] FILE NOT FOUND ERROR?
JRST REST2 ;[27] YES
JRST REST9
REST8: TRNN TB,-1 ;[27] FILE NOT FOUND ERROR?
JRST REST4 ;[27] YES
REST9: PUSHJ PP,SAVEA ;[27] SAVE ERROR CODE
OUTSTR [ASCIZ "
?Trouble renaming files "]
PUSHJ PP,LREERR ;[27] COMMON ERROR ROUTINE
EXIT
REST10: PUSHJ PP,BADCOM
JRST NEWCOM
;"END" COMMAND HAS BEEN TYPED.
ALLDUN: PUSHJ PP,CLOSOT
MOVE TA,TODBUF
MOVEM TA,.JBFF ;[13]
INBUF TOD,2
MOVE TA,TOFBUF
MOVEM TA,.JBFF ;[13]
INBUF TOF,2
PUSHJ PP,SETBAK ;SET UP OUTPUT
MOVE TA,RUFPTR
ALDUN2: MOVE WD,0(TA)
PUSHJ PP,PUTFOF
AOBJN TA,ALDUN2
SETZM TODNAM+2
SETZM TODNAM+3 ;[27] CLEAR PPN SET BY ENTER
MOVEI TA,TODNAM ;[27] IN CASE OF ERROR
LOOKUP TOD,TODNAM
JRST NOLDSK
ALDUN3: PUSHJ PP,GETTOD
PUSHJ PP,PUTFOF
AOJE WD,ALDUN4
PUSHJ PP,GETTOD
ADD WD,OFFSET
PUSHJ PP,PUTFOF
JRST ALDUN3
ALDUN4: SETZM TOFNAM+3
MOVEI TA,TOFNAM ;[27] IN CASE OF ERROR
LOOKUP TOF,TOFNAM
JRST NOLDSK
ALDUN5: PUSHJ PP,GETTOF
JRST ALDUN6
PUSHJ PP,PUTFOF
JRST ALDUN5
;CLOSE OUT ALL FILES, AND DELETE ALL SCRATCH FILES
ALDUN6: MOVEI TA,0 ;FILE-NAME FOR 'DELETE'
CLOSE TOD,
RENAME TOD,TA
JFCL
RELEASE TOD,
CLOSE TOF,
RENAME TOF,TA
JFCL
RELEASE TOF,
TRNN SW,NOINP ;ANY INPUT FILE?
JRST ALDN6A ;YES
TRNN SW,HAVS04 ;NO--READING SCRATCH?
JRST ALDUN7 ;NO
ALDN6A: CLOSE TID,
RENAME TID,TA
JFCL
RELEASE TID,
TRZN SW,HAVS04 ;WERE WE READING SCRATCH?
JRST ALDUN7 ;NO
CLOSE OIF, ;YES--
RENAME OIF,TA ;DELETE IT
JFCL
ALDUN7: RELEASE OIF,
SKIPN FOFDAT+1 ;ANY FOF FILE?
JRST ALDUN8 ;NO
CLOSE FOF,
STATZ FOF,IO.ERR+IO.EOF
OUTSTR [ASCIZ "?Error while closing output file
"]
RELEASE FOF,
ALDUN8: RELEASE LST,
ALDUN9: TRNE SW,ENDCOM ;END OF NON-TTY COMMAND FILE?
JRST START ;YES--START AT RESET
PUSHJ PP,GETTY ;SKIP UP TO THE BEGINNING
CAIL CH,$LF ; OF THE NEXT LINE.
CAILE CH,$FF
JRST ALDUN9
JRST START1 ;AND THEN GO RESTART.
;LIST THE ENTIRE LIBRARY FILE
LSTFIL: IORI SW,REGET ;[17] REGET THE <CR> TO INDICATE END OF CMD
ENTER LST,LSTNAM ;ENTER LISTING FILE
JRST CNTLST ;CANNOT--ERROR
MOVEI FT,2
LSTF3: PUSHJ PP,GETFT
MOVE PN,[XWD -^D64,FINTAB]
LSTF4: MOVE TA,(PN)
AOJE TA,ALDUN7
SUBI TA,1
MOVEM TA,OUTNAM
MOVE TA,1(PN)
MOVEM TA,OUTNAM+1
SETZM PAGNO ;[24] START ON PAGE 1
PUSHJ PP,LSTHDG
AOS LINECT ;[24] ACCOUNT FOR SOS AT LSTF6
TRNE SW,DSWICH ;IF /DIRECTORY HEADER SWITCH
JRST LSTF10 ;DONT LIST THE FILE
MOVE TA,1(PN)
AND TA,[XWD 37,-1]
LSHC TA,-7
USETI OIF,1(TA)
IN OIF,
AOSA OIFIB+2
JRST LSTERA
MOVEI TA,0
LSHC TA,7
ADDM TA,OIFIB+1
MOVNS TA
ADDM TA,OIFIB+2
;LIST THE LIBRARY (CONT'D)
LSTF6: PUSHJ PP,GETOIF
TRNN WD,1
JRST TRBL1
CAMN WD,[<ASCII / />+1] ;SOS PAGE MARK?
JRST LSTF11 ;YES
MOVE TA,WD
AOJE TA,LSTF10
SOSG LINECT ;[24] ROOM LEFT ON PAGE?
PUSHJ PP,LSTHDG ;[24] NO, START AGAIN
LSH WD,-1
PUSHJ PP,LINOUT
LSTF7: PUSHJ PP,GETOIF
TRNE WD,1
JRST TRBL2
MOVE TA,[POINT 7,WD]
LSTF8: ILDB CH,TA
CAIL CH,$LF ;IS CHARACTER A LINE-FEED?
CAILE CH,$FF ;OR VT, OR FF?
TRNA ;NO
JRST LSTF9 ;YES
PUSHJ PP,PUTL2
TLNE TA,760000 ;IS WORD NOW EMPTY?
JRST LSTF8 ;NO
JRST LSTF7 ;YES--GET ANOTHER
LSTF9: MOVE TA,CH ;SAVE END-LINE CHARACTER
MOVEI CH,$CR
PUSHJ PP,PUTL2
MOVEI CH,$LF
CAME TA,CH ;IS EOL A LF?
PUSHJ PP,PUTL2 ;NO, PUT OUT A LF FIRST
MOVE CH,TA ;PUT OUT
PUSHJ PP,PUTL2 ; END-LINE CHARACTER
JRST LSTF6
LSTF10: ADDI PN,1
AOBJN PN,LSTF4
JRST LSTF3
LSTF11: PUSHJ PP,GETOIF ;GET WORD AFTER PAGE MARK
MOVEI CH,$FF ;FAKE UP FORM FEED
PUSHJ PP,PUTL2 ;OUTPUT IT
JRST LSTF6 ;GET NEXT LINE
;PRINT OUT LINE NUMBER
LINOUT: MOVE TA,WD
MOVEI TC,0
MOVEI TD,6
LINOT1: IDIVI TA,^D10
ADDI TB,"0"
LSHC TB,-6
SOJG TD,LINOT1
LINOT2: MOVEI TB,0
LSHC TB,6
MOVEI CH,(TB)
PUSHJ PP,PUTL2
JUMPN TC,LINOT2
MOVEI CH,$HT ;[25] PUT OUT TAB
JRST PUTL2 ;[25] AFTER LINE NUMBER
;GET ONE BLOCK OF FINE-TABLE
GETFT: USETI OIF,(FT)
IN OIF,
TRNA
JRST DIRERA
MOVS TA,OIFIB+1
HRRI TA,FINTAB-1
BLT TA,FINTAB+177
AOJA FT,CPOPJ
;PUT A MESSAGE ONTO LISTING FILE
PUTMES: ILDB CH,TE
JUMPE CH,CPOPJ
PUSHJ PP,PUTL2
JRST PUTMES
;CONVERT JOB NUMBER IN "TA" TO DECIMAL
CONVBD: MOVEI TD,3
CONVB1: IDIVI TA,^D10
ADDI TB,"0"-40
LSHC TB,-6
SOJG TD,CONVB1
POPJ PP,
;GET A COMMAND FROM TTY
GETCOM: TRNE SW,ENDCOM ;COMMAND FILE EMPTY?
JRST GTCOM8 ;YES
CAIN CH,"@"
JRST GTCM10
MOVE CP,[POINT 7,COMSAV]
TRNN SW,NOTTY
OUTSTR [ASCIZ "*"]
MOVE TA,[POINT 6,COMWRD]
SETZM COMWRD
SETZM COMWRD+1
GTCOM1: PUSHJ PP,GETTY
TRNE SW,ENDCOM
JRST GTCOM8
CAIN CH,"@"
JRST GTCM10
CAIL CH,$LF
CAILE CH,$FF
TRNA
JRST GTCOM2
CAIGE CH,140
CAIGE CH,40
JRST GTCOM7
CAIN CH,$SP
JRST GTCOM2
; CAIE CH,"*" ;[SEB] FIX MULTIPLE "IMPROPER COMMAND" MSGS
CAIN CH,"-"
JRST GTCOM3
SUBI CH,40
IDPB CH,TA
CAME TA,[POINT 6,COMWRD+1,35]
JRST GTCOM1
JRST GTCOM9
GTCOM2: CAMN TA,[POINT 6,COMWRD]
JRST GTCOM1
GTCOM3: IORI SW,REGET
POPJ PP,
GTCOM7: CAIN CH,$HT
JRST GTCOM2
CAIE CH,$LF
JRST GTCOM9
MOVE TA,COMWRD
CAMN TA,[SIXBIT "END"]
JRST GTCOM3
GTCOM8: MOVSI TA,'END'
MOVEM TA,COMWRD
POPJ PP,
GTCOM9: PUSHJ PP,BADCOM
JRST GETCOM
;'@' SEEN IN COMMAND
GTCM10: CAME TA,[POINT 6,COMWRD]
JRST GTCM11
SETZB DN,FN
SETZB EX,PJ
PUSHJ PP,GTDV8Z ;[27] SCAN FOR 'DEV:FILE.EXT[P,P]'
JFCL ;IGNORE ERROR (MESSAGE WAS TYPED)
JRST GETCOM ;GO BACK FOR ANOTHER COMMAND
GTCM11: PUSHJ PP,BADCOM
JRST GETCOM
;SEE IF THE COMMAND IS ONE OF THE MAJOR ONES.
;IF SO, RETURN WITH TA CONTAINING THE ADDRESS OF THE
; APPROPRIATE ROUTINE
TSTCOM: MOVSI CH,LSTSIZ
MOVE TA,COMWRD
SETO TC, ;FIND MASK FOR TRAILING NULLS
LSH TC,-6
TDNE TA,TC
JRST .-2
TSTCM1: MOVE TB,LIST1(CH)
ANDCM TB,TC
CAME TA,TB
AOBJN CH,TSTCM1
JUMPGE CH,TSTCM2
SKIPA TA,LIST2(CH)
TSTCM2: MOVEI TA,0
POPJ PP,
DEFINE COMMANDS<
XX DELETE,DELETE
XX END,ALLDUN
XX EXTRACT,XTRACT
XX INSERT,INSERT
XX REPLACE,REPLAC
XX RESTART,RESTRT
>
DEFINE XX(A,B)< <SIXBIT /A/>>
LIST1: COMMANDS
DEFINE XX(A,B)< EXP B>
LIST2: COMMANDS
LSTSIZ==LIST2-.
;COPY A LINE FROM INPUT FILE TO OUTPUT FILE
COPYL: MOVEI WD,^D10*2
COPYL0: SKIPA WD,INLIN
MOVEM WD,OUTLIN ;THAT'S NEW OUTPUT LINE
COPYL1: PUSHJ PP,PUTTOF ;WRITE IT
PUSHJ PP,GETOIF ;GET INPUT WORD
TRNN WD,1B35 ;IS IT A LINE NUMBER?
JRST COPYL1 ;NO - LOOP
COPYL2: MOVEM WD,INLIN ;YES -- THAT'S NEW INPUT LINE
AOJN WD,CPOPJ ;WAS IT MINUS 1?
IORI SW,ENDP ;YES -- SET "END OF PROGRAM"
COPYL3: PUSHJ PP,GETTID ;GET PROGRAM NAME
AOJE WD,COPYL5 ;ANYTHING THERE?
SUBI WD,1 ;YES
MOVEM WD,INNAM
PUSHJ PP,GETTID
SETZM INSEQ ;ASSUME NOT SEQUENCED
TLNE WD,SEQFLG ;IS IT
SETOM INSEQ ;YES
AND WD,[XWD 777700,0]
MOVEM WD,INNAM+1
PUSHJ PP,GETOIF ;GET NEXT LINE NUMBER
MOVEM WD,INLIN ;SAVE LINE NUMBER
POPJ PP,
COPYL5: IORI SW,ENDF ;NO MORE PROGRAMS--SET "END-FILE"
POPJ PP,
;PASS OVER ONE LINE OF INPUT
PASSL: PUSHJ PP,GETOIF ;COPY WORDS UNTIL
TRNN WD,1B35 ; 1-BIT SEEN
JRST PASSL
JRST COPYL2
;COPY A PROGRAM FROM INPUT TO OUTPUT
COPYP: TRZE SW,ENDP ;END OF PROGRAM SEEN?
JRST COPYP1 ;YES
PUSHJ PP,COPYL0 ;NO--COPY ONE LINE
JRST COPYP ;LOOP
COPYP1: MOVNI WD,1 ;WRITE OUT LAST LINE NUMBER
JRST PUTTOF
;PASS OVER A PROGRAM
PASSP: PUSHJ PP,PASSL
TRZN SW,ENDP
JRST PASSP
POPJ PP,
;SEARCH FOR THE PROGRAM SPECIFIED BY "NEWNAM"
;IF AT END OF INPUT FILE, PUT OUT ERROR MESSAGE AND
; RETURN TO CALL+1.
;IF THE PROGRAM HAS BEEN PASSED, PUT OUT ERROR MESSAGE AND
; RETURN TO CALL+1.
;IF THE PROGRAM DOESN'T EXIST, RETURN TO CALL+2.
;RETURN TO CALL+3 IF THE PROGRAM IS FOUND.
SEARCH: ANDCMI SW,FSRC ;TURN OFF "WE HAVE MOVED INPUT"
PUSHJ PP,GETNAM ;GET PROGRAM NAME
POPJ PP, ;ERROR-QUIT
SERCH1: TRNE SW,ENDF ;END OF INPUT?
JRST SERCH4 ;YES -- ERROR
MOVEI TB,INNAM
PUSHJ PP,COMPAR
JRST SERCH4 ;NEW NAME LESS THAN NEXT INPUT
JRST SERCH2 ;NEW NAME GREATER THAN NEXT INPUT
CPOPJ2: AOS (PP) ;NEW NAME EQUAL TO NEXT INPUT
CPOPJ1: AOS (PP)
CPOPJ: POPJ PP,
SERCH2: PUSHJ PP,PUTINM ;PUT NAME IN OUTPUT DIRECTORY
PUSHJ PP,COPYP ;COPY THIS PROGRAM
IORI SW,FSRC ;SET "WE HAVE MOVED INPUT"
ANDCMI SW,ENDP ;INSURE "END-OF-PROGRAM" IS RESET
JRST SERCH1 ;LOOP
SERCH4: TRNE SW,FSRC ;YES -- WAS INPUT DONE?
JRST CPOPJ1 ;YES -- PROGRAM DOESN'T EXIST
MOVEI TB,OUTNAM ;NO--IS NEW NAME GREATER THAN LAST WRITTEN?
PUSHJ PP,COMPAR
JRST SERCH5 ;LESS--ERROR
JRST CPOPJ1 ;GREATER--OK
SERCH5: ERRORA <Program, if it exists, has been passed>
POPJ PP,
;SCAN COMMAND TO SET UP INPUT AND OUTPUT FILES
GETDEV: TRNE SW,ENDCOM ;AT END OF COMMAND FILE?
JRST START ;YES--GO BACK TO TTY
MOVE CP,[POINT 7,COMSAV]
ANDI SW,NOTTY ;CLEAR ALL SWITCHES EXCEPT "COMMANDS NOT ON TTY"
MOVE TA,SAVJFF ;RESET JOBFF
MOVEM TA,.JBFF ;[13]
TRNN SW,NOTTY ;TYPE "*" IF COMMAND FILE NOT TTY
OUTSTR [ASCIZ "
*"]
PUSHJ PP,GETTY ;IS THERE A
CAIL CH,12 ; LINE-FEED WAITING?
CAILE CH,14 ;OR VT, OR FF?
TROA SW,REGET ;NO--SET UP TO REGET CHARACTER
JRST GETDEV ;YES--FORGET IT
GTDEV0:
IFE TOPS20,<
MOVEI PJ,FOFPTH+.PTPPN ;[27] SFD PATH
>
PUSHJ PP,GTDEV6 ;SCAN ONE FILE DESCRIPTOR
CAIN CH,"/"
PUSHJ PP,GTDEV7
CAIN CH,"@"
JRST GTDV0A
SKIPN DN
MOVSI DN,'DSK'
MOVE TA,DN ;GET
DEVCHR TA, ; CHARACTERISTICS
JUMPE TA,NOTDEV ;IF ZERO--NOT A DEVICE
MOVEM TA,ODEVCH ;SAVE CHARACTERISTICS
MOVEM DN,FOFDAT+1
MOVEM FN,FOFNAM
MOVEM EX,FOFNAM+1
MOVEM PJ,FOFNAM+3
JRST GTDEV1
GTDV0A: PUSHJ PP,GTDEV8
JRST START1 ;ERROR
JRST GTDEV0
;SET UP INPUT AND OUTPUT FILES (CONT'D).
;NOW DO LISTING FILE
GTDEV1: CAIE CH,"," ;IS THERE A LISTING FILE?
JRST GTDV1B ;NO
GTDV1A:
IFE TOPS20,<
MOVEI PJ,LSTPTH+.PTPPN ;[27] LISTING SFD
>
PUSHJ PP,GTDEV6 ;YES--SCAN IT
CAIN CH,"/"
PUSHJ PP,GTDEV7
CAIN CH,"@"
JRST GTDV1C
SKIPN DN
MOVSI DN,'DSK'
MOVE TA,DN
DEVCHR TA,
JUMPE TA,NOTDEV
MOVEM DN,LSTDAT+1
SKIPN FN
MOVE FN,['LIBARY']
MOVEM FN,LSTNAM
SKIPN EX
MOVSI EX,'LST'
MOVEM EX,LSTNAM+1
MOVEM PJ,LSTNAM+3
OPEN LST,LSTDAT
JRST NOTAV
OUTBUF LST,2
ENTER LST,LSTNAM
JRST CNTLST
IORI SW,LISTIT
MOVE TA,LSTDAT+1
DEVCHR TA,
TXNE TA,DV.TTU
IORI SW,LSTTY
GTDV1B: CAIN CH,"="
JRST GTDEV2
PUSHJ PP,BADCOM
JRST GOBACK
GTDV1C: PUSHJ PP,GTDEV8
JRST START1 ;ERROR
JRST GTDV1A
;SET UP INPUT AND OUTPUT FILES (CONT'D).
;NOW DO INPUT FILE
GTDEV2:
IFE TOPS20,<
MOVEI PJ,OIFPTH+.PTPPN ;[27] SFD PATH
>
PUSHJ PP,GTDEV6
GTDV2C: CAIN CH,"/"
PUSHJ PP,GTDEV7
CAIN CH,"@"
JRST GTDV4A
CAIL CH,$LF
CAILE CH,$FF
JRST [CAIE CH,$SP ;SKIP TRAILING BLANKS.
JRST IMPCOM
PUSHJ PP,GETTY
JRST GTDV2C]
JUMPN DN,GTDEV3
JUMPN FN,GTDV2A
JUMPN EX,GTDV2A
JUMPN PJ,GTDV2A
IORI SW,ENDF!NOINP
SETZM INDEV
TRNE SW,LSWICH
JRST IMPCOM
JRST GTDV5B
GTDV2A: MOVSI DN,'DSK'
GTDEV3: MOVE TA,DN
DEVCHR TA,
JUMPE TA,NOTDEV
TXNN TA,DV.M14 ;BINARY DEVICE?
JRST NOTBIN ;NO--ERROR
TXNN TA,DV.DIR
JRST GTDEV4
IORI SW,INDIR
JUMPE FN,NONAME
GTDEV4: TRNE SW,OUTDIR
SKIPE FOFNAM
JRST GTDEV5
JUMPE FN,NONAME
MOVEM FN,FOFNAM
JRST GTDEV5
GTDV4A: PUSHJ PP,GTDEV8
JRST START1
JRST GTDEV2
;SET UP INPUT AND OUTPUT FILES (CONT'D)
;DOING INPUT FILE (CONT'D)
GTDEV5: MOVEM DN,INDEV
MOVEM DN,OIFDAT+1
MOVEM FN,OIFNAM
MOVEM FN,INFIL
SKIPN EX
MOVSI EX,'LIB'
HLLZM EX,OIFNAM+1
HLLZM EX,INEXT
MOVEM PJ,OIFNAM+3
MOVEM PJ,INPP
OPEN OIF,OIFDAT
JRST NOTAV
SETZM OIFNAM+2
MOVE TE,[XWD OIFNAM,TA]
BLT TE,TD
MOVE TE,.JBFF ;[13]
MOVEM TE,OIFBUF
ADDI TE,406
MOVEI TF,1
TRNN SW,LSWICH
MOVEI TF,2
INBUF OIF,(TF)
MOVEM TE,.JBFF ;[13]
LOOKUP OIF,TA
JRST NOFIND
;SET UP I/O FILES (CONT'D)
;INITIALIZE OUTPUT DEVICE
GTDV5B: MOVE TA,ODEVCH
TXNE TA,DV.DIR
IORI SW,OUTDIR
SKIPN TB,FOFNAM
MOVE TB,OIFNAM
JUMPN TB,.+3
TRNE SW,OUTDIR
JRST NONAME
MOVEM TB,FOFNAM
TRNE SW,LSWICH ;ARE WE DOING "/L"?
JRST GTDV5C ;YES
TXNN TA,DV.M14 ;BINARY DEVICE?
JRST NOTBIN ;NO--ERROR
SKIPN EX,FOFNAM+1 ;ANY EXTENSION?
MOVSI EX,'LIB' ;NO--USE LIB
MOVEM EX,FOFNAM+1
MOVE DN,FOFDAT+1
OPEN FOF,FOFDAT
JRST NOTAV
OUTBUF FOF,2
POPJ PP,
GTDV5C: TRNE SW,LISTIT ;ARE THERE TWO OUTPUT FILES?
JRST TUMANY ;YES
SKIPN EX,FOFNAM+1
MOVSI EX,'LST'
MOVEM EX,FOFNAM+1
MOVE TA,[XWD FOFNAM,LSTNAM]
BLT TA,LSTNAM+3
MOVE DN,FOFDAT+1
MOVEM DN,LSTDAT+1
SETZM FOFDAT+1
OPEN LST,LSTDAT
JRST NOTAV
OUTBUF LST,2
DEVCHR DN,
TXNE DN,DV.TTU
IORI SW,LSTTY
POPJ PP,
;SCAN 'DEV:FILE.EXT[P,P]
GTDEV6: MOVEM CP,SAVECP ;SAVE POINTER TO COMMAND SAVER
IFE TOPS20,<
MOVEM PJ,PTHPTR ;[27] STORE POINTER TO SFD BLOCK
>
SETZB DN,FN
SETZB EX,PJ
PUSHJ PP,SKIPBL ;SKIP OVER LEADING BLANKS.
PUSHJ PP,GETSIX
CAIE CH,":"
JRST GTDV6B
MOVE DN,TA
PUSHJ PP,GETSIX
GTDV6B: MOVE FN,TA
CAIE CH,"."
JRST GTDV6C
PUSHJ PP,GETSIX
HLLZ EX,TA
GTDV6C: CAIE CH,"["
POPJ PP,
PUSHJ PP,GETOCT
CAIN CH,"-" ;[27] CHECK FOR [-]
JRST [JUMPN TA,BADPP ;[27] BUT ONLY ALLOW "-"
IFN TOPS20,< MOVE PJ,MYPPN ;[27] GET DEFAULT>
IFE TOPS20,< MOVEI PJ,MYPATH ;[27] GET DEFAULT>
JRST GTDV6D] ;[27]
HRLZ PJ,TA
CAIE CH,","
JRST BADPP
SKIPN TA ;[27] TEST FOR [,PROG]
HLL PJ,MYPPN ;[27] AND USE DEFAULT
PUSHJ PP,GETOCT
HRR PJ,TA
SKIPN TA ;[27] TEST FOR [PROJ,]
HRR PJ,MYPPN ;[27] AND USE DEFAULT
IFE TOPS20,<
CAIE CH,"," ;[27] CHECK FOR SFDS
JRST GTDV6D ;[27] NOT
MOVEM PJ,@PTHPTR ;[27] STORE PPN IN .PTPPN
MOVE PJ,PTHPTR ;[27] POINT TO FIRST SFD-1
HRLI PJ,-<.PTMAX-.PTPPN-1> ;[27] FORM AOBJN PTR
GTDV6E: PUSHJ PP,GETSIX ;[27] GET SFD
MOVEM TA,1(PJ) ;[27] STORE SFD
CAIE CH,"," ;[27] MORE?
JRST GTDV6F ;[27] NO
AOBJN PJ,GTDV6E ;[27] LOOP
JRST BADPP ;[27] UNLESS TOO MANY
GTDV6F: SETZM 2(PJ) ;[27] END ON ZERO
MOVE PJ,PTHPTR ;[27] POINT TO PATH BLOCK
SUBI PJ,.PTPPN ;[27] BACKUP TO START OF PATH
>
GTDV6D: CAIE CH,"]" ;[27]
JRST BADPP
JRST GETTY
SKIPBL: PUSHJ PP,GETTY ;GO GET A CHAR.
CAIN CH,$SP ;IF IT'S A BLANK,
JRST SKIPBL ; IGNORE IT.
IORI SW,REGET ;REMEMBER TO REGET IT.
POPJ PP, ;RETURN.
;"/" SEEN -- CHECK FOR 'L' SWITCH
GTDEV7: PUSHJ PP,GETTY
CAIE CH,"H"
CAIN CH,"h"
JRST HELP
CAIE CH,"L"
CAIN CH,"l"
IORI SW,LSWICH
CAIE CH,"D" ;/DIRECTORY HEADER ?
CAIN CH,"d"
IORI SW,LSWICH!DSWICH
TRNE SW,LSWICH!DSWICH
JRST GETTY
PUSHJ PP,TYPEQA
OUTCHR CH
OUTSTR [ASCIZ / is not a legal switch/]
JRST GOBACK
;HELP SWITCH
HELP: MOVE 1,['LIBARY']
PUSHJ PP,.HELPR
JRST GOBACK
;IMPROPER PROJ-PROG NUMBER
BADPP: ERRORA <Improper project-programmer number>
JRST GOBACK
;TERMINATOR IS "@", SET UP NEW COMMAND FILE
GTDEV8: JUMPN DN,GTDV8A
JUMPN FN,GTDV8A
JUMPN EX,GTDV8A
JUMPN PJ,GTDV8A
GTDV8Z: PUSHJ PP,GTDEV6 ;[27] ENTER HERE WITH ALL ACCS PRE-SET TO ZERO
JRST GTDV8B
GTDV8A: PUSHJ PP,GETTY
GTDV8B: CAIL CH,$LF
CAILE CH,$FF
JRST IMPCOM
RELEASE TTY, ;THROW AWAY OLD COMMAND DEVICE
SKIPN DN
MOVSI DN,'DSK'
MOVEI TA,0
MOVE TB,DN
MOVEI TC,TTYIB
OPEN TTY,TA
JRST NOTAV
MOVE TA,FN
MOVE TB,EX
MOVEI TC,0
MOVE TD,PJ
JUMPN TB,GTDV8E
MOVSI TB,'CCL'
LOOKUP TTY,TA
SKIPA TB,EX
JRST GTDV8F
MOVE TD,PJ
GTDV8E: LOOKUP TTY,TA
JRST NOCOM
GTDV8F: IORI SW,NOTTY
HLRZ TA,.JBSA ;[13]
EXCH TA,.JBFF ;[13]
INBUF TTY,2
MOVEM TA,.JBFF ;[13]
ANDCMI SW,ENDCOM
MOVE CP,SAVECP ;RESET POINTER TO COMMAND SAVER
JRST CPOPJ1 ;SKIP RETURN
;ERRORS DETECTED WHILE SCANNING FILE COMMAND
CNTFOF: ERRORA <Cannot enter output file >
MOVEI TA,FOFNAM ;[27] POINT TO ERROR CODE
JRST GOERR ;[27] COMMON ERROR ROUTINE
CNTLST: ERRORA <Cannot enter listing file >
MOVEI TA,LSTNAM ;[27] POINT TO ERROR CODE
GOERR: PUSHJ PP,LREERR ;[27] COMMON ERROR ROUTINE
GOBACK: PUSHJ PP,SKPTTY
JRST START
NOTDEV: ERRORA <Improper device>
JRST GOBACK
NOTBIN: ERRORA <Input and output devices must be binary>
JRST GOBACK
NONAME: ERRORA <Directory devices require file names>
JRST GOBACK
NOFIND: PUSHJ PP,SAVEA ;[27] PUT ERROR CODE IN SAFE PLACE
ERRORC <Input file LOOKUP error >
MOVEI TA,ERRNAM ;[27] POINT TO LOOKUP BLOCK
JRST GOERR ;[27]
NOTAV: MOVE TA,[POINT 6,DN]
MOVE TB,[POINT 7,COMWRD]
NOTAV1: ILDB TC,TA
JUMPE TC,NOTAV2
ADDI TC,40
IDPB TC,TB
TLNE TA,770000
JRST NOTAV1
NOTAV2: MOVEI TC,0
IDPB TC,TB
PUSHJ PP,TYPEQB
OUTSTR [ASCIZ /"/]
OUTSTR COMWRD
OUTSTR [ASCIZ /" not available
/]
JRST GOBACK
NOCOM: PUSHJ PP,SAVEA ;[27] SAVE ERROR CODE
ERRORA <Cannot find command file >
MOVEI TA,ERRNAM ;[27] POINT TO ERROR CODE
JRST GOERR ;[27] COMMON ERROR ROUTINE
TUMANY: ERRORA <Only one output file allowed with /L>
JRST GOBACK
IMPCOM: ERRORA <Improper command>
JRST GOBACK
;INITIALIZE TTY.
;ENTER WITH 'JSP TA,INITTY'
INITTY: MOVEI SW,0 ;CLEAR SWITCHES
CALLI 0 ;RESET DEVICES
INIT TTY,.IOASL ;ASCII-LINE MODE
SIXBIT 'TTY'
XWD 0,TTYIB
JRST CANTTY ;NO TTY????
INBUF TTY,2
JRST (TA)
CANTTY: OUTSTR [ASCIZ "?Cannot init TTY:
"]
EXIT
;TYPE OUT '<C.R.>?'
;IF COMMAND FILE IS NOT ON TTY, TYPE OUT LATEST COMMAND.
TYPEQA: OUTSTR [ASCIZ "
?"]
TRNN SW,NOTTY
POPJ PP,
JRST TYPEQ4
;TYPE OUT '<C.R.>?'
;IF INPUT IS NOT FROM TTY, TYPE OUT LATEST LIBRARY NAME FOLLOWED BY
; PREVIOUS COMMAND.
TYPEQB: OUTSTR [ASCIZ "
?"]
TRNN SW,NOTTY
POPJ PP,
MOVE TA,[POINT 6,LASTPG]
TYPEQ2: ILDB TB,TA
JUMPE TB,TYPEQ3
ADDI TB,40
CAIN TB,":"
MOVEI TB,"-"
OUTCHR TB
JRST TYPEQ2
TYPEQ3: OUTSTR [ASCIZ " -- "]
TYPEQ4: MOVEI TB,0
IDPB TB,CP
OUTSTR COMSAV
OUTSTR [ASCIZ "
"]
MOVE CP,[POINT 7,COMSAV]
POPJ PP,
;GET INPUT AND OUTPUT DEVICES (CONT'D).
;READ NEXT SIXBIT NAME FROM COMMAND STRING INTO TA.
GETSIX: MOVEI TA,0
MOVE TB,[POINT 6,TA]
GETSX1: PUSHJ PP,GETTY
CAIG CH,"Z"
CAIGE CH,"A"
JRST GETSX3
GETSX2: SUBI CH,40
TLNE TB,770000
IDPB CH,TB
JRST GETSX1
GETSX3: CAIG CH,"9"
CAIGE CH,"0"
POPJ PP,
JRST GETSX2
;GET NEXT OCTAL NUMBER FROM COMMAND STRING INTO TA
GETOCT: MOVEI TA,0
GETOC1: PUSHJ PP,GETTY
CAIG CH,"7"
CAIGE CH,"0"
POPJ PP,
LSH TA,3
IORI TA,-"0"(CH)
CAIG TA,-1
JRST GETOC1
POPJ PP,
;GET NAME OF PROGRAM FROM TTY
GETNAM: SETZM OFFDEV
SETZM NEWNAM
SETZM NEWNAM+1
MOVE TA,[POINT 6,NEWNAM]
GTNAM0: PUSHJ PP,GETTY ;PASS OVER INTERVENING SPACES
CAIE CH,$SP
CAIN CH,$HT
JRST GTNAM0
TRNA
GTNAM1: PUSHJ PP,GETTY
CAIG CH,"Z"
CAIGE CH,"A"
JRST GTNAM3
GTNAM2: CAIN CH,"-"
MOVEI CH,":"
SUBI CH,40
CAMN TA,[POINT 6,NEWNAM+1,11]
JRST GTNM2A ;TOO BIG
IDPB CH,TA
JRST GTNAM1
GTNM2A: OUTSTR [ASCIZ /%Library module name too long - truncated to 8 characters - continuing
/]
TLZ TA,007700 ;SO WE DON'T STORE ANYTHING
JRST GTNAM1 ;GET RID OF THE REST OF THE NAME
GTNAM3: CAIG CH,"9"
CAIGE CH,"0"
CAIN CH,"-"
JRST GTNAM2
GTNM3A: CAIE CH,$SP
JRST .+3
GTNM3E: PUSHJ PP,GETTY
JRST GTNM3A
CAIN CH,"/"
JRST GTNAM7
GTNM3B: CAIL CH,$LF
CAILE CH,$FF
TRNA
JRST GTNAM5
CAIE CH,","
JRST GTNM3C
SKIPE OFFDEV
JRST GTNM3D
PUSHJ PP,GTNM10
JRST GTNM3A
GTNM3C: ERRORA <Improper character in name>
JRST SKPTTY
GTNM3D: ERRORA <Only one file allowed>
PUSHJ PP,SKPTTY
JRST GTNAM9
;GET NAME OF PROGRAM FROM COMMAND FILE (CONT'D)
GTNAM5: SKIPE NEWNAM
JRST GTNAM9
ERRORA <No name specified>
POPJ PP,
;SWITCH SEEN
GTNAM7: PUSHJ PP,GETTY
CAIN CH,"S" ;CARD IMAGE?
JRST [SETOM SEQ ;YES
JRST GTNM3E] ;EAT UP ANY SPACES
OUTSTR [ASCIZ /
?/]
OUTCHR CH
OUTSTR [ASCIZ / is not a legal switch
/]
JRST SKPTTY
GTNAM9: MOVE CH,[XWD NEWNAM,LASTPG]
BLT CH,LASTPG+1
JRST CPOPJ1
;COMMA SEEN -- SCAN FILE NAME
GTNM10:
IFE TOPS20,<
MOVEI PJ,OFFPTH+.PTPPN ;[27] SFD PATH
>
PUSHJ PP,GTDEV6
SKIPN DN
MOVSI DN,'DSK'
MOVEM DN,OFFDEV
MOVEM FN,OFFNAM
HLLZM EX,OFFNAM+1
MOVEM PJ,OFFNAM+3
POPJ PP,
;COMPARE "NEWNAM" AGAINST TWO WORDS WHOSE ADDRESS IS IN TB.
;EXIT TI CALL+1 IF NEWNAM<(TB)
;EXIT TO CALL+2 IF NEWNAM>(TB)
;EXIT TO CALL+3 IF NEWNAM=(TB)
COMPAR: SKIPL TC,NEWNAM
JRST COMP3
SKIPL (TB)
JRST CPOPJ1
COMP1: CAMN TC,(TB)
JRST COMP2
CAMLE TC,(TB)
AOS (PP)
POPJ PP,
COMP2: HLRZ TC,NEWNAM+1
HLRZ TD,1(TB)
LSH TC,-6
LSH TD,-6
CAMN TC,TD
AOSA (PP)
CAMLE TC,TD
AOS (PP)
POPJ PP,
COMP3: SKIPL (TB)
JRST COMP1
POPJ PP,
;COPY A LINE FROM TTY TO OUTPUT BUFFER
PUTLIN: MOVEI WD,^D10*2
SKIPA WD,COMLIN
MOVEM WD,OUTLIN
TRO SW,CHAR1 ;[15] SET "THIS IS FIRST CHAR"
PUTLI1: PUSHJ PP,PUTTOF
MOVEI WD,0
MOVE TB,[POINT 7,WD]
PUTLI2: PUSHJ PP,GETTY
TRZE SW,CHAR1 ;[15] IS THIS THE 1ST CHAR?
CAIE CH,$SP ;[15] IGNORE IF LEADING SPACE
IDPB CH,TB
CAIL CH,$LF
CAILE CH,$FF
TRNA
JRST PUTTOF
TLNE TB,760000
JRST PUTLI2
JRST PUTLI1
;PUT INPUT NAME INTO OUTPUT DIRECTORY
PUTINM: MOVE TA,INNAM
MOVEM TA,OUTNAM
MOVE TA,INNAM+1
MOVEM TA,OUTNAM+1
MOVE TA,INSEQ
MOVEM TA,OUTSEQ
JRST PUTNAM
;PUT NEW NAME INTO OUTPUT DIRECTORY
PUTNNM: MOVE TA,NEWNAM
MOVEM TA,OUTNAM
MOVE TA,NEWNAM+1
MOVEM TA,OUTNAM+1
TRNN SW,LISTIT ;ANY LISTING FILE?
JRST PUTNAM ;NO
IORI SW,DOLIST ;YES--SET "LIST THIS PROGRAM" FLAG
SETZM PAGNO ;[24] PAGE 1
PUSHJ PP,LSTHDG ;PUT OUT HEADING LINE
;PUT OUTPUT NAME INTO DIRECTORY.
;IF THIS IS THE FIRST WORD OF A DIRECTORY BLOCK, PUT ENTRY INTO ROUGH TABLE.
PUTNAM: MOVE TC,TOFCTR ;IS FILE TOO LARGE?
TLNE TC,377700
JRST PUTNM6 ;YES
HLLZ TB,OUTNAM+1 ;NO
TLZ TB,77
IOR TB,TC
SKIPE OUTSEQ ;SEQUENCED OUTPUT?
TLO TB,SEQFLG ;YES, SET SEQ BIT
MOVE TA,PRGCTR ;ARE WE ABOUT TO WRITE FIRST WORD OF A BLOCK?
TRNE TA,77
JRST PUTNM2 ;NO
MOVE TA,RUFCTR ;YES--IS ROUGH TABLE FULL?
CAILE TA,176
JRST PUTNM5 ;YES
MOVE TC,OUTNAM
MOVEM TC,RUFTAB(TA)
HLLZ TC,OUTNAM+1
TLZ TC,77
IOR TC,FINCTR
MOVEM TC,RUFTAB+1(TA)
MOVEI TC,200
ADDM TC,FINCTR
MOVEI WD,2
ADDM WD,RUFCTR
PUTNM2: AOS PRGCTR
MOVEI WD,2
ADDM WD,OFFSET
MOVE WD,OUTNAM
PUSHJ PP,PUTTOD
MOVE WD,TB
JRST PUTTOD
;ROUGH TABLE IS FULL
PUTNM5: ERRORA <Too many programs>
JRST KILLIM
;FILE TOO LARGE
PUTNM6: ERRORA <File too large>
JRST KILLIM
;GET A CHARACTER FROM COMMAND FILE.
;PRINTER-CONTROL CHARACTERS (EXCEPT FORM-FEED) ARE CONVERTED
; TO LINE-FEEDS.
;CARRIAGE-RETURNS AND NULLS ARE IGNORED.
GETTY: TRNE SW,ENDCOM ;COMMAND FILE EMPTY?
JRST GETY2A ;YES
TRZE SW,REGET ;REGET LAST CHARACTER?
JRST GETTY4 ;YES
SOSG TTYIB+2 ;NO--GET NEXT ONE
JRST GETTY5
GETTY0: ILDB CH,TTYIB+1
GETTY1: CAIN CH,$HT ;CONVERT TABS TO BLANKS.
MOVEI CH,$SP
CAIN CH,$CR
JRST GETTY
CAIL CH,"a" ;[23] IS THIS CHARACTER
CAILE CH,"z" ;[23] A LOWER CASE CHARACTER?
TRNA ;[23] NO GO ON
SUBI CH,40 ;[23] YES CONVERT TO UPPER CASE
CAIN CH,$CZ
JRST GETY5A
JUMPE CH,GETTY
CAIE CH,$VT
CAIN CH,$FF
JRST GETY2A
CAIG CH,$DC4
CAIGE CH,$DLE
JRST GETTY7
GETTY2: TRNN SW,NOTTY
OUTSTR [ASCIZ "
"]
GETY2A: MOVEI CH,$LF
DPB CH,TTYIB+1
POPJ PP,
GETTY4: LDB CH,TTYIB+1
JRST GETTY1
;GET CHARACTER FROM COMMAND FILE (CONT'D).
;GET ANOTHER BUFFER FULL
GETTY5: IN TTY,
JRST GETTY0
GETSTS TTY,CH ;END-OF-FILE?
TRNN CH,IO.EOF
JRST GETTY6 ;NO
GETY5A: IORI SW,ENDCOM ;YES
JRST GETY2A
GETTY6: OUTSTR [ASCIZ "
?Read error on command file
"]
JRST START
;PUT CHARACTER INTO COMMAND STREAM SAVER
GETTY7: CAME CP,[POINT 7,COMSAV+8,27]
IDPB CH,CP
POPJ PP,
;DISPLAY "IMPROPER COMMAND" AND SKIP TO END OF LINE
BADCOM: ERRORB <Improper command>
;SKIP THE REST OF THE TTY INPUT LINE
SKPTTY: IORI SW,REGET
SKPTT1: PUSHJ PP,GETTY
CAIL CH,$LF
CAILE CH,$FF
JRST SKPTT1
POPJ PP,
;WRITE CONTENTS OF "WD" ONTO LISTING FILE
PUTLST: TRNN WD,1 ;SEQUENCE NUMBER?
JRST PUTL6 ;NO
SKIPGE TE,WD ;YES-- GET LINE NUMBER (BITS 0-34)
POPJ PP, ;LINE NUMBER WAS NEGATIVE--FORGET IT
LSH TE,-1
MOVE TG,[XWD -6,DECIML]
PUTL1: IDIV TE,(TG)
MOVEI CH,"0"(TE)
PUSHJ PP,PUTL2
MOVE TE,TE+1
AOBJN TG,PUTL1
MOVEI CH,$HT
;PUT A SINGLE CHARACTER OUT ONTO LISTING FILE
PUTL2: SOSG LSTBH+2
JRST PUTL4
PUTL3: IDPB CH,LSTBH+1
POPJ PP,
PUTL4: OUT LST,
JRST PUTL3
JRST LSTERA
PUTL6: SKIPA TE,[POINT 7,WD]
PUTL7: PUSHJ PP,PUTL2
PUTL8: TLNN TE,760000
POPJ PP,
ILDB CH,TE
JUMPE CH,PUTL8
CAIL CH,$LF
CAILE CH,$FF
JRST PUTL7
MOVEI CH,$CR
PUSHJ PP,PUTL2
LDB CH,TE
PUTL9: MOVEI TE,LINPAG
CAIN CH,$FF
MOVEM TE,LINECT
JRST PUTL2
;WRITE OUT HEADING LINE ONTO LISTING FILE
LSTHDG: TRNE SW,LSTTY ;IS LISTING ON CONSOLE?
JRST LSTHD6 ;YES
TRNE SW,DSWICH ;DIRECTORY HEADER ONLY?
JRST LSTHD1 ;THEN NO PAGE OR LINE CHARACTERS
MOVE CH,LINECT
CAIN CH,LINPAG
JRST LSTHD1
MOVEI CH,$CR
PUSHJ PP,PUTL2
MOVEI CH,$FF
PUSHJ PP,PUTL2
LSTHD1: MOVE TE,[POINT 6,OUTNAM]
LSTHD2: ILDB CH,TE
JUMPE CH,LSTHD5
ADDI CH,40
CAIN CH,":"
MOVEI CH,"-"
PUSHJ PP,PUTL2
MOVEI CH,$SP
TRNN SW,DSWICH ;DONT GET FANCY
PUSHJ PP,PUTL2
JRST LSTHD2
LSTHD3: MOVE TE,OUTNAM+1
TLNN TE,SEQFLG ;TEST FOR SEQUENCED
JRST LSTH3A ;NO
MOVE TE,[POINT 7,[ASCIZ \/S\]]
PUSHJ PP,PUTMES
LSTH3A: MOVE TE,[POINT 7,HEADER] ;[26]
PUSHJ PP,PUTMES ;[26]
AOS TE,PAGNO ;[24] GET PAGE NUMBER
PUSHJ PP,PUTDEC ;[24] OUTPUT IT
MOVE TE,[POINT 7,[ASCIZ "
"]] ;[24]
LSTHD4: PUSHJ PP,PUTMES ;[26] [24] OUTPUT CRLF-CRLF
MOVEI CH,LINPAG-1
MOVEM CH,LINECT
POPJ PP,
LSTHD5: TRNN SW,DSWICH ;/DIRECTORY HEADER ONLY?
JRST LSTHD3 ;NOP
MOVE TE,OUTNAM+1
TLNE TE,SEQFLG ;SEQUENCED?
SKIPA TE,[POINT 7,[ASCIZ \ /S
\]]
MOVE TE,[POINT 7,[ASCIZ /
/]]
;[26] ILDB CH,TE ;GET FIRST CHAR
JRST LSTHD4 ;OUTPUT END OF LINE
LSTHD6: MOVE TE,[POINT 7,[ASCIZ "
*** PROGRAM "]]
TRNN SW,DSWICH ;/DIRECTORY HEADER MEANS NAME ONLY
PUSHJ PP,PUTMES
MOVE TE,[POINT 6,OUTNAM]
LSTHD7: ILDB CH,TE
ADDI CH,40
CAIN CH,":"
MOVEI CH,"-"
PUSHJ PP,PUTL2
CAME TE,[POINT 6,OUTNAM+1,11]
JRST LSTHD7
MOVE TE,OUTNAM+1
TLNN TE,SEQFLG ;SEQUENCED?
JRST LSTHD8 ;NO
MOVE TE,[POINT 7,[ASCIZ \ /S\]]
PUSHJ PP,PUTMES
LSTHD8:
MOVE TE,[POINT 7,[ASCIZ "
"]]
TRNE SW,DSWICH ;ONLY ONE CRLF IF /DIRECTORY
MOVE TE,[POINT 7,[ASCIZ "
"]]
PUSHJ PP,PUTMES
HRLOI CH,377777
MOVEM CH,LINECT
POPJ PP,
LSTFIN: TRNE SW,DOLIST ;[20] IS THERE A LIST FILE?
OUT LST, ;[20] YES OUTPUT LAST BUFFER
POPJ PP, ;[20] GO BACK
JRST LSTERA ;[20] LISTING ERROR
;PUT DATE AND TIME INTO HEADING LINE
DATIME: DATE TE, ;GET DATE
IDIVI TE,^D31*^D12 ;TE=YEAR
IDIVI TF,^D31 ;TF=MONTH,TG=DAY
ADDI TG,1
PUSHJ PP,DATIM9
TRNN TG,3600
TRZ TG,4000
DPB TG,[POINT 14,HDATE,34]
MOVE TG,MOTABL(TF)
DPB TG,[POINT 21,HDATE+1,27]
MOVEI TG,^D64(TE)
CAIL TG,^D100 ;CK FOR YR 2000+
SUBI TG,^D100 ;IF SO, CHANGE TO 00+
PUSHJ PP,DATIM9
DPB TG,[POINT 14,HDATE+2,13]
MSTIME TF, ;GET TIME IN MILLISECONDS
IDIVI TF,^D1000*^D60 ;CONVERT TO MINUTES
IDIVI TF,^D60
PUSHJ PP,DATIM9
DPB TG,[POINT 14,HTIME,34]
MOVE TG,TF
PUSHJ PP,DATIM9
DPB TG,[POINT 14,HTIME,13]
POPJ PP,
DATIM9: IDIVI TG,^D10
LSH TG,7
ADDI TG,"00"(TH)
POPJ PP,
;[24] OUTPUT DECIMAL NUMBER IN TE
PUTDEC: IDIVI TE,^D10 ;[24] DIVIDE BY RADIX
HRLM TF,(PP) ;[24] SAVE DIGIT
SKIPE TE ;[24] ANYTHING LEFT?
PUSHJ PP,PUTDEC ;[24] YES, LOOP BACK
HLRZ CH,(PP) ;[24] GET DIGIT
ADDI CH,"0" ;[24] CONVERT TO ASCII
JRST PUTL2 ;[24] OUTPUT IT
;[27] OUTPUT OCTAL NUMBER IN TE
PUTOCT: IDIVI TE,8 ;[27] DIVIDE BY RADIX
HRLM TF,(PP) ;[27] SAVE DIGIT
SKIPE TE ;[27] ANYTHING LEFT?
PUSHJ PP,PUTOCT ;[27] YES, LOOP BACK
HLRZ CH,(PP) ;[27] GET DIGIT
ADDI CH,"0" ;[27] CONVERT TO ASCII
OUTCHR CH ;[27] OUTPUT IT
POPJ PP, ;[27] GET NEXT OR RETURN
;OUTPUT ROUTINES
;PUT A WORD ONTO TEMPORARY OUTPUT FILE
PUTTOD: SOSG TODOB+2
JRST PTOD2
PTOD1: IDPB WD,TODOB+1
POPJ PP,
PTOD2: OUT TOD,
JRST PTOD1
JRST SCROE
;PUT A WORD ONTO TEMPORARY INPUT DIRECTORY
PUTTID: SOSG TIDOB+2
JRST PTID2
PTID1: IDPB WD,TIDOB+1
POPJ PP,
PTID2: OUT TID,
JRST PTID1
JRST SCROE
;PUT A WORD ONTO FINAL OUTPUT FILE
PUTFOF: SOSG FOFOB+2
JRST PFOF2
PFOF1: IDPB WD,FOFOB+1
POPJ PP,
PFOF2: OUT FOF,
JRST PFOF1
JRST SCROE
;PUT A WORD ONTO TEMPORARY OUTPUT FILE
PUTTOF: AOS TOFCTR
SOSG TOFOB+2
JRST PTOF2
PTOF1: IDPB WD,TOFOB+1
TRNE SW,DOLIST
PUSHJ PP,PUTLST
POPJ PP,
PTOF2: OUT TOF,
JRST PTOF1
JRST SCROE
;INPUT ROUTINES
;GET A WORD FROM TEMPORARY OUTPUT DIRECTORY
GETTOD: SOSG TODIB+2
JRST GTOD2
GTOD1: ILDB WD,TODIB+1
POPJ PP,
GTOD2: IN TOD,
JRST GTOD1
JRST SCRIE
;GET A WORD FROM TEMPORARY INPUT DIRECTORY
GETTID: TRNE SW,ENDF ;ANY MORE INPUT FILE?
JRST GOIF3 ;NO
SOSG TIDIB+2
JRST GTID2
GTID1: ILDB WD,TIDIB+1
POPJ PP,
GTID2: IN TID,
JRST GTID1
JRST SCRIE
;GET A WORD FROM TEMPORARY OUTPUT FILE
GETTOF: SOSG TOFIB+2
JRST GTOF2
GTOF1: ILDB WD,TOFIB+1
JRST CPOPJ1
GTOF2: IN TOF,
JRST GTOF1
GETSTS TOF,WD
TRNE WD,IO.ERR
JRST SCRIE
POPJ PP,
;INPUT ROUTINES (CONT'D).
;GET A WORD FROM OLD INPUT FILE
GETOIF: TRNE SW,ENDF ;ANY MORE INPUT FILE?
JRST GOIF3 ;NO
SOSG OIFIB+2
JRST GOIF2
GOIF1: ILDB WD,OIFIB+1
POPJ PP,
GOIF2: IN OIF,
JRST GOIF1
JRST INPERA
GOIF3: MOVNI WD,1
POPJ PP,
;SET UP ANY 'OFF-LINE' FILE FOR INPUT
SETOFF: SKIPN OFFDEV
JRST CPOPJ1
SKIPN TA,OFFBUF
HRRZ TA,.JBFF ;[13]
HRRM TA,.JBFF ;[13]
MOVEM TA,OFFBUF
MOVEI TA,0
MOVE TB,OFFDEV
MOVEI TC,OFFBH
OPEN OFF,TA
JRST NOOFFD
INBUF OFF,2
MOVE TE,[XWD OFFNAM,TA]
BLT TE,TD
LOOKUP OFF,TA
JRST NOOFFL
JRST CPOPJ1
NOOFFD: OUTSTR [ASCIZ /?Device does not exist
/]
POPJ PP,
NOOFFL: PUSHJ PP,SAVEA ;[27] SAVE ERROR CODE
OUTSTR [ASCIZ /?Cannot find file /]
MOVEI TA,ERRNAM ;[27] POINT TO ERROR CODE
PUSHJ PP,LREERR ;[27] COMMON ERROR ROUTINE
CRLF: OUTSTR [ASCIZ /
/] ;[27] CR-LF
POPJ PP, ;[27]
;COPY PROGRAM FROM 'OFF-LINE' FILE
COPOFF: MOVEI TA,1 ;SET LINE # TO ZERO
MOVEM TA,OUTLIN
PUSHJ PP,GETOFF ;GET A CHARACTER
JUMPE CH,CPOPJ ;IF END-OF-FILE -- QUIT
COPF01: MOVE TA,@OFFBH+1 ;ANY SEQ #?
TRNN TA,1
JRST COPF06 ;NO
CAME TA,[<ASCII / />+1] ;SOS PAGE MARK?
JRST COPF03 ;NO
MOVE WD,TA ;YES
PUSH PP,SW ;SAVE SWITCHES
TRZ SW,DOLIST ;TURN OFF LISTING OF SOS PAGE MARK
PUSHJ PP,PUTTOF ;OUTPUT IT AS IS
AOS OFFBH+1 ;BYPASS IT
MOVNI TB,5
ADDM TB,OFFBH+2 ;NOTE, WE WILL READ SECOND BYTE OF WORD, BUT IT IS OK
PUSHJ PP,GETOFF ;GET NEXT WORD
MOVE WD,@OFFBH+1 ;GET CR-FF
PUSHJ PP,PUTTOF ;OUTPUT IT AS IS
POP PP,SW ;GET SWITCHES BACK
TRNN SW,DOLIST ;NEED LISTING?
JRST COPOFF ;NO, JUST READ NEXT LINE
MOVEI CH,$FF ;YES, FAKE UP FORM FEED
PUSHJ PP,PUTL9 ;OUTPUT IT AND RESET LINE COUNTERS
JRST COPOFF ;READ NEXT LINE
COPF03: MOVEI WD,0
MOVEI TB,5
COPF04: IMULI WD,^D10
ADDI WD,-"0"(CH)
PUSHJ PP,GETOFF
SOJG TB,COPF04
LSH WD,1
IORI WD,1
COPF05: PUSHJ PP,GETOFF ;GET FIRST DATA CHARACTER
MOVEI TA,1 ;CLEAR "SEQ" FLAG
ANDCMI TA,@OFFBH+1 ; IN THAT WORD
CAMLE WD,OUTLIN
JRST COPF07
COPF06: MOVEI WD,^D10*2
ADD WD,OUTLIN
COPF07: MOVEM WD,OUTLIN
;COPY 'OFF-LINE' FILE (CONT'D)
COPF08: PUSH PP,CH
PUSHJ PP,PUTTOF ;PUT OUT ONE WORD
POP PP,CH
MOVE TB,[POINT 7,WD] ;RESET
MOVEI WD,0 ; WORD
COPF09: JUMPE CH,COPF10 ;[EDIT#10]
IDPB CH,TB ;[EDIT#10]
CAIG CH,$FF ;END OF LINE?
CAIGE CH,$LF ;I.E. LF, VT, OR FF
TRNA ;NO
JRST COPF11 ;YES
PUSHJ PP,GETOFF ;NO--GET ANOTHER
MOVE TA,@OFFBH+1 ;SEQ #?
TRNE TA,1
JRST COPF10 ;YES
TLNE TB,760000 ;NO--IS OUTPUT WORD FULL?
JRST COPF09 ;NO
JRST COPF08 ;YES
COPF10: MOVEI TA,$LF ;STASH END-OF-LINE
IDPB TA,TB
JRST COPF12
COPF13: DPB CH,TB ;REPLACE LF BY VT OR FF
COPF11: PUSHJ PP,GETOFF ;GET CHARACTER AFTER LINE-FEED
CAIE CH,$VT ;CHECK FOR VT
CAIN CH,$FF ;AND FORM-FEED
JRST COPF13 ;AS THESE ARE SPECIAL
COPF12: PUSH PP,CH
PUSHJ PP,PUTTOF ;PUT OUT FINAL WORD FOR LINE
POP PP,CH
JUMPE CH,CPOPJ ;[24] FINISH UP IF EMPTY
TRNE SW,DOLIST ;[24] SKIP IF NO LISTING FILE
SOSLE LINECT ;[24] ROOM LEFT ON PAGE?
JRST COPF01 ;[24] LOOP UNTIL END-FILE
PUSH PP,CH ;[24] SAVE IT AGAIN
PUSHJ PP,LSTHDG ;[24] START AGAIN
POP PP,CH ;[24] GET CHAR BACK
JRST COPF01 ;[24] LOOP UNTIL END-FILE
;GET CHARACTER FROM 'OFF-LINE' FILE
GETOFF: SOSG OFFBH+2
JRST GETOF3
GETOF1: ILDB CH,OFFBH+1
CAILE CH,32 ;POSSIBLY AN INTERESTING CONTROL CHARACTER?
POPJ PP, ;NO, JUST RETURN WHAT WE FOUND
JUMPE CH,GETOFF ;IGNORE NULLS
CAIN CH,$CR ;AND CARRIAGE-RETURNS
JRST GETOFF
CAIN CH,$CZ ;^Z
JRST GETOF4 ;YES, SEE IF FROM TERMINAL
CAIG CH,$DC4 ;JUST RETURN THE NON-INTERESTING CONTROL CHARS.
CAIGE CH,$LF
POPJ PP,
CAIL CH,$DLE ;CONVERT 20-24 INTO LF
GETOF2: MOVEI CH,$LF
POPJ PP, ;RETURN LF, VT, FF
GETOF3: IN OFF,
JRST GETOF1
STATZ OFF,IO.ERR
OUTSTR [ASCIZ "
?Read error on insertion file
"]
MOVEI CH,0
RELEASE OFF,
POPJ PP,
GETOF4: MOVEI CH,OFF ;SEE IF DEVICE IS TERMINAL
DEVCHR CH,
TXNE CH,DV.TTY ;TEST DV.TTY BIT
JRST GETOFF ;IT IS, THROW AWAY ^Z
MOVEI CH,32 ;ITS NOT
POPJ PP, ;ASSUME USER KNOWS WHAT HE'S DOING
;PUT LINE NUMBER INTO 'OFF-LINE' FILE
OFFNUM: MOVE TA,OFFBH+1 ;MAKE
TLNN TA,760000 ; SURE
JRST OFFNM1 ; WE
MOVEI CH,0 ; ARE
PUSHJ PP,PUTOFF ; AT
JRST OFFNUM ; WORD BOUNDARY
OFFNM1: SOS TA,WD ;GET LINE NUMBER BACK
LSH TA,-1 ;SHIFT OFF BIT 35
MOVSI TC,1B18 ;GET READY TO SHIFT IN A NUMBER
OFFNM2: IDIVI TA,^D10 ;GET LOW-OERDER DIGIT INTO TB
ADDI TB,"0" ;CONVERT TO ASCII
LSHC TB,-7 ;SHIFT IT INTO TC
TRNN TC,1 ;IF WE DON'T HAVE FIVE DIGITS,
JRST OFFNM2 ; LOOP
MOVE TA,[POINT 7,TC]
OFFNM3: ILDB CH,TA ;GET HIGH-ORDER DIGIT
PUSHJ PP,PUTOFF ;WRITE IT OUT
TLNE TA,760000 ;LOOP UNTIL
JRST OFFNM3 ; FIVE DIGITS OUT
MOVEI TA,1 ;SET
IORM TA,@OFFBH+1 ;[12] BIT 35
MOVEI CH,$HT ;PUT OUT TAB AND
JRST PUTOFF ; RETURN
;PUT A CHARACTER INTO 'OFF-LINE' FILE
PUTOFF: SOSG OFFBH+2 ;IF BUFFER IS FULL,
JRST PUTOF2 ; WRITE IT OUT
PUTOF1: IDPB CH,OFFBH+1 ;STASH CHARACTER
POPJ PP, ;EXIT
PUTOF2: OUT OFF, ;WRITE OUT A BUFFER FULL
JRST PUTOF1 ;NO ERRORS--ALL IS WELL
ERRORA <Output error on extraction file>
JRST KILLIM ;TOUGH
;CLOSE OUT TEMPORARY OUTPUT FILES AFTER COPYING REST OF INPUT
CLOSOT: TRNE SW,ENDF ;END OF INPUT SEEN?
JRST CLSOT1
ANDCMI SW,ENDP
PUSHJ PP,PUTINM
PUSHJ PP,COPYP
JRST CLOSOT
CLSOT1: MOVNI WD,1
PUSHJ PP,PUTTOD
AOS OFFSET
CLOSE TOD, ;CLOSE OUTPUT DIRECTORY
CLOSE TOF, ;CLOSE OUTPUT PROGRAMS
CLOSE OIF, ; [17] CLOSE ORIGNAL FILE
POPJ PP,
;CREATE "BAK" FILE IF NECESSARY.
;SET UP OUTPUT FILE.
SETBAK: TRNN SW,NOINP ;ANY INPUT DEVICE?
TRNN SW,INDIR ;YES--DIRECTORY DEVICE?
JRST SETBK4 ;NO
MOVE TA,OIFNAM ;SAME NAME FOR
CAME TA,FOFNAM ; INPUT AND OUTPUT?
JRST SETBK4 ;NO
HLLZ TA,OIFNAM+1 ;YES--SAME EXTENSION?
HLLZ TB,FOFNAM+1
CAME TA,TB
JRST SETBK4 ;NO
MOVE TA,OIFNAM+3
CAME TA,FOFNAM+3
JRST SETBK4
;INPUT FILE SHOULD BE CHANGED TO HAVE EXTENSION "BAK"
MOVE TA,OIFNAM ;ANY BACKUP FILE ALREADY?
MOVSI TB,'BAK'
MOVEI TC,0
MOVE TD,OIFNAM+3
LOOKUP TOD,TA
JRST SETBK5 ;NO
CLOSE TOD, ;YES--DELETE IT
SETZB TA,TB
SETZB TC,TD
RENAME TOD,TA
JRST SETBK6 ;COULDN'T DELETE
SETBK2: MOVE TA,OIFNAM ;RENAME INPUT FILE
HLLZ TB,OIFNAM+1
MOVEI TC,0
MOVE TD,OIFNAM+3
LOOKUP TOD,TA
JRST SETBK9 ;CAN'T FIND IT NOW
CLOSE TOD,
HRLI TB,'BAK'
MOVE TD,OIFNAM+3
RENAME TOD,TA
JRST SETBK9
;NOW SET UP OUTPUT FILE
SETBK4: ENTER FOF,FOFNAM
JRST CNTFOF
POPJ PP,
;RENAME INPUT FILE TO "BAK" (CONT'D)
SETBK5: TRNN TB,-1 ;[27] COULDN'T FIND "BAK"--IS IT THERE?
JRST SETBK2 ;[27] IF JUMP--IT REALLY WASN'T THERE
SETBK6: PUSHJ PP,SAVEA ;[27] SAVE ERROR CODE
OUTSTR [ASCIZ /
?Cannot delete "BAK" file /]
SETBK7: PUSHJ PP,LREERR ;[27] COMMON ERROR ROUTINE
OUTSTR [ASCIZ "
writing "]
MOVE TA,[POINT 6,TIDNAM]
SETBK8: ILDB TB,TA
ADDI TB,40
OUTCHR TB
CAME TA,[POINT 6,TIDNAM,17]
JRST SETBK8
OUTSTR [ASCIZ "LIB.LIB as output file
"]
MOVE TA,TIDNAM
HRRI TA,'LIB'
MOVEM TA,FOFNAM
HRLZM TA,FOFNAM+1
JRST SETBK4
SETBK9: PUSHJ PP,SAVEA ;[27] SAVE ERROR CODE
OUTSTR [ASCIZ /
?Cannot rename input to "BAK" /]
JRST SETBK7
;ERROR ROUTINES
DIRERA: OUTSTR [ASCIZ "?Error reading table
"]
JRST KILL2
TRBL1: OUTSTR [ASCIZ "?First word not line number
"]
JRST KILL2
TRBL2: OUTSTR [ASCIZ "?Imbedded line number
"]
JRST KILL2
NODSK: OUTSTR [ASCIZ /
?DSK: is not a device/]
JRST KILLIM
NOEDSK: OUTSTR [ASCIZ /
?Can't enter a scratch file on DSK: /]
MOVEI TA,TIDNAM ;[27] POINT TO ERROR CODE
PUSHJ PP,LREERR ;[27] COMMON ERROR ROUTINE
JRST KILLIM
NOEOFF: PUSHJ PP,SAVEA ;[27] SAVE ERROR CODE
ERRORA <Cannot enter extraction file >
MOVEI TA,ERRNAM ;[27] POINT TO ERROR CODE
PUSHJ PP,LREERR ;[27] COMMON ERROR ROUTINE
JRST KILLIM
NOLDSK: OUTSTR [ASCIZ /
?Can't find a scratch file on DSK: /]
PUSHJ PP,LREERR ;[27] COMMON ERROR ROUTINE
JRST KILLIM
NOPROG: ERRORA <That program not found>
JRST NEWCOM
SCROE: OUTSTR [ASCIZ "
?Output error on scratch file"]
JRST KILLIM
SCRIE: OUTSTR [ASCIZ "
?Read error on scratch file"]
JRST KILLIM
LSTERA: OUTSTR [ASCIZ "
?Output error on listing file
"]
JRST KILLIM
INPERA: OUTSTR [ASCIZ "
?Error reading input file"]
KILLIM: CALLI 0 ;THROW AWAY ALL OUTPUT FILES
KILL2: EXIT ;GIVE UP
;[27] CALLED WITH ADDRESS OF LOOKUP/ENTER BLOCK IN TA
LREERR: HRRZ TB,1(TA) ;[27] GET ERROR CODE ONLY
CAIL TB,LRELEN ;[27] MAKE SURE ITS LEGAL
PUSHJ PP,DEFERR ;[27] NO, USE DEFAULT
OUTSTR @LRETAB(TB) ;[27]
SKIPN TC,(TA) ;[27] NON-ZERO FILE NAME?
POPJ PP, ;[27] NO, GIVE UP
PUSHJ PP,PUTSIX ;[27] PRINT FILE-NAME
OUTSTR [ASCIZ /./] ;[27]
HLLZ TC,1(TA) ;[27] GET EXTENSION
PUSHJ PP,PUTSIX ;[27]
SKIPN TE,3(TA) ;[27] GET PPN
POPJ PP, ;[27] FINISHED
OUTSTR [ASCIZ /[/] ;[27] START PPN
IFE TOPS20,<
TLNN TE,-1 ;[27] SFD?
JRST LRESFD ;[27] YES
>
HLRZ TE,TE ;[27] PROJ#
PUSHJ PP,PUTOCT ;[27]
OUTSTR [ASCIZ /,/] ;[27]
HRRZ TE,3(TA) ;[27] PROG#
PUSHJ PP,PUTOCT ;[27]
LREEND: OUTSTR [ASCIZ /]/] ;[27]
POPJ PP, ;[27]
IFE TOPS20,<
LRESFD: MOVEI TA,.PTPPN(TE) ;[27] POINT TO PPN
HLRZ TE,(TA) ;[27] PROJ#
PUSHJ PP,PUTOCT ;[27]
OUTSTR [ASCIZ /,/] ;[27]
HRRZ TE,(TA) ;[27] PROG#
PUSHJ PP,PUTOCT ;[27]
LRESF1: SKIPN TC,1(TA) ;[27] GET NEXT SFD
JRST LREEND ;[27] FINISHED
OUTSTR [ASCIZ /,/] ;[27]
PUSHJ PP,PUTSIX ;[27]
AOJA TA,LRESF1 ;[27] LOOP
>
;[27] OUTPUT SIXBIT WORD IN TC, USING TB
PUTSIX: SETZ TB, ;[27] CLEAR JUNK
LSHC TB,6 ;[27] GET CHAR.
ADDI TB,$SP ;[27] MAKE ASCII
OUTCHR TB ;[27]
JUMPN TC,PUTSIX ;[27] LOOP IF ANY LEFT
POPJ PP, ;[27]
LRETAB: [ASCIZ \(0) file was not found \]
[ASCIZ \(1) no directory for 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 empty \]
[ASCIZ \(25) SFD nested too deeply \]
[ASCIZ \(26) no-create on for specified SFD path \]
[ASCIZ \(27) segment not on swap space \]
[ASCIZ \(30) can't update file \]
[ASCIZ \(31) low segment overlaps high segment \]
LRELEN==.-LRETAB
[ASCIZ \) unknown error \]
DEFERR: OUTSTR [ASCIZ \(\] ;[27]
HRRZ TE,1(TA) ;[27] GET ERROR NUMBER
PUSHJ PP,PUTOCT ;[27] OUTPUT IT IN OCTAL
MOVEI TB,LRELEN ;[27] USE DEFAULT MESSAGE
POPJ PP, ;[27] RETURN TO PRINT IT
;[27] STORE LOOKUP/ENTER BLOCK IN CURRENTLY IN AC TA-TD IN ERRNAM
SAVEA: MOVEM TA,ERRNAM ;[27] SAVE LOOKUP BLOCK
MOVEM TB,ERRNAM+1 ;[27] SAVE EXT AND ERROR CODE
MOVEM TC,ERRNAM+2 ;[27]
MOVEM TD,ERRNAM+3 ;[27]
MOVEI TA,ERRNAM ;[27] POINT TO IT
POPJ PP, ;[27]
PPLEN==^D20 ;LENGTH OF PUSHDOWN STACK
PPOINT: IOWD PPLEN,PPTABL
TTYC1: POINT 6,COMWRD,5
DECIML: DEC 100000
DEC 10000
DEC 1000
DEC 100
DEC 10
DEC 1
;TABLE OF MONTHS
MOTABL: "JAN"
"FEB"
"MAR"
"APR"
"MAY"
"JUN"
"JUL"
"AUG"
"SEP"
"OCT"
"NOV"
"DEC"
;THESE ARE THE VALUES THAT ARE JAMMED INTO IMPURE AREA BETWEEN
; LOWIMP AND HIIMP
IMPVAL: ASCII " COBOL LIBRARY"
ASCIZ " XX-XXX-XX XX:XX PAGE " ;[24]
OCT .IOBIN ;TOF DATA
SIXBIT "DSK"
XWD TOFOB,TOFIB
SIXBIT " S01"
SIXBIT "TMP"
OCT 0
OCT 0
OCT .IOBIN ;TOD DATA
SIXBIT "DSK"
XWD TODOB,TODIB
SIXBIT " S02"
SIXBIT "TMP"
OCT 0
OCT 0
OCT .IOBIN ;TID DATA
SIXBIT "DSK"
XWD TIDOB,TIDIB
SIXBIT " S03"
SIXBIT "TMP"
OCT 0
OCT 0
OCT .IOBIN ;FOF DATA
OCT 0
XWD FOFOB,0
OCT 0
OCT 0
OCT 0
OCT 0
OCT .IOBIN ;OIF DATA
OCT 0
XWD 0,OIFIB
OCT 0
OCT 0
OCT 0
OCT 0
OCT .IOASC ;OFF DATA
OCT 0
OCT 0
OCT 0
OCT 0
OCT .IOASC ;LST DATA
OCT 0
XWD LSTBH,0
ENDPUR==. ;END OF PURE SEGMENT--LITERALS WILL START HERE
;IMPURE AREA
RELOC 0
LOWIMP==.
HEADER: BLOCK 3
HDATE: BLOCK 3
HTIME: BLOCK 3 ;[24] EXTRA ROOM FOR PAGE
TOFDAT: BLOCK 3
TOFNAM: BLOCK 4
TODDAT: BLOCK 3
TODNAM: BLOCK 4
TIDDAT: BLOCK 3
TIDNAM: BLOCK 4
FOFDAT: BLOCK 3
FOFNAM: BLOCK 4
OIFDAT: BLOCK 3
OIFNAM: BLOCK 4
OFFDEV: BLOCK 1
OFFNAM: BLOCK 4
LSTDAT: BLOCK 3
LSTNAM: BLOCK 4
HIIMP==LSTNAM-1
ODEVCH: BLOCK 1 ;CHARACTERISTICS OF FIRST OUTPUT DEVICE
TTYIB: BLOCK 3
LSTBH: BLOCK 3
TOFOB: BLOCK 3
TOFIB: BLOCK 3
TODOB: BLOCK 3
TODIB: BLOCK 3
TIDOB: BLOCK 3
TIDIB: BLOCK 3
FOFOB: BLOCK 3
OIFIB: BLOCK 3
OFFBH: BLOCK 3
LOCLR==.
TOFBUF: BLOCK 1
TODBUF: BLOCK 1
TIDBUF: BLOCK 1
OIFBUF: BLOCK 1
OFFBUF: BLOCK 1
LASTPG: BLOCK 2 ;LATEST LIBRARY NAME TYPED
IFE TOPS20,<
TOFPTH: BLOCK .PTMAX ;[27]
TODPTH: BLOCK .PTMAX ;[27]
TIDPTH: BLOCK .PTMAX ;[27]
FOFPTH: BLOCK .PTMAX ;[27]
OIFPTH: BLOCK .PTMAX ;[27]
OFFPTH: BLOCK .PTMAX ;[27]
LSTPTH: BLOCK .PTMAX ;[27]
>
ERRNAM: BLOCK 4 ;[27] WHERE TO STORE LOOKUP/ENTER BLOCK ON ERRORS
HICLR==.-1
SAVJFF: BLOCK 1 ;SAVE JOBFF AFTER SETTING UP TTY
INDEV: BLOCK 1 ;INPUT DEVICE
INFIL: BLOCK 1 ;INPUT FILE-NAME
INEXT: BLOCK 1 ;INPUT FILE-EXTENSION
INPP: BLOCK 1 ;INPUT PROJ-PROG NUMBER
TOEXTN: BLOCK 1 ;CURRENT TEMPORARY EXTENSION, IN BINARY
PPTABL: BLOCK PPLEN ;PUSH-DOWN LIST
COMLIN: BLOCK 1 ;LINE NUMBER TYPED WITH "I", "R" OR "D"
COMWRD: BLOCK 2
NEWNAM: BLOCK 2
RUFCTR: BLOCK 1
RUFLOC: BLOCK 1
RUFTAB: BLOCK 200 ;ROUGH TABLE
INNAM: BLOCK 2 ;CURRENT INPUT PROGRAM
OUTNAM: BLOCK 2 ;CURRENT OUTPUT PROGRAM
INLIN: BLOCK 1 ;CURRENT INPUT LINE NUMBER
OUTLIN: BLOCK 1 ;CURRENT OUTPUT LINE NUMBER
OFFSET: BLOCK 1 ;AMOUNT NEEDED TO OFFSET CHAINS
TOFCTR: BLOCK 1 ;COUNT OF WORDS WRITTEN INTO TEMP OUTPUT FILE
PRGCTR: BLOCK 1 ;NUMBER OF PROGRAMS IN THE FILE
FINCTR: BLOCK 1
LINECT: BLOCK 1 ;LINES LEFT ON PRINTER PAGE
PAGNO: BLOCK 1 ;[24] CURRENT PAGE NUMBER
COMSAV: BLOCK ^D9 ;SAVE COMMAND STREAM
SAVECP: BLOCK 1 ;SAVE 'CP' DURING '@' COMMAND
SEQ: BLOCK 1 ;-1 IF LIBRARY IS CARD IMAGE (SEQUENCED) /S
INSEQ: BLOCK 1 ;SEQ FLAG FOR COPIED PROGRAMS
OUTSEQ: BLOCK 1 ;...
BLOCK 1 ;USED WHEN BLT'ING TO FINTAB
FINTAB: BLOCK 200 ;HOLDS FINE TABLE WHEN DOING /L
IFE TOPS20,<
PTHPTR: BLOCK 1 ;[27] POINTER TO WHICH SFD BLOCK TO USE
MYPATH: BLOCK .PTPPN ;[27] FIRST PART OF DEFAULT PATH
>
MYPPN: BLOCK 1 ;[27] LOGGED IN PPN
IFE TOPS20,<
MYSFD: BLOCK .PTMAX-.PTPPN ;[27] REST OF DEFAULT PATH
>
EXTERNAL .JBFF,.JBSA ;[13]
RELOC ENDPUR
END START