Trailing-Edge
-
PDP-10 Archives
-
bb-d549g-sb
-
pip.mac
There are 4 other files named pip.mac in the archive. Click here to see a list.
TITLE PIP V.033B(260)
SUBTTL VJC/PMH/AK-DAG/DMN/JHT/DLC/NOTHEAD 04-MAR-75
;PERIPHERAL INTERCHANGE PROGRAM
;"COPYRIGHT 1968,1969,1970,1971,1972,1973,1974,1975 DIGITAL EQUIPMENT CORP.,MAYNARD,MASS.,U.S.A.
VPIP==33 ;VERSION NUMBER
VUPDATE==2 ;DEC UPDATE LEVEL
VEDIT==260 ;EDIT NUMBER
VCUSTOM==0 ;NON-DEC UPDATE LEVEL
SUBTTL REVISION HISTORY
;
;
; EDIT # FUNCTION
; ==== ========
;
; 124 IMPLEMENTES (DX) FACILITY
; 125 ALLOWS USER TO CLEAR DECTAPE ID
; 126 FIXES LOSE OF 662ND. CHAR IN LINE WHEN USING /T
; 127 CORRECTS RETURN ADDRESS FROM DERR5A WHEN NO UFD
; 130 CORRECTS THE PROTECTION CODE ERROR WHEN UFD IS
; PROTECTED BUT FILE ISN'T AND USER EXPLICITLY TYPES
; FILE NAME (I.E. */X_DSK:FILE.MAC[10,1])
; 131 STOPS TEMPORARY PPN FROM BECOMING PERMANENT
;
;VERSION 33A
;
; 132 DATE75 HACK (BY DAVE NIXON)
; 133 PREVENTS "?NO FILE NAMED" FROM BEING TYPED 4
; TIMES. FIX EXTRACTED FROM 33A WHERE IT WAS
; ALREADY IMPLEMENTED.
; 134 MAKE PIP UNDERSTAND AND USE DEVICES 'OLD',
; 'NEW' AND 'LIB
; 135 PREVENTS TRANSLATION OF CHARACTERS TO ^CHAR+100
; IF OUTPUT TO TTY
; 136 HELPS PREVENTION OF LINE SEQUENCE NUMBER
; WHEN LAST CHARACTER OF A BLOCK
;
; 137 ACCOMMODATES FOR POSSIBLE SKIP RETURN AT
; DSKDIR+2 FOR THE MONITOR CALL GETPPN
;
; 140 ALLOWS MULTIPLE FILES TO BE SEQUENCED CORRECTLY
; IF A NON-SEQUENCED FILE FOLLOWS A SEQUENCED FILE(SPR #12349)
;
; 141 PREVENT PRIV'D JOB FROM ZEROING SYS: UNINTENTIONALLY
; SPRS 12984,13318
; AREAS AFFECTED: OMOD1, DTCLR, DSKDIR
;
; 142 CLEAR TAB SEEN FLAG BEFORE GOING TO GET FOR THE FIRST TIME.
; OTHERWISE IF THE FIRST TAB OF A FILE IS AT A TAB STOP,
; AND THE /W SWITCH IS USED, THE TAB WOULD NOT BE REPLACED
; WITH A BLANK.
; SPRS 12238,13123
; AREA AFFECTED: GETT8
;
;
; 143 FIX TO EDIT 142. EDIT 142 CLEARED THE WRONG
; BITS SO MOST SWITCHES WOULDN'T WORK.
; AREA AFFECTED: GETT8
;
; 144 PREVENTS PIP FROM LOOPING ON CCL ENTRY IF
; NO CMD FILE EXISTS
;
; 145 MAKES PIP LOOK IN CORRECT UFD WHEN THERE IS A
; PPN ON OUTPUT SIDE OF FILE SPEC
;
; 146 MAKES PIP ABLE TO COPY FROM TMPCOR TO TMPCOR
;
; 147 PREVENTS PIP FROM RENAMING OR DELETING FROM
; ANOTHER PPN UNLESS EXPLICITLY SPECIFIED
; (PREVENTS ?AMBIGUOUS MESSAGE WHEN FILES WITH
; SAME NAME.EXT ARE IN USER'S PPN AND LIB.)
;
; 150 MAKES PIP DO PHYSICAL-ONLY OPEN SO THERE IS NO
; AMBIGUITY BETWEEN PHYS & LOG FILE STRUCTURES
;
; 151 FIX EDIT 150. DO A PHYSICAL-ONLY OPEN ONLY WHEN
; THE DEVICE IS GENERIC DISK. THIS MAKES /L FIND ALL
; FILES PROPERLY AND PREVENTS ?AMBIGUOUS FOR /D AND /R
; IF WE HAVE .AS DSKA DSKB. CORRECTION TO SPR 13541.
; 28-SEP-74, JNT.
;
; 152 CHECK FOR SOURCE DEVICE SPECIFICATION ON A DELETE
; OR RENAME AND PRINT ERROR IF THERE IS. SPR 13939.
; 26-SEP-74, JNT.
;
; 153 KEEP THE FILE NAME AND EXTENSION UNDER CONTROL.
; DON'T ALLOW ".FOO" TO FIND A FILE "FOO".
; DON'T ALLOW "UFD[P,PN]" TO FIND "[P,PN].UFD".
; NO SPR. 29-SEP-74, JNT.
;
; 154 MAKE /C COUNT LOWER CASE CHARACTERS AND ESCAPES COUNT
; AS PRINTING CHARACTERS, INSTEAD OF JUST SPACE THRU ^.
; SPR'S 14,285 & 14,308. 09-OCT-74, JNT.
;
; 155 CORRECT 133 TO ELIMINATE LOOP ON /D OR /R WHEN
; FILENAME AND EXTENSION ARE NULL, E.G. DSK:/D=
; NO SPR. 10-OCT-74, JNT.
;
; 156 CHECK FOR DEVICES WHICH CARE WHAT MODE THEY ARE
; INITED IN, AND REOPEN THEM IF THE NEW MODE IS
; DIFFERENT, I.E. CHANGE PTP: TO /B IF PUNCHING
; A REL FILE. SPR 14,310. 10-OCT-74, JNT.
;
; 157 FIX NEW:, SYS:, OLD:, AND LIB: A LITTLE MORE SO THAT
; LOGICAL ASSIGNMENTS WILL NOT FOOL PIP. NO SPR.
; 13-OCT-74, JNT.
;
; 160 WHEN CONCATENATING FILES, MAKE PIP TREAT THE LAST
; FILE THE SAME AS THE OTHERS, I.E. NOT CHANGE FROM ASCII
; LINE MODE TO BINARY. NO SPR. 13-OCT-74, JNT.
;
; 161 REMOVE EDIT 145 SO THAT PPN'S DON'T ALL BECOME STICKY.
; REPLACE DELETED INSTRUCTIONS. SER FROM CO'T.
; 19-OCT-74, JNT.
;
; 162 REMOVE EDIT 131. I DON'T KNOW WHAT IT WAS SUPPOSED
; TO DO, BUT IT BREAKS TOO MANY THINGS: E.G.
; TTY:/L=[#,#].UFD
; TTY:/L=FOO[#,#] WHERE #,# IS NOT YOUR PPN
; NO SPR. 19-OCT-74, JNT.
;
;VERSION 33B
;
; 163 WHOLESALE CHANGES TO ERSATZ DEVICE HANDLING, EDIT 134.
; THIS EDIT IS MOSTLY COURTESY OF JAEDGECOMBE.
; MANY SPR'S, 11,988. 20-OCT-74, JNT.
;
; 164 CORRECTION TO EDIT 151 TO CLEAR THE UU.PHS BIT
; EACH TIME ININIT IS CALLED.
; NO SPR. 21-OCT-74, JNT.
;
; 165 EDIT 163 CAUSES @ CONSTRUCTIONS TO FAIL SINCE WHEN
; THE @ IS SEEN, DEVICE IS NOW 0 FOR DEFAULT TRAPPING.
; NO SPR. 21-OCT-74, JNT.
;
; 166 ALLOW [-] OR [#,], [,#], [,] AS PPN SPEC.
; NO SPR. 21-OCT-74, JNT.
;
; 167 REMOVED BY EDIT 224.
;
; 170 ON SEQUENCING A FILE WITH /O OR /S, ANY LINES WHICH
; CONSIST OF JUST END OF LINE CHARACTERS, ADD A TAB
; INSTEAD OF ANOTHER CARRIAGE RETURN.
; SPR 14408. 23-OCT-74, JNT.
;
; 171 SKIP THE CLOSE BETWEEN THE LOOKUP AND RENAME IF
; RUNNING LEVEL D, SO FUNNY PATHS WON'T BE LOST.
; SPRS ?/?. 25-OCT-74, JNT.
;
; 172 CLOSE THE /L/F DEVICE BEFORE PRINTING "NO FILES NAMED",
; SO THAT ANY LEFT OVER UFD STUFF WILL PRINT.
; SPR 12533,?. 25-OCT-74, JNT.
;
; 173 FIX THE FIND THE NEXT EXISTING FILE ROUTINE SO THAT
; AN EXISTING FILE FOLLOWED BY A NON-EXISTING FILE
; WILL NOTICE THE NON-EXISTING FILE.
; SPRS 12533,+?. 25-OCT-74, JNT.
;
; 174 FIX PROBLEM WITH RUBBISH IN THE MIDDLE OF FILES
; WHICH HAVE BEEN MERGED WITH WILD CARD SPECS.
; SPRS 12900,9527,???. 26-OCT-74, JNT.
;
; 175 FIX PROBELM WITH I/O ERROR MESSAGES DESTROYING
; OUTPUT TO TTY.
; SPR 12256. 26-OCT-74, JNT.
;
; 176 FIX PROBLEM WITH FILE NOT FOUND MESSAGES DURING
; WILD CARD INPUT DESTROYING OUTPUT TO TTY.
; NO SPR. 26-OCT-74, JNT.
;
; 177 FIX PROBLEM WITH MISSING DIRECTORIES AFTER NOT FOUND
; FILES, AND PRINT THE NAMES OF THE FILES NOT FOUND.
; NO SPR. 26-OCT-74, JNT.
;
; 200 MAKE LOGICAL ASSIGNMENTS AND ALL: WORK BETTER.
; NO SPR. 26-OCT-74, JNT.
;
; 201 MAKE NUL: WORK BETTER.
; NO SPR. 27-OCT-74, JNT.
;
; 202 HACK TO ALLOW UFD PROTECTION CHANGES AGAIN.!!!
; PROBLEM IS SOMEWHERE IN NON-ZERO PPN FOOLISHNESS.
; NO SPR. 28-OCT-74, JNT.
;
; 203 CHANGE INITFS TO DETERMINE SEARCH LIST TO USE
; BY DOING A PATH. INSTEAD OF COMPARING DEVPPN TO
; OUR PPN.
; NO SPR. 31-OCT-74, JNT.
;
; 204 MAKE /Z SAVE THE TYPED FILE NAME, INSTEAD OF USING
; THE LAST FILE NAME THE ZEROED DIRECTORY.
; NO SPR. 01-NOV-74, JNT.
;
; 205 FIX EDIT 163 TO NOT LOOSE THE DEFAULT OUTPUT DEVICE.
; NO SPR. 01-NOV-74, JNT.
;
; 206 REDO WHAT WAS ORIGINALLY EDIT 117 FROM SPR 8069.
; IF WILD CARDS ARE USED IN THE OUTPUT SPEC OF A COPY
; WITHOUT /X, MAKE THAT ILLEGAL.
; SPR'S 11041, 11633, 12332. 01-NOV-74, JNT.
;
; 207 WORK ON STRAIGHTENING OUT PATH USAGE. USE FLAG BITS
; TO DETERMINE WHAT PPN OR PATH TO USE.
; SPR'S MANY. 03-NOV-74, JNT.
;
; 210 CORRECT EDIT 156 TO DO CLOSE-OPEN INSTEAD OF SETSTS AND
; DO THESE ONLY ON CDP: AND PTP:. SETSTS DOESN'T PUNCH
; BLANK TAPE AND FOOLS PTPSER.
; SPR 14310. 07-NOV-74, JNT.
;
; 211 MORE OF 207, WORK ON PATHS AND PPN'S.
; MANY SPR'S. 14-NOV-74, JNT.
;
; 212 ADD CODE TO THE SETPTH ROUTINE TO MAKE SURE THAT NON-SFD
; MONITORS DO NOT GET PATH POINTERS IN LOOKUP BLOCKS.
; NO SPR. 17-NOV-74, JNT.
;
; 213 FIX EDIT 211 SO THAT DIRECTORIES OF ERSATZ DEVICES AND
; DEFAULT PPN'S WORK AGAIN.
; NO SPR. 17-NOV-74, JNT.
;
; 214 FIX EDIT 203 TO LOOK AT THE RIGHT WORD FOR THE DEVICE'S
; SEARCH LIST CODE AFTER THE PATH. UUO.
; NO SPR. 17-NOV-74, JNT.
;
; 215 FIX EDIT 211 TO ALLOW TMP: AGAIN.
; NO SPR. 18-NOV-74, JNT.
;
; 216 FIX EDIT 207 TO SAVE THE PPN FOR /X COPIES SO
; THAT DEFAULT PATHS AND OTHER PPNS WILL WORK AGAIN.
; QAR MD. 21-NOV-74, JNT.
;
; 217 FIX EDIT 211 TO ALLOW MULTIPLE DELETES TO DEFAULT
; PPN'S AND POSSIBLY OTHER THINGS.
; MY QAR. 21-NOV-74, JNT.
;
; 220 CORRECT THE MEANING OF THE DEFAULT PPN IN [,] TO BE
; THE JOB'S UFD, NOT THE DEFAULT PATH.
; MY QAR. 25-NOV-74, JNT.
;
; 221 CLEAR OUT THE OUTPUT PATH BEFORE SCANNING THE INPUT.
; NEEDED NOW DUE TO CHANGES FOR EDIT 211.
; MD QAR. 25-NOV-74, JNT.
;
; 222 MAKE UP FOR MONITOR DEFICIENCY WITH RENAMES AND SFD'S,
; AND MAKE RENAME SUPER DEFENSIVE FOR OLD MONITORS.
; TH SER. 26-NOV-74, JNT.
;
; 223 PUT THE /N AND /S PATH SCANNING SWITCH UNDER A NORMALLY
; OFF CONDITIONAL. THESE WERE SPECIFIED IN THE MANNER:
; [1,2,SFD,SFD/S] OR [-/N] OR ETC.
; HOWEVER THIS IS INCOMPATIBLE WITH SCAN AND WAS REMOVED
; FOR THIS REASON. THEY ARE UNSUPPORTED.
; AGREEMENT. 26-NOV-74, JNT.
;
; 224 REMOVE EDIT 167, IT WAS A BAD IDEA.
; NO SPR. 26-NOV-74, JNT.
;
; 225 FIX FILE SPECIFICATIONS TO FOLLOW DIRECT STANDARDS.
; NO SPR. 26-NOV-74, JNT.
;
; 226 FIX PART OF EDIT 211, CHANGE HRLZ TO HLRZ TO MAKE WILD
; UFD DIRECTORY PRINTOUTS CORRECT.
; MY QAR. 27-NOV-74, JNT.
;
; 227 ALLOW EQUAL SOURCE AND OBJECT DEVICES FOR /R/D
; SEER. 02-DEC-74, JNT.
;
; 230 FIX THE /Q SWITCH TO CHECK BOTH SYS: AND HLP:
; NO SPR. 02-DEC-74, JNT.
;
; 231 FIX RENAMES TO NOT CHANGE UFD FROM ERSATZ TO JOB'S
; DEFAULT PATH!!!!
; JMF SER. 07-DEC-74, JNT.
;
; 232 WHEN DOING FILE STRUCTURE SCANNING IN AN SFD, ALLOW
; LOOKUP ERROR 1 ALSO SINCE THAT MEANS THERE IS NOT
; EVEN A UFD FOR THE STRUCTURE.
; TC QAR. 09-DEC-74, JNT.
;
; 233 FIX PART OF EDIT 211 TO MAKE [30,] WORK AGAIN.
; MY SER. 29-DEC-74, JNT.
;
; 234 FIX SETPATH FOR NON-PATHING MONITORS.
; MY SER. 01-JAN-75, JNT.
;
; 235 CORRECT DEVICE NAME FOR NON-DISK ERROR MESSAGES FROM
; DELETE OR RENAME.
; MY SER. 01-JAN-75, JNT.
;
; 236 FIX ERROR NUMBER MESSAGE DURING /R OR /D WHEN THE MONITOR
; RETURNS THE WRONG PPN ON A PATH.
; MY SER. 11-JAN-75, JNT.
;
; 237 TREAT SYS: THE SAME WAY WILD DOES, I.E. USE A PATH. UUO
; INSTEAD OF A DEVPPN. WHEN THE MONITOR IS FIXED, THEN
; PIP WILL STILL ACT THE SAME WAY AS WILD.
; QAR, GRIPES, COMMENTS. 11-JAN-75, JNT.
;
; 240 MOVE EDIT 235 UP SO THAT IT WILL FIX TMP: MESSAGES TOO.
; MY SER. 12-JAN-75, JNT.
;
; 241 CHANGE EDIT 135 TO BE A CONDITIONAL ASSEMBLY PARAMETER.
; WJF,CLR,JMF SER. 12-JAN-75, JNT.
;
; 242 CHANGE THE /L/F NO UFD ERROR MESSAGE TO SAY EXISTS INSTEAD
; OF CREATED.
; WJF QAR. 12-JAN-75, JNT.
;
; 243 MAKE EDIT 232 CLEANER.
; WJF QAR. 12-JAN-75, JNT.
;
; 244 CHANGE EDIT 206 TO ASSUME /X IF WILD CARDS ARE GIVEN IN A
; COPY COMMAND OUTPUT SPEC. THIS MAKES PIP'S OPERATION
; COMPATIBLE WITH COMPIL, USING THE LEAST CONFUSION PRINCIPLE.
; WJF QAR. 12-JAN-75, JNT.
;
; 245 FINISH FIXING 235 AND 240.
; OPR SER. 18-JAN-75, JNT.
;
; 246 PUT IN LOST FIX FROM SPR 10-7752.
; SPR 7752. 18-JAN-75, JNT.
;
; 247 PRESERVE MODE OF FILES COPIED TO DISK OR DECTAPE FROM DISK OR DECTAPE
; REGARDLESS OF /B/I/H.
; SPR 7863,... 18-JAN-75, JNT.
;
; 250 PUT WHAT WAS EDIT 116 BACK IN, ERROR MESSAGES ON FILES
; FOUND BUT NOT VALID IN /R/D (I.E. RIB ERROR).
; SPR 8285, 8231. 18-JAN-75, JNT.
;
; 251 CHANGE EDIT 241 TO DEFAULT TO SENDING ACTUAL CHARACTERS TO A
; TTY UNLESS /J SWITCH IS USED, WHERE THEY WILL ECHO AS ^C
; PFC SUGGESTION. 19-JAN-75, JNT.
;
; 252 ACCEPT SWITCHES, PPN'S, AND PROTECTIONS AFTER OCTAL FILE
; NAME SPECIFICATIONS, #12/X=FOO.
; WJF QAR. 19-JAN-75, JNT.
;
; 253 FIX /T/C TO CHECK CORRECTLY FOR NULL LINES.
; WJF QAR. 19-JAN-75, JNT.
;
; 254 MAKE /Z WORK WHEN USED WITH COPYING.
; MY SER. 20-JAN-75, JNT.
;
; 255 MOVE EDITS 142 AND 143 TO FIX MAG TAPE SWITCHES AND TO GET
; RID OF ONE INSTRUCTION.
; SPR 15194. 01-FEB-75, JNT.
;
; 256 REFORMAT THE LISTING AND ADD SUBTITLES.
; 15-FEB-75, JNT.
;
; 257 FIX IO TO UNASSIGNED CHANNEL (DTA ONLY, WHEN FILE NOT FOUND).
; MY SER. 15-FEB-75, JNT.
;
; 260 REMOVE EDIT 237. IT WAS A BAD IDEA. IT MADE PIP INCONSISTENT
; AND POINTED OUT A NEW MONITOR BUG.
; MY SER. 15-FEB-75, JNT.
;
;[END OF REVISION HISTORY]
SUBTTL CONDITIONAL ASSEMBLY SWITCHES
LOC 124
PIP1 ;SET REENTER ADDRESS
RELOC
LOC 137
<VCUSTOM>B2+<VPIP>B11+<VUPDATE>B17+VEDIT
RELOC
;RIMSW==0 /Y SWITCH OPTION UNAVAILABLE.
;RIMSW==1 /Y SWITCH OPTION AVAILABLE.
;CCLSW==0 PIP WILL NOT PROCESS CCL COMMANDS.
;CCLSW==1 PIP WILL EXECUTE CCL COMMANDS FROM DISK.
;TEMP==1 PIP WILL GET CCL COMMANDS FROM CORE (TMPCOR UUO)
;REENT==1 PIP IS REENTRANT (AK-DAG)
;FTDSK==0 NON-DSK SYSTEM
;FTDSK==1 DSK SYSTEM
;LEVELC==0 LEVEL C SUPPORT ELIMINATED (GETTAB'S, CLOSE-RENAME, ETC)
;LEVELC==1 INCLUDE LEVEL C SUPPORT (AND ALL SMALL MONITOR CODE)
;SCANSW==0 NO /N & /S SCAN SWITCH ALLOWED IN PPN SPEC
;SCANSW==1 ALLOW /N & /S
;CTLTTY==0 SEND CONTROL CHARACTERS TO TTY
;CTLTTY==1 TRANSLATE CONTROL CHARACTERS TO ^CH TO TTY IF /J SWITCH IS USED
;CONDITIONAL ASSEMBLY SWITCH SETUP (DEC CONFIGURATION)
;---------------------------------
IFNDEF FTDSK, <FTDSK==1>
IFE FTDSK, <CCLSW==0>
IFNDEF CCLSW, <CCLSW==1>
IFE CCLSW, <TEMP==0>
IFNDEF TEMP, <TEMP==1>
IFNDEF REENT, <REENT==1>
IFNDEF RIMSW, <RIMSW==1>
IFNDEF LEVELC, <LEVELC==0>
IFNDEF SCANSW, <SCANSW==0>
IFNDEF CTLTTY,<CTLTTY==1>
IFN REENT,< TWOSEGMENTS
RELOC 400000>
MLON
SALL
EXTERN .JBFF,.JBSA,.JBREL
SUBTTL REGISTER BIT DEFINITIONS
;FLAG ASSIGNMENTS (RIGHT HALF)
LINE==1 ;ASCII LINE MODE PROCESSING
BMOD==2 ;BINARY PROCESSING
TBMOD==4 ;SUPPRESS TRAILING SP, CHANGE MULTIPLE SP TO TABS
DFLG==10 ;DELETE FILES MODE
LFLG==20 ;LIST DIRECTORY
NSMOD==40 ;IGNORE INPUT SEQUENCE NUMBERS
RFLG==100 ;RENAME FILE MODE
SQMOD==200 ;GENERATE SEQUENCE NUMBERS
STS==400 ;END OF LINE SEEN, OUTPUT SEQUENCE NUMBER NEXT
SPMOD==1000 ;SUPPRESS TRAILING SPACES
XFLG==2000 ;COPY DECTAPE MODE
ZFLG==4000 ;CLEAR DECTAPE DIRECTORY
SUS==10000 ;SEQUENCE NUMBER GENERATION IN PROGRESS
SPOK==20000 ;SPACE WAS LAST CHARACTER
ESQ==40000 ;STOP OUTPUTTING SEQ NUM, RESUME OUTPUTTING DATA
SNI==100000 ;DO NOT INCREMENT SEQUENCE NUMBER
MTFLG==200000 ;MTA REQUEST RECEIVED
OSFLG==400000 ;GENERATE SEQ. NOS. INCR. BY ONE
;FLAG ASSIGNMENTS (LEFT HALF)
OFLG==1 ;BLOCK 0 COPY
RIMFLG==2 ;RIM FORMAT INPUT /OUT TO DTA. ILLEG IF RIMSW==0
PFLG==4 ;FORTRAN PROGRAM OUTPUT FORMAT CONVERSION
PCONV==10 ;COLUMN 1 CONVERSION IN PROGRESS
NEWFIL==20 ;NEW FILE JUST INITIATED
CHKFLG==40 ;PARENTHESES CHECK MODE
IFLG==100 ;SELECT IMAGE MODE
GFLG==200 ;KEEP GOING IF THERE ARE I/O ERRORS
IBFLG==400 ;SELECT IMAGE BINARY MODE
JFLG==1000 ;NON-STANDARD MODE
WFLG==2000 ;/W CONVERT TABS TO SPACES
TBSN==4000 ;TAB ALREADY SEEN DURING /W
TID==10000 ;[125] TAPE ID TO BE ALTERED
DSKDBC==40000 ;[130] DSKDIR BEEN CALLED
;AUXFLG ASSIGNMENTS (LEFT HALF)
QFLG==1 ;PLEASE PRINT SWITCH SET
NSPROT==2 ;NON-STANDARD DISK OUTPUT PROTECTION
SBIN==4 ;36-BIT PR. ON REL. ETC. FILES
NOMORE==20 ;IGNORE ANY SWITCHES BUT MTA FROM NOW ON
CDRFLG==40 ;CONVERT COLS 73-80 TO SPACES + /C
INFOFL==100 ;FLAG USED BY ERR3A:
RSDCFL==200 ;USED FOR MERGING FILES, ==1 IF FILE HAS EXTENSION
;REL,SAV,DMP,CHN OR OTHERWISE == 0
FRSTIN==400 ;THIS IS THE FIRST INPUT FILE (USED IN FILE
;MERGE COMMAND) == 0 FOR FIRST INPUT
;MTAREQ ASSIGNMENTS (RIGHT HALF)
MTAFLG==1 ;MTA ADVANCE ONE FILE
MTBFLG==2 ;MTA BACKSPACE ONE FILE
MTTFLG==4 ;MTA SKIP TP LOGICAL EOT
MTWFLG==10 ;MTA REWIND
MTFFLG==20 ;MTA MARK EOF
MTUFLG==40 ;MTA REWIND AND UNLOAD
MTDFLG==100 ;MTA ADVANCE ONE RECORD
MTPFLG==200 ;MTA BACKSPACE ONE RECORD
MT8FLG==400 ;MTA SET 800 B.P.I.
MT5FLG==1000 ;MTA SET 556 B.P.I.
MT2FLG==2000 ;MTA SET 200 B.P.I.
MTEFLG==4000 ;MTA SELECT EVEN PARITY
;AUXFLG ASSIGNMENTS (RIGHT HALF)
REDFLG==1 ;==1 IF ANY FILES ARE INPUT (OTHER THAN DIRECTORIES)
SYSFLG==2 ;[163] USE SYSSTR FOR SEARCH LIST, IE ALL:
NULIN==4 ;[211] NUL: IS THE INPUT DEVICE
LPTOUT==10 ;LPT OUTPUT
FFLG==20 ;LIST SHORT DISK DIRECTORY
ONEOUT==40 ;ONE OUTPUT FILE INITIALIZED
CDRIN==100 ;CARDS IN
MTAOUT==200 ;OUTPUT TO MTA
MTAIN==400 ;INPUT FROM MTA
TTYIN==1000 ;INPUT FROM TTY
READ1==2000 ;LOOK FOUND NEW INPUT FILE, NO READ YET.
DTAOUT==4000 ;OUTPUT TO DTA
DSKOUT==10000 ;OUTPUT TO DSK
DTAIN==20000 ;INPUT FROM DTA
DSKIN==40000 ;INPUT FROM DSK
TTYOUT==100000 ;OUTPUT TO TTY
PPTIN==200000 ;INPUT FROM PTR
PPTOUT==400000 ;OUTPUT TO PTP
;CALFLG ASSIGNMENTS (RIGHT HALF) FOR DESCRIBING A BLOCK OF INFORMATION
;FOUND BY THE COMMAND SCANNER.
FNEX==1 ;==1 WHEN FN.EX==*.*, *.EXT, FN.* (WHEN MORE
;THAN ONE FN.EX IS IMPLIED).
MATEX==2 ;FILE EXTENSIONS MUST MATCH
MATFN==4 ;FILE NAMES MUST MATCH
NEWDEV==10 ;A NEW INPUT DEVICE WAS GIVEN
NEWPP==20 ;A NEW #P-P WAS GIVEN
ASTFLG==40 ;FLAG SET WHEN FILE NAMED IN CS FOUND
;BY LOOK ROUTINE EVEN IF FN OR EXT =*
DEV==100 ;DEVICE NAME INDICATOR
DVSWTH==200 ;OUTPUT DEVICE SEEN
NSWTCH==400 ;INDICATES NULL NAME
SSWTCH==1000 ;LEFT ARROW SEEN (TEMPORARY SWITCH)
LISTTY==2000 ;LIST TO TTY
TMPI==4000 ;INPUT DEVICE TMPCOR SEEN
TMPO==10000 ;OUTPUT DEVICE TMPCOR
RXFLG==20000 ;(RX) SEEN
RTRNFL==40000 ;RETURN (POPJ ) FROM ERROR PRINTER (PTEXT)
ARWSW==100000 ;LEFT ARROW SEEN IN THIS LINE
SQNSN==200000 ;A SEQUENCE NUMBER HAS BEEN SEEN FOR THIS LINE
COMAFL==400000 ;A COMMA SEEN ON INPUT SIDE OF SPECIFICATIONS
ALLCLF==FNEX!MATEX!MATFN!NEWDEV!NEWPP
;MORE FLAGS IN LEFT HALF
MFLG==1 ;A WILD CHAR MASK HAS BEEN SET UP FOR ??????.???
LDVFLG==2 ;WE HAVE A DEVICE TO OUTPUT (DIR COMMAND)
LPPFLG==4 ;WE HAVE A PPN TO OUTPUT (DIR)
OSPLFL==10 ;OUTPUT DEVICE IS SPOOLED
SDEVSN==20 ;[152] SOURCE DEVICE SEEN IN SCAN
FNSEEN==40 ;[153] FILE NAME NOT SEEN IN SCAN
PPSEEN==100 ;[207] SPECIFIC PROJECT-PROG NUMBER/PATH SEEN ON INPUT
PPPSEN==200 ;[207] PERMANENT PROJ-PROG NUMBER/PATH SEEN ON INPUT
OPPSEN==400 ;[207] SPECIFIC PROJECT-PROG NUMBER/PATH SEEN ON OUTPUT
SUBTTL MISCELLANEOUS DEFINITIONS
;DEVICE CHANNEL ASSIGNMENTS
IFN CCLSW,<
COM==0 ;STORED COMMAND INPUT CHANNEL>
CON==1 ;COMMAND INPUT CHANNEL
OUT==2 ;OUTPUT DEVICE
IN==3 ;INPUT DEVICE
TAPE==4 ;MTA POSITIONING
DIR==5 ;DISK DIR. READ
DD==6 ;DUMP MODE CHANNEL FOR DTA DIR (TAPE ID ONLY)
;ACCUMULATOR ASSIGNMENTS
T1=1 ;GENERAL PURPOSE
T2=2 ;G.P.
T3=3 ;G.P.
CHR=4 ;INPUT CHARACTER
FL=5 ;MORE FLAGS
FLAG=6 ;FLAG REGISTER
T4=7 ;G.P.
IOS=10 ;IO STATUS BITS
T5=11 ;G.P.
T6=12 ; G.P.
AUXFLG=13 ;AUXILIARY FLAG REGISTER
T7=14 ;G.P.
DOUT=15 ;DIVIDED NO. FOR OUTPUT
DOUT1=16 ;REMAINDER, DOUT+1
P=17 ;PUSHDOWN POINTER
CALFLG==FL ;OLD NAME - TOO LONG TO TYPE
;MISCELLANEOUS PARAMETERS
WRTLOK==400000 ;WRITE LOCK (DECTAPE) /IMPROPER I/O
BIGBLK==40000 ;BLOCK TOO LARGE
INBIT==2 ;DEVCHR BIT FOR DEV CAN DO INPUT
OUTBIT==1 ;DEVCHR BIT FOR DEV CAN DO OUTPUT
EOFBIT==20000 ;END OF FILE
EOTBIT==2000 ;END OF TAPE
DTABIT==4 ;DEVCHR BIT FOR DECTAPE IDENTIFICATION
INHIB==1 ;OUTPUT RELEASE INHIBIT BIT
TABSP==10 ;SPACES PER TAB
PTRBIT==200 ;DEVCHR BIT FOR PTR
PTPBIT==400 ;DEVCHR BIT FOR PTP
DSKBIT==200000 ;DEVCHR BIT FOR DSK
MTABIT==20 ;DEVCHR BIT FOR MTA
LPTBIT==40000 ;DEVCHR BIT FOR LPT
TTYBIT==10 ;DEVCHR BIT FOR TTY
CDRBIT==100000 ;DEVCHR FOR CDR
DENS2==200 ;MTA 200 BPI
DENS5==400 ;MTA 556 BPI
DENS8==600 ;MTA 800 BPI
PARE==1000 ;MTA EVEN PARITY
LDP==4000 ;MTA LOAD POINT STATUS
HPAGE==20
UU.PHS==400000 ;PHYSICAL-ONLY BIT
.TYSPL==(1B13) ;DEVTYP BIT FOR SPOOLING
DV.TTA==1B4 ;[211] CONTROLLING TERMINAL
;EXTENDED LOOKUP PARAMETERS
RBSIZ==5 ;WRITTEN FILE LENGTH
RIBSTS==17 ;STATUS BITS
PTHLEN==6 ;NUMBER OF SFD'S ALLOWED (1 MORE THAN 5.04)
;ASCII CHARACTERS
CR==15 ;CARRIAGE RETURN
LF==12 ;LINE FEED
FF==14 ;FORM-FEED
ALTMOD==33 ;NEWEST ALTMODE
ALT175==175 ;OLDEST ALTMODE
ALT176==176 ;OLDER ALTMODE
LA==137 ;LEFT ARROW
CZ==32 ;CONTROL Z
XON==21 ;^Q,START TTY PTR
XOFF==23 ;^S,STOP TTY PTR MODE
COMMA==54
PERIOD==56 ;PERIOD
COLON==72
SPACE==40
DEL==177 ;DELETE,RUBOUT,REPEAT MOD.35
TAB==11 ;TAB
SUBTTL MACRO DEFINITIONS
DEFINE SKIP (J)<JRST .+1+'J>
DEFINE LSTLIN (Z),<
MOVEI T1,Z
PUSHJ P,LISTIT>
DEFINE ERRPNT (X),<
JSP T1,PTEXT
XLIST
ASCIZ X
LIST>
DEFINE ERRPN2 (X),<
JSP T1,PTEXT2
XLIST
ASCIZ X
LIST>
;MACRO TO THROW AWAY CURRENT LINE BEFORE PRINTING ERROR MESSAGE
DEFINE ERRPNX (X)<
JSP T1,PRETXT
XLIST
ASCIZ X
LIST>
DEFINE SWSEG <
IFN REENT, <RELOC>>
SUBTTL OPDEF'S
;I/O DEFINITIONS FOR CREF
OPDEF OPEN [OPEN]
OPDEF INIT [INIT]
OPDEF LOOKUP [LOOKUP]
OPDEF ENTER [ENTER]
OPDEF IN [IN]
OPDEF INPUT [INPUT]
OPDEF OUT [OUT]
OPDEF OUTPUT [OUTPUT]
OPDEF CLOSE [CLOSE]
OPDEF RELEASE [RELEASE]
OPDEF RENAME [RENAME]
;CALLI DEFINITIONS
OPDEF WAIT [MTAPE 0]
OPDEF RESET [CALLI 0]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF UTPCLR [CALLI 13]
OPDEF DATE [CALLI 14]
OPDEF MSTIME [CALLI 23]
OPDEF GETPPN [CALLI 24]
OPDEF PJOB [CALLI 30]
OPDEF RUN [CALLI 35]
OPDEF GETTAB [CALLI 41]
OPDEF TMPCOR [CALLI 44]
OPDEF DSKCHR [CALLI 45]
OPDEF GOBSTR [CALLI 66]
OPDEF DEVPPN [CALLI 55]
OPDEF PATH. [CALLI 110]
SUBTTL INITIALIZE AND FIND TMP FILES IF CCL ENTRY
PIP1: IFN CCLSW,<
TDZA FLAG,FLAG ;NORMAL ENTRY TO ACCEPT COMMANDS FROM TTY
SETO FLAG, ;CCL ENTRY TO READ COMMANDS FROM DISK FILE>
MOVE 0,[LOW,,LOW+1] ;XWD FOR BLT TO
SETZM LOW ;CLEAR DATA AREA
BLT 0,LOWTOP-1 ;TO ZERO
MOVSI 'TTY' ;TEST TTY TO SEE IF NOT A REAL TTY
DEVCHR
TLNE TTYBIT ;WELL IS IT
SKIP 2 ;YES
OUTSTR [ASCIZ /?Logical TTY must be physical TTY/]
EXIT 1, ;NO, DO MONRET
MOVEI P,PDL-1 ;[144] INIT PDL
IFN FTDSK,<
MOVE [PTHLEN+3,,JOBPTH]
SETOM JOBPTH ;FIND JOB'S DEFAULT PATH
PATH. ;GET PATH
SETZM JOBPTH ;FAILED NOT SFD'S
MOVE [XWD 17,11] ;STATES WORD
GETTAB ;GET IT
SETZ ;ERROR RETURN
TLNN (7B9) ;TEST FOR LEVEL D
TDZA ;NOT LEVEL D
HRROI -2 ;THIS IS LEVEL D
MOVEM LEVEL ;SAVE
GETPPN 0, ;[163] GET OUR PPN
JFCL ;[163] ALLOW FOR PRIVILEDGED
MOVEM 0,JOBPPN ;[163] AND SAVE IT
SKIPN JOBPTH ;[211] SEE IF PATH WORKED
MOVEM 0,JOBPTH+2 ;[211] NO, SAVE OUR PPN AS DEFAULT PATH
MOVE 0,[XWD 1,16] ;[163] GET PPN OF SYS:
GETTAB 0, ;[163]
MOVE 0,[XWD 1,1] ;[163] LEVEL C
MOVEM 0,SYSPPN ;[163] AND SAVE IT
MOVEI 0,16 ;[163] GET PPN OF MFD:
GETTAB 0, ;[163]
MOVE 0,[XWD 1,1] ;[163] LEVEL C
MOVEM 0,MFDPPN ;[163] AND SAVE IT
>;[163] END IFN FTDSK
IFE REENT,<
IFE FTDSK,<HLRZ T1,.JBSA ;NO DSK SO USE JOBFF>
IFN FTDSK,<MOVEI T1,DSKDR0 ;ASSUME NO DISK FOR TEST, LOC OF DSK RTNS
MOVSI 0,'DSK'
DEVCHR ;DEVCHR REQUEST: IS THERE A DSK
JUMPE 0,P1 ;0 IF NO DISK: USE DSKDR
MOVE T1,.JBFF ;DISK: PREPARE TO SAVE C(JOBFF)
HRRZ T2,.JBREL ;HIGHEST REL LOC AVAILABLE TO USER
CAIL T2,6000 ;CURRENT SIZE 4K
JRST P1 ;YES
MOVEI T2,7777 ;NO. EXPAND TO 4K
HRRZM T1,SVJBFF ;SAVE JOBFF SO BUFFERS CAN BE CREATED
CORE T2, ;CORE UUO
JRST CERR7 ;CORE UNAVAILABLE>
>
IFN REENT,<
HLRZ T1,.JBSA ;GET JOBFF>
P1: HRRZM T1,SVJBFF ;SAVE JOBFF SO BUFFERS CAN BE CREATED
RESET ;RESET. MOVES JOBSA (LH) TO C (JOBFF)
IFE CCLSW,<JRST PIP>
IFN CCLSW,<JUMPE FLAG,PIP ;ENTER PIP IF NO COMMAND FILE
MOVEI PIP1 ;GET STARTING ADDRESS
HRRM .JBSA ;RESET IT SO ^C START WILL WORK
;THIS IS MODIFICATION FOR USING TMPCOR WITH CCL
IFN TEMP,< ;[167]
MOVE T1,[XWD 1,TMPFIL];SET BLOCK POINTER FOR TMPCOR UUO
;1=READ ONLY, LOC OF FILENAME
MOVSI T2,'PIP'
MOVEM T2,TMPFIL
MOVSI T2,-200
HRR T2,SVJBFF ;CALCULATE TMPFIL ADDRESS FOR BUFFER
HRRZ T5,.JBREL ;GET TOP OF CORE
CAIGE T5,200(T2) ;WILL BUFFER FIT IN AVAILABLE CORE?
JRST [ADDI T5,200 ;NO, TRY FOR ONE MORE K
CORE T5,
JRST OMODER ;FAILED, GIVE UP
JRST .+1] ;WILL BE OK NOW
MOVEM T2,TMPFIL+1 ;STORE IN TMPFIL+1
SOS TMPFIL+1 ;MAKE IT AN IOWD
TMPCOR T1, ;READ AND DELETE PIP FILE
;T1 ON RETURN=NOWDS IN CS
JRST P11 ;NO PIP FILE IN CORE TRY DSK
HRLI T2,440700 ;SET UP BYTE POINTR FOR COMMANDS
MOVEM T2,TMPPNT ;USE LATER IN GETSC
SETOM TMPFLG ;SIGNAL THAT TMPCOR WAS USED
MOVNI 0,(T1) ;GET NUMBER OF WORDS
HRLM 0,TMPFIL+1 ;IN CASE COMMAND FAILS
ADDB T1,SVJBFF ;CALCULATE END OF TMPCOR BUFFER
MOVEM T1,TMPEND ;STORE FOR LATER USE
SETOM COMFLG ;MARK THAT CCL IS IN ACTION
JRST PIP2A ;START PIP
P11:>
PJOB T1, ;GET JOB NBR.
MOVEI 0,3 ;SET TO GENER. 3 DIGIT JOB NO
IDIVI T1,^D10 ;DIVIDE BY 10
ADDI T2,"0"-40 ;REMAINDER MAKE SIXBIT
LSHC T2,-6 ;SHIFT T2 RIGHT INTO T3
SOJG 0,.-3 ;DECREMENT AND LOOP
HRRI T3,'PIP'
MOVEM T3,CFILE ;INSERT JOB NBR IN CCL INIT
MOVSI T3,'DSK'
MOVEM T3,CCLINI+1 ;DEFAULT DEVICE
MOVSI T3,'TMP'
SETZM CFILE+3
P12: MOVEM T3,CFILE+1
SETZM CCLINI ;CLEAR MODE
MOVEI T3,CFI ;COMMAND FILE BUFFER HEADER
MOVEM T3,CCLINI+2
OPEN COM,CCLINI ;INIT DEVICE FOR CCL OR @
JRST CER1 ;CAN'T INIT
LOOKUP COM,CFILE ;LOOKUP COMMAND FILE
JRST [SKIPE CFILE+1 ;IF NUL FILE NOT FOUND
JRST CER2 ;NO, REAL FILE NOT FOUND
MOVSI T3,'CCL'
MOVEM T3,CFILE+1
JRST .-1] ;TRY AGAIN WITH CCL
INBUF COM,1 ;1 BUFFER ONLY
MOVE 0,.JBFF ;SAVE JOBFF NOW
HRRZM 0,SVJBFF ;TO LEAVE COMMANDS INTACT WHEN BUFFERS RECREATED
SETOM COMFLG ;SUCCESS: COMMAND FILE REQUESTED
JRST PIP2A
CER1: ERRPNT </?File />
PUSHJ P,P6BIT
CFILE
ERRPN2 </.TMP init failure!/>
CER2: SETOM COMEOF ;FORCE EXIT AFTER MESSAGE
ERRPNT </?Command file />
MOVEI T3,CFILE ;ADDRESS OF FILE NAME
PUSHJ P,FN.EX ;PUT IT IN MESSAGE
ERRPN2 </ not found!/>
PIP2: TLNE FLAG,TID;[125] NEED TO SET TAPE ID?
PUSHJ P,WRTID ;YES
SKIPE COMFLG ;LAST COMMAND CCL?
SKIPN COMEOF ;ANY MORE CCL COMMAND?
JRST PIP2A ;YES,GET NEXT PIP COMMAND
CLOSE CON, ;FORCE OUTPUT OF ERROR MESSAGE
EXIT 1, ;NO,CAN EXIT
SETZM COMFLG ;CLEAR FLAG NOW
JRST PIP2A ;JUST INCASE MONITOR RETURNS>
IFE REENT,<IFN FTDSK,<
CERR7: ERRPNT </?4K needed/>
EXIT ;EXIT TO MONITOR>>
SUBTTL SCAN COMMAND STRING
PIP:
;NEW COMMAND STRING SCAN STARTS HERE
IFE CCLSW,<PIP2: >
PIP2A: JSP T5,INICN1 ;INITIALIZE THE TTY AND PDL
IFN CCLSW,<SKIPE COMFLG ;ACCEPT NEW PIP COMMAND?
JRST PIP2B ;NOT PIP (TTY) COMMD, BUT CCL>
MOVEI 0,"*" ;TYPE ASTERISK******
IDPB 0,TFO+1 ;READY TO ACCEPT
OUTPUT CON, ;COMMAND FROM TTY
PIP2B: SETZM TOTBRK ;CLEAR PAREN COUNTER
MOVEI 0,TABSP ;SPACES PER TAB
MOVEM 0,TABCT ;INITIALIZE TAB COUNT
MOVE 0,ZRO ;ASCII /00000/
MOVEM 0,SQNUM ;INITIALIZE SEQUENCE NUMBERS
RELEAS CON, ;RELEASE TTY FOR USE AS IN-OUT DEVICE
MAINA1: SETZB FLAG,FZERO ;INITIALIZE FOR FIRST/NEXT COMMAND STRING
SETZB AUXFLG,DEVICE
IFN FTDSK,<HRRZI 0,'SYS' ;SYSTEM DIRECT DEV, DSK/DTA
HRLZM 0,ADSK ;PUT IN SYSTEM DEVICE>
MOVE 0,[XWD FZERO,FZERO+1]
BLT 0,LZERO ;CLEAR STORAGE AREA
SETZ CALFLG, ;CLEAR OTHER FLAGS
IFN CCLSW,<SKIPE COMFLG ;CCL COMMAND?
JRST COMPRO ;YES, GET FROM CORE OR DSK>
MOVE T3,.JBFF ;FREE CORE POINTER
HRLI T3,(POINT 7) ;FORM BYTE POINTER
MOVEM T3,COMPTR ; FOR STORING CS IN CORE
;ACCUMULATE CS CHARS IN CORE
COMSTO: PUSHJ P,GETTA ;GET CS CHAR
AOS COMCNT ;COUNT CHARS
MOVEI T4,1(T3) ;GET BYTE POINTER ADDRESS PLUS SOME
CAMGE T4,.JBREL ;SEE IF IT WILL BE IN BOUNDS
JRST .+3 ;YES, ALL IS WELL
CORE T4, ;GET WHAT WE NEED
JRST OMODER ;FAILED, UNLIKELY TO HAPPEN
CAIN 0,CZ ;CHECK FOR ^Z
COMASK: PUSHJ P,GETEN2 ;SET ^Z IN 0
IDPB 0,T3 ;STORE IN COMBUF
SKIPE COMEOF ;END-OF-FILE SET?
AOJA T3,COMSTD ;YES, PROCESS CS IN COMBUF
CAIG 0,CR ;NOT EOF
CAIGE 0,LF ;LF,VT,FF,CR?
CAIN 0,ALTMODE ;NO, $?
JRST COMASK ;YES
JRST COMSTO ;NO, KEEP STORING
COMSTD: HRRM T3,.JBFF ;RESET JOBFF TO RETAIN STORED COMMAND
HRRM T3,DTJBFF ;ALSO JOBFF AFTER 2 TTY BUFFERS (PLUS COMMAND)
; AND FALL INTO COMPRO
;********************************************************************
;BEGIN SCAN OF DESTINATION PORTION OF COMMAND STRING
COMPRO:
SETZM DEVICE ;[163] ENSURE THAT WE GET DEFAULT
COMPRP: RELEASE CON, ;RELEASE TTY
PUSHJ P,NAME ;GO SCAN DESTINATION PORTION OF COMMAND STRING
SKIPE XNAME ;NO SCAN OVERSHOOT ALLOWED
JRST ERR6A
SKIPL ESWTCH ;11/25/69 END OF CS ?
JRST MAINC ;NO
IFN CCLSW,<SKIPE COMFLG ;STILL IN CCL
JRST PIP2 ;YES>
TLNE AUXFLG,QFLG ;PERHAPS JUST /Q?
JRST MAINQ ;YES IT WAS
TRNN CALFLG,NSWTCH ;NON-NULL DESTINATION
TRNE CALFLG,SSWTCH ;_ NOT SEEN?
SKIPE FILNAM ;OR ANYTHING IN FILENAME
JRST ERR6A ;YES, ERROR
JRST PIP2 ;NO, ALL OK
MAINQ: MOVSI 0,'TTY' ;[163] /Q DEFAULT IS TTY
SKIPE DEVICE ;[163] SO USE IT IF NOTHING TYPED
MAINC: MOVE 0,DEVICE ;[163] SEE IF ANYTHING TYPED
SKIPN 0 ;[163]
MOVSI 0,'DSK' ;[163] NOTHING TYPED, USE DSK:
IFN FTDSK,< ;[240]
MOVEM 0,ADSK ;[240] SAVE FOR ERROR TYPEOUT
>;[240] END IFN FTDSK
MOVEM 0,DEVICE ;[205] IF DEFAULT, SAVE IT
MOVEM 0,ODEV ;SAVE DEVICE NAME FOR LATER USAGE
PUSHJ P,DEVTST ;SAVE DEVICE TYPE, SET XXXOUT.E.G. DTAOUT
PUSHJ P,ABCHK ;CHECK MTA BACKSPACE/ADV VALUES
PUSHJ P,PROTK ;CHECK PROTECTION
MOVE 0,AB ;MTA VALUE SWITCHES
MOVEM 0,ABOUT ;GET MTA CONTROL NUMBERS FO R OUT
MOVE 0,AUX
MOVEM 0,AUXOUT
MOVE 0,[FILNAM,,DTON]
BLT 0,DTON+3 ;SAVE DESTINATION FILE NAME
IFN FTDSK,<TRNN AUXFLG,DSKOUT ;DISK OUTPUT?>
SETZM DTON+3 ;ZERO 4TH WD OF DIRECTORY ENTRY
IFN FTDSK,< ;[211]
TLZE FL,PPSEEN!PPPSEN ;[207] SEE IF EXPLICIT PPN GIVEN
TLOA FL,OPPSEN ;[211] YES, SET FLAG AND COPY FULL PATH
JRST M3 ;[211] NO, SKIP COPY
MOVE 0,PTHPPN ;[217] YES, GET PPN IN CASE NO SFD'S
MOVEM 0,PTHOUT+2 ;[217] AND PUT IT IN OUTPUT PATH
SKIPN PTHSFD ;[211] SEE IF SFD SPECIFIED
JRST M3 ;[211] NO, SKIP COPY OF PATH
MOVE 0,[PTHADD,,PTHOUT]
HRRZM 0,DTON+3 ;SET PATH ADDRESS
BLT 0,PTHOUT+PTHLEN+3
>
M3: TRZ CALFLG,SSWTCH ;TERMINATE DESTINATION FILE SCAN
IFE FTDSK,<SETZM DEVICE ;DONT CARRY OVER INPUT DEVICE>
IFN FTDSK,<SETZM PPP ;CLEAR OUTPUT PPN
SETZM DEVPP ;[163] AND ERSATZ DEVICE PPN
SETZM PP ;JUST IN CASE
SETZM PTHADD ;AND FULL PATH JUNK
MOVE 0,[XWD PTHADD,PTHADD+1] ;[221] CLEAR ALL OF PATH SPEC
BLT 0,PTHADD+PTHLEN+3 ;[221]
SETZM DEFPTH ;AND ITS DEFAULT
MOVE 0,[XWD DEFPTH,DEFPTH+1] ;[211] CLEAR ALL OF PATH SPEC
BLT 0,DEFPTH+PTHLEN+3 ;[221]
MOVSI 0,'DSK' ;DEFAULT CASE DSK
TRNN FLAG,RFLG!DFLG ;[163] FORCE CONSTANT DEV: FOR /D & /R
MOVEM 0,DEVICE ;MUST NOT LET O/DEV. CARRY OVER AS I/DEV.>
M3A: PUSHJ P,DESCRP ;GET A UNIT DESCRIPTOR (INPUT).
TLNN AUXFLG,QFLG ;[230] /Q?
JRST M2 ;NO
HRRZI 0,'SYS' ;YES MAKE INPUT DEVICE SYS
HRLZM 0,DEVICE
HRLZM DEVA ;SAVE COPY OF INPUT DEVICE
MOVE 0,['PIPHLP'] ;NAME.EXT FOR HELP TEXT
HLLZM 0,FILNAM
HRLZM 0,FILEX
TDZ FLAG,[XWD -1-GFLG-WFLG-TID,-1-SPMOD-TBMOD-BMOD-SQMOD-MTFLG-ZFLG];[230]
TDZ FL,[XWD MFLG,FNEX+TMPI+NSWTCH];[230] CLEAR ANY EXTRA
TRO FL,DEV+NEWDEV+MATEX+MATFN ;[230] SET WHAT WE WANT
SETZM PP ;[163] CLEAR PPN FOR SYS:
SOS ESWTCH ;NO MORE COMMAND STRING
PUSHJ P,CHECK1 ;CHECK INPUT DEVICE
M2: TLO AUXFLG,NOMORE ;NO MORE SWITCHES BUT MTA ALLOWED
TLNE FLAG,OFLG ;BLOCK 0 COPY?
JRST BLOCK0 ;YES
;CHECK TO SEE IF IN COPY MODE WITH WILD CARD OUTPUT BUT /X WASN'T GIVEN
TRNN FLAG,RFLG!DFLG ;[244] DON'T FORCE /X FOR /R/D
TRNN AUXFLG,DTAOUT!DSKOUT ;[244] SEE IF DIRECTORY OUTPUT
JRST M2B ;[244] NO
SKIPN OQMASK ;[244] YES, SEE IF WILD CARDS
SKIPE OQMASK+1 ;[244] IN NAME OR EXTENSION
SKIPA ;[244] YES
JRST M2B ;[244] NO
TRNN FLAG,LFLG ;[244] YES, SEE IF /L OR /F
TRNE AUXFLG,FFLG ;[244] CAUSE THAT WON'T WORK
JRST ERR13 ;[244] THAT'S A NONO
TRO FLAG,XFLG ;[244] OK, SWITCH TO /X
M2B: ;[244]
TRNN FLAG,XFLG ;/X ?
JRST M2A ;NO
TRNE FLAG,RFLG ;(RX)?
JRST M5 ;YES, (RX)
MOVE 0,DTON ;GET FILE NAME
JUMPN 0,M5 ;BELIEVE ANYTHING BUT ZERO
HLRZ 0,DTON+1 ;SAME FOR EXT
JUMPN 0,M5
M2A: IFN RIMSW,<
TLNN FLAG,RIMFLG ;RIM OUTPUT?
JRST M1 ;NO
TRNE AUXFLG,PPTOUT ;RIM IS ONLY DTA TO PTP
TRNN AUXFLG,DTAIN!DSKIN!MTAIN
JRST ERR5B>
M1: MOVEI T4,1 ;ASCII LINE MODE ASSUMED
PUSHJ P,OUTLOOK ;SEE IF OUTPUT DEV MTA
PUSHJ P,M4 ;NOT MTA
TLNE FLAG,JFLG ;NON STARDARD MODE ?
TRO T4,100 ;TO PUNCH 029 ON CDP
TRNN AUXFLG,TTYOUT ;[251] SEE IF OUTPUT TO TTY
TRZ T4,100 ;[251] YES, THEN DON'T SET /J IO.SEM
HRRZM T4,OMOD ;SET MODE OF OUTPUT DEV
MOVEI T4,1
PUSHJ P,INLOOK ;SEE IF INPUT DEV MTA
PUSHJ P,M4 ;NOT MTA
HRRZM T4,ININI1 ;SET MODE OF INPUT DEV
PUSHJ P,FNSET ;NOW DEVICE, DEVA CORRECT FOR START
JRST OMOD1 ;INIT OUTPUT DEVICE
SUBTTL INITIALIZE INPUT AND OUTPUT DEVICES
;SET MODE IF /I,/B,/H,
M4: TRNN FLAG,BMOD ;BINARY MODE?
JRST .+3 ;NO
TRZ T4,17 ;CLEAR ALL MODES
TRO T4,14 ;BIN. MODE
TLNN FLAG,IFLG ;IMAGE BINARY MODE?
JRST .+3 ;NO
TRZ T4,17 ;CLEAR ALL MODES
TRO T4,10 ;IM. MODE
TLNN FLAG,IBFLG ;IMAGE BINARY MODE?
JRST .+3 ;NO
TRZ T4,17 ;CLEAR ALL MODES
TRO T4,13 ;YES
TRNE FLAG,XFLG ;COPY MODE?
POPJ P, ;YES, DON'T ALTER DATA MODE
TRNE FLAG,DFLG+RFLG ;DELETE OR RENAME?
TRO T4,20 ;DIRECTORY WILL BE WRITTEN, DON'T
POPJ P, ;COMPUTE WORD COUNT MODE NEEDED.
;FORCE MONITOR TO USE WORD COUNT
;IN FIRST DATA WORD OF BUFFER
M5: TRZ FLAG,RFLG ;CLEAR /R FLAG
TRO CALFLG,RXFLG ;SET (RX) FLAG
MOVE 0,[DTON,,MATCH]
BLT 0,MATCH+1 ;SAVE NAME AND EXT
JRST M2A ;RETURN
;IF OUTPUT DEVICE IS MTA PERFORM ALL PRE-TRANSFER REQUESTS
;SUCH AS REWIND. IF OUTPUT DEVICE IS MTA, AND THERE IS NO
;INPUT DEVICE, EXIT. FOR OTHER MTA OUTPUT, PREPARE INIT
;DENSITY AND PARITY.
OUTLOOK:
MOVE T3,ABOUT ;AB FOR OUTPUT DEV
MOVE T1,AUXOUT ;AUX FOR OUTPUT DEV
MOVEI T6,INOMTA ;SET TO INIT
JRST MT1 ;MTA FOR OUTPUT
;SAME FOR INPUT DEVICE.
INLOOK: SKIPE T3,FILNAM ;IF NO FILENAME
TRNN FLAG,XFLG ;OR NOT /X
JRST INLUK1 ;CONTINUE
SKIPE DTON ;IF OUTPUT NAME SET UP
JRST INLUK1 ;CONTINUE
HLRZ T1,FILEX ;GET EXT
MOVEM T3,DTON ;SET OUT NAME
HRLZM T1,DTON+1 ;AND EXTENSION
INLUK1: MOVE T3,AB ;ADV OR BKSPACE
MOVE T1,AUX ;AUX FOR INPUT DEV
MOVEI T6,INIMTA ;SET TO INIT
JRST MT1 ;MTA FOR INPUT
;ROUTINE TO INITIALIZE OUTPUT DEVICE
OMODE: IFN TEMP,<
TRNE CALFLG,TMPO ;TMPCOR OUTPUT DEVICE?
JRST OMOD2 ;YES, NO OUTBUFS>
MOVE T1,[XWD OBF,IBF]
MOVEM T1,ODEV+1
MOVE T1,DTJBFF ;JOBFF AFTER 2 TTY BUFS
MOVEM T1,.JBFF ;SET UP
OPEN OUT,OMOD ;INITIALIZE OUTPUT DEVICE
JRST ERR1 ;UNAVAILABLE ERROR
OUTBUF OUT,1 ;TRY ONE OUTBUFFER FOR SIZE
EXCH T1,.JBFF ;JOBFF_DTJBFF+BUFSZ
;NOTE JOBFF RESET TO DTJBFF
SUB T1,DTJBFF ;T1=BUFSZ
HRRZ 0,.JBREL ;HIGHEST CORE AVAILABLE
SUB 0,DTJBFF ;0=TOTAL CORE AVAILABLE
ASH 0,-1 ;COMPUTE HOW MANY OUTPUT BUFFERS
IDIVM 0,T1 ;FIT IN HALF THE AVAILABLE SPACE
MOVEI T4,OMODE ;SET RETURN FROM CORCHK
PUSHJ P,CORCHK ;LOOP BACK OR ERROR IF NOT ENOUGH CORE
OUTBUF OUT,(T1) ;SET UP OUTPUT BUFFERS
MOVE 0,OBF+1
MOVEM 0,SVOBF ;SAVE ORIGINAL MODE SETTING
OMOD2: MOVE 0,.JBFF
HRRZM 0,SVJBF1 ;PREPARE TO RECLAIM INBUFFER SPACE
POPJ P,
OMOD1: PUSHJ P,OMODE ;GO INITIALIZE OUTPUT DEVICE
TRZN FLAG,ZFLG ;[163] /Z IN COMMAND STRING
JRST MAINA2 ;NO,
PUSH P,DTON ;[204] SAVE TYPED FILE NAME WHICH GETS CLOBBERED
PUSHJ P,DTCLR ;[204] YES, GO CLEAR DIRECTORY
POP P,DTON ;[204] RESTORE CLOBBERED OUTPUT FILE NAME
MOVE 0,DEVICE ;[254] RESTORE ADSK
MOVEM 0,ADSK ;[254] SINCE DISK ZERO CLOBBERED IT
RELEASE OUT,
RELEASE DIR,
TRNN CALFLG,NSWTCH ;SEE IF DEVICE WAS TYPED
JRST OMOD1 ;YES
JRST PIP2 ;GET NEXT COMMAND
;ROUTINE TO CHECK FOR ENOUGH CORE FOR I/O BUFFERS
;ENTER T1: COMPUTED NUMBER OF BUFFERS WE WANT
; T4: WHERE TO GO IF WE EXPAND CORE
CORCHK: CAIL T1,2 ;ROOM NOW FOR AT LEAST 2 BUFFERS?
POPJ P, ;YES, RETURN OK
JUMPLE T1,MORCOR ;HAVE TO GET MORE ROOM IF NONE
HRRZ 0,.JBREL ;WANTED 1, SEE IF WE CAN GET 2
ADDI 0,1000 ;TRY 1/2K MORE
CORE 0,
POPJ P, ;NO, LIVE WITH 1 BUFFER
POP P,0 ;YES, POP OFF PUSHJ CALL
JRST (T4) ;AND RECOMPUTE
MORCOR: HRRZ 0,.JBREL ;TRY TO GET
ADDI 0,2000 ;1K MORE OF CORE
CORE ;ASK MONITOR FOR 1K CORE
JRST OMODER ;NOT AVAILABLE
JRST (T4) ;GOT IT
OMODER: ERRPNT</?Not enough core/>
EXIT
SUBTTL PROCESS INPUT COMMAND STRING
MAINA2: TRNE FLAG,RFLG+DFLG ;RENAME OR DELETE FILE MODE?
JRST DTDELE ;YES./D,/X,OR(DX)
IFN RIMSW,<
TLNE FLAG,RIMFLG ;RIM?
JRST RIMTB ;YES./Y
>
TRNE FLAG,XFLG ;TRANSFER EVERYTHING MODE?
JRST PRECOP ;YES./X
;LOOP TO COPY ALL FILES BEGINS HERE FROM MAIN2
MAINA3: TRNN AUXFLG,FFLG ;LIST DSK DIR SHORT?
TRNE FLAG,LFLG ;LIST DIRECTORY?
JRST DTPDIR ;YES./F OR /L
IFN TEMP,<
TRNE CALFLG,TMPI ;TEMCOR:
JRST TMPIN ;YES THIS IS SPECIAL>
MANA3A: ;[206]
PUSHJ P,ININIT ;INITIALIZE INPUT FILE
TRNN CALFLG,FNEX ;SINGLE FILE SPECIFICATION?
JRST [MOVE 0,[FILNAM,,ZRF] ;YES, DON'T READ DIRECTORY
BLT 0,ZRF+3 ;SET UP FILE NAME,EXT, AND PPN
SETZM GENERI ;JUST IN CASE
JRST MANA42] ;[211]
TRNE AUXFLG,DTAIN ;DEC TAPE INPUT?
PUSHJ P,DTADIR ;INIT DTA DIR
IFN FTDSK,<TRNN AUXFLG,DSKIN ;NO, DISK INPUT?
JRST MAINA4 ;NO
PUSHJ P,INITFS ;INIT SEARCH LIST IF LEVEL D
JRST MANA41 ;[211] NOT GENERIC "DSK"
MAINAD: PUSHJ P,NXTFSU ;GET NEXT F/S
JRST [TRNN AUXFLG,REDFLG ;WAS FILE FOUND?
PUSHJ P,ERR3A ;NO
JRST MAINA7] ;NO MORE F/S
TROA CALFLG,FNEX ;KEEP THE FLAG FLYING
MANA41: ;[211]
PUSHJ P,DSKDIR ;INIT DSK UFD CHANNEL>
MAINA4: PUSHJ P,LOOK ;GET A FILE TO COPY
JRST MAINA5 ;NO MORE
MANA42: ;[211]
IFN FTDSK,<PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT>
LOOKUP IN,ZRF
JRST MAINQ1 ;[230] LOOKUP FAILURE, GO SEE IF /Q
IFN TEMP,<TRNE CALFLG,TMPO
JRST TMPOUT ;OUTPUT TO TMPCOR>
TLO FLAG,NEWFIL
PUSHJ P,FILTYP
TRNE AUXFLG,ONEOUT
JRST PSCANA ;OUT HAS BEEN INITIALIZED
PUSHJ P,OKBLKS
IFN FTDSK,<SKIPE LEVEL ;IF LEVEL D
TLNN AUXFLG,NSPROT ;AND NON-STANDARD PROTECTION
JRST .+3 ;NOT BOTH TRUE
LDB 0,PRPTL ;GET PROTECTION CODE
DPB 0,PRPTD ;INTO ENTER BLOCK [207]
MOVE 0,DTON+3 ;[207] SAVE PPN FOR RENAME
>;[207] END IFN FTDSK
SETO T2, ;[247] SET FLAG FOR AFTER ENTER
TRNE AUXFLG,DTAIN!DSKIN ;[247] IF DTA OR DISK INPUT
TRNN AUXFLG,DTAOUT!DSKOUT ;[247] AND DTA OR DISK OUTPUT
JRST MANA43 ;[247] NOPE
GETSTS OUT,T1 ;[247] GET CURRENT STATUS
LDB T2,[POINT 4,ZRF+2,12] ;[247] GET ORIGINAL STATUS
SETSTS OUT,(T2) ;[247] MAKE NEW FILE THE SAME
MANA43: ;[247]
ENTER OUT,DTON ;CREATE OUTPUT FILE
JRST ERR4 ;DIR. FULL OR 0 FILE NAME
SKIPL T2 ;[247] SEE IF MODE CHANGED
SETSTS OUT,(T1) ;[247] YES, RESTORE PROCESSING MODE
MOVEM 0,DTON+3 ;[207] RESTORE PPN
JRST PSCANA
MAINQ1: TLZN AUXFLG,QFLG ;[230] SEE IF /Q, FIRST TIME THRU
JRST ERR3 ;[230] NO, ERROR
MOVSI 0,'HLP' ;[230] YES, TRY HLP: AFTER SYS:
MOVEM 0,DEVICE ;[230]
JRST MANA3A ;[230] GO DO LOOKUP AGAIN
MAINA5:
IFN FTDSK,<TRNE AUXFLG,DSKIN ;DSK INPUT
JRST MAINAD ;YES, GET NEXT F/S>
MAINA7: TRZE AUXFLG,REDFLG ;[257] SEE IF READ ANYTHING
JRST MAIN1 ;[257] YES, CONTINUE
TRNE AUXFLG,DTAIN ;[257] NO, IF DECTAPE IN, THEN
PUSHJ P,ERR3A ;[257] PRINT FILE NOT FOUND MESSAGE
JRST IOERRN ;[257] AND RELEASE EVERYTHING
PSCANB: TRNE AUXFLG,MTAIN!CDRIN!TTYIN!PPTIN ;ON NON-DIR DEVICE?
TRZ CALFLG,ALLCLF ;END OF THE ONE OR MANY FILES SPECIFIED
TRON AUXFLG,ONEOUT ;HAS OUT JUST BEEN INIT?
OUTPUT OUT, ;YES, AND FIRST FILE IS EOF ONLY, INIT OUT IN
;CASE NO MORE SOURCE FILES
JRST PSCAN5 ;EMPTY FILE, CLOSE INPUT, RETURN FOR MORE
SUBTTL FILE COPYING ROUTINES
PSCANA: TRO AUXFLG,REDFLG ;SET FLAG FOR INPUT FILE READ
PUSHJ P,INP ;GO READ INPUT FILE
TRZ AUXFLG,READ1
PUSHJ P,TTYZ ;CHECK IF INPUT IS TTY
TRNE IOS,EOFBIT ;EOF FIRST DATA?
JRST PSCANB
SKIPN IBF+2
JRST PSCANA
PSCAN: TRO AUXFLG,ONEOUT ;INDICATE ONE OUTPUT FILE INITED
TDNN FLAG,[XWD IFLG+IBFLG,BMOD] ;BIN. OR NO CHAR. PROCESSING
TLNE AUXFLG,SBIN
JRST PSCAN3 ;YES
MOVE 0,OPTRA ;PRESCAN A LINE, INITIALIZE LINE BUFFER PTR
MOVEM 0,OPTR
SETZM CDRCNT
PUSHJ P,CLRBUF ;CLEAR LINE BUFFER
TRO FLAG,STS ;START A FRESH LINE
PSCAN2: PUSHJ P,GET ;GET CHARACTER
JRST PSCAN1 ;END OF FILE RETURN
CAIN CHR,DEL ;VJC 4/16/69
JRST PSCAN2 ;GET NEXT CHAR
HRRZ T1,OPTR ;GET DEPOSIT ADDRESS
CAIL T1,LBUFE
PUSHJ P,PSCLNG ;LINE TOO LONG
IDPB CHR,OPTR ;DEPOSIT CHAR. IN LINE BUFFER
CAIG CHR,24
CAIGE CHR,20 ;LINE PRINTERR CONTROL CHAR
SKIP 1 ;NO
JRST PSCAN4 ;YES, TREAT AS END OF LINE
CAIG CHR,14
CAIGE CHR,12 ;END OF LINE CHARACTER?
SKIP 1 ;NO
JRST PSCAN4 ;YES
CAIGE CHR," " ;TEST FOR CONTROL CHARS.
CAIN CHR,CR ;BUT ALLOW CR
JRST PSCAN2 ;NONE, SO CONTINUE
CAIE CHR,TAB ;TAB IS O.K. THOUGH
TRNN AUXFLG,LPTOUT!IFN CTLTTY,<TTYOUT> ;[241] LPT? OR <TTY?>
JRST PSCAN2 ;[135] NO, DON'T CONVERT CHARACTER
IFN CTLTTY,< ;[251]
TRNN AUXFLG,LPTOUT ;[251] SEE IF TTY
TLNE FLAG,JFLG ;[251] YES, SEE IF /J
SKIPA ;[251] LPT OR /J TO TTY
JRST PSCAN2 ;[251] NOT /J TO TTY
>;[251] END IFN CTLTTY
PUSH P,CHR ;IT WAS, SO SAVE IT
MOVEI CHR,"^" ;STANDARD UP ARROW
DPB CHR,OPTR;WIPE OUT BAD CHAR
POP P,CHR ;GET IT BACK
TRC CHR,100 ;MAKE IT VISIBLE
IDPB CHR,OPTR
JRST PSCAN2 ;AND CONTINUE
PSCAN4: TRNN FLAG,TBMOD!SPMOD;REMOVED TRAILING SPACES?
JRST PSCAN7 ;NO
HLRZ T2,LBUF ;[253] GET FIRST TWO CHARACTERS
ANDI T2,(BYTE (7)-1,-1) ;[253] CLEAR RIGHT BITS
CAIE T2,(BYTE (7)CR,LF) ;[253] BLANK LINE?
JRST PSCAN7 ;NOT A BLANK LINE
MOVE T2,[BYTE (7) 40,15,12,40,40]
MOVEM T2,LBUF ;GUARENTEE ONE SPACE
IBP OPTR ;DON'T FORGET TO ACCOUNT FOR IT
PSCAN7: PUSHJ P,OUTLBF ;YES, SO DUMP THE LINE BUFFER
JRST PSCAN ;SCAN THE NEXT LINE
PSCAN1: TRZ CALFLG,SQNSN ;[140-12349] CLEAR SEQ. NO. FOUND THIS LINE
LDB CHR,OPTR ;PICK UP LAST CHAR.
CAIN CHR,CZ ;IS IT ^Z
TRNN AUXFLG,TTYIN ;FROM TTY?
JRST PSCAN6 ;NO
SETZ CHR, ;YES,CLEAR CHAR.
DPB CHR,OPTR ;AND REMOVE FROM BUFFER
PSCAN6: PUSHJ P,OUTLBF ;DUMP THE REMAINING BUFFER
TRNE FLAG,XFLG ;COPY MODE?
JRST COPY2A ;YES, GO COPY THE NEXT FILE
PSCAN5: CLOSE IN,
JRST MAINA4
;HERE IF LINE IS TOO LONG FOR LINE BUFFER
PSCLNG: TRNE FLAG,LINE ;FATAL IF /A LINE BLOCKING
JRST ERR10 ;SINCE WE DON'T KNOW HOW TO
PUSHJ P,OUTLBF ;DUMP THE LINE
MOVE 0,OPTRA ;FIX UP LINE BUFFER AGAIN
MOVEM 0,OPTR
LDB CHR,IBF+1 ;[126] RESTORE THE LOST CHARACTER
JRST CLRBUF ;CLEAR LINE BUFFER AND RETURN
;HERE FOR BINARY TRANSFER
PSCAN3: SETZB T3,T4 ;SAVES TIME LATER
TLNN FLAG,PFLG ;FORTRAN BINARY DATA (BP) ?
JRST PSCAN8 ;NO
ILDB T3,IBF+1 ;GET DATA COUNT
TRZE T3,-1 ;INCASE ONLY ONE BLOCK
SETO T4, ;IT WAS, SO FLAG THAT FACT
SOS IBF+2 ;COUNT ONE LESS
PSCAN8: SKIPG IBF+2 ;BUFER ENPTY?
JRST [PUSHJ P,INP ;YES, INPUT A BUFFER
TRNE IOS,EOFBIT ;END OF FILE?
JRST PSCAN6+1 ;YES, RETURN
TLNN FLAG,PFLG ;FORTRAN BINARY?
JRST .+1 ;NO
ILDB CHR,IBF+1 ;GET FIRST DATA WORD
TRZE CHR,-1 ;INCASE LAST BLOCK
HRLI T4,-1 ;FLAG IT WAS
ADD T3,CHR ;ADD TO WORD COUNT
SOS IBF+2 ;DECREMENT WORD COUNT
JRST .+1] ;BUFFER FULL NOW
SKIPG OBF+2 ;ANY ROOM IN OUTPUT BUFFER?
JRST [PUSHJ P,OUTP ;OUTPUT FULL BUFFER
TLNN FLAG,PFLG ;FORTRAN BINARY?
JRST .+1 ;NO
SOS CHR,OBF+2 ;GET WORD COUNT-1
HRLZS CHR ;PUT COUNT IN LEFT HALF
SUB T3,CHR ;ACCOUNT FOR LAST BLOCK OUTPUT
IDPB CHR,OBF+1 ;STORE AS FIRST WORD
ADDI T3,1 ;INCREMENT BLOCK COUNT
HRR T4,OBF+1 ;SAVE INITIAL ADDRESS
JRST .+1] ;CONTINUE
MOVE T1,IBF+2 ;NUMBER OF WORDS TO GO
CAMLE T1,OBF+2 ;WILL THEY FIT?
MOVE T1,OBF+2 ;NO, SO FILL BUFFER ONLY
HRLZ T2,IBF+1 ;BLT FROM INPUT
HRR T2,OBF+1 ;TO OUTPUT
AOBJP T2,.+1 ;BUT START ON DATA WORDS
ADDM T1,IBF+1 ;ADJUST BYTE POINTER
ADDM T1,OBF+1
MOVNS T1 ;NEGATE WORDS TO GO
ADDM T1,IBF+2 ;ADJUST WORD COUNT
ADDM T1,OBF+2
BLT T2,@OBF+1 ;MOVE WORDS
JUMPGE T4,PSCAN8 ;NOT FORTRAN BINARY, OR NOT LAST BLOCK
SKIPE IBF+2 ;FINISHED WITH THIS BUFFER?
JRST PSCAN8 ;NO, WILL FIX WORD COUNT NEXT TIME
ADDM T3,(T4) ;SET FINAL WORD COUNT
SETZB T3,T4 ;JUST IN CASE
SETZM OBF+2 ;FORCE OUTPUT
JRST PSCAN8 ;GET MORE
SUBTTL FINISHED AN OUTPUT FILE, SEE IF MORE
;COME HERE AFTER /L,/D,/R ON DISK OR THROUGH COPYING
MAIN1: RELEAS DIR, ;RELEASE THE DIRECTORY DEVICE
RELEAS IN,INHIB ;RELEASE THE INPUT DEVICE
SKIPL T4,ESWTCH ;MORE COMMAND STRING TO PROCESS?
JRST MAIN2 ;YES
;COME HERE AFTER /D,/R ON DTA. ALSO FROM ABOVE
MAINB: ;[207]
IFN LEVELC,< ;[207]
SKIPL LEVEL ;[207] SEE IF LEVEL C
CLOSE OUT, ;[207] YES, THEN CLOSE FIRST
>;[207] END IFN LEVELC
IFN FTDSK,<TLNE AUXFLG,NSPROT ;NON-ST. PROT?
TRNN AUXFLG,DSKOUT ;DISK OUT/
JRST MAINB1 ;NO
LDB 0,PRPTL
SKIPE LEVEL ;IF LEVEL D
JUMPN 0,MAINB1 ;ALREADY SET UNLESS 0
DPB 0,PRPTD
SETZM DTON+3 ;[207] CLEAR OUT PPN
RENAME OUT,DTON ;SET UP RENAME REQUEST
JRST DERR6 ;DISK ERROR
SKIPA ;[207] SKIP CLOSE
MAINB1:>
CLOSE OUT, ;[207] FINISH THE OUTPUT FILE
TRNN FL,TMPO ;[207] DON'T CHECK STATUS IF TMPCOR
PUSHJ P,OUTP1 ;[207] CHECK FINAL ERROR BITS
RELEAS OUT, ;RELEASE THE OUTPUT DEVICE
JRST PIP2 ;PROCESS THE NEXT COMMAND
MAIN2: PUSHJ P,DESCRP ;GET THE NEXT INPUT FILE TO PROCESS
PUSHJ P,INLOOK
PUSHJ P,M4
HRRZM T4,ININI1
JRST MAINA3
;END OF LOOP BEGINNING AT MAINA3
SUBTTL INITIALIZE THE INPUT FILE
ININIT: IFN TEMP,<
TRNE CALFLG,TMPI ;IF DEV IS TMPCOR:
POPJ P, ;RETURN>
HRRZ 0,ININI1 ;[164] GET THE PREVIOUS MODE (OR FIRST)
SKIPE GENERI ;[164] SEE IF GENERIC DISK
TLO 0,UU.PHS ;[164] YES, SET PHYSICAL ONLY TO GET REAL STRUCTURES
MOVEM 0,ININI1 ;[164] SAVE OLD MODE AND UU.PHS
MOVE T1,SVJBF1 ;SVJBF1=END OF OUTPUT BUFFERS
MOVEM T1,.JBFF ;COMPARE OMODE CODE
MOVEI 0,IBF
MOVEM 0,DEVICE+1
OPENIT: OPEN IN,ININI1
JRST ERR1A ;NOT AVAILABLE ERROR
INBUF IN,1 ;TRY ONE INPUT BUFFER FOR SIZE
EXCH T1,.JBFF ;HOW MANY INBUFFERS WILL FIT?
SUB T1,SVJBF1
HRRZ 0,.JBREL
SUB 0,.JBFF ;JOBREL-SVJBF1=TOTAL SPACE LEFT
IDIVM 0,T1
MOVEI T4,ININIT ;RETURN FROM CORCHK IS ININIT
PUSHJ P,CORCHK ;LOOP BACK OR ERROR IF NOT ENOUGH CORE
INBUF IN,(T1) ;SET UP AS MANY BUFFS AS FIT
MOVE 0,IBF+1 ;SAVE ORIGINAL MODE
MOVEM 0,SVIBF
POPJ P,
SUBTTL READ AN INPUT FILE SPEC AND POSITION TAPE
;THIS ROUTINE GETS AN INPUT UNIT DESCRIPTOR AND, FOR
;ADVANCE FILE AND BSPF ON MTA, ENSURES THE VALUE 1 IF NO
;NUMBER WAS GIVEN.
DESCRP: SETZM AUX ;WILL GET ANY MTA REQ. GOING TO AUXFLG.
SETZM AB ;MTA VALUE SWITCHES
SETZM PR ;PROTECTION
IFN FTDSK,<SETZM PP ;PROJ-PROG NUMBER>
PUSHJ P,NAME ;GO SCAN INPUT SIDE OF COMMAND STRING
HLLZS PR ;[211] IGNORE PROTECT BIT IN RH ON INPUT
PUSHJ P,CHECK1 ;CHECK UNIT, AND FOR _
DESCR1: SKIPE XNAME ;NO OVERSHOOT ALLOWED
JRST ERR6A
ABCHK: HLRZ T2,AB ;NO RECS/FILES TO BACKSPACE
JUMPN T2,.+2 ;IF 0
MOVEI T2,1 ;GUARANTEE ONE
HRLM T2,AB ;SET AB LH
HRRZ T2,AB ;NO RECS/FILES TO ADV
JUMPN T2,FNSET ;IF 0
AOS AB ;GUARANTEE 1
JRST FNSET ;FIND OUT DETAILS OF FILENAME
;IF A NON-STANDARD OUTPUT PROTECTION IS REQUESTED, SAVE FOR RENAME.
PROTK: MOVE T1,PR
TRNN T1,1
JRST PROTK1
HLLZM T1,PROTS
HLLZM T1,PR
TLOA AUXFLG,NSPROT
PROTK1: SETZB T1,PR
POPJ P,
SUBTTL DETERMINE OUTPUT DEVICE TYPE
;TEST "DEVICE" TO SEE IF DESTINATION DEVICE IS DTA, DSK, PTP, LPT, TTY, MTA
;IF ANY IS TRUE, SET RELEVANT BIT IN AUXFLG. "0" CONTAINS
;"DEVICE" ON ENTRY.
DEVTST: DEVCHR ;GET DEVICE CHARACTERISTICS
IFN FTDSK,<TLNN 0,DSKBIT ;IS OUTPUT DEV DSK?
JRST DEVTSU ;NO
TRO AUXFLG,DSKOUT ;YES, SET BIT
POPJ P, ;[211] RETURN, DON'T CARE WHAT DEVPPN IS
DEVTSU:>;[163] END IFN FTDSK
JUMPE 0,DEVER2 ;NON-EXISTENT DEVICE
TLNN 0,OUTBIT ;CAN DEV DO OUTPUT?
JRST ERR6A ;NO
TLNE 0,DTABIT ;DECTAPE?
TRO AUXFLG,DTAOUT ;YES
TLNE 0,PTPBIT ;PAPER TAPE PUNCH?
TRO AUXFLG,PPTOUT
TLNE 0,LPTBIT ;LINE PRINTER?
TRO AUXFLG,LPTOUT
TLNE 0,TTYBIT ;TELETYPE?
TRO AUXFLG,TTYOUT
TLNE 0,MTABIT ;MAGTAPE?
TRO AUXFLG,MTAOUT
MOVE 0,ODEV ;GET OUTPUT DEVICE AGAIN
DEVTYP 0, ;NEED TO FIND OUT ABOUT SPOOLING
SETZ 0, ;NEED 5.03 TO SPOOL
TLNE 0,.TYSPL ;IS DEVICE SPOOLED
TLOA CALFLG,OSPLFL ;YES
TLZ CALFLG,OSPLFL ;NO
POPJ P,
SUBTTL SET UP THE ERSATZ DEVICE PPN IF NECESSARY
;ROUTINE TO CHECK IF DEVICE SYS,OLD,LIB,NEW AND SET [P,PN] IF NONE GIVEN
IFN FTDSK,<
;[163] CHANGE ROUTINE TO GET PPN OF ANY ERSATZ DEVICE
PSYSP: SETZM DEVPP ;[211] CLEAR ERSATZ DEVICE PPN
DEVPPN 0, ;[163] GET PPN FOR DEVICE IN 0
IFE LEVELC,< ;[211]
JFCL ;[211] IGNORE ERRORS
>;[211] END IFE LEVELC
IFN LEVELC,< ;[211]
PUSHJ P,TRYSYS ;[163] UNSUPPORTED, DO IT THE HARD WAY
>;[211] END IFN LEVELC
CAME 0,JOBPTH+2 ;[211] UNLESS DEVICE DIFFERENT FROM OUR DEFAULT
;[211] PATH PPN, IT'S NOT ERSATZ
MOVEM 0,DEVPP ;[163] AND ERSATZ DEVICE PPN
POPJ P, ;[163]
IFN LEVELC,< ;[211]
TRYSYS: DEVNAM 0, ;[163] NO DEVPPN, SEE IF WAS LOGICAL NAME
JFCL ;[163]
CAMN 0,['SYS '] ;[163] SEE IF SYS:
SKIPA T1,SYSPPN ;[163] YES, USE SYS'S PPN
MOVE T1,JOBPPN ;[163] NO, USE OURS
MOVE 0,T1 ;[163] COPY FOR PSYSP
POPJ P, ;[163] AND GO BACK
>;[211] END IFN LEVELC
>;[163] END IFN FTDSK
SUBTTL NON-EXISTANT DEVICE, INIT P & CTY
DEVER1: IFN TEMP,<
TROA CALFLG,TMPI>
DEVER2: IFN TEMP,<
TRO CALFLG,TMPO>
IFN TEMP,< ;[211]
MOVE T1,DEVICE ;[211] GET NON-EXISTANT DEVICE NAME
DEVNAM T1, ;[211] IN CASE LOGICAL
MOVE T1,DEVICE ;[215] RESTORE DEVICE NAME SINCE TMP: GONE
HLRZ T1,T1 ;[211] SWITCH FOR COMPARE
CAIN T1,'TMP'
POPJ P, ;ALLOW DEVICE TMPCOR:
TRZ CALFLG,TMPI!TMPO ;JUST IN CASE>
MOVE T1,DEVICE
DEVER: MOVEM T1,DEVERR
ERRPNT </?Device />
PUSHJ P,P6BIT
DEVERR
ERRPN2 </ does not exist!/>
;ROUTINE TO INIT PDL POINTER AND TTY
INICN1: MOVEI P,PDL-1 ;INITIALIZE PUSHDOWN POINTER
SETZM DTJBFF ;ALWAYS REINITIALIZE IF * OUTPUT
INICN2: MOVE 0,SVJBFF ;IS INITIALIZED AT PIP1
MOVEM 0,.JBFF ;SET JOBFF TO BEGINNING OF BUFFER AREA
PUSHJ P,INICON ;INITIALIZE THE TTY
INBUF CON,1 ;ONE INBUFFER
OUTBUF CON,1 ;ONE OUTBUFFER
MOVE 0,DTJBFF ;SEE IF THIS IS FIRST TIME HERE
JUMPN 0,[MOVEM 0,.JBFF ;NO, SO SAVE POSSIBLE STORED COMMAND
JRST INICN3]
MOVE 0,.JBFF
HRRZM 0,DTJBFF ;JOBFF AFTER 2 TTY BUFFERS SET
INICN3: OUTPUT CON, ;INITIALIZE BUFFER POINTERS
JRST (T5)
;ROUTINE TO CLEAR LINE BUFFER
CLRBUF: SETZM LBUF ;SUBR. TO CLEAR LINE BUFFER
MOVE 0,[LBUF,,LBUF+1]
BLT 0,LBUFE
POPJ P,
SUBTTL TRADITIONAL COMMAND SCANNER
;COMMAND SCANNER ROUTINE
NAME: TRNN CALFLG,SSWTCH ;RETURN NULL IF _ OR END-OF-LINE SEEN
SKIPGE ESWTCH
JRST NM13 ;
TLZ FL,FNSEEN!PPSEEN ;[153,207] CLEAR SINGLE SPEC FLAGS
TRZ CALFLG,NSWTCH
SKIPE T1,XNAME ;IF COMMAND SCAN OVERSHOOT PICKED UP
;DEVICE NAME, USE IT NOW
JRST NM7
TRZ CALFLG,DEV
;LOOK FOR FILE NAME, EXT
NM1: SETZM FILEX
SETZM QMASK+1 ;CLEAR WILD CHAR. MASK
TLZ CALFLG,MFLG ;AND FLAG
;[160] THIS FLAG IS USED ONLY TO TELL FILTYP THAT WE'RE DOING
;[160] CONCATENATION, AND SHOULD NOT BE CLEARED FOR THE LAST FILE
;[160] IN THE STRING. CLEARING IT MAKES PIP CHANGE TO BINARY FOR
;[160] THE LAST FILE ONLY, WASTING SPACE.
NM2: SETZM FILNAM
SETZM QMASK
SKIPA T1,NM15
IDFIN: POP P,T1 ;RESTORE OLD POINTER
;LOOP TO PICK OFF FILENAME, EXT
NM3: PUSHJ P,GETCOM ;GO GET 7 BIT ASCII CHAR. FROM COMMAND STRING
NM3A: CAIN 0,"*" ;TO ALLOW FN.EX = *.*
JRST NMSTAR ;GO SET MASK
CAIL 0,"A" ;ALPHABETIC CHARACTER?
CAILE 0,"Z"
JRST NM4A ;NO
NM4: SUBI 0,40 ;CONVERT TO SIXBIT
TLNE T1,770000 ;6 CHARS. YET?
IDPB 0,T1 ;NO
JRST NM3 ;GET NEXT CHAR.
NM4A: CAIL 0,"0" ;NUMERIC?
CAILE 0,"9"
JRST NM5 ;NO
JRST NM4
NMBIN: TLC T1,500 ;MAKE BYTE SIZE 3
NMBIN1: PUSHJ P,GETBUF ;GET A CHARACTER
CAIL 0,"0" ;MUST BE OIT
CAILE 0,"7"
JRST NMBIN2 ;NOT NUMERIC
SUBI 0,"0" ;MAKE BINARY
TLNE T1,770000 ;STILL ROOM?
IDPB 0,T1 ;YES
JRST NMBIN1 ;GET NEXT
NMBIN2: TLNE T1,010000 ;ODD NUMBER OF 3 BIT BYTES?
IBP T1 ;YES, MAKE EVEN
TLC T1,500 ;BACK TO SIXBIT BYTES
PUSHJ P,GETCM1 ;[251] GO SEE IF A SPEC CHAR (/[<>
JRST NM3A ;PROCESS THIS CHAR.
;CHARACTER NOT *,0-9,A-Z
NM5: CAIG 0,CR ;CARRIAGE RETURN
CAIGE 0,LF ;LINE FEED
CAIN 0,ALTMOD ;ALTMODE
JRST NM5A ;YES
CAIN 0,CZ ;END-OF-FILE(CCL)?
NM5A: JRST NM5C ;YES, OR EOF
CAIN 0,COMMA ;COMMA
JRST NM6 ;YES
CAIN 0,PERIOD ;PERIOD
JRST NM10 ;YES
CAIN 0,COLON ;COLON
JRST NM9 ;YES
CAIN 0,";" ;IS THE REST A COMMENT?
JRST NM16 ;YES
IFN CCLSW,<CAIN 0,"@" ;INDIRECT COMMAND
JRST INDRCT ;YES
CAIN 0,"!" ;RUN COMMAND?
JRST RUNIT ;YES>
CAIN 0,"?" ;WILD CHAR.?
JRST WLDCH ;YES, SET UP MASK
CAIN 0,"^" ;TAPE ID ?
JRST ID ;YES
CAIN 0,"#" ;SPECIAL OCTAL FILE NAME ?
JRST NMBIN ;YES
CAIE 0,LA ;LEFT ARROW
CAIN 0,"=" ;OR EQUALS
SKIP 1 ;YES
JRST NM5B ;NO
TRNE CALFLG,DEV ;HAS A DEVICE BEEN SEEN?
TRO CALFLG,DVSWTH ;YES-NEEDED FOR /Z/,/D
TROA CALFLG,SSWTCH!ARWSW ;SET LEFT ARROW SWITCHES
NM5C: SOS ESWTCH ;END OF LINE OR FILE
JRST NM6A ;BUT NOT COMMA
NM6: TRNN CALFLG,ARWSW ;COMMA'S ILLEGAL BEFORE "_"
JRST ERR6A ;GIVE MESSAGE
TRO CALFLG,COMAFL ;MARK COMMA SEEN, MORE TO COME
NM6A:
IFN FTDSK,<SKIPE PP ;IF PPN ALREADY SET UP
SKIP 2 ;GO ON
SKIPE T1,PPP ;GET DEFAULT PPN
MOVEM T1,PP ;AS PPN>
SKIPN T1,FILEX ;COMMA ROUTINE - FIGURE OUT WHAT WE HAVE
JRST NM17 ;NO FILE NAME TEMPORARILY IN FILEX
EXCH T1,FILNAM ;PUT THE FILE NAME WHERE IT BELONGS
HLLZM T1,FILEX ;PUT THE EXTENSION WHERE IT BELONGS
MOVE T1,QMASK+1 ;GET FILE NAME MASK
EXCH T1,QMASK ;INTO RIGHT PLACE
HLR T1,T1 ;PUT MASK IN BOTH HALVES
MOVEM T1,QMASK+1 ;SINCE NEEDED IN EITHER HALF
MOVE T1,[QMASK,,OQMASK] ;PUT MASK ON OUTPUT SIDE
TRNE CALFLG,SSWTCH ;SEEN LEFT ARROW YET?
BLT T1,OQMASK+1 ;SINCE IT MAY DIFFER FROM INPUT MASK
POPJ P,
NM7: SETZM XNAME ;USE XNAME ONLY ONCE
CAIN T1,1 ;1 FLAGS A NULL OVERSHOOT
JRST NM13 ;RETURN NULL NAME
NM8: MOVEM T1,DEVICE ;NEW DEVICE
SETZM FILNAM ;FILE NAME OUT OF DATE BY NOW
IFN FTDSK,<SETZM PPP ;CLEAR PERM PPN
SETZM DEFPTH ;AND DEFAULT PATH>
TRO CALFLG,DEV
TRNE FL,ARWSW ;[152] IF LEFT ARROW SEEN,
TLO FL,SDEVSN ;[152] SAY WE'VE SEEN A SOURCE DEVICE
JRST NM1 ;LOOK FOR A FILE NAME AND EXTENSION
NM9: TRNN CALFLG,DEV ;COLON ROUTINE - IS DEVICE NAME IN YET?
JRST NM12 ;NO
SKIPN T1,FILNAM ;SCAN OVERSHOOT - NULL OVERSHOOT?
MOVEI T1,1 ;YES - FLAG NULL OVERSHOOT WITH A 1
MOVEM T1,XNAME ;XNAME = OVERSHOOT NAME
JRST NM14
ID: PUSH P,T1 ;SAVE BYTE POINTER
TLO FLAG,TID ;[125] SET FLAG TO CHANGE TAPEID
MOVE T1,[POINT 6,TAPEID]
ID1: PUSHJ P,GETBUF ;ALLOW ALL 6 BIT CHARS.
CAIN 0,"^" ;END OF TAPE ID?
JRST IDFIN ;YES
SUBI 0,40 ;MAKE SIXBIT
JUMPL 0,ERR6 ;MUST BE SIXBIT
TLNN T1,770000 ;TOO MANY CHAR.?
JRST ERR6 ;YES, GIVE ERROR
IDPB 0,T1 ;STORE CHAR.
JRST ID1 ;GET MORE
NM10: SKIPE FILEX ;FILENAME SEEN ALREADY?
JRST ERR6 ;YES, GIVE COMMAND ERROR
MOVE 0,FILNAM ;PERIOD ROUTINE - SAVE FILE NAME
MOVEM 0,FILEX ;TEMPORARILY IN FILEX
SKIPN 0 ;[153] SEE IF ANY FILE NAME THERE
TLO FL,FNSEEN ;[153] NO, SET FNSEEN FOR NM17 TO CHECK
MOVE 0,QMASK ;GET WILD CHAR. MASK
MOVEM 0,QMASK+1 ;SAVE IT ALSO
JRST NM2 ;LOOK FOR EXTENSION
NM11: SKIPN FILNAM ;WAS A FILE NAME SPECIFIED?
TRNE CALFLG,DEV ;WAS ANYTHING SPECIFIED?
POPJ P, ;YES
NM12: SKIPE T1,FILNAM ;NULL NAME SPECIFIED?
JRST NM8 ;NO - SO REMEMBER AND LOOK FOR FILE NAME
NM13: TRO CALFLG,NSWTCH ;RETURN A NULL NAME
SETZM FILEX
NM14: SETZM FILNAM
POPJ P,
NM15: POINT 6,FILNAM
NM5B: CAIE 0,TAB ;IGNORE TAB
CAIN 0,SPACE ;SPACES IGNORED
JRST NM3 ;IGNORE NOT LEGAL SIXBIT
PUSH P,0 ;SAVE CHARACTER
ERRPNX </?Illegal character />
POP P,0 ;RECOVER CHAR.
CAIL 0,SPACE ;INVISIBLE CHAR.?
JRST .+4 ;NO
MOVEI CHR,"^" ;USUAL UP ARROW MARKER
PUSHJ P,PUTCON ;OUTPUT TO TTY
TRC 0,100 ;MAKE CHAR. VISIBLE
MOVE CHR,0 ;NOW FOR THE CHAR.
PUSHJ P,PUTCON
ERRPN2 </ in command!/>
NM16: PUSHJ P,GETBUF ;GET NEXT ASCII CHAR.
CAILE 0,LF
CAIG 0,CR ;IF LF,FF,VT,OR CR
JRST NM5A ;RETURN
CAIE 0,ALTMOD ;SAME IF ALTMOD
CAIN 0,CZ ;OR ^Z
JRST NM5A
JRST NM16 ;GET NEXT CHARACTER
IFE FTDSK,<SYN NM11,NM17>
IFN FTDSK,<
NM17: MOVE T1,[QMASK,,OQMASK] ;PUT MASK ON OUTPUT SIDE
TRNE CALFLG,SSWTCH ;SEEN LEFT ARROW YET?
BLT T1,OQMASK+1 ;SINCE IT MAY DIFFER FROM INPUT MASK
TLZN FL,FNSEEN ;[153] SEE IF WE SAW A DOT
JRST NM11 ;[153] NO, WE MAY HAVE LEGIT FILE NAME
MOVS T1,FILNAM ;GET EXT
CAIN T1,(SIXBIT 'UFD') ;CHECK FOR .UFD
SKIPN PP ;AND [PPN]
JRST ERR12 ;[153] ONLY LEGAL EXTENSION ONLY IS
;[153] [P,PN].UFD, NOT .FOO
MOVSM T1,FILEX ;EXT IN CORRECT PLACE
SKIPN T1,PP ;[211] GET PPN TYPED
MOVE T1,JOBPTH+2 ;[211] IF NONE, USE DEFAULT PATH
MOVEM T1,FILNAM ;INTO FILNAM
MOVE T1,MFDPPN ;[163] GET PPN OF MFD
MOVEM T1,PP ;FOR DSK LOOKUP
POPJ P,>
IFN CCLSW,<
INDRCT: SKIPN T3,DEVICE ;[165] GET TYPED DEVICE
MOVSI T3,'DSK' ;[165] NONE, USE DEFAULT DSK:
MOVEM T3,CCLINI+1 ;SET IT UP FOR OPEN
SKIPN T3,PP ;SOMEONE ELSES AREA
SETZ T3, ;NO, USE OWN
MOVEM T3,CFILE+3 ;STORE PPN
MOVE T3,FILEX ;GET FILE NAME OR EXTENSION
MOVEM T3,CFILE ;ASSUME FILE NAME
MOVE T3,FILNAM ;GET FILE NAME
SKIPN CFILE ;HAVE WE A FILE NAME
EXCH T3,CFILE ;PUT IN RIGHT PLACE
JRST P12 ;STORE EXT
RUNIT: TRNE CALFLG,DEV ;USE SYS IF NO DEVICE SEEN
SKIPN T3,DEVICE ;GET DEVICE IF SPECIFIED
MOVSI T3,'SYS'
MOVEM T3,RUNDEV
MOVE T3,FILNAM ;GET FILE NAME
MOVEM T3,RUNFIL ;SAVE IT
PUSHJ P,GETEND ;DELETE COMMAND FILE
SKIPN T3,PP ;SOMEONE ELSES AREA?
SETZ T3, ;NO, SO USE OWN
MOVEM T3,RUNPP
MOVEI 16,RUNDEV ;XWD 0,RUNDEV
SKIPE COMFLG ;CCL IN PROGRESS?
HRLI 16,1 ;YES START AT C(JOBSA)+1
RUN 16,
HALT ;SHOULD NOT RETURN
>
;HERE IF A "?" SEEN IN FILE NAME OR EXTENSION
WLDCH: TLO CALFLG,MFLG ;SET FLAG
TLNN T1,770000 ;6 CHAR. YET?
JRST NM3 ;YES, NO MORE
IDPB 0,T1 ;DEPOSIT IN NAME
HRRI T1,QMASK ;MASK BYTE POINTER
DPB 0,T1 ;PUT IN MASK ALSO
HRRI T1,FILNAM ;BACK AS IT WAS
JRST NM3 ;RETURN FOR MORE
;HERE IF "*" SEEN IN FILE NAME OR EXTENSION
NMSTAR: SKIPE (T1) ;NAME BETTER BE ZERO
JRST NMSTR1 ;[225] NO, ADD ?????
SETOM QMASK ;MASK ALL CHARACTERS
SETOM (T1) ;AND NAME OF ??????
TLZ T1,770000 ;MAKE SURE NOTHING ELSE GETS HERE
TLO FL,MFLG ;SET FLAG
JRST NM3 ;BACK FOR MORE
NMSTR1: MOVEI 0,"?" ;[225] SET WILD CHARACTER
NMSTR2: TLNN T1,770000 ;[225] SEE IF ANY MORE CHARS TO FILL
JRST NM3 ;[225] NO, DONE
TLO FL,MFLG ;[225] YES, SET WILD BIT, (ONLY IF SOME GENERATED)
IDPB 0,T1 ;[225] DEPOSIT ? IN FILENAME
HRRI T1,QMASK ;[225] CHANGE TO MASK WORD
DPB 0,T1 ;[225] AND DEPOSIT ? IN MASK WORD
HRRI T1,FILNAM ;[225] RESTORE TO FILE NAME
JRST NMSTR2 ;[225] AND GO SEE IF MORE TO DO
SUBTTL COPY BY CHARACTER OUTPUT ROUTINES
;ROUTINE TO OUTPUT ONE LINE FROM LBUF
OUTLBF: TRNE FLAG,LINE
JRST OUTLBA ;OUTPUT LINE-BY-LINE
OUTCH1: MOVE T2,OPTRA ;OUTPUT CHARACTER-BY-CHARACTER
OUTLB1: CAMN T2,OPTR ;ARE ALL CHARACTERS OUT?
POPJ P, ;YES
ILDB CHR,T2 ;NO
PUSHJ P,PUT ;GO OUTPUT CHARACTER
JRST OUTLB1
OUTLBA: TLNE FLAG,CHKFLG;PAREN COUNTING?
JRST OUTCHK ;YES, SO DO IT
TRNE AUXFLG,TTYOUT+LPTOUT
JRST OUTCH1 ;IF OUTPUT TO TTY OR LPT DO CHR BY CHR
MOVEI T1,4 ;CLEAR UNUSED PORTION OF LAST WORD USED IN LBUF
MOVEI T2,0
MOVE T3,OPTR
IDPB T2,T3
SOJG T1,.-1
MOVEI T2,5
HRRZ T1,OPTR ;COMPUTE NUMBER OF WORDS FILLED
SUBI T1,LBUF-1
JUMPE T1,OUTLB3 ;DO NOTHING IF BUFFER EMPTY
IMULM T1,T2 ;COMPUTE CHARACTER COUNT=5 TIMES WORD CT
;THIS IS WHERE OLD FORTRAN MODE WAS TESTED.
CAMG T2,OBF+2 ;WILL LINE FIT IN THE OUTBUFFER?
JRST OUTLB2 ;YES
PUSHJ P,OUTP ;NO, SO DUMP BUFFER AND CHECK ERROR BITS
MOVEI T6 ,1
TDNE T6,LBUF ;SEQUENCED?
TRNN AUXFLG,DTAOUT ;YES, ON DTA?
SKIP 1 ;NO
ADDI T2,40*5 ;LEAVE EDITING ROOM
OUTLB2: MOVNS T2
ADDM T2,OBF+2 ;UPDATE OUTBUFFER CHARACTER COUNT
HRLI T2,LBUF
HRR T2,OBF+1
ADDI T2,1
ADDB T1,OBF+1 ;UPDATE OUTBUFFER BYTE POINTER
BLT T2,(T1) ;MOVE DATA TO OUTBUFFER
OUTLB3: POPJ P,
;ROUTINE TO PUT ONE CHAR INTO OUT BUFFER
TABOUT: MOVEI CHR,TAB ;OUTPUT A TAB
PUT: SOSG OBF+2 ;SUBR. TO OUTPUT ONE CHARACTER IN AC CHR
PUSHJ P,OUTP ;IF BUFFER FULL, DUMP AND CHECK ERR BITS
IDPB CHR,OBF+1 ;PUT CHARACTER IN BUFFER
POPJ P,
LISTIT: TLOA T1,(POINT 7) ;FORM BYTE POINTER
PUSHJ P,PUT ;OUTPUT CHAR
ILDB CHR,T1 ;GET CHAR.
JUMPN CHR,.-2 ;BACK FOR MORE
POPJ P, ;DONE
;ROUTINE TO DUMP OUT BUFFER WHEN FULL
OUTP: OUT OUT, ;SUBR. TO DUMP OUTBUFFER AND CHECK ERR BITS
JRST CPOPJZ ;NO ERRERS,BUT CLEAR IOS JUST IN CASE
OUTP1: GETSTS OUT,IOS ;HERE FOR BIT CHECKING ONLY
PUSHJ P,OUTP4
SETSTS OUT,(IOS);ERRORS WERE DETECTED
POPJ P, ;NO ERRORS
OUTP4: TRNN AUXFLG,MTAOUT
JRST .+3
OUTP3: TRNE IOS,EOTBIT ;EOT?
JRST .+3 ;YES
TRNN IOS,740000 ;ANY ERROR BITS ON?
JRST CPOPJ1 ;NO
PUSHJ P,COMERR ;YES
JSP T5,INICN2 ;INIT TTY
PUSHJ P,QUEST
ERRPN2 </Output device />
PUSHJ P,P6BIT
ODEV
SKIPN DTON ;ONLY IF THERE IS A FILE NAME
JRST .+4 ;DON'T PRINT IF NOT
ERRPN2 </: file />
MOVEI T3,DTON ;OUTPUT FILE NAME LOC
PUSHJ P,FN.EX ;PRINT FILE NAME EXT
MOVE T2,AUXFLG
ANDI T2,MTAOUT+DSKOUT+DTAOUT
;AND FALL INTO IOERR
SUBTTL COPYING I/O ERRORS
IOERR: MOVEI T1,TXTC ;PHYSICAL END OF TAPE
TRNE IOS,EOTBIT
JRST PTEXT2 ;YES
MOVEI T1,TXTD2 ;7-9 PUNCH MISSING
TRNN T2,CDRIN
IFN FTDSK,<
MOVEI T1,TXTD3
TRNN T2,DSKIN>
MOVEI T1,TXTD ;WRITE LOCK ERROR
TRNN T2,DSKIN+DSKOUT+DTAIN+DTAOUT+MTAIN+MTAOUT
MOVEI T1,TXTD1
TRNE IOS,WRTLOK
JRST PTEXT2
MOVEI T1,TXTA ;DEVICE ERROR
TRNE IOS,200000
JRST PTEXT2
MOVEI T1,TXTB ;CHECKSUM/PARITY ERROR
TRNE IOS,100000
JRST PTEXT2
IFN FTDSK,<
HRRZ T1,TABLE+14
TRNN T2,DSKOUT ;QUOTA EXCEDED>
MOVEI T1,TXTC1 ;BLOCK TOO LARGE
JRST PTEXT2
;DEVICE ERROR COMMENTS
TXTD: ASCIZ /write (lock) error/
JRST IOERRN ;NO RECOVERY
TXTD1: ASCIZ /binary data incomplete/
JRST IOERRG
TXTD2: ASCIZ /7-9 punch missing/
JRST IOERRG
TXTA: ASCIZ /device error/
JRST IOERRG
TXTB: ASCIZ /checksum or parity error/
JRST IOERRG
TXTC: ASCIZ /physical eot/
JRST IOERRG
TXTC1: ASCIZ /block or block number too large/
;FALLS THROUGH TO IOERRN
IOERRN: PUSHJ P,TCRLF ;OUTPUT A CR-LF ON TTY
RELEAS TAPE, ;NO RECOVERY ERRORS EXIT HERE
RELEAS DIR,
RELEAS OUT,
RELEAS IN,
TLZ FLAG,TID;[125] CLEAR REQUEST TO WRITE TAPE ID
JRST PIP2 ;GET NEXT COMMAND
IFN FTDSK,<
TXTD3: ASCIZ /monitor detected software error/>
;TEST IF /G FLAG(IGNORE ERRORS) SET
IOERRG: TLNN FLAG,GFLG ;PRINTED CURRENT MESSAGE
JRST IOERRN ;NO RECOVERY
ERRPN2</
/> ;PRINT CR, LF DON'T MOVE>
RELEAS CON,
TRNE AUXFLG,TTYOUT ;TTY OUTPUT DEVICE?
PUSHJ P,OMODE ;YES, INIT OUTPUT DEVICE
TRNE AUXFLG,TTYIN ;REINIT TTYIN,TTYOUT
PUSHJ P,ININIT
TRZ IOS,740000 ;CLEAR FILE STATUS, I/O ERRORS
TRNE T2,MTAIN+MTAOUT
TRZ IOS,EOTBIT ;CLEAR PHYSICAL EOT I/O ERROR
MOVS 0,[XWD 1,SAVAC]
BLT 0,3
MOVE T5,SAVAC+3
MOVE T6,SAVAC+4
POPJ P,
COMERR: MOVE 0,[XWD 1,SAVAC] ;SAVE ACS T1,T2,T3,T5,T6
BLT 0,SAVAC+2
MOVEM T5,SAVAC+3
MOVEM T6,SAVAC+4
TRNE AUXFLG,TTYOUT ;RELEASE ANY TTYIO
RELEAS OUT,
TRNE AUXFLG,TTYIN
RELEAS IN,
POPJ P,
;PRINT FILE NAME AND EXTENSION FROM (T3), 1(T3).
FN.EX: MOVE T1,(T3) ;T1=FILENAME
HLRZ T6,1(T3) ;T6=FILE EXT
MOVEM T1,DERR2 ;STORE FILE NAME
JUMPE T6,DERR2A ;FILE EXT=0?
JUMPL T1,DERR2B ;MUST BE SIXBIT, SIGN BIT ON
CAIE T6,'UFD'
JRST DERR2B ;NO
SETZB T1,DERR2 ;CLEAR FILE NAME IF 'UFD'
HLRZ DOUT,(T3) ;YES, GET PROJ. NO.
MOVEI T2,PUTCON ;PRINT PROJ-PROG. NO.
MOVEI CHR,"[" ;BETWEEN SQUARE BRACKETS
PUSHJ P,PUTCON
PUSHJ P,OUTOCT ;CONVERT TO ASCII
MOVEI CHR,COMMA
PUSHJ P,PUTCON
HRRZ DOUT,(T3) ;GET PROG. NO.
PUSHJ P,OUTOCT ;CONVERT TO ASCII
MOVEI CHR,"]"
PUSHJ P,PUTCON
DERR2B: TLO T6,"."-40 ;PUT SIXBIT PERIOD
DERR2A: MOVEM T6,DERR2+1 ;INTO EXTENSION
PUSHJ P,P6BIT
DERR2
PUSHJ P,P6BIT
DERR2+1
MOVEI CHR," "
JRST PUTCON
SUBTTL COMMAND STRING CHARACTER GETTER WITHOUT /[]<>
;THIS ROUTINE GETS A 7 BIT ASCII CHARACTER FROM THE COMMAND STRING
;AND RETURNS IT TO THE COMMAND SCANNER ROUTINE (NAME) IN AC0
GETCOM: PUSHJ P,GETBUF
GETCM1: ;[252] ENTRY AFTER # PROCESSED
CAIN 0,"/" ;SINGLE CHARACTER SWITCH
JRST GETT6
CAIN 0,"(" ;LOOK FOR (MULTI-CHAR.) SWITCH
JRST GETT3
CAIN 0,"<" ;GO LOOK FOR PROTECTION
JRST GETT9
CAIE 0,"["
POPJ P,
GETT10: ;[211]
IFN FTDSK,< ;[211]
SETZM PTHADD ;[211]
MOVE T7,[XWD PTHADD,PTHADD+1] ;[211] CLEAR PATH
BLT T7,PTHADD+PTHLEN+3 ;[211]
>;[211] END IFN FTDSK
PUSHJ P,GETNUM ;[211] GO GET PPN
IFN FTDSK,< ;[211]
CAIN 0,"-" ;[166] SEE IF [-] PPN SPEC
JRST GETMYP ;[166] YES, EXPLICITLY USE OURS
>;[211] END IFN FTDSK
CAILE T7,-1 ;[211] GREATER THAN HALF WORD?
JRST ERR2A ;[211] YES, ERROR
IFN FTDSK,< ;[211]
SKIPN T7 ;[166] SEE IF PROJECT SPECIFIED
MOVS T7,JOBPPN ;[220] NO, USE JOB'S UFD
>;[211] END IFN FTDSK
MOVSM T7,PP ;[211] SAVE PPN, BOTH HALVES ([] WORKS)
CAIE 0,"," ;SEPARATOR?
JRST GETT11 ;OR TERMINATOR (NON-NUMERIC)
PUSHJ P,GETNUM ;GET RIGHT HALF
IFN FTDSK,< ;[240]
SKIPN T7 ;[233] SEE IF ANY PROGRAMMER NUMBER
HRRZ T7,JOBPPN ;[233] NO, USE OURS
>;[240] END IFN FTDSK
CAILE T7,-1 ;GREATER THAN HALF WORD
JRST ERR2A ;YES, ERROR
HRRM T7,PP ;STORE RIGHT HALF
GETT12: ;[211]
IFN FTDSK,< ;[211]
SKIPE T7,PP ;[211] GET WHATEVER WAS TYPED
MOVEM T7,PTHPPN ;[211] AND PUT INTO PATH
CAIE 0,"," ;[211] SEE IF SFD SPECIFIED
JRST GETT11 ;NO
PUSHJ P,GETPTH ;GET FULL PATH
>;[211] END IFN FTDSK
GETT11: ;[211]
IFN FTDSK,< ;[211]
IFN SCANSW,< ;[223]
CAIN 0,"/" ;[211] SEE IF SCAN SWITCH SPECIFIED
PUSHJ P,GTPTH4 ;[211] YES, GO DECODE IT
>;[223] END IFN SCANSW
>;[211] END IFN FTDSK
CAIG 0,CR ;[211] ALLOW END OF LINE
CAIGE 0,LF ;TO TERMINATE PPN
JRST .+3 ;NOT CR/LF
AOS COMCNT ;ALLOW FOR EXTRA CHAR READ
JRST .+3 ;AND SKIP TEST
CAIE 0,"]" ;FORCE CORRECT TERMINATOR
JRST ERR2
TLO FL,PPSEEN ;[207] SET SPECIFIC PPN FLAG
IFN FTDSK,<
SKIPN FILNAM ;[211] IF FILE SPEC SEEN ALREADY
SKIPE FILEX ;[211] IF PPN IS IN MIDDLE, FORCE NO DEFAULT
;[211] I.E. FILE.[PPN]EXT
JRST GETCOM ;[161] THEN NOT DEFAULT PPN
MOVE T7,[XWD PTHADD,DEFPTH] ;[211] COPY PATH TO DEFAULT
HRRZM T7,PPP ;[211] AND POINT PERMANENT TO IT
BLT T7,DEFPTH+PTHLEN+3 ;[211]
TLO FL,PPPSEN ;[207] SET PERMANENT PPN FLAG
MOVE T7,PP ;[211] IF NO PATHING
SKIPN JOBPTH ;[211] ON THIS SYSTEM
MOVEM T7,PPP ;[211] SAVE ACTUAL PPN
>;[211] END IFN FTDSK
JRST GETCOM ;CONTINUE SCAN
IFN FTDSK,< ;[211]
GETMYP: JUMPN T7,ERR2A ;[166] IF ANY NUMBERS WITH [-], ERROR
MOVE T7,[XWD JOBPTH,PTHADD] ;[207] COPY TO PATH AREA
BLT T7,PTHADD+PTHLEN+3 ;[207] COPY IT
GETMY1: PUSHJ P,GETBUF ;[166] SKIP - AND ANY BLANKS
CAIN 0," " ;[166]
JRST GETMY1 ;[166]
MOVE T7,PTHPPN ;[211] GET THE PPN
MOVEM T7,PP ;[211] AND SAVE IT FOR REFERENCE
JRST GETT11 ;[166] FORCE ] OR CRLF
>;[211] END IFN FTDSK
GETT9: PUSHJ P,GETNUM
CAIN 0,">" ;TERMINATE ON RIGHT BRKT ONLY
CAILE T7,777 ;PR. IN RANGE?
JRST ERR2A
ROT T7,-11
HLLOM T7,PR ;RHS=1'S MEANS <> SEEN (PR MAY BE 0)
JRST GETCOM
GETNUM: MOVEI T7,0 ;TO PICK UP P-P NUMBER
GETN1: PUSHJ P,GETBUF ;AND PROTECTION
CAIN 0," " ;IGNORE SPACES
JRST GETN1
CAIL 0,"0"
CAILE 0,"7"
POPJ P, ;GOT A NON-NUMERIC
MOVE T5,0
LSH T7,3
ADDI T7,-60(T5) ;PROCESS TO BINARY
JRST GETN1
GETT3: PUSHJ P,GETT5 ;PROCESS SWITCH CHARACTER
CAIN 0,")" ;CLOSING PAREN?
JRST GETCOM ;YES
CAIN 0,"M" ;MTA FLAG?
TRO FLAG, MTFLG ;SET MTA, LOOK FOR MULTI CHAR. SWITCH
CAIE 0,"#" ;MTA#
JRST GETT3 ;NO
TRNN FLAG,MTFLG ;ONLY LOOK AFTER # IF MTFLG IS ON.
JRST ERR6A ;I.E. IF MT SWITCH IS IN PROGRESS.
PUSHJ P,GETNUD ;GET A NUMBER
SKIPN T7 ;SKIP IF NOT EXPLICIT ZERO
SETO T7, ;MAKE IT DIFFERENT FROM DEFAULT ZERO
CAIE 0,"D" ;TERMINATED BY D?
CAIN 0,"A" ;TERMINATED BY A?
JRST GETT3A ;YES, MARK AB UPPER
CAIE 0,"P" ;ONLY A,D,P AND B CAN BE
CAIN 0,"B" ;PRECEDED BY #.
SKIP 1
JRST ERR6A
HRRM T7,AB ;NO. FILES/RECS TO ADVANCE
;GOES IN AB (RH)
GETT3B: PUSHJ P,GETT5A
JRST GETT3
GETT3A: HRLM T7,AB ;NO. FILES/RECS TO BACK SPACE
JRST GETT3B ;GOES IN AB (LH)
GETT6: PUSHJ P,GETT5 ;PROCESS ONE SWITCH CHAR
CAIE 0,"M"
CAIN 0,")" ;THESE ARE ILLEGAL 1-SWITCH CHARS.
JRST ERR6A
JRST GETCOM
GETNUD: MOVEI T7,0 ;GET A DECIMAL NUMBER
GETN2: PUSHJ P,GETBUF ;GET CHAR FROM COMMAND STRING
CAIN 0,SPACE ;SPACE?
JRST GETN2 ;YES, IGNORE
CAIL 0,"0" ;NUMBER?
CAILE 0,"9"
POPJ P, ;NO
IMULI T7,^D10 ;T7*10
ANDI 0,17 ;ADD ON LAST DIGIT
ADD T7,0 ;+ LOW 4 BITS
JRST GETN2
;GET NEXT COMMAND STRING CHAR(SWITCH),CHECK WITH TABLE,SET FLAGS
GETT5: PUSHJ P,GETBUF ;GET CHAR FROM COMMAND STRING
GETT5A: MOVE T2,[POINT 7,DISPTB,6] ;SET DISPTB NEXT SEARCH
MOVEI T6,MTAREQ ;SET MTAREQ NEXT SEARCH
TRNN FLAG,MTFLG ;SET UP TABLE TO SEARCH AND FLAG TO SET.
HRRI T2,DISPTA ;PUT IN BYTE POINTER, NOT MTA REQUEST
;SET TO LOOK AT NON-MTA LETTERS FIRST
TRNN FLAG,MTFLG ;IF MTFLG SET, START AT DISPTB AND STORE RESULT IN
MOVEI T6,AUXFLG ;MTAREQ, ELSE START AT DISPTA AND STORE RESULT IN
;AUXFLG OR FLAG
;GET FIRST CHAR DISPTA OR DISPTB, LOOK FOR MATCH, SET SWITCH FLAGS.
GETT7: LDB T3,T2 ;COMPARE WITH LEFT 7 BITS OF
JUMPN T3,GETT8 ;TABLE ENTRIES
TRZ FLAG, MTFLG ;SEARCHED TABLE 1 (DISPTB) DROP MTA FLAG
MOVEI T6,AUXFLG ;SET AUXFLG NEXT TABLE SEARCH
TLNE AUXFLG,NOMORE ;AFTER FIRST INPUT DEVICE ONLY ACCEPT MTA FLAGS
POPJ P,
GETT8: CAIN T3,1 ;END OF DISPTA 1ST HALF?
MOVEI T6,FLAG ;YES, SEARCH DISPTA 2ND HALF FROM NOW ON
CAIN T3,2 ;END OF DISPTA 2ND HALF?
JRST ERR6A ;SEARCHED TABLE 3, ERROR EXIT
CAME T3,0 ;MATCHING CHARACTER?
AOJA T2,GETT7 ;NO, GET NEXT SWITCH IN TABLE.
MOVE T5,(T2) ;YES, SET FLAG OR AUXFLG OR MTAREQ
TLZ T5,774000 ;[255] CLEAR THE SWITCH CHARACTER
ORM T5,(T6) ;FLAG OR AUXFLG
TRNE FLAG,MTFLG
ORM T5,AUX ;MTA REQUESTS SAVED IN AUX
IFE RIMSW,<
TLNE FLAG,RIMFLG
JRST RIMTB ;NO RIM IF RIMSW=0
> ;PRINT ERROR MESSAGE
POPJ P, ;EXIT ON MATCHING CHAR
;ROUTINE TO GET ONE TTY OR CCL COMMAND STRING CHAR INTO AC 0
GETTA:
IFN CCLSW,<
SKIPE COMFLG ;STORED COMMANDS?
JRST GETSC ;YES>
SOSLE TFI+2 ;SUBR TO GET ONE TTY CHAR IN AC 0
JRST GETT2 ;BUFFER NOT EMPTY
MOVE 0,TFI ;BUFFER EMPTY, SAVE
MOVE T5,TFO ;CURRENT BUFFER LOCS
PUSHJ P,INICON ;BUFFER EMPTY SO RE-ATTACH TTY
HRROM 0,TFI ;RESTORE OLD BUFFER LOCS
HRROM T5,TFO ;USE PREVIOUSLY ASSIGNED I/O BUF. FOR TTY
INPUT CON, ;GET THE NEXT LINE
MOVE T5,TFI+2 ;SAVE CHAR COUNT
RELEAS CON, ;LET GO OF TTY FOR USE AS IN-OUT DEVICE
MOVEM T5,TFI+2 ;RESTORE CHAR COUNT LOST DURING RELEASE
GETT2: ILDB 0,TFI+1 ;FETCH CHAR
GETT4: CAIE 0,ALT175 ;OLD ALTMODE?
CAIN 0,ALT176
MOVEI 0,ALTMOD ;YES,MAKE NEW ALTMOD
JUMPE 0,GETTA ;IGNORE NULL CHARS
CAIL 0,140 ;LOWER CASE?
TRZ 0,40 ;YES MAKE UPPER CASE?
CAIE 0,XON ;IGNORE XON,XOFF ONLY FOR
CAIN 0,XOFF ;TTY SERVICE TO SIGNAL TTY
JRST GETTA ;PTR READ IN MODE
POPJ P,
;ROUTINE TO GET ONE TTY CHAR FROM COMBUF INTO AC0
GETBUF: IFN CCLSW,<
SKIPE COMFLG ;CCL COMMAND?
JRST GETSC ;YES, GET CHARS FROM DSK, CORE>
SOSGE COMCNT ;ANY CHARS LEFT?
JRST ERR6B ;NO, COMMAND ERROR
ILDB 0,COMPTR ;PICK UP CHAR FROM COMBUF
POPJ P,
;ROUTINE TO INITIALIZE THE TTY, ASCII LINE MODE
INICON: INIT CON,1 ;SUBR TO INITIALIZE THE TTY
SIXBIT /TTY/
XWD TFO,TFI ;TTY OUT/IN BUFFER HEADERS
EXIT ;IF TTY NOT AVAILABLE,FATAL.JOB DET?
POPJ P,
;GET 7 BIT ASCII CHARACTER - INPUT FROM CCL COMMAND FILE
IFN CCLSW,<GETSC:
IFN TEMP,<SKIPN TMPFLG ;IS TMPCOR UUO IN ACTION?
JRST GETTM1 ;NO CONTINUE AS USUAL
GETTM2: ILDB 0,TMPPNT ;PICK UP NEXT CHARACTER
HRRZ DOUT1,TMPPNT ;GET BYTE POINTER POISITION
CAML DOUT1,TMPEND ;HAS THE COMMAND FINISHED YET
JRST GETEND ;YES, EXIT
JRST GETT4 ;CHECK FOR ALTMODE,NULL,LOWER CASE
GETTM1: >
SOSLE CFI+2 ;ANY REMAINING?
JRST GETSC0 ;YES
IN COM,
JRST GETSC0 ;NO ERRORS
STATZ COM,EOFBIT ;END-OF-FILE
JRST GETEND ;YES
ERRPNT </Read error-CCL command file!/>
GETSC0: ILDB 0,CFI+1 ;GET A CHARACTER
MOVE DOUT1,@CFI+1 ;GET PRESENT WORD
TRNN DOUT1,1 ;IS IT A SEQUENCE NUMBER?
JRST GETT4 ;NO - CONTINUE
AOS CFI+1 ;YES - ADD 1 TO BYTE POINTER
MOVNI DOUT1,5 ;I.E. IGNORE SEQ. NO.
ADDM DOUT1,CFI+2 ;SUBTRACT 5 FROM COUNT FOR SEQ. NO.
JRST GETSC ;CONTINUE
GETEND:
IFN TEMP,<SKIPE TMPFLG ;TMPCOR
JRST GETEN3 ;YES>
SKIPN COMFLG ;CCL END OF CS?
JRST GETEN2 ;NO
GETEN1: CLOSE COM, ;NO, DSK FILE CCL
SETZ 0, ;DIRECTORY ENTRY FOR RENAME
HLRZ 1,CFILE+1 ;GET EXT
CAIN 1,'TMP' ;IF EXT IS TMP
RENAME COM,0 ;WIPE OUT COMMAND FILE
JFCL
RELEASE COM,0 >
GETEN2: SETOM COMEOF ;INDICATE END OF FILE
MOVEI 0,CZ ;NEEDED TO TERM CCL CS SCAN
POPJ P,
IFN TEMP,<
GETEN3: MOVE 1,[XWD 2,TMPFIL]
TMPCOR 1, ;READ AND DELETE
JFCL ;NOT FOUND
JRST GETEN2 ;CONTINUE>
;TABLE OF RECOGNIZED COMMAND LETTERS AND CORRESPONDING FLAG BITS
DEFINE DISP (A,B)
< XWD <"A">*4000,B>
;MAGTAPE SWITCHES AND FLAG BITS. TABLE 1 (MTAREQ)
DISPTB: DISP A,MTAFLG
DISP B,MTBFLG
DISP T,MTTFLG
DISP W,MTWFLG
DISP 8,MT8FLG
DISP 5,MT5FLG
DISP 2,MT2FLG
DISP E,MTEFLG
DISP U,MTUFLG
DISP F,MTFFLG
DISP D,MTDFLG
DISP P,MTPFLG
DISP #,0
OCT 000000000000
;1ST BYTE 0=END OF DISPTB
;------------------------
;COMMAND STRING LETTERS AND FLAG BITS. TABLE 2 (AUXFLG)
DISPTA: XWD <"Q">*4000+QFLG,0
XWD <"E">*4000+CDRFLG,0
DISP F,FFLG
OCT 004000000000
;1ST BYTE 1=END OF DISPTA 1ST HALF
;------------------------
;COMMAND STRING LETTERS AND FLAG BITS. TABLE 3 (FLAG)
DISP A,LINE
DISP B,BMOD
DISP C,TBMOD
DISP D,DFLG
DISP L,LFLG
DISP M,0
DISP ),0
DISP N,NSMOD
DISP O,SQMOD+NSMOD+STS+OSFLG
XWD <"P">*4000+PFLG+PCONV,0
DISP R,RFLG
DISP S,SQMOD+NSMOD+STS
DISP T,SPMOD
XWD <"V">*4000+CHKFLG,LINE
XWD <"W">*4000+WFLG,0
DISP X,XFLG
DISP Z,ZFLG
XWD <"U">*4000+OFLG,0
XWD <"Y">*4000+IBFLG+RIMFLG,0
XWD <"J">*4000+JFLG,0
XWD <"I">*4000+IFLG,0
XWD <"H">*4000+IBFLG,0
XWD <"G">*4000+GFLG,0
OCT 010000000000
;FIRST BYTE 2=END OF DISPTA 2ND HALF
SUBTTL COPYING INPUT A CHARACTER CHECKING LSN
;SUBR TO GET NEXT CHAR INTO AC CHR
;NO SKIP RETURN IS END OF FILE, SINGLE SKIP IS NORMAL RETURN
GET: TLNN FLAG,NEWFIL ;NEW FILE?
TLZN FLAG,PCONV+NEWFIL ;NO,CONVERT THIS CHAR?
JRST GETPC1 ;YES
LDB CHR,IBF+1 ;GET CHAR
CAIN CHR," " ;SPACE?
JRST GETPC2 ;YES, CONVERT TO LINE FEED
CAIG CHR,"3" ;IS THE CHAR A PROPER FORMAT CONTROL CHAR?
CAIGE CHR,"*"
JRST GETPC3 ;NO, SO OUTPUT LINE FEED FOLLOWED BY BAD CHAR
CAIG CHR,"." ;USE LEFT HALF OF TABLE?
SKIPA CHR,PCHTAB-<"*">(CHR)
MOVS CHR,PCHTAB-<"/">(CHR)
GETPC4: DPB CHR,IBF+1 ;CLOBBER OLD CHAR, USUALLY BECOMES NULL
LSH CHR,-7 ;BUT OTHERWISE BECOMES ANOTHER FORMAT CHAR
ANDI CHR,377 ;EXTRACT THE CHAR TO BE OUTPUT
TRZE CHR,200 ;=1 FOR GENERATING MULTIPLE LINE FEEDS
TLO FLAG,PCONV ;CONTINUE TO CONVERT
JUMPN CHR,CPOPJ1;OUTPUT THE GENERATED CHAR UNLESS NULL
POP P,(P) ;IGNORE NULL CHARS
JRST PSCAN4 ;DUMP THE LINE BUFFER
GETPC1: TRNN FLAG,SUS ;SUPPLYING SEQ. NUM. NOW?
JRST GET2 ;NO
ILDB CHR,PTRPT ;YES, SO GET CHAR OF SEQ NUM
JUMPN CHR,CPOPJ1;0 MARKS LAST CHAR
LDB CHR,IBF+1 ;GET FIRST CHAR OF THIS LINE
CAIG CHR,15 ;PREPARE TO OUTPUT A CR,LF
CAIGE CHR,12 ;IS FIRST CHAR OF LINE AN END OF LINE CHAR?
JRST [TRNE CALFLG,SQNSN ;REPLACING OLD SQ. NUM.?
TRZA FLAG,ESQ ;YES, SO DON'T REPEAT CHAR.
MOVEI CHR,TAB ;NO, SO OUTPUT A TAB
JRST .+2] ;SKIP RETURN
MOVEI CHR,TAB ;[170] ADD A TAB TO A NULL LINE
TRZ FLAG,SUS ;TURN OFF SUS SUPPLY
JRST GETA5
GET5: AOS IBF+1 ;HERE IF A SEQ NUM FOUND IN INBUFFER
TRO CALFLG,SQNSN ;SIGNAL SQ. NUM. SEEN
MOVNI T1,5 ;IGNORE SEQ NUM, AND DECREMENT CHAR COUNT
ADDB T1,IBF+2
SKIPL T1,IBF+2 ;[136] END OF BLOCK?
JRST GETJ ;[136] NO
PUSHJ P,INP ;[136] YES, DO INPUT
TRNE IOS,EOFBIT ;[136] EOF?
POPJ P, ;[136] YES
TRNN FLAG,NSMOD ;[136] ARE WE REMOVING SEQ NUMS
JRST GETJ ;[136] NO
SOS T1,IBF+2 ;[136] STEP
ILDB CHR,IBF+1 ;[136]
GETJ: TRNE FLAG,NSMOD ;[136] REMOVE SEQ NUMS MODE?
JRST GET2A ;YES, SO GET NEXT CHAR
MOVEM T2,SQNUM ;SEQ NUM FROM BUFFER BECOMES NEW SEQ NUM
PUSHJ P,OUTLBF ;DUMP THE LINE BUFFER (IF REQUIRED)
TRON FLAG,STS+SNI ;TURN ON START OF LINE
;AND NO-INCREMENT SEQ NUM FLAG
PUSHJ P,CLRBUF ;CLEAR LBUF IF IN THE MIDDLE OF A LINE
JRST GET1 ;GET CHAR. AFTER SEQ. NUMBER
GET2A: TRNN FLAG,SQMOD ;IF RESEQUENCING COPY FIRST CHAR.
GET2: TRZE FLAG,ESQ ;REPROCESS LAST CHAR?
JRST GET1 ;YES
SOSL T1,IBF+2 ;CHARS REMAINING IN INBUFFER?
JRST GET4 ;YES
PUSHJ P,INP ;NO, SO REFILL AND CHECK ERR BITS
TRNE IOS,EOFBIT ;END OF FILE? IOS HAS STATUS BITS
POPJ P, ;YES
JRST GET2 ;NO, SO PROCESS INBUFFER
GETPC3: TRO FLAG,ESQ ;REPROCESS BAD CHAR
TROA CHR,12*200 ;PRECEED BAD CHAR WITH LINE FEED
GETPC2: MOVEI CHR,12*200;CHANGE SPACE TO LINE FEED
JRST GETPC4
PCHTAB: XWD 24*200,23*200+"." ;/ *
XWD 212*200+" ",177*200 ;0 + VJC 4/16/49
XWD 14*200,21*200 ;1 ,
XWD 20*200,212*200+"0" ;2 -
XWD 13*200,22*200 ;3 .
GET4: ILDB CHR,IBF+1 ;FETCH CHAR FROM INBUFFER
TDNN FLAG,[XWD IFLG+IBFLG,BMOD] ;BIN, IB, I OR SBIN MODE?
TLNE AUXFLG,SBIN
JRST CPOPJ1 ;YES, SO NO PROCESSING REQUIRED
GET1: LDB CHR,IBF+1 ;AFTER SEQ NUM, HERE FOR 1ST CHAR
JUMPE CHR,GET2 ;IGNORE NULL CHARS
TLNE FLAG,WFLG ;CONVERTING TABS TO SPACES?
CAIE CHR,11 ;A TAB?
JRST GET1D ;NO
MOVEI CHR,40 ;YES, PREPARE A SPACE INSTEAD
TLZN FLAG,TBSN ;SEEN THIS TAB BEFORE?
JRST GET1B ;NO, THIS SPACE OUTPUT UNCONDITIONALLY
MOVE T2,CDRCNT ;YES, AT A TAB STOP?
TRNN T2,7
JUMPN T2,GET2 ;YES, STOP CONVERSION AND GET NEXT CHAR.
GET1B: TDO FLAG,[XWD TBSN,ESQ] ;NO, SIGNAL REPROCESS THIS TAB
GET1D: CAIN CHR,LF ;IGNORE LINE FEED IN FORTRAN OUTPUT
TLNN FLAG,PFLG ;/P SWITCH IN EFFECT?
JRST GET1A ;NO
TLO FLAG,PCONV ;CONVERT THE NEXT LIVE CHAR
JRST GET2 ;GET NEXT CHAR
GET1A: MOVE T2,@IBF+1 ;BIT 35 OF BUFFER SET?
TRZE T2,1
JRST GET5 ;YES, THIS IS A SEQ NUM
TRZE FLAG,STS ;START SEQ (NEW LINE) FLAG ON?
TRNN FLAG,SQMOD+SNI ;YES, SEQ MODE OR SEQ COPY?
JRST GET7 ;NO, SO PROCESS CHAR
MOVE T2,SQNUM ;NO, SO ADD 10. TO SEQ NUM
MOVE T1,K1
TRNE FLAG,OSFLG ;TEST FOR INCR. BY ONE
MOVE T1,K4
ADD T2,T1 ;ASCII INCREMENT
AND T2,K3 ;MASK SIGNIFICANT DIGITS
MOVE T1,T2
AND T1,ZRO ;MASK CARRY BITS
ASH T1,-3
SUB T2,T1 ;ADJUST CARRIES
IOR T2,ZRO
TRZN FLAG,SNI ;NON-INCREMENT SEQ NUM FLAG ON?
MOVEM T2,SQNUM ;NO, SO SAVE THE RESULT
TRO FLAG,LINE+SUS+ESQ ;TURN ON SUPPLY SEQ, REPROCESS
;LAST CHAR, AND LINE-BY-LINE FLAGS
AOS LBUF ;SET BIT 35 IN LBUF TO MARK SEQ NUM
MOVE T1,[POINT 7,SQNUM]
MOVEM T1,PTRPT ;INITIALIZE SEQ NUM PICK-UP POINTER
JRST GET ;GO OUTPUT FIRST CHAR OF SEQ NUM
SUBTTL INPUT
;ROUTINE TO INPUT INPUT FILE
INP: IN IN, ;INPUT DATA
JRST CPOPJZ ;NO ERRORS ,BUT CLEAR IOS JUST IN CASE
GETSTS IN,IOS ;CHECK INPUT ERR BITS
TRNN AUXFLG,MTAIN ;MTA INPUT?
TRNE IOS,740000 ;ANY ERROR BITS SET?
TRNN IOS,740000+EOTBIT ;EOT FOR MTA?
POPJ P, ;NO
PUSHJ P,COMERR ;SAVE AC'S RELEASE TTY
JSP T5,INICN2 ;YES SO PRINT OUT COMPLETE FILE DESCRIPTOR
PUSHJ P,QUEST
ERRPN2 </Input device />
PUSHJ P,P6BIT
DEVICE
SKIPN ZRF ;IS THERE A FILE NAME
JRST .+4 ;NO,SO DON'T PRINT
ERRPN2 </: file />
MOVEI T3,ZRF ;LOC OF INPUT FILE NAME TO T3
PUSHJ P,FN.EX ;DEPOSIT FILE NAME, EXT INTO TTY OUT BUFFER
MOVE T2,AUXFLG
ANDI T2,CDRIN+DTAIN+DSKIN+MTAIN
PUSHJ P,IOERR ;GO PRINT ERROR DESCRIPTOR
SETSTS IN,(IOS)
POPJ P,
;ROUTINE TO TEST IF BLOCK TOO LARGE, OR WRITE LOCKED
QUEST: MOVEI CHR,"?" ;DEPOSIT "?" IN ERROR MSG
TLNN FLAG,GFLG ;ONLY IF /G NOT ON
JRST PUTCON ;/G NOT ON, PRINT ?(FATAL) BEFORE ERR MSG
TRNN IOS,BIGBLK ;BLOCK NO. TOO LARGE?
JRST QUEST2 ;NO
TRNN AUXFLG,DTAIN+DTAOUT ;YES
POPJ P, ;BLOCK TOO LARGE
JRST PUTCON ;DEPOSIT "?" FATAL EVEN IF /G ON
QUEST2: TRNE IOS,WRTLOK ;WRITE LOCKED?
TRNN AUXFLG,DTAIN+DTAOUT+MTAIN+MTAOUT+DSKOUT
POPJ P, ;NO
JRST PUTCON ;DEPOSIT "?" FATAL EVEN IF /G ON
SUBTTL TAB AND SPACE HANDLER
GET7: TLNE FLAG,PCONV ;CONVERTING FORTRAN CARRAIGE CONTROL CHAR?
JRST GET+1 ;YES, GO DO IT
AOS T1,CDRCNT
CAIN CHR,SPACE ;SPACE?
JRST GETA2 ;YES
CAIN CHR,CR ;CAR. RET.?
JRST GETA3 ;YES
TLNE AUXFLG,CDRFLG
JRST GET7B ;CARD READER INPUT
GET7C: TRZ FLAG,SPOK ;CHAR NOT A SPACE STOP COUNTING CONSEC. SPACES
CAIN CHR,TAB ;TAB?
JRST GETA5 ;KEEP TRACK OF TAB STOPS
CAIG CHR,176 ;[154] ALLOW LOWER CASE & ESC TO COUNT
;[154] IN ADDITION TO NUMBERS, UPPER, ETC
CAIGE CHR,SPACE ;NON-SPACING CHARACTER?
JRST CPOPJ1 ;YES, SO RETURN IMMEDIATELY
SOSG TABCT ;COUNT DOWN THE TAB STOP COUNTER
JRST GETA5 ;RESET THE COUNTER IF TAB STOP IS PASSED
CPOPJ1: AOSA (P) ;SKIP RETURN
CPOPJZ: SETZ IOS, ;CLEAR IOS JUST IN CASE
CPOPJ: POPJ P,
GETA3: TRZE FLAG,SPOK ;CAR. RET. SEEN, ANY TRAILING SPACES?
TRNN FLAG,SPMOD+TBMOD ;YES, ARE WE FLUSHING TRAILING SPACES
JRST GETA5 ;NO, RESET TAB COUNTER ONLY
MOVE 0,SVPTR1
MOVEM 0,OPTR ;CLOBBER THE OUTPUT POINTER TO LBUF
GETA5: MOVEI 0,TABSP
MOVEM 0,TABCT ;RESET THE TAB COUNTER
JRST CPOPJ1
GET7B: CAIG CHR,SPACE
JRST GET7C ;DON'T CONSIDER CONTROL CHARS.
CAIL T1,^D73 ;LT COL 73?
CAILE T1,^D80 ;NO, LE COL 80?
JRST GET7C ;CAN'T BE A CARD SEQUENCE NUMBER
MOVEI CHR,SPACE ;REPLACE CARD SEQUENCE NOS. BY SPACE
GETA2: TROE FLAG,SPOK ;SPACE WAS SEEN, IS THIS ONE OF A SEQUENCE?
JRST GETA7 ;YES
MOVE 0,OPTR ;THIS IS THE FIRST SPACE SEEN, SAVE LBUF
;POINTER IN CASE THIS SPACE MUST BE FLUSHED
MOVEM 0,SVPTR1 ;THIS POINTER FOR FLUSHING FINAL SPACES
MOVEM 0,SVPTR2 ;THIS POINTER FOR CHANGING MULT. SPACES TO TABS
SETZM SPCT ;INITIALIZE THE SPACE COUNTER
GETA7: AOS T1,SPCT
SOSLE TABCT ;ARE WE AT THE NEXT TAB STOP?
JRST CPOPJ1 ;NO
CAIL T1,2 ;DONT BOTHER CHANGING ONE SPACE TO A TAB
TRNN FLAG,TBMOD ;TAB GENERATING MODE?
JRST GETA5A ;NO, GO RESET TAB COUNTER
MOVE 0,SVPTR2
MOVEM 0,OPTR ;BACK UP THE OUTPUT POINTER OVER THE LAST
;GROUP OF SPACES
MOVEI CHR,TAB ;OUTPUT A TAB
SETZM SPCT ;RESET THE SPACE COUNTER
GETA5A: IBP SVPTR2 ;UPDATE THE CHANGE-SPACES-TO-TABS POINTER
JRST GETA5 ;RESET THE TAB COUNTER
SUBTTL ERROR MESSAGES (GENERAL)
;ERROR ROUTINES
IFN RIMSW,<
ERR8A: MOVEI T4,ERR382
JRST E10B
ERR3B: MOVEI T4,ERR381
JRST E10B>
ERR10: MOVEI T4,E10A
E10B: SKIPN ZRF
SKIP 3
ERRPNT </?File />
MOVEI T3,ZRF
PUSHJ P,FN.EX
JRST (T4)
IFN RIMSW,<
ERR381: ERRPN2 </illegal extension!/>
ERR382: ERRPN2 </illegal format!/>
ERR5B: ERRPN2 </? DTA to PTP only!/>>
ERR9: MOVEI T3,DTON
IFN FTDSK,<MOVEI T7,4 ;REALLY ERROR TYPE 4
SKIPE DTON ;UNLESS FILE NAME IS ZERO
JRST DERR4 ;NOT, SO USE DSK ERROR ROUTINES>
ERRPNT </?/>
PUSHJ P,FN.EX
IFE FTDSK,<SKIPN DTON ;SKIP IF NON-ZERO FILE NAME>
JRST ERR4B
IFE FTDSK<ERRPNT </(4) rename file name already exists!/>>
ERR11: ;[211]
MOVE 0,DEVICE ;[227] GET SOURCE DEVICE NAME
CAMN 0,ODEV ;[227] ALLOW EXACTLY THE SAME
JRST DELE2 ;[227] EQUAL, CONTINUE /R/D
IFN FTDSK,< ;[211]
MOVEM 0,DEVPTH ;[211] ALLOW A SYS SEARCH LIST DEVICE
MOVE T1,[XWD 3,DEVPTH] ;[211] SET UP FOR PATH.
PATH. T1, ;[211] AND DO IT
JFCL ;[211]
LDB T1,[POINT 3,DEVPTH+1,29];[211] GET SEARCH LIST BITS
CAIN T1,3 ;[211] SEE IF SYS SEARCH LIST
JRST DELE2 ;[211] YES, ALLOW THAT
>;[211] END IFN FTDSK
ERRPNT </?Different source device specification not allowed!/> ;[227] /R OR /D
ERR12: ERRPNT </?Null file name illegal!/> ;[153] FIX .FOO
ERR13: ERRPNT <%?Wild card not allowed for /L or /F!%> ;[244]
ERR1: SKIPA T2,ODEV ;OUTPUT UNAVAILABLE
ERR1A: MOVE T2,DEVICE ;INPUT UNAVAILABLE
ERR1B: ERRPNT </?Device />
PUSHJ P,P6BIT
T2
ERRPN2 </ not available!/>
ERR3:
IFN FTDSK,<TRNE AUXFLG,DSKIN
JRST DERR5 ;ERR ON DSK>
PUSHJ P,ERR3A
JRST IOERRN ;EXIT
ERR3A: TLO AUXFLG,INFOFL ;SIGNAL RETURN TO ERR3AA
TRNE AUXFLG,TTYOUT ;[176] SEE IF OUTPUT IS TO TTY
CLOSE OUT, ;[176] YES, THEN PRINT BEFORE NEW INIT
JRST INFO
ERR3AA: TRNE FLAG,DFLG ;DELETING?
JRST ERR3AD ;YES, GIVE NON-FATAL MESSAGE
ERRPN2 </? /> ;NO, FATAL
ERR3AB: ERRPN2 </No file named />
ERR3AC: ;[177] LABEL FOR /L/F TO USE FOR NOT FOUND
IFN FTDSK,< ;[240]
PUSHJ P,P6BIT ;[211] GO PRINT DEVICE NAME
ADSK ;[211] FROM ADSK
MOVEI CHR,":" ;[211] WITH COLON
PUSHJ P,PUTCON ;[211]
>;[240] END IFN FTDSK
SKIPN T3,QMASK ;USING WILD CHAR. ?
JRST ERR3AX ;NO
ANDCAM T3,FILNAM ;CLEAR GARBAGE CHARS.
AND T3,['??????'] ;CREATE MASK OF ??S
IORB T3,FILNAM ;FILL IN FILE NAME
CAME T3,['??????'] ;BUT IF ALL CHARS ARE WILD
JRST ERR3AX ;NOT
MOVSI T3,'* ' ;USE *
MOVEM T3,FILNAM
ERR3AX: SKIPN T3,QMASK+1 ;SAME FOR EXT
JRST ERR3AY
ANDCAM T3,FILNAM+1
AND T3,['??????']
IORB T3,FILNAM+1
CAME T3,['??????'] ;BUT IF ALL CHARS ARE WILD
JRST ERR3AY ;NOT
MOVSI T3,'* ' ;USE *
MOVEM T3,FILNAM+1
ERR3AY: MOVEI T3,FILNAM
PUSHJ P,FN.EX ;PRINT NAME OF FILE THAT CANNOT BE FOUND
PUSHJ P,INFO2 ;OUTPUT MESS. WITH CR-LF
TRNN AUXFLG,TTYIN!TTYOUT ;WAS TTY IN USE?
POPJ P, ;NO
TRNE AUXFLG,TTYIN ;INPUT DEVICE?
JRST ININIT ;YES ,RE-INIT
JRST OMODE ;MUST BE OUTPUT
ERR3AD: ERRPN2 </% /> ;NON-FATAL
JRST ERR3AB ;AND COMMON MESSAGE
ERR4: SKIPN DTON
JRST ERR4A
IFN FTDSK,<TRNE AUXFLG,DSKOUT ;ERR ON DSK
JRST DERR6>
ERRPNT </? Directory full!/>
ERR4A:
ERR4B: ERRPNT </?(0) Illegal file name!/>
ERR6: TLZ FLAG,TID ;[125] CLEAR ID REQUEST TO PREVENT LOOP
ERR6A: ERRPNX </?PIP command error!/>
ERR6B: ERRPNT </?PIP command too long!/>
E10A: ERRPN2 </ line too long!/>
ERR5A: ERRPNT </?Too many input devices!/>
;FILE MANIPULATION COMMANDS TO NON-DIRECTORY DEVICES COME HERE
ERR5: ERRPNT </?Disk or DECtape input required!/>
ERR2: ERRPNX </?Incorrect Project-Programmer number!/>
ERR2A: ERRPNX </?Illegal protection!/>
ERR7A: ERRPNT <Z?DECtape I/O only!Z>
ERR8: ERRPNT </?Explicit output device required!/>
SUBTTL DETERMINE INPUT DEVICE TYPE
;ROUTINE TO CHECK INPUT DEV, SET XXXIN.E.G.DTAIN
CHECK1: TRZ AUXFLG,DTAIN+DSKIN+CDRIN+PPTIN+TTYIN+MTAIN+NULIN ;[211]
MOVE 0,DEVICE ;INPUT DEVICE NAME TO AC 0
JUMPE 0,CHECK ;IGNORE IF NO INPUT DEVICE
IFN FTDSK,< ;[245]
MOVEM 0,ADSK ;[245] SAVE DEVICE FOR INIT AND ERRORS
>;[245] END IFN FTDSK
DEVCHR ;GET INPUT DEVCHR
IFN FTDSK,<TLNN 0,DSKBIT ;INPUT DEVICE DISK?
JRST CHECK2 ;NO
TRO AUXFLG,DSKIN;INPUT DEVICE IS DSK, SET BIT
TLC 0,-1-<(DV.TTA)> ;[211] CHECK FOR NULL
TLCN 0,-1-<(DV.TTA)> ;[211] BY LOOKING FOR ALL BITS ON
TRO AUXFLG,NULIN ;[211] IT IS NUL:
MOVE 0,DEVICE ;[163] GET DEVICE INTO 0 FOR PSYSP
PUSHJ P,PSYSP ;[163] GO CHECK ERSATZ
JRST CHECK
>;[163] END IFN FTDSK
CHECK2: JUMPE 0,DEVER1 ;NON-EX. DEVICE
TLNN 0,INBIT ;CAN DEVICE DO INPUT?
JRST ERR6A ;NO, COMMD ERROR
TLNE 0,PTRBIT ;PAPER TAPE READER?
TRO AUXFLG,PPTIN;YES
TLNE 0,DTABIT ;DECTAPE?
TRO AUXFLG,DTAIN
TLNE 0,MTABIT ;MAGTAPE?
TRO AUXFLG, MTAIN
TLNE CDRBIT ;CARD READER?
TRO AUXFLG,CDRIN
TLNE 0,TTYBIT ;TELETYPE?
TRO AUXFLG,TTYIN
CHECK: TRNE CALFLG,SSWTCH ;_FLAG STILL ON?
JRST ERR6A ; YES ,COMMAND ERROR
POPJ P, ; NO, RETURN
SUBTTL ERROR MESSAGE PRINTERS
;SUBR TO PRINT ERROR MESSAGES
;! MARKS THE END OF MESSAGE & SIGNALS GO TO PIP2
;NULL IS A FLAG TO RETURN TO THE NEXT LOCATION
PRETXT: IFN CCLSW,<
SKIPN COMFLG ;IN CCL MODE
JRST PTEXT ;NO, SO DON'T BOTHER
PRTXT1: PUSHJ P,GETBUF ;GET A CHAR.
CAIG 0,FF ;TEST FOR LF, VT, FF
CAIGE 0,LF
JRST PRTXT1 ;NOT A LINE TERMINATOR>
PTEXT: TRNE AUXFLG,TTYOUT ;[175] SEE IF OUTPUT DEVICE IS TTY
CLOSE OUT, ;[175] YES, THEN OUTPUT LAST BUFFER
JSP T5,INICN2 ;[175] GO INIT TTY ON CON
PUSHJ P,TCRLF ;OUTPUT A CR-LF
PTEXT2: HRLI T1,440700 ;GET SET TO SCAN 7-BIT DATA
PTEXT1: ILDB 0,T1 ;GET CHAR OF ERR MESSAGE
JUMPE 0,1(T1) ;RETURN ON ZERO
CAIN 0,"!" ;!?
JRST [TRZN CALFLG,RTRNFL ;FATAL
JRST IOERRN ;YES, END OF MESSAGE, APPEND CAR.RET., LF
JRST TCRLF] ;RETURN TO CALLING ROUTINE
IDPB 0,TFO+1 ;DEPOSIT CHAR IN OUTBUFFER
JRST PTEXT1 ;GET NEXT CHAR
;ROUTINE TO DEPOSIT CHARACTER IN TTY OUT BUFFER
PUTCON: SOSG TFO+2 ;STORED MORE THAN BUFFER HOLDS?
OUTPUT CON, ;YES
IDPB CHR,TFO+1
POPJ P,
;ROUTINE TO CONVERT ONE WORD OF SIXBIT
;FROM ADDRESS IN LOCATION AFTER CALL AND DEPOSIT INTO TTY OUT BUFFER
P6BIT: MOVE T1,@(P) ;PICK UP WORD OF 6-BIT
HRLI T1,440600 ;SET UP POINTER
P6BIT1: ILDB CHR,T1
JUMPE CHR,P6BIT2
ADDI CHR,40
PUSHJ P,PUTCON ;DEPOSIT IN TTY
P6BIT2: TLNE T1,770000 ;DONE SIX?
JRST P6BIT1 ;NO
JRST CPOPJ1 ;SKIP RETURN
SUBTTL DTA /Z AND ^^
;ROUTINE TO CLEAR DSK OR DTA DIRECTORY (/Z SWITCH)
DTCLR: TRNN CALFLG,DVSWTH ;HAS A DEVICE BEEN SEEN?
JRST ERR8 ;NO,SO DON'T SCREW USER
IFN FTDSK,<TRNE AUXFLG,DSKOUT ;CLEAR DSK OR DTA DIR.
JRST DSKZRO>
IFN TEMP,<TRNE CALFLG,TMPO ;TMPCOR
JRST TMPZRO>
TRNN AUXFLG,DTAOUT ;MUST BE DTA
JRST ERR5
UTPCLR OUT, ;CLEAR DIRECTORY
POPJ P,
;ROUTINE TO WRITE ID IN DTA
SYN QMASK,DDIOW ;SAVE SPACE
WRTID: MOVEI 0,117 ;NON-STANDARD DUMP MODE
MOVEM 0,OMOD ;IN OPEN DATA
SETZM OMOD+2 ;NO BUFFERS
OPEN DD,OMOD ;INIT DEVICE
JRST ERR1 ;NOT AVAILABLE
USETI DD,144 ;SET ON DIRECTORY
HRRZ T1,.JBFF ;GET CURRENT TOP OF FREE CORE
ADDI T1,200 ;DIRECTORY BUFFER
CAMLE T1,.JBREL ;WILL IT FIT
JSP T4,MORCOR ;NO, GET SOME
SUBI T1,201 ;IOWD ADDRESS
HRLI T1,-200 ;NUMBER OF WORDS
MOVEM T1,DDIOW ;STORE I/O WORD
SETZM DDIOW+1 ;TERMINATE LIST
INPUT DD,DDIOW ;DO INPUT
MOVE 0,TAPEID ;GET ID
MOVEM 0,200(T1) ;PUT IT IN DIRECTORY
USETO DD,144 ;SET TO WRITE IT OUT
OUTPUT DD,DDIOW ;OUT IT GOES
RELEAS DD,0 ;CLEAR DIRECTORY IN CORE BIT
TLZ FLAG,TID ;[125] SO WE DON'T COME BACK TOO OFTEN
POPJ P,
SUBTTL /X COPY ROUTINES
;ROUTINE TO SET UP TO COPY EVERYTHING
PRECOP:IFN TEMP,<
TRNE CALFLG,TMPI ;INPUT DEV. IS TMPCOR?
JRST TMPIN ;YES>
TRO CALFLG,FNEX ;/X IMPLIES MANY FILES
PUSHJ P,ININIT ;INIT INPUT FILE
TRNN AUXFLG,DTAIN ;DECTAPE INPUT
SKIP 2 ;NO
PUSHJ P,DTCH2 ;YES, GET DIRECT, SET POINTERS TO DIRECT
DTCOPY: PUSHJ P,DTADI1 ;START (T5)
IFN FTDSK,<TLNN FL,MFLG ;[130] NO NEED TO CALL DSKDIR IF
JRST COPY1A ;[130] EXPLICIT FILE NAME TYPED
TRNE AUXFLG,DSKIN ;DSK INPUT. ENTER HERE FROM DTD2
PUSHJ P,DSKDIR ;YES, PREPARE TO LOOKUP FILES>
COPY1A: MOVEI T2,6 ;FILL 0 CHARS. IN DEST-FILE
MOVE T1,[POINT 6,DTON] ;NAME WITH X'S. THIS IS
TRNN FL,RXFLG ;TWO NAMES GIVEN?
JRST .+3 ;NO
MOVE 0,[FILNAM,,DTON] ;GET INPUT FILE NAME
BLT 0,DTON+1 ;AS OUTPUT
MOVE 0,QMASK ;GET INPUT MASK
ANDCAM 0,DTON ;AND CLEAR WILD CHARACTERS
HLLZ 0,QMASK+1 ;SAME FOR EXT
ANDCAM 0,DTON+1
XSS: ILDB 0,T1 ;THEN THE BASE FOR GENERATED
JUMPN 0,.+2 ;DESTINATION FILES FROM
MOVEI 0,"X"-40 ;NON-DIR. DEVICES IN /X
DPB 0,T1
SOJG T2,XSS ;DON'T YET KNOW IF ONE
;OF THE INPUT DEV. WILL BE NON-DIR
MOVE 0,[DTON,,DTONSV]
BLT 0,DTONSV+1
COPY1: PUSHJ P,SR2 ;SET INIT. COPYING MODE
PUSHJ P,LOOK ;GET A FILE TO COPY
JRST CAL6 ;NO MORE
IFN FTDSK<PUSHJ P,XDDSK ;GOT ONE, CHECK (XD) FROM DSK, NAMTAB
JRST COPY1 ;IN LIST, DON'T COPY>
TRNN AUXFLG,MTAIN+PPTIN+CDRIN+TTYIN ;OK, COPY FILE
JRST COPY6A ;MUST BE DIRECTORY DEVICE
PUSHJ P,MTPTCR ;SET UP A DEST. FN.
JRST COPY6
COPY6A:
IFN FTDSK,<PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;YES, USE IT>
LOOKUP IN,ZRF ;LOOKUP INPUT FILE NAME
JRST CAL5 ;INPUT FILE FILE PROTECTED
COPY6: PUSHJ P,FILTYP ;CHECK FOR DMP,SAV,REL,CHN
TRNN AUXFLG,DSKIN!DTAIN ;ALLOW NULL FILE ON DIRECTORY DEVICES
PUSHJ P,COPY3 ;INPUT FIRST BLOCK AND CHECK FOR EOF
COPY6B: MOVE 0,ZRF ;INPUT FILE NAME
MOVEM 0,DTON ;IS OUTPUT FILE NAME
HLLZ 0,ZRF+1 ;LIKEWISE EXT
HLLZM 0,DTON+1
;THIS CODE OPERATES AS FOLLOWS - FOR E+2, SET = 0
;TO START (ASSUMING /X)
;DSK TO DSK IF EDIT SWITCHES PUT E+2 = 0 IF NO EDITS TRANSFER
; DATE, TIME, BITS 13-35
;DSK TO DTA FOR EDITS E+2 = 0, NO EDITS TRANSFER 24-35 FOR
;DATE, FOR"SAV" FILES TRANSLATE NO. 1K BLOCKS
;DTA TO DSK FOR NO EDITS XFER BITS 24-35, ELSE E+2 = 0
;DTA TO DTA ALWAYS XFER 18-23, (1K BLOCK) NO EDITS XFER 24-35(DATE)
SETZM DTON+2 ;CLEAR DATE. OUTPUT FILE, DSK/DTA
LDB 0,DATE ;GET DSK/DTA DATE CREATED
TDNN FLAG,[XWD PFLG+WFLG,LINE+TBMOD+NSMOD+SQMOD+SPMOD]
TLNE AUXFLG,CDRFLG
JRST COPY6C
DPB 0,DATED ;DEPOSIT IF NO EDITS
LDB 0,XDATE ;[132] HIGH ORDER BITS OF DATE
DPB 0,XDATED ;[132] MUST BE COPIED ALSO
IFN FTDSK,<LDB 0,TIME
TRC AUXFLG,DSKIN+DSKOUT
TRCN AUXFLG,DSKIN+DSKOUT
DPB 0,TIMED ;DSK TO DSK TIME>
COPY6C: PUSHJ P,OKBLKS ;SETUP 1K BLOCKS
IFN FTDSK,<SKIPE LEVEL ;IF LEVEL D
TLNN AUXFLG,NSPROT ;AND NON-STANDARD PROTECTION
JRST .+3 ;NOT BOTH TRUE
LDB 0,PRPTL ;GET PROTECTION CODE
DPB 0,PRPTD ;INTO ENTER BLOCK>
MOVE 0,DTON+3 ;[207] SAVE PPN
SETO T2, ;[247] SET FLAG FOR AFTER ENTER
TRNE AUXFLG,DTAIN!DSKIN ;[247] IF DISK OR DTA INPUT
TRNN AUXFLG,DTAOUT!DSKOUT ;[247] AND DISK OR DTA OUTPUT
JRST COPY6D ;[247] NOPE
GETSTS OUT,T1 ;[247] GET CURRENT MODE
LDB T2,[POINT 4,ZRF+2,12] ;[247] GET MODE OF INPUT FILE
SETSTS OUT,(T2) ;[247] THEN MAKE MODE LIKE INPUT FILE
COPY6D: ;[247]
ENTER OUT,DTON ;GOT DATA, CREATE NEW FILE
JRST ERR4 ;DIRECTORY FULL
SKIPL T2 ;[247] SKIP IF DIDN'T CHANGE MODE
SETSTS OUT,(T1) ;[247] RESTORE TO ORIGINAL MODE FOR COPY
MOVEM 0,DTON+3 ;[207] RESTORE PPN
MOVE 0,ZRO ;GET ASCII/00000/AND
MOVEM 0,SQNUM ;RESET SEQUENCE NO.
TLO FLAG,NEWFIL ;SET NEW FILE FLAG
SETZM TOTBRK ;CLEAR PAREN COUNTER
TLNN AUXFLG,CDRFLG+SBIN ;SPECIAL PROCESSING?
TDNE FLAG,[XWD PFLG+WFLG+IFLG+IBFLG,LINE+BMOD+TBMOD+NSMOD+SQMOD+SPMOD]
JRST PSCAN ;YES, DO IT
TRNE AUXFLG,LPTOUT!TTYOUT
TLNE CALFLG,OSPLFL ;IS IT HARD COPY BUT NOT SPOOLED
JRST COPY5 ;NO
JRST PSCAN ;YES, MAKE SURE CONTROL CHARS. ARE HANDLED
COPY5: SOSGE IBF+2 ;INPUT BUFFER EMPTY?
JRST COPY4 ;YES
ILDB CHR,IBF+1 ;GET NEXT WORD AND
PUSHJ P,PUT ;OUTPUT IT
JRST COPY5
COPY4: PUSHJ P,COPY3 ;GET NEXT FULL SOURCE BLOCK
PUSHJ P,OUTP ;OUTPUT PREV. BLOCK-DONT ALTER DATA
AOS OBF+2 ;MAKE PUT HAPPY BECAUSE OF
JRST COPY5 ;OUTPUT HERE.
COPY2A: CLOSE IN,
IFN LEVELC,< ;[207]
SKIPL LEVEL ;[207] SEE IF LEVEL C
CLOSE OUT, ;[207] ONLY DO CLOSE IF LEVEL C
>;[207] END IFN LEVELC
IFN FTDSK,<TLNE AUXFLG,NSPROT ;NON-STANDARD PROTECTION?
TRNN AUXFLG,DSKOUT ;RENAME ALL OUTPUT FILES IF
JRST COPY2B ;NON-STANDARD PROTECTION
LDB 0,PRPTL ;GET NEW PROTECTION
SKIPE LEVEL ;IF LEVEL D
JUMPN 0,COPY2B ;AND NOT ZERO, DONE ALREADY
DPB 0,PRPTD
IFE LEVELC,< ;[207]
SETZM DTON+3 ;[207] CLEAR PPN FOR LEVEL D
>;[207] END IFE LEVELC
RENAME OUT,DTON ;RENAME OUTPUT FILE
JRST DERR6
IFE LEVELC,< ;[207]
SKIPA ;[207] SKIP CLOSE
>;[207] END IFE LEVELC
>;[207] END IFN FTDSK
COPY2B: ;[207]
IFE LEVELC,< ;[207]
CLOSE OUT, ;[207] CLOSE OUT IF NO RENAME
>;[207] END IFE LEVELC
PUSHJ P,OUTP1 ;[207]
JRST COPY1 ;GO GET NEXT FILE
IFE FTDSK,<SYN COPY1,CAL5>
IFN FTDSK,<
CAL5: PUSHJ P,DERR5R ;PRINT DSK ERROR TYPE
JRST COPY1 ;COUNT READ FAILURES>
;NO MORE FILES TO COPY
CAL6: TLZ AUXFLG,NSPROT
JRST MAIN1
COPY3B: SKIPE IBF+2 ;EMPTY BLOCK?
POPJ P, ;NO, RETURN
COPY3: PUSHJ P,INP ;READ NEXT BLOCK
TRZE AUXFLG,READ1
PUSHJ P,TTYZ ;END OF FILE FROM TTY?
TRNN IOS,EOFBIT ;END OF FILE? IOS HAS STATUS BITS
JRST COPY3B ;NO.
POP P,0 ;CLEAR ITEM FROM STACK
HRRZS 0 ;ADDRESS ONLY
TRNN AUXFLG,DSKIN!DTAIN ;ALLOW NULL FILE FOR THESE ONLY
CAIE 0,COPY6B ;DID WE COME FROM COPY6B-1?
JRST COPY2A ;NO, CLOSE OUT FILES
TRZ CALFLG,ALLCLF ;YES, END OF INFO ON NON-DIR DEVICE
JRST COPY1
;CREATE DESTINATION FILE NAME. RANGE IS ...001 TO ...999
MTPTCR: TRNE FL,RXFLG ;OUTPUT NAME SEEN?
HLLOS OQMASK ;YES, ONLY USE FIRST 3 CHARS.
AOS T1,NO.
CAILE T1,^D999
JRST MPC2
PUSHJ P,MTPTC1
MOVE 0,[DTONSV,,ZRF] ;FILNAM=DTON IS ONLY WAY TO IDENTIFY
BLT 0,ZRF+1 ;INPUT FILE
POPJ P,
MPC2: ERRPNT <Z?Terminate /X, max. of 999 files processed!Z>
MTPTC1: MOVEI DOUT,^D1000(T1)
MOVE T1,[POINT 6,DTONSV,17]
JSP T2,OUTDC1
AOJA T2,CPOPJ
SUBI CHR,40
IDPB CHR,T1
POPJ P,
;ROUTINE TO RESTORE BYTE POINTERS TO INITED MODE
;FOR INPUT AND OUTPUT DEVICES
SR2: MOVE 0,SVIBF
HLLM 0,IBF+1
MOVE 0,SVOBF
HLLM 0,OBF+1
POPJ P,
;ROUTINE TO SEE IF ^Z FIRST CHAR ON TTY
TTYZ: TRNN AUXFLG,TTYIN ;SEE IF FIRST CHAR. IS ^Z
POPJ P, ;NOT TTY INPUT
HRRZ T1,IBF+1 ;ON TTY
HLRZ 0,1(T1) ;GET FIRST CHARACTER
TRZ 0,3777 ;CLEAR ANY OTHER CHAR.
CAIN 0,(<CZ>B6) ;IS IT ^Z?
TROA IOS,EOFBIT ;YES,SET END OF FILE
CAIE 0,(<XON>B6) ;IS IT XON "^Q"
POPJ P, ;NO
MOVSI 0,(<DEL>B6) ;A RUBOUT
IORM 1(T1) ;CLEAR "^Q" FROM BUFFER
POPJ P, ;AND RETURN
;DTA TO DTA MAINTAIN BITS 18-23 OF E+2 IF SET
;DSK TO DSK NO TRANSLATION (E+2)
;DSK TO DTA TRANSLATE E+3 (LHS) INTO E+2 (18-23)
;DTA TO DSK NO TRANSLATION (E+2)
;THIS ROUTINE ENSURES "SAVE" FILES MAINTAIN
;CORRECT DATA FOR LOADING. FOR DSK INPUT
;A "SAVE" FILE IS ONE WITH THE EXTENSION
;"SAV". E+3 = (-[(200XN)+NO. WDS IN LAST BLOCK]
;IN LHS TRANSLATE TO NO. 1K BLOCKS NEEDED
;TO LOAD FILE - BEFORE IT IS EXPANDED IN CORE.
OKBLKS: TRNN CALFLG,RXFLG ;(RX)?
JRST OKBLK0 ;NO
MOVE 0,MATCH ;GET FILE NAME
HLRZ T1,MATCH+1 ;AND EXT.
MOVEM 0,DTON ;REPLACE NAME
HRLM T1,DTON+1
SKIPN T1,OQMASK ;WILD CARD OUTPUT
JRST .+4 ;NO
ANDCAM T1,DTON ;CLEAR OUT MASK CHARS
AND T1,ZRF ;GET SUBSTITUTE ONES
ORM T1,DTON ;PUT THEM IN
HLLZ T1,OQMASK+1 ;TRY EXT
JUMPE T1,.+4 ;NO
ANDCAM T1,DTON+1 ;SAME AS ABOVE
AND T1,ZRF+1
ORM T1,DTON+1
OKBLK0: MOVE 0,DTON ;GET OUTPUT FILE NAME
HLRZ T1,DTON+1 ;AND EXT
CAIE T1,'SAV' ;SAV FILE?
CAIN T1,'SVE' ;OR SVE (SPMON) FILE?
TRNN AUXFLG,DTAOUT ;AND OUTPUT TO DTA?
SKIP 1 ;NO
UGETF OUT,0 ;SET TO FIRST FREE BLOCK
IFN FTDSK,<TRC AUXFLG,DSKIN+DSKOUT ;DSK I/O
TRCN AUXFLG,DSKIN+DSKOUT
POPJ P, ;YES, EXIT
TRC AUXFLG,DTAIN+DTAOUT ;NO
TRCE AUXFLG,DTAIN+DTAOUT ;DTA I/O
JRST OKBLK1 ;NO>
LDB 0,OKB ;DTA I/O - 1K BLKS
DPB 0,OKBD ;DEPOSIT IN DTON
POPJ P,
IFN FTDSK,<
OKBLK1: TRC AUXFLG,DTAIN+DSKOUT ;DTA-TO-DSK
TRCN AUXFLG,DTAIN+DSKOUT
POPJ P, ;YES
TRC AUXFLG,DSKIN+DTAOUT ;NO,DSK-TO-DTA?
TRCE AUXFLG,DSKIN+DTAOUT ;NO
POPJ P,
HLRZ 0,ZRF+1 ;YES DSK-TO-DTA
CAIE 0,'SAV' ;GET LOOKED UP EXT,(INPUT).
CAIN 0,'SVE'
SKIP 1
POPJ P,
HLRO T1,ZRF+3 ;EXTENSION=SAV
MOVNS T1 ;WORD COUNT
IDIVI T1,2000 ;DIVIDE BY 1K CORE(OCTAL LOCS.)
JUMPN T2,.+2
SOJ T1, ;N-1
DPB T1,OKBD
POPJ P,>
SUBTTL /X/D COPY EXCEPT ROUTINE
IFN FTDSK,<
;ARE WE DOING (XD) FROM DSK? IF NOT, EXIT.
;SEE IF CURRENT FILE SELECTED IN ZRF IS IN THE
;LIST OF FILES NOT TO BE COPIED. (POPJ IF IT IS)
XDDSK: TRC FLAG,XFLG+DFLG ;COMPLEMENT
TRCN FLAG,XFLG+DFLG ;RESET AND TEST
TRNN AUXFLG,DSKIN ;/X AND /D WERE SET
JRST CPOPJ1 ;NOT DSKIN SO COPY FILE
HRROI T1,-12 ;SET TO LOOP NAMTAB
XDDSK2: MOVE T2,ZRF ;GET FILE NAME
SKIPN T3,NAMTAB+12(T1) ;END OF TABLE ENTRIES?
JRST CPOPJ1 ;YES, EXIT
IOR T2,NAMASK+12(T1) ;[124] MASK OUT WILD CHARS
CAME T2,T3 ;FN IS * OR MATCH?
JRST XDDSK1 ;NO MATCH
HLLZ T2,ZRF+1 ;GET EXT
SKIPN T3,NAMTAB+24(T1) ;NO EXT MATCH WANTED
POPJ P, ;EXIT THEN
IOR T2,NAMASK+24(T1) ;[124] MASK OUT WILD CHARS
CAMN T2,T3 ;EXT IS * OR MATCH?
POPJ P, ;FN EX MATCH, NO COPY
XDDSK1: AOJL T1,XDDSK2 ;TRY ANOTHER FOR MATCH
JRST CPOPJ1 ;SEARCHED TABLE, NO MATCH>
SUBTTL SET UP THE MULTIPLE NAME MATCHING TABLE
;ROUTINE TO DELETE OR RENAME FILES ON DTA OR DSK OR SET UP NAMTAB
;FOR (DX) (DISK ONLY)
DTDELE: IFN TEMP,<
TRNE CALFLG,TMPO ;TMPCOR
JRST TMPDEL ;YES>
TRNE FLAG,XFLG ;/X
JRST DELE1 ;YES
TRNN FLAG,DFLG ;/D NEED EXPLICIT DEVICE
SKIP 2
TRNN CALFLG,DVSWTH ;-1 IF DEVICE SEEN
JRST ERR8 ;NO, ERROR
TLZE FL,SDEVSN ;[152] SEE IF WE SAW A SOURCE DEVICE
JRST ERR11 ;[152] YES, DON'T ALLOW THAT
MOVE 0,ODEV ;OUTPUT DEVICE
DELE2: ;[211] RETURN IF =SYS:
MOVEM 0,DEVICE ;NO,SET DEVICE FOR INPUT
MOVEM 0,DEVA
DELE1: PUSHJ P,CHECK1 ;RESET INPUT DEVICE DESCRP
MOVE 0,[DTON,,NAMTAB] ;FOR /R GET NEW NAME
;SET TO BLT OUTPUT DIRECT ENTRY
BLT 0,NAMTAB+3 ;TO NAMTAB
TRNN AUXFLG,DTAIN+DSKIN
JRST ERR5 ;NOT DTA OR DSK
PUSHJ P,FNSET ;SET UP CALFLG CORRECTLY
TRNE FLAG,XFLG ;/X?
JRST DTD1 ;YES, (DX). RX ILLEGAL
IFN FTDSK,<TRNE AUXFLG,DSKOUT ;NO, HAS TO BE /D OR /R
JRST DSKDR0 ;ON DSK>
JRST DTADR ;OR DTA
DTD1:
IFN FTDSK,<TRNE AUXFLG,DSKIN ;DSK INPUT?
JRST DTD1A ;YES>
PUSHJ P,DTCHECK ;NO, HAS TO BE DTA, GET DIR
JRST DELE3 ;DELETE, FILES FROM DIR
IFN FTDSK,<
DTD1A: SETZM NAMTAB ;COLLECT NAMES FOR DX, DSK SOURCE
MOVE T1,[XWD NAMTAB,NAMTAB+1]
HLRZM T1,LOCNAM ;[124] SAVE TABLE LOCATION
BLT T1,NAMTAB+23 ;[124] FIRST CLEAR TABLE
SETZM NAMASK ;[124]
MOVE T1,[NAMASK,,NAMASK+1] ;[124]
HLRZM T1,LOCMSK ;[124]
BLT T1,NAMASK+23 ;[124] AND MASK TABLE
DTD4: MOVE 0,FILNAM
JUMPE 0,DTD4A ;FN=0 ILLEGAL
MOVE T1,LOCNAM
MOVEM 0,(T1) ;STORE FILENAME FROM CS
MOVE 0,FILEX ;STORE FILE EXT
MOVEM 0,12(T1) ;TABLE FULL?
MOVE 0,QMASK ;[124]
MOVE T2,LOCMSK ;[124] CORRESPONDING MASK
MOVEM 0,(T2) ;[124] FOR FILENAME
HLLZ 0,QMASK+1 ;[124]
MOVEM 0,12(T2) ;[124] FOR EXTENSION
MOVEI T2,NAMTAB+11
CAMN T2,T1
SOS ESWTCH ;YES
SKIPE ESWTCH ;NO, END OF CS SCAN?
JRST DTD2 ;END OF NAME PROCESSING
AOS LOCMSK ;[124] POINT TO NEXT MASK ENTRY
AOSA T1,LOCNAM ;SET TO STORE IN NEXT SLOT NAMTAB
DTD4A: PUSHJ P,ERR3A
DTD4B: PUSHJ P,DESCRP ;NO, GET NEXT FILENAME FROM CS
TRNE CALFLG,NEWPP!NEWDEV
JRST ERR5A ;ERROR, NEW DEV OR# PP
JRST DTD4
;END OF CS OR NAMTAB FULL
DTD2: PUSHJ P,ININIT ;INIT INPUT FILE
MOVEI T1,1 ;SET TO RETURN DTCOPY+1
JRST DTD5>
SUBTTL DELETE OR RENAME FOR DECTAPE
;ROUTINE TO DELETE OR RENAME FILES ON DTA
DTADR: PUSHJ P,DTCHECK ;GO GET DTA DIRECTORY
MOVE T1,IBF ;CURRENT INPUT BUFFER
USETO OUT,144 ;THIS SHOULD GIVE ERROR MSG
OUTPUT OUT,(T1) ;IF DTA WRITE LOCKED
PUSHJ P,DTCHECK ;GO GET DTA DIRECTORY
PUSHJ P,INFO ;WRITE "FILES DELETED/RENAME
;*********************************************************************
;LOOP TO DELETE/RENAME. FOR (DX) DELETE FILES FROM DTA DIR
;THEN USE REVISED DIRECTORY TO COPY ALL REMAINING FILES
DELE3: PUSHJ P,LOOK ;GET FILE TO DELETE OR RENAME FROM CS
JRST DELE5 ;NO MORE FILES
TRNN FLAG,XFLG ;/X?
PUSHJ P,INFO3 ;PRINT FILENAME-EXT
MOVE T1,DIRST ;GOT A MATCH - PROCESS IT
TRNE FLAG,RFLG ;AND IT IS AT (T5) IN (DTA) DIR
JRST DTRNAM ;RENAME
SETZM (T1) ;DELETE FILENAME IN CORE DIRECT
SETZM 26(T1) ;DELETE EXT
TRNE FLAG,XFLG ;(DX)?
JRST DELE3 ;YES, DON'T ACTUALLY DELETE FILE FROM TAPE
LOOKUP OUT,ZRF ;DO LOOKUP
JRST DELE3 ;SHOULD NEVER FAIL
SETZM DTON ;SET NAME TO ZERO
DELE4: RENAME OUT,DTON ;GET RID OF IT
JRST ERR9 ;SHOULD NEVER HAPPEN EITHER
JRST DELE3 ;GET NEXT FILE NAME
DELE5: MOVE T1,IBF ;LOC OF INPUT BUFFER
TRNE FLAG,XFLG ;DX SWITCH?
JRST DTD6 ;YES, NOW MUST COPY REMAINING FILES
RELEAS CON, ;OUTPUT DELETE OR RENAME INFO TO TTY
JRST MAINB
;ROUTINE TO RENAME FILE ON DECTAPE
DTRNAM: PUSHJ P,RENAME ;SET UP FILE NAME
SETZM DTON+3 ;
SKIPE DTON ;JUST INCASE 0 FILE NAME
LOOKUP OUT,ZRF ;LOOK UP FILENAME-EXT ON OUTPUT DEV
JRST DELE3 ;SHOULD NEVER FAIL
JRST DELE4 ;RENAME TO NEW NAME
;END OF LOOP
;*********************************************************************
;DX SWITCH ON, COPY ALL BUT SPECIFIED FILES. I.E. THOSE NOT DELETED
DTD6: MOVEI T1,0 ;SET TO RETURN TO DTCOPY
DTD5: SETOB 0,FILNAM ;FORCE COPY-ALL
HLLZM 0,FILEX ;BY MAKING FILE-EXT=*.*
SETOM QMASK ;AND MASKS
HLLZM 0,QMASK+1
SETOM OQMASK ;SAME FOR OUTPUT SIDE
HLLZM 0,OQMASK+1
TLO FL,MFLG ;SET FLAG ALSO
PUSHJ P,FNSET ;FIND DETAILS OF FILE-EXT
TRNE AUXFLG,DTAIN ;DTA INPUT
PUSHJ P,DTCH1 ;INIT DIRST,DIRST1
IFN RIMSW, <
TLNE FLAG,RIMFLG ;NO
JRST RIMTB
>
JRST DTCOPY(T1)
SUBTTL SET UP BLOCK FOR RENAME
;SET UP OUTPUT DIRECTORY ENTRY FOR RENAME
;ONLY ONE FILE NAME ALLOWED, BUT MAY BE *.EXT OR FN.*
;ALSO MUST HANDLE WILD CARD MASK
RENAME: SKIPL ESWTCH ;SKIP IF CR,LF SEEN IN C.S.
JRST ERR6A ;ONLY 1 SOURCE FILE DESCRIPTOR ALLOWED
SKIPN T2,NAMTAB ;AN OUTPUT NAME SPECIFIED?
JRST RENAM0 ;NO, USE INPUT
MOVEM T2,DTON ;STORE IT
MOVE 0,OQMASK ;WILD CHARS.
JUMPE 0,.+4 ;NO
ANDCAM 0,DTON ;YES, CLEAR FROM OUTPUT NAME
AND 0,ZRF ;PICKUP FROM INPUT NAME
ORM 0,DTON ;PUT IN OUTPUT
HLLZ 0,NAMTAB+1 ;USER SUPPLIED EXT
MOVEM 0,DTON+1
HLLZ 0,OQMASK+1 ;SAME FOR EXT
JUMPE 0,.+4 ;NO CHARS.
ANDCAM 0,DTON+1
AND 0,ZRF+1
ORM 0,DTON+1
SETZM DTON+2 ;LET MONITOR SUPPLY
POPJ P,
RENAM0: MOVE 0,[XWD ZRF,DTON];NO NAME SET SO USE LOOKUP NAME
BLT 0,DTON+2 ;AND EXT SO FILE NOT DELETED
POPJ P,
SUBTTL GET INPUT FILE SPEC AND MATCH IT TO DIRECTORY
;THIS ROUTINE GETS NEXT FILENAME.EXT FROM CS
;THEN SEES IF ONE IN DIRECTORY MATCHES
;IF IT DOES - EXIT IS CPOPJ1
;NO-MORE-FN.EX-TO-HANDLE-EXIT IS POPJ
;PREPARE ZRF FOR A "LOOKUP" ON THE NEXT REQUESTED FILE.
LOOK: TRNE CALFLG,NSWTCH ;NULL NAME?
TLNN FLAG,TID ;[125] AND TAPE ID SEEN?
JRST LOOK0 ;NO
SETZM GENERI ;YES, SAVES TIME
TRO AUXFLG,REDFLG ;FAKE SO COMMAND WILL BE ERROR FREE
TRO CALFLG,ASTFLG ;SAME AGAIN
POPJ P, ;RETURN TO WRITE ID
LOOK0: TRNE CALFLG,FNEX ;DOES FILNAM, FILEX CONTAIN
JRST LOOK6 ;A FILE TO THINK ABOUT? YES
TRZ FL,ASTFLG ;[173] CLEAR THAT WE'VE SEEN ONE
LOOK01: PUSHJ P,LOOKA ;GET ONE (NOTE: DEVICE MAY ALTER)
POPJ P, ;NONE, END OF CS
;RETURN SKIP FROM LOOKA
LOOK6: MOVE T2,FILEX ;GET FILE EXT INTO T2
SKIPN T1,FILNAM ;FILNAME AND EXT=0?
JUMPE T2,LOOK7C ;FN.EX=0, ONE FILE COPY
TLNE CALFLG,MFLG ;WILD CHAR. MASKING?
JRST LOOK1 ;YES, ALLOW FOR MANY FILES
TRNE AUXFLG,DTAIN+DSKIN ;DONT REQUIRE FILENAME
JUMPE T1,LOOK6C ;HERE FOR 0.EX,FN.EX OR FN.0,0.EX ILLEGAL
LOOK7B: TRZ CALFLG,FNEX ;IF HERE, ONLY ONE FILE WAS ENTAILED IN REQUEST.
TRNN AUXFLG,DTAIN+DSKIN
JRST LOOK4 ;GOT A FILE TO HANDLE
TRNE FLAG,DFLG!RFLG ;/R OR /D ?
JRST LOOK8 ;YES, MUST SCAN DIRECTORY IN THAT CASE
MOVE T1,[FILNAM,,ZRF] ;SET UP NAME AND EXT
BLT T1,ZRF+1 ;IN LOOKUP BLOCK
MOVE T1,PP ;AND PROJ-PROG #
MOVEM T1,ZRF+3 ;ALSO
JRST CPOPJ1 ;OK RETURN
LOOK8: PUSHJ P,PICUP ;GET A FILE (ANY) FROM DIRECTORY
JRST LOOK2 ;[133 COR] WE GOT A FILE, DOES IT MATCH?
TRZ CALFLG,FNEX ;[133 COR] SEE IF A PARTIC. FILE WAS REQUESTED?
LOOK6D:
IFN FTDSK,<SKIPE GENERI ;SEARCHING F/S ?
POPJ P, ;YES, WAIT TIL END OF F/S SEARCH LIST>
TRZN CALFLG,ASTFLG ;DID WE FIND AT LEAST ONE
PUSHJ P,ERR3A ;NO, PRINT MSG.
JRST LOOK ;GET NEXT FILE FROM CS
;CHECK IF FILE.EXT IN DIRECTORY MATCHES FILE TO /D,/R
;NOTE WE MAY HAVE *.EXT,FIL.*, OR *.*
MLOOK2: XOR T1,FILNAM ;XOR TOGETHER
ANDCM T1,QMASK ;MASK
JUMPN T1,LOOK8 ;NO MATCH
MOVE T1,ZRF ;GET GOOD FILENAME
MOVEM T1,FILNAM ;WHERE IT BELONGS
JRST LOOK3
MLOOK3: XOR T1,FILEX
ANDCM T1,QMASK+1
JUMPN T1,LOOK8
MOVE T1,ZRF+1
MOVEM T1,FILEX
JRST LOOK5
LOOK2: TRNN CALFLG,MATFN ;SHOULD FILENAMES MATCH
JRST LOOK3 ;NO
MOVE T1,ZRF ;YES
TLNE CALFLG,MFLG ;MASKING NEEDED?
JRST MLOOK2 ;YES
CAME T1,FILNAM
JRST LOOK8 ;NO MATCH
LOOK3: TRNN CALFLG,MATEX ;SHOULD EXTENSIONS MATCH
JRST LOOK5 ;NO
MOVE T1,ZRF+1 ;YES
TLNE CALFLG,MFLG ;MASKING?
JRST MLOOK3 ;YES
CAME T1,FILEX
JRST LOOK8 ;NO MATCH
LOOK5:
LOOK4: TRO AUXFLG,READ1 ;READY FOR FIRST READ
TRO CALFLG,ASTFLG ;FOUND A FILE *.EXT, F.*,*.*
JRST CPOPJ1 ;MATCH OR NO CARES
LOOK7C: TRNE AUXFLG,DSKIN+DTAIN
JRST LOOK6C ;0.0 ON DIR DEVICE
SETZM ZRF
SETZM ZRF+1
JRST LOOK7B ;0.0 ON NON-DIR. DEV.
LOOK6C: TRNE FLAG,XFLG+DFLG+RFLG ;[217] ONLY PRINT MESSAGE IF /X/R/D
PUSHJ P,ERR3A ;[211] NON /X WILL PRINT LATER
POPJ P, ;[211] GIVE ERROR RETURN IMMEDIATELY
LOOK1: TRNE AUXFLG,DTAIN+DSKIN
JRST LOOK8
SETZM ZRF
SETZM ZRF+1
JRST LOOK4
SUBTTL GET A FILE NAME FROM DTA OR DSK DIRECTORY
;ROUTINE TO GET NEXT FILE NAME FROM DIRECTORY
;FILNAM, FILEX CONTAIN THE FILE NAME. EXT TO BE
;MATCHED WITH DIR. NAMES. PUT SUGGESTED FILE
;NAME EXT IN ZRF, ZRF+1 AND #P-P IN ZRF+3
;NOTE THAT WE HAVE TO HANDLE *.EXT,FILE.*
PICUP:
IFN FTDSK,<TRNN AUXFLG,DSKIN ;DSK INPUT?
JRST PICUP2 ;[130] NO - DTA
TLON FLAG,DSKDBC ;[130COR]HAS DSKIDR BEEN CALLED?
PUSHJ P,DSKDIR ;[130] NO - LOOKUP UFD
SOSLE UFDIN+2 ;[130]
JRST .+3
PICUP1: PUSHJ P,UIN ;INPUT USER'S FILE DIRECTORY
JRST CPOPJ1 ;EOF ON DSK
ILDB 0,UFDIN+1 ;PICK UP FILENAME
JUMPE 0,PICUP1 ;IGNORE NULL
MOVEM 0,ZRF ;SET FILE NAME
MOVE 0,FNPPN
MOVEM 0,ZRF+3 ;SET DSK #P-P
SOS UFDIN+2 ;COUNT DOWN FOR NEXT TIME
ILDB 0,UFDIN+1 ;SET FILE EX
HLLZM 0,ZRF+1
POPJ P,>
PICUP2: MOVE T3,DIRST1 ;SETUP TO CHECK ALL FILENAME SLOTS
ADDI T3,26 ;IN DIRECTORY (22 FILE NAMES)
MOVE T5,DIRST ;LOC OF FIRST/NEXT FILE
PICUP4: ADDI T5,1 ;
CAMLE T5,T3 ;END OF FILE SLOTS?
JRST CPOPJ1 ;END OF FILE NAMES
MOVEM T5,DIRST ;NEXT SLOT TO LOOK AT
MOVE 0,(T5) ;GOT FILE NAME FROM DIRECT
JUMPE 0,PICUP4 ;IGNORE IF 0
MOVEM 0,ZRF
MOVE 0,26(T5) ;GET EXT ETC
HLLZM 0,ZRF+1
POPJ P,
;READ DTA DIR. AND PREPARE T5 TO PICK UP FIRST ENTRY.
DTADIR: PUSHJ P,DTCH2 ;READ DTA DIR INTO INPUT BUF
DTADI1: MOVEI T3,DBUF ;SET BLT FROM INBUF TO DBUF
HRL T3,T5 ;FIRST DATA WORD OF DIRECTORY IN T5
BLT T3,DBUF+176 ;MOVE FROM INBUF TO DBUF
MOVEI T5,DBUF+123-1 ;LOC OF FIRST FILE NAME
MOVEM T5,DIRST ;T5 POINTS TO FILNAME JUST HANDLED
MOVEM T5,DIRST1 ;TO RESTORE DIRST
POPJ P, ;(IE NONE BUT NEXT WILL BE FIRST)
SUBTTL ROUTINE TO OUTPUT FILENAMES THAT WERE DELETED OR RENAMED
;PRINT "FILES DELETED:" OR "FILES RENAMED:"
;ALSO USED TO PRINT "NO FILE NAMED XXX.XXX"
INFO: MOVE T1,TFO ;SETUP TTY FOR OUTPUT
MOVE T2,TFI ;SAVE BUFFER LOCS
PUSHJ P,INICON ;INIT TTY
HRROM T2,TFI ;SET BUFFER LOCS
HRROM T1,TFO
OUTPUT CON,
TLZE AUXFLG,INFOFL ;ERROR PRINT ONLY?
JRST ERR3AA ;YES
TRNN FLAG,DFLG ;DELETE?
JRST INFO1 ;NO, MUST BE RENAME
IFN CCLSW,<SKIPE COMFLG
SKIPG RENSN
SKIP 1
POPJ P,
HRRZM T1,RENSN ;SET POSITIVE>
ERRPN2 </Files deleted:/>
IFN FTDSK,<SETZM BLKSUM ;SET TOTAL TO ZERO>
JRST INFO2
INFO1: IFN CCLSW,<
SKIPE COMFLG ;IF NOT CCL
SKIPL RENSN ;OR FIRST TIME
SKIP 1
POPJ P, ;ONLY PRINT ONCE IF CCL
SETOM RENSN ;DON'T PRINT IT TWICE>
ERRPN2 </Files renamed:/> ;RENAME (/R)
TCRLF:
INFO2: MOVEI CHR,CR ;OUTPUT CR/LF
PUSHJ P,PUTCON ;ON TTY
MOVEI CHR,LF
PUSHJ P,PUTCON
OUTPUT CON,
POPJ P,
;**********************************************************************
;PRINT FILENAME.EXT OR [P,P].UFD OF FILE DELETED
INFO3: MOVEI T3,ZRF ;LOCATION OF FILENAME
PUSHJ P,FN.EX
IFN FTDSK,<TRNE FLAG,DFLG ;SKIP IF /D
TRNN AUXFLG,DSKIN ;AND INPUT DEVICE IS DSK>
JRST INFO2 ;NO
IFN FTDSK,<HLRE DOUT,ZRF+3 ;GET BLOCK SIZE
PUSHJ P,BLKSD ;STORE BLOCK SIZE
JRST INFO2 ;AND CR-LF>
SUBTTL /X OR /D. FIND OUT DETAILS OF FILE NAME AND
;EXTENSION (0 FN.EX=*.*) AND ANY CHANGE IN
;SOURCE DEV. SET BITS IN CALFLG.
FNSET: TRZ CALFLG,ALLCLF ;CLEAR FLAGS ON ENTRY
SKIPN FILNAM
TROA CALFLG,FNEX ;FILENAME = * OR 0
TRO CALFLG,MATFN ;FILENAME MUST BE MATCHED
SKIPN FILEX ;EXT=0?
TRNN AUXFLG, MTAIN+CDRIN+PPTIN+TTYIN ;YES
TROA CALFLG,MATEX ;FILE EXTENSION MUST BE MATCHED
TRO CALFLG,FNEX ;YES
IFN FTDSK,<TRNN AUXFLG,DSKIN
JRST FNSET1
MOVE T2,[XWD JOBPTH,COMPTH] ;[211] FOR 1ST TIME WITH NO PPN USE DEFAULT
TLNN FL,PPSEEN ;[211] SEE A PPN TYPED
SKIPE COMPTH ;[211] AND 1ST TIME THROUGH
SKIPA ;[211] NO
JRST FNSET6 ;[211] YES, SET FOR DEFAULT PATH
SKIPN COMPTH ;[211] SEE IF NOT HERE BEFORE & HAVE PPN
JRST FNSET5 ;[211] YES, SET UP WITH FIRST PPN
MOVEI T2,2 ;[211] START AT PPN FOR COMPARES
FNSET3: MOVE 0,PTHADD(T2) ;[211] GET A PPN OR SFD NAME
CAME 0,COMPTH(T2) ;[211] SEE IF SAME AS PREVIOUS
JRST FNSET4 ;[211] NO, SET NEW PPN FLAG
JUMPE 0,FNSET1 ;[211] YES, SEE IF END OF LIST
AOJA T2,FNSET3 ;[211] NO, MORE TO COMPARE
FNSET4: TRO FL,NEWPP ;[211] SAY WE SAW NEW ONE FOR /XD /R
FNSET5: MOVE T2,[XWD PTHADD,COMPTH] ;[211] COPY SPECIFIED INTO
FNSET6: BLT T2,COMPTH+PTHLEN+3 ;[211] COMPARE AREA FOR NEXT TIME
FNSET2: SETOM COMPTH ;[211] MAKE SURE WE KNOW WE HAVE ONE
>;[211] END IFN FTDSK
FNSET1: MOVE T2,DEVICE
CAME T2,DEVA
TRO CALFLG,NEWDEV ;CHANGE IN SOURCE DEV.
MOVEM T2,DEVA ;SET DEVA=DEVICE
TRNN FLAG,XFLG!RFLG!DFLG ;NEED MULTIPLE FILES FOR THESE
TLNE CALFLG,MFLG ;WILD CHAR.?
TRO CALFLG,FNEX ;YES, SET FOR MULTIPLE FILES
POPJ P,
;POPJ EXIT IF END OF COMMAND STRING, OTHERWISE RESET
;POINTER TO START OF DIRECTORY, READING IN NEW DIR.
;IF DEV OR #P-P CHANGED (EXIT CPOPJ1)
;IF DIR. IS ON DSK RESET BY REINIT.
LOOKA: SKIPE T4,ESWTCH ;MORE C.S.?
POPJ P, ;NO
PUSHJ P,DESCRP ;YES, GET NEXT FN.EX FROM CS
PUSHJ P,INLOOK ;CHECK FOR MTA REQUESTS, MODE
PUSHJ P,M4 ;CHECK FOR /I,/B,/H
HRRZM T4,ININI1 ;SET MODE
RELEAS DIR,
TRNN FLAG,DFLG ;FOR DELETE, ONE SOURCE FILE
JRST LOOKB ;...
TRNE CALFLG,NEWDEV ;ONLY IS PERMITTED
JRST ERR5A
LOOKB: TRNN CALFLG,NEWDEV!NEWPP ;PREPARE TO LOOK FOR NEW FILE
JRST LOOKC ;NAME AT HEAD OF DIRECTORY
PUSHJ P,ININIT ;INIT INPUT FILE
TRNN AUXFLG,DTAIN+DSKIN
JRST CPOPJ1
IFN FTDSK,<TRNN AUXFLG,DTAIN ;DTA INPUT?
JRST LOOKD ;NO, MUST BE DSK>
PUSHJ P,DTADIR ;YES, READ IN DTA DIRECT
LOOKC:
IFN FTDSK,<TRNE AUXFLG,DSKIN ;DSK INPUT?
JRST LOOKD ;YES>
MOVE T5,DIRST1 ;NO, RESET DIRECTORY START
MOVEM T5,DIRST
JRST CPOPJ1
IFN FTDSK,<
LOOKD: PUSHJ P,DSKDIR ;GET USER'S FILE DIRECTORY
SETZM UFDIN+2 ;DSK DIR BUF EMPTY
JRST CPOPJ1>
SUBTTL ROUTINE TO LIST DTA OR DSK DIRECTORIES
DEFINE P6 (A,B)<
MOVEI T2,A ;;NUMBER OF CHARACTERS
MOVE 0,[POINT 6,B] ;;BYTE POINTER TO SIXBIT STRING
PUSHJ P,PDIR2 ;;OUTPUT THE STRING
>
DTPDIR: TROE AUXFLG,ONEOUT ;ONLY DO ENTRY ONCE
JRST DTPDN ;SO MULTIPLE LISTINGS DON'T LOSE
ENTER OUT,DTON ;OUTPUT DEV ENTRY
JRST ERR4 ;DIRECTORY FULL
DTPDN: IFN FTDSK,<
TRNE AUXFLG,FFLG ;/F? SHORT FORM?
SKIPE DEVICE ;INPUT DEVICE SPECIFIED?
JRST PDIR1A ;YES
HRRZI 0,'DSK' ;ASSUME DSK IF NO DEVICE GIVEN
HRLZM 0,DEVICE
TROA AUXFLG,DSKIN ;SET DSK INPUT
PDIR1A: TRNE AUXFLG,DSKIN ;DSK INPUT?
JRST DSKLST ;YES, GO AND TRY TO LIST DSK>
IFN TEMP,<
TRNE CALFLG,TMPI ;LIST TMPCOR DIRECTORY?
JRST TMPLST ;YES>
TRNN AUXFLG,DTAIN ;DECTAPE INPUT?
JRST ERR5 ;NOT DSK OR DTA. ERROR
;ROUTINE TO LIST DTA DIRECTORY. /L OR /F SWITCH
DTALST: PUSHJ P,DTCHECK ;CHECK FOR DTA INPUT-MUST BE DECTAPE AND
;GET DIRECTORY
PUSHJ P,CRLF ;PRINT NO. OF FREE BLOCKS LEFT
MOVE T1,IBF ;START OF BUFFER
MOVE DOUT,200(T1) ;GET POSSIBLE TAPE ID
JUMPE DOUT,NOTPID ;NOT IF ZERO
CAMN DOUT,[-1] ;OR -1
JRST NOTPID ;JUST GARBAGE
P6 9,[SIXBIT /TAPE ID: /]
P6 6,DOUT
PUSHJ P,CRLF ;NEW LINE
NOTPID: SETZ DOUT, ;CLEAR NO. FREE BLOCKS
MOVEI T4,1102 ;OCTAL NO. OF BLOCKS ON DECTAPE
MOVSI T1,(POINT 5,0) ;5 BIT BYTES
HRRZ T5,IBF ;CURRENT INPUT BUFFER
ADDI T1,1(T5) ;POINTER TO 1ST DATA WORD IN DIRECT
PDIR8: SOJLE T4,PDIR1 ;ALL THROUGH?
ILDB T3,T1 ;CALCULATE NO. OF FREE BLOCKS
JUMPN T3,PDIR8
;THIS BLOCK FULL
AOJA DOUT,PDIR8 ;COUNT NO. WITH ZERO IN
PDIR1: P6 6,['FREE: ']
PUSHJ P,OUTDC3 ;PRINT RESULT
P6 6,<[' BLKS,']>
PUSHJ P,DTCH1 ;FIX T5, TO POINT AT BEGIN OF DIR
MOVE T4,T5 ;ANOTHER COPY
MOVEI T2,26 ;NUMBER OF POSSIBLE FILES
MOVEI DOUT,26
SKIPE 123(T4) ;SKIP IF NO FILE THERE
SUBI DOUT,1 ;ONE LESS FREE
ADDI T4,1 ;SET FOR NEXT FILE
SOJG T2,.-3 ;LOOP FOR ALL FILES
PUSHJ P,OUTDC3 ;OUTPUT NUMBER FREE
P6 6,[' FILES']
PUSHJ P,CRLF ;CARRIAGE RET, LINEFEED
SUBTTL LOOP TO EXAMINE FILE NAMES DTA DIRECTORY
PDIR4:
SKIPN 123(T5) ;NULL (=0) FILE NAME?
JRST PDIR6 ;YES SO LOOK FOR ANOTHER
MOVEI T2,6 ;TRANSMIT UP TO 6 CHARACTERS
MOVSI 0,440600+T5 ;SET UP SOURCE BYTE POINTER
HRRI 0,123 ;SET TO PICK UP FILE NAME
SETZ T4,
;FOLLOWING CODE TO OUTPUT PROJ, PROG FILENAME
HLRZ CHR,151(T5) ;GET EXT
CAIE CHR,'UFD' ;UFD?
JRST PDIR4A ;NO
HLRZ DOUT,123(T5) ;PROJ NO.
MOVEI T2,PUT
PUSHJ P,OUTOCT
MOVEI CHR,COMMA ;COMMA
PUSHJ P,PUT
HRRZ DOUT,123(T5) ;PROG NO.
PUSHJ P,OUTOCT
JRST PDIR4B
PDIR4A: PUSHJ P,PDIR2 ;OUTPUT 6-BIT DATA AND INCR DIRECTORY PTR
PDIR4B: HLLZ CHR,151(T5) ;PICK UP EXTENSION
MOVSI 0,440600+T5 ;SET BYTE POINTER
HRRI 0,151 ;PICK UP EXTENSION
MOVEI T2,4 ;PRINT UP TO 4 CHRS. (PERIOD+3*EXT)
JUMPN CHR,.+3 ;EXTENSION NULL?
PUSHJ P,PDIR2A+1 ;YES
SKIP 2 ;NO
MOVEI CHR,PERIOD-40 ;NO, SO PRINT A PERIOD
PDIR3: PUSHJ P,PDIR2A ;OUTPT 6 BIT OR INCR T5
MOVEI CHR,SPACE ;OUTPUT 2 SPACES
PUSHJ P,PUT
PUSHJ P,PUT
TRNE AUXFLG,FFLG ;SHORT FORM DIRECT ?
JRST PDIR3A ;YES VJC 4/16/69
SETZ DOUT, ;CALCULATE NBR OF BLOCKS PER FILE
MOVEI T4,1101
MOVSI 0,(POINT 5,0)
HRRZ T2,IBF
ADDI 0,1(T2)
HRRZ T7,T5
SUBI T7,(T2)
ILDB T6,0 ;LOAD CONTENTS OF S.A.T. BLOCK
CAMN T6,T7 ;COMPARE WITH FILE SLOT NBR
ADDI DOUT,1 ;ADD 1 TO COUNT IF EQUAL
SOJG T4,.-3
PUSHJ P,OUTDC3 ;OUTPUT NBR OF BLOCKS PER FILE
MOVEI CHR,TAB
PUSHJ P,PUT
MOVE 0,151(T5) ;GET ENTRY DATE
ANDI 0,7777 ;LEFT BITS ARE IRRELEVENT
MOVEI T2,1 ;[132] SET UP TO TEST FOR HIGH ORDER BITS
TDNE T2,0(T5) ;[132] WHICH ARE LOW ORDER BITS IN DIR.
IORI 0,1B23 ;[132] ON SO SET BIT IN DATE
TDNE T2,^D22(T5) ;[132] REPEAT FOR EACH BIT
IORI 0,1B22 ;[132] ...
TDNE T2,^D44(T5) ;[132] ...
IORI 0,1B21 ;[132] ...
PUSHJ P,DATOUT ;OUTPUT THE DATE
PDIR3A: PUSHJ P,CRLF ;GIVE CR,LF 4/16/69
PDIR6: HRRZ T1,IBF ;PROCESS NEXT ENTRY
SUBM T5,T1
CAIL T1,26 ;FILE "NUMBER" OK?
JRST MAIN1 ;NO, END OF ENTRIES
AOJA T5,PDIR4 ;END OF LOOP, GET NEXT FILENAME
IFN FTDSK,<
CLRF: SOS LIN>
CRLF: MOVEI CHR,CR ;OUTPUT CAR. RET.
PUSHJ P,PUT
MOVEI CHR,LF ;LINE FEED
JRST PUT
PDIR2: ILDB CHR,0 ;ROUTINE TO OUTPUT 6-BIT DATA
TRNN 0,-1 ;PRINT SPACES WHEN PRINTING THE FREE BLOCKS
PDIR2A: JUMPE CHR,PDIR21 ;TERMINATE ON SPACE
ADDI CHR,40 ;CONVERT TO 7 BIT
PUSHJ P,PUT ;OUTPUT CHARACTER
ADDI T4,1
SOJG T2,PDIR2 ;COUNT DOWN MAX-CHARS COUNTER
PDIR21: POPJ P, ;CONTINUE
SUBTTL DATE OUTPUT FOR DIRECTORY
;OUTPUT THE DATE FOUND IN AC 0.
DATOUT: MOVEI T2,PUT ;PUT CHAR IN OUT
IDIVI 0,^D31
MOVEI T3,1(1)
IDIVI 0,^D12
MOVE DOUT,T3 ;DOUT=DAY
PUSHJ P,OUTDC1 ;PRINT DAY
PUSHJ P,DATO2 ;PRINT -MONTH-
MOVE DOUT,0
ADDI DOUT,^D64 ;DOUT=YEAR
CAIL DOUT,^D100 ;[132] AFTER YEAR 2000?
SUBI DOUT,^D100 ;[132] YES, KEEP IT CORRECT FOR NEXT 100 YEARS
OUTDC1: SKIPA DOUT+1,TWL ;RADIX 10
;*******************************************************************
;ROUTINE TO CONVERT OCTAL TO ASCII
;DOUT CONTAINS OCTAL VALUE ON ENTRY
OUTOCT: MOVEI DOUT+1,10 ;RADIX 8
PRNUMA: HRRZM DOUT+1,T4
MOVEI CHR,"0"
CAMGE DOUT,DOUT+1 ;PRINT AT LEAST 2 DIGITS
PUSHJ P,(T2) ;PUT OR PUTCON
PRN: IDIVI DOUT,(T4) ;DIVIDE BY RADIX
HRLM DOUT+1,(P) ;SAVE NO. FOR PRINT
JUMPE DOUT,.+2 ;ENUF DIGITS?
PUSHJ P,PRN ;NO, GET MORE
HLRZ CHR,(P) ;YES, GET LEFTMOST
ADDI CHR,60 ;CONVERT TO ASCII
JRST (T2) ;PUT OR PUTCON
OUTDE4: MOVEI CHR," " ;SET UP FOR SPACES
CAIL DOUT,^D1000 ;PRINT 4 CHAR.
JRST OUTDC1 ;AT LEAST 4 SEEN
PUSHJ P,(T2) ;OUTPUT ONE SPACE
CAIGE DOUT,^D100 ;3 CHAR.?
PUSHJ P,(T2) ;NO,SO ANOTHER SPACE
JRST OUTDC1
OUTDC3: MOVEI CHR," " ;GET A SPACE READY
CAIGE DOUT,^D100 ;LESS THAN 3 CHAR.
PUSHJ P,PUT ;YES, COMPENSATE WITH A SPACE
OUTDEC: MOVEI T2,PUT ;PUT CHAR IN OUT BUF
JRST OUTDC1
DATO2: MOVEI T4,5
MOVE T6,MNPT
ADDM 1,T6
ILDB CHR,T6
PUSHJ P,(T2) ;PUT OR PUTCON
SOJG T4,.-2
POPJ P,
SUBTTL DTA DIRECTORY READ
;READ DTA DIRECTORY AND INITIALIZE DIRST AND DIRST1
DTCHECK:PUSHJ P,ININIT ;INITIALIZE INPUT DEVICE
DTCH2:
USETI IN,144 ;GET DTA DIR
PUSHJ P,INP ;INPUT DIRECTORY
CLOSE IN, ;FINISHED WITH CHAN FOR NOW
DTCH1: HRRZ T5,IBF ;LOC. OF CURRENT BUF, 2ND WORD
MOVEI 0,123(T5) ;83 WORDS,7, FIVE-BIT BYTES
ADDI T5,1 ;COMPUTE ADD. OF DIR. START
MOVEM 0,DIRST ;FIRST FILE NAME LOC
MOVEM 0,DIRST1 ;TO RESTORE DIRST
POPJ P,
;ROUTINE TO CHECK BRACKET COUNT/MATCHING
OUTCHK: SETZB T3,TLBRKT ;COUNT <> ON THIS LINE, CLEAR THINGS
MOVE T1,OPTRA ;BYTE POINTER FOR READING OUT THE LINE
OUTCH2: CAMN T1,OPTR ;LINE DONE?
JRST OUTCH3 ;YES, SO DECIDE WHETHER TO PRINT
ILDB T2,T1 ;GET CHAR
CAIN T2,"<" ;LEFT BRACKET?
AOS TLBRKT ;YES, SO INCREMENT BRACKET COUNT
CAIN T2,">" ;RIGHT BRACKET?
SOSL TLBRKT ;YES, SUBTRACT BRACKET COUNT, GONE NEG?
JRST OUTCH2 ;NO, SO DO NEXT CHAR
AOJA T3,OUTCH2 ;YES, SO FLAG COUNT GONE NEG.
OUTCH3: SKIPN T2,TLBRKT ;BRACKET COUNT OFF THIS LINE?
JUMPE T3,CPOPJ ;NO, WENT NEG.?
ADDM T2,TOTBRK ;YES, SO ADD INTO CUMULATIVE COUNT
MOVEI CHR,"-" ;PRINT MINUS FOR NEG TOTAL
SKIPGE TOTBRK
PUSHJ P,PUT
MOVM DOUT,TOTBRK;PRINT MAGNITUDE OF TOTAL
PUSHJ P,OUTDEC
MOVEI CHR,TAB ;FOLLOW WITH TAB
PUSHJ P,PUT
JRST OUTCH1 ;AND PRINT THE LINE
SUBTTL ROUTINE TO FIND FILE TYPE AND SET MODE
FILTYP: TDNE FLAG,[XWD IFLG+IBFLG,BMOD]
POPJ P, ;BIN MODE DON'T CARE IF DMP, ETC
TLZ AUXFLG,SBIN ;CLEAR BINARY FLAG
TDNN FLAG,[XWD PFLG!WFLG,LINE!TBMOD!NSMOD!SQMOD!SPMOD]
TLNE AUXFLG,CDRFLG ;/E FROM DSK IS NOT BINARY
JRST FIL2 ;SO TURN OFF SBIN
TRNN FLAG,XFLG ;NO CONCATENATION ALLOWED
TRNN CALFLG,COMAFL ;CONCATENATION, SO TAKE IT SLOWLY
TRNN AUXFLG,DSKIN!DTAIN!MTAIN ;BINARY INPUT POSSIBLE?
JRST FIL11 ;NO
TRNE AUXFLG,DSKOUT!DTAOUT!MTAOUT ;BINARY OUTPUT?
JRST FIL3 ;YES, USE BINARY MODE
FIL11: HLLZS ZRF+1 ;CLEAR RIGHT HALF
MOVE T1,[-TYTLEN,,TYPTAB]
FIL11A: HLLZ 0,(T1) ;GET AN EXT
CAMN 0,ZRF+1 ;MATCH?
JRST FIL3 ;YES, USE BINARY
HRLZ 0,(T1) ;TRY OTHER
CAMN 0,ZRF+1
JRST FIL3
AOBJN T1,FIL11A ;NO, KEEP TRYING
HLLZS DTON+1 ;CLEAR RIGHT HALF INCASE NOT ZERO
MOVE T1,[-TYTLEN,,TYPTAB]
FIL11B: HLLZ 0,(T1) ;GET AN EXT
CAMN 0,DTON+1 ;MATCH?
JRST FIL3 ;YES, USE BINARY
HRLZ 0,(T1) ;TRY OTHER
CAMN 0,DTON+1
JRST FIL3
AOBJN T1,FIL11B ;NO, KEEP TRYING
TRNN FLAG,XFLG ;DO NORMAL PROCESSING ON ALL
JRST FIL2 ;BUT DMP ETC FILES IF NOT /X
POPJ P, ;NO SIGNIFICANT SWITCHES
TYPTAB: 'SHR',,'HGH'
'SAV',,'LOW'
'XPN',,'SVE'
'REL',,'CHN'
'DMP',,'BIN'
'RIM',,'RTB'
'RMT',,'BAC'
'BUG',,'CAL'
'DAE',,'DCR'
'MSB',,'OVR'
'QUC',,'QUE'
'QUF',,'SFD'
'SYS',,'UFD'
'EXE',,'UNV'
TYTLEN==.-TYPTAB
FIL4: TLO AUXFLG,RSDCFL ;SET REL,SAV,DMP,CHN FLAG
FIL1: HRLZI 0,004400 ;FORCE 36-BIT.
HLLM 0,IBF+1 ;INPUT BYTE POINTER
HLLM 0,OBF+1 ;OUTPUT BYTE POINTER
TRNE AUXFLG,DSKOUT!DTAOUT!TTYOUT!MTAOUT ;[210] CDP OR PTP?
POPJ P, ;CHANGE TO FORCED BINARY
CLOSE OUT, ;[210] PUNCH BLANK TAPE OR CARD
MOVEI 0,14 ;[210] CHANGE TO BINARY MODE
HRRM 0,OMOD ;[210] PUT IN OPEN BLOCK
OPEN OUT,OMOD ;[210] REOPEN
OUTPUT OUT, ;[210] DUMMY OUTPUT
POPJ P, ;[156]
FIL3: TLO AUXFLG,SBIN ;INPUT EXT = DMP,SAV,CHN,REL
TRNE FLAG,XFLG
JRST FIL1
TLON AUXFLG,FRSTIN ;NOT /X TEST FURTHER
JRST FIL4 ;IS THIS FIRST SOURCE, YES
TLOE AUXFLG,RSDCFL ;NOT FIRST, WAS PREVIOS FILE RSCD?
JRST FIL1 ;ENSURE BINARY AT ALL TIMES
OUTPUT OUT, ;NO CHANGE TO 36-BIT
MOVE 0,OBF+2 ;CURRENTLY 7-BIT I/O, MUST CHANGE TO 36-BIT
;OUTPUT CURRENT BUFFER
IDIVI 0,5 ;DIVIDE OBF+2 BY 5 (CHAR. COUNT)
MOVEM 0,OBF+2
JRST FIL1
FIL2: TLOE AUXFLG,FRSTIN ;NOT A RSCD FILE
TLZN AUXFLG,RSDCFL ;NO, WAS PREV. FILE RSCD?
POPJ P, ;NO, NO CHANGE
OUTPUT OUT, ;YES, CHANGE 36-BIT TO 7-BIT
MOVEI 0,5
IMULM 0,OBF+2
MOVE 0,SVIBF ;RESTORE 7-BIT
HLLM 0,IBF+1
MOVE 0,SVOBF
HLLM 0,OBF+1
TRNE AUXFLG,DSKOUT!DTAOUT!TTYOUT!MTAOUT ;[210] CDP OR PTR?
POPJ P,
CLOSE OUT, ;[210] PUNCH BLANK TAPE OR CARD
SETZM OMOD ;[210] CHANGE MODE TO ASCII
OPEN OUT,OMOD ;[210] REOPEN AS ASCII
OUTPUT OUT, ;[210] DUMMY OUTPUT
POPJ P, ;[156]
SUBTTL ROUTINES TO HANDLE DEVICE TMPCOR:
IFN TEMP,<
;ZERO TMPCOR DIRECTORY
TMPZRO: MOVE T1,[XWD 5,TMPNAM]
PUSHJ P,TMPXCT
JRST TMPNAV ;ONLY GETS HERE IF NO TMPCOR
JRST PIP2 ;GET NEXT COMMAND
;LIST TMPCOR DIRECTORY
TMPLST: SETZ T1, ;0 TO GET FREE SPACE
TMPCOR T1, ;GET IT
JRST TMPNAV ;NO TMPCOR IN THIS MONITOR
MOVE 0,T1 ;GET WORD COUNT
PUSHJ P,OCTLS2 ;OUTPUT IT
LSTLIN TMPHDR ;AND MESSAGE
MOVE T1,[XWD 4,TMPNAM]
PUSHJ P,TMPXCT
JRST MAIN1 ;SHOULD NEVER HAPPEN
JUMPLE T1,MAIN1 ;DIRECTORY EMPTY
MOVNS T1 ;GET - WORD COUNT
HRL T5,T1 ;MAKE AOBJN WORD
TMPLS2: HLLZ 0,(T5) ;GET NAME
PUSHJ P,SIXOUT ;OUTPUT IT
PUSHJ P,TABOUT ;AND A TAB
HRRZ 0,(T5) ;GET WORD COUNT
PUSHJ P,OCTLS2 ;OUTPUT IN OCTAL
PUSHJ P,CRLF ;NEW LINE
AOBJN T5,TMPLS2
JRST MAIN1 ;END OF DIRECTORY
;INPUT ONE FILE FROM TMPCOR
TMPIN: SKIPL ESWTCH ;MORE COMMAND
JRST TMPERR ;YES
MOVE T1,[XWD 1,TMPNAM]
PUSHJ P,TMPXCQ
JRST [PUSHJ P,ERR3A ;ERROR
PUSHJ P,GETEND;DELETE CCL FILE
JRST PIP2]
TROE AUXFLG,ONEOUT ;ONLY DO ENTRY ONCE
JRST TMPIN1 ;DONE ALREADY
TRNE CALFLG,TMPO ;[146] TMP:-TO-TMP: XFER?
JRST TMITMO ;[146] YES -- DO TMPCOR OUTPUT
ENTER OUT,DTON ;ENTER FILE IN CASE DIRECTORY DEV.
JRST ERR4 ;FAILURE
TMPIN1: HRLI T5,440700 ;MAKE A BYTE POINTER
IMULI T1,5 ;WORD COUNT
ADDI T1,1 ;BONUS FOR SOSGE
SOJLE T1,MAIN1 ;JUMP WHEN DONE
ILDB CHR,T5 ;GET CHARACTER
PUSHJ P,PUT ;OUTPUT IT
JRST .-3 ;LOOP 'TIL DONE
;[146] ROUTINE TO WRITE TMPCOR FILE FROM TMPCOR FILE
TMITMO: MOVE T2,DTON ;[146] GET OUTPUT FILE NAME
MOVEM T2,TMPNAM ;[146] PUT IN TMPCOR BLOCK
MOVN T2,T1 ;[146] GET NEGATIVE NO. OF WORDS READ
HRLZS T2,T2 ;[146] PUT IN LH
HRRM T5,T2 ;[146] GET BEGINNING ADDR OF FILE READ
SUBI T2,1 ;[146] MAKE IT AN IOWD
MOVEM T2,TMPNAM+1 ;[146] SET UP TMPCOR BLOCK
MOVE T1,[XWD 3,TMPNAM] ;[146] SET UP TO WRITE FILE
TMPCOR T1, ;[146] DO IT
JRST TMPFUL ;[146] NO TMPCOR UUO
JRST MAIN1 ;[146] RETURN
;DELETE ONE FILE FROM TMPCOR
TMPDEL: TRNE FLAG,RFLG!XFLG
JRST TMPERR
MOVE T1,[XWD 2,TMPNAM]
PUSHJ P,TMPXCQ
JRST [PUSHJ P,ERR3A
PUSHJ P,GETEND
JRST PIP2]
ERRPNT </File deleted: />
PUSHJ P,P6BIT ;OUTPUT FILE NAME
FILNAM
PUSHJ P,TCRLF ;OUTPUT CR-LF
JRST PIP2
;OUTPUT ONE FILE TO TMPCOR
TMPOUT: MOVE T1,DTON ;OUTPUT FILE NAME
MOVEM T1,TMPNAM ;FOR TMPCOR
SETZ T1, ;GET FREE WORD
PUSHJ P,TMPXCT ;DO IT
JRST TMPNAV ;NO TEMPCOR
MOVEM T5,TMPNAM+1 ;SAVE START
HLL T5,IBF+1 ;FORM BYTE POINTER
HRRZ T2,.JBFF ;TOP OF BUFFER
INPTMP: PUSHJ P,INP ;GET A BUFFER FULL
PUSHJ P,TTYZ ;CHECK TTY FOR EOF
TRNE IOS,EOFBIT ;CHECK FOR EOF ON ALL DEVICES
JRST TMPEOF ;YES IT WAS
TMPILP: SOSGE IBF+2 ;ANYTHING IN BUFFER?
JRST INPTMP ;NO, GET MORE
ILDB T1,IBF+1 ;GET A CHARACTER
CAIGE T2,(T5) ;TOO MANY CHARS.?
JRST TMPFUL ;YES, ERROR
IDPB T1,T5 ;DEPOSIT CHAR
JRST TMPILP ;LOOP
TMPEOF: HRRZ T5 ;CLEAR OUT BYTE POSITION
SUB T5,TMPNAM+1 ;TOTAL NO OF WORDS
MOVNS T5 ;NEGATE IT
HRLM T5,TMPNAM+1 ;MAKE IOWD
MOVE T1,[3,,TMPNAM] ;SET TO WRITE
TMPCOR T1, ;DO IT
JRST TMPFUL ;FAILED, NOT ENOUGH ROOM
JRST PIP2 ;ONLY ONE BUFFER ALLOWED
;SET UP AND XCT TMPCOR UUO
TMPXCQ: MOVE T2,FILNAM ;GET FILE NAME
SKIPE QMASK ;CANN'T HANDLE WILD CHARS. YET
JRST TMPERR ;YES
MOVEM T2,TMPNAM ;PUT IN LOOKUP BLOCK
TMPXCT: MOVSI T2,-200 ;ALLOW 200 WORDS
HRR T2,.JBFF ;WHERE TO PUT CHARS.
HRRZ T5,.JBREL ;GET TOP OF CORE
CAIGE T5,200(T2) ;WILL BUFFER FIT IN
JRST [ADDI T5,200 ;ASK FOR ENUF CORE
CORE T5, ;TRY TO GET IT
JRST OMODER ;FAILED
JRST .+1] ;OK NOW
MOVEM T2,TMPNAM+1 ;STORE IN LOOKUP BLOCK
SOS TMPNAM+1 ;MAKE AN IOWD
TMPCOR T1, ;THIS IS IT
POPJ P, ;ERROR RETURN
MOVE T5,T1 ;NUMBER OF WORDS
ADD T5,.JBFF ;FIX UP JOBFF JUST IN CASE
EXCH T5,.JBFF ;PUT START OF BUFFER IN T5
JRST CPOPJ1 ;AND SKIP RETURN
TMPERR: ERRPNT </?Command not yet supported for TMPCOR!/>
TMPFUL: ERRPNT </?Not enough room in TMPCOR:!/>
TMPHDR: ASCIZ / TMPCOR words free
/
TMPNAV: ERRPNT </?TMPCOR not available!/>
>
SUBTTL BLOCK 0 CODE
;THIS CODE COPIES BLOCK 0,1,2 ONLY. I/O MUST BE DECTAPE.
;MODE SELECTED MUST BE BIT 100, 20 AND NOT DUMP MODE (134).
BLOCK0: TRC AUXFLG,DTAIN+DTAOUT
TRCE AUXFLG,DTAIN+DTAOUT;FORCE DTA I/O
JRST ERR7A
MOVEI 0,134
MOVEM 0,OMOD
MOVEM 0,ININI1
MOVSI 0,OBF
MOVEM 0,ODEV+1
MOVEI 0,IBF
MOVEM 0,DEVICE+1
OPEN OUT,OMOD
JRST ERR1 ;UNAVAILABLE
OUTBUF OUT,1
OUTPUT OUT,
OPEN IN,ININI1
JRST ERR1A
INBUF IN,1
SETZB T1,BL0CNT
BL4: USETI IN,(T1)
INPUT IN, ;READ
GETSTS IN,IOS
TRNN IOS,740000 ;ANY ERRORS
JRST BL1 ;NO
JSP T5,INICN2
PUSHJ P,QUEST
ERRPN2 </Input device />
PUSHJ P,P6BIT
DEVICE
ERRPN2 </: />
MOVE T2,AUXFLG ;DECTAPE FOR ERROR MESSAGE
ANDI T2,DTAIN
PUSHJ P,IOERR ;PRINT ERROR TYPE
BL1: HRLZ T5,IBF+1
HRR T5,OBF+1
MOVEI T4,177(T5)
BLT T5,(T4) ;SHIFT DATA TO OUTPUT BUFFER
USETO OUT,@BL0CNT
OUTPUT OUT, ;WRITE BLOCK
PUSHJ P, OUTP1 ;CHECK ERRORS
AOS T1,BL0CNT
CAIGE T1,3
JRST BL4
BL3: RELEASE OUT, ;IF ANY, PDL IS RESET
JRST PIP2
SUBTTL MAGTAPE ROUTINES
;TEST TO SEE IF MORE THAN ONE OF THE LOWEST EIGHT MTA FLAGS
;HAVE BEEN SELECTED. IF SO ERROR. OTHERWISE, IMPLEMENT
;REQUEST. T1, T3, T6 SET AT ENTRY BY INLOOK OR OUTLOOK
;TO EQUAL AUX/AUXOUT, AB/ABOUT,INIMTA/INOMTA
MT1: HRRZ T2,T1 ;T1 CONTAINS REQUEST
ANDI T2,-1(T2) ;KNOCK OFF RIGHT MOST 1
TRNE T2,377
JRST MTR1 ;PRINT ERROR MESSAGE
TRNN T1,MTAFLG+MTBFLG+MTWFLG+MTTFLG+MTFFLG+MTUFLG+MTDFLG+MTPFLG
JRST MTC1
CAIN T6,INOMTA ;OUTPUT DEVICE?
TRNE CALFLG,DVSWTH ;YES, AN EXPLICIT DEVICE?
JRST .+2 ;INPUT DEVICE, OR EXPLICIT OUTPUT ONE
JRST ERR8 ;NOT OUTPUT DEVICE SEEN
PUSHJ P,(T6) ;THERE IS A REQUEST
;GO TO INIMTA/INOMTA
;PERFORM POSITIONING REQUESTS
TRNE T1,MTUFLG
JRST UNLOAD
TRNE T1,MTWFLG
JRST REWIND
TRNE T1,MTFFLG
JRST MARKEF
TRNE T1,MTTFLG
JRST SLEOT
TRNE T1,MTBFLG+MTPFLG ;MULTIPLE REQUESTS ALLOWED
JRST BSPF
TRNE T1,MTAFLG+MTDFLG ;MULTIPLE REQUESTS ALLOWED
JRST ADVF
;T1=AUX,AUXOUT. T3=AB,ABOUT. T6=INIMTA,INOMTA.
MTCONT: RELEAS TAPE,
TRNN T1,MTUFLG ;UNLOAD?
TRNE CALFLG,NSWTCH ;IS THERE AN INPUT DEVICE?
CAIE T6,INOMTA ;OUTPUT TAPE?
POPJ P, ;NO
JRST PIP2 ;YES, END OF COMMAND
;ROUTINE TO CHECK AND SET DENSITY FOR NEW DEVICE
MTC1: MOVE T4,T1 ;GET AUX/AUXOUT
ANDI T4,MT2FLG+MT5FLG+MT8FLG
ANDI T4,-1(T4) ;REMOVE RIGHT MOST 1
JUMPN T4,MTR1 ;MORE THAN 1 REQ, ERROR
MOVEI T4,1 ;ASCII LINE STANDARD MODE
TRNE T1,MT2FLG
TRO T4,DENS2 ;SET 200 BPI
TRNE T1,MT5FLG
TRO T4,DENS5 ;SET 556 BPI
TRNE T1,MT8FLG
TRO T4,DENS8 ;SET 800 BPI
TRNE T1,MTEFLG
TRO T4,PARE ;EVEN PARITY
POPJ P,
;REWIND AND UNLOAD
UNLOAD: MTAPE TAPE,11
JRST MTCONT
;REWIND ONLY
REWIND: MTAPE TAPE,1
MTWAIT: WAIT TAPE,
JRST MTCONT
;MARK END OF FILE
MARKEF: MOVE T5,MTANAM
EXCH T5,ODEV
MTAPE TAPE,3
GETSTS TAPE,IOS
PUSHJ P,OUTP3
SETSTS TAPE,(IOS)
MOVEM T5,ODEV
JRST MTCONT
;SKIP TO LOGICAL END OF TAPE.
SLEOT: MTAPE TAPE,10
JRST MTWAIT
;BACKSPACE MTA 1 FILE, T3=AB OR ABOUT
;AB/ABOUT = INPUT/OUTPUT DEVICE
BSPF: HRRE T3,T3 ;T3=NO. OF FILES/RECORDS TO BACK
MOVEI T5,7 ;BSPR
TRNN T1,MTPFLG ;BSPR?
MOVEI T5,17 ;BSPF
BSPF2: WAIT TAPE, ;WAIT
STATO TAPE,LDP ;AT LOAD POINT?
JRST BSPF3 ;NOT LDP
ERRPNT </?Load point before end of backspace request!/>
BSPF3: MTAPE TAPE,(T5) ;BACKSPACE FILE/RECORD
SOJGE T3,BSPF2 ;MORE FILES/RECORDS TO BSP?
;NO, END OF LOOP
WAIT TAPE,
GETSTS TAPE,IOS
TRNN T1,MTBFLG ;BACKSPACE FILE?
JRST MTCONT ;NO
TRNN IOS,LDP ;IF AT LOAD POINT
MTAPE TAPE,16 ;(MOVE FWD. OVER EOF)
JRST MTCONT ;DON'T SKIP A RECORD
;ADVANCE MTA 1 FILE, T3=AB OR ABOUT
;AB/ABOUT = INPUT/OUTPUT DEVICE
ADVF: HLRE T3,T3 ;T3=NO. FILES (OR REC) TO ADVANCE
MOVEI T5,6 ;ADVR
TRNN T1,MTDFLG ;ADVR ?
MOVEI T5,16 ;ADVF
MTAPE TAPE,(T5) ;ADVANCE FILE/RECORD
SOJG T3,.-1 ;MORE FILES/RECORDS TO ADV?
;NO, END OF LOOP
SKIPGE T3 ;WAS ITEXPLICIT ZERO
MTAPE TAPE,7 ;YES , POSITION BEFORE EOF MARK
WAIT TAPE, ;WAIT...
GETSTS TAPE,IOS
TRZE IOS,EOFBIT
SETSTS TAPE,(IOS) ;END OF FILE
JRST MTCONT
;ROUTINE TO INITIALIZE MAGTAPE FOR INPUT OR OUTPUT
INOMTA: SKIPA T2,ODEV ;INIT OUTPUT DEVICE
INIMTA: MOVE T2,DEVICE ;INIT INPUT DEVICE
SETZM MTANAM+1
MOVEM T2,MTANAM
TRNN CALFLG,NEWDEV
JRST INMTA ;SAME DEVICE
PUSHJ P,MTC1 ;NEW DEVICE
HRRZM T4,INMTA1 ;SET MODE,DENSITY,PARITY
INMTA: OPEN TAPE,INMTA1
JRST ERR1B
POPJ P,
;ROUTINE TO PRINT ERROR MSG IF MORE THAN 1/8 FLAGS SET
MTR1: MOVE T4,DEVICE ;TENTATIVELY SET I/DEV
CAIE T6,INIMTA ;INPUT DEVICE?
MOVE T4,ODEV ;NO, SET O/DEV
ERRPNT </?Too many requests for />
PUSHJ P,P6BIT
T4
JRST PIP2
SUBTTL CONSTANTS/STORAGE/VARIABLES
;CONSTANTS
OKBD: POINT 6,DTON+2,23 ;FOR NO. 1K BLOCKS
OKB: POINT 6,ZRF+2,23
DATE: POINT 12,ZRF+2,35
DATED: POINT 12,DTON+2,35 ;CREATION DATE /X
XDATE: POINT 3,ZRF+1,20 ;[132] HIGH ORDER PART
XDATED: POINT 3,DTON+1,20 ;[132] ...
ZRO: ASCII /00000/
OPTRA: XWD 700,LBUF-1 ;INITIAL POINTER TO LINE BUFFER
K1: 432150643240 ;MAGIC ASCII INCREMENT BY 10
K3: 375767737576 ;CHARACTER MASK 077
K4: 432150643216 ;MAGIC ASCII INCREMENT BY 1
TWL: OCT 12
IFN FTDSK,<
PRPTL: POINT 9,PROTS,8 ;PROTECTION FOR RENAME
PRPTD: POINT 9,DTON+2,8
PRNM: POINT 9,ZRF+2,8 ;PROT FOR /R
TIME: POINT 11,ZRF+2,23 ;CREATE TIME /X
TIMED: POINT 11,DTON+2,23 ;DEPOSIT CREATE TIME
ADATE: POINT 15,FILNAM+1,35 ;[132] 15 BIT ACCESS DATE
CTIME: POINT 11,FILNAM+2,23 ;CREATION TIME
CDATE: POINT 12,FILNAM+2,35 ;CREATION DATE
XCDATE: POINT 3,FILNAM+1,20 ;[132] HIGH ORDER BIT
PROT: POINT 9,FILNAM+2,8 ;PROTECTION
MODE: POINT 4,FILNAM+2,12 ;RECORDING MODE
>
MONTH: ASCII /-Jan-/
ASCII /-Feb-/
ASCII /-Mar-/
ASCII /-Apr-/
ASCII /-May-/
ASCII /-Jun-/
ASCII /-Jul-/
ASCII /-Aug-/
ASCII /-Sep-/
ASCII /-Oct-/
ASCII /-Nov-/
ASCII /-Dec-/
MNPT: POINT 7,MONTH
;PROGRAM STORAGE AREA
SWSEG
LOW:
IFN TEMP,<
TMPPNT: BLOCK 1
TMPFLG: BLOCK 1
TMPEND: BLOCK 1
TMPFIL: BLOCK 2
TMPNAM: BLOCK 2 >
BL0CNT: BLOCK 1 ;COUNT
IFN CCLSW,<
CFI: BLOCK 3 ;STORED COMMAND INPUT HEADER
CFILE: BLOCK 4 ;NAME OF STORED CCL COMMAND FILE
COMFLG: BLOCK 1 ;-1 IF STORED COMMANDS,0 IF TTY>
SVIBF: BLOCK 1 ;SAVE INIT MODE (INPUT)
SVOBF: BLOCK 1 ;SAVE INIT MODE (OUTPUT)
IBF: BLOCK 3 ;INPUT BUFFER HEADER
OBF: BLOCK 3 ;OUTPUT BUFFER HEADER
OBI: BLOCK 3 ;OUTPUT BUFFER INPUT HEADER FOR DSK /Z
TFI: BLOCK 3 ;CONSOLE INPUT HEADER
TFO: BLOCK 3 ;CONSOLE OUTPUT HEADER
SAVAC: BLOCK 5 ;SAVE SOME ACS
NAMTAB: BLOCK 24 ;FOR (XD) ON DSK OR RENAME
NAMASK: BLOCK 24 ;[124] CORRESPONDING NAMTAB MASK
IFN FTDSK,<
JOBPPN: BLOCK 1 ;[163] OUR PPN
SYSPPN: BLOCK 1 ;[163] PPN OF SYS:
MFDPPN: BLOCK 1 ;[163] PPN OF MFD
DEVPP: BLOCK 1 ;[163] PPN OF CURRENT ERSATZ
TDSK: BLOCK 1 ;[163] LAST DEV: RETURNED IN STR SEARCH
LOCNAM: BLOCK 1 ;POINTER FOR NAMTAB
>;[163] END IFN FTDSK
LOCMSK: BLOCK 1 ;[124] LOC OF MASK TABLE
DIRST: BLOCK 1 ;LOC. OF LAST DIR. FILE NAME REFERENCED
DIRST1: BLOCK 1 ;SAVE INITIAL DIRST
SQNUM: BLOCK 1 ;CURRENT SEQUENCE NUMBER
DTJBFF: BLOCK 1 ;VALUE OF JOBFF AFTER CONSOLE I/O BUFFERS
SVJBFF: BLOCK 1 ;INITIAL VALUE OF JOBFF
SVJBF1: BLOCK 1 ;VALUE OF JOBFF AFTER OUTBUF UUO
OPTR: BLOCK 1 ;CURRENT POINTER FOR LINE PRESCAN
DTONSV: BLOCK 2 ;OUTPUT DIRECTORY ENTRY COPY
SVPTR1: BLOCK 1 ;POINTER TO LAST PRINTING CHARACTER
SVPTR2: BLOCK 1 ;POINTER TO LAST GENERATED TAB
TLBRKT: BLOCK 1 ;TOTAL PARENS ON THIS LINE
TOTBRK: BLOCK 1 ;TOTAL CUMULATIVE PARENS
TABCT: BLOCK 1 ;SPACES TO NEXT TAB STOP
SPCT: BLOCK 1 ;CONSECUTIVE SPACES COUNTER
ABOUT: BLOCK 1 ;AB FOR OUTPUT UNIT
AUXOUT: BLOCK 1 ;AUX FOR OUTPUT UNIT
PROTS: BLOCK 1 ;SAVE PROTECTION
CDRCNT: BLOCK 1 ;COUNT CARD COLS.
PTRPT: BLOCK 1 ;STORE SEQ. NO. POINTER
;THIS IS A BLOCK OF VARIABLE LOCATIONS, ZEROED AT THE START OF EACH
;PIP RUN, I.E EACH TIME PIP TYPES *.
FZERO==.
;***** DO NOT SPLIT THIS BLOCK *****
IFN FTDSK,<
RIBFIR: BLOCK 1 ;NUMBER OF WORDS IN LOOKUP
PPN: BLOCK 1 ;PROJ-PROG FOR EXTENDED LOOKUP>
FILNAM: BLOCK 1 ;FILE NAME FROM COMMAND SCANNER
FILEX: BLOCK 1 ;EXTENSION
PR: BLOCK 1 ;PROTECTION
PP: BLOCK 1 ;P-P NUMBER TYPED BY USER
IFN FTDSK,<BLOCK 20+RIBFIR-.> ;TOTAL LENGTH OF LOOKUP BLOCK
;***** END OF BLOCK *****
DTON: BLOCK 4 ;OUTPUT DIR. ENTRY
DEVA: BLOCK 1 ;SAVE INPUT DEV. NAME
NO.: BLOCK 1 ;GENERATE FILE NAMES
ZRF: BLOCK 4 ;LOOKUP FILE NAMES
MTAREQ: BLOCK 1 ;STORE MTA REQUESTS
COMEOF: BLOCK 1 ;EOF INDICATOR
COMCNT: BLOCK 1 ;COMBUF CHARS COUNT
COMPTR: BLOCK 1 ;POINTER FOR STORING/EXTRACTING CS
AUX: BLOCK 1 ;COPT AUXFLG (MTA)
IFN FTDSK,<
PPP: BLOCK 1 ;PERMANENT PPN
FNPPN: BLOCK 1 ;RESERVE #P-P
UFDPPN: BLOCK 1 ;[211] PPN FOR LSTU8 TO PRINT FROM, MAY BE PATH
ESWTCH: BLOCK 1 ;-1 INDICATES END OF LINE
XNAME: BLOCK 1 ;-1 INDICATES SCAN OVERSHOOT WITH A NULL NAME
;0 INDICATES NO SCAN OVERSHOOT
;CONTAINS OVERSHOOT NAME IF NOT NULL
AB: BLOCK 1 ;MTA VALUE SWITCHES
PTHADD: BLOCK 1 ;FIRST ADDRESS OF FULL PATH
PTHSCN: BLOCK 1 ;SCAN SWITCH
PTHPPN: BLOCK 1 ;PATH PPN
PTHSFD: BLOCK PTHLEN+1 ;SFD LIST + 0
DEFPTH: BLOCK PTHLEN+4 ;DEFAULT PATH
PTHOUT: BLOCK PTHLEN+4 ;OUTPUT PATH
WRKPTH: BLOCK PTHLEN+4 ;[207] WORK AREA FOR PATHING
COMPTH: BLOCK PTHLEN+4 ;[211] COMPARE SAVE AREA TO SEE IF NEW PPN TYPED
SAVPTH: BLOCK PTHLEN+4 ;[211] INPUT PATH SAVE AREA FOR /Z
CHKPTH: BLOCK 3 ;[147] TO CHECK REAL PPN OF FILE
MATCH: BLOCK 2 ;NAME AND EXT FOR /L OR (RX)
TAPEID: BLOCK 1 ;TAPE ID IN SIXBIT
QMASK: BLOCK 2 ;MASK FOR MATCHING FILE NAME AND EXT
OQMASK: BLOCK 2 ;SAME BUT FOR OUTPUT
STRARG: BLOCK 3 ;ARGUMENTS FOR GOBSTR UUO
GENERI=STRARG+2 ;FILE STRUCTURE NAMES IF GENERIC DSK
LZERO==.-1 ;THIS IS THE END OF THE INIT. ZEROED BLOCK.
PDL: BLOCK 20 ;PUSHDOWN LIST
LBUF: BLOCK 204 ;LINE BUFFER. ALLOW FOR FORTRAN DATA
LBUFE: BLOCK 1 ;ALLOW FOR OVERFLOW
DBUF: BLOCK 204 ;DIRECTORY BUFFER
OMOD: BLOCK 1 ;OUTPUT DEVICE MODE, STATUS
ODEV: BLOCK 2 ;OUTPUT DEVICE NAME
;BUFFER HEADER(S) LOC
ININI1: BLOCK 1 ;INPUT DEVICE
DEVICE: BLOCK 2
IFN CCLSW,<
RENSN: BLOCK 1 ;-1 IF RENAME MESSAGE SEEN
RUNDEV: BLOCK 1 ;RUN UUO DEVICE
RUNFIL: BLOCK 3 ;FILE NAME
RUNPP: BLOCK 2
CCLINI: BLOCK 3 ;CCL INPUT DEVICE OPEN BLOCK>
DEVERR: BLOCK 1
DERR2: BLOCK 2
INMTA1: BLOCK 1
MTANAM: BLOCK 2
IFN FTDSK,<
ADSK1: BLOCK 1 ;OPEN DIRECTORY, MODE
ADSK: BLOCK 2 ;FILENAME, EXT
LIN: BLOCK 1 ;COUNT FOR DSK DIR LIST
PGCNT: BLOCK 1 ;COUNT OF PAGES FOR DSK DIR
UFDIN: BLOCK 3 ;HEADER FOR READING DISK DIRECTORY
UFD: BLOCK 4 ;[P,P] OR *FD*
;UFD OR SYS
BLKSUM: BLOCK 1 ;TOTAL NBR BLOCKS PER PROJ. PROG NBR
LEVEL: BLOCK 1 ;-2 IF LEVEL D DISK SERVICE
JOBPTH: BLOCK PTHLEN+4 ;DEFAULT JOB PATH
DEVPTH: BLOCK 3 ;[203] AREA FOR DOING PATH. ON DEVICE
>
IFN RIMSW,<
CHKSM: BLOCK 1 ;CHECKSUM ACCUMULATED (RIM10B)
POINTA: BLOCK 1 ;SAVE POINTER FOR RIM10B BLOCK
LENGTH: BLOCK 1 ;CALC. LENGTH OF RIM10 FILE
ZERO: BLOCK 1 ;NO OF 0'S NEEDED TO FILL SPACES IN
COUNT: BLOCK 1 ;RIM10B COUNT WORDS OUT
XFERWD: BLOCK 1 ;RIM-10-B XFER WD. ;FILE.
>
VAR ;JUST IN CASE
LOWTOP: ;LAST DATA LOCATION PLUS ONE
SWSEG
SUBTTL RIM LOADER
IFE RIMSW,<
RIMTB: ERRPNT <Z? /Y switch option not available this assembly!Z>
XLIST>
IFN RIMSW,<
LODAL==16 ;LENGTH OF RIM LOADER
HLTBIT==200 ;CHANGES JRST TO HALT
BLKSZ==17 ;NORMAL BLOCK LENGTH IN RIM10B
.JBDA==140 ;START OF USER AREA
RIMTB: TRNN AUXFLG,DTAIN!DSKIN!MTAIN
JRST ERR5B
PUSHJ P,ININIT
OUTPUT OUT,
PUSHJ P,FNSET ;SEE WHAT WE HAVE FOR FILNAM.EXT
TRNN CALFLG,FNEX ;SINGLE FILE SPECIFICATION?
JRST [MOVE 0,[FILNAM,,ZRF] ;YES, DON'T READ DIRECTORY
BLT 0,ZRF+3 ;SET UP FILE NAME,EXT, AND PPN
SETZM GENERI ;JUST IN CASE
JRST RIMTB0+2]
TRNE AUXFLG,DTAIN
PUSHJ P,DTADIR
IFN FTDSK,<
TRNE AUXFLG,DSKIN
PUSHJ P,DSKDIR>
RIMTB0: PUSHJ P,LOOK ;GET FILE TO CONVERT
JRST MAIN1 ;NONE LEFT
IFN FTDSK,<PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT>
LOOKUP IN,ZRF
JRST ERR3
MOVEI 0,254000
HRLM 0,XFERWD ;ASSUME JRST
HLRZ 0,ZRF+1
CAIN 0,'RTB'
JRST RIMTB1
CAIE 0,'SAV'
CAIN 0,'RMT'
JRST RIMTB2
JRST ERR3B ;NO LEGAL EXTENSION - SAVE JOBFF TOO
RIMTB1: MOVE T1,OBF+1 ;PUNCH RIM10B LOADER
HRLI T1,RMLODA
AOS T2,T1 ;XFER IT TO OUTPUT BUFFER
BLT T1,LODAL(T2)
ADDI T2,LODAL
HRRM T2,OBF+1 ;FIX BUFFER POINTER
MOVNI T2,LODAL
ADDM T2,OBF+2 ;AND COUNTER
CLOSE OUT, ;BLANK TAPE
RIMTB2: PUSHJ P,RINP ;GET FIRST BUFFER
JRST ERR8A ;FILE OF ZERO LENGTH
JUMPGE CHR,ERR8A ;FIRST WORD MUST BE POINTER
HLRZ 0,ZRF+1
CAIN 0,'SAV'
JRST RIMTB4 ;"SAV" FILE
MOVEI T2,^D126(CHR) ;FIND VALUE OF .JBSA
MOVEI T3,.JBDA-1
CAMGE T2,T3 ;(JOBDA) IS FIRST LOC. OF USER PROF,
JRST ERR8A ;NO, ERROR
MOVE T1,IBF+1
MOVEI T3,.JBSA
PUSHJ P,RMS1
HRRM CHR,XFERWD ;SAVE TRANSFER WORD
MOVEI T3,.JBFF
MOVE T1,IBF+1
PUSHJ P,RMS1
HRRZM CHR,LENGTH ;SAVE (JOBFF)
HLRZ 0,ZRF+1
CAIN 0,'RTB' ;RIM 10B CONVERSION
JRST RIMTB4
;RIM10 1ST WD IS -N,X X IS 1ST WORD IN DATA BLOCK
;CONTAINING FIRST NON-ZERO WORD AFTER END
;OF JOBDATA AREA, FROM THERE TO JOBFF GIVES
;VALUE OF N. XFER ADD. COMES FROM JOBSA.
RMT1: MOVEI T1,.JBDA ;FIRST LOC. AVAILABLE TO USER
LDB CHR,IBF+1
SUBI T1,1(CHR)
JUMPLE T1,RMT2 ;CURRENT "X" GT OR EQ JOBDA
HLRO T2,CHR
MOVNS T2 ;GET "N"
AOJ T1, ;GET REL. LOC. OF JOBDA IN BLOCK
CAMG T1,T2
JRST RMT2
AOJ T2, ;NOT IN BLOCK, TRY NEXT
ADDM T2,IBF+1
MOVNS T2
ADDM T2,IBF+2 ;READY TO GET NEXT POINTER
JRST RMT1
RMT2: LDB CHR,IBF+1 ;POINTS TO FIRST USEFUL I/O WORD
MOVNI T1,(CHR)
ADDB T1,LENGTH
MOVNS T1 ; -N
HRLM T1,POINTA
HRRM CHR,POINTA ;(-N,X) IN POINTA
SETZM ZERO
;NOW OUTPUT RIM10 FILE. IBF+1 POINTS TO FIRST I/O WORD. POINTA HAS I/O
;WORD FOR FILE. LENGTH = NO. WDS TO GO OUT INCLUDING XFER WD.
;COUNT COUNTS NO. WDS IN CURRENT LOGICAL BLOCK
;ZERO COUNTS ZERO FILL
MOVE CHR,POINTA
PUSHJ P,PUT ;PUNCH I/O WORD
RMT8: LDB CHR,IBF+1 ;-N,X
MOVEM CHR,POINTA
HLRO T1,CHR
MOVNM T1,COUNT
RMT6: SETZ CHR, ;PUNCH ZERO IF NECESSARY
SOSL ZERO
JRST RMT4 ;DEPOSIT ZERO
SOSGE COUNT
JRST RMT5 ;GET NEW LOGICAL BLOCK
PUSHJ P,RINP1
JRST ERR8A
RMT4: SOSG LENGTH
JRST RIMTB8
PUSHJ P,PUT
JRST RMT6
RMT5: HRRZ T1,POINTA
HLRO T2,POINTA
SUBM T1,T2
PUSHJ P,RINP1
JRST RMT9
JUMPGE CHR,RIMTB8
HRRZ CHR,CHR
SUB CHR,T2
JUMPL CHR,ERR8A
MOVEM CHR,ZERO
JRST RMT8
RMT9: MOVE CHR,LENGTH
SOJ CHR,
MOVEM CHR,ZERO
SETZ CHR,
RMT10: SOSGE ZERO
JRST RIMTB8
PUSHJ P,PUT
JRST RMT10
;RIM10B: COMES FROM RTB AND SAV FILES. SAV=RTB EXCEPT IT HAS NO
;RIM LOADER AND NO TRANSFER WORD
RIMTB3: PUSHJ P,RINP1 ;NONE, GET NEW POINTER
JRST RIMTB8 ;EOF
JUMPL CHR,RIMTB4 ;POINTER WORD
CAME CHR,XFERWD ;IS IT FINAL JRST XXX
JRST ERR8A ;NO,ERROR
JRST RIMTB8 ;YES,OUTPUT IT
RIMTB4: LDB CHR,IBF+1
HRRZM CHR,POINTA ;LOAD WORDS HERE
HLROM CHR,COUNT
MOVNS COUNT ;NO. WDS IN THIS BLOCK
RIMTB7: SKIPN T1,COUNT ;ANY WORDS LEFT IN BLOCK?
JRST RIMTB3 ;NONE
SETZM CHKSM ;INITIALIZE CHECKSUM
CAIL T1,BLKSZ
MOVEI T1,17
MOVN T2,T1 ;T1 HAS NO. OF WDS TO GO OUT
ADDM T2,COUNT ;ADJUST COUNT
HRL CHR,T2
HRR CHR,POINTA ;I/O WD IN CHR
ADDM T1,POINTA ;SET POINTA FOR NEXT TIME
ADDM CHR,CHKSM ;ADD I/O WD TO CHECKSUM
RIMTB5: PUSHJ P,PUT ;PUTPUT I/O WORD
SOJL T1,RIMTB6 ;FINISHED THIS BLOCK
PUSHJ P,RINP1 ;GET DATA
JRST ERR8A ;EOF (ILLEGAL)
ADDM CHR,CHKSM ;CHECKSUM
JRST RIMTB5
RIMTB6: MOVE CHR,CHKSM
PUSHJ P,PUT
OUTPUT OUT,
JRST RIMTB7
RIMTB8: MOVE CHR,XFERWD ;EOF HERE, XFERWD=JOBSA
TRNN CHR,-1
TLO CHR,HLTBIT
HLRZ 0,ZRF+1
CAIN 0,'SAV' ;NO XFER WD FOR "SAV" FILES
JRST RIMA
PUSHJ P,PUT
SETZ CHR,
PUSHJ P,PUT ;TRAILING ZERO
OUTPUT OUT,
RIMA: CLOSE IN,
TRNN FLAG,XFLG
JRST MAIN1 ;END OF SINGLE FILE
CLOSE OUT,
JRST RIMTB0
;THIS IS THE I/O SECTION
RINP: PUSHJ P,INP
TRNE IOS,EOFBIT ;EOF?
POPJ P, ;EOF EXIT
RINP1: SOSGE IBF+2
JRST RINP
ILDB CHR,IBF+1
JRST CPOPJ1
RMS2: SUB T1,T4 ;(IBF+1)+N
AOJ T1,
RMS1: LDB CHR,T1 ;GET POINTER
HRRZ T2,CHR ;X
HLRO T4,CHR ;-N
SUB T2,T4 ;X+N IN T2
CAMGE T2,T3
JRST RMS2
SUBI T3,(CHR) ;HOW FAR FROM POINTER?
ADD T1,T3 ;INCREMENT POINTER
LDB CHR,T1 ;(JOBSA/FF)
POPJ P,
;THIS IS THE RIM LOADER FOR THE PDP-10
RMLODA: PHASE 0
XWD -16,0
ST:! CONO PTR,60
ST1:! HRRI A,RD+1
RD:! CONSO PTR,10
JRST .-1
DATAI PTR,@TBL1-RD+1(A)
XCT TBL1-RD+1(A)
XCT TBL2-RD+1(A)
A:! SOJA A,
TBL1:! CAME CKSM,ADR
ADD CKSM,1(ADR)
SKIPL CKSM,ADR
TBL2:! HALT ST
AOBJN ADR,RD
ADR:! JRST ST1
CKSM:! BLOCK 0
DEPHASE>
LIST
IFE FTDSK,< END PIP1>
SUBTTL DISK DELETE AND RENAME ROUTINES
;* * * ALL THE FOLLOWING ARE DISK ROUTINES * * *
;DISK DELETE AND RENAME ROUTINES
SYN AB,STRCNT ;SOMEWHERE TO COUNT NO. OF F/S SEEN
SYN MTAREQ,SAVSTR ;FIRST F/S NAME SEEN
DSKDR0: SKIPE PP ;[211] SEE IF INPUT PPN GIVEN
JRST DSKDRD ;[211] YES, GO TRY OUTPUT
MOVE T1,DTON+3 ;[211] NO, USE OUTPUT
MOVEM T1,PP ;[211]
MOVS T1,[XWD PTHADD,PTHOUT] ;[211] AND USE OUTPUT PATH
BLT T1,PTHADD+PTHLEN+3 ;[211]
DSKDRD: SKIPN DTON+3 ;[211] SEE IF OUTPUT PPN GIVEN
SKIPN PP ;[211] NO, WAS INPUT?
JRST DSKDRE ;[211] NO, LET BOTH DEFAULT
MOVE T1,[XWD PTHADD,PTHOUT] ;[211] USE INPUT PATH FOR BOTH
HRRZM T1,DTON+3 ;[211] POINT TO PATH
BLT T1,PTHOUT+PTHLEN+3 ;[211] COPY INPUT PATH OVER
DSKDRE: ;[211]
PUSHJ P,ININIT ;GET DSK AS INPUT DEVICE
TLO FLAG,DSKDBC ;[163] SAVE TIME BY NOT CALLING DSKDIR AGAIN
PUSHJ P,DSKDIR ;GET USER'S FILE DIRECTORY
PUSHJ P,INFO ;PRINT FILES DELETED:/RENAMED:
DSKDR5: PUSHJ P,LOOK ;PREPARE FOR LOOKUP/ENTER
;OF FILE TO /D OR /R
JRST DSKDR1 ;ALL THROUGH WITH UFD
TRNN FLAG,DFLG ;ONLY MAKE NON-AMBIGUITY CHECK FOR /D
JRST DSKDR ;/R WILL ALWAYS FAIL
TRC CALFLG,MATEX!MATFN
TRCE CALFLG,MATEX!MATFN
JRST DSKDR+1 ;YES MUST NOT BE AMBIGUOUS
TLNN CALFLG,MFLG ;TEST FOR ???
DSKDR: PUSHJ P,INITFS ;INITIALIZE THE F/S SEARCH LIST
JRST DSKDR6 ;LEVEL C, OR NOT GENERIC "DSK"
SETOM STRCNT ;START WITH -1
PUSH P,DEVICE ;SAVE DSK DEVICE
DSKDR3: PUSHJ P,NXTFS ;GET NEXT F/S
JRST RENFIN ;NO MORE
PUSH P,ZRF+3 ;SAVE PPN
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
LOOKUP IN,ZRF ;TRY THIS F/S
JRST DSKDRG ;[250] LOOKUP FAILED, GO SEE WHAT ERROR
PUSHJ P,CHKPPN ;[147] SEE IF FILE'S PPN IS OK
JRST DSKDRF ;[147] WRONG PPN -- DON'T TOUCH
MOVE 0,STRCNT ;GET COUNT
AOS STRCNT ;INCRENENT COUNT
JUMPL 0,[MOVE 0,GENERI
MOVEM 0,SAVSTR ;SAVE FIRST F/S
JRST DSKDRF] ;AND CONTINUE
JUMPG 0,DSKDRA ;NOT FIRST TIME
ERRPN2 </?Ambiguous /> ;GIVE MESSAGE
PUSHJ P,P6BIT ;PRINT
SAVSTR ;FIRST F/S
PUSHJ P,TYPSTR ;AND :
DSKDRA: PUSHJ P,P6BIT ;PRINT THIS F/S
GENERI
PUSHJ P,TYPSTR ;FOLLOWED BY COLON SPACE
JRST DSKDRF ;[250] SKIP THE FOLLOWING
DSKDRG: HRRZ T7,ZRF+1 ;[250] GET ERROR CODE FROM LOOKUP
CAILE T7,1 ;[250] FILE NOT FOUND, DON'T PRINT ERROR
CAIN T7,23 ;[250] SFD NOT FOUND, DON'T PRINT ERROR
JRST DSKDRF ;[250] 0,1,23
PUSHJ P,DERR5R ;[250] SOMETHING ELSE, PRINT ERROR
DSKDRF: POP P,ZRF+3 ;PUT PPN BACK
JRST DSKDR3 ;TRY NEXT F/S
TYPSTR: MOVEI CHR,":" ;FOLLOW WITH COLON
PUSHJ P,PUTCON
MOVEI CHR," " ;AND A SPACE
JRST PUTCON ;POPJ RETURN
;[147] THIS RTN CHECKS THE FILE'S PPN AGAINST THE USER'S PPN
;[147] OR THE PPN EXPLICITLY SPECIFIED BY THE USER
CHKPPN: MOVEI 0,IN ;[147] SET UP TO GET PPN OF FILE
MOVEM 0,CHKPTH ;[147] TO COMPARE WITH PPN IN LOOKUP BLK
MOVE 0,[XWD 3,CHKPTH];[147] JUST NEED 3 WORDS
PATH.
JRST CPOPJ1 ;[147] CAN'T PATH.: ASSUME PPN OK
MOVE 0,-1(P) ;[147] GET PPN SPECIFIED BY LOOKUP
SKIPN 0 ;[211] SEE IF ANY
MOVE 0,JOBPTH+2 ;[211] NO, WERE USING JOB'S DEFAULT
TLNE 0,-1 ;[217] SEE IF IT IS A PATH ADDRESS
JRST CHKPP1 ;[217] NO, SKIP
ADDI 0,2 ;[217] YES, CONVERT IT TO A PPN
MOVE 0,@0 ;[217] GET ACTUAL PPN
CHKPP1: ;[217]
CAMN 0,CHKPTH+2 ;[236] SEE IF EQUAL TO FILE'S PPN
JRST CPOPJ1 ;[236] YES, WIN
HLLZS ZRF+1 ;[236] NO, CLEAR DATE TO FILE NOT FOUND CODE
SETZM ZRF+2 ;[236] TO BE SUPER SURE FOR DATE75
POPJ P, ;[236] ERROR RETURN
DSKR6I: MOVE 0,SAVSTR ;[163] USE SAVED STRUCTURE
PUSH P,DEVICE ;[163] SAVE FOR LATER
MOVEM 0,DEVICE ;[163] FOR SPEED AND TO ALLOW RENAMES
PUSHJ P,ININIT ;[163] GO INIT INPUT
POP P,DEVICE ;[163] GET IT BACK
DSKDR6: PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
MOVE 0,ZRF+3 ;[217] GET WHATEVER IS BEING USED
MOVEM 0,DTON+3 ;[217] AND SAVE IT FOR DELETE (RENAME IS DIFF)
LOOKUP IN,ZRF ;IS SOURCE FILE THERE?
JRST DERR5 ;ERROR
IFN LEVELC,< ;[207]
SKIPL LEVEL ;[171] DON'T DO CLOSE IF LEVEL D
CLOSE IN, ;YES
>;[207] END IFN LEVELC
TRNN FLAG,DFLG ;DELETE?
JRST DSKDR4 ;NO, RENAME
SETZM DTON ;YES
JRST DSKDR7
RENFIN: POP P,DEVICE ;GET DSK DEVICE BACK
MOVE 0,STRCNT ;GET COUNT
JUMPL 0,DERR5 ;NOT EVEN ONE FOUND
JUMPE 0,DSKR6I ;UNIQUE, DO RENAME/DELETE
SETZM ZRF+3 ;CLEAR PPN IN LOOKUP BLOCK
JRST DSKDR9 ;SINCE TOO MANY F/S
DSKDR4: PUSHJ P,RENAME
MOVE 0,ZRF+2 ;GET DATE,MODE,PROT ETC.
MOVEM 0,DTON+2 ;SAVE AS BEFORE
LDB 0,XDATE ;[132] HIGH ORDER BIT
DPB 0,XDATED ;[132] ...
LDB 0,[POINT 9,NAMTAB+2,8]
TLNE AUXFLG,NSPROT ;USE THE CURRENT PROTECTION
DPB 0,PRPTD ;UNLESS NEW PROT. SPECIFIED
MOVE 0,ODEV ;[231] CHECK FOR ERSATZ DEVICES
PUSHJ P,PSYSP ;[231] USING ERSATZ DEVICE ROUTINE
SKIPE T1,DEVPP ;[231] SEE IF THERE WAS ONE
MOVEM T1,NAMTAB+3 ;[231] YES, SAVE IT AS OUTPUT PPN
SKIPE T1 ;[231] FOR BOTH PATH AND NO PATH
MOVEM T1,PTHOUT+2 ;[231]
MOVE T1,NAMTAB+3 ;[222] GET SPECIFIED OUTPUT PPN
SKIPE JOBPTH ;[222] USE IT IF NO PATH. IN MONITOR
MOVEI T1,PTHOUT ;[222] HAS PATH., USE OUTPUT PATH
TLNN T1,-1 ;[222] SEE IF WE HAVE A PATH POINTER
SKIPE JOBPTH ;[222] YES, SEE IF SMALL MONITOR
SKIPA ;[222] NO, LEAVE ALL ALONE
MOVE T1,2(T1) ;[222] YES, USE PPN WITHOUT PATH BLOCK
MOVEM T1,DTON+3 ;[222] AND SAVE IT ALL IN RENAME BLOCK
MOVE 0,[XWD JOBPTH,PTHOUT] ;[222] SINCE THE CURRENT MONITOR
SKIPN PTHOUT+2 ;[222] CANNOT HANDLE A RENAME WITH A ZERO
SKIPE PTHOUT+3 ;[222] PATH BLOCK, WE MUST CHECK FOR THAT
SKIPA ;[222] AND COPY IN THE DEFAULT PATH IF
BLT 0,PTHOUT+PTHLEN+3 ;[222] THIS IS THE CASE.
HLRZ T1,DTON+1 ;[202] HACK HACK HACK HACK
CAIN T1,'UFD' ;[202] HACK TO CHECK FOR UFD RENAME
SETZM DTON+3 ;[202] IT IS, ZERO PPN
DSKDR7: RENAME IN,DTON
JRST [PUSHJ P,DERR7 ;OUTPUT ERROR CODE
JRST DSKDR5] ;AND CONTINUE
DSKDR9: PUSHJ P,INFO3 ;PRINT FILENAME DELETED/RENAMED
JRST DSKDR5
DSKDR1: TLZ AUXFLG,NSPROT ;NON-ST. PROT FIXED
SOS ESWTCH ;ENSURE ESWTCH NEGATIVE
SKIPE DOUT,BLKSUM ;GET TOTAL FREED BLOCKS
TRNN FLAG,DFLG ;BUT ONLY IF /D
JRST DSKDR2 ;BOTH NOT TRUE
MOVEI T2,PUTCON ;ON TTY
PUSHJ P,OUTDC1 ;OUTPUT IN DECIMAL
ERRPN2 </ Blocks freed/>
PUSHJ P,TCRLF ;FINISH WITH CR-LF
SETZM BLKSUM ;CLEAR RUNNING TOTAL
DSKDR2: RELEAS CON,
JRST MAIN1
SUBTTL DISK /Z
;ZERO DSK DIRECTORY OF ALL POSSIBLE FILES. IF ANY ARE PROTECTED, GIVE
;A MESSAGE AND DO NOT PROCESS ANY OTHER SWITCHES.
DSKZRO: SKIPE T1,ODEV ;GET REAL DSK
MOVEM T1,ADSK ;SO AS TO INIT CORRECT F/S
MOVE 0,[XWD PTHADD,SAVPTH] ;[211] SAVE INPUT PATH
BLT 0,SAVPTH+PTHLEN+3 ;[211]
MOVS 0,[XWD PTHADD,PTHOUT] ;[211] AND COPY OUTPUT OVER TO
BLT 0,PTHADD+PTHLEN+3 ;[211] INPUT FOR ALL LOOKUPS
PUSHJ P,DIRSK1
INBUF OUT,1 ;FOR LOOKUPS ON OUT
DSKZ1: SOSLE UFDIN+2
SKIP 2
DSKZ3: PUSHJ P,UIN
JRST DSKZ4 ;[211] GO COPY INPUT PATH BACK
ILDB 0,UFDIN+1
JUMPE 0,DSKZ3
MOVEM 0,ZRF
MOVEM 0,DTON ;INCASE OF FAILURE
SOS UFDIN+2
ILDB 0,UFDIN+1
HLLZM 0,ZRF+1 ;EXTENSION
MOVE 0,FNPPN
MOVEM 0,ZRF+3
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
LOOKUP OUT,ZRF
JRST [PUSHJ P,DERR5R ;ERROR
JRST DSKZ1] ;IGNORE RENAME TO ZERO
IFN LEVELC,< ;[211]
SKIPL LEVEL ;[211] SKIP CLOSE FOR LEVEL D
CLOSE OUT,
>;[211] END IFN LEVELC
SETZM ZRF
MOVE 0,FNPPN
MOVEM 0,ZRF+3
PUSHJ P,SETPTH ;SEE IF FULL PATH
MOVEM 0,ZRF+3 ;NON-SKIP RETURN, USE IT
RENAME OUT,ZRF
PUSHJ P,DERR7Z
JRST DSKZ1 ;REPEAT
DSKZ4: MOVS 0,[XWD PTHADD,SAVPTH] ;[211] COPY INPUT PATH BACK
BLT 0,PTHADD+PTHLEN+3 ;[211] WHERE IT BELONGS
POPJ P, ;[211] AND CONTINUE
SUBTTL LEVEL D FILE STRUCTURES AND ERSATZ STRUCTURES
;ROUTINES TO HANDLE LEVEL D FILE STRUCTURES
;TO INITIALIZE THE SEARCH LIST
INITFS: SKIPN LEVEL ;ONLY IF LEVEL D
POPJ P, ;LEVEL C - NON-SKIP RETURN
SETZM GENERI ;CLEAR INCASE OF ERROR RETURN
TRZ AUXFLG,SYSFLG ;[163] CLEAR ALL: BIT
MOVEI 0,ADSK ;ADDRESS OF DEVICE
DSKCHR 0, ;SEE IF DSK
POPJ P, ;NOT LEVEL D DSK
TLNE 0,(7B17) ;GENERIC DEVICE DSK
POPJ P, ;NO
PUSH P,T1 ;[163]
MOVE T1,ADSK ;[200] GET THE GENERIC DEVICE NAME
MOVEM T1,TDSK ;[200] SAVE THE ORIGINAL
DEVNAM T1, ;[200] CONVERT ANY LOGICALS FOR ALL:
JFCL ;[200] IN CASE
MOVS T1,T1 ;[200] SWAP FOR COMPARE
CAIN T1,'NUL' ;[201] CHECK ON NUL:
JRST ININUL ;[201] YUP, DO IT W/O SEARCH
MOVSM T1,DEVPTH ;[203] PUT DEVICE IN PATH BLOCK
MOVE 0,[XWD 3,DEVPTH];[203] SET FOR PATH
PATH. 0, ;[203] GET DEVICE'S SEARCH LIST
JRST INIFSO ;[203] NO PATH., CHECK PPN
LDB T1,[POINT 3,DEVPTH+1,29];[214] GET SEARCH LIST BITS
JRST @[INIFS1 ;[203] SET PROPER LIST - 0=NON-STANDARD
INIFS1 ;[203] 1=JOB'S
INIALL ;[203] 2=ALL:
INISUS ;[203] 3=SYS:
INIFS1 ;[203] 4=NOT DEFINED
INIFS1 ;[203] 5=NOT DEFINED
INIFS1](T1) ;[203] 6=NOT DEFINED
INIFSO: ;[203] PATH. FAILED, TRY AN OLDER WAY
MOVE 0,DEVPP ;[163] GET ITS PPN
CAME 0,JOBPPN ;[163] SEE IF IT'S OURS
JRST INISYS ;[163] NO, GO SEE IF SYS: SEARCH LIST
CAIN T1,'ALL' ;[163] YES, SEE IF IT'S ALL:
INIALL: ;[203] SET FOR ALL: FROM PATH.
TROA AUXFLG,SYSFLG ;[163] YES, SET SPECIAL SEARCH FLAG
INIFS1: SETOM GENERI ;[163] SET FOR INITIAL STRUCTURE
SETOM STRARG ;[163] AND OUR SEARCH LIST
INIFS2: SETOM STRARG+1 ;[163] USE OUR SEARCH LIST (UNLESS STRARG=0)
POP P,T1 ;[163] RESTORE SAVED AC
JRST CPOPJ1 ;GIVE SKIP RETURN
ININUL: POP P,T1 ;[201] DEVICE NUL:, GET T1 BACK
POPJ P, ;[201] AND GIVE NON SEARCH RETURN
;TO INITIALIZE SYSTEM SEARCH LIST
INISYS: CAIN T1,'LIB' ;[163] HERE WHEN DEVPP DOESN'T MATCH OUR
JRST INIFS1 ;[163] PPN, BUT LIB: USES OUR SEARCH LIST
CAIN T1,'ALL' ;[200] SEE IF ALL: FOR SOMEONE ELSE
TROA AUXFLG,SYSFLG ;[200] YES, SAY SO AND LEAVE GENERI 0
INISUS: ;[203] SET SYS: SEARCH LIST FROM PATH.
SETOM GENERI ;[163] FOR INITIAL FILE
SETZM STRARG ;[163] ON SYSTEM SEARCH LIST
JRST INIFS2 ;[163]
;TO FIND NEXT F/S IN SEARCH LIST
NXTFS: TRNE AUXFLG,SYSFLG ;[163] SEE IF DOING ALL:
JRST NXTSYS ;[163] YES, IT'S DIFFERENT
MOVEI 0,STRARG ;[163] SET ADDRESS OF STR LIST, LENGTH 3
SKIPE GENERI ;FINISHED IF IT IS ZERO
GOBSTR 0, ;GET FILE STRUCTURE
TDZA 0,0 ;ERROR
MOVE 0,GENERI ;GET DEVICE
CAMN 0,[-1] ;MIGHT BE MISSING FENCE, CHECK FOR END
JRST NOFNCE ;IT WAS
NXTFS1:
JUMPE 0,ENDFS ;FINISHED
MOVEM 0,DEVICE ;FOR RETRIEVAL INFO
PUSHJ P,ININIT ;INIT
JRST CPOPJ1 ;GIVE SKIP RETURN
NXTSYS: MOVE 0,GENERI ;[163] GET LAST ALL: SYSSTR VALUE
SYSSTR 0, ;[163] GET NEXT ALL: STRUCTURE
TDZ 0,0 ;[163] CLEAR IF ERROR
MOVEM 0,GENERI ;[163] SAVE NEXT STRUCTURE
JRST NXTFS1 ;[163] CONTINUE
;TO INIT NEXT UFD
NXTFSU: PUSHJ P,NXTFS ;GET NEXT F/S
POPJ P, ;SIMPLE SKIP RETURN
MOVE 0,DEVICE ;OTHERWISE GET IT
MOVEM 0,ADSK ;FOR DIR INIT
AOS (P) ;SET FOR SKIP RETURN
JRST DSKDIR ;INIT NEW UFD AND RETURN TO USER
NOFNCE: AOS GENERI ;SIGNAL END OF F/S
ENDFS: MOVE 0,TDSK ;[163] GET SAVED ORIGINAL DEVICE
MOVEM 0,ADSK ;[163] AND RESTORE IT IN CASE
MOVEM 0,DEVICE ;INPUT TO PROCESS
POPJ P, ;RETURN
SUBTTL SFD SPECIFICATIONS AND PATH BLOCK SETUPS
;ROUTINES TO HANDLE SFD'S
GETPTH: SETOM PTHADD ;SIGNAL FULL PATH TO BE USED
MOVEI T7,PTHSFD ;ADDRESS OF SFD LIST
GTPTH1: HRLI T7,(POINT 6,,) ;ILDP LOOP
PUSHJ P,GETBUF ;GET A CHARACTER
CAIL 0,"A" ;ALPHABETIC
CAILE 0,"Z"
JRST .+2 ;NO
JRST GTPTH2 ;YES , FOUND ONE
CAIL 0,"0" ;NUMERIC
CAILE 0,"9"
JRST GTPTH3 ;NO
GTPTH2: SUBI 0,40 ;MAKE SIXBIT
TLNE T7,770000 ;SIX CHAR. YET?
IDPB 0,T7 ;NO DEPOSIT
JRST GTPTH1+1 ;LOOP
GTPTH3: MOVE T5,JOBPTH-PTHADD(T7) ;[211] GET DEFAULT SFD NAME
SKIPN (T7) ;[211] SEE IF HE SPECIFIED ANYTHING
MOVEM T5,(T7) ;[211] NO, USE DEFAULT
CAIE 0,"," ;[211] SEE IF ANY MORE
JRST GTPTH4 ;NO
MOVEI T7,1(T7) ;ADVANCE BYTE POINTER
CAIGE T7,PTHSFD+PTHLEN-1 ;TOO MANY SFD'S
JRST GTPTH1 ;NO, GET NEXT SFD
ERRPNX </?SFD list too long!/>
GTPTH4: ;[223]
IFN SCANSW,< ;[223]
CAIE 0,"/" ;[223] SEE IF IT'S A SCAN SWITCH
POPJ P, ;[211] NO
PUSHJ P,GETBUF ;[211] YES, GET NEXT CHARACTER
MOVEI T5,1 ;[211] SET NO SCAN
CAIN 0,"N" ;[211] IF /N
MOVEM T5,PTHSCN ;[211] SET NO SCAN SWITCH
MOVEI T5,2 ;[211] SET SCAN
CAIN 0,"S" ;[211] IF /S
MOVEM T5,PTHSCN ;[211] SET SCAN SWITCH
PUSHJ P,GETBUF ;[211] BYPASS SWITCH
>;[223] END IFN SCANSW
POPJ P,
;PUT PATH ADDRESS IN AC0
;SKIP IF ZER0, NON-SKIP IF FULL PATH IN USE
SETPTH: MOVE 0,[XWD PTHADD,WRKPTH] ;[207] TRY FULL PATH
SKIPN JOBPTH ;SKIP IF SFD'S
JRST STPTH2 ;[211] GO MAKE SURE WE DON'T HAVE PATH POINTER
SKIPE PTHADD ;IN USE
JRST STPTH1 ;[207] GO COPY TO WORK AREA
MOVE 0,@(P) ;IF A PPN HAS BEEN SET , DON'T USE DEFAULT
SKIPN @0 ;LOOK AT @RETURN ADDRESS
SKIPN DEFPTH ;IS DEFAULT PATH IN USE
JRST CPOPJ1 ;[207] NO, SKIP RETURN
MOVE 0,[XWD DEFPTH,WRKPTH] ;[207] YES, USE DEFAULT PATH
STPTH1: BLT 0,WRKPTH+PTHLEN+3 ;[207] COPY TO WORK AREA
MOVEI 0,WRKPTH ;[207] AND SET ADDRESS UP
POPJ P, ;RETURN
STPTH2: MOVE 0,@(P) ;[212] GET PPN ADDRESS
MOVE 0,@0 ;[212] GET PPN
SKIPE 0 ;[234] OK IF DEFAULT
TLNE 0,-1 ;[212] SEE IF PATH POINTER
JRST CPOPJ1 ;[212] NO, IT'S OK
ADDI 0,2 ;[212] YES, GET PPN SO NON-PATHING
MOVE 0,@0 ;[212] MONITORS DO NOT LOSE
POPJ P, ;[212] AND LET NORMAL RETURN STORE IT
SUBTTL READ DIRECTORY FOR WILD CARDS AND /L/F/R/D
;PREPARE TO LOOKUP FILES IN PARTICULAR DISK DIRECTORY
DIRSK1: SKIPA T1,DTON+3 ;ENTRY FOR /Z.... BE CAREFUL
DSKDIR: MOVE T1,PP ;[162] GET PPN FOR UFD
JUMPN T1,DSKDRB ;[163] SEE IF ANY SPECIFIED
SKIPN T1,DEVPP ;[163] SEE IF DEVICE IMPLIES ANY
SKIPE T1,PPP ;[163] SEE IF PERMANENT
JRST DSKDRB ;[163] GOT ONE OF THE ABOVE
SETZM FNPPN ;[211] CLEAR THE CARRYOVER PPN
MOVE T1,[XWD JOBPTH,PTHADD] ;[211] GET DEFAULT PATH
BLT T1,PTHADD+PTHLEN+3 ;[211] AS PATH TO USE
MOVE T1,JOBPTH+2 ;[211] GET PPN FOR FILE NAME
CAIA ;[211] BUT DON'T SAVE IN FNPPN
DSKDRB: MOVEM T1,FNPPN ;[134] NO
MOVEM T1,UFDPPN ;[211] SAVE PPN FOR PRINTOUT
TLNN T1,-1 ;[211] SEE IF REALLY PATH POINTER
MOVE T1,2(T1) ;[211] YES, GET PPN IN CASE NO SFD'S
MOVE 0,[XWD FILNAM,UFD]
BLT 0,UFD+3 ;SAVE LOOKUP BLOCK
MOVEM T1,FILNAM ;[P,P] TO UFD
MOVSI 0,'UFD'
MOVEM 0,FILEX ;USER HAS SPECIFIED [P,P]
MOVE 0,MFDPPN ;[163] GET PPN OF MFD'S
IFN LEVELC,< ;[211]
MOVEM 0,PP ;[211] SAVE PP IN SHORT LOOKUP FOR C
>;[211] END IFN LEVELC
MOVEM 0,PPN ;SAVE FOR EXTENDED LOOKUP
PUSHJ P,DSKDST ;INIT TO READ DIRECTORY
MOVEI T1,RIBSTS ;NO. OF WORDS FOR EXTENDED LOOKUP
MOVEM T1,RIBFIR
SKIPE PTHSFD ;[211] ANY SFD SPECIFIED
JRST SFDDIR ;YES, LOOKUP PATH
MOVE T1,LEVEL ;LEVEL D = -2
LOOKUP DIR,FILNAM(T1) ;GET USERS FILE DIRECTORY
JRST DERR5A ;ONE OF MANY LOOKUP ERRORS
JUMPE T1,DIRSK2 ;IF LEVEL C
DIRSK3: HRRZ T1,RIBFIR+RIBSTS
ANDI T1,777 ;GET ERROR BITS
JUMPN T1,DIRSK2 ;JUMP IF ERRORS IN UFD
MOVEI T1,RBSIZ ;SET LOOKUP
MOVEM T1,RIBFIR ;FOR SHORT EXTENDED
DIRSK2: MOVS T1,[XWD FILNAM,UFD]
BLT T1,PP ;RESTORE LOOKUP BLOCK
POPJ P, ;LOOKUP OK
;HERE TO DO LOOKUP ON SPECIFIED PATH
SFDDIR: MOVSI 0,'SFD' ;CHANGE EXTENSION
MOVEM 0,FILEX ;TO EXPECTED
MOVEI 0,PTHADD ;ADDRESS OF FULL PATH
MOVEM 0,PPN ;THIS IS THE DIRECTORY REQUIRED
MOVEM 0,UFDPPN ;[211] SAVE POINTER FOR PRINTOUT
MOVEI T1,PTHSFD+PTHLEN ;LOOP FOR ALL SFD'S
MOVE T2,(T1) ;[211] GET A POSSIBLE SFD NAME
SKIPN T2 ;[211] END LOOP WHEN NON-ZERO
SOJA T1,.-2 ;NOT YET
SETZM (T1) ;BACKUP PATH ONE SFD
MOVEM T2,FILNAM ;[211] THIS IS NAME OF FILE WE WANT TO LOOK UP
PUSHJ P,SETPTH ;[211] GO MOVE PATH TO WORK AREA
MOVEM 0,PPN ;[211] AND SAVE POINTER
LOOKUP DIR,RIBFIR ;GIVE IT A TRY
JRST DERR5S ;[211] .SFD FAILED, ERROR DIFF FROM UFD
MOVEM T2,(T1) ;[211] RESTORE FULL PATH SPEC
JRST DIRSK3 ;AND RETURN TO COMMON CODE
SUBTTL DISK DIRECTORY LISTS
;ROUTINE TO LIST DISK DIRECTORY. /L OR /F SWITCH
SYN AB,FILCNT ;COUNT OF NUMBER OF FILES FOUND
SYN MTAREQ,FILERR ;ERROR BIT IN FILE
DSKLST: PUSHJ P,ININIT ;ASSIGN "IN" FOR RETRIEVAL INFO
SETZM BLKSUM ;CLEAR TOTAL BLOCKS FOR ALL FILES
SETZM FILCNT ;START AT ZERO
SETZM LIN ;SET UP APPROPRIATE CONTROLS
MOVS T1,ODEV ;FOR THIS LISTING DEVICE
CAIN T1,'TTY' ;IF ODEV IS TTY
TRO CALFLG,LISTTY ;SET LISTTY=1 (TTY)
SKIPN FILNAM ;IF NO FILNAM GIVEN
TRZ CALFLG,MATFN!MATEX ;LIST ALL OF DIRECTORY
MOVE T1,FILNAM
MOVEM T1,MATCH
HLRZ T1,FILEX
MOVEM T1,MATCH+1
PUSHJ P,DSKDIR
PUSHJ P,CRLF ;GIVE A BLANK LINE
TRNN AUXFLG,FFLG ;SHORT LISTING
PUSHJ P,HEADER ;PUT OUT HEADER LINES
TLO CALFLG,LPPFLG ;OUTPUT PPN LATER
PUSHJ P,INITFS ;INIT F/S SEARCH LIST
JRST LSTU0A ;NOT GENERIC "DSK"
LSTU0: PUSHJ P,NXTFSU ;GET NEXT F/S IN LIST
JRST DIRFIN ;NO MORE
LSTU0A: TLO CALFLG,LDVFLG ;SIGNAL NEW DEVICE TO OUTPUT
MOVE T1,FNPPN ;[211] GET PROJ-PROG OF EVERYONE BUT US
MOVEM T1,PPN ;SAVE FOR EXTENDED LOOKUP
LSTU1: SOSLE UFDIN+2
SKIP 2
LSTU2: PUSHJ P,UIN ;GO READ DIRECTORY
JRST BLKLST ;(EOF) - OUTPUT BLOCKS USED
ILDB 0,UFDIN+1
JUMPE 0,LSTU2
MOVEM 0,FILNAM ;PREPARE TO GET RETRIEVAL INFO
MOVE T1,FNPPN ;EACH LOOKUP DESTROYS P-P NO.
MOVEM T1,FILNAM+3 ;RESTORE P-P NO.
SKIPG LIN
PUSHJ P,HEDR3 ;YES, PUT OUT HEADER LINES
SOS UFDIN+2
ILDB DOUT,UFDIN+1 ;PICK UP EXTENSION
HLRZS DOUT ;CLEAR RIGHT HALF
HRLZM DOUT,FILNAM+1 ;KEEP FOR LOOKUP
TLNE CALFLG,MFLG ;NEED TO MASK?
JRST MLSTU ;YES
TRNN CALFLG,MATEX ;MATCH EXTENSIONS?
SKIP 2 ;NO,TRY MATFN
CAME DOUT,MATCH+1 ;MATCH?
JRST LSTU1 ;NO,GET NEXT FILE
TRNN CALFLG,MATFN ;MATCH FILENAME?
JRST LSTU2A ;NO
CAME 0,MATCH ;FILNAM MATCH?
JRST LSTU1 ;NO
LSTU2A: CAIE DOUT,'UFD' ;IS FILE MFD
JRST LSTU3 ;GO PRINT NAME HELD IN 0.
HLRZ DOUT,FILNAM ;HERE FOR MFD ONLY
MOVEI T2,PUT
PUSHJ P,OUTOCT ;PRINT #,#. PROJ. NO.
MOVEI CHR,COMMA ;","
PUSHJ P,PUT ;...
HRRZ DOUT,FILNAM ;PROG. NO.
PUSHJ P,OUTOCT
JRST LSTU3A ;...
LSTU3: MOVE 0,FILNAM
PUSHJ P,SIXOUT ;OUPUT FILENAME
LSTU3A: MOVEI T4,5 ;SET LOOP FOR OUTPT EXT
MOVE 0,FILEX
JUMPE 0,LSTU4
PUSHJ P,TABOUT
PUSHJ P,SIXOUT ;OUTPUT EXTENSION
LSTU4: AOS FILCNT ;COUNT ONE MORE FILE SEEN
TRNN AUXFLG,FFLG ;SHORTEST LISTING?
SKIP 2
PUSHJ P,CLRF ;YES
JRST LSTU1
SKIPN FILEX
PUSHJ P,TABOUT ;ACCOUNT FOR LACK OF EXTENSION
PUSHJ P,SPACES
PUSHJ P,SETPTH ;[211] GO SET UP PATH
MOVEM 0,PPN ;[211] AND SET POINTER
MOVE T4,LEVEL ;-2 IF LEVEL D,0 IF LEVEL C
LOOKUP IN,FILNAM(T4) ;GET RETRIEVAL INFO.
JRST LSTU5 ;NOT AVAILABLE
JUMPE T4,LSTU4A ;LEVEL C OR NO UFD ERRORS
HRRZ DOUT,RIBFIR+RIBSTS ;FILE ERROR STATUS
ANDI DOUT,777 ;ONLY ERROR BITS
MOVEM DOUT,FILERR ;STORE ERROR BIT OR ZERO
LSTU4A: PUSHJ P,BLKS ;DETERMINE NO. BLK IN FILE
;AND TOTAL FOR UFD
LDB 0,PROT ;GET PROTECTION BITS
PUSHJ P,PROTO ;PRINT OCTAL NUMBERS
TRNE CALFLG,LISTTY ;OUTPUT DEVICE A TTY?
JRST LSTU7 ;YES, SKIP LONG DIRECTORY
LDB 0,ADATE ;PRINT ACCESS DATE
PUSHJ P,DATOUT
PUSHJ P,TABOUT
LDB 0,CTIME ;PRINT CREATION TIME
PUSHJ P,TIMOUT
LDB 0,CDATE
LDB T1,XCDATE ;[132] HIGH ORDER BITS
DPB T1,[POINT 3,0,23] ;[132] MERGE
PUSHJ P,DATOUT ;PRINT CREATION DATE
PUSHJ P,SPACE2
LDB 0,MODE ;PRINT MODE
PUSHJ P,OCTLS2
JRST LSTU8
LSTU5: PUSHJ P,TABOUT ;THE FILE WAS PROTECTED
HRRZ T7,FILEX ;GET PARTICULAR ERROR TYPE
CAIL T7,TABLND-TABLE ;IS IT LEGAL ERROR
PUSHJ P,DERRQ ;NO,PICK UP CATCH ALL MESSAGE
MOVE T1,TABLE(T7) ;PICK UP POINTER FOR ERROR MSG
LSTU6: ILDB CHR,T1 ;PICK UP CHAR FROM ERROR MSG
JUMPE CHR,LSTU8 ;PRINT ERROR MESSAGE, END SEEN
CAIN CHR,"!"
JRST LSTU8 ;ALTERNATE END SEEN (!)
IFE REENT,<
PUSHJ P,CCASE> ;DEPOSIT CHARACTER
PUSHJ P,PUT
JRST LSTU6
LSTU7: LDB 0,CDATE
LDB T1,XCDATE ;[132] HIGH ORDER BITS
DPB T1,[POINT 3,0,23] ;[132] MERGE
PUSHJ P,DATOUT ;PRINT CREATION DATE ONLY FOR TTY
LSTU8: CLOSE IN,
SKIPE DOUT,FILERR ;ANY FILE ERRORS
PUSHJ P,ERROUT ;YES, LIST CODE INSIDE PARENS.
PUSHJ P,LSTU8A ;COMMON ROUTINE TO OUTPUT "DEV:[PPN]"
JRST LSTU1
LSTU8A: TLZN CALFLG,LDVFLG ;DEVICE TO OUTPUT?
JRST LSTU9 ;NO
PUSHJ P,SPACE2
MOVE 0,ADSK ;GET F/S NAME
PUSHJ P,SIXOUT ;PRINT IT
MOVEI CHR,":" ;FOLLOW WITH COLON
PUSHJ P,PUT
LSTU9: TLZN CALFLG,LPPFLG ;PPN TO LIST?
JRST LSTU9A ;NO
PUSHJ P,SPACE2
MOVEI CHR,"[" ;FORM PPN
PUSHJ P,PUT
MOVE T5,UFDPPN ;[211] GET PPN OR POINTER TO PATH
TLNN T5,-1 ;[211] SEE IF PATH
MOVE T5,2(T5) ;[211] YES, GET PPN FROM PATH
HLRZ 0,T5 ;[211] PUT PROJECT NUMBER IN 0
PUSHJ P,OCTLST
MOVEI CHR,","
PUSHJ P,PUT
HRRZ 0,T5 ;[211] GET PROGRAMMER NUMBER
PUSHJ P,OCTLST
MOVE T5,UFDPPN ;[211] GET PPN
TLNE T5,-1 ;[211] SEE IF IT IS POINTER TO PATH
JRST LSTU9B ;[211] NO, SKIP SFD PRINT
MOVEI T5,3(T5) ;[211] START AT FIRST SFD
LSTU9C: MOVE 0,(T5) ;[211] GET SFD NAME
JUMPE 0,LSTU9B ;[211] 0 ENDS LIST
MOVEI CHR,"," ;[211] PUT COMMA'S BETWEEN
PUSHJ P,PUT ;[211] OUTPUT ,
PUSHJ P,SIXOUT ;[211] OUTPUT SFD NAME
AOJA T5,LSTU9C ;[211] LOOP TILL NULL SFD NAME
LSTU9B: ;[211]
MOVEI CHR,"]"
PUSHJ P,PUT
LSTU9A: JRST CLRF ;PRINT CR-LF AND RETURN
ERROUT: PUSHJ P,SPACE2 ;SEPARATE BY SOME SPACES
MOVEI CHR,"(" ;PUT ERROR CODE IN PARENS
PUSHJ P,PUT
SKIPA T4,[POINT 7,[ASCII /a*cm**rwf*/]]
LSH DOUT,-1 ;SHIFT ERROR BIT TOWARDS BIT 35
ILDB CHR,T4 ;GET AN ERROR CHARACTER
TRNN DOUT,1 ;IS IT THIS ERROR?
JRST .-3 ;NO
PUSHJ P,PUT ;YES,OUT IT GOES
MOVEI CHR,")"
JRST PUT ;RETURN
DIRFIN: SKIPE FILCNT ;HAVE WE SEEN ANY FILES?
JRST MAIN1 ;YES, EXIT
;[177] TELL USER HE DOESN'T HAVE ANY OF THOSE, AND TELL HIM WHICH
ERRPNT </Directory has no such files as />;[177]
MOVE 0,MATCH ;[177] MOVE NAME AND EXTENSION TO
MOVEM 0,FILNAM ;[177] FILNAM FOR FN.EX TO PRINT OUT
HRLZ 0,MATCH+1 ;[177] AFTER ERR3AC FIGURES OUT ANY
MOVEM 0,FILNAM+1 ;[177] WILD CARD STUFF
PUSHJ P,ERR3AC ;[177] GO PRINT FILNAM, IF OUTPUT IS TTY
;[177] IT WILL BE REOPENED HERE
JRST MAIN1 ;[177] GO SEE IF ANY MORE TO DO
MLSTU: TRNN CALFLG,MATFN ;MATCH FILE NAME
JRST MLSTU1 ;NO, TRY EXT
XOR 0,MATCH
ANDCM 0,QMASK
JUMPN 0,LSTU1 ;MATCH FAILED
MLSTU1: TRNN CALFLG,MATEX ;MATCH EXT
JRST LSTU2A ;NO
XOR DOUT,MATCH+1
ANDCM DOUT,QMASK+1
JUMPN DOUT,LSTU1 ;FAILED
HLRZ DOUT,FILNAM+1 ;[226] RESTORE EXTENSION (I.E. 'UFD')
JRST LSTU2A ;MATCH FOUND
;ROUTINE TO OUTPUT SPACES, T4=NO. TO OUTPUT
SPACE2: MOVEI T4,2 ;SET FOR 2 SPACES
SPACES: MOVEI CHR,SPACE
PUSHJ P,PUT
SOJG T4,.-1
POPJ P,
;ROUTINE TO DEPOSIT T4.SIXBIT CHARACTERS
;FROM AC0 INTO OUTPUT BUFFER
SIXOUT: MOVSI T2,(POINT 6,0)
JUMPE 0,SIXO1 ;ZERO WORD
TLNE 0,770000 ;LEADING SPACE
JRST LSTO0 ;NO
LSH 0,6 ;GET NEXT CHAR.
MOVEI CHR," " ;BUT OUTPUT SPACE
SKIP 3
LSTO0: ILDB CHR,T2
JUMPE CHR,SIXO1
ADDI CHR,40 ;MAKE ASCII
PUSHJ P,PUT
SOJ T4,
TLNN T2,770000
SIXO1: POPJ P,
JRST SIXOUT+2
;DETERMINE NUMBER OF BLOCKS PER FILE AND TOTAL NUMBER OF
;BLOCKS USED BY USERS PROJECT,PROGRAMMER NUMBER
BLKS: MOVEI T2,PUT ;SET OUTPUT
MOVE DOUT,RIBFIR+RBSIZ
SKIPE LEVEL ;SKIP IF LEVEL C
SKIP 3 ;LEVEL D WORD COUNT
HLRE DOUT,PP ;GET WORD COUNT OF FILE
BLKSD: JUMPGE DOUT,BLKADD ;IF POS = NO. OF BLOCKS
MOVNS DOUT ;MAKE POSITIVE
TRZE DOUT,177 ;TAKE CARE OF PARTIAL BLOCKS
ADDI DOUT,200
IDIVI DOUT,200 ;CALCULATE BLOCK COUNT
BLKADD: ADDM DOUT,BLKSUM ;CALCULATE TOTAL FOR ALL FILES
TRNE FLAG,DFLG ;IF /D
POPJ P, ;JUST RETURN
PUSHJ P,OUTDE4 ;OUTPUT NUMBER OF BLOCKS IN DECIMAL
JRST SPACE2 ;RETURN WITH 2 SPACES
;END OF FILE ON UFD OUTPUT TOTAL BLOCKS XXX
BLKLST: SKIPN BLKSUM ;ANY INFORMATION TO OUTPUT
JRST BLKLS1 ;NO - FINISHED
LSTLIN TOTAL ;OUTPUT CR,LF "TOTAL BLOCKS"
MOVE DOUT,BLKSUM
MOVEI T2,PUT ;SET OUTPUT
PUSHJ P,OUTDE4 ;PRINT TOTALS
PUSHJ P,CRLF ;BONUS CR-LF
BLKLS1: SKIPN GENERI ;MORE FILE STRUCTURES?
JRST MAIN1 ; FINISHED
SETZM BLKSUM ;START AFFRESH
MOVE T1,UFDPPN ;[211] RESTORE PP
TLNN T1,-1 ;[211] SEE IF PATH POINTER
MOVE T1,2(T1) ;[211] YES, GET ACTUAL PPN
MOVEM T1,PP
JRST LSTU0 ;YES
TOTAL: ASCIZ /
Total Blocks /
IFE REENT,<
CCASE: CAIL CHR,"a" ;FLUSH LOWER CASE LETTERS
CAILE CHR,"z" ;FROM OUTPUT IN CASE PDP-6 LPT
POPJ P,
SUBI CHR,40
POPJ P,>
SUBTTL SET UP DIRECTORY CHANNEL
;INPUT USERS FILE DIRECTORY
UIN: SETZ IOS, ;JUST IN CASE
IN DIR,
JRST CPOPJ1 ;NO ERRORS
STATUS DIR,IOS
TRZN IOS,EOFBIT
JRST UIN2 ;ERROR PRINT
POPJ P,
;INIT DIRECTORY DEVICE
DSKDST: MOVE T2,.JBFF ;SAVE JOBFF IN T2
MOVEI T1,DBUF
MOVEM T1,.JBFF ;MAKE MONITOR USE DBUF FOR DISK DIR.
MOVEI T1,14 ;BINARY MODE
SKIPE GENERI ;[151] SEE IF IT WAS A GENERIC SPEC
TLO T1,UU.PHS ;[151] YES, SET PHYSICAL-ONLY TO AVOID AMBIGUITY
MOVEM T1,ADSK1
MOVEI T1,UFDIN ;LOC OF DIRECTORY ENTRY
MOVEM T1,ADSK+1 ;FOR UFD
OPEN DIR,ADSK1
JRST ERR1A
INBUF DIR,1 ;RESET JOBFF SAME AS ENTRY
MOVEM T2,.JBFF
POPJ P,
SUBTTL MISCELLANEOUS DIRECTORY LIST ROUTINES
;OUTPUT THE DIRECTORY LISTING HEADER
HEDR3: TRNN AUXFLG,FFLG ;POP BACK IF SHORT LISTING
TRNE CALFLG,LISTTY
POPJ P,
HEADER: PUSHJ P,HEDR4
HEDR1: LSTLIN HEDL1
DATE ;DATE REQ.
PUSHJ P,DATOUT
PUSHJ P,TABOUT
PUSHJ P,NOWOUT ;PRINT CURRENT TIME, DATE
AOS PGCNT ;INCREMENT PAGE COUNT
LSTLIN HEDPG
MOVE 0,PGCNT ;GET PAGQ NUMBER
IDIVI 0,^D10 ;DECIMAL PAGES
JUMPE 0,.+4
MOVE CHR,0
ADDI CHR,"0" ;[246] CONVERT TO ASCII
PUSHJ P,PUT
MOVEI CHR,"0"(1)
PUSHJ P,PUT
SOS LIN
LSTLIN HEDLIN
HEDR2: JRST CLRF
HEDLIN: ASCIZ /
Name Extension Len Prot Access ---Creation--- Mode
/
HEDL1: ASCIZ / Directory listing /
HEDPG: ASCIZ / Page /
UIN2: PUSHJ P,COMERR
JSP T5,INICN2
ERRPN2 </?Disk directory read />
MOVEI T3,UFD ;LOCATION OF FILENAME(AND EXT)
PUSHJ P,FN.EX ;PRINT FILE NAME EXTENSION
MOVE T2,AUXFLG
ANDI T2,DSKIN
PUSHJ P,IOERR
SETSTS DIR,(IOS)
JRST CPOPJ1
;OUTPUT THE TIME FOUND IN AC 0
NOWOUT: MSTIME ;CALL MILLISEC TIMER
IDIVI 0,^D60000 ;CONVERT TO MINUTES
TIMOUT: IDIVI 0,^D60
MOVE DOUT,0
PUSHJ P,OUTDEC
MOVEI CHR,":" ;SEPARATE BY A COLON
PUSHJ P,PUT
MOVE DOUT,1
PUSHJ P,OUTDEC
JRST TABOUT
;SKIP TO HEAD OF FORM OR NEXT HALF PAGE, RESET COUNT
HEDR4: TRNE CALFLG,LISTTY
JRST [POP P,(P) ;BACKUP ONE LEVEL
POPJ P,] ;AND EXIT IF TTY
SKIPLE LIN
JRST HEDR6 ;ANYTHING ON THIS PAGE?
HEDR5: MOVEI CHR,FF ;FORM FEED IF FULL OR
MOVEI T2,^D50
HEDR5A: MOVEM T2,LIN ;ALMOST FULL
PUSHJ P,PUT
MOVEI CHR,LF
PUSHJ P,PUT
PUSHJ P,PUT
JRST PUT ;PRINT LINEFEEDS AND EXIT
HEDR6: CAIGE T2,^D25
JRST HEDR5
MOVEI CHR,HPAGE
MOVEI T2,^D16
JRST HEDR5A
;OUTPUT OCTAL WORD FOUND IN AC 0
OCTLS2: MOVEI CHR," "
CAIGE 0,10 ;AT LEAST 2 CHAR.?
PUSHJ P,PUT ;NO,SO OUTPUT A BLANK
OCTLST: MOVSI T1,(POINT 3,0)
ILDB CHR,T1
TLNE T1,770000 ;ALLOW UPTO 12 OCTAL NOS
JUMPE CHR,.-2 ;GET MOST SIG. NUMBER
OCTL1: ADDI CHR,60 ;CONVERT TO ASCII
PUSHJ P,PUT ;OUTPUT CHAR
ILDB CHR,T1 ;GET SUCCEEDING CHARS
TLNN T1,400000 ;WAIT TILL POINTING TO NEW
JRST OCTL1 ;WORD, THEN EXIT. MEAN WHILE
POPJ P, ;PRINT OCTAL NUMBERS
;OUTPUT PROTECTION BITS FOUND IN AC 0
PROTO: MOVEI CHR,"<"
MOVSI T1,(POINT 3,,26)
PUSHJ P,OCTL1+1
MOVEI CHR,">"
PUSHJ P,PUT
MOVEI T4,3 ;SET FOR THREE SPACES
JRST SPACES ;AND EXIT
SUBTTL DISK ENTER/LOOKUP/RENAME ERROR PRINTER
;THIS IS THE DISK ERROR ROUTINE. CALL DERR4 WITH T3=FIRST WORD ADDRESS
;OF LOOKUP OR ENTER. USE T7 FOR SAVING THE ERROR CODE.
DERR5A: MOVEI T3,FILNAM ;LOCATION OF FILENAME
HRRZ T7,1(T3) ;GET ERROR CODE
SKIPE GENERI ;FATAL IF NOT GENERIC "DSK"
CAILE T7,1 ;NO UFD IF 0 OR 1
JRST DERR4 ;ANY OTHER ERROR
TRNN AUXFLG,FFLG ;[174] ONLY OUTPUT %NO UFD IF DOING
TRNE FLAG,LFLG ;[174] /L OR /F
SKIPN STRARG ;[163] IF DOING SYS: SEARCH LIST
JRST DERR5B ;[163] THEN IGNORE MISSING UFD'S
LSTLIN NOUFD
TLO CALFLG,LDVFLG!LPPFLG ;PRINT "DEV:[PPN]"
PUSHJ P,LSTU8A
TLO FL,LDVFLG!LPPFLG ;[163] RESET TO PRINT DEV AND PP AGAIN
DERR5B: ;[163]
SOS (P) ;[127] CORRECT RETURN ADDRESS
SOS (P) ;[127] TO MAINAD OR LSTU0
JRST DIRSK2 ;GET NEXT FILE STRUCTURE
NOUFD: ASCIZ /%No UFD exists for / ;[242]
;HERE IF THE SFD LOOKUP FAILED
DERR5S: MOVEI T3,FILNAM ;[211] GET ADDRESS OF LOOKUP BLOCK
HRRZ T7,1(T3) ;[211] GET LOOKUP ERROR CODE
CAIE T7,23 ;[211] ONLY ACCEPT ERROR 23
CAIG T7,1 ;[243] OR 0 OR 1
SKIPN GENERI ;[211] AND ONLY ON NON-GENERIC
JRST DERR4 ;[211] FATAL ERROR
MOVEM T2,(T1) ;[211] RESTORE SFD NAME
JRST DERR5B ;[211] AND BACKWARDS SKIP RETURN
DERR7Z: MOVE T3,DTON ;RECOVER NAME
MOVEM T3,ZRF
JRST DERR5R ;PRINT AND RETURN
DERR6R: TRO CALFLG,RTRNFL
DERR6: MOVEI T3,DTON ;LOCATION OF FILENAME (OUTPUT)
JRST DERTYP
DERR7: HRRZ T3,DTON+1 ;GET ERROR CODE
CAIN T3,4 ;IF RENAME ERROR =4
JRST DERR6R ;USE OUTPUT NAME
HRRM T3,ZRF+1 ;PUT IT IN EXPECTED PLACE
DERR5R: TRO CALFLG,RTRNFL ;SET TO RETURN FROM ERROR PRINTER
DERR5: MOVEI T3,ZRF ;LOCATION OF FILENAME (INPUT)
DERTYP: HRRZ T7,1(T3) ;ERROR TYPE
DERR4: ERRPNT </? />
PUSHJ P,FN.EX ;PRINT FILE NAME .EXT
CAIL T7,TABLND-TABLE ;LEGAL ERROR?
PUSHJ P,DERRQ ;NO USE CATCHALL MESSAGE
MOVE T1,TABLE(T7) ;PICK UP BYTE POINTER
JRST PTEXT1 ;AND PRINT MESSAGE
DERRQ: MOVEI CHR,"(" ;ENCLOSE ERROR NUMBER IN PARENS.
PUSHJ P,PUTCON ;OUTPUT IT
MOVE 0,T7 ;GET ERROR NUMBER
IDIVI 0,8 ;TWO OCTAL DIGITS
JUMPE 0,.+4 ;NO LEADING DIGIT
MOVE CHR,0
ADDI CHR,"0" ;ASCII
PUSHJ P,PUTCON ;OUTPUT IT
MOVEI CHR,"0"(1) ;REMAINDER
MOVEI T7,TABLND-TABLE ;SETUP MESSAGE
JRST PUTCON ;PRINT REMAINDER AND RETURN
TABLE: POINT 7,[ASCII /(0) file was not found!/]
POINT 7,[ASCII /(1) no directory for project-programmer number!/]
POINT 7,[ASCII /(2) protection failure!/]
POINT 7,[ASCII /(3) file was being modified!/]
POINT 7,[ASCII /(4) rename file name already exists!/]
POINT 7,[ASCII /(5) illegal sequence of UUOs!/]
POINT 7,[ASCII /(6) bad UFD or bad RIB!/]
POINT 7,[ASCII /(7) not a SAV file!/]
POINT 7,[ASCII /(10) not enough core!/]
POINT 7,[ASCII /(11) device not available!/]
POINT 7,[ASCII /(12) no such device!/]
POINT 7,[ASCII /(13) not two reloc reg. capability!/]
POINT 7,[ASCII /(14) no room or quota exceeded!/]
POINT 7,[ASCII /(15) write lock error!/]
POINT 7,[ASCII /(16) not enough monitor table space!/]
POINT 7,[ASCII /(17) partial allocation only!/]
POINT 7,[ASCII /(20) block not free on allocation!/]
POINT 7,[ASCII /(21) can't supersede (enter) an existing directory!/]
POINT 7,[ASCII /(22) can't delete (rename) a non-empty directory!/]
POINT 7,[ASCII /(23) SFD not found!/]
POINT 7,[ASCII /(24) search list empty!/]
POINT 7,[ASCII /(25) SFD nested too deeply!/]
POINT 7,[ASCII /(26) no-create on for specified SFD path!/]
TABLND: POINT 7,[ASCII /) lookup,enter,or rename error!/]
END PIP1