Initial commit
[retro-software/dec/tops10/v1.19.git] / src / pip.mac
1 TITLE PIP V.030 MOD SANDERS/DBP 19-AUG-71\r
2 SUBTTL  VJC/PMH/AK-DAG/DMN      8-JUL-70\r
3 \r
4 ;PERIPHERAL INTERCHANGE PROGRAM\r
5 ;"COPYRIGHT 1968, 1969, DIGITAL EQUIPMENT CORP.,MAYNARD,MASS.,U.S.A.\r
6 \r
7 VPIP==30                ;VERSION NUMBER\r
8 SVER==5         ; SANDERS VERSION\r
9 \r
10 \r
11 ;WCH==0  PIP IS ASSEMBLED FOR PDP-10 AND ASSUMES NEW FORMAT DECTAPES.\r
12 ;WCH==1  PIP IS ASSEMBLED FOR PDP-6 AND ASSUMES OLD FORMAT DECTAPES.\r
13 \r
14 ;DISK30==0 PIP IS ASSEMBLED TO RUN WITH 10/40, 10/50 MONITOR SYSTEMS.\r
15 ;DISK30==1 PIP IS ASSEMBLED TO RUN WITH 10/30 DISK SYSTEM.\r
16 \r
17 ;BLOC0==0 PIP ALLOWS COPYING OF BLOCK0 (DECTAPE).\r
18 ;BLOC0==1 PIP WILL NOT ALLOW BLOCK0 TO BE COPIED.\r
19 \r
20 ;RIMSW==0 /Y SWITCH OPTION UNAVAILABLE. (ALSO UNAVAILABLE FOR OLD FORMAT DECTAPES)\r
21 ;RIMSW==1 /Y SWITCH OPTION AVAILABLE.\r
22 \r
23 ;FTDSK==0       NON DSK SYSTEM.NO CCL.SAVES CORE ON 10/40\r
24 ;FTDSK==1       10/50 DSK SYSTEM,ALSO 10/30 DSK SYSTEM\r
25 \r
26 \f\r
27 ;CONDITIONAL ASSEMBLY SWITCH SETUP (NORMAL CONFIGURATION)\r
28 ;---------------------------------\r
29 \r
30 IFNDEF WCH,     <WCH==0>\r
31 IFNDEF DISK30,  <DISK30==0>\r
32 IFNDEF BLOC0,   <BLOC0==0>\r
33 IFNDEF FTDSK,   <FTDSK==0>\r
34 IFN WCH,        <RIMSW==0>\r
35 IFNDEF RIMSW,   <RIMSW==0>\r
36 IFNDEF K,       <K==0>\r
37 \r
38 \r
39 \r
40 \r
41         LOC 124\r
42         PIP1            ;SET REENTER ADDRESS\r
43         RELOC\r
44         LOC 137\r
45         XWD SVER,VPIP\r
46         RELOC\r
47 \r
48 \r
49         MLON\r
50 IFDEF SALL,     <SALL>\r
51 \f\r
52 EXTERN JOBFF,JOBSA,JOBREL\r
53 \r
54 ;FLAG ASSIGNMENTS (RIGHT HALF)\r
55 \r
56 LINE==1         ;ASCII LINE MODE PROCESSING\r
57 BMOD==2         ;BINARY PROCESSING\r
58 TBMOD==4        ;SUPPRESS TRAILING SP, CHANGE MULTIPLE SP TO TABS\r
59 DFLG==10        ;DELETE FILES MODE\r
60 LFLG==20        ;LIST DIRECTORY\r
61 NSMOD==40       ;IGNORE INPUT SEQUENCE NUMBERS\r
62 RFLG==100       ;RENAME FILE MODE\r
63 SQMOD==200      ;GENERATE SEQUENCE NUMBERS\r
64 STS==400        ;END OF LINE SEEN, OUTPUT SEQUENCE NUMBER NEXT\r
65 SPMOD==1000     ;SUPPRESS TRAILING SPACES\r
66 XFLG==2000      ;COPY DECTAPE MODE\r
67 ZFLG==4000      ;CLEAR DECTAPE DIRECTORY\r
68 SUS==10000      ;SEQUENCE NUMBER GENERATION IN PROGRESS\r
69 SPOK==20000     ;SPACE WAS LAST CHARACTER\r
70 ESQ==40000      ;STOP OUTPUTTING SEQ NUM, RESUME OUTPUTTING DATA\r
71 SNI==100000     ;DO NOT INCREMENT SEQUENCE NUMBER\r
72 MTFLG==200000   ;MTA REQUEST RECEIVED\r
73 OSFLG==400000   ;GENERATE SEQ. NOS. INCR. BY ONE\r
74 \r
75 ;FLAG ASSIGNMENTS (LEFT HALF)\r
76 \r
77 OFLG==1         ;BLOCK 0 COPY\r
78 RIMFLG==2       ;RIM FORMAT INPUT /OUT TO DTA. ILLEG IF RIMSW==0,OR WCH==1\r
79 PFLG==4         ;FORTRAN PROGRAM OUTPUT FORMAT CONVERSION\r
80 PCONV==10       ;COLUMN 1 CONVERSION IN PROGRESS\r
81 NEWFIL==20      ;NEW FILE JUST INITIATED\r
82 CHKFLG==40      ;PARENTHESES CHECK MODE\r
83 IFLG==100       ;SELECT IMAGE MODE\r
84 GFLG==200       ;KEEP GOING IF THERE ARE I/O ERRORS\r
85 IBFLG==400      ;SELECT IMAGE BINARY MODE\r
86 JFLG==1000      ;NON-STANDARD MODE\r
87 \f;AUXFLG ASSIGNMENTS (LEFT HALF)\r
88 \r
89 QFLG==1         ;PLEASE PRINT SWITCH SET\r
90 NSPROT==2       ;NON-STANDARD DISK OUTPUT PROTECTION\r
91 SBIN==4         ;36-BIT PR. ON REL. ETC. FILES\r
92 NOMORE==20      ;IGNORE ANY SWITCHES BUT MTA FROM NOW ON\r
93 CDRFLG==40      ;CONVERT COLS 73-80 TO SPACES + /C\r
94 INFOFL==100     ;FLAG USED BY ERR3A:\r
95 RSDCFL==200     ;USED FOR MERGING FILES, ==1 IF FILE HAS EXTENSION\r
96                 ;REL,SAV,DMP,CHN OR OTHERWISE == 0\r
97 FRSTIN==400     ;THIS IS THE FIRST INPUT FILE (USED IN FILE\r
98                 ;MERGE COMMAND) == 0 FOR FIRST INPUT\r
99 \r
100 ;MTAREQ ASSIGNMENTS (RIGHT HALF)\r
101 \r
102 MTAFLG==1       ;MTA ADVANCE ONE FILE\r
103 MTBFLG==2       ;MTA BACKSPACE ONE FILE\r
104 MTTFLG==4       ;MTA SKIP TP LOGICAL EOT\r
105 MTWFLG==10      ;MTA REWIND\r
106 MTFFLG==20      ;MTA MARK EOF\r
107 MTUFLG==40      ;MTA REWIND AND UNLOAD\r
108 MTDFLG==100     ;MTA ADVANCE ONE RECORD\r
109 MTPFLG==200     ;MTA BACKSPACE ONE RECORD\r
110 MT8FLG==400     ;MTA SET 800 B.P.I.\r
111 MT5FLG==1000    ;MTA SET 556 B.P.I.\r
112 MT2FLG==2000    ;MTA SET 200 B.P.I.\r
113 MTEFLG==4000    ;MTA SELECT EVEN PARITY\r
114 \r
115 ;AUXFLG ASSIGNMENTS (RIGHT HALF)\r
116 \r
117 REDFLG==1       ;==1 IF ANY FILES ARE INPUT (OTHER THAN DIRECTORIES)\r
118 SYSFLG==2       ;DEVICE IS SYS\r
119 SYSLST==4       ;LAST DEVICE WAS SYS\r
120 LPTOUT==10      ;LPT OUTPUT\r
121 FFLG==20        ;LIST SHORT DISK DIRECTORY\r
122 ONEOUT==40      ;ONE OUTPUT FILE INITIALIZED\r
123 CDRIN==100      ;CARDS IN\r
124 MTAOUT==200     ;OUTPUT TO MTA\r
125 MTAIN==400      ;INPUT FROM MTA\r
126 TTYIN==1000     ;INPUT FROM TTY\r
127 READ1==2000     ;LOOK FOUND NEW INPUT FILE, NO READ YET.\r
128 DTAOUT==4000    ;OUTPUT TO DTA\r
129 DSKOUT==10000   ;OUTPUT TO DSK\r
130 DTAIN==20000    ;INPUT FROM DTA\r
131 DSKIN==40000    ;INPUT FROM DSK\r
132 TTYOUT==100000  ;OUTPUT TO TTY\r
133 PPTIN==200000   ;INPUT FROM PTR\r
134 PPTOUT==400000  ;OUTPUT TO PTP\r
135 \f;CALFLG ASSIGNMENTS (RIGHT HALF) FOR DESCRIBING A BLOCK OF INFORMATION\r
136 ;FOUND BY THE COMMAND SCANNER.\r
137 \r
138 FNEX==1         ;==1 WHEN FN.EX==*.*, *.EXT, FN.* (WHEN MORE\r
139                 ;THAN ONE FN.EX IS IMPLIED).\r
140 MATEX==2        ;FILE EXTENSIONS MUST MATCH\r
141 MATFN==4        ;FILE NAMES MUST MATCH\r
142 NEWDEV==10      ;A NEW INPUT DEVICE WAS GIVEN\r
143 NEWPP==20       ;A NEW #P-P WAS GIVEN\r
144 ASTFLG==40      ;FLAG SET WHEN FILE NAMED IN CS FOUND\r
145                 ;BY LOOK ROUTINE EVEN IF FN OR EXT =*\r
146 DEV==100        ;DEVICE NAME INDICATOR\r
147 DVSWTH==200     ;OUTPUT DEVICE SEEN\r
148 NSWTCH==400     ;INDICATES NULL NAME\r
149 SSWTCH==1000    ;LEFT ARROW SEEN\r
150 LISTTY==2000    ;LIST TO TTY\r
151 TMPI==4000      ;INPUT DEVICE TMPCOR SEEN\r
152 TMPO==10000     ;OUTPUT DEVICE TMPCOR\r
153 RXFLG==20000    ;(RX) SEEN\r
154 \r
155 ALLCLF==FNEX!MATEX!MATFN!NEWDEV!NEWPP\r
156 \r
157 ;DEVICE CHANNEL ASSIGNMENTS\r
158 \r
159 CON==1          ;COMMAND INPUT CHANNEL\r
160 OUT==2          ;OUTPUT DEVICE\r
161 IN==3           ;INPUT DEVICE\r
162 TAPE==4         ;MTA POSITIONING\r
163 DIR==5          ;DISK DIR. READ\r
164 BLKIN==6        ;INPUT FOR 10/30 DISK FILES\r
165 DTDIR==7        ; DECTAPE DIR. READ(FOR PPN)\r
166 \r
167 ;ACCUMULATOR ASSIGNMENTS\r
168 \r
169 T1=1            ;GENERAL PURPOSE\r
170 T2=2            ;G.P.\r
171 T3=3            ;G.P.\r
172 CHR=4           ;INPUT CHARACTER\r
173 P=5             ;PUSHDOWN POINTER\r
174 FLAG=6          ;FLAG REGISTER\r
175 T4=7            ;G.P.\r
176 IOS=10          ;IO STATUS BITS\r
177 T5=11           ;G.P.\r
178 T6=12           ; G.P.\r
179 AUXFLG=13       ;AUXILIARY FLAG REGISTER\r
180 T7=14           ;G.P.\r
181 DOUT=15         ;DIVIDED NO. FOR OUTPUT\r
182 DOUT1=16        ;REMAINDER, DOUT+1\r
183 CALFLG=17       ;MORE FLAGS\r
184 \f\r
185 ;MISCELLANEOUS PARAMETERS\r
186 \r
187 WRTLOK==400000  ;WRITE LOCK (DECTAPE) /IMPROPER I/O\r
188 BIGBLK==40000   ;BLOCK TOO LARGE\r
189 INBIT==2        ;DEVCHR BIT FOR DEV CAN DO INPUT\r
190 OUTBIT==1       ;DEVCHR BIT FOR DEV CAN DO OUTPUT\r
191 EOFBIT==20000   ;END OF FILE\r
192 EOTBIT==2000    ;END OF TAPE\r
193 DTABIT==4       ;DEVCHR BIT FOR DECTAPE IDENTIFICATION\r
194 INHIB==1        ;OUTPUT RELEASE INHIBIT BIT\r
195 TABSP==10       ;SPACES PER TAB\r
196 PTRBIT==200     ;DEVCHR BIT FOR PTR\r
197 PTPBIT==400     ;DEVCHR BIT FOR PTP\r
198 DSKBIT==200000  ;DEVCHR BIT FOR DSK\r
199 MTABIT==20      ;DEVCHR BIT FOR MTA\r
200 LPTBIT==40000   ;DEVCHR BIT FOR LPT\r
201 TTYBIT==10      ;DEVCHR BIT FOR TTY\r
202 CDRBIT==100000  ;DEVCHR FOR CDR\r
203 DENS2==200      ;MTA 200 BPI\r
204 DENS5==400      ;MTA 556 BPI\r
205 DENS8==600      ;MTA 800 BPI\r
206 PARE==1000      ;MTA EVEN PARITY\r
207 LDP==4000       ;MTA LOAD POINT STATUS\r
208 HPAGE==20\r
209 \r
210 ;MACRO DEFINITIONS\r
211 \r
212 DEFINE SKIP (J)<JRST    .+1+'J>\r
213 \r
214 DEFINE  LSTLIN (Z),<\r
215         SKIPA   T1,[POINT 7,Z]\r
216         PUSHJ   P,PUT\r
217         ILDB    CHR,T1\r
218 IFN WCH,<PUSHJ  P,CCASE>\r
219         JUMPN   CHR,.-2>\r
220 \r
221 DEFINE  ERRPNT  (X),<\r
222         JSP     T1,PTEXT\r
223         ASCIZ   X>\r
224 \r
225 DEFINE  ERRPN2  (X),<\r
226         JSP     T1,PTEXT2\r
227         ASCIZ   X>\r
228 \r
229 DEFINE  ERRPNX  (X),<\r
230         JSP     T1,PRETXT\r
231         ASCIZ   X>\r
232 \r
233 \r
234 LOW:\r
235 \f\r
236 ;ASCII CHARACTERS\r
237 \r
238 CR==15          ;CARRIAGE RETURN\r
239 LF==12          ;LINE FEED\r
240 FF==14          ;FORM-FEED\r
241 ALTMOD==33      ;NEWEST ALTMODE\r
242 ALT175==175     ;OLDEST ALTMODE\r
243 ALT176==176     ;OLDER ALTMODE\r
244 LA==137         ;LEFT ARROW\r
245 CZ==32          ;CONTROL Z\r
246 XON==21         ;^Q,START TTY PTR\r
247 XOFF==23        ;^S,STOP TTY PTR MODE\r
248 COMMA==54\r
249 PERIOD==56      ;PERIOD\r
250 COLON==72\r
251 SPACE==40\r
252 DEL==177        ;DELETE,RUBOUT,REPEAT MOD.35\r
253 TAB==11         ;TAB\r
254 \r
255 \r
256 ;CALLI DEFINITIONS\r
257 \r
258 OPDEF   RESET   [CALLI   0]\r
259 OPDEF   DEVCHR  [CALLI   4]\r
260 OPDEF   CORE    [CALLI  11]\r
261 OPDEF   EXIT    [CALLI  12]\r
262 OPDEF   UTPCLR  [CALLI  13]\r
263 OPDEF   DATE    [CALLI  14]\r
264 OPDEF   MSTIME  [CALLI  23]\r
265 OPDEF   GETPPN  [CALLI  24]\r
266 OPDEF   PJOB    [CALLI  30]\r
267 OPDEF   RUN     [CALLI  35]\r
268 OPDEF   GETTAB  [CALLI  41]\r
269 OPDEF   TMPCOR  [CALLI  44]\r
270 OPDEF   DSKCHR  [CALLI  45]\r
271 OPDEF   JOBSTR  [CALLI  47]\r
272 OPDEF   DEVPPN  [CALLI  55]\r
273 OPDEF   WAIT    [MTAPE   0]\r
274 \r
275 ;EXTENDED LOOKUP PARAMETERS\r
276 \r
277 RBSIZ==5                ;WRITTEN FILE LENGTH\r
278 RIBSTS==17              ;STATUS BITS\r
279 \r
280 \f
281 \r
282 PIP1:   MOVE    0,[LOW,,LOW+1]\r
283         SETZM   LOW\r
284         BLT     0,LOWTOP\r
285         MOVSI   (SIXBIT /SYS/)\r
286         DEVPPN                  ;FIND PP OF DEVICE SYS\r
287         MOVE    PP13            ;ASSUME 1,,3 IF NOT LEVELD\r
288         MOVEM   SYSPP           ;SAVE AS SYS PP\r
289 IFN FTDSK,<\r
290         MOVE    [XWD 17,11]     ;STATES WORD\r
291         GETTAB                  ;GET IT\r
292         SETZ                    ;ERROR RETURN\r
293         TLNN    (7B9)           ;TEST FOR LEVEL D\r
294         TDZA                    ;NOT LEVEL D\r
295         HRROI   -2              ;THIS IS LEVEL D\r
296         MOVEM   LEVEL           ;SAVE  >\r
297 IFE FTDSK,<HLRZ T1,JOBSA        ;NO DSK SO USE JOBFF>\r
298 IFN FTDSK,<MOVEI T1,DSKDR       ;ASSUME NO DISK FOR TEST, LOC OF DSK RTNS\r
299         MOVSI   0,(SIXBIT /DSK/)\r
300         DEVCHR                  ;DEVCHR REQUEST: IS THERE A DSK \r
301         JUMPE   0,P1            ;0 IF NO DISK: USE DSKDR\r
302         MOVE    T1,JOBFF        ;DISK: PREPARE TO SAVE C(JOBFF)\r
303         HRRZ    T2,JOBREL       ;HIGHEST REL LOC AVAILABLE TO USER\r
304         CAIL    T2,6000         ;CURRENT SIZE 4K\r
305         JRST    P1              ;YES\r
306         MOVEI   T2,7777         ;NO. EXPAND TO 4K\r
307         HRRZM   T1,SVJBFF       ;SAVE JOBFF SO BUFFERS CAN BE CREATED\r
308         CORE    T2,             ;CORE UUO\r
309         JRST    DERR7           ;CORE UNAVAILABLE>\r
310 P1:     HRRZM   T1,SVJBFF       ;SAVE JOBFF SO BUFFERS CAN BE CREATED\r
311         JRST    PIP\r
312 \r
313 IFN FTDSK,<\r
314 DERR7:  ERRPNT  </?4K needed/>\r
315         EXIT                    ;EXIT TO MONITOR>\r
316 \r
317 \fPIP:   RESET           ;REINITIALIZE WHEN RESTARTED MANUALLY\r
318                         ;NEW COMMAND STRING SCAN STARTS HERE\r
319 PIP2:   \r
320 PIP2A:  JSP T5,INICN1   ;INITIALIZE THE TTY AND PDL\r
321         MOVEI 0,CR      ;TYPE CR\r
322         IDPB 0,TFO+1\r
323         MOVEI 0,LF      ;AND LF\r
324         IDPB    0,TFO+1\r
325         MOVEI   0,"*"   ;TYPE ASTERISK******\r
326         IDPB 0,TFO+1    ;READY TO ACCEPT\r
327         OUTPUT CON,     ;COMMAND FROM TTY\r
328 PIP2B:  SETZM TOTBRK    ;CLEAR PAREN COUNTER\r
329         MOVEI 0,TABSP   ;SPACES PER TAB\r
330         MOVEM 0,TABCT   ;INITIALIZE TAB COUNT\r
331         MOVE 0,ZRO      ;ASCII /00000/\r
332         MOVEM 0,SQNUM   ;INITIALIZE SEQUENCE NUMBERS\r
333         RELEAS CON,     ;RELEASE TTY FOR USE AS IN-OUT DEVICE\r
334 \r
335 MAINA1: SETZB FLAG,FILNAM   ;INITIALIZE FOR FIRST/NEXT COMMAND STRING\r
336         SETZB AUXFLG,DEVICE\r
337 IFN FTDSK,<HRRZI 0,(SIXBIT /SYS/) ;SYSTEM DIRECT DEV, DSK/DTA\r
338         HRLZM 0,ADSK            ;PUT IN SYSTEM DEVICE>\r
339         MOVE 0,[XWD FILNAM,FILNAM+1]    ;SET PROJECT, PROG NO.\r
340         BLT 0,AB        ;ZERO OUT FILNAM - AB\r
341         SETZ    CALFLG,         ;CLEAR OTHER FLOGS\r
342         MOVE T3,COMPTR  ;BYTE POINTER FOR STORING CS IN BUFFER\r
343 \r
344 ;ACCUMULATE CS CHARS IN COMBUF ALLOW LONG CS ONLY FOR TTY COMMAND\r
345 \r
346 COMSTO: PUSHJ   P,GETTA         ;GET CS CHAR\r
347         AOS     T4,COMCNT       ;COUNT CHARS\r
348         CAILE   T4,^D200        ;ALLOW UP TO 200 CHARS\r
349         JRST    ERR6B           ;MORE THAN 200 CHARS\r
350         CAIN    0,CZ            ;CHECK FOR ^Z\r
351 COMASK: PUSHJ   P,GETEN2        ;SET  ^Z IN 0\r
352         IDPB    0,T3            ;STORE IN COMBUF\r
353         SKIPE   COMEOF          ;END-OF-FILE SET?\r
354         JRST    COMPRO          ;YES, PROCESS CS IN COMBUF\r
355         CAIG    0,CR            ;NOT EOF\r
356         CAIGE   0,LF            ;LF,VT,FF,CR?\r
357         CAIN    0,ALTMODE       ;NO, $?\r
358         JRST    COMASK          ;YES\r
359         JRST    COMSTO          ;NO, KEEP STORING\r
360 \r
361 COMPTR: POINT   7,COMBUF\r
362 \f\r
363 ;********************************************************************\r
364 ;BEGIN SCAN OF DESTINATION PORTION OF COMMAND STRING\r
365 COMPRO:\r
366 IFN FTDSK,<\r
367         MOVSI   0,(SIXBIT/DSK/)\r
368         DEVCHR                          ;IS THERE A DSK?\r
369         JUMPE   0,COMPRP\r
370         MOVSI   0,(SIXBIT /DSK/)        ;MAKE DEFAULT DEVICE\r
371         MOVEM   0,DEVICE                ;TENTATIVELY DSK>\r
372 \r
373 COMPRP: RELEASE CON,            ;RELEASE TTY\r
374         MOVE    0,COMPTR        ;INITIALIZE POINTER\r
375         MOVEM 0,COMPTS          ;TO PICK UP CS FROM COMBUF\r
376         PUSHJ P,NAME    ;GO SCAN DESTINATION PORTION OF COMMAND STRING\r
377         SKIPE XNAME     ;NO SCAN OVERSHOOT ALLOWED\r
378         JRST ERR6A\r
379         SKIPL   ESWTCH  ;11/25/69  END OF CS ?\r
380         JRST    MAINC   ;NO\r
381         TRNN    CALFLG,NSWTCH   ;NON-NULL DESTINATION\r
382         TRNE    CALFLG,SSWTCH   ;_ NOT SEEN?\r
383         SKIPE   FILNAM          ;OR ANYTHING IN FILENAME\r
384         JRST    ERR6A           ;YES, ERROR\r
385         JRST    PIP2            ;NO, ALL OK\r
386 \r
387 MAINC:  MOVE 0,DEVICE   ;GET OUTPUT DEVICE NAME\r
388         MOVEM 0,ODEV    ;SAVE DEVICE NAME FOR LATER USAGE\r
389         PUSHJ P,DEVTST  ;SAVE DEVICE TYPE, SET XXXOUT.E.G. DTAOUT\r
390         PUSHJ P,ABCHK   ;CHECK MTA BACKSPACE/ADV VALUES\r
391         PUSHJ P,PROTK   ;CHECK PROTECTION\r
392         MOVE 0,AB       ;MTA VALUE SWITCHES\r
393         MOVEM 0,ABOUT   ;GET MTA CONTROL NUMBERS FO R OUT\r
394         MOVE 0,AUX\r
395         MOVEM 0,AUXOUT\r
396         MOVE 0,[XWD FILNAM,DTON]\r
397         BLT 0,DTON+3    ;SAVE DESTINATION FILE NAME\r
398 IFN FTDSK,<TRNN AUXFLG,DSKOUT   ;DISK OUTPUT?>\r
399         SETZM DTON+3    ;ZERO 4TH WD OF DIRECTORY ENTRY\r
400 \fM3:    TRZ     CALFLG,SSWTCH   ;TERMINATE DESTINATION FILE SCAN\r
401         SETZM DEVICE    ;DONT CARRY OVER INPUT DEVICE\r
402 IFN FTDSK,<MOVSI 0,(SIXBIT/DSK/)\r
403         DEVCHR          ;IS THERE A DISK\r
404         JUMPE 0,M3A\r
405         MOVSI 0,(SIXBIT /DSK/)  ;DEFAULT CASE DSK\r
406         MOVEM 0,DEVICE  ;MUST NOT LET O/DEV. CARRY OVER AS I/DEV.>\r
407 M3A:    PUSHJ P,DESCRP  ;GET A UNIT DESCRIPTOR (INPUT).\r
408         TLNN AUXFLG,QFLG;Q?     ;SCAN INPUT PORTION OF COMMAND STRING\r
409         JRST M2         ;NO\r
410         HRRZI 0,(SIXBIT /SYS/)  ;YES MAKE INPUT DEVICE SYS\r
411         HRLZM 0,DEVICE\r
412         HRLZM DEVA              ;SAVE COPY OF INPUT DEVICE\r
413         MOVE 0,QPIP             ;MAKE INPUT FILENAME QPIP\r
414         MOVEM 0,FILNAM\r
415         MOVSI 0,(SIXBIT /*/)    ;DONT RESTRICT QPIP\r
416         MOVEM 0,FILEX   ;EXT TO BEING NULL\r
417         TRZ     CALFLG,MATEX    ;DON'T MATCH EXTENSIONS\r
418         TRO     AUXFLG,SYSFLG   ;DEVICE IS SYS\r
419         MOVE    0,SYSPP ;GET SYS PP\r
420         MOVEM   0,PP    ;AND SET IT\r
421         SOS ESWTCH      ;NO MORE COMMAND STRING\r
422         TRZ AUXFLG,DTAIN+DSKIN+CDRIN+PPTIN+TTYIN+MTAIN\r
423         PUSHJ P,CHECK1  ;CHECK INPUT DEVICE\r
424 \r
425 M2:     TLO AUXFLG,NOMORE       ;NO MORE SWITCHES BUT MTA ALLOWED\r
426         TLNE FLAG,OFLG  ;BLOCK 0 COPY?\r
427         JRST BLOCK0     ;YES\r
428         TRC FLAG,XFLG+RFLG;(RX)\r
429         TRCN FLAG,XFLG+RFLG\r
430         PUSHJ   P,M5    ;YES,(RX)\r
431 IFN RIMSW,<\r
432         TLNN FLAG,RIMFLG        ;RIM OUTPUT?\r
433         JRST M1         ;NO\r
434 IFE WCH,<       \r
435         TRNE AUXFLG,PPTOUT      ;RIM IS ONLY DTA TO PTP\r
436         TRNN AUXFLG,DTAIN!DSKIN!MTAIN\r
437         JRST ERR5B>\r
438 IFN WCH,<JRST RIMTB  >>\r
439 \r
440 M1:     MOVEI T4,1      ;ASCII LINE MODE ASSUMED\r
441         PUSHJ P,OUTLOOK ;SEE IF OUTPUT DEV MTA\r
442         PUSHJ P,M4      ;NOT MTA\r
443         TLNE    FLAG,JFLG       ;NON STARDARD MODE ?\r
444         TRO     T4,100          ;TO PUNCH 029 ON CDP\r
445         HRRZM T4,OMOD   ;SET MODE OF OUTPUT DEV\r
446         MOVEI T4,1\r
447         PUSHJ P,INLOOK  ;SEE IF INPUT DEV MTA\r
448         PUSHJ P,M4      ;NOT MTA\r
449         HRRZM T4,ININI1 ;SET MODE OF INPUT DEV\r
450         PUSHJ P,FNSET   ;NOW DEVICE, DEVA CORRECT FOR START\r
451         JRST OMOD1      ;INIT OUTPUT DEVICE\r
452 \f\r
453 ;SET MODE IF /I,/B,/H,\r
454 \r
455 M4:     TLNN FLAG,IFLG  ;IMAGE BINARY MODE?\r
456         JRST .+3        ;NO\r
457         TRO T4,10       ;IM. MODE\r
458         TRZ T4,1        ;CLEAR ASCII LINE MODE\r
459 \r
460         TRNN FLAG,BMOD  ;BINARY MODE?\r
461         JRST .+3        ;NO\r
462         TRO T4,14       ;BIN. MODE\r
463         TRZ T4,1        ;CLEAR ASCII LINE MODE\r
464 \r
465         TLNE FLAG,IBFLG ;ASCII TO START.  IB MODE?\r
466         TRO T4,13       ;YES\r
467         TRNE FLAG,XFLG  ;COPY MODE?\r
468         POPJ P,         ;YES, DON'T ALTER DATA MODE\r
469 \r
470         TRNE FLAG,DFLG+RFLG     ;DELETE OR RENAME?\r
471         TRO T4,20       ;DIRECTORY WILL BE WRITTEN, DON'T\r
472         POPJ P,         ;COMPUTE WORD COUNT MODE NEEDED.\r
473                         ;FORCE MONITOR TO USE WORD COUNT\r
474                         ;IN FIRST DATA WORD OF BUFFER\r
475 \r
476 M5:     TRZ     FLAG,RFLG       ;CLEAR /R FLAG\r
477         TRO     CALFLG,RXFLG    ;SET (RX) FLAG\r
478         MOVE    0,[XWD DTON,MATCH]\r
479         BLT     0,MATCH+1       ;SAVE NAME AND EXT\r
480         POPJ    P,              ;RETURN\r
481 \f;IF OUTPUT DEVICE IS MTA PERFORM ALL PRE-TRANSFER REQUESTS\r
482 ;SUCH AS REWIND.  IF OUTPUT DEVICE IS MTA, AND THERE IS NO \r
483 ;INPUT DEVICE, EXIT.  FOR OTHER MTA OUTPUT, PREPARE INIT\r
484 ;DENSITY AND PARITY.\r
485 \r
486 OUTLOOK:\r
487         MOVE T3,ABOUT   ;AB FOR OUTPUT DEV\r
488         MOVE T1,AUXOUT  ;AUX FOR OUTPUT DEV\r
489         MOVEI T6,INOMTA ;SET TO INIT\r
490         JRST MT1        ;MTA FOR OUTPUT\r
491 \r
492 \r
493 \r
494 \r
495 ;SAME FOR INPUT DEVICE.\r
496 \r
497 INLOOK: SKIPE   T3,FILNAM       ;IF NO FILENAME\r
498         TRNN    FLAG,XFLG       ;OR NOT /X\r
499         JRST    INLUK1          ;CONTINUE\r
500         SKIPE   DTON            ;IF OUTPUT NAME SET UP\r
501         JRST    INLUK1          ;CONTINUE\r
502         HLRZ    T1,FILEX        ;GET EXT\r
503         CAIE    T1,(SIXBIT /*/) ;IF EITHER IS *\r
504         CAMN    T3,STAR         ;DON'T SET OUTNAME\r
505         JRST    INLUK1          ;BUT JUST CONTINUE\r
506         MOVEM   T3,DTON         ;SET OUT NAME\r
507         HRLZM   T1,DTON+1       ;AND EXTENSION\r
508 INLUK1: MOVE T3,AB      ;ADV OR BKSPACE\r
509         MOVE T1,AUX     ;AUX FOR INPUT DEV\r
510         MOVEI T6,INIMTA ;SET TO INIT\r
511         JRST MT1        ;MTA FOR INPUT\r
512 \f;ROUTINE TO INITIALIZE OUTPUT DEVICE\r
513 \r
514 OMODE:  MOVE T1,[XWD OBF,IBF]\r
515         MOVEM T1,ODEV+1\r
516         MOVE T1,DTJBFF  ;JOBFF AFTER 2 TTY BUFS\r
517         MOVEM T1,JOBFF  ;SET UP\r
518 \r
519         OPEN OUT,OMOD   ;INITIALIZE OUTPUT DEVICE\r
520         JRST ERR1       ;UNAVAILABLE ERROR\r
521         OUTBUF OUT,1    ;TRY ONE OUTBUFFER FOR SIZE\r
522         EXCH T1,JOBFF   ;JOBFF_DTJBFF+BUFSZ\r
523                         ;NOTE JOBFF RESET TO DTJBFF\r
524         SUB T1,DTJBFF   ;T1=BUFSZ\r
525         HRRZ 0,JOBREL   ;HIGHEST CORE AVAILABLE\r
526         SUB 0,DTJBFF    ;0=TOTAL CORE AVAILABLE\r
527         ASH 0,-1        ;COMPUTE HOW MANY OUTPUT BUFFERS\r
528         IDIVM 0,T1      ;FIT IN HALF THE AVAILABLE SPACE\r
529         MOVEI T4,OMODE  ;SET RETURN FROM MORCOR\r
530         CAIGE T1,1      ;1 OR MORE THAN 1 FIT?\r
531         JRST MORCOR     ;NO, NEED MORE CORE\r
532         OUTBUF OUT,(T1) ;SET UP OUTPUT BUFFERS\r
533         MOVE 0,OBF+1\r
534         MOVEM 0,SVOBF   ;SAVE ORIGINAL MODE SETTING\r
535         MOVE 0,JOBFF\r
536         HRRZM 0,SVJBF1  ;PREPARE TO RECLAIM INBUFFER SPACE\r
537         POPJ P,\r
538 \r
539 OMOD1:  PUSHJ P,OMODE   ;GO INITIALIZE OUTPUT DEVICE\r
540         TRZN FLAG,ZFLG  ;Z COMMAND TYPED?\r
541         JRST MAINA2     ;NO,\r
542         PUSHJ P,DTCLR   ;YES, GO CLEAR DIRECTORY\r
543         RELEASE OUT,\r
544         RELEASE DIR,\r
545         TRNN    CALFLG,NSWTCH   ;SEE IF DEVICE WAS TYPED\r
546         JRST OMOD1      ;YES\r
547         JRST PIP2       ;GET NEXT COMMAND\r
548 \r
549 MORCOR: HRRZ 0,JOBREL   ;TRY TO GET\r
550         ADDI 0,2000     ;1K MORE OF CORE\r
551         CORE            ;ASK MONITOR FOR 1K CORE\r
552         JRST OMODER             ;NOT AVAILABLE\r
553         JRST (T4)       ;GOT IT\r
554 \r
555 OMODER: ERRPNT</?Not enough core/>\r
556         EXIT\r
557 \f;MAIN LOOP TO PROCESS INPUT SIDE OF CS\r
558 \r
559 \r
560 MAINA2: TRNE   FLAG,RFLG+DFLG   ;RENAME OR DELETE FILE MODE?\r
561         JRST   DTDELE           ;YES./D,/X,OR(DX)\r
562 IFN RIMSW,<\r
563         TLNE   FLAG,RIMFLG      ;RIM?\r
564         JRST   RIMTB            ;YES./Y\r
565         >\r
566         TRNE   FLAG,XFLG        ;TRANSFER EVERYTHING MODE?\r
567         JRST   PRECOP           ;YES./X\r
568 ;LOOP TO COPY ALL FILES BEGINS HERE FROM MAIN2\r
569 MAINA3: TRNN   AUXFLG,FFLG      ;LIST DSK DIR SHORT?\r
570         TRNE   FLAG,LFLG        ;LIST DIRECTORY?\r
571         JRST   DTPDIR           ;YES./F OR /L\r
572         PUSHJ  P,ININIT         ;INITIALIZE INPUT FILE\r
573         TRNE   AUXFLG,DTAIN     ;DEC TAPE INPUT?\r
574         PUSHJ  P,DTADIR         ;INIT DTA DIR\r
575 \r
576 IFN FTDSK,<TRNE   AUXFLG,DSKIN  ;NO, DISK INPUT?\r
577         PUSHJ  P,DSKDIR         ;OR DSK>\r
578 MAINA4: PUSHJ  P,LOOK           ;GET A FILE TO COPY\r
579         JRST   MAINA5           ;NO MORE\r
580         LOOKUP IN,ZRF\r
581         JRST   ERR3             ;LOOKUP FAILURE\r
582 IFN WCH,<\r
583 MAINA6: TRNN  AUXFLG,DTAIN+DTAOUT\r
584         JRST  .+5\r
585         HLRZ  0,ZRF+1\r
586         CAIE  0,(SIXBIT /DMP/)\r
587         IFN DISK30,<CAIN 0,(SIXBIT/SVE/)>\r
588         IFE DISK30,<CAIN 0,(SIXBIT/SAV/)>\r
589         JRST  MAINA4            ;DONT COPY DMP OR SAV FILES ON DTA>\r
590         TLO   FLAG,NEWFIL\r
591         PUSHJ P,FILTYP\r
592         TRNE  AUXFLG,ONEOUT\r
593         JRST  PSCANA            ;OUT HAS BEEN INITIALIZED\r
594 IFE WCH,<\r
595         PUSHJ P,OKBLKS>\r
596         ENTER OUT,DTON          ;CREATE OUTPUT FILE\r
597         JRST  ERR4              ;DIR. FULL OR 0 FILE NAME\r
598         JRST  PSCANA\r
599 \r
600 MAINA5: TRZN  AUXFLG,REDFLG\r
601         JRST  IOERRN            ;NEVER READ A FILE\r
602         JRST  MAIN1\r
603 \fPSCANB:        TRNE AUXFLG,MTAIN!CDRIN!TTYIN!PPTIN     ;ON NON-DIR DEVICE?\r
604         TRZ     CALFLG,ALLCLF   ;END OF THE ONE OR MANY FILES SPECIFIED\r
605         TRON AUXFLG,ONEOUT      ;HAS OUT JUST BEEN INIT?\r
606         OUTPUT OUT,     ;YES, AND FIRST FILE IS EOF ONLY, INIT OUT IN\r
607                         ;CASE NO MORE SOURCE FILES\r
608         JRST PSCAN5     ;EMPTY FILE, CLOSE INPUT, RETURN FOR MORE\r
609 \r
610 PSCANA: TRO   AUXFLG,REDFLG     ;SET FLAG FOR INPUT FILE READ\r
611         PUSHJ P,INP             ;GO READ INPUT FILE\r
612         TRZ   AUXFLG,READ1\r
613         PUSHJ P,TTYZ            ;CHECK IF INPUT IS TTY\r
614         TRNE IOS,EOFBIT         ;EOF FIRST DATA?\r
615         JRST PSCANB\r
616         SKIPN IBF+2\r
617         JRST PSCANA\r
618 \r
619 PSCAN:  TRO AUXFLG,ONEOUT       ;INDICATE ONE OUTPUT FILE INITED\r
620         MOVE 0,OPTRA    ;PRESCAN A LINE, INITIALIZE LINE BUFFER PTR\r
621         MOVEM 0,OPTR\r
622         SETZM CDRCNT\r
623         PUSHJ P,CLRBUF  ;CLEAR LINE BUFFER\r
624         TROA FLAG,STS   ;START A FRESH LINE\r
625 PSCAN3: PUSHJ P,PUT     ;HERE FOR BINARY DATA\r
626 \r
627 PSCAN2: PUSHJ P,GET     ;GET CHARACTER\r
628         JRST PSCAN1     ;END OF FILE RETURN\r
629         TDNN FLAG,[XWD IFLG+IBFLG,BMOD] ;BIN. OR NO CHAR. PROCESSING\r
630         TLNE AUXFLG,SBIN\r
631         JRST PSCAN3     ;YES\r
632         MOVE T1,OPTR\r
633         CAIN CHR,DEL    ;VJC 4/16/69\r
634         JRST PSCAN2     ; STR# 10-2615\r
635         CAMN T1,OPTMAX  ;CHECK LENGTH OF LINE\r
636         JRST ERR10      ;LINE TOO LONG\r
637         IDPB CHR,OPTR   ;DEPOSIT CHAR. IN LINE BUFFER\r
638         CAIG CHR,24\r
639         CAIGE   CHR,20  ;LINE PRINTERR CONTROL CHAR\r
640         SKIP    1       ;NO\r
641         JRST PSCAN4     ;YES, TREAT AS END OF LINE\r
642         CAIG CHR,14\r
643         CAIGE CHR,12    ;END OF LINE CHARACTER?\r
644         JRST PSCAN2     ;NO, SO CONTINUE\r
645 PSCAN4: PUSHJ P,OUTLBF  ;YES, SO DUMP THE LINE BUFFER\r
646         JRST PSCAN      ;SCAN THE NEXT LINE\r
647 \r
648 PSCAN1: LDB     CHR,OPTR        ;PICK UP LAST CHAR.\r
649         CAIN    CHR,CZ          ;IS IT ^Z\r
650         TRNN    AUXFLG,TTYIN    ;FROM TTY?\r
651         JRST    PSCAN6          ;NO\r
652         SETZ    CHR,            ;YES,CLEAR CHAR.\r
653         DPB     CHR,OPTR        ;AND REMOVE FROM BUFFER\r
654 PSCAN6: PUSHJ P,OUTLBF  ;DUMP THE REMAINING BUFFER\r
655         TRNE FLAG,XFLG  ;COPY MODE?\r
656         JRST COPY2A     ;YES, GO COPY THE NEXT FILE\r
657 PSCAN5: CLOSE IN,\r
658         JRST MAINA4\r
659 \f;COME HERE AFTER /L,/D,/R ON DISK OR THROUGH COPYING\r
660 \r
661 MAIN1:  RELEAS DIR,     ;RELEASE THE DIRECTORY DEVICE\r
662         RELEAS IN,INHIB ;RELEASE THE INPUT DEVICE\r
663         SKIPL T4,ESWTCH ;MORE COMMAND STRING TO PROCESS?\r
664         JRST MAIN2      ;YES\r
665 \r
666 ;COME HERE AFTER /D,/R ON DTA. ALSO FROM ABOVE\r
667 \r
668 MAINB:  CLOSE OUT,      ;CLOSE THE OUTPUT FILE\r
669         PUSHJ P,OUTP1   ;CHECK THE FINAL ERROR BITS\r
670 IFN FTDSK,<TLNE AUXFLG,NSPROT   ;NON-ST. PROT?\r
671         TRNN AUXFLG,DSKOUT+DTAOUT       ;DISK OUT/ OR DTA\r
672         JRST MAINB1     ;NO\r
673         LDB 0,PRPTL\r
674         DPB 0,PRPTD\r
675         RENAME OUT,DTON ;SET UP RENAME REQUEST\r
676         JRST DERR6      ;DISK ERROR\r
677 MAINB1:>\r
678         RELEAS OUT,     ;RELEASE THE OUTPUT DEVICE\r
679         JRST PIP2       ;PROCESS THE NEXT COMMAND\r
680 \r
681 MAIN2:  PUSHJ P,DESCRP  ;GET THE NEXT INPUT FILE TO PROCESS\r
682         PUSHJ P,INLOOK\r
683         PUSHJ P,M4\r
684         HRRZM T4,ININI1\r
685         JRST MAINA3\r
686 ;END OF LOOP BEGINNING AT MAINA3\r
687 \f;SUBROUTINE TO INITIALIZE THE INPUT FILE\r
688 \r
689 ININIT: MOVE T1,SVJBF1  ;SVJBF1=END OF OUTPUT BUFFERS\r\r
690         MOVEM T1,JOBFF  ;COMPARE OMODE CODE\r
691         MOVEI 0,IBF\r
692         MOVEM 0,DEVICE+1\r
693         OPEN IN,ININI1\r
694         JRST ERR1A      ;NOT AVAILABLE ERROR\r
695         INBUF IN,1      ;TRY ONE INPUT BUFFER FOR SIZE\r
696         EXCH T1,JOBFF   ;HOW MANY INBUFFERS WILL FIT?\r
697         SUB T1,SVJBF1\r
698         HRRZ 0,JOBREL\r
699         SUB 0,JOBFF     ;JOBREL-SVJBF1=TOTAL SPACE LEFT\r
700         IDIVM 0,T1\r
701         MOVEI T4,ININIT ;RETURN FROM MORCOR IS ININIT\r
702         CAIGE T1,1      ;1 OR MORE THAN 1 FITS?\r
703         JRST MORCOR     ;NO, GET MORE CORE\r
704         INBUF IN,(T1)   ;SET UP AS MANY BUFFS AS FIT\r
705         MOVE 0,IBF+1    ;SAVE ORIGINAL MODE\r
706         MOVEM 0,SVIBF\r
707         POPJ P,\r
708 \f;THIS ROUTINE GETS AN INPUT UNIT DESCRIPTOR AND, FOR\r
709 ;ADVANCE FILE AND BSPF ON MTA, ENSURES THE VALUE 1 IF NO\r
710 ;NUMBER WAS GIVEN.\r
711 \r
712 DESCRP: SETZM AUX       ;WILL GET ANY MTA REQ. GOING TO AUXFLG.\r
713         TRZE    AUXFLG,SYSFLG   ;IS THIS DEVICE SYS.?\r
714         TRO     AUXFLG,SYSLST   ;YES,SET SYS AS LAST DEVICE\r
715         SETZM AB        ;MTA VALUE SWITCHES\r
716         SETZM PR        ;PROTECTION\r
717         SETZM PP        ;PROJ-PROG NUMBER\r
718 ;********************************************************************\r
719         PUSHJ P,NAME    ;GO SCAN INPUT SIDE OF COMMAND STRING\r
720         MOVE T1,PR      ;PROTECTION\r
721         HLLZM T1,PR     ;IGNORE PR FLAG IN RHS FOR INPUT\r
722         TRZ AUXFLG,DTAIN+DSKIN+PPTIN+MTAIN+CDRIN+TTYIN\r
723         PUSHJ P,CHECK1  ;CHECK UNIT, AND FOR _\r
724 \r
725 IFN FTDSK,<TRNN AUXFLG,DSKIN    ;DSK INPUT?\r
726         JRST DESCR1     ;NO\r
727         TRNE    AUXFLG,SYSFLG   ;IS THIS DEVICE SYS?\r
728         JRST DESCR1     ;YES\r
729         TRNN    AUXFLG,SYSLST   ;WAS LAST DEVICE?\r
730         JRST DESCR1     ;NO\r
731         MOVE T2,FNPPNS  ;YES, SAVE LAST [P,P]\r
732         SKIPE PP        ;[P,P] ZERO?\r
733         JRST DESCR1\r
734         MOVEM T2,PP     ;YES, MAKE OLD [P,P] CURRENT [P,P]\r
735         MOVEM T2,FNPPN  ;RESERVE [P,P]>\r
736 DESCR1: SKIPE XNAME     ;NO OVERSHOOT ALLOWED\r
737         JRST ERR6A\r
738 \r
739 ABCHK:  HLRZ T2,AB      ;NO RECS/FILES TO BACKSPACE\r
740         JUMPN T2,.+2    ;IF 0\r
741         MOVEI T2,1      ;GUARANTEE ONE\r
742         HRLM T2,AB      ;SET AB LH\r
743 \r
744         HRRZ T2,AB      ;NO RECS/FILES TO ADV\r
745         JUMPN T2,FNSET  ;IF 0\r
746         AOS AB          ;GUARANTEE 1\r
747         JRST    FNSET   ;FIND OUT DETAILS OF FILENAME\r
748 \f\r
749 ;IF A NON-STANDARD OUTPUT PROTECTION IS REQUESTED, SAVE FOR RENAME.\r
750 \r
751 PROTK:  MOVE T1,PR\r
752         TRNN T1,1\r
753         JRST PROTK1\r
754         HLLZM T1,PROTS\r
755         HLLZM T1,PR\r
756         TLOA AUXFLG,NSPROT\r
757 PROTK1: SETZB   T1,PR\r
758         POPJ P,\r
759 \r
760 ;TEST "DEVICE" TO SEE IF DESTINATION DEVICE IS DTA, DSK, PTP, LPT, TTY, MTA\r
761 ;IF ANY IS TRUE, SET RELEVANT BIT IN AUXFLG.  "0" CONTAINS\r
762 ;"DEVICE" ON ENTRY.\r
763 \r
764 DEVTST: DEVCHR          ;GET DEVICE CHARACTERISTICS\r
765 IFN FTDSK,<TLNN 0,DSKBIT        ;IS OUTPUT DEV DSK?\r
766         JRST DEVTSU     ;NO\r
767         TRO AUXFLG,DSKOUT       ;YES, SET BIT\r
768         PUSH    P,DEVICE        ;SAVE DEVICE NAME\r
769         POP     P,ADSK          ;PUT NAME IN DSK INIT\r
770         POPJ P,\r
771 DEVTSU:>\r
772         JUMPE   0,DEVER2        ;NON-EXISTENT DEVICE\r
773         TLNN 0,OUTBIT   ;CAN DEV DO OUTPUT?\r
774         JRST ERR6A      ;NO\r
775 \r
776         TLNE 0,DTABIT   ;DECTAPE?\r
777         TRO AUXFLG,DTAOUT       ;YES\r
778 \r
779         TLNE 0,PTPBIT   ;PAPER TAPE PUNCH?\r
780         TRO AUXFLG,PPTOUT\r
781 \r
782         TLNE 0,LPTBIT   ;LINE PRINTER?\r
783         TRO AUXFLG,LPTOUT\r
784 \r
785         TLNE 0,TTYBIT   ;TELETYPE?\r
786         TRO AUXFLG,TTYOUT\r
787 \r
788         TLNE 0,MTABIT   ;MAGTAPE?\r
789         TRO AUXFLG,MTAOUT\r
790 \r
791         POPJ P,\r
792 \f\r
793 ;ROUTINE TO CHECK IF DEVICE SYS AND SET [P,P], IF NONE GIVEN\r
794 \r
795 IFN FTDSK,<\r
796 PSYSP:  CAME    0,[SIXBIT /SYS/];IS DEVICE SYS?\r
797         POPJ    P,              ;NO\r
798         MOVE    T1,SYSPP        ;GET SYS PP\r
799         MOVEM   T1,PP           ;AND SET IT\r
800         TRO     AUXFLG,SYSFLG   ;SET FLAG TO INDICATE\r
801         POPJ    P,              ;CURRENT INPUT DEVICE IS SYS>\r
802 \r
803 DEVER1: \r
804 DEVER2: MOVE    T1,DEVICE\r
805 DEVER:  MOVEM   T1,DEVERR\r
806         ERRPNT  </?Device />\r
807         PUSHJ   P,P6BIT\r
808                 DEVERR\r
809         ERRPN2  </does not exist!/>\r
810 ;ROUTINE TO INIT PDL POINTER AND TTY\r
811 \r
812 INICN1: MOVEI   P,PDL-1         ;INITIALIZE PUSHDOWN POINTER\r
813 INICN2: MOVE    0,SVJBFF        ;IS INITIALIZED AT PIP1\r
814         MOVEM   0,JOBFF         ;SET JOBFF TO BEGINNING OF BUFFER AREA\r
815         PUSHJ   P,INICON        ;INITIALIZE THE TTY\r
816         INBUF   CON,1           ;ONE INBUFFER\r
817         OUTBUF  CON,1           ;ONE OUTBUFFER\r
818         MOVE    0,JOBFF\r
819         HRRZM   0,DTJBFF        ;JOBFF AFTER 2 TTY BUFFERS SET\r
820         OUTPUT   CON,           ;INITIALIZE BUFFER POINTERS\r
821         JRST    (T5)\r
822 \r
823 ;ROUTINE TO CLEAR LINE BUFFER\r
824 \r
825 CLRBUF: SETZM   LBUF            ;SUBR. TO CLEAR LINE BUFFER\r
826         MOVE    0,[XWD LBUF,LBUF+1]\r
827         BLT     0,LBUFE\r
828         POPJ    P,\r
829 \r
830 \f;COMMAND SCANNER ROUTINE\r
831 \r
832 NAME:   TRNN    CALFLG,SSWTCH   ;RETURN NULL IF _ OR END-OF-LINE SEEN\r
833         SKIPGE  ESWTCH\r
834         JRST    NM13            ;\r
835         TRZ     CALFLG,NSWTCH\r
836         SKIPE   T1,XNAME        ;IF COMMAND SCAN OVERSHOOT PICKED UP\r
837                                 ;DEVICE NAME, USE IT NOW\r
838         JRST    NM7\r
839         TRZ     CALFLG,DEV\r
840 ;LOOK FOR FILE NAME, EXT\r
841 NM1:    SETZM   FILEX\r
842 NM2:    SETZM   FILNAM\r
843         MOVE    T1,NM15\r
844 ;LOOP TO PICK OFF FILENAME, EXT\r
845 NM3:    PUSHJ   P,GETCOM        ;GO GET 7 BIT ASCII CHAR. FROM COMMAND STRING\r
846         CAIE    0,"*"           ;TO ALLOW FN.EX = *.*\r
847         CAIL    0,"A"           ;ALPHABETIC CHARACTER?\r
848         CAILE   0,"Z"\r
849         JRST    NM4A            ;NO\r
850 NM4:    SUBI    0,40            ;CONVERT TO SIXBIT\r
851         TLNE    T1,770000       ;6 CHARS. YET?\r
852         IDPB    0,T1            ;NO\r
853         JRST    NM3             ;GET NEXT CHAR.\r
854 NM4A:   CAIL    0,"0"           ;NUMERIC?\r
855         CAILE   0,"9"\r
856         JRST    NM5             ;NO\r
857         JRST    NM4\r
858 \f;CHARACTER NOT *,0-9,A-Z\r
859 NM5:    CAIG    0,CR            ;CARRIAGE RETURN\r
860         CAIGE   0,LF            ;LINE FEED\r
861         CAIN    0,ALTMOD        ;ALTMODE\r
862         JRST    NM5A            ;YES\r
863         CAIN    0,CZ            ;END-OF-FILE(CCL)?\r
864 NM5A:   SOSA    ESWTCH          ;YES, OR EOF\r
865         CAIN    0,COMMA         ;COMMA\r
866         JRST    NM6             ;YES\r
867         CAIN    0,PERIOD        ;PERIOD\r
868         JRST    NM10            ;YES\r
869         CAIN    0,COLON         ;COLON\r
870         JRST    NM9             ;YES\r
871         CAIN    0,";"           ;IS THE REST A COMMENT?\r
872         JRST    NM16            ;YES\r
873         CAIN    0,"C"-100       ;^C\r
874         EXIT                    ;IN CASE JACCT ON ???\r
875         CAIE    0,LA            ;LEFT ARROW\r
876         JRST    NM5B            ;NO\r
877         TRO     CALFLG,SSWTCH   ;SET LEFT ARROW SWITCH\r
878         TRNE    CALFLG,DEV      ;HAS A DEVICE BEEN SEEN?\r
879         TRO     CALFLG,DVSWTH   ;YES-NEEDED FOR /Z/,/D\r
880 \r
881 NM6:    SKIPN   T1,FILEX        ;COMMA ROUTINE - FIGURE OUT WHAT WE HAVE\r
882         JRST    NM11            ;NO FILE NAME TEMPORARILY IN FILEX\r
883         EXCH    T1,FILNAM       ;PUT THE FILE NAME WHERE IT BELONGS\r
884         HLLZM   T1,FILEX        ;PUT THE EXTENSION WHERE IT BELONGS\r
885         POPJ    P,\r
886 \r
887 NM7:    SETZM   XNAME           ;USE XNAME ONLY ONCE\r
888         CAIN    T1,1            ;1 FLAGS A NULL OVERSHOOT\r
889         JRST    NM13            ;RETURN NULL NAME\r
890 NM8:    MOVEM   T1,DEVICE       ;NEW DEVICE\r
891         TRO     CALFLG,DEV\r
892         JRST    NM1             ;LOOK FOR A FILE NAME AND EXTENSION\r
893 \r
894 NM9:    TRNN    CALFLG,DEV      ;COLON ROUTINE - IS DEVICE NAME IN YET?\r
895         JRST    NM12            ;NO\r
896         SKIPN   T1,FILNAM       ;SCAN OVERSHOOT - NULL OVERSHOOT?\r
897         MOVEI   T1,1            ;YES - FLAG NULL OVERSHOOT WITH A 1\r
898         MOVEM   T1,XNAME        ;XNAME = OVERSHOOT NAME\r
899         JRST    NM14\r
900 NM10:   SKIPE   FILEX\r
901         JRST    ERR6\r
902         MOVE    0,FILNAM        ;PERIOD ROUTINE - SAVE FILE NAME\r
903         MOVEM   0,FILEX         ;TEMPORARILY IN FILEX\r
904         JRST    NM2             ;LOOK FOR EXTENSION\r
905 NM11:   SKIPN   FILNAM          ;WAS A FILE NAME SPECIFIED?\r
906         TRNE    CALFLG,DEV      ;WAS ANYTHING SPECIFIED?\r
907         POPJ    P,              ;YES\r
908 NM12:   SKIPE   T1,FILNAM       ;NULL NAME SPECIFIED?\r
909         JRST    NM8             ;NO - SO REMEMBER AND LOOK FOR FILE NAME\r
910 \r
911 NM13:   TRO     CALFLG,NSWTCH   ;RETURN A NULL NAME\r
912         SETZM   FILEX\r
913 NM14:   SETZM   FILNAM\r
914         POPJ    P,\r
915 \r
916 NM15:   POINT   6,FILNAM\r
917 NM5B:   CAIG    0,LA            ;ALLOW ANY SIXBIT CHAR NOT CS DELIMITER\r
918         CAIG    0,SPACE         ;SPACES IGNORED\r
919         JRST    NM3             ;IGNORE NOT LEGAL SIXBIT\r
920         JRST    NM4             ;ACCEPT\r
921 \r
922         PUSHJ   P,GETBUF        ;GET NEXT ASCII CHAR.\r
923 NM16:   CAILE   0,LF\r
924         CAIG    0,CR            ;IF LF,FF,VT,OR CR\r
925         JRST    NM5A            ;RETURN\r
926         CAIE    0,ALTMOD        ;SAME IF ALTMOD\r
927         CAIN    0,CZ            ;OR ^Z\r
928         JRST    NM5A\r
929         JRST    NM16-1          ;GET NEXT CHARACTER\r
930 \r
931 \f;ROUTINE TO OUTPUT ONE LINE FROM LBUF\r
932 \r
933 OUTLBF: TRNE FLAG,LINE\r
934         JRST OUTLBA     ;OUTPUT LINE-BY-LINE\r
935 OUTCH1: MOVE T2,OPTRA   ;OUTPUT CHARACTER-BY-CHARACTER\r
936 OUTLB1: CAMN T2,OPTR    ;ARE ALL CHARACTERS OUT?\r
937         POPJ P,         ;YES\r
938         ILDB CHR,T2     ;NO\r
939         PUSHJ P,PUT     ;GO OUTPUT CHARACTER\r
940         JRST OUTLB1\r
941 OUTLBA: TLNE FLAG,CHKFLG;PAREN COUNTING?\r
942         JRST OUTCHK     ;YES, SO DO IT\r
943         TRNE AUXFLG,TTYOUT+LPTOUT\r
944         JRST OUTCH1     ;IF OUTPUT TO TTY OR LPT DO CHR BY CHR  \r
945         MOVEI T1,4      ;CLEAR UNUSED PORTION OF LAST WORD USED IN LBUF\r
946         MOVEI T2,0\r
947         MOVE T3,OPTR\r
948         IDPB T2,T3\r
949         SOJG T1,.-1\r
950         MOVEI T2,5\r
951         HRRZ T1,OPTR    ;COMPUTE NUMBER OF WORDS FILLED\r
952         SUBI T1,LBUF-1\r
953         JUMPE T1,OUTLB3 ;DO NOTHING IF BUFFER EMPTY\r
954         IMULM T1,T2     ;COMPUTE CHARACTER COUNT=5 TIMES WORD CT\r
955 ;THIS IS WHERE OLD FORTRAN MODE WAS TESTED.\r
956         CAMG T2,OBF+2   ;WILL LINE FIT IN THE OUTBUFFER?\r
957         JRST OUTLB2     ;YES\r
958         PUSHJ P,OUTP    ;NO, SO DUMP BUFFER AND CHECK ERROR BITS\r
959         MOVEI T6 ,1\r
960         TDNE T6,LBUF    ;SEQUENCED?   \r
961         TRNN AUXFLG,DTAOUT      ;YES, ON DTA?\r
962         SKIP    1       ;NO\r
963         ADDI T2,40*5    ;LEAVE EDITING ROOM\r
964 OUTLB2: MOVNS T2\r
965         ADDM T2,OBF+2   ;UPDATE OUTBUFFER CHARACTER COUNT\r
966         HRLI T2,LBUF\r
967         HRR T2,OBF+1\r
968         AOJ T2,\r
969         ADDB T1,OBF+1   ;UPDATE OUTBUFFER BYTE POINTER\r
970         BLT T2,(T1)     ;MOVE DATA TO OUTBUFFER\r
971 OUTLB3: POPJ P,\r
972 \f;ROUTINE TO PUT ONE CHAR INTO OUT BUFFER\r
973 \r
974 TABOUT: MOVEI   CHR,TAB ;OUTPUT A TAB\r
975 PUT:    SOSG OBF+2      ;SUBR. TO OUTPUT ONE CHARACTER IN AC CHR\r
976         PUSHJ P,OUTP    ;IF BUFFER FULL, DUMP AND CHECK ERR BITS\r
977         IDPB CHR,OBF+1  ;PUT CHARACTER IN BUFFER\r
978         POPJ P,\r
979 \r
980 ;ROUTINE TO DUMP OUT BUFFER WHEN FULL\r
981 \r
982 OUTP:   OUT OUT,        ;SUBR. TO DUMP OUTBUFFER AND CHECK ERR BITS\r
983         JRST    CPOPJZ  ;NO ERRERS,BUT CLEAR IOS JUST IN CASE\r
984 OUTP1:  GETSTS OUT,IOS  ;HERE FOR BIT CHECKING ONLY\r
985         PUSHJ P,OUTP4\r
986         SETSTS OUT,(IOS);ERRORS WERE DETECTED\r
987         POPJ P,         ;NO ERRORS\r
988 \r
989 OUTP4:  TRNN AUXFLG,MTAOUT\r
990         JRST .+3\r
991 OUTP3:  TRNE IOS,EOTBIT ;EOT?\r
992         JRST .+3        ;YES\r
993         TRNN IOS,740000 ;ANY ERROR BITS ON?\r
994         JRST CPOPJ1     ;NO\r
995         PUSHJ P,COMERR  ;YES\r
996 \r
997         JSP T5,INICN2   ;INIT TTY\r
998         PUSHJ P,QUEST\r
999         ERRPN2  </Output device />\r
1000         PUSHJ   P,P6BIT\r
1001                 ODEV\r
1002         SKIPN   DTON            ;ONLY IF THERE IS A FILE NAME\r
1003         JRST    .+4             ;DON'T PRINT IF NOT\r
1004         ERRPN2  </: file />\r
1005         MOVEI T3,DTON   ;OUTPUT FILE NAME LOC\r
1006         PUSHJ P,FN.EX   ;PRINT FILE NAME EXT\r
1007         MOVE T2,AUXFLG\r
1008         ANDI T2,MTAOUT+DSKOUT+DTAOUT\r
1009 \f\r
1010 IOERR:  MOVEI T1,TXTC   ;PHYSICAL END OF TAPE\r
1011         TRNE IOS,EOTBIT\r
1012         JRST PTEXT2     ;YES\r
1013 \r
1014         MOVEI T1,TXTD2  ;7-9 PUNCH MISSING\r
1015         TRNN T2,CDRIN\r
1016 \r
1017 IFN FTDSK,<\r
1018         MOVEI   T1,TXTD3\r
1019         TRNN    T2,DSKIN!DSKOUT>\r
1020 \r
1021         MOVEI T1,TXTD   ;WRITE LOCK ERROR\r
1022         TRNN T2,DSKIN+DSKOUT+DTAIN+DTAOUT+MTAIN+MTAOUT\r
1023 \r
1024         MOVEI T1,TXTD1\r
1025         TRNE IOS,WRTLOK\r
1026         JRST PTEXT2\r
1027 \r
1028         MOVEI T1,TXTA   ;DEVICE ERROR\r
1029         TRNE IOS,200000\r
1030         JRST PTEXT2\r
1031 \r
1032         MOVEI T1,TXTB   ;CHECKSUM/PARITY ERROR\r
1033         TRNE IOS,100000\r
1034         JRST PTEXT2\r
1035 \r
1036 IFN FTDSK,<\r
1037         HRRZ    T1,TABLE+14\r
1038         TRNN    T2,DSKOUT       ;QUOTA EXCEDED>\r
1039 \r
1040         MOVEI T1,TXTC1  ;BLOCK TOO LARGE\r
1041         JRST PTEXT2\r
1042 \f;DEVICE ERROR COMMENTS\r
1043 \r
1044 TXTD:   ASCIZ /write (lock) error/\r
1045         JRST IOERRN     ;NO RECOVERY\r
1046 \r
1047 TXTD1:  ASCIZ /binary data incomplete/\r
1048         JRST IOERRG\r
1049 \r
1050 TXTD2:  ASCIZ /7-9 punch missing/\r
1051         JRST IOERRG\r
1052 \r
1053 TXTA:   ASCIZ /device error/\r
1054         JRST IOERRG\r
1055 \r
1056 TXTB:   ASCIZ /checksum or parity error/\r
1057         JRST IOERRG\r
1058 \r
1059 TXTC:   ASCIZ /physical eot/\r
1060         JRST IOERRG\r
1061 \r
1062 TXTC1:  ASCIZ /block or block number too large/\r
1063         ;FALLS THROUGH TO IOERRN\r
1064 \f\r
1065 IOERRN: RELEAS TAPE,    ;NO RECOVERY ERRORS EXIT HERE\r
1066         RELEAS DIR,\r
1067         RELEAS OUT,\r
1068         RELEAS IN,\r
1069 IFN DISK30,<\r
1070         RELEAS BLKIN,>\r
1071         JRST PIP2       ;GET NEXT COMMAND\r
1072 \r
1073 IFN FTDSK,<\r
1074 TXTD3:  ASCIZ   /monitor detected software error/>\r
1075 \r
1076 ;TEST IF /G FLAG(IGNORE ERRORS) SET\r
1077 \r
1078 IOERRG: TLNN FLAG,GFLG          ;PRINTED CURRENT MESSAGE\r
1079         JRST IOERRN             ;NO RECOVERY\r
1080 \r
1081         ERRPN2</\r
1082 />                              ;PRINT CR, LF DON'T MOVE>\r
1083 \r
1084         RELEAS CON,\r
1085         TRNE AUXFLG,TTYOUT      ;TTY OUTPUT DEVICE?\r
1086         PUSHJ P,OMODE           ;YES, INIT OUTPUT DEVICE\r
1087         TRNE AUXFLG,TTYIN       ;REINIT TTYIN,TTYOUT\r
1088         PUSHJ P,ININIT\r
1089         TRZ IOS,740000          ;CLEAR FILE STATUS, I/O ERRORS\r
1090         TRNE T2,MTAIN+MTAOUT\r
1091         TRZ IOS,EOTBIT          ;CLEAR PHYSICAL EOT I/O ERROR\r
1092         MOVS 0,[XWD 1,SAVAC]\r
1093         BLT 0,3\r
1094         MOVE T5,SAVAC+3\r
1095         MOVE T6,SAVAC+4\r
1096         POPJ P,\r
1097 \r
1098 \fCOMERR:        MOVE 0,[XWD 1,SAVAC]    ;SAVE ACS T1,T2,T3,T5,T6\r
1099         BLT 0,SAVAC+2\r
1100         MOVEM T5,SAVAC+3\r
1101         MOVEM T6,SAVAC+4\r
1102         TRNE AUXFLG,TTYOUT      ;RELEASE ANY TTYIO\r
1103         RELEAS OUT,\r
1104         TRNE AUXFLG,TTYIN\r
1105         RELEAS IN,\r
1106         POPJ P,\r
1107 ;PRINT FILE NAME AND EXTENSION FROM (T3), 1(T3).\r
1108 \r
1109 FN.EX:  MOVE T1,(T3)    ;T1=FILENAME\r
1110         HLRZ T6,1(T3)   ;T6=FILE EXT\r
1111         CAIN T6,(SIXBIT /UFD/)\r
1112         SETZ T1,        ;UFD FILES ONLY ARE ASSUMED TO HAVE FILENAME\r
1113         MOVEM T1,DERR2  ;OF NUMERIC FORM (#,# P-P NUMBER).\r
1114         JUMPE T6,DERR2A ;FILE EXT=0?\r
1115         CAIE T6,(SIXBIT /UFD/)\r
1116         JRST DERR2B     ;NO\r
1117 \r
1118         HLRZ DOUT,(T3)  ;YES, GET PROJ. NO.\r
1119         MOVEI T2,PUTCON ;PRINT PROJ-PROG. NO.\r
1120         PUSHJ P,OUTDC1  ;CONVERT TO ASCII\r
1121 \r
1122         MOVEI CHR,COMMA\r
1123         PUSHJ P,PUTCON\r
1124 \r
1125         HRRZ DOUT,(T3)  ;GET PROG. NO.\r
1126         PUSHJ P,OUTDC1  ;CONVERT TO ASCII\r
1127 \r
1128 DERR2B: TLO     T6,"."-40       ;PUT SIXBIT PERIOD\r
1129 DERR2A: MOVEM   T6,DERR2+1      ;INTO EXTENSION\r
1130         PUSHJ   P,P6BIT\r
1131                 DERR2\r
1132         PUSHJ   P,P6BIT\r
1133                 DERR2+1\r
1134         MOVEI   CHR," "\r
1135         JRST    PUTCON\r
1136 \r
1137 \r
1138 \r
1139 \r
1140 \f;THIS ROUTINE GETS A 7 BIT ASCII CHARACTER FROM THE COMMAND STRING\r
1141 ;AND RETURNS IT TO THE COMMAND SCANNER ROUTINE (NAME) IN AC0\r
1142 \r
1143 GETCOM: PUSHJ P,GETBUF\r
1144         CAIN 0,"/"      ;SINGLE CHARACTER SWITCH\r
1145         JRST GETT6\r
1146         CAIN 0,"("      ;LOOK FOR (MULTI-CHAR.) SWITCH\r
1147         JRST GETT3\r
1148         CAIN 0,"<"      ;GO LOOK FOR PROTECTION\r
1149         JRST GETT9\r
1150         CAIE 0,"["\r
1151         POPJ P,\r
1152 \r
1153 GETT10: PUSHJ P,GETDEC  ;LOOK FOR PROJECT-PROGRAMMER NUMBER\r
1154         CAILE T7,-1     ;GREATER THAN HALF WORD?\r
1155         JRST ERR2A      ;YES, ERROR\r
1156         CAIE 0,","      ;SEPARATOR?\r
1157         JRST GETUPJ     ;OR TERMINATOR (NON-NUMERIC)\r
1158         HRLZM T7,PP\r
1159         PUSHJ   P,GETDEC\r
1160         CAILE   T7,-1\r
1161         JRST    ERR2A\r
1162 \r
1163 GETT11: HRRM T7,PP\r
1164         CAIN 0,"]"      ;FORCE CORRECT TERMINATOR\r
1165         JRST GETCOM\r
1166         JRST ERR2\r
1167 \r
1168 GETT9:  PUSHJ P,GETOCT\r
1169         CAIN 0,">"      ;TERMINATE ON RIGHT BRKT ONLY\r
1170         CAILE T7,777    ;PR. IN RANGE?\r
1171         JRST ERR2A\r
1172         ROT T7,-11\r
1173         HLLOM T7,PR     ;RHS=1'S MEANS <> SEEN (PR MAY BE 0)\r
1174         JRST GETCOM\r
1175 \r
1176 GETUPJ: MOVE    T5,UPROJ\r
1177         HRLZM   T5,PP\r
1178         JRST    GETT11\r
1179 GETOCT: SKIPA   T5,[EXP 10]\r
1180 GETDEC: MOVEI   T5,12\r
1181 GETNUM: MOVEI T7,0      ;TO PICK UP P-P NUMBER\r
1182 GETN1:  PUSHJ P,GETBUF  ;AND PROTECTION\r
1183         CAIN 0," "      ;IGNORE SPACES\r
1184         JRST GETN1\r
1185         CAIL 0,"0"\r
1186         CAIL 0,"0"(T5)\r
1187         POPJ P,         ;GOT A NON-NUMERIC\r
1188         IMUL    T7,T5   ; MULTIPLY BY RADIX\r
1189         SUBI    0,"0"\r
1190         ADD     T7,0    ; ADD DIGIT\r
1191         JRST GETN1\r
1192 \fGETT3: PUSHJ P,GETT5   ;PROCESS SWITCH CHARACTER\r
1193         CAIN 0,")"      ;CLOSING PAREN?\r
1194         JRST GETCOM     ;YES\r
1195         CAIN 0,"M"      ;MTA FLAG?\r
1196         TRO FLAG, MTFLG ;SET MTA, LOOK FOR MULTI CHAR. SWITCH\r
1197         CAIE 0,"#"      ;MTA#\r
1198         JRST GETT3      ;NO\r
1199         TRNN FLAG,MTFLG ;ONLY LOOK AFTER # IF MTFLG IS ON.\r
1200         JRST ERR6A      ;I.E. IF MT SWITCH IS IN PROGRESS.\r
1201         PUSHJ P,GETNUD  ;GET A NUMBER\r
1202         CAIE 0,"D"      ;TERMINATED BY D?\r
1203         CAIN 0,"A"      ;TERMINATED BY A?\r
1204         JRST GETT3A     ;YES, MARK AB UPPER\r
1205         CAIE 0,"P"      ;ONLY A,D,P AND B CAN BE\r
1206         CAIN 0,"B"      ;PRECEDED BY #.\r
1207         SKIP    1\r
1208         JRST ERR6A\r
1209         HRRM T7,AB      ;NO. FILES/RECS TO ADVANCE\r
1210                         ;GOES IN AB (RH)\r
1211 GETT3B: PUSHJ P,GETT5A\r
1212         JRST GETT3\r
1213 \r
1214 GETT3A: HRLM T7,AB      ;NO. FILES/RECS TO BACK SPACE\r
1215         JRST GETT3B     ;GOES IN AB (LH)\r
1216 \r
1217 GETT6:  PUSHJ P,GETT5   ;PROCESS ONE SWITCH CHAR\r
1218         CAIE 0,"M"\r
1219         CAIN 0,")"      ;THESE ARE ILLEGAL 1-SWITCH CHARS.\r
1220         JRST ERR6A\r
1221         JRST GETCOM\r
1222 \r
1223 GETNUD: MOVEI T7,0      ;GET A DECIMAL NUMBER\r
1224 GETN2:  PUSHJ P,GETBUF  ;GET CHAR FROM COMMAND STRING\r
1225         CAIN 0,SPACE    ;SPACE?\r
1226         JRST GETN2      ;YES, IGNORE\r
1227         CAIL 0,"0"      ;NUMBER?\r
1228         CAILE 0,"9"\r
1229         POPJ P,         ;NO\r
1230         IMULI T7,^D10   ;T7*10\r
1231         ANDI 0,17       ;ADD ON LAST DIGIT\r
1232         ADD T7,0        ;+ LOW 4 BITS\r
1233         JRST GETN2\r
1234 \f\r
1235 ;GET NEXT COMMAND STRING CHAR(SWITCH),CHECK WITH TABLE,SET FLAGS\r
1236 \r
1237 GETT5:  PUSHJ P,GETBUF  ;GET CHAR FROM COMMAND STRING\r
1238 GETT5A: MOVE T2,[XWD 350700,DISPTB]     ;SET DISPTB NEXT SEARCH\r
1239         MOVEI T6,MTAREQ ;SET MTAREQ NEXT SEARCH\r
1240 \r
1241         TRNN FLAG,MTFLG ;SET UP TABLE TO SEARCH AND FLAG TO SET.\r
1242         HRRI T2,DISPTA  ;PUT IN BYTE POINTER, NOT MTA REQUEST\r
1243 \r
1244 ;SET TO LOOK AT NON-MTA LETTERS FIRST\r
1245 \r
1246         TRNN FLAG,MTFLG ;IF MTFLG SET, START AT DISPTB AND STORE RESULT IN\r
1247         MOVEI T6,AUXFLG ;MTAREQ, ELSE START AT DISPTA AND STORE RESULT IN\r
1248                         ;AUXFLG OR FLAG\r
1249 ;GET FIRST CHAR DISPTA OR DISPTB, LOOK FOR MATCH, SET SWITCH FLAGS.\r
1250 \r
1251 GETT7:  LDB T3,T2       ;COMPARE WITH LEFT 7 BITS OF\r
1252         JUMPN T3,GETT8  ;TABLE ENTRIES\r
1253         TRZ FLAG, MTFLG ;SEARCHED TABLE 1 (DISPTB) DROP MTA FLAG\r
1254         MOVEI T6,AUXFLG ;SET AUXFLG NEXT TABLE SEARCH\r
1255         TLNE AUXFLG,NOMORE      ;AFTER FIRST INPUT DEVICE ONLY ACCEPT MTA FLAGS\r
1256         POPJ P,\r
1257 \r
1258 GETT8:  CAIN T3,1       ;END OF DISPTA 1ST HALF?\r
1259         MOVEI T6,FLAG   ;YES, SEARCH DISPTA 2ND HALF FROM NOW ON\r
1260         CAIN T3,2       ;END OF DISPTA 2ND HALF?\r
1261         JRST ERR6A      ;SEARCHED TABLE 3, ERROR EXIT\r
1262         CAME T3,0       ;MATCHING CHARACTER?\r
1263         AOJA T2,GETT7   ;NO, GET NEXT SWITCH IN TABLE.\r
1264 \r
1265         MOVE T5,(T2)    ;YES, SET FLAG OR AUXFLG OR MTAREQ\r
1266         ORM T5,(T6)     ;FLAG OR AUXFLG\r
1267         TRNE FLAG,MTFLG\r
1268         ORM T5,AUX      ;MTA REQUESTS SAVED IN AUX\r
1269 IFE RIMSW,<\r
1270         TLNE FLAG,RIMFLG\r
1271         JRST RIMTB      ;NO RIM IF RIMSW=0\r
1272         >               ;PRINT ERROR MESSAGE\r
1273         POPJ P,         ;EXIT ON MATCHING CHAR\r
1274 \r\f\r
1275 ;ROUTINE TO GET ONE TTY OR CCL COMMAND STRING CHAR INTO AC 0\r
1276 \r
1277 GETTA:\r
1278 \r
1279         SOSLE TFI+2     ;SUBR TO GET ONE TTY CHAR IN AC 0\r
1280         JRST GETT2      ;BUFFER NOT EMPTY\r
1281         MOVE 0,TFI      ;BUFFER EMPTY, SAVE\r
1282         MOVE T5,TFO     ;CURRENT BUFFER LOCS\r
1283         PUSHJ P,INICON  ;BUFFER EMPTY SO RE-ATTACH TTY\r
1284         HRROM 0,TFI     ;RESTORE OLD BUFFER LOCS\r
1285         HRROM T5,TFO    ;USE PREVIOUSLY ASSIGNED I/O BUF. FOR TTY\r
1286         MOVE T5,COMCNT  ;DONT TYPE CR,LF\r
1287         CAIG T5,^D69    ;FOR SHORT LINE\r
1288         JRST GETTIN\r
1289         PUSHJ   P,INFO2 ;TYPE CR,LF\r
1290 GETTIN: INPUT CON,      ;GET THE NEXT LINE\r
1291         MOVE T5,TFI+2   ;SAVE CHAR COUNT\r
1292         RELEAS CON,     ;LET GO OF TTY FOR USE AS IN-OUT DEVICE\r
1293         MOVEM T5,TFI+2  ;RESTORE CHAR COUNT LOST DURING RELEASE\r
1294 GETT2:  ILDB 0,TFI+1    ;FETCH CHAR\r
1295 GETT4:  CAIE 0,ALT175   ;OLD ALTMODE?\r
1296         CAIN 0,ALT176\r
1297         MOVEI 0,ALTMOD  ;YES,MAKE NEW ALTMOD\r
1298         JUMPE   0,GETTA ;IGNORE NULL CHARS\r
1299         CAIL 0,140      ;LOWER CASE?\r
1300         TRZ     0,40    ;YES MAKE UPPER CASE?\r
1301         CAIE    0,XON   ;IGNORE XON,XOFF ONLY FOR\r
1302         CAIN    0,XOFF  ;TTY SERVICE TO SIGNAL TTY\r
1303         JRST    GETTA   ;PTR READ IN MODE\r
1304         POPJ P,\r
1305 \r
1306 ;ROUTINE TO GET ONE TTY CHAR FROM COMBUF INTO AC0\r
1307 \r
1308 GETBUF: SOSGE COMCNT    ;ANY CHARS LEFT?\r
1309         JRST ERR6B      ;NO, COMMAND ERROR\r
1310         ILDB 0,COMPTS   ;PICK UP CHAR FROM COMBUF\r
1311         POPJ P,\r
1312 \r
1313 ;ROUTINE TO INITIALIZE THE TTY, ASCII LINE MODE\r
1314 \r
1315 INICON: INIT CON,1      ;SUBR TO INITIALIZE THE TTY\r
1316         SIXBIT /TTY/\r
1317         XWD TFO,TFI     ;TTY OUT/IN BUFFER HEADERS\r
1318         EXIT            ;IF TTY NOT AVAILABLE,FATAL.JOB DET?\r
1319         POPJ P,\r
1320 \f;GET 7 BIT ASCII CHARACTER - INPUT FROM CCL COMMAND FILE\r
1321 \r
1322 GETEN2: SETOM   COMEOF          ;INDICATE END OF FILE\r
1323         MOVEI   0,CZ            ;NEEDED TO TERM CCL CS SCAN\r
1324         POPJ    P,\r
1325 \f;TABLE OF RECOGNIZED COMMAND LETTERS AND CORRESPONDING FLAG BITS\r
1326 \r
1327 DEFINE DISP (A,B)\r
1328 <       XWD <"A">*4000,B>\r
1329 ;MAGTAPE SWITCHES AND FLAG BITS. TABLE 1 (MTAREQ)\r
1330 DISPTB: DISP A,MTAFLG\r
1331         DISP B,MTBFLG\r
1332         DISP T,MTTFLG\r
1333         DISP W,MTWFLG\r
1334         DISP 8,MT8FLG\r
1335         DISP 5,MT5FLG\r
1336         DISP 2,MT2FLG\r
1337         DISP E,MTEFLG\r
1338         DISP U,MTUFLG\r
1339         DISP F,MTFFLG\r
1340         DISP D,MTDFLG\r
1341         DISP P,MTPFLG\r
1342         DISP #,0\r
1343         OCT 000000000000\r
1344 ;1ST BYTE 0=END OF DISPTB\r
1345 ;------------------------\r
1346 ;COMMAND STRING LETTERS AND FLAG BITS. TABLE 2 (AUXFLG)\r
1347 DISPTA:                 XWD <"Q">*4000+QFLG,0\r
1348                         XWD <"E">*4000+CDRFLG,0\r
1349         DISP F,FFLG\r
1350         OCT 004000000000\r
1351 ;1ST BYTE 1=END OF DISPTA 1ST HALF\r
1352 ;------------------------\r
1353 ;COMMAND STRING LETTERS AND FLAG BITS. TABLE 3 (FLAG)\r
1354         DISP A,LINE\r
1355         DISP B,BMOD\r
1356 IFN,K,< DISP C,TBMOD\r
1357         DISP D,DFLG\r
1358         DISP L,LFLG>\r
1359         DISP M,0\r
1360         DISP ),0\r
1361         DISP N,NSMOD\r
1362         DISP O,SQMOD+NSMOD+STS+OSFLG\r
1363                         XWD <"P">*4000+PFLG+PCONV,0\r
1364 IFN,K<  DISP R,RFLG>\r
1365         DISP S,SQMOD+NSMOD+STS\r
1366 IFN,K<  DISP T,SPMOD\r
1367                         XWD <"V">*4000+CHKFLG,LINE\r
1368         DISP X,XFLG>\r
1369         DISP Z,ZFLG\r
1370                         XWD <"U">*4000+OFLG,0\r
1371                         XWD <"Y">*4000+IBFLG+RIMFLG,0\r
1372                         XWD <"J">*4000+JFLG,0\r
1373                         XWD <"I">*4000+IFLG,0\r
1374                         XWD <"H">*4000+IBFLG,0\r
1375                         XWD <"G">*4000+GFLG,0\r
1376         OCT 010000000000\r
1377 ;FIRST BYTE 2=END OF DISPTA 2ND HALF\r
1378 \f;SUBR TO GET NEXT CHAR INTO AC CHR\r
1379 ;NO SKIP RETURN IS END OF FILE, SINGLE SKIP IS NORMAL RETURN\r
1380 \r
1381 GET:    TLNN FLAG,NEWFIL        ;NEW FILE?\r
1382         TLZN FLAG,PCONV+NEWFIL  ;NO,CONVERT THIS CHAR?\r
1383         JRST GETPC1     ;YES\r
1384         LDB CHR,IBF+1   ;GET CHAR\r
1385         CAIN CHR," "    ;SPACE?\r
1386         JRST GETPC2     ;YES, CONVERT TO LINE FEED\r
1387         CAIG CHR,"3"    ;IS THE CHAR A PROPER FORMAT CONTROL CHAR?\r
1388         CAIGE CHR,"*"\r
1389         JRST GETPC3     ;NO, SO OUTPUT LINE FEED FOLLOWED BY BAD CHAR\r
1390         CAIG CHR,"."    ;USE LEFT HALF OF TABLE?\r
1391         SKIPA CHR,PCHTAB-<"*">(CHR)\r
1392         MOVS CHR,PCHTAB-<"/">(CHR)\r
1393 GETPC4: DPB CHR,IBF+1   ;CLOBBER OLD CHAR, USUALLY BECOMES NULL\r
1394         LSH CHR,-7      ;BUT OTHERWISE BECOMES ANOTHER FORMAT CHAR\r
1395         ANDI CHR,377    ;EXTRACT THE CHAR TO BE OUTPUT\r
1396         TRZE CHR,200    ;=1 FOR GENERATING MULTIPLE LINE FEEDS\r
1397         TLO FLAG,PCONV  ;CONTINUE TO CONVERT\r
1398         JUMPN CHR,CPOPJ1;OUTPUT THE GENERATED CHAR UNLESS NULL\r
1399         POP     P,(P)   ;IGNORE NULL CHARS\r
1400         JRST    PSCAN4  ;DUMP THE LINE BUFFER\r
1401 GETPC1: TRNN FLAG,SUS   ;SUPPLYING SEQ. NUM. NOW?\r
1402         JRST GET2       ;NO\r
1403         ILDB CHR,PTRPT  ;YES, SO GET CHAR OF SEQ NUM\r
1404         JUMPN CHR,CPOPJ1;0 MARKS LAST CHAR\r
1405         LDB T1,IBF+1    ;GET FIRST CHAR OF THIS LINE\r
1406         MOVEI CHR,15\r
1407         CAIG T1,15      ;PREPARE TO OUTPUT A CR,LF\r
1408         CAIGE T1,12     ;IS FIRST CHAR OF LINE AN END OF LINE CHAR?\r
1409         MOVEI   CHR,TAB ;NO, SO OUTPUT A TAB\r
1410         TRZ FLAG,SUS    ;TURN OFF SUS SUPPLY\r
1411         JRST    GETA5\r
1412 GET5:   AOS IBF+1       ;HERE IF A SEQ NUM FOUND IN INBUFFER\r
1413         SUBI T1,5       ;IGNORE SEQ NUM, TAB AND DECREMENT CHAR COUNT\r
1414         MOVEM T1,IBF+2\r
1415         TRNE FLAG,NSMOD ;REMOVE SEQ NUMS MODE?\r
1416         JRST GET2       ;YES, SO GET NEXT CHAR\r
1417         MOVEM T2,SQNUM  ;SEQ NUM FROM BUFFER BECOMES NEW SEQ NUM\r
1418         PUSHJ P,OUTLBF  ;DUMP THE LINE BUFFER (IF REQUIRED)\r
1419         TRON FLAG,STS+SNI       ;TURN ON START OF LINE\r
1420                         ;AND NO-INCREMENT SEQ NUM FLAG\r
1421         PUSHJ P,CLRBUF  ;CLEAR LBUF IF IN THE MIDDLE OF A LINE\r
1422 \r
1423 GET2:   TRZE FLAG,ESQ   ;REPROCESS LAST CHAR?\r
1424         JRST GET1       ;YES\r
1425         SOSL T1,IBF+2   ;CHARS REMAINING IN INBUFFER?\r
1426         JRST GET4       ;YES\r
1427         PUSHJ P,INP     ;NO, SO REFILL AND CHECK ERR BITS\r
1428         TRNE IOS,EOFBIT ;END OF FILE? IOS HAS STATUS BITS\r
1429         POPJ P,         ;YES\r
1430         JRST GET2       ;NO, SO PROCESS INBUFFER\r
1431 \r
1432 GETPC3: TRO FLAG,ESQ    ;REPROCESS BAD CHAR\r
1433         TROA CHR,12*200 ;PRECEED BAD CHAR WITH LINE FEED\r
1434 GETPC2: MOVEI CHR,12*200;CHANGE SPACE TO LINE FEED\r
1435         JRST GETPC4\r
1436 \r
1437 PCHTAB: XWD 24*200,23*200+"."   ;/ *\r
1438         XWD 212*200+" ",177*200 ;0 +   VJC 4/16/49\r
1439         XWD 14*200,21*200       ;1 ,\r
1440         XWD 20*200,212*200+"0"  ;2 -\r
1441         XWD 13*200,22*200       ;3 .\r
1442 \r
1443 GET4:   ILDB CHR,IBF+1  ;FETCH CHAR FROM INBUFFER\r
1444         TDNN FLAG,[XWD IFLG+IBFLG,BMOD] ;BIN, IB, I OR SBIN MODE?\r
1445         TLNE AUXFLG,SBIN\r
1446         JRST CPOPJ1     ;YES, SO NO PROCESSING REQUIRED\r
1447 GET1:   LDB CHR,IBF+1   ;AFTER SEQ NUM, HERE FOR 1ST CHAR\r
1448         JUMPE CHR,GET2  ;IGNORE NULL CHARS\r
1449         CAIN CHR,LF     ;IGNORE LINE FEED IN FORTRAN OUTPUT\r
1450         TLNN FLAG,PFLG  ;/P SWITCH IN EFFECT?\r
1451         JRST GET1A      ;NO\r
1452         TLO FLAG,PCONV  ;CONVERT THE NEXT LIVE CHAR\r
1453         JRST GET2       ;GET NEXT CHAR\r
1454 GET1A:  MOVE T2,@IBF+1  ;BIT 35 OF BUFFER SET?\r
1455         TRZE T2,1\r
1456         JRST GET5       ;YES, THIS IS A SEQ NUM\r
1457         TRZE FLAG,STS   ;START SEQ (NEW LINE) FLAG ON?\r
1458         TRNN FLAG,SQMOD+SNI     ;YES, SEQ MODE OR SEQ COPY?\r
1459         JRST GET7       ;NO, SO PROCESS CHAR\r
1460         MOVE T2,SQNUM   ;NO, SO ADD 10. TO SEQ NUM\r
1461         MOVE T1,K1\r
1462         TRNE FLAG,OSFLG ;TEST FOR INCR. BY ONE\r
1463         MOVE T1,K4\r
1464         ADD T2,T1       ;ASCII INCREMENT\r
1465         AND T2,K3       ;MASK SIGNIFICANT DIGITS\r
1466         MOVE T1,T2\r
1467         AND T1,ZRO      ;MASK CARRY BITS\r
1468         ASH T1,-3\r
1469         SUB T2,T1       ;ADJUST CARRIES\r
1470         IOR T2,ZRO\r
1471         TRZN FLAG,SNI   ;NON-INCREMENT SEQ NUM FLAG ON?\r
1472         MOVEM T2,SQNUM  ;NO, SO SAVE THE RESULT\r
1473         TRO FLAG,LINE+SUS+ESQ   ;TURN ON SUPPLY SEQ, REPROCESS\r
1474                                 ;LAST CHAR, AND LINE-BY-LINE FLAGS\r
1475         AOS LBUF                ;SET BIT 35 IN LBUF TO MARK SEQ NUM\r
1476         MOVE T1,[POINT 7,SQNUM]\r
1477         MOVEM T1,PTRPT  ;INITIALIZE SEQ NUM PICK-UP POINTER\r
1478         JRST GET        ;GO OUTPUT FIRST CHAR OF SEQ NUM\r
1479 \f;ROUTINE TO INPUT INPUT FILE\r
1480 \r
1481 INP:    IN      IN,     ;INPUT DATA\r
1482         JRST    CPOPJZ  ;NO ERRORS ,BUT CLEAR IOS JUST IN CASE\r
1483 INERR:  GETSTS IN,IOS   ;SUBR TO CHECK INPUT ERR BITS\r
1484         TRNN AUXFLG,MTAIN       ;MTA INPUT?\r
1485         TRNE IOS,740000 ;ANY ERROR BITS SET?\r
1486         TRNN IOS,740000+EOTBIT  ;EOT FOR MTA?\r
1487         POPJ P,         ;NO\r
1488 \r
1489         PUSHJ P,COMERR  ;SAVE AC'S RELEASE TTY\r
1490         JSP T5,INICN2   ;YES SO PRINT OUT COMPLETE FILE DESCRIPTOR\r
1491         PUSHJ P,QUEST\r
1492         ERRPN2  </Input device />\r
1493         PUSHJ   P,P6BIT\r
1494                 DEVICE\r
1495         SKIPN   ZRF             ;IS THERE A FILE NAME\r
1496         JRST    .+4             ;NO,SO DON'T PRINT\r
1497         ERRPN2  </: file />\r
1498         MOVEI T3,ZRF    ;LOC OF INPUT FILE NAME TO T3\r
1499         PUSHJ P,FN.EX   ;DEPOSIT FILE NAME, EXT INTO TTY OUT BUFFER\r
1500         MOVE T2,AUXFLG\r
1501         ANDI T2,CDRIN+DTAIN+DSKIN+MTAIN\r
1502         PUSHJ P,IOERR   ;GO PRINT ERROR DESCRIPTOR\r
1503         SETSTS IN,(IOS)\r
1504         POPJ P,\r
1505 \r
1506 ;ROUTINE TO TEST IF BLOCK TOO LARGE, OR WRITE LOCKED\r
1507 \r
1508 QUEST:  MOVEI CHR,"?"   ;DEPOSIT "?" IN ERROR MSG\r
1509         TLNN FLAG,GFLG  ;ONLY IF /G NOT ON\r
1510         JRST PUTCON     ;/G NOT ON, PRINT ?(FATAL) BEFORE ERR MSG\r
1511 \r
1512         TRNN IOS,BIGBLK ;BLOCK NO. TOO LARGE?\r
1513         JRST QUEST2     ;NO\r
1514         TRNN AUXFLG,DTAIN+DTAOUT        ;YES\r
1515         POPJ P,         ;BLOCK TOO LARGE\r
1516 \r
1517         JRST PUTCON     ;DEPOSIT "?" FATAL EVEN IF /G ON\r
1518 \r
1519 QUEST2: TRNE IOS,WRTLOK ;WRITE LOCKED?\r
1520         TRNN AUXFLG,DTAIN+DTAOUT+MTAIN+MTAOUT+DSKOUT\r
1521         POPJ P,         ;NO\r
1522         JRST PUTCON     ;DEPOSIT "?" FATAL EVEN IF /G ON\r
1523 \f\r
1524 GET7:   TLNE FLAG,PCONV ;CONVERTING FORTRAN CARRAIGE CONTROL CHAR?\r
1525         JRST GET+1      ;YES, GO DO IT\r
1526         AOS T1,CDRCNT\r
1527         TLNE AUXFLG,CDRFLG\r
1528         JRST GET7B      ;CARD READER INPUT\r
1529 \r
1530 GET7C:  CAIN CHR,SPACE  ;SPACE?\r
1531         JRST GETA2      ;YES\r
1532         CAIN CHR,CR     ;CAR. RET.?\r
1533         JRST GETA3      ;YES\r
1534         TRZ FLAG,SPOK   ;CHAR NOT A SPACE STOP COUNTING CONSEC. SPACES\r
1535         CAIN CHR,TAB    ;TAB?\r
1536         JRST GETA5      ;KEEP TRACK OF TAB STOPS\r
1537         CAIG CHR,137\r
1538         CAIGE CHR,SPACE ;NON-SPACING CHARACTER?\r
1539         JRST CPOPJ1     ;YES, SO RETURN IMMEDIATELY\r
1540         SOSG TABCT      ;COUNT DOWN THE TAB STOP COUNTER\r
1541         JRST GETA5      ;RESET THE COUNTER IF TAB STOP IS PASSED\r
1542 CPOPJ1: AOSA    (P)     ;SKIP RETURN\r
1543 CPOPJZ: SETZ    IOS,    ;CLEAR IOS JUST IN CASE\r
1544 CPOPJ:  POPJ    P,\r
1545 \r
1546 \r
1547 GET7B:  CAIL T1,^D73    ;LT COL 73?\r
1548         CAILE T1,^D80   ;NO, LE COL 80?\r
1549         JRST    GET7C   ;CANT BE A CARD SEQUENCE NUMBER\r
1550         MOVEI CHR,SPACE ;REPLACE CARD SEQUENCE NOS. BY SPACE\r
1551         JRST GET7C\r
1552 \r
1553 GETA3:  TRZE FLAG,SPOK  ;CAR. RET. SEEN, ANY TRAILING SPACES?\r
1554         TRNN FLAG,SPMOD+TBMOD   ;YES, ARE WE FLUSHING TRAILING SPACES\r
1555         JRST GETA5      ;NO, RESET TAB COUNTER ONLY\r
1556         MOVE 0,SVPTR1\r
1557         MOVEM 0,OPTR    ;CLOBBER THE OUTPUT POINTER TO LBUF\r
1558 GETA5:  MOVEI 0,TABSP\r
1559         MOVEM 0,TABCT   ;RESET THE TAB COUNTER\r
1560         JRST    CPOPJ1\r
1561 \fGETA2: TROE FLAG,SPOK  ;SPACE WAS SEEN, IS THIS ONE OF A SEQUENCE?\r
1562         JRST GETA7      ;YES\r
1563         MOVE 0,OPTR     ;THIS IS THE FIRST SPACE SEEN, SAVE LBUF\r
1564                         ;POINTER IN CASE THIS SPACE MUST BE FLUSHED\r
1565         MOVEM 0,SVPTR1  ;THIS POINTER FOR FLUSHING FINAL SPACES\r
1566         MOVEM 0,SVPTR2  ;THIS POINTER FOR CHANGING MULT. SPACES TO TABS\r
1567         SETZM SPCT      ;INITIALIZE THE SPACE COUNTER\r
1568 GETA7:  AOS T1,SPCT\r
1569         SOSLE TABCT     ;ARE WE AT THE NEXT TAB STOP?\r
1570         JRST CPOPJ1     ;NO\r
1571         CAIL T1,2       ;DONT BOTHER CHANGING ONE SPACE TO A TAB\r
1572         TRNN FLAG,TBMOD ;TAB GENERATING MODE?\r
1573         JRST GETA5A     ;NO, GO RESET TAB COUNTER\r
1574         MOVE 0,SVPTR2\r
1575         MOVEM 0,OPTR    ;BACK UP THE OUTPUT POINTER OVER THE LAST\r
1576                         ;GROUP OF SPACES\r
1577         MOVEI CHR,TAB   ;OUTPUT A TAB\r
1578         SETZM SPCT      ;RESET THE SPACE COUNTER\r
1579 GETA5A: IBP SVPTR2      ;UPDATE THE CHANGE-SPACES-TO-TABS POINTER\r
1580         JRST GETA5      ;RESET THE TAB COUNTER\r
1581 \f;ERROR ROUTINES\r
1582 \r
1583 IFE WCH,<IFN RIMSW,<\r
1584 ERR8A:  MOVEI   T4,ERR382\r
1585         JRST    E10B\r
1586 ERR3B:  MOVEI   T4,ERR381\r
1587         JRST    E10B>>\r
1588 \r
1589 ERR10:  MOVEI   T4,E10A\r
1590 E10B:   SKIPN   ZRF\r
1591         SKIP    3\r
1592         ERRPNT  </?File />\r
1593         MOVEI T3,ZRF\r
1594         PUSHJ P,FN.EX\r
1595         JRST    (T4)\r
1596 \r
1597 IFE WCH,<IFN RIMSW,<\r
1598 ERR381: ERRPN2  </illegal extension!/>\r
1599 \r
1600 ERR382: ERRPN2  </illegal format!/>\r
1601 \r
1602 ERR5B:  ERRPN2  </? DTA to PTP only!/>>>\r
1603 \r
1604 ERR9:   ERRPNT  </?/>\r
1605         MOVEI T3,DTON\r
1606         PUSHJ P,FN.EX\r
1607         JRST    ERR4B\r
1608 \fERR1:  SKIPA T2,ODEV   ;OUTPUT UNAVAILABLE\r
1609 ERR1A:  MOVE T2,DEVICE  ;INPUT UNAVAILABLE\r
1610 ERR1B:  ERRPNT  </?Device />\r
1611         PUSHJ   P,P6BIT\r
1612                 T2\r
1613         ERRPN2  </ not available!/>\r
1614 ERR3:\r
1615 IFN FTDSK,<TRNE AUXFLG,DSKIN\r
1616         JRST DERR5      ;ERR ON DSK>\r
1617         PUSHJ P,ERR3A\r
1618         JRST IOERRN     ;EXIT\r
1619 ERR3A:  TLO AUXFLG,INFOFL       ;SIGNAL RETURN TO ERR3AA\r
1620         JRST INFO\r
1621 ERR3AA: ERRPN2  </? No file named />\r
1622         MOVEI   T3,FILNAM\r
1623         PUSHJ   P,FN.EX ;PRINT NAME OF FILE THAT CANNOT BE FOUND\r
1624         PUSHJ   P,INFO2         ;OUTPUT MESS. WITH CR-LF\r
1625         TRNN    AUXFLG,TTYIN!TTYOUT     ;WAS TTY IN USE?\r
1626         POPJ    P,              ;NO\r
1627         TRNE    AUXFLG,TTYIN    ;INPUT DEVICE?\r
1628         JRST    ININIT          ;YES ,RE-INIT\r
1629         JRST    OMODE           ;MUST BE OUTPUT\r
1630 \r
1631 ERR4:   SKIPN DTON\r
1632         JRST ERR4A\r
1633 IFN FTDSK,<TRNE AUXFLG,DSKOUT   ;ERR ON DSK\r
1634         JRST DERR6>\r
1635         ERRPNT  </? Directory full!/>\r
1636 ERR4A:\r
1637 IFN FTDSK,<TRNE AUXFLG,DSKOUT\r
1638         JRST ERR4C>\r
1639 ERR4B:  ERRPNT  </?Illegal file name!/>\r
1640 IFN FTDSK,<\r
1641 ERR4C:  ERRPNT  </?(0) Illegal file name!/>>\r
1642 \r
1643 ERR6:\r
1644 ERR6A:  ERRPNT  </?PIP command error!/>\r
1645 \r
1646 ERR6B:  ERRPNT  </?PIP command too long!/>\r
1647 \r
1648 E10A:   ERRPN2  </ line too long!/>\r
1649 ERR5A:  ERRPNT  </?Too many input devices!/>\r
1650 ;FILE MANIPULATION COMMANDS TO NON-DIRECTORY DEVICES COME HERE\r
1651 \r
1652 ERR5:   ERRPNT  </?Disk or DECtape input required!/>\r
1653 ERR2:   ERRPNT </?Incorrect Project-Programmer number!/>\r
1654 ERR2A:  ERRPNX  </?Illegal protection!/>\r
1655 IFE BLOC0,<\r
1656 ERR7A:  ERRPNT  <Z?DECtape I/O only!Z>>\r
1657 \r
1658 ERR8:   ERRPNT  </?Explicit output device required!/>\r
1659 \f\r
1660 ;ROUTINE TO CHECK INPUT DEV, SET XXXIN.E.G.DTAIN\r
1661 \r
1662 CHECK1: MOVE 0,DEVICE   ;INPUT DEVICE NAME TO AC 0\r
1663         JUMPE 0,CHECK   ;IGNORE IF NO INPUT DEVICE\r
1664 IFN FTDSK,<PUSHJ        P,PSYSP ; STR# 10-3178>\r
1665         DEVCHR          ;GET INPUT DEVCHR\r
1666 IFN FTDSK,<TLNN 0,DSKBIT ;INPUT DEVICE DISK?\r
1667         JRST CHECK2     ;NO\r
1668         TRO AUXFLG,DSKIN;INPUT DEVICE IS DSK, SET BIT\r
1669         MOVE    T1,DEVICE\r
1670         CAMN    T1,[SIXBIT/SYS/]        ; INIT SYS AS DSK\r
1671         MOVSI   T1,(SIXBIT/DSK/)\r
1672         MOVEM   T1,ADSK\r
1673         JRST    CHECK>\r
1674 \r
1675 CHECK2: JUMPE 0,DEVER1  ;NON-EX. DEVICE\r
1676 \r
1677         TLNN 0,INBIT    ;CAN DEVICE DO INPUT?\r
1678         JRST ERR6A      ;NO, COMMD ERROR\r
1679 \r
1680         TLNE 0,PTRBIT   ;PAPER TAPE READER?\r
1681         TRO AUXFLG,PPTIN;YES\r
1682 \r
1683         TLNE 0,DTABIT   ;DECTAPE?\r
1684         TRO AUXFLG,DTAIN\r
1685 \r
1686         TLNE 0,MTABIT   ;MAGTAPE?\r
1687         TRO AUXFLG, MTAIN\r
1688 \r
1689         TLNE CDRBIT     ;CARD READER?\r
1690         TRO AUXFLG,CDRIN\r
1691 \r
1692         TLNE 0,TTYBIT   ;TELETYPE?\r
1693         TRO AUXFLG,TTYIN\r
1694 \r
1695 CHECK:  TRNE    CALFLG,SSWTCH   ;_FLAG STILL ON?\r
1696         JRST ERR6A      ; YES ,COMMAND ERROR\r
1697         POPJ P,         ; NO, RETURN \r
1698 \f;SUBR TO PRINT ERROR MESSAGES\r
1699 ;! MARKS THE END OF MESSAGE & SIGNALS GO TO PIP2\r
1700 ;NULL IS A FLAG TO RETURN TO THE NEXT LOCATION\r
1701 \r
1702 PRETXT: 
1703 PTEXT:  RELEAS DIR,     ;RELEASE DIRECTORY DEVICE\r\r
1704         RELEAS TAPE,    ;RELEASE MAGTAPE\r
1705         RELEAS OUT,     ;LET GO OF BOTH OUTPUT AND\r
1706         RELEAS IN,      ;INPUT DEVICES\r
1707         JSP T5,INICN1   ;INITIALIZE THE TTY\r
1708         MOVEI   0,CR\r
1709         IDPB    0,TFO+1 ;OUTPUT A CR-LF\r
1710         MOVEI   0,LF\r
1711         IDPB    0,TFO+1 ;FOR BATCH\r
1712 PTEXT2: HRLI T1,440700  ;GET SET TO SCAN 7-BIT DATA\r
1713 PTEXT1: ILDB 0,T1       ;GET CHAR OF ERR MESSAGE\r
1714         JUMPE 0,1(T1)   ;RETURN ON ZERO\r
1715         CAIN 0,"!"      ;!?\r
1716         JRST PIP2       ;YES, END OF MESSAGE, APPEND CAR.RET., LF\r
1717         IDPB 0,TFO+1    ;DEPOSIT CHAR IN OUTBUFFER\r
1718         JRST PTEXT1     ;GET NEXT CHAR\r
1719 \r
1720 ;ROUTINE TO DEPOSIT CHARACTER IN TTY OUT BUFFER\r
1721 \r
1722 PUTCON: SOSG TFO+2      ;STORED MORE THAN BUFFER HOLDS?\r
1723         OUTPUT CON,     ;YES\r
1724         IDPB CHR,TFO+1\r
1725         POPJ P,\r
1726 \r
1727 ;ROUTINE TO CONVERT ONE WORD OF SIXBIT\r
1728 ;FROM ADDRESS IN LOCATION AFTER CALL AND DEPOSIT INTO TTY OUT BUFFER\r
1729 \r
1730 P6BIT:  MOVE T1,@(P)    ;PICK UP WORD OF 6-BIT\r
1731         HRLI T1,440600  ;SET UP POINTER\r
1732 P6BIT1: ILDB CHR,T1\r
1733         JUMPE CHR,P6BIT2\r
1734         ADDI CHR,40\r
1735         PUSHJ P,PUTCON  ;DEPOSIT IN TTY\r
1736 P6BIT2: TLNE T1,770000  ;DONE SIX?\r
1737         JRST P6BIT1     ;NO\r
1738         JRST CPOPJ1     ;SKIP RETURN\r
1739 \r
1740 \f;ROUTINE TO CLEAR DSK OR DTA DIRECTORY (/Z SWITCH)\r
1741 \r
1742 DTCLR:  TRNN    CALFLG,DVSWTH   ;HAS A DEVICE BEEN SEEN?\r
1743         JRST    ERR8            ;NO,SO DON'T SCREW USER\r
1744 IFN FTDSK,<TRNE AUXFLG,DSKOUT   ;CLEAR DSK OR DTA DIR.\r
1745         JRST DSKZRO>\r
1746         TRNN AUXFLG,DTAOUT      ;MUST BE DTA\r
1747         JRST ERR5\r
1748         UTPCLR  OUT,            ;CLEAR DIRECTORY\r
1749         POPJ P,\r
1750 \f;ROUTINE TO SET UP TO COPY EVERYTHING\r
1751 \r
1752 PRECOP: PUSHJ   P,ININIT        ;INIT INPUT FILE\r
1753         TRNN    AUXFLG,DTAIN    ;DECTAPE INPUT\r
1754         SKIP    2               ;NO\r
1755         PUSHJ   P,DTCH2         ;YES, GET DIRECT, SET POINTERS TO DIRECT\r
1756 \r
1757 DTCOPY: PUSHJ   P,DTADI1        ;START (T5)\r
1758 IFN FTDSK,<TRNE AUXFLG,DSKIN    ;DSK INPUT. ENTER HERE FROM DTD2\r
1759         PUSHJ   P,DSKDIR        ;YES, PREPARE TO LOOKUP FILES>\r
1760 COPY1A: SETZM   ZCNT            ;CLEAR COUNT FOR DSK ZERO REQUESTS\r
1761         MOVEI   T2,6            ;FILL 0 CHARS. IN DEST-FILE\r
1762         MOVE    T1,[POINT 6,DTON]       ;NAME WITH X'S. THIS IS\r
1763 XSS:    ILDB    0,T1            ;THEN THE BASE FOR GENERATED\r
1764         JUMPN   0,.+2           ;DESTINATION FILES FROM\r
1765         MOVEI   0,"X"-40        ;NON-DIR. DEVICES IN /X\r
1766         DPB     0,T1\r
1767         SOJG    T2,XSS          ;DON'T YET KNOW IF ONE\r
1768                                 ;OF THE INPUT DEV. WILL\r
1769         MOVE    0,DTON          ;BE NON-DIR\r
1770         MOVEM   0,DTONSV\r
1771         MOVE    0,DTON+1\r
1772         MOVEM   0,DTONSV+1\r
1773 \r
1774 COPY1:  PUSHJ   P,SR2           ;SET INIT. COPYING MODE\r
1775         PUSHJ   P,LOOK          ;GET A FILE TO COPY\r
1776         JRST    CAL6            ;NO MORE\r
1777 IFN FTDSK<PUSHJ P,XDDSK         ;GOT ONE, CHECK (XD) FROM DSK, NAMTAB\r
1778         JRST    COPY1           ;IN LIST, DON'T COPY>\r
1779         TRNN    AUXFLG,MTAIN+PPTIN+CDRIN+TTYIN  ;OK, COPY FILE\r
1780         JRST    COPY6A          ;MUST BE DIRECTORY DEVICE\r
1781         PUSHJ   P,MTPTCR        ;SET UP A DEST. FN.\r
1782         JRST    COPY6\r
1783 \fCOPY6A:        LOOKUP  IN,ZRF          ;LOOKUP INPUT FILE NAME\r
1784         JRST    CAL5            ;INPUT FILE FILE PROTECTED\r
1785 COPY6:  PUSHJ   P,FILTYP        ;CHECK FOR DMP,SAV,REL,CHN\r
1786 IFN WCH,<\r
1787         TRNN    AUXFLG,DTAIN+DTAOUT\r
1788         JRST    .+5\r
1789         HLRZ    0,ZRF+1\r
1790         CAIE    0,(SIXBIT /DMP/)\r
1791 IFN DISK30,<CAIN 0,(SIXBIT/SVE/)>\r
1792 IFE DISK30,<CAIN 0,(SIXBIT/SAV/)>\r
1793         JRST    COPY1>\r
1794         PUSHJ   P,COPY3\r
1795 COPY6B: MOVE    0,ZRF           ;INPUT FILE NAME\r
1796         MOVEM   0,DTON          ;IS OUTPUT FILE NAME\r
1797         HLLZ    0,ZRF+1         ;LIKEWISE EXT\r
1798         HLLZM   0,DTON+1\r
1799 \r
1800 ;THIS CODE OPERATES AS FOLLOWS - FOR E+2, SET = 0\r
1801 ;TO START (ASSUMING /X)\r
1802 ;DSK TO DSK IF EDIT SWITCHES PUT E+2 = 0 IF NO EDITS TRANSFER\r
1803 ;       DATE, TIME, BITS 13-35\r
1804 ;DSK TO DTA FOR EDITS E+2 = 0, NO EDITS TRANSFER 24-35 FOR\r
1805 ;DATE, FOR"SAV" FILES TRANSLATE NO.  1K BLOCKS\r
1806 ;DTA TO DSK FOR NO EDITS XFER BITS 24-35, ELSE E+2 = 0\r
1807 ;DTA TO DTA ALWAYS XFER 18-23, (1K BLOCK) NO EDITS XFER 24-35(DATE)\r
1808 \r
1809         SETZM   DTON+2          ;CLEAR DATE. OUTPUT FILE, DSK/DTA\r
1810         LDB     0,DATE          ;GET DSK/DTA DATE CREATED\r
1811         TDNN    FLAG,[XWD PFLG,LINE+TBMOD+NSMOD+SQMOD+SPMOD]\r
1812         TLNE    AUXFLG,CDRFLG\r
1813         JRST    COPY6C\r
1814         DPB     0,DATED         ;DEPOSIT IF NO EDITS\r
1815 IFN FTDSK,<LDB  0,TIME\r
1816         TRC     AUXFLG,DSKIN+DSKOUT\r
1817         TRCN    AUXFLG,DSKIN+DSKOUT\r
1818         DPB     0,TIMED         ;DSK TO DSK TIME>\r
1819 COPY6C: IFE WCH,<\r
1820         PUSHJ   P,OKBLKS        ;SETUP 1K BLOCKS>\r
1821         ENTER   OUT,DTON        ;GOT DATA, CREATE NEW FILE\r
1822         JRST    ERR4            ;DIRECTORY FULL\r
1823         MOVE    0,ZRO           ;GET ASCII/00000/AND\r
1824         MOVEM   0,SQNUM         ;RESET SEQUENCE NO.\r
1825         TLO     FLAG,NEWFIL     ;SET NEW FILE FLAG\r
1826         SETZM   TOTBRK          ;CLEAR PAREN COUNTER\r
1827         TLNN    AUXFLG,CDRFLG+SBIN      ;SPECIAL PROCESSING?\r
1828         TDNE    FLAG,[XWD PFLG+IFLG+IBFLG,LINE+BMOD+TBMOD+NSMOD+SQMOD+SPMOD]    \r
1829         JRST    PSCAN           ;YES, DO IT\r
1830 COPY5:  SOSGE   IBF+2           ;INPUT BUFFER EMPTY?\r
1831         JRST    COPY4           ;YES\r
1832         ILDB    CHR,IBF+1       ;GET NEXT WORD AND\r
1833         PUSHJ   P,PUT           ;OUTPUT IT\r
1834         JRST    COPY5\r
1835 COPY4:  PUSHJ   P,COPY3         ;GET NEXT FULL SOURCE BLOCK\r
1836         PUSHJ   P,OUTP          ;OUTPUT PREV. BLOCK-DONT ALTER DATA\r
1837         AOS     OBF+2           ;MAKE PUT HAPPY BECAUSE OF\r
1838         JRST    COPY5           ;OUTPUT HERE.\r
1839 COPY2A: CLOSE   IN,\r
1840         CLOSE   OUT,\r
1841 IFN FTDSK,<TLNE  AUXFLG,NSPROT  ;NON-STANDARD PROTECTION?\r
1842         TRNN    AUXFLG,DSKOUT   ;RENAME ALL OUTPUT FILES IF\r
1843         JRST    COPY2B          ;NON-STANDARD PROTECTION\r
1844         MOVE    0,PROTS         ;GET NEW PROTECTION\r
1845         MOVEM   0,DTON+2\r
1846 \r
1847         RENAME  OUT,DTON        ;RENAME OUTPUT FILE\r
1848         JRST    DERR6>\r
1849 COPY2B: PUSHJ   P,OUTP1\r
1850         JRST    COPY1           ;GO GET NEXT FILE\r
1851 \r
1852 CAL5:   AOS     ZCNT            ;INPUT FILE READ PROT.\r
1853         JRST    COPY1           ;COUNT READ FAILURES\r
1854 \r
1855 ;NO MORE FILES TO COPY\r
1856 \r
1857 CAL6:   TLZ     AUXFLG,NSPROT\r
1858 IFN FTDSK,<     SKIPN   ZCNT    ;FILES READ PROTECTED ?>\r
1859         JRST    MAIN1           ;NO\r
1860 IFN FTDSK,<MOVSI T4,(SIXBIT /X/)        ;YES,PRINT FAILURE DURING\r
1861         JRST    DSKZ5           ;/X REQUEST>\r
1862 \r
1863 COPY3B: SKIPE   IBF+2           ;EMPTY BLOCK?\r
1864         POPJ    P,              ;NO, RETURN\r
1865 \r
1866 COPY3:  PUSHJ   P,INP           ;READ NEXT BLOCK\r
1867         TRZE    AUXFLG,READ1\r
1868         PUSHJ   P,TTYZ          ;END OF FILE FROM TTY?\r
1869         TRNN    IOS,EOFBIT      ;END OF FILE? IOS HAS STATUS BITS\r
1870         JRST    COPY3B          ;NO.\r
1871         POP     P,0             ;FIND WHERE CALLED FROM\r
1872         HRRZS   0\r
1873         TRNE    AUXFLG,MTAIN+CDRIN+TTYIN+PPTIN\r
1874         CAIE    0,COPY6B        ;DID WE COME FROM COPY6B-1\r
1875         JRST    COPY2A          ;NO, EOF NOT FIRST DATA IN FILE \r
1876         TRZ   CALFLG,ALLCLF     ;END OF INFO ON NON-DIR. DEVICE\r
1877         JRST    COPY1\r
1878 \r\f;CREATE DESTINATION FILE NAME. RANGE IS ...001 TO ...999\r
1879 \r
1880 MTPTCR: AOS T1,NO.\r
1881         CAILE T1,^D999\r
1882         JRST MPC2\r
1883         PUSHJ P,MTPTC1\r
1884         MOVE 0,DTONSV   ;FILNAM=DTON IS ONLY WAY TO IDENTIFY\r
1885         MOVEM 0,ZRF     ;INPUT FILE\r
1886         MOVE 0,DTONSV+1\r
1887         MOVEM 0,ZRF+1\r
1888         POPJ P,\r
1889 MPC2:   ERRPNT <Z?Terminate /X, max. of 999 files processed!Z>\r
1890 \r
1891 MTPTC1: MOVEI DOUT,^D1000(T1)\r
1892         MOVE T1,[POINT 6,DTONSV,17]\r
1893         JSP T2,OUTDC1\r
1894         AOJA T2,CPOPJ\r
1895         SUBI CHR,40\r
1896         IDPB CHR,T1\r
1897         POPJ P,\r
1898 \r
1899 ;ROUTINE TO RESTORE BYTE POINTERS TO INITED MODE\r
1900 ;FOR INPUT AND OUTPUT DEVICES\r
1901 \r
1902 SR2:    MOVE 0,SVIBF\r
1903         HLLM 0,IBF+1\r
1904         MOVE 0,SVOBF\r
1905         HLLM 0,OBF+1\r
1906         POPJ P,\r
1907 \r
1908 ;ROUTINE TO SEE IF ^Z FIRST CHAR ON TTY\r
1909 \r
1910 TTYZ:   TRNN AUXFLG,TTYIN       ;SEE IF FIRST CHAR. IS ^Z\r
1911         POPJ P,                 ;NOT TTY INPUT\r
1912         HRRZ T1,IBF+1           ;ON TTY\r
1913         HLRZ 0,1(T1)            ;GET FIRST CHARACTER\r
1914         TRZ     0,3777          ;CLEAR ANY OTHER CHAR.\r
1915         CAIN    0,(<CZ>B6)      ;IS IT ^Z?\r
1916         TROA    IOS,EOFBIT      ;YES,SET END OF FILE\r
1917         CAIE    0,(<XON>B6)     ;IS IT XON "^Q"\r
1918         POPJ    P,              ;NO\r
1919         MOVSI   0,(<DEL>B6)     ;A RUBOUT\r
1920         IORM    1(T1)           ;CLEAR "^Q" FROM BUFFER\r
1921         POPJ    P,              ;AND RETURN\r
1922 \fIFE    WCH,<\r
1923 ;DTA TO DTA MAINTAIN BITS 18-23 OF E+2 IF SET\r
1924 ;DSK TO DSK NO TRANSLATION (E+2)\r
1925 ;DSK TO DTA TRANSLATE E+3 (LHS) INTO E+2 (18-23)\r
1926 ;DTA TO DSK NO TRANSLATION (E+2)\r
1927 ;THIS ROUTINE ENSURES "SAVE" FILES MAINTAIN\r
1928 ;CORRECT DATA FOR LOADING.  FOR DSK INPUT\r
1929 ;A "SAVE" FILE IS ONE WITH THE EXTENSION\r
1930 ;"SAV". E+3 = (-[(200XN)+NO. WDS IN LAST BLOCK]\r
1931 ;IN LHS TRANSLATE TO NO. 1K BLOCKS NEEDED\r
1932 ;TO LOAD FILE - BEFORE IT IS EXPANDED IN CORE.\r
1933 \r
1934 OKBLKS: TRNN    CALFLG,RXFLG    ;(RX)?\r
1935         JRST    OKBLK0          ;NO\r
1936         MOVE    0,MATCH         ;GET FILE NAME\r
1937         HLRZ    T1,MATCH+1      ;AND EXT.\r
1938         CAME    0,STAR          ;SKIP IF NAME IS "*"\r
1939         MOVEM   0,DTON          ;OTHERWISE REPLACE NAME\r
1940         CAIE    T1,(SIXBIT /*/) ;SAME FOR EXT\r
1941         HRLM    T1,DTON+1\r
1942 OKBLK0: MOVE    0,DTON          ;GET OUTPUT FILE NAME\r
1943         HLRZ    T1,DTON+1       ;AND EXT\r
1944         CAIE    T1,(SIXBIT /*/) ;IS IT "*"\r
1945         CAMN    0,STAR          ;IS IT "*"\r
1946         JRST    ERR4B           ;YES, ERROR\r
1947 \r
1948 REPEAT 0,<                      ;NEEDS FIX TO TENDMP OR MONITOR\r
1949         TRNE    AUXFLG,DTAOUT   ;OUTPUT TO DTA?\r
1950         CAIE    T1,(SIXBIT /SAV/) ;AND A SAV FILE?\r
1951         SKIP    1               ;NO\r
1952         UGETF   OUT,0           ;SET TO FIRST FREE BLOCK\r
1953 >\r
1954 \r
1955 IFN FTDSK,<TRC  AUXFLG,DSKIN+DSKOUT     ;DSK I/O\r
1956         TRCN    AUXFLG,DSKIN+DSKOUT\r
1957         POPJ    P,                      ;YES, EXIT\r
1958         TRC     AUXFLG,DTAIN+DTAOUT     ;NO\r
1959         TRCE    AUXFLG,DTAIN+DTAOUT     ;DTA I/O\r
1960         JRST    OKBLK1                  ;NO>\r
1961         LDB     0,OKB                   ;DTA I/O - 1K BLKS\r
1962         DPB     0,OKBD                  ;DEPOSIT IN DTON\r
1963         POPJ    P,\r
1964 \r
1965 IFN FTDSK,<\r
1966 OKBLK1: TRC     AUXFLG,DTAIN+DSKOUT     ;DTA-TO-DSK\r
1967         TRCN    AUXFLG,DTAIN+DSKOUT\r
1968         POPJ    P,                      ;YES\r
1969         TRC     AUXFLG,DSKIN+DTAOUT     ;NO,DSK-TO-DTA?\r
1970         TRCE    AUXFLG,DSKIN+DTAOUT     ;NO\r
1971         POPJ    P,\r
1972         HLRZ    0,ZRF+1                 ;YES DSK-TO-DTA\r
1973 IFE DISK30,<\r
1974         CAIE    0,(SIXBIT /SAV/)        ;GET LOOKED UP EXT,(INPUT).\r
1975         >\r
1976 IFN DISK30,<CAIE 0,SIXBIT /SVE/>\r
1977         POPJ    P,\r
1978         HLRO    T1,ZRF+3                ;EXTENSION=SAV\r
1979         MOVNS   T1                      ;WORD COUNT\r
1980         IDIVI   T1,2000                 ;DIVIDE BY 1K CORE(OCTAL LOCS.)\r
1981         JUMPN   T2,.+2\r
1982         SOJ     T1,                     ;N-1\r
1983         DPB     T1,OKBD\r
1984         POPJ    P,>>\r
1985 \f\r
1986 IFN FTDSK,<\r
1987 ;ARE WE DOING (XD) FROM DSK? IF NOT, EXIT.\r
1988 ;SEE IF CURRENT FILE SELECTED IN ZRF IS IN THE\r
1989 ;LIST OF FILES NOT TO BE COPIED. (POPJ IF IT IS)\r
1990 \r
1991 XDDSK:  TRC     FLAG,XFLG+DFLG          ;COMPLEMENT\r
1992         TRCN    FLAG,XFLG+DFLG          ;RESET AND TEST\r
1993         TRNN    AUXFLG,DSKIN            ;/X AND /D WERE SET\r
1994         JRST    CPOPJ1                  ;NOT DSKIN SO COPY FILE\r
1995         HRROI   T1,-12                  ;SET TO LOOP NAMTAB\r
1996 XDDSK2: MOVE    T2,ZRF                  ;GET FILE NAME\r
1997         SKIPN   T3,NAMTAB+12(T1)        ;END OF TABLE ENTRIES?\r
1998         JRST    CPOPJ1                  ;YES, EXIT\r
1999         CAME    T2,T3                   ;FN IS * OR MATCH?\r
2000         CAMN    T3,STAR\r
2001         SKIP    1                       ;YES, * OR MATCH?\r
2002         JRST    XDDSK1                  ;NO MATCH\r
2003         HLLZ    T2,ZRF+1                ;GET EXT\r
2004         SKIPN   T3,NAMTAB+24(T1)        ;NO EXT MATCH WANTED\r
2005         POPJ    P,                      ;EXIT THEN\r
2006         CAME    T2,T3                   ;EXT IS * OR MATCH?\r
2007         CAMN    T3,STAR\r
2008         POPJ    P,                      ;FN EX MATCH, NO COPY\r
2009 XDDSK1: AOJL    T1,XDDSK2               ;TRY ANOTHER FOR MATCH\r
2010         JRST    CPOPJ1                  ;SEARCHED TABLE, NO MATCH>\r
2011 \f;ROUTINE TO DELETE OR RENAME FILES ON DTA OR DSK OR SET UP NAMTAB\r
2012 ;FOR (DX) (DISK ONLY)\r
2013 \r
2014 DTDELE: TRNE    FLAG,XFLG       ;/X\r
2015         JRST    DELE1           ;YES\r
2016         TRNN    FLAG,DFLG       ;/D NEED EXPLICIT DEVICE\r
2017         SKIP    2\r
2018         TRNN    CALFLG,DVSWTH   ;-1 IF DEVICE SEEN\r
2019         JRST    ERR8            ;NO, ERROR\r
2020         MOVE    0,ODEV          ;OUTPUT DEVICE\r
2021         MOVEM   0,DEVICE        ;NO,SET DEVICE FOR INPUT\r
2022         MOVEM   0,DEVA\r
2023 DELE1:  TRZ     AUXFLG,DTAIN+CDRIN+TTYIN+PPTIN+MTAIN+DSKIN\r
2024         PUSHJ   P,CHECK1        ;RESET INPUT DEVICE DESCRP\r
2025         MOVEI   0,NAMTAB        ;FOR /R GET NEW NAME\r
2026         HRLI    0,DTON          ;SET TO BLT OUTPUT DIRECT ENTRY\r
2027         BLT     0,NAMTAB+3      ;TO NAMTAB\r
2028 \r
2029         TRNN    AUXFLG,DTAIN+DSKIN\r
2030         JRST    ERR5            ;NOT DTA OR DSK\r
2031         PUSHJ   P,FNSET         ;SET UP CALFLG CORRECTLY\r
2032         TRNE    FLAG,XFLG       ;/X?\r
2033         JRST    DTD1            ;YES, (DX). RX ILLEGAL\r
2034 IFN FTDSK,<TRNE AUXFLG,DSKOUT   ;NO, HAS TO BE /D OR /R\r
2035         JRST    DSKDR0          ;ON DSK>\r
2036         JRST    DTADR           ;OR DTA\r
2037 \r
2038 DTD1:\r
2039 IFN FTDSK,<TRNE AUXFLG,DSKIN    ;DSK INPUT?\r
2040         JRST    DTD1A           ;YES>\r
2041         PUSHJ   P,DTCHECK       ;NO, HAS TO BE DTA, GET DIR\r
2042         JRST    DELE3           ;DELETE, FILES FROM DIR\r
2043 IFN FTDSK,<\r
2044 DTD1A:  SETZM   NAMTAB          ;COLLECT NAMES FOR DX, DSK SOURCE\r
2045         MOVE    T1,[XWD NAMTAB,NAMTAB+1]\r
2046         BLT     T1,NAMTAB+23    ;FIRST CLEAR TABLE\r
2047         MOVEI   T1,NAMTAB       ;LOCATION OF NAMTAB\r
2048         MOVEM   T1,LOCNAM\r
2049 DTD4:   MOVE    0,FILNAM\r
2050         JUMPE   0,DTD4A         ;FN=0 ILLEGAL\r
2051         MOVE    T1,LOCNAM\r
2052         MOVEM   0,(T1)          ;STORE FILENAME FROM CS\r
2053         MOVE    0,FILEX         ;STORE FILE EXT\r
2054         MOVEM   0,12(T1)        ;TABLE FULL?\r
2055         MOVEI   T2,NAMTAB+11\r
2056         CAMN    T2,T1\r
2057         SOS     ESWTCH          ;YES\r
2058         SKIPE   ESWTCH          ;NO, END OF CS SCAN?\r
2059         JRST    DTD2            ;END OF NAME PROCESSING\r
2060         AOS     T1,LOCNAM       ;SET TO STORE IN NEXT SLOT NAMTAB\r
2061 DTD4B:  PUSHJ   P,DESCRP        ;NO, GET NEXT FILENAME FROM CS\r
2062         TRNE    CALFLG,NEWPP!NEWDEV\r
2063         JRST    ERR5A           ;ERROR, NEW DEV OR# PP\r
2064         JRST    DTD4\r
2065 DTD4A:  PUSHJ   P,ERR3A\r
2066         JRST    DTD4B\r
2067 \r
2068 ;END OF CS OR NAMTAB FULL\r
2069 DTD2:   PUSHJ   P,ININIT        ;INIT INPUT FILE\r
2070         MOVEI   T1,1            ;SET TO RETURN DTCOPY+1\r
2071         JRST    DTD5>\r
2072 \f;ROUTINE TO DELETE OR RENAME FILES ON DTA\r
2073 \r
2074 DTADR:  PUSHJ   P,DTCHECK       ;GO GET DTA DIRECTORY\r
2075         MOVE T1,IBF             ;CURRENT INPUT BUFFER\r
2076 IFN WCH,<\r
2077         USETO OUT,1             ;TRY TO WRITE OUTPUT TAPE\r
2078         >                       ;DETERMINE IF WRITE LOCKED\r
2079 IFE WCH,<\r
2080         USETO OUT,144>          ;THIS SHOULD GIVE ERROR MSG\r
2081         OUTPUT OUT,(T1)         ;IF DTA WRITE LOCKED\r
2082         PUSHJ P,DTCHECK         ;GO GET DTA DIRECTORY\r
2083 \r
2084         PUSHJ   P,INFO          ;WRITE "FILES DELETED/RENAME\r
2085 \r
2086 ;*********************************************************************\r
2087 \r
2088 \r
2089 ;LOOP TO DELETE/RENAME. FOR (DX) DELETE FILES FROM DTA DIR\r
2090 ;THEN USE REVISED DIRECTORY TO COPY ALL REMAINING FILES\r
2091 \r
2092 \r
2093 DELE3:  PUSHJ   P,LOOK          ;GET FILE TO DELETE OR RENAME FROM CS\r
2094         JRST    DELE5           ;NO MORE FILES\r
2095         TRNN    FLAG,XFLG       ;/X?\r
2096         PUSHJ   P,INFO3         ;PRINT FILENAME-EXT\r
2097         MOVE    T1,DIRST        ;GOT A MATCH - PROCESS IT\r
2098         TRNE    FLAG,RFLG       ;AND IT IS AT (T5) IN (DTA) DIR\r
2099         JRST    DTRNAM          ;RENAME\r
2100 IFN WCH,<\r
2101         SKIPA   T2,T1\r
2102         ADDI    T2,4\r
2103         SKIPE   4(T2)\r
2104         JRST    .-2\r
2105         HRLS    T1\r
2106         ADDI    T1,4            ;GET TO END OF NAMES\r
2107         MOVSS   T1              ;BLOCK UP DIR\r
2108         BLT     T1,-1(T2)       ;ZERO OUT LAST 4 WORDS\r
2109         SETZM   (T2)\r
2110         SETZM   1(T2)\r
2111         SETZM   2(T2)\r
2112         SETZM   3(T2)\r
2113         MOVE    T1,DIRST1\r
2114         MOVEM   T1,DIRST\r
2115         JRST    DELE3>\r
2116 IFE WCH,<\r
2117         SETZM   (T1)            ;DELETE FILENAME IN CORE DIRECT\r
2118         SETZM   26(T1)          ;DELETE EXT\r
2119         SUB     T1,DIRST1       ;GET FILE "NUMBER" (POS IN DIRECT)\r
2120         MOVEI   T3,1102         ;TO LOOK AT ALL BLOCKS\r
2121         MOVSI   T2,(POINT 5,0)\r
2122         HRR     T2,DIRST1       ;TO CALCULATE ADDRESS OF FIRST WORD\r
2123         SUBI    T2,122          ;OF BLOCK TABLE IN DIRECTORY\r
2124 DELE2:  SOJLE   T3,DELE3        ;LOOK AT 1101 BLOCKS\r
2125         ILDB    0,T2            ;GET BLOCK NUMBER\r
2126         CAME    0,T1            ;IS IT SAME AS FILE "NUMBER"\r
2127         JRST    DELE2           ;NO IGNORE\r
2128         SETZ    0,              ;FREE THE BLOCKS OF THIS FILE\r
2129         DPB     0,T2            ;CLEAR OUT BLOCK NUMBER\r
2130         JRST    DELE2>          ;LOOP ON 1102 BLOCKS\r
2131 DELE5:  MOVE    T1,IBF          ;LOC OF INPUT BUFFER\r
2132         TRNE    FLAG,XFLG       ;DX SWITCH?\r
2133         JRST    DTD6            ;YES, NOW MUST COPY REMAINING FILES\r
2134 IFN WCH,<\r
2135         USETO   OUT,1>\r
2136 IFE WCH,<\r
2137         USETO   OUT,144>\r
2138         OUTPUT  OUT,(T1)        ;OUTPUT DTA DIRECTORY\r
2139         RELEAS  CON,            ;OUTPUT DELETE OR RENAME INFO TO TTY\r
2140         JRST    MAINB\r
2141 \f;ROUTINE TO RENAME FILE ON DECTAPE\r
2142 \r
2143 DTRNAM: PUSHJ   P,RENAME\r
2144         SETZM   DTON+2          ;MAKE MONITOR SUPPLY\r
2145         SETZM   DTON+3          ;DATE TIME\r
2146         LOOKUP  OUT,DTON        ;LOOK UP FILENAME-EXT ON OUTPUT DEV\r
2147         SKIP    1               ;NO FILE ALREADY OF DESTINATION NAME\r
2148         JRST    DTRNM1\r
2149         MOVE    0,DTON          ;RENAME, FILENAME\r
2150         JUMPE   0,DELE3         ;BUT NOT IF ZERO\r
2151         MOVEM   0,(T1)          ;PUT IN DIRECTORY\r
2152         MOVE    0,DTON+1        ;GET EXT\r
2153 IFE WCH,<\r
2154         HLLM    0,26(T1)>       ;RENAME, EXT\r
2155 IFN WCH,<\r
2156         HLLM    0,1(T1)>\r
2157         JRST    DELE3\r
2158 DTRNM1: HRRZ    T2,IBF  ; GET PROTECTION DIR SLOT\r
2159         LDB     0,[POINT 5,17(T2),14]\r
2160         CAIE    0,36            ; FILE PROTECTION ?\r
2161         JRST    ERR9            ; NO,ILLEGAL FILE NAME\r
2162         JRST    DELE3           ; RENAME DONE AT MAINB\r
2163 \r
2164 ;END OF LOOP\r
2165 ;*********************************************************************\r
2166 ;DX SWITCH ON, COPY ALL BUT SPECIFIED FILES. I.E. THOSE NOT DELETED\r
2167 \r
2168 DTD6:   MOVEI   T1,0            ;SET TO RETURN TO DTCOPY\r
2169 DTD5:   MOVSI   0,(SIXBIT /*/)\r
2170         MOVEM   0,FILNAM        ;FORCE COPY-ALL\r
2171         MOVEM   0,FILEX         ;BY MAKING FILE-EXT=*.*\r
2172         PUSHJ   P,FNSET         ;FIND DETAILS OF FILE-EXT\r
2173         TRNE    AUXFLG,DTAIN    ;DTA INPUT\r
2174         PUSHJ   P,DTCH1         ;INIT DIRST,DIRST1\r
2175 IFN RIMSW,      <\r
2176         TLNE    FLAG,RIMFLG     ;NO\r
2177         JRST    RIMTB\r
2178         >\r
2179         JRST    DTCOPY(T1)\r
2180 \r
2181 \r
2182 ;SET UP OUTPUT DIRECTORY ENTRY FOR RENAME\r
2183 ;ONLY ONE FILE NAME ALLOWED, BUT MAY BE *.EXT OR FN.*\r
2184 \r
2185 RENAME: SKIPL   ESWTCH          ;SKIP IF CR,LF SEEN IN C.S.\r
2186         JRST    ERR6A           ;ONLY 1 SOURCE FILE DESCRIPTOR ALLOWED\r
2187         HLRZ    0,NAMTAB+1      ;GET EXT\r
2188         CAIN    0,(SIXBIT /*/)  ;USE SPEC. EXTENSION, BUT IF\r
2189         HLRZ    0,ZRF+1         ;EXT.=*, USE SOURCE EXTENSION\r
2190         HRLM    0,DTON+1        ;USE SPECIFIED EXT\r
2191         MOVE    T2,NAMTAB       ;USE SPEC. FN, BUT IF\r
2192         CAMN    T2,STAR         ;FN=* OR 0, USE SOURCE FILENAME\r
2193         MOVE    T2,ZRF          ;SOURCE FILE NAME=DEST\r
2194         MOVEM   T2,DTON         ;USE SPECIFIED FILENAME\r
2195         POPJ    P,\r
2196 \r
2197 \r
2198 \r
2199 \f;THIS ROUTINE GETS NEXT FILENAME.EXT FROM CS\r
2200 ;THEN SEES IF ONE IN DIRECTORY MATCHES\r
2201 ;IF IT DOES - EXIT IS CPOPJ1\r
2202 ;NO-MORE-FN.EX-TO-HANDLE-EXIT IS POPJ\r
2203 ;PREPARE ZRF FOR A "LOOKUP" ON THE NEXT REQUESTED FILE.\r
2204 \r
2205 LOOK:   TRNE    CALFLG,FNEX     ;DOES FILNAM, FILEX CONTAIN\r
2206         JRST    LOOK6           ;A FILE TO THINK ABOUT? YES\r
2207 LOOK01: PUSHJ   P,LOOKA         ;GET ONE (NOTE: DEVICE MAY ALTER)\r
2208         POPJ    P,              ;NONE, END OF CS\r
2209                                 ;RETURN SKIP FROM LOOKA\r
2210 LOOK6:  MOVE    T2,FILEX        ;GET FILE EXT INTO T2\r
2211         SKIPN   T1,FILNAM       ;FILNAME AND EXT=0?\r
2212         SKIPE   T2,FILEX\r
2213         SKIP    1               ;EITHER FN OR EX N.E.0\r
2214         JRST    LOOK7C          ;FN.EX=0, ONE FILE COPY\r
2215         CAME    T1,STAR         ;FILNAME OR EXT=*?\r
2216         CAMN    T2,STAR\r
2217         JRST    LOOK7A          ;FN OR EX=*, MANY FILES \r
2218 \r
2219         TRNE    AUXFLG,DTAIN+DSKIN      ;DONT REQUIRE FILENAME\r
2220         JUMPE   T1,LOOK6C       ;HERE FOR 0.EX,FN.EX OR FN.0,0.EX ILLEGAL\r
2221 LOOK7B: TRZ     CALFLG,FNEX     ;IF HERE, ONLY ONE FILE WAS ENTAILED IN REQUEST.\r
2222         TRNN    AUXFLG,DTAIN+DSKIN\r
2223         JRST    LOOK4           ;GOT A FILE TO HANDLE\r
2224 \r
2225 LOOK8:  PUSHJ   P,PICUP         ;GET A FILE (ANY) FROM DIRECTORY\r
2226         JRST    LOOK2           ;WE GOT A FILE, DOES IT MATCH?\r
2227         TRZE    CALFLG,FNEX     ;SEE IF A PARTIC. FILE WAS REQUESTED?\r
2228         JRST    LOOK6D          ;NO\r
2229         JRST    LOOK6C          ;YES\r
2230 \r
2231 LOOK6A: PUSHJ   P,ERR3A\r
2232         JRST    IOERRN          ;NO RECOVERY\r
2233 LOOK6C: PUSHJ   P,ERR3A\r
2234         JRST    LOOK01          ;GET NEXT FILE FROM CS\r
2235 \r
2236 LOOK6D: TRZN    CALFLG,ASTFLG   ;DID WE FIND AT LEAST ONE\r
2237         PUSHJ   P,ERR3A         ;NO, PRINT MSG.\r
2238         JRST    LOOK            ;GET NEXT FILE FROM CS\r
2239 ;CHECK IF FILE.EXT IN DIRECTORY MATCHES FILE TO /D,/R\r
2240 ;NOTE WE MAY HAVE *.EXT,FIL.*, OR *.*\r
2241 \r
2242 \r
2243 LOOK2:  TRNN    CALFLG,MATFN    ;SHOULD FILENAMES MATCH\r
2244         JRST    LOOK3           ;NO\r
2245         MOVE    T1,FILNAM       ;YES\r
2246         CAME    T1,ZRF\r
2247         JRST    LOOK8           ;NO MATCH\r
2248 \r
2249 LOOK3:  TRNN    CALFLG,MATEX    ;SHOULD EXTENSIONS MATCH\r
2250         JRST    LOOK5           ;NO\r
2251         MOVE    T1,FILEX        ;YES\r
2252         CAME    T1,ZRF+1\r
2253         JRST    LOOK8           ;NO MATCH\r
2254 LOOK5:  IFN DISK30,<\r
2255         TRNN    AUXFLG,DSKIN    ;DSK INPUT?\r
2256         JRST    LOOK4           ;NO\r
2257         LDB     T1,UFDIN+1      ;PICKUP P-P# IN DIRECTORY\r
2258         HRRZM   T1,T2\r
2259         CAME    T2,MASK         ;COMPARE WITH OWN P-P#\r
2260         JRST    LOOK8           ;NO MATCH>\r
2261 LOOK4:  TRO     AUXFLG,READ1    ;READY FOR FIRST READ\r
2262         TRO     CALFLG,ASTFLG   ;FOUND A FILE *.EXT, F.*,*.*\r
2263         JRST    CPOPJ1          ;MATCH OR NO CARES\r
2264 \r
2265 ;FILENAME OR EXT=*\r
2266 LOOK7A: JUMPE   T2,.+2          ;EXT=0?\r
2267         CAMN    T2,STAR         ;NO,\r
2268         CAME    T1,STAR\r
2269         SKIP    1\r
2270         JRST    LOOK1           ;*.* ALWAYS O.K. AND *\r
2271         TRNN    AUXFLG,DSKIN+DTAIN\r
2272         JRST LOOK6A     ;*.A OR * ON NON-DIRECT DEV\r
2273         JRST    LOOK8\r
2274 \r
2275 LOOK7C: TRNE    AUXFLG,DSKIN+DTAIN\r
2276         JRST    LOOK6C          ;0.0 ON DIR DEVICE\r
2277         SETZM   ZRF\r
2278         SETZM   ZRF+1\r
2279         JRST    LOOK7B          ;0.0 ON NON-DIR. DEV.\r
2280 \r
2281 LOOK1:  TRNE    AUXFLG,DTAIN+DSKIN\r
2282         JRST    LOOK8\r
2283         SETZM   ZRF\r
2284         SETZM   ZRF+1\r
2285         JRST    LOOK4\r
2286 \f;ROUTINE TO GET NEXT FILE NAME FROM DIRECTORY\r
2287 ;FILNAM, FILEX CONTAIN THE FILE NAME. EXT TO BE\r
2288 ;MATCHED WITH DIR. NAMES. PUT SUGGESTED FILE\r
2289 ;NAME EXT IN ZRF, ZRF+1 AND #P-P IN ZRF+3\r
2290 ;NOTE THAT WE HAVE TO HANDLE *.EXT,FILE.*\r
2291 \r
2292 PICUP:\r
2293 IFN FTDSK,<TRNN AUXFLG,DSKIN    ;DSK INPUT?\r
2294         JRST    PICUP2          ;N0, DTA\r
2295         SOSLE   UFDIN+2         ;YES\r
2296         JRST    .+3\r
2297 PICUP1: PUSHJ   P,UIN           ;INPUT USER'S FILE DIRECTORY\r
2298         JRST    CPOPJ1          ;EOF ON DSK\r
2299         ILDB    0,UFDIN+1       ;PICK UP FILENAME\r
2300         JUMPE   0,PICUP1        ;IGNORE NULL\r
2301         MOVEM   0,ZRF           ;SET FILE NAME\r
2302         MOVE    0,FNPPN\r
2303         MOVEM   0,ZRF+3         ;SET DSK #P-P\r
2304         SOS     UFDIN+2         ;COUNT DOWN FOR NEXT TIME\r
2305         ILDB    0,UFDIN+1       ;SET FILE EX\r
2306         HLLZM   0,ZRF+1\r
2307 IFN DISK30,<\r
2308         IBP     UFDIN+1         ;INCREMENT POINTER TO GET PROJ,PROG #\r
2309         IBP     UFDIN+1>\r
2310         POPJ    P,>\r
2311 \r
2312 PICUP2:\r
2313 IFN WCH,<\r
2314         MOVE    T5,DIRST        ;DIRST=LOC 4 FIRST TIME THRU\r
2315         ADDI    T5,4            ;CALCULATE FIRST/NEXT FILENAME\r
2316         MOVEM   T5,DIRST\r
2317         MOVE    0,(T5)\r
2318         JUMPE   0,CPOPJ1                ;NO MORE FILENAMES IN DIRECTORY\r
2319         MOVEM   0,ZRF\r
2320         MOVE    0,1(T5)>\r
2321 IFE WCH,<\r
2322         MOVE    T3,DIRST1       ;SETUP TO CHECK ALL FILENAME SLOTS\r
2323         ADDI    T3,26           ;IN DIRECTORY (22 FILE NAMES)\r
2324         MOVE    T5,DIRST        ;LOC OF FIRST/NEXT FILE\r
2325 PICUP4: ADDI    T5,1            ;\r
2326         CAMLE   T5,T3           ;END OF FILE SLOTS?\r
2327         JRST    CPOPJ1          ;END OF FILE NAMES\r
2328         MOVEM   T5,DIRST        ;NEXT SLOT TO LOOK AT\r
2329         MOVE    0,(T5)          ;GOT FILE NAME FROM DIRECT\r
2330         JUMPE   0,PICUP4        ;IGNORE IF 0\r
2331         MOVEM   0,ZRF\r
2332         MOVE    0,26(T5)>       ;GET EXT ETC\r
2333         HLLZM   0,ZRF+1\r
2334         MOVE    0,PP\r
2335         MOVEM   0,ZRF+3\r
2336         POPJ    P,\r
2337 \r\f;READ DTA DIR. AND PREPARE T5 TO PICK UP FIRST ENTRY.\r
2338 \r
2339 DTADIR: PUSHJ   P,DTCH2         ;READ DTA DIR INTO INPUT BUF\r
2340 DTADI1: MOVEI   T3,DBUF         ;SET BLT FROM INBUF TO DBUF\r
2341         HRL     T3,T5           ;FIRST DATA WORD OF DIRECTORY IN T5\r
2342 IFN WCH,<\r
2343         MOVNS   T2\r
2344         BLT     T3,DBUF+176(T2)\r
2345         SETZM   DBUF+177(T2)\r
2346         MOVEI   T5,DBUF-4>\r
2347 IFE WCH,<\r
2348         BLT     T3,DBUF+176     ;MOVE FROM INBUF TO DBUF\r
2349         MOVEI   T5,DBUF+123-1>  ;LOC OF FIRST FILE NAME\r
2350         MOVEM   T5,DIRST        ;T5 POINTS TO FILNAME JUST HANDLED\r
2351         MOVEM   T5,DIRST1       ;TO RESTORE DIRST\r
2352         POPJ    P,              ;(IE NONE BUT NEXT WILL BE FIRST)\r
2353 \r
2354 \f\r
2355 ;ROUTINE TO OUTPUT FILENAMES THAT WERE DELETED OR RENAMED\r
2356 ;PRINT "FILES DELETED:" OR "FILES RENAMED:"\r
2357 ;ALSO USED TO PRINT "NO FILE NAMED XXX.XXX"\r
2358 \r
2359 \r
2360 INFO:   MOVE    T1,TFO          ;SETUP TTY FOR OUTPUT\r
2361         MOVE    T2,TFI          ;SAVE BUFFER LOCS\r
2362         PUSHJ P,INICON          ;INIT TTY\r
2363         HRROM   T2,TFI          ;SET BUFFER LOCS\r
2364         HRROM   T1,TFO\r
2365         OUTPUT CON,\r
2366         TLZE    AUXFLG,INFOFL   ;ERROR PRINT ONLY?\r
2367         JRST    ERR3AA          ;YES\r
2368         TRNN    FLAG,DFLG       ;DELETE?\r
2369         JRST    INFO1           ;NO, MUST BE RENAME\r
2370         ERRPN2  </Files deleted:/>\r
2371         JRST    INFO2\r
2372 INFO1:  SETOM   RENSN           ;DON'T PRINT IT TWICE\r
2373         ERRPN2  </Files renamed:/>      ;RENAME (/R)\r
2374 INFO2:  MOVEI   CHR,CR          ;OUTPUT CR/LF\r
2375         PUSHJ   P,PUTCON        ;ON TTY\r
2376         MOVEI   CHR,LF\r
2377         PUSHJ   P,PUTCON\r
2378         OUTPUT CON,\r
2379         POPJ    P,\r
2380 \r
2381 ;**********************************************************************\r
2382 ;PRINT FILENAME.EXT OR [P,P].UFD OF FILE DELETED\r
2383 \r
2384 INFO3:  MOVEI   T3,ZRF          ;LOCATION OF FILENAME\r
2385         PUSHJ   P,FN.EX\r
2386         JRST    INFO2\r
2387 \f;/X OR /D. FIND OUT DETAILS OF FILE NAME AND\r
2388 ;EXTENSION (0 FN.EX=*.*) AND ANY CHANGE IN\r
2389 ;SOURCE DEV. SET BITS IN CALFLG.\r
2390 \r
2391 FNSET:  TRZ     CALFLG,ALLCLF   ;CLEAR FLAGS ON ENTRY\r
2392         TRO     CALFLG,FNEX\r
2393         MOVSI   0,(SIXBIT /*/)  ;* TO AC0\r
2394         CAME    0,FILNAM        ;FILNAM=* OR 0?\r
2395         SKIPN   FILNAM\r
2396         SKIP    1               ;FILENAME = * OR 0\r
2397         TRO     CALFLG,MATFN    ;FILENAME MUST BE MATCHED\r
2398         SKIPN   FILEX           ;EXT=0?\r
2399         TRNN    AUXFLG, MTAIN+CDRIN+PPTIN+TTYIN ;YES\r
2400         CAMN    0,FILEX         ;NO, EXT = *?\r
2401         SKIP    1               ;YES\r
2402         TRO     CALFLG,MATEX    ;FILE EXTENSION MUST BE MATCHED\r
2403 IFN FTDSK,<TRNN    AUXFLG,DSKIN\r
2404         JRST    FNSET1\r
2405         SKIPN   T2,PP\r
2406         JRST    FNSET2          ;IF #P-P=0 IT IS COUNTED AS UNCHANGED\r
2407         CAME    T2,FNPPN\r
2408         TRO     CALFLG,NEWPP    ;CHANGE IN # P-P\r
2409         JRST    FNSET1\r
2410 FNSET2: MOVE    T2,FNPPN        ;IF P-P#=0, SET TO PREVIOUS VALUE\r
2411         MOVEM   T2,PP>\r
2412 FNSET1: MOVE    T2,DEVICE\r
2413         CAME    T2,DEVA\r
2414         TRO     CALFLG,NEWDEV   ;CHANGE IN SOURCE DEV.\r
2415         MOVEM   T2,DEVA         ;SET DEVA=DEVICE\r
2416         POPJ    P,\r
2417 \f;POPJ EXIT IF END OF COMMAND STRING, OTHERWISE RESET\r
2418 ;POINTER TO START OF DIRECTORY, READING IN NEW DIR.\r
2419 ;IF DEV OR #P-P CHANGED (EXIT CPOPJ1)\r
2420 ;IF DIR. IS ON DSK RESET BY REINIT.\r
2421 \r
2422 LOOKA:  SKIPE   T4,ESWTCH               ;MORE C.S.?\r
2423         POPJ    P,                      ;NO\r
2424         PUSHJ   P,DESCRP                ;YES, GET NEXT FN.EX FROM CS\r
2425         PUSHJ   P,INLOOK                ;CHECK FOR MTA REQUESTS, MODE\r
2426         PUSHJ   P,M4                    ;CHECK FOR /I,/B,/H\r
2427         HRRZM    T4,ININI1              ;SET MODE\r
2428         RELEAS  DIR,\r
2429         TRNN    AUXFLG,MTAIN+CDRIN+PPTIN+TTYIN  ;NON-DIR DEVICE?\r
2430         JRST    LOOKF\r
2431 \r
2432         TRNE    CALFLG,MATEX!MATFN      ;YES, NO FN EX BUT *.* OR * ALLOWED\r
2433         JRST    ERR6A\r
2434 \r
2435 LOOKF:  TRNN    FLAG,DFLG               ;FOR DELETE, ONE SOURCE FILE\r
2436         JRST    LOOKB                   ;...\r
2437 \r
2438         TRNE    CALFLG,NEWDEV!NEWPP     ;ONLY IS PERMITTED\r
2439         JRST    ERR5A\r
2440 \r
2441 LOOKB:  TRNN    CALFLG,NEWDEV!NEWPP     ;PREPARE TO LOOK FOR NEW FILE\r
2442         JRST    LOOKC                   ;NAME AT HEAD OF DIRECTORY\r
2443 \r
2444         PUSHJ   P,ININIT                ;INIT INPUT FILE\r
2445         TRNN    AUXFLG,DTAIN+DSKIN\r
2446         JRST    CPOPJ1\r
2447 IFN FTDSK,<TRNN AUXFLG,DTAIN            ;DTA INPUT?\r
2448         JRST    LOOKD                   ;NO, MUST BE DSK>\r
2449         PUSHJ   P,DTADIR                ;YES, READ IN DTA DIRECT\r
2450 \r
2451 LOOKC:\r
2452 IFN FTDSK,<TRNE    AUXFLG,DSKIN         ;DSK INPUT?\r
2453         JRST    LOOKD                   ;YES>\r
2454         MOVE    T5,DIRST1               ;NO, RESET DIRECTORY START\r
2455         MOVEM   T5,DIRST\r
2456         JRST    CPOPJ1\r
2457 \r
2458 IFN FTDSK,<\r
2459 LOOKD:  PUSHJ   P,DSKDIR                ;GET USER'S FILE DIRECTORY\r
2460         SETZM   UFDIN+2                 ;DSK DIR BUF EMPTY\r
2461         JRST    CPOPJ1>\r
2462 \f;ROUTINE TO LIST DTA OR DSK DIRECTORIES\r
2463 \r
2464 \r
2465 DTPDIR: ENTER   OUT,DTON        ;OUTPUT DEV,NROCT ENTRY\r
2466         JRST    ERR4            ;DIRECTORY FULL\r
2467 IFN FTDSK,<TRNE    AUXFLG,FFLG  ;/F? SHORT FORM?\r
2468         SKIPE   DEVICE          ;INPUT DEVICE SPECIFIED?\r
2469         JRST    PDIR1A          ;YES\r
2470         MOVSI   0,(SIXBIT/DSK/)\r
2471         DEVCHR\r
2472         JUMPE   0,PDIR1A        ;NO DISK\r
2473         HRRZI   0,(SIXBIT /DSK/);ASSUME DSK IF NO DEVICE GIVEN\r
2474         HRLZM   0,DEVICE\r
2475         TROA   AUXFLG,DSKIN     ;SET DSK INPUT\r
2476 PDIR1A: TRNE    AUXFLG,DSKIN    ;DSK INPUT?\r
2477         JRST    DSKLST          ;YES, GO AND TRY TO LIST DSK>\r
2478         TRNN    AUXFLG,DTAIN    ;DECTAPE INPUT?\r
2479         JRST    ERR5            ;NOT DSK OR DTA. ERROR\r
2480 \r
2481 ;ROUTINE TO LIST DTA DIRECTORY. /L OR /F SWITCH\r
2482 \r
2483 DTALST: PUSHJ   P,DTCHECK       ;CHECK FOR DTA INPUT-MUST BE DECTAPE AND\r
2484                                 ;GET DIRECTORY\r
2485         PUSHJ   P,CRLF          ;PRINT NO. OF FREE BLOCKS LEFT\r
2486         LDB     T1,[POINT 5,16(T5),14]\r
2487         CAIE    T1,36           ; SKIP DIR HEADER IF\r
2488         JRST    PDIR1B          ; DECTAPE HAS NO PROTECTION\r
2489         LSTLIN  HEDL1           ; PRINT HEADER\r
2490         MOVE    T2,DTAID\r
2491         JUMPE   T2,DTALS4\r
2492         MOVEI   T2,5            ; CHARACTER COUNT\r
2493         MOVE    0,[POINT 6,DTAID]\r
2494         ILDB    CHR,0           ; GET CLASSIFICATION\r
2495         CAIE    CHR,23          ; STD (I.E.=3) ?\r
2496         AOJA    T2,DTALS3\r
2497 DTALS1: ILDB    CHR,0           ; GET NEXT DIGIT\r
2498         ADDI    CHR,40          ; CONVERT TO ASCII\r
2499         CAIN    CHR,"0"         ; SUPPRESS LEADING ZEROS\r
2500         SOJG    T2,DTALS1\r
2501         PUSHJ   P,PUT\r
2502 DTALS2: SOJLE   T2,DTALS4\r
2503         ILDB    CHR,0\r
2504 DTALS3: ADDI    CHR,40\r
2505         PUSHJ   P,PUT\r
2506         JRST    DTALS2\r
2507 DTALS4: MOVEI   CHR,"["\r
2508         PUSHJ   P,PUT\r
2509         HLRZ    DOUT,DIRPPN\r
2510         PUSHJ   P,OUTDEC\r
2511         MOVEI   CHR,","\r
2512         PUSHJ   P,PUT\r
2513         HRRZ    DOUT,DIRPPN\r
2514         PUSHJ   P,OUTDEC\r
2515         MOVEI   CHR,"]"\r
2516         PUSHJ   P,PUT\r
2517         PUSHJ   P,CRLF\r
2518 PDIR1B:\r
2519 \r
2520 IFN WCH,<\r
2521         MOVE    T1,IBF\r
2522         HLRZ    DOUT,1(T1)      ;GET FREE BLOCK POINTER\r
2523         MOVNS   DOUT\r
2524         ADDI    DOUT,1101       ;GET NO. OF FREE BLOCKS LESS FREE BLOCK NO.\r
2525         PUSHJ   P,OUTDEC        ;PRINT RESULT>\r
2526 IFE WCH,<\r
2527         SETZ   DOUT,            ;CLEAR NO. FREE BLOCKS\r
2528         MOVEI   T4,1102         ;OCTAL NO. OF BLOCKS ON DECTAPE\r
2529         MOVSI   T1,(POINT 5,0)  ;5 BIT BYTES\r
2530         HRRZ    T5,IBF          ;CURRENT INPUT BUFFER\r
2531         ADDI    T1,1(T5)        ;POINTER TO 1ST DATA WORD IN DIRECT\r
2532 \r\r
2533 PDIR8:  SOJLE   T4,PDIR1        ;ALL THROUGH?\r
2534         ILDB    T3,T1           ;CALCULATE NO. OF FREE BLOCKS\r
2535         JUMPN   T3,PDIR8\r
2536 \r
2537                                 ;THIS BLOCK FULL\r
2538         AOJA    DOUT,PDIR8      ;COUNT NO. WITH ZERO IN\r
2539 PDIR1:  PUSHJ   P,OUTDEC        ;PRINT RESULT>\r
2540         MOVE    0,[POINT 6,PDIR7]\r
2541         MOVEI   T2,^D18         ;SET LOOP TO DEPOSIT 18 CHARS\r
2542         PUSHJ   P,PDIR2         ;PRINT "FREE BLOCKS LEFT" MESSAGE\r
2543         PUSHJ   P,CRLF          ;CARRIAGE RET, LINEFEED\r
2544         PUSHJ   P,DTCH1         ;FIX T5, TO POINT AT BEGIN OF DIR\r
2545 \f;LOOP TO EXAMINE FILE NAMES DTA DIRECTORY\r
2546 PDIR4:\r
2547 IFE WCH,<\r
2548         SKIPN   123(T5)         ;NULL (=0) FILE NAME?\r
2549         JRST    PDIR6           ;YES SO LOOK FOR ANOTHER>\r
2550 IFN WCH,<\r
2551         SKIPN   (T5)            ;NULL (=0) FILE NAME?\r
2552         JRST    MAIN1           ;YES, SO END OF DIR.>\r
2553         MOVEI   T2,6            ;TRANSMIT UP TO 6 CHARACTERS\r
2554         MOVSI   0,440600+T5     ;SET UP SOURCE BYTE POINTER\r
2555 IFE WCH,<\r
2556         HRRI    0,123>          ;SET TO PICK UP FILE NAME\r
2557         SETZ   T4,\r
2558 ;FOLLOWING CODE TO OUTPUT PROJ, PROG FILENAME\r
2559 ;*****************************************************************\r
2560 IFE WCH,<\r
2561         HLRZ    CHR,151(T5)     ;GET EXT\r
2562         CAIE    CHR,(SIXBIT/UFD/)       ;UFD?\r
2563         JRST    PDIR4A          ;NO\r
2564 \r
2565         HLRZ    DOUT,123(T5)    ;PROJ NO.\r
2566         MOVEI   T2,PUT\r
2567         PUSHJ   P,OUTDC1\r
2568 \r
2569         MOVEI   CHR,COMMA       ;COMMA\r
2570         PUSHJ   P,PUT\r
2571 \r
2572         HRRZ    DOUT,123(T5)    ;PROG NO.\r
2573         PUSHJ   P,OUTDC1\r
2574         JRST    PDIR4B\r
2575         >\r
2576 ;*********************************************************************\r
2577 PDIR4A: PUSHJ   P,PDIR2         ;OUTPUT 6-BIT DATA AND INCR DIRECTORY PTR\r
2578 IFE WCH,<\r
2579 PDIR4B: HLLZ    CHR,151(T5)>    ;PICK UP EXTENSION\r
2580 IFN WCH,<\r
2581         HLLZ    CHR,(T5)>\r
2582         MOVSI   0,440600+T5     ;SET BYTE POINTER\r
2583 IFE WCH,<\r
2584         HRRI    0,151>          ;PICK UP EXTENSION\r
2585         MOVEI   T2,4            ;PRINT UP TO 4 CHRS. (PERIOD+3*EXT)\r
2586         JUMPN   CHR,.+3         ;EXTENSION NULL?\r
2587         PUSHJ   P,PDIR2A+1      ;YES\r
2588         SKIP    2               ;NO\r
2589         MOVEI   CHR,PERIOD-40   ;NO, SO PRINT A PERIOD\r
2590 PDIR3:  PUSHJ   P,PDIR2A        ;OUTPT 6 BIT OR INCR T5\r
2591 IFE WCH,<\r
2592         MOVEI   CHR,SPACE       ;OUTPUT 2 SPACES\r
2593         PUSHJ   P,PUT\r
2594         PUSHJ   P,PUT\r
2595         TRNE AUXFLG,FFLG        ;SHORT FORM DIRECT ?\r
2596         JRST PDIR3A             ;YES VJC 4/16/69\r
2597 \r
2598         SETZ    DOUT,           ;CALCULATE NBR OF BLOCKS PER FILE\r
2599         MOVEI   T4,1101\r
2600         MOVSI   0,(POINT 5,0)\r
2601         HRRZ    T2,IBF\r
2602         ADDI    0,1(T2)\r
2603         HRRZ    T7,T5\r
2604         SUBI    T7,(T2)\r
2605         ILDB    T6,0            ;LOAD CONTENTS OF S.A.T. BLOCK\r
2606         CAMN    T6,T7           ;COMPARE WITH FILE SLOT NBR\r
2607         ADDI    DOUT,1          ;ADD 1 TO COUNT IF EQUAL\r
2608         SOJG    T4,.-3\r
2609         PUSHJ   P,OUTDEC        ;OUTPUT NBR OF BLOCKS PER FILE\r
2610         MOVEI   CHR,TAB\r
2611         >\r
2612 IFN WCH,<\r
2613         AOJ     T5,             ;STEP DIR. POINTER\r
2614         MOVEI   CHR,11\r
2615         PUSHJ   P,PUT           ;OUTPUT A TAB\r
2616         CAIG    T4,7>\r
2617         PUSHJ   P,PUT\r
2618         LDB     T1,[POINT 5,DBUF+16,14]\r
2619         CAIE    T1,36\r
2620         JRST    PDIR3B\r
2621         HRRZ    T1,IBF\r
2622         SUBM    T5,T1\r
2623         LDB     0,[POINT 9,DBUF+200(T1),8]\r
2624         PUSHJ   P,PROTO         ; OUTPUT PROTECTION\r
2625 PDIR3B:\r
2626 IFE WCH,<\r
2627         MOVE    0,151(T5)       ;GET ENTRY DATE>\r
2628 IFN WCH,<\r
2629         MOVE    0,-1(T5)        ;GET ENTRY DATE>\r
2630         ANDI    0,7777          ;LEFT BITS ARE IRRELEVENT\r
2631         PUSHJ   P,DATOUT        ;OUTPUT THE DATE\r
2632 PDIR3A: PUSHJ   P,CRLF          ;GIVE CR,LF 4/16/69\r
2633 IFN WCH,<\r
2634         AOJA    T5,PDIR4        ;PROCESS NEXT ENTRY>\r
2635 IFE WCH,<\r
2636 PDIR6:  HRRZ    T1,IBF          ;PROCESS NEXT ENTRY\r
2637         SUBM    T5,T1\r
2638         CAIL    T1,26           ;FILE "NUMBER" OK?\r
2639         JRST    MAIN1           ;NO, END OF ENTRIES\r
2640         AOJA    T5,PDIR4        ;END OF LOOP, GET NEXT FILENAME>\r
2641 \f\r
2642 IFN FTDSK,<\r
2643 CLRF:   SOS     LIN>\r
2644 CRLF:   MOVEI   CHR,CR          ;OUTPUT CAR. RET.\r
2645         PUSHJ   P,PUT\r
2646         MOVEI   CHR,LF          ;LINE FEED\r
2647         JRST    PUT\r
2648 \r
2649 PDIR2:  ILDB    CHR,0           ;ROUTINE TO OUTPUT 6-BIT DATA\r
2650         TRNN    0,-1            ;PRINT SPACES WHEN PRINTING THE FREE BLOCKS\r
2651 PDIR2A: JUMPE   CHR,PDIR21      ;TERMINATE ON SPACE\r
2652         ADDI    CHR,40          ;CONVERT TO 7 BIT\r
2653         PUSHJ   P,PUT           ;OUTPUT CHARACTER\r
2654         ADDI    T4,1\r
2655         SOJG    T2,PDIR2        ;COUNT DOWN MAX-CHARS COUNTER\r
2656 IFN WCH,<\r
2657 PDIR21: AOJA    T5,CPOPJ        ;STEP AND CONTINUE>\r
2658 IFE WCH,<\r
2659 PDIR21: POPJ    P,              ;CONTINUE>\r
2660 \fPDIR7: SIXBIT /. FREE BLOCKS LEFT/\r
2661 ;OUTPUT THE DATE FOUND IN AC 0.\r
2662 \r
2663 DATOUT: MOVEI T2,PUT            ;PUT CHAR IN OUT\r
2664         IDIVI 0,^D31\r
2665         MOVEI T3,1(1)\r
2666         IDIVI 0,^D12\r
2667         MOVE DOUT,T3            ;DOUT=DAY\r
2668         PUSHJ P,OUTDC1          ;PRINT DAY\r
2669         PUSHJ P,DATO2           ;PRINT -MONTH-\r
2670         MOVE DOUT,0\r
2671         ADDI DOUT,^D64          ;DOUT=YEAR\r
2672 OUTDC1: SKIPA DOUT+1,TWL        ;RADIX 10\r
2673 ;*******************************************************************\r
2674 ;ROUTINE TO CONVERT OCTAL TO ASCII\r
2675 ;DOUT CONTAINS OCTAL VALUE ON ENTRY\r
2676 \r
2677 OUTOCT: MOVEI DOUT+1,10         ;RADIX 8\r
2678 PRNUMA: HRRZM DOUT+1,T4\r
2679         MOVEI CHR,"0"\r
2680         CAMGE DOUT,DOUT+1       ;PRINT AT LEAST 2 DIGITS\r
2681         PUSHJ P,(T2)            ;PUT OR PUTCON\r
2682 PRN:    IDIVI DOUT,(T4)         ;DIVIDE BY RADIX\r
2683         HRLM DOUT+1,(P)         ;SAVE NO. FOR PRINT\r
2684         JUMPE DOUT,.+2          ;ENUF DIGITS?\r
2685         PUSHJ P,PRN             ;NO, GET MORE\r
2686         HLRZ CHR,(P)            ;YES, GET LEFTMOST\r
2687         ADDI CHR,60             ;CONVERT TO ASCII\r
2688         JRST (T2)               ;PUT OR PUTCON\r
2689 \r
2690 OUTDE4: MOVEI   CHR," "         ;SET UP FOR SPACES\r
2691         CAIL    DOUT,^D1000     ;PRINT 4 CHAR.\r
2692         JRST    OUTDEC          ;AT LEAST 4 SEEN\r
2693         PUSHJ   P,PUT           ;OUTPUT ONE SPACE\r
2694         CAIGE   DOUT,^D100      ;3 CHAR.?\r
2695         PUSHJ   P,PUT           ;NO,SO ANOTHER SPACE\r
2696 OUTDEC: MOVEI T2,PUT            ;PUT CHAR IN OUT BUF\r
2697         JRST OUTDC1\r
2698 \r
2699 DATO2:  MOVEI T4,5\r
2700         MOVE T6,MNPT\r
2701         ADDM 1,T6\r
2702         ILDB CHR,T6\r
2703         PUSHJ P,(T2)            ;PUT OR PUTCON\r
2704         SOJG T4,.-2\r
2705         POPJ P,\r
2706 \f;READ DTA DIRECTORY AND INITIALIZE DIRST AND DIRST1\r
2707 \r
2708 DTCHECK:PUSHJ P,ININIT  ;INITIALIZE INPUT DEVICE\r
2709 DTCH2:\r
2710 IFN WCH,<\r
2711         USETI IN,1      ;GET DTA DIR>\r
2712 IFE WCH,<\r
2713         USETI IN,144    ;GET DTA DIR>\r
2714         PUSHJ P,INP     ;INPUT DIRECTORY\r
2715         CLOSE   IN,\r
2716         PUSHJ   P,GETPPN        ; GET PPN OF DECTAPE\r
2717         PUSHJ   P,ININIT        ; REINITIALIZE INPUT DEVICE\r
2718 IFN WCH,<\r
2719 DTCH1:  MOVE T5,IBF\r
2720         HRRZ T2,1(T5)\r
2721         ADDI T5,1(T2)   ;GET ADD. OF FIRST ENTRY\r
2722         MOVE 0,T5\r
2723         SUBI 0,4>\r
2724 IFE WCH,<\r
2725 DTCH1:  HRRZ T5,IBF     ;LOC. OF CURRENT BUF, 2ND WORD\r
2726         MOVEI 0,123(T5) ;83 WORDS,7, FIVE-BIT BYTES\r
2727         ADDI T5,1       ;COMPUTE ADD. OF DIR. START>\r
2728         MOVEM 0,DIRST   ;FIRST FILE NAME LOC\r
2729         MOVEM 0,DIRST1  ;TO RESTORE DIRST\r
2730         POPJ P,\r
2731 \r
2732 ;ROUTINE TO CHECK BRACKET COUNT/MATCHING\r
2733 \r
2734 OUTCHK: SETZB T3,TLBRKT ;COUNT <> ON THIS LINE, CLEAR THINGS\r
2735         MOVE T1,OPTRA   ;BYTE POINTER FOR READING OUT THE LINE\r
2736 OUTCH2: CAMN T1,OPTR    ;LINE DONE?\r
2737         JRST OUTCH3     ;YES, SO DECIDE WHETHER TO PRINT\r
2738         ILDB T2,T1      ;GET CHAR\r
2739         CAIN T2,"<"     ;LEFT BRACKET?\r
2740         AOS TLBRKT      ;YES, SO INCREMENT BRACKET COUNT\r
2741         CAIN T2,">"     ;RIGHT BRACKET?\r
2742         SOSL TLBRKT     ;YES, SUBTRACT BRACKET COUNT, GONE NEG?\r
2743         JRST OUTCH2     ;NO, SO DO NEXT CHAR\r
2744         AOJA T3,OUTCH2  ;YES, SO FLAG COUNT GONE NEG.\r
2745 \r
2746 OUTCH3: SKIPN T2,TLBRKT ;BRACKET COUNT OFF THIS LINE?\r
2747         JUMPE T3,CPOPJ  ;NO, WENT NEG.?\r
2748         ADDM T2,TOTBRK  ;YES, SO ADD INTO CUMULATIVE COUNT\r
2749         MOVEI CHR,"-"   ;PRINT MINUS FOR NEG TOTAL\r
2750         SKIPGE TOTBRK\r
2751         PUSHJ P,PUT\r
2752         MOVM DOUT,TOTBRK;PRINT MAGNITUDE OF TOTAL\r
2753         PUSHJ P,OUTDEC\r
2754         MOVEI CHR,TAB   ;FOLLOW WITH TAB\r
2755         PUSHJ P,PUT\r
2756         JRST OUTCH1     ;AND PRINT THE LINE\r
2757 \r
2758 GETPPN: MOVEI   T5,117  ; NON STD DUMP MODE\r
2759         MOVEM   T5,DTBLK\r
2760         MOVE    T5,DEVICE       ; GET INPUT DEVICE\r
2761         MOVEM   T5,DTDEV\r
2762         OPEN    DTDIR,DTBLK\r
2763         POPJ    P,\r
2764         USETI   DTDIR,144       ; READ BLOCK 100 AND\r
2765         MOVE    T5,[IOWD 227,DBUF]\r
2766         MOVEI   T6,0\r
2767         INPUT   DTDIR,T5        ; WORD 1 OF BLOCK 101.\r
2768         MOVE    T5,177+DBUF\r
2769         MOVEM   T5,DTAID\r
2770         MOVE    T5,200+DBUF\r
2771         MOVEM   T5,DIRPPN       ; SAVE PPN FOR LISTING\r
2772         RELEASE DTDIR,\r
2773         POPJ    P,\r
2774 \fFILTYP:        TDNE FLAG,[XWD IFLG+IBFLG,BMOD]\r
2775         POPJ P,                 ;BIN MODE DON'T CARE IF DMP, ETC\r
2776         TRNN    AUXFLG,DSKIN!DTAIN!MTAIN        ;BINARY INPUT POSSIBLE?\r
2777         JRST    FIL11           ;NO\r
2778         TRNN    AUXFLG,DSKOUT!DTAOUT!MTAOUT     ;BINARY OUTPUT?\r
2779         JRST    FIL11           ;NO\r
2780         TDNN    FLAG,[XWD PFLG,LINE!TBMOD!NSMOD!SQMOD!SPMOD]\r
2781         TLNE    AUXFLG,CDRFLG   ;/E FROM DSK IS NOT BINARY\r
2782         JRST    FIL11           ;SO TURN OFF SBIN\r
2783         JRST    FIL3            ;FORCE BINARY MODE\r
2784 FIL11:  TLZ AUXFLG,SBIN         ;IS\r
2785         HLRZ 0,ZRF+1            ; INPUT EXTENSION\r
2786         CAIE 0,(SIXBIT /DMP/)   ;DMP?\r
2787 IFE DISK30,<CAIN 0,(SIXBIT /SAV/)       ;SAV?>\r
2788 IFN DISK30,<CAIN 0,(SIXBIT/SVE/)>\r
2789         JRST FIL3               ;YES\r
2790         CAIE 0,(SIXBIT /CHN/)   ;CHN?\r
2791         CAIN 0,(SIXBIT /REL/)   ;REL?\r
2792         JRST FIL3               ;YES\r
2793         CAIE    0,(SIXBIT /SHR/)\r
2794         CAIN    0,(SIXBIT /HGH/)\r
2795         JRST    FIL3\r
2796         CAIE    0,'BIN' ; GENERAL BINARY EXTENSION?\r
2797         CAIN    0,(SIXBIT /LOW/)\r
2798         JRST    FIL3\r
2799         TRNN FLAG,XFLG          ;DO NORMAL PROCESSING ON ALL\r
2800         JRST FIL2               ;BUT DMP ETC FILES IF NOT /X\r
2801         TLNN AUXFLG,CDRFLG\r
2802         TDNE FLAG,[XWD PFLG,LINE+TBMOD+NSMOD+SQMOD+SPMOD]\r
2803         POPJ P,                 ;NO SIGNIFICANT SWITCHES\r
2804 FIL1:   HRLZI 0,004400          ;FORCE 36-BIT.\r
2805         HLLM 0,IBF+1            ;INPUT BYTE POINTER\r
2806         HLLM 0,OBF+1            ;OUTPUT BYTE POINTER\r
2807         POPJ P,                 ;CHANGE TO FORCED BINARY\r
2808 FIL3:   TLO AUXFLG,SBIN         ;INPUT EXT = DMP,SAV,CHN,REL\r
2809         TRNE FLAG,XFLG\r
2810         JRST FIL1\r
2811         TLON AUXFLG,FRSTIN      ;NOT /X TEST FURTHER\r
2812         JRST FIL4               ;IS THIS FIRST SOURCE, YES\r
2813         TLOE AUXFLG,RSDCFL      ;NOT FIRST, WAS PREVIOS FILE RSCD?\r
2814         JRST    FIL5            ;YES, NO CHANGE UNLESS DEVICE HAS CHANGED\r
2815         OUTPUT OUT,             ;NO CHANGE TO 36-BIT\r
2816         MOVE 0,OBF+2            ;CURRENTLY 7-BIT I/O, MUST CHANGE TO 36-BIT\r
2817                                 ;OUTPUT CURRENT BUFFER\r
2818         IDIVI 0,5               ;DIVIDE OBF+2 BY 5 (CHAR. COUNT)\r
2819         MOVEM 0,OBF+2\r
2820         JRST FIL1\r
2821 FIL2:   TLOE AUXFLG,FRSTIN      ;NOT A RSCD FILE\r
2822         TLZN AUXFLG,RSDCFL      ;NO, WAS PREV. FILE RSCD?\r
2823         POPJ P,                 ;NO, NO CHANGE\r
2824         OUTPUT OUT,             ;YES, CHANGE 36-BIT TO 7-BIT\r
2825         MOVEI 0,5\r
2826         IMULM 0,OBF+2\r
2827         MOVE 0,SVIBF            ;RESTORE 7-BIT\r
2828         HLLM 0,IBF+1\r
2829         MOVE 0,SVOBF\r
2830         HLLM 0,OBF+1\r
2831         POPJ P,\r
2832 FIL4:   TLO AUXFLG,RSDCFL       ;SET REL,SAV,DMP,CHN FLAG\r
2833         JRST FIL1\r
2834 FIL5:   HRLZI 0,004400          ;NEW DEVICE, SET 36-BIT INPUT\r
2835         TRNE CALFLG,NEWDEV      ;SOURCE DEVICE CHANGED\r
2836         HLLM 0,IBF+1\r
2837         POPJ P,                 ;OUTPUT ALREADY SET\r
2838 \r
2839 \r
2840 \fSUBTTL BLOCK 0 CODE\r
2841 \r
2842 IFE BLOC0,<\r
2843 IFE WCH,<;THIS CODE COPIES BLOCK 0,1,2 ONLY. I/O MUST BE DECTAPE.>\r
2844 IFN WCH,<;THIS CODE COPIES BLOCK 0 ONLY. I/O MUST BE DECTAPE.>\r
2845 ;MODE SELECTED MUST BE BIT 100, 20 AND NOT DUMP MODE (134).\r
2846 \r
2847 BLOCK0: TRC AUXFLG,DTAIN+DTAOUT\r
2848         TRCE AUXFLG,DTAIN+DTAOUT;FORCE DTA I/O\r
2849         JRST ERR7A\r
2850         MOVEI 0,134\r
2851         MOVEM 0,OMOD\r
2852         MOVEM 0,ININI1\r
2853         MOVSI 0,OBF\r
2854         MOVEM 0,ODEV+1\r
2855         MOVEI 0,IBF\r
2856         MOVEM 0,DEVICE+1\r
2857         OPEN OUT,OMOD\r
2858         JRST ERR1               ;UNAVAILABLE\r
2859         OUTBUF  OUT,1\r
2860         OUTPUT  OUT,\r
2861         OPEN IN,ININI1\r
2862         JRST ERR1A\r
2863         INBUF IN,1\r
2864         SETZB T1,BL0CNT\r
2865 BL4:    USETI IN,(T1)\r
2866         INPUT IN,               ;READ\r
2867         GETSTS IN,IOS\r
2868         TRNN IOS,740000         ;ANY ERRORS\r
2869         JRST BL1                ;NO\r
2870         JSP T5,INICN2\r
2871         PUSHJ P,QUEST\r
2872         ERRPN2 </Input device />\r
2873         PUSHJ P,P6BIT\r
2874               DEVICE\r
2875         ERRPN2 </: />\r
2876         MOVE T2,AUXFLG          ;DECTAPE FOR ERROR MESSAGE\r
2877         ANDI T2,DTAIN\r
2878         PUSHJ P,IOERR           ;PRINT ERROR TYPE\r
2879 BL1:    HRLZ T5,IBF+1\r
2880         HRR T5,OBF+1\r
2881         MOVEI T4,177(T5)\r
2882         BLT T5,(T4)             ;SHIFT DATA TO OUTPUT BUFFER\r
2883         USETO   OUT,@BL0CNT\r
2884         OUTPUT OUT,             ;WRITE BLOCK\r
2885         PUSHJ P, OUTP1          ;CHECK ERRORS\r
2886 IFE WCH,<\r
2887         AOS T1,BL0CNT\r
2888         CAIGE T1,3\r
2889         JRST BL4>\r
2890 BL3:    RELEASE OUT,            ;IF ANY, PDL IS RESET\r
2891         JRST PIP2>\r
2892 \r
2893 IFN BLOC0,<\r
2894 BLOCK0: ERRPNT  </?No block 0 copy!/>\r
2895                 >\r
2896 \fSUBTTL MAGTAPE ROUTINES\r
2897 \r
2898 ;TEST TO SEE IF MORE THAN ONE OF THE LOWEST EIGHT MTA FLAGS\r
2899 ;HAVE BEEN SELECTED. IF SO ERROR. OTHERWISE, IMPLEMENT\r
2900 ;REQUEST.  T1, T3, T6 SET AT ENTRY BY INLOOK OR OUTLOOK\r
2901 ;TO EQUAL AUX/AUXOUT, AB/ABOUT,INIMTA/INOMTA\r
2902 \r
2903 MT1:    HRRZ T2,T1              ;T1 CONTAINS REQUEST\r
2904         ANDI T2,-1(T2)          ;KNOCK OFF RIGHT MOST 1\r
2905         TRNE T2,377\r
2906         JRST MTR1               ;PRINT ERROR MESSAGE\r
2907 \r
2908         TRNN T1,MTAFLG+MTBFLG+MTWFLG+MTTFLG+MTFFLG+MTUFLG+MTDFLG+MTPFLG\r
2909         JRST MTC1\r
2910         PUSHJ P,(T6)            ;THERE IS A  REQUEST\r
2911                                 ;GO TO INIMTA/INOMTA\r
2912 \r
2913 ;PERFORM POSITIONING REQUESTS\r
2914         TRNE T1,MTUFLG\r
2915         JRST UNLOAD\r
2916 \r
2917         TRNE T1,MTWFLG\r
2918         JRST REWIND\r
2919 \r
2920         TRNE T1,MTFFLG\r
2921         JRST MARKEF\r
2922 \r
2923         TRNE T1,MTTFLG\r
2924         JRST SLEOT\r
2925 \r
2926         TRNE T1,MTBFLG+MTPFLG   ;MULTIPLE REQUESTS ALLOWED\r
2927         JRST BSPF\r
2928 \r
2929         TRNE T1,MTAFLG+MTDFLG   ;MULTIPLE REQUESTS ALLOWED\r
2930         JRST ADVF\r
2931 \r
2932 \f;T1=AUX,AUXOUT. T3=AB,ABOUT.  T6=INIMTA,INOMTA.\r
2933 \r
2934 MTCONT: RELEAS TAPE,\r
2935         TRNN T1,MTUFLG          ;UNLOAD?\r
2936         TRNE CALFLG,NSWTCH      ;IS THERE AN INPUT DEVICE?\r
2937         CAIE T6,INOMTA          ;OUTPUT TAPE?\r
2938         POPJ P,                 ;NO\r
2939         JRST PIP2               ;YES, END OF COMMAND\r
2940 \r
2941 ;ROUTINE TO CHECK AND SET DENSITY FOR NEW DEVICE\r
2942 \r
2943 MTC1:   MOVE T4,T1              ;GET AUX/AUXOUT\r
2944         ANDI T4,MT2FLG+MT5FLG+MT8FLG\r
2945         ANDI T4,-1(T4)          ;REMOVE RIGHT MOST 1\r
2946         JUMPN T4,MTR1           ;MORE THAN 1 REQ, ERROR\r
2947 \r
2948         MOVEI T4,1              ;ASCII LINE STANDARD MODE\r
2949 \r
2950         TRNE T1,MT2FLG\r
2951         TRO T4,DENS2            ;SET 200 BPI\r
2952 \r
2953         TRNE T1,MT5FLG\r
2954         TRO T4,DENS5            ;SET 556 BPI\r
2955 \r
2956         TRNE T1,MT8FLG\r
2957         TRO T4,DENS8            ;SET 800 BPI\r
2958 \r
2959         TRNE T1,MTEFLG\r
2960         TRO T4,PARE             ;EVEN PARITY\r
2961 \r
2962         POPJ P,\r
2963 \r
2964 \f;REWIND AND UNLOAD\r
2965 \r
2966 UNLOAD: MTAPE TAPE,11\r
2967         JRST MTCONT\r
2968 \r
2969 ;REWIND ONLY\r
2970 \r
2971 REWIND: MTAPE TAPE,1\r
2972 MTWAIT: WAIT TAPE,\r
2973         JRST MTCONT\r
2974 \r
2975 \r
2976 \r
2977 \r
2978 ;MARK END OF FILE\r
2979 \r
2980 MARKEF: MOVE T5,MTANAM\r
2981         EXCH T5,ODEV\r
2982         MTAPE TAPE,3\r
2983         GETSTS TAPE,IOS\r
2984         PUSHJ P,OUTP3\r
2985         SETSTS TAPE,(IOS)\r
2986         MOVEM T5,ODEV\r
2987         JRST MTCONT\r
2988 \r
2989 \r
2990 \r
2991 \r
2992 ;SKIP TO LOGICAL END OF TAPE.\r
2993 \r
2994 SLEOT:  MTAPE TAPE,10\r
2995         JRST MTWAIT\r
2996 \f;BACKSPACE MTA 1 FILE, T3=AB OR ABOUT\r
2997 ;AB/ABOUT = INPUT/OUTPUT DEVICE\r
2998 \r
2999 BSPF:   HRRZ T3,T3      ;T3=NO. OF FILES/RECORDS TO BACK\r
3000 BSPF2:  WAIT TAPE,      ;WAIT\r
3001         GETSTS TAPE,IOS\r
3002         TRNN IOS,LDP    ;AT LOAD POINT?\r
3003         JRST BSPF3      ;NO LDP\r
3004         ERRPNT </?Load point before end of (MB) or (MP) request!/>\r
3005 BSPF3:  MOVEI T5,7      ;BSPR\r
3006         TRNN T1,MTPFLG  ;BSPR?\r
3007         MOVEI T5,17     ;BSPF\r
3008         MTAPE TAPE,(T5) ;BACKSPACE FILE/RECORD\r
3009         SOJGE T3,BSPF2  ;MORE FILES/RECORDS TO BSP?\r
3010                         ;NO, END OF LOOP\r
3011         WAIT TAPE,\r
3012         GETSTS TAPE,IOS\r
3013         TRNN T1,MTBFLG  ;BACKSPACE FILE?\r
3014         JRST MTCONT     ;NO\r
3015         TRNN IOS,LDP    ;IF AT LOAD POINT\r
3016         MTAPE TAPE,16   ;(MOVE FWD. OVER EOF)\r
3017         JRST MTCONT     ;DON'T SKIP A RECORD\r
3018 \r
3019 \r
3020 \r
3021 ;ADVANCE MTA 1 FILE, T3=AB OR ABOUT\r
3022 ;AB/ABOUT = INPUT/OUTPUT DEVICE\r
3023 \r
3024 ADVF:   HLRZ T3,T3      ;T3=NO. FILES (OR REC) TO ADVANCE\r
3025 ADVF2:  MOVEI T5,6      ;ADVR\r
3026         TRNN T1,MTDFLG  ;ADVR ?\r
3027         MOVEI T5,16     ;ADVF\r
3028         MTAPE TAPE,(T5) ;ADVANCE FILE/RECORD\r
3029         SOJG T3,ADVF2   ;MORE FILES/RECORDS TO ADV?\r
3030                         ;NO, END OF LOOP\r
3031         WAIT TAPE,      ;WAIT...\r
3032         GETSTS TAPE,IOS\r
3033         TRZE IOS,EOFBIT\r
3034         SETSTS TAPE,(IOS)       ;END OF FILE\r
3035         JRST MTCONT\r
3036 \f;ROUTINE TO INITIALIZE MAGTAPE FOR INPUT OR OUTPUT\r
3037 \r
3038 INOMTA: SKIPA T2,ODEV   ;INIT OUTPUT DEVICE\r
3039 INIMTA: MOVE T2,DEVICE  ;INIT INPUT DEVICE\r
3040         SETZM MTANAM+1\r
3041         MOVEM T2,MTANAM\r
3042         TRNN CALFLG,NEWDEV\r
3043         JRST INMTA      ;SAME DEVICE\r
3044         PUSHJ P,MTC1    ;NEW DEVICE\r
3045         HRRZM   T4,INMTA1       ;SET MODE,DENSITY,PARITY\r
3046 \r
3047 INMTA:  OPEN TAPE,INMTA1\r
3048         JRST ERR1B\r
3049         POPJ P,\r
3050 \r
3051 ;ROUTINE TO PRINT ERROR MSG IF MORE THAN 1/8 FLAGS SET\r
3052 \r
3053 MTR1:   MOVE T4,DEVICE  ;TENTATIVELY SET I/DEV\r\r
3054         CAIE T6,INIMTA  ;INPUT DEVICE?\r
3055         MOVE T4,ODEV    ;NO, SET O/DEV\r
3056         ERRPNT </?Too many requests for />\r
3057         PUSHJ P,P6BIT\r
3058                 T4\r
3059         JRST    PIP2\r
3060 \f       SUBTTL  CONSTANTS/STORAGE/VARIABLES\r
3061 \r
3062 ;CONSTANTS\r
3063 \r
3064 IFE WCH,<\r
3065 OKBD:   POINT 6,DTON+2,23       ;FOR NO. 1K BLOCKS\r
3066 OKB:    POINT 6,ZRF+2,23>\r
3067 DATE:   POINT 12,ZRF+2,35\r
3068 DATED:  POINT 12,DTON+2,35      ;CREATION DATE /X\r
3069 ZRO:    ASCII /00000/\r
3070 OPTMAX: POINT 7,LBUFE-1,34\r
3071 OPTRA:  XWD 700,LBUF-1          ;INITIAL POINTER TO LINE BUFFER\r
3072 K1:     432150643240            ;MAGIC ASCII INCREMENT BY 10\r
3073 K3:     375767737576            ;CHARACTER MASK 077\r
3074 K4:     432150643216            ;MAGIC ASCII INCREMENT BY 1\r
3075 QPIP:   SIXBIT /QPIP/           ;DATA FOR Q SWITCH\r
3076 STAR:   SIXBIT /*/              ;LOOK FOR *.* FILNAM.EXT\r
3077 TWL:    OCT 12\r
3078 PP11:   XWD 1,1\r
3079 PP13:   XWD 1,3                 ; SANDERS SYS\r
3080 UPROJ:  EXP     ^D101   ; SANDERS UNIVERSAL PROJECT\r
3081 IFN FTDSK,<\r
3082 PRPTL:  POINT 9,PROTS,8         ;PROTECTION FOR RENAME\r
3083 PRPTD:  POINT 9,DTON+2,8\r
3084 PRNM:   POINT 9,ZRF+2,8         ;PROT FOR /R\r
3085 TIME:   POINT 11,ZRF+2,23       ;CREATE TIME /X\r
3086 TIMED:  POINT 11,DTON+2,23      ;DEPOSIT CREATE TIME>\r
3087 \r
3088 \r
3089 \r
3090 \f;PROGRAM STORAGE AREA\r
3091 \r
3092 IFE BLOC0,<\r
3093 BL0CNT: BLOCK   1               ;COUNT>\r
3094 DTAID:  BLOCK 1 ; STORE DTA SERIAL NUMBER\r
3095 DIRPPN: BLOCK 1         ; STORE OWNERSHIP\r
3096 SVIBF:  BLOCK   1       ;SAVE INIT MODE (INPUT)\r
3097 SVOBF:  BLOCK   1       ;SAVE INIT MODE (OUTPUT)\r
3098 IBF:    BLOCK   3       ;INPUT BUFFER HEADER\r
3099 OBF:    BLOCK   3       ;OUTPUT BUFFER HEADER\r
3100 OBI:    BLOCK   3       ;OUTPUT BUFFER INPUT HEADER FOR DSK /Z\r
3101 TFI:    BLOCK   3       ;CONSOLE INPUT HEADER\r
3102 TFO:    BLOCK   3       ;CONSOLE OUTPUT HEADER\r
3103 SAVAC:  BLOCK   5       ;SAVE SOME ACS\r
3104 NAMTAB: BLOCK   24      ;FOR (XD) ON DSK OR RENAME\r
3105 IFN FTDSK,<\r
3106 LOCNAM: BLOCK   1       ;POINTER FOR NAMTAB>\r
3107 DIRST:  BLOCK   1       ;LOC. OF LAST DIR. FILE NAME REFERENCED\r
3108 DIRST1: BLOCK   1       ;SAVE INITIAL DIRST\r
3109 SQNUM:  BLOCK   1       ;CURRENT SEQUENCE NUMBER\r
3110 DTJBFF: BLOCK   1       ;VALUE OF JOBFF AFTER CONSOLE I/O BUFFERS\r
3111 SVJBFF: BLOCK   1       ;INITIAL VALUE OF JOBFF\r
3112 SVJBF1: BLOCK   1       ;VALUE OF JOBFF AFTER OUTBUF UUO\r
3113 OPTR:   BLOCK   1       ;CURRENT POINTER FOR LINE PRESCAN\r
3114 DTONSV: BLOCK   2       ;OUTPUT DIRECTORY ENTRY COPY\r
3115 SVPTR1: BLOCK   1       ;POINTER TO LAST PRINTING CHARACTER\r
3116 SVPTR2: BLOCK   1       ;POINTER TO LAST GENERATED TAB\r
3117 TLBRKT: BLOCK   1       ;TOTAL PARENS ON THIS LINE\r
3118 TOTBRK: BLOCK   1       ;TOTAL CUMULATIVE PARENS\r
3119 TABCT:  BLOCK   1       ;SPACES TO NEXT TAB STOP\r
3120 SPCT:   BLOCK   1       ;CONSECUTIVE SPACES COUNTER\r
3121 ABOUT:  BLOCK   1       ;AB FOR OUTPUT UNIT\r
3122 AUXOUT: BLOCK   1       ;AUX FOR OUTPUT UNIT\r
3123 PROTS:  BLOCK   1       ;SAVE PROTECTION\r
3124 ZCNT:   BLOCK   1       ;COUNT FOR DSK ZRO REQ.\r
3125 CDRCNT: BLOCK   1       ;COUNT CARD COLS.\r
3126 PTRPT:  BLOCK   1       ;STORE SEQ. NO. POINTER\r
3127 SYSPP:  BLOCK   1       ;PP OF DEVICE SYS\r
3128 \r
3129 \f;THIS IS A BLOCK OF VARIABLE LOCATIONS, ZEROED AT THE START OF EACH\r
3130 ;PIP RUN, I.E EACH TIME PIP TYPES *.\r
3131 \r
3132 ;*****  DO NOT SPLIT THIS BLOCK *****\r
3133 IFN FTDSK,<\r
3134 RIBFIR: BLOCK   1       ;NUMBER OF WORDS IN LOOKUP\r
3135 PPP:    BLOCK   1       ;PROJ-PROG FOR EXTENDED LOOKUP>\r
3136 FILNAM: BLOCK   1       ;FILE NAME FROM COMMAND SCANNER\r
3137 FILEX:  BLOCK   1       ;EXTENSION\r
3138 PR:     BLOCK   1       ;PROTECTION\r
3139 PP:     BLOCK   1       ;P-P NUMBER TYPED BY USER\r
3140 IFN FTDSK,<BLOCK 20+RIBFIR-.>   ;TOTAL LENGTH OF LOOKUP BLOCK\r
3141 ;*****  END OF BLOCK    *****\r
3142 DTON:   BLOCK   4       ;OUTPUT DIR. ENTRY\r
3143 DEVA:   BLOCK   1       ;SAVE INPUT DEV. NAME\r
3144 NO.:    BLOCK   1       ;GENERATE FILE NAMES\r
3145 ZRF:    BLOCK   4       ;LOOKUP FILE NAMES\r
3146 MTAREQ: BLOCK   1       ;STORE MTA REQUESTS\r
3147 \r
3148 COMEOF: BLOCK   1       ;EOF INDICATOR\r
3149 COMBUF: BLOCK   ^D41    ;COMMAND BUFFER. ALLOWS 205 CHARS.\r
3150 COMCNT: BLOCK   1       ;COMBUF CHARS COUNT\r
3151 COMPTS: BLOCK   1       ;POINTER FOR STORING/EXTRACTING CS\r
3152 \r
3153 \r
3154 AUX:    BLOCK   1       ;COPT AUXFLG (MTA)\r
3155 IFN FTDSK,<\r
3156 FNPPN:  BLOCK   1       ;RESERVE #P-P\r
3157 FNPPNS: BLOCK   1       ;COPY FNPPN FOR LATEST NON-SYS #P-P>\r
3158 ESWTCH: BLOCK   1       ;-1 INDICATES END OF LINE\r
3159 XNAME:  BLOCK   1       ;-1 INDICATES SCAN OVERSHOOT WITH A NULL NAME\r
3160                         ;0  INDICATES NO SCAN OVERSHOOT\r
3161                         ;CONTAINS OVERSHOOT NAME IF NOT NULL\r
3162 AB:     BLOCK   1       ;MTA VALUE SWITCHES\r
3163                         ;THIS IS THE END OF THE INIT. ZEROED BLOCK.\r
3164 \fMONTH: ASCII /-Jan-/\r
3165         ASCII /-Feb-/\r
3166         ASCII /-Mar-/\r
3167         ASCII /-Apr-/\r
3168         ASCII /-May-/\r
3169         ASCII /-Jun-/\r
3170         ASCII /-Jul-/\r
3171         ASCII /-Aug-/\r
3172         ASCII /-Sep-/\r
3173         ASCII /-Oct-/\r
3174         ASCII /-Nov-/\r
3175         ASCII /-Dec-/\r
3176 \r
3177 MNPT:   POINT 7,MONTH\r
3178 \r
3179 PDL:   BLOCK 20         ;PUSHDOWN LIST\r
3180 \r
3181 LBUF:  BLOCK 204        ;LINE BUFFER. ALLOW FOR FORTRAN DATA\r
3182 LBUFE==.-1\r
3183 \r
3184 DBUF:  BLOCK 204        ;DIRECTORY BUFFER\r
3185         BLOCK   27      ; ALLOW ENOUGH FOR DTA PROT.\r
3186 \r
3187 OMOD:   BLOCK 1         ;OUTPUT DEVICE MODE, STATUS\r
3188 ODEV:   BLOCK 2         ;OUTPUT DEVICE NAME\r
3189                         ;BUFFER HEADER(S) LOC\r
3190 \r
3191 ININI1: BLOCK 1         ;INPUT DEVICE\r
3192 DEVICE: BLOCK 2\r
3193 \r
3194 \r
3195 DEVERR: BLOCK 1\r
3196 DERR2:  BLOCK 2\r
3197 \r
3198 INMTA1: BLOCK 1\r
3199 MTANAM: BLOCK 2\r
3200 MATCH:  BLOCK   2       ;NAME AND EXT FOR /L OR (RX)\r
3201 RENSN:  BLOCK   1       ;-1 IF RENAME MESSAGE SEEN\r
3202 \r
3203 \fSUBTTL RIM LOADER\r
3204 IFE RIMSW,<\r
3205 RIMTB:  ERRPNT  <Z? /Y switch option not available this assembly!Z>\r
3206 XLIST>\r
3207 IFN RIMSW,<\r
3208 LODAL==16                       ;LENGTH OF RIM LOADER\r
3209 HLTBIT==200                     ;CHANGES JRST TO HALT\r
3210 BLKSZ==17                       ;NORMAL BLOCK LENGTH IN RIM10B\r
3211 JOBDA==140                      ;START OF USER AREA\r
3212 CHKSM:  BLOCK   1               ;CHECKSUM ACCUMULATED (RIM10B)\r
3213 POINTA: BLOCK   1               ;SAVE POINTER FOR RIM10B BLOCK\r
3214 LENGTH: BLOCK   1               ;CALC. LENGTH OF RIM10 FILE\r
3215 ZERO:   BLOCK   1               ;NO OF 0'S NEEDED TO FILL SPACES IN\r
3216 COUNT:  BLOCK   1               ;RIM10B COUNT WORDS OUT\r
3217 XFERWD: BLOCK   1               ;RIM-10-B XFER WD. ;FILE.\r
3218 \r
3219 RIMTB:  TRNN    AUXFLG,DTAIN!DSKIN!MTAIN\r
3220         JRST    ERR5B\r
3221         PUSHJ   P,ININIT\r
3222         OUTPUT  OUT,\r
3223         TRNE    AUXFLG,DTAIN\r
3224         PUSHJ   P,DTADIR\r
3225 IFN FTDSK,<\r
3226         TRNE    AUXFLG,DSKIN\r
3227         PUSHJ   P,DSKDIR>\r
3228         PUSHJ   P,FNSET\r
3229 RIMTB0: MOVEI   0,254000\r
3230         HRLM    0,XFERWD        ;ASSUME JRST\r
3231         PUSHJ   P,LOOK          ;GET FILE TO CONVERT\r
3232         JRST    MAIN1           ;NONE LEFT\r
3233         LOOKUP  IN,ZRF\r
3234         JRST    ERR3\r
3235         HLRZ    0,ZRF+1\r
3236         CAIN    0,(SIXBIT ,RTB,)\r
3237         JRST    RIMTB1\r
3238         CAIE    0,(SIXBIT ,SAV,)\r
3239         CAIN    0,(SIXBIT ,RMT,)\r
3240         JRST    RIMTB2\r
3241         JRST    ERR3B           ;NO LEGAL EXTENSION - SAVE JOBFF TOO\r
3242 \fRIMTB1:        MOVE    T1,OBF+1        ;PUNCH RIM10B LOADER\r
3243         HRLI    T1,RMLODA\r
3244         AOS     T2,T1           ;XFER IT TO OUTPUT BUFFER\r
3245         BLT     T1,LODAL(T2)\r
3246         ADDI    T2,LODAL\r
3247         HRRM    T2,OBF+1        ;FIX BUFFER POINTER\r
3248         MOVNI   T2,LODAL\r
3249         ADDM    T2,OBF+2        ;AND COUNTER\r
3250         CLOSE   OUT,            ;BLANK TAPE\r
3251 RIMTB2: PUSHJ   P,RINP          ;GET FIRST BUFFER\r
3252         JRST    ERR8A           ;FILE OF ZERO LENGTH\r
3253         JUMPGE  CHR,ERR8A       ;FIRST WORD MUST BE POINTER\r
3254         HLRZ    0,ZRF+1\r
3255         CAIN    0,(SIXBIT ,SAV,)\r
3256         JRST    RIMTB4          ;"SAV" FILE\r
3257         MOVEI   T2,^D126(CHR)   ;FIND VALUE OF JOBSA\r
3258         MOVEI   T3,JOBDA-1\r
3259         CAMGE   T2,T3           ;(JOBDA) IS FIRST LOC. OF USER PROF,\r
3260         JRST    ERR8A           ;NO, ERROR\r
3261         MOVE    T1,IBF+1\r
3262         MOVEI   T3,JOBSA\r
3263         PUSHJ   P,RMS1\r
3264         HRRM    CHR,XFERWD      ;SAVE TRANSFER WORD\r
3265         MOVEI   T3,JOBFF\r
3266         MOVE    T1,IBF+1\r
3267         PUSHJ   P,RMS1\r
3268         HRRZM   CHR,LENGTH      ;SAVE (JOBFF)\r
3269         HLRZ    0,ZRF+1\r
3270         CAIN    0,(SIXBIT .RTB.);RIM 10B CONVERSION\r
3271         JRST    RIMTB4\r
3272 \f;RIM10 1ST WD IS -N,X X IS 1ST WORD IN DATA BLOCK\r
3273 ;CONTAINING FIRST NON-ZERO WORD AFTER END\r
3274 ;OF JOBDATA AREA, FROM THERE TO JOBFF GIVES\r
3275 ;VALUE OF N. XFER ADD. COMES FROM JOBSA.\r
3276 \r
3277 RMT1:   MOVEI   T1,JOBDA        ;FIRST LOC. AVAILABLE TO USER\r
3278         LDB     CHR,IBF+1\r
3279         SUBI    T1,1(CHR)\r
3280         JUMPLE  T1,RMT2 ;CURRENT "X" GT OR EQ JOBDA\r
3281         HLRO    T2,CHR\r
3282         MOVNS   T2              ;GET "N"\r
3283         AOJ     T1,             ;GET REL. LOC. OF JOBDA IN BLOCK\r
3284         CAMG    T1,T2\r
3285         JRST    RMT2\r
3286         AOJ     T2,             ;NOT IN BLOCK, TRY NEXT\r
3287         ADDM    T2,IBF+1\r
3288         MOVNS   T2\r
3289         ADDM    T2,IBF+2        ;READY TO GET NEXT POINTER\r
3290         JRST    RMT1\r
3291 RMT2:   LDB     CHR,IBF+1       ;POINTS TO FIRST USEFUL I/O WORD\r
3292         MOVNI   T1,(CHR)\r
3293         ADDB    T1,LENGTH\r
3294         MOVNS   T1              ; -N\r
3295         HRLM    T1,POINTA\r
3296         HRRM    CHR,POINTA      ;(-N,X) IN POINTA\r
3297         SETZM   ZERO\r\r
3298 \f;NOW OUTPUT RIM10 FILE.  IBF+1 POINTS TO FIRST I/O WORD.  POINTA HAS I/O\r
3299 ;WORD FOR FILE.  LENGTH = NO. WDS TO GO OUT INCLUDING XFER WD.\r
3300 ;COUNT COUNTS NO. WDS IN CURRENT LOGICAL BLOCK\r
3301 ;ZERO COUNTS ZERO FILL\r
3302 \r
3303         MOVE    CHR,POINTA\r
3304         PUSHJ   P,PUT           ;PUNCH I/O WORD\r
3305 RMT8:   LDB     CHR,IBF+1       ;-N,X\r
3306         MOVEM   CHR,POINTA\r
3307         HLRO    T1,CHR\r
3308         MOVNM   T1,COUNT\r
3309 RMT6:   SETZ    CHR,            ;PUNCH ZERO IF NECESSARY\r
3310         SOSL    ZERO\r
3311         JRST    RMT4            ;DEPOSIT ZERO\r
3312         SOSGE   COUNT\r
3313         JRST    RMT5            ;GET NEW LOGICAL BLOCK\r
3314         PUSHJ   P,RINP1\r
3315         JRST    ERR8A\r
3316 RMT4:   SOSG    LENGTH\r
3317         JRST    RIMTB8\r
3318         PUSHJ   P,PUT\r
3319         JRST    RMT6\r
3320 RMT5:   HRRZ    T1,POINTA\r
3321         HLRO    T2,POINTA\r
3322         SUBM    T1,T2\r
3323         PUSHJ   P,RINP1\r
3324         JRST    RMT9\r
3325         JUMPGE  CHR,ERR8A\r
3326         HRRZ    CHR,CHR\r
3327         SUB     CHR,T2\r
3328         JUMPL   CHR,ERR8A\r
3329         MOVEM   CHR,ZERO\r
3330         JRST    RMT8\r
3331 RMT9:   MOVE    CHR,LENGTH\r
3332         SOJ     CHR,\r
3333         MOVEM   CHR,ZERO\r
3334         SETZ    CHR,\r
3335 RMT10:  SOSGE   ZERO\r
3336         JRST    RIMTB8\r
3337         PUSHJ   P,PUT\r
3338         JRST    RMT10\r
3339 \f;RIM10B: COMES FROM RTB AND SAV FILES. SAV=RTB EXCEPT IT HAS NO\r
3340 ;RIM LOADER AND NO TRANSFER WORD\r
3341 \r
3342 RIMTB3: PUSHJ   P,RINP1         ;NONE, GET NEW POINTER\r
3343         JRST    RIMTB8          ;EOF\r
3344         JUMPL   CHR,RIMTB4      ;POINTER WORD\r
3345         CAME    CHR,XFERWD      ;IS IT FINAL JRST XXX\r
3346         JRST    ERR8A           ;NO,ERROR\r
3347         JRST    RIMTB8          ;YES,OUTPUT IT\r
3348 \r
3349 RIMTB4: LDB     CHR,IBF+1\r
3350         HRRZM   CHR,POINTA      ;LOAD WORDS HERE\r
3351         HLROM   CHR,COUNT\r
3352         MOVNS   COUNT           ;NO. WDS IN THIS BLOCK\r
3353 RIMTB7: SKIPN   T1,COUNT        ;ANY WORDS LEFT IN BLOCK?\r
3354         JRST    RIMTB3          ;NONE\r
3355         SETZM   CHKSM           ;INITIALIZE CHECKSUM\r
3356         CAIL    T1,BLKSZ\r
3357         MOVEI   T1,17\r
3358         MOVN    T2,T1           ;T1 HAS NO. OF WDS TO GO OUT\r
3359         ADDM    T2,COUNT        ;ADJUST COUNT\r
3360         HRL     CHR,T2\r
3361         HRR     CHR,POINTA      ;I/O WD IN CHR\r
3362         ADDM    T1,POINTA       ;SET POINTA FOR NEXT TIME\r
3363         ADDM    CHR,CHKSM       ;ADD I/O WD TO CHECKSUM\r
3364 RIMTB5: PUSHJ   P,PUT           ;PUTPUT I/O WORD\r
3365         SOJL    T1,RIMTB6               ;FINISHED THIS BLOCK\r
3366         PUSHJ   P,RINP1         ;GET DATA\r
3367         JRST    ERR8A           ;EOF (ILLEGAL)\r
3368         ADDM    CHR,CHKSM       ;CHECKSUM\r
3369         JRST    RIMTB5\r
3370 RIMTB6: MOVE    CHR,CHKSM\r
3371         PUSHJ   P,PUT\r
3372         OUTPUT  OUT,\r
3373         JRST    RIMTB7\r
3374 RIMTB8: MOVE    CHR,XFERWD      ;EOF HERE, XFERWD=JOBSA\r
3375         TRNN    CHR,-1\r
3376         TLO     CHR,HLTBIT\r
3377         HLRZ    0,ZRF+1\r
3378         CAIN    0,(SIXBIT .SAV.);NO XFER WD FOR "SAV" FILES\r
3379         JRST    RIMA\r
3380         PUSHJ   P,PUT\r
3381         SETZ    CHR,\r
3382         PUSHJ   P,PUT           ;TRAILING ZERO\r
3383         OUTPUT  OUT,\r
3384 RIMA:   CLOSE   IN,\r
3385         TRNE    FLAG,XFLG\r
3386         CLOSE   OUT,\r
3387         JRST    RIMTB0\r
3388 \r
3389 \f;THIS IS THE I/O SECTION\r
3390 \r
3391 RINP:   PUSHJ   P,INP\r
3392         TRNE    IOS,EOFBIT      ;EOF?\r
3393         POPJ    P,              ;EOF EXIT\r
3394 RINP1:  SOSGE   IBF+2\r
3395         JRST    RINP\r
3396         ILDB    CHR,IBF+1\r
3397         JRST    CPOPJ1\r
3398 \r
3399 RMS2:   SUB     T1,T4           ;(IBF+1)+N\r
3400         AOJ     T1,\r
3401 RMS1:   LDB     CHR,T1          ;GET POINTER\r
3402         HRRZ    T2,CHR          ;X\r
3403         HLRO    T4,CHR          ;-N\r
3404         SUB     T2,T4           ;X+N IN T2\r
3405         CAMGE   T2,T3\r
3406         JRST    RMS2\r
3407         SUBI    T3,(CHR)        ;HOW FAR FROM POINTER?\r
3408         ADD     T1,T3           ;INCREMENT POINTER\r
3409         LDB     CHR,T1          ;(JOBSA/FF)\r
3410         POPJ    P,\r
3411 \r
3412 ;THIS IS THE RIM LOADER FOR THE PDP-10\r
3413 \r
3414 RMLODA: PHASE   0\r
3415 \r
3416         XWD     -16,0\r
3417 ST:     CONO    PTR,60\r
3418 ST1:    HRRI    A,RD+1\r
3419 RD:     CONSO   PTR,10\r
3420         JRST    .-1\r
3421         DATAI   PTR,@TBL1-RD+1(A)\r
3422         XCT     TBL1-RD+1(A)\r
3423         XCT     TBL2-RD+1(A)\r
3424 A:      SOJA    A,\r
3425 TBL1:   CAME    CKSM,ADR\r
3426         ADD     CKSM,1(ADR)\r
3427         SKIPL   CKSM,ADR\r
3428 TBL2:   JRST    4,ST\r
3429         AOBJN   ADR,RD\r
3430 ADR:    JRST    ST1\r
3431 CKSM:   BLOCK   0\r
3432 \r
3433 IF2,<   PURGE ST,ST1,RD,A,TBL1,TBL2,ADR,CKSM>\r
3434 DEPHASE>\r
3435 LIST\r
3436 \r
3437 IFE FTDSK,<     \r
3438         VAR\r
3439 LOWTOP:\r
3440         END     PIP1>\r
3441 \fSUBTTL DISK ROUTINES\r
3442 ;* * * ALL THE FOLLOWING ARE DISK ROUTINES * * *\r
3443 \r
3444 ;DISK DELETE AND RENAME ROUTINES\r
3445 \r
3446 DSKDR0: MOVE    T1,DTON+3       ;GET OUTPUT PPN\r
3447         SKIPN   PP              ;ALREADY SET?\r
3448         MOVEM   T1,PP           ;OUTPUT=INPUT FOR /D,/R\r
3449 DSKDR:  PUSHJ   P,ININIT        ;GET DSK AS INPUT DEVICE\r
3450         PUSHJ   P,DSKDIR        ;GET USER'S FILE DIRECTORY\r
3451         PUSHJ   P,INFO          ;PRINT FILES DELETED:/RENAMED:\r
3452         SETZM   ZCNT            ;COUNT OF FAILURES\r
3453 DSKDR5: PUSHJ   P,LOOK          ;PREPARE FOR LOOKUP/ENTER\r
3454                                 ;OF FILE TO /D OR /R\r
3455         JRST    DSKDR1          ;ALL THROUGH WITH UFD\r
3456         LOOKUP  IN,ZRF          ;IS SOURCE FILE THERE?\r
3457         JRST    DERR5           ;ERROR\r
3458         CLOSE   IN,             ;YES\r
3459         TRNN    FLAG,DFLG       ;DELETE?\r
3460         JRST    DSKDR4          ;NO, RENAME\r
3461         SETZM   DTON            ;YES\r
3462         MOVE    0,FNPPN         ;SET DEST. DEVICE SAME AS SOURCE FOR DELETE,\r
3463         MOVEM   0,DTON+3        ;I.E. PROJ-PROG NUMBER\r
3464         JRST    DSKDR7\r
3465 \r
3466 DSKDR4: PUSHJ   P,RENAME\r
3467         JUMPN   T2,.+3          ;JUMP IF FILE NAME SEEN\r
3468         MOVE    0,[XWD ZRF,DTON];NO NAME SET SO USE LOOKUP NAME\r
3469         BLT     0,DTON+1        ;AND EXT SO FILE NOT DELETED\r
3470         MOVE    0,ZRF+2         ;GET DATE,MODE,PROT ETC.\r
3471         MOVEM   0,DTON+2        ;SAVE AS BEFORE\r
3472         MOVE    0,NAMTAB+3      ;GET PROJ-PROG\r
3473         MOVEM   0,DTON+3\r
3474         LDB     0,[POINT 9,NAMTAB+2,8]\r
3475         TLNE    AUXFLG,NSPROT   ;USE THE CURRENT PROTECTION\r
3476         DPB     0,PRPTD         ;UNLESS NEW PROT. SPECIFIED\r
3477 DSKDR7: RENAME  IN,DTON\r
3478         AOSA     ZCNT           ;RENAME (OR DELETE) FAILS\r
3479         PUSHJ   P,INFO3         ;PRINT FILENAME DELETED/RENAMED\r
3480         JRST    DSKDR5\r
3481 \r
3482 DSKDR1: TLZ     AUXFLG,NSPROT   ;NON-ST. PROT FIXED\r
3483         SKIPE   ZCNT            ;SKIP IF NO FAILURES\r
3484         JRST    DSKDR6          ;ERROR\r
3485         SOS     ESWTCH          ;ENSURE ESWTCH NEGATIVE\r
3486         RELEAS  CON,\r
3487         JRST    MAIN1\r
3488 \f;ZERO DSK DIRECTORY OF ALL POSSIBLE FILES.  IF ANY ARE PROTECTED, GIVE\r
3489 ;A MESSAGE AND DO NOT PROCESS ANY OTHER SWITCHES.\r
3490 \r
3491 DSKZRO: SKIPE   T1,ODEV         ; STR# 10-2892\r
3492         MOVEM   T1,ADSK\r
3493         PUSHJ   P,DIRSK1\r
3494         SETZM   ZCNT\r
3495         INBUF   OUT,1           ;FOR LOOKUPS ON OUT\r
3496 DSKZ1:  SOSLE   UFDIN+2\r
3497         SKIP    2\r
3498 DSKZ3:  PUSHJ   P,UIN\r
3499         JRST    DSKZ2\r
3500         ILDB    0,UFDIN+1\r
3501         JUMPE   0,DSKZ3\r
3502         MOVEM   0,ZRF\r
3503         SOS     UFDIN+2\r
3504         ILDB    0,UFDIN+1\r
3505         HLLZM   0,ZRF+1         ;EXTENSION\r
3506         MOVE    0,FNPPN\r
3507         MOVEM   0,ZRF+3\r
3508         LOOKUP  OUT,ZRF\r
3509         AOS     ZCNT            ;COUTN REJECTS,TRY MORE FILES\r
3510         CLOSE   OUT,\r
3511         SETZM   ZRF\r
3512         MOVE    0,FNPPN\r
3513         MOVEM   0,ZRF+3\r
3514         RENAME  OUT,ZRF\r
3515         AOS     ZCNT\r
3516         JRST    DSKZ1           ;REPEAT\r
3517 DSKZ2:  SKIPN   ZCNT            ;ANY FAILURES?\r
3518         POPJ    P,              ;NO\r
3519                                 ;PRINT ERROR MESSAGE\r
3520         MOVSI   T4,(SIXBIT /Z/)\r
3521         JRST    DSKZ5\r
3522 DSKDR6: MOVSI   T4,(SIXBIT /D/)\r
3523         TRNN    FLAG,DFLG\r
3524         MOVSI   T4,(SIXBIT /R/)\r
3525 DSKZ5:  ERRPNT  <X?Failure(s) during /X>\r
3526         PUSHJ   P,P6BIT\r
3527                 T4\r
3528         ERRPN2  </ request!/>\r
3529 \f;PREPARE TO LOOKUP FILES IN PARTICULAR DISK DIRECTORY\r
3530 \r
3531 DIRSK1: SKIPA   T1,DTON+3\r
3532 DSKDIR: MOVE    T1,PP           ;GET [P,P] INTO T1\r
3533         JUMPN   T1,.+2          ;IS IT ZERO?\r
3534         GETPPN   T1,            ;YES, GET USER'S [P,P]\r
3535         TRNE    AUXFLG,SYSFLG   ;DEVICE SYS\r
3536         MOVE    T1,SYSPP        ;GET SYS  [PP]\r
3537         MOVEM   T1,FNPPN\r
3538         MOVE    0,[XWD FILNAM,UFD]\r
3539         BLT     0,UFD+3         ;SAVE LOOKUP BLOCK\r
3540 IFE DISK30,<\r
3541         MOVEM   T1,FILNAM       ;[P,P] TO UFD\r
3542         MOVSI   0,(SIXBIT /UFD/)\r
3543         MOVEM   0,FILEX         ;USER HAS SPECIFIED [P,P]>\r
3544 IFN DISK30,<\r
3545         HRRZM   T1,T2           ;SAVE PROGRAMMER NBR.\r
3546         LSH     T1,-14          ;SHIFT PROJECT NBR.\r
3547         IOR     T1,T2           ;REPLACE PROGRAMMER NBR\r
3548         MOVEM   T1,MASK\r
3549         MOVE    0,[SIXBIT /*FD*/]\r
3550         MOVEM   0,FILNAM\r
3551         MOVSI   0,(SIXBIT /SYS/)\r
3552         MOVEM   0,FILEX>\r
3553         TRNN    CALFLG,SYSFLG   ;CURRENT DEVICE SYS?\r
3554         MOVEM   T1,FNPPNS       ;SAVE LATEST NON-SYS #P-P\r
3555         MOVE    0,PP11          ;MAKE [P,P]=[1,1]\r
3556         MOVEM   0,PP\r
3557         MOVEM   0,PPP           ;SAVE FOR EXTENDED LOOKUP\r
3558         PUSHJ   P,DSKDST        ;INIT TO READ DIRECTORY\r
3559         MOVEI   T1,RIBSTS       ;NO. OF WORDS FOR EXTENDED LOOKUP\r
3560         MOVEM   T1,RIBFIR\r
3561         MOVE    T1,LEVEL        ;LEVEL D = -2\r
3562         LOOKUP  DIR,FILNAM(T1)  ;GET USERS FILE DIRECTORY\r
3563         JRST    DERR5A          ;ONE OF 8 LOOKUP ERRORS\r
3564         JUMPE   T1,DIRSK2       ;IF LEVEL C\r
3565         HRRZ    T1,RIBFIR+RIBSTS\r
3566         ANDI    T1,777          ;GET ERROR BITS\r
3567         JUMPN   T1,DIRSK2       ;JUMP IF ERRORS IN UFD\r
3568         MOVEI   T1,RBSIZ        ;SET LOOKUP\r
3569         MOVEM   T1,RIBFIR       ;FOR SHORT EXTENDED\r
3570 DIRSK2: MOVS    T1,[XWD FILNAM,UFD]\r
3571         BLT     T1,PP           ;RESTORE LOOKUP BLOCK\r
3572         POPJ    P,              ;LOOKUP OK\r
3573 \f;SETUP BUFFER TO READ 10/30 DISK BLOCKS\r
3574 \r
3575 IFN DISK30,<\r
3576 BLKSET:                         ;MAKE MONITOR USE BLKBUF\r
3577         MOVEI   T1,BLKBUF       ;FOR 10/30 DISK BLOCKS\r
3578         EXCH    T1,JOBFF\r
3579         INIT    BLKIN,14\r
3580         SIXBIT  /SYS/\r
3581         XWD     0,BLKHD\r
3582         JRST    ERR1A\r
3583         INBUF   BLKIN,1\r
3584         MOVEM   T1,JOBFF\r
3585         POPJ    P,\r
3586 \r
3587 BLKBUF: BLOCK 204               ;10/30 DISK BLOCK BUFFER\r
3588 \r
3589 ;ROUTINE TO READ 10/30 DISK\r
3590 \r
3591 BLKRD:  SETZM   FILNAM+2\r
3592         SETZB   BLKTMP\r
3593         INPUT   BLKIN,          ;INPUT 10/30 DISK BLOCKS\r
3594         STATUS  BLKIN,IOS\r
3595         TRNN    IOS,760000\r
3596         JRST    BLKRD1\r
3597         TRZN    IOS,20000       ;EOF\r
3598         JRST    BLKERR          ;ERROR\r
3599         SETSTS  BLKIN,(IOS)\r
3600         MOVEM   0,BLKTMP\r
3601         ADDM    0,BLKSUM\r
3602         POPJ    P,\r
3603 BLKRD1: AOJA    0,BLKRD+2       ;COUNT BLOCKS PER FILE\r
3604 BLKERR: PUSHJ   P,COMERR\r
3605         JSP     T5,INICN2\r
3606         TRNN    IOS,400000      ;CHECK FOR WRITE LOCK\r
3607         JRST    BLKER2          ;NO\r
3608         ERRPN2  </?/>\r
3609 BLKER2: ERRPN2  </Input device DSK file />\r
3610         MOVEI   T6,FILNAM\r
3611         PUSHJ   P,FN.EX\r
3612         MOVE    T2,AUXFLG\r
3613         ANDI    T2,DSKIN\r
3614         PUSHJ   P,IOERR\r
3615         SETSTS  BLKIN,(IOS)\r
3616         POPJ    P,>\r
3617 \f;ROUTINE TO LIST DISK DIRECTORY. /L OR /F SWITCH\r
3618 \r
3619 DSKLST: PUSH    P,DEVICE\r
3620         PUSHJ   P,ININIT        ;ASSIGN "IN" FOR RETRIEVAL INFO\r
3621         SETZM   BLKSUM          ;CLEAR TOTAL BLOCKS FOR ALL FILES\r
3622 IFN DISK30,<TRNN AUXFLG,FFLG    ;SHORT LISTING\r
3623         PUSHJ   P,BLKSET        ;NO>\r
3624         SETZM   LIN             ;SET UP APPROPRIATE CONTROLS\r
3625         MOVS    T1,ODEV         ;FOR THIS LISTING DEVICE\r
3626         CAIN    T1,(SIXBIT/TTY/);IF ODEV IS TTY\r
3627         TRO     CALFLG,LISTTY   ;SET LISTTY=1 (TTY)\r
3628         SKIPN   FILNAM          ;IF NO FILNAM GIVEN\r
3629         TRZ     CALFLG,MATFN!MATEX      ;LIST ALL OF DIRECTORY\r
3630         MOVE    T1,FILNAM\r
3631         MOVEM   T1,MATCH\r
3632         HLRZ    T1,FILEX\r
3633         MOVEM   T1,MATCH+1\r
3634         PUSHJ   P,DSKDIR\r
3635         PUSHJ   P,CRLF          ;GIVE A BLANK LINE\r
3636         TRNN    AUXFLG,FFLG     ;SHORT LISTING\r
3637         PUSHJ   P,HEADER        ;PUT OUT HEADER LINES\r
3638         SKIPN   LEVEL           ;ONLY IF LEVEL D\r
3639         JRST    LSTU0A          ;LEVEL C\r
3640         MOVEI   T1,ADSK         ;ADDRESS OF DEVICE\r
3641         DSKCHR  T1,             ;SEE IF DSK\r
3642         TDZA    T1,T1           ;NOT LEVEL D DSK\r
3643         TLNE    T1,(7B17)       ;GENERIC DEVICE DSK\r
3644         TDZA    T1,T1           ;NO\r
3645         SETO    T1,             ;YES\r
3646         MOVEM   T1,GENERI       ;SAVE IT\r
3647         JUMPE   T1,LSTU0A       ;LEVEL C\r
3648 LSTU0:  MOVEI   T1,GENERI       ;GET ADDRESS\r
3649         JOBSTR  T1,             ;GET FILE STRUCTURE\r
3650         TDZA    T1,T1           ;ERROR\r
3651         SKIPN   T1,GENERI       ;GET DEVICE\r
3652         JRST    DIRFIN          ;FINISHED\r
3653         MOVEM   T1,ADSK         ;FOR DIR INIT\r
3654         MOVEM   T1,DEVICE       ;FOR RETRIEVAL INFO\r
3655         PUSHJ   P,ININIT        ;INIT\r
3656         MOVE    0,GENERI        ;YES, GET IT\r
3657         PUSHJ   P,SIXOUT        ;PRINT IT\r
3658         MOVEI   CHR,":"         ;FOLLOW WITH COLON\r
3659         PUSHJ   P,PUT\r
3660         PUSHJ   P,DSKDIR        ;LOOKUP UFD\r
3661         PUSHJ   P,CRLF          ;AND A CR-LF\r
3662 LSTU0A: MOVE    T1,PP           ;GET PROJ-PROG\r
3663         MOVEM   T1,PPP          ;SAVE FOR EXTENDED LOOKUP\r
3664 LSTU1:  SOSLE   UFDIN+2\r
3665         SKIP    2\r
3666 LSTU2:  PUSHJ   P,UIN           ;GO READ DIRECTORY\r
3667         JRST    BLKLST          ;(EOF) - OUTPUT BLOCKS USED\r
3668         ILDB    0,UFDIN+1\r
3669         JUMPE   0,LSTU2\r
3670         MOVEM   0,FILNAM        ;PREPARE TO GET RETRIEVAL INFO\r
3671         MOVE    T1,FNPPN        ;EACH LOOKUP DESTROYS P-P NO.\r
3672         MOVEM   T1,FILNAM+3     ;RESTORE P-P NO.\r
3673         SKIPG   LIN\r
3674         PUSHJ   P,HEDR3         ;YES, PUT OUT HEADER LINES\r
3675         SOS     UFDIN+2\r
3676         ILDB    DOUT,UFDIN+1    ;PICK UP EXTENSION\r
3677         HLRZS   DOUT            ;CLEAR RIGHT HALF\r
3678         HRLZM   DOUT,FILNAM+1   ;KEEP FOR LOOKUP\r
3679         TRNN    CALFLG,MATEX    ;MATCH EXTENSIONS?\r
3680         SKIP    2               ;NO,TRY MATFN\r
3681         CAME    DOUT,MATCH+1    ;MATCH?\r
3682         JRST    LSTU1           ;NO,GET NEXT FILE\r
3683         TRNN    CALFLG,MATFN    ;MATCH FILENAME?\r
3684         JRST    LSTU2A          ;NO\r
3685         CAME    0,MATCH         ;FILNAM MATCH?\r
3686         JRST    LSTU1           ;NO\r
3687 LSTU2A: IFE DISK30,<\r
3688         CAIE    DOUT,(SIXBIT ?UFD?)     ;IS FILE MFD\r
3689         JRST    LSTU3           ;GO PRINT NAME HELD IN 0.\r
3690         HLRZ    DOUT,FILNAM     ;HERE FOR MFD ONLY\r
3691         MOVEI   T2,PUT\r
3692         PUSHJ   P,OUTDC1        ;PRINT #,#. PROJ. NO.\r
3693         MOVEI   CHR,COMMA       ;","\r
3694         PUSHJ   P,PUT           ;...\r
3695         HRRZ    DOUT,FILNAM     ;PROG. NO.\r
3696         PUSHJ   P,OUTDC1\r
3697         JRST    LSTU3A  ;...>\r
3698 \fIFN DISK30,<\r
3699         ILDB    0,UFDIN+1       ;PICKUP THIRD AND FOURTH WORD\r
3700         MOVEM   0,FILNAM+2      ;IN 10/30 DISK FILE DIRECTORY\r
3701         ILDB    0,UFDIN+1\r
3702         TDC     0,MASK\r
3703         TRNE    0,3777\r
3704         JRST    LSTU1>\r
3705 LSTU3:  MOVE    0,FILNAM\r
3706         PUSHJ   P,SIXOUT        ;OUPUT FILENAME\r
3707 LSTU3A: MOVEI   T4,4            ;SET LOOP FOR OUTPT EXT\r
3708         MOVE    0,FILEX\r
3709         JUMPE   0,LSTU4\r
3710         PUSHJ   P,TABOUT\r
3711         PUSHJ   P,SIXOUT        ;OUTPUT EXTENSION\r
3712 LSTU4:  TRNN    AUXFLG,FFLG     ;SHORTEST LISTING?\r
3713         SKIP    2\r
3714         PUSHJ   P,CLRF          ;YES\r
3715         JRST    LSTU1\r
3716         SKIPN   FILEX\r
3717         PUSHJ   P,TABOUT\r
3718         PUSHJ   P,SPACES\r
3719 IFE DISK30,<\r
3720         MOVE    T4,LEVEL        ;-2 IF LEVEL D,0 IF LEVEL C\r
3721         LOOKUP  IN,FILNAM(T4)   ;GET RETRIEVAL INFO.\r
3722         JRST    LSTU5           ;NOT AVAILABLE\r
3723         JUMPE   T4,LSTU4A       ;LEVEL C OR NO UFD ERRORS\r
3724         HRRZ    DOUT,RIBFIR+RIBSTS      ;FILE ERROR STATUS\r
3725         ANDI    DOUT,777                ;ONLY ERROR BITS\r
3726         JUMPE   DOUT,LSTU4A     ;NO ERRORS\r
3727         MOVEI   CHR,"("         ;PUT ERROR CODE IN PARENS\r
3728         PUSHJ   P,PUT\r
3729         SKIPA   T4,[POINT 7,[ASCII /a*cm**rwf*/]]\r
3730         LSH     DOUT,-1         ;SHIFT ERROR BIT TOWARDS BIT 35\r
3731         ILDB    CHR,T4          ;GET AN ERROR CHARACTER\r
3732         TRNN    DOUT,1          ;IS IT THIS ERROR?\r
3733         JRST    .-3             ;NO\r
3734         PUSHJ   P,PUT           ;YES,OUT IT GOES\r
3735         MOVEI   CHR,")"\r
3736         PUSHJ   P,PUT\r
3737 LSTU4A: >\r
3738 IFN DISK30,<\r
3739         MOVE    DOUT,FILNAM+2   ;SAVE\r
3740         LOOKUP  BLKIN,FILNAM\r
3741         JRST    LSTU5\r
3742         PUSHJ   P,BLKRD\r
3743         MOVEM   DOUT,FILNAM+2>\r
3744         PUSHJ   P,TABOUT\r
3745 IFE DISK30,<\r
3746         PUSHJ   P,BLKS>         ;DETERMINE NO. BLK IN FILE\r
3747                                 ;AND TOTAL FOR UFD\r
3748 IFN DISK30,<\r
3749         PUSHJ   P,BLKOUT>\r
3750 \f       LDB     0,PROT          ;GET PROTECTION BITS\r
3751         PUSHJ   P,PROTO         ;PRINT OCTAL NUMBERS\r
3752         TRNE    CALFLG,LISTTY   ;OUTPUT DEVICE A TTY?\r
3753         JRST    LSTU7           ;YES, SKIP LONG DIRECTORY\r
3754         LDB     0,ADATE         ;PRINT ACCESS DATE\r
3755         PUSHJ   P,DATOUT\r
3756         PUSHJ   P,TABOUT\r
3757         LDB     0,CTIME         ;PRINT CREATION TIME\r
3758         PUSHJ   P,TIMOUT\r
3759         LDB     0,CDATE\r
3760         PUSHJ   P,DATOUT        ;PRINT CREATION DATE\r
3761         PUSHJ   P,TABOUT\r
3762         LDB     0,MODE          ;PRINT MODE\r
3763         PUSHJ   P,OCTLS2\r
3764         JRST    LSTU8\r
3765 \r
3766 LSTU5:  PUSHJ   P,TABOUT        ;THE FILE WAS PROTECTED\r
3767         HRRZ    T7,FILEX        ;GET PARTICULAR ERROR TYPE\r
3768         CAIL    T7,TABLND-TABLE ;IS IT LEGAL ERROR\r
3769         SKIPA   T1,TABLND       ;NO,PICK UP CATCH ALL MESSAGE\r
3770         MOVE    T1,TABLE(T7)    ;PICK UP POINTER FOR ERROR MSG\r
3771 LSTU6:  ILDB    CHR,T1          ;PICK UP CHAR FROM ERROR MSG\r
3772         JUMPE   CHR,LSTU8       ;PRINT ERROR MESSAGE, END SEEN\r
3773         CAIN    CHR,"!"\r
3774         JRST    LSTU8           ;ALTERNATE END SEEN (!)\r
3775         PUSHJ   P,CCASE         ;DEPOSIT CHARACTER\r
3776         PUSHJ   P,PUT\r
3777         JRST    LSTU6\r
3778 \r
3779 \r
3780 LSTU7:  LDB     0,CDATE\r
3781         PUSHJ   P,DATOUT        ;PRINT CREATION DATE ONLY FOR TTY\r
3782 LSTU8:  IFE DISK30,<\r
3783         CLOSE   IN,>\r
3784         PUSHJ   P,CLRF\r
3785         JRST    LSTU1\r
3786 \r\f\r
3787 \r
3788 ;ROUTINE TO OUTPUT SPACES, T4=NO. TO OUTPUT\r
3789 \r
3790 SPACES: MOVEI   CHR,SPACE\r
3791         PUSHJ   P,PUT\r
3792         SOJG    T4,.-1\r
3793         POPJ    P,\r
3794 \r
3795 ;ROUTINE TO DEPOSIT T4.SIXBIT CHARACTERS\r
3796 ;FROM AC0 INTO OUTPUT BUFFER\r
3797 SIXOUT: MOVSI   T2,(POINT 6,0)\r
3798         JUMPE   0,SIXO1         ;ZERO WORD\r
3799         TLNE    0,770000        ;LEADING SPACE\r
3800         JRST    LSTO0           ;NO\r
3801         LSH     0,6             ;GET NEXT CHAR.\r
3802         MOVEI   CHR," "         ;BUT OUTPUT SPACE\r
3803         SKIP    3\r
3804 LSTO0:  ILDB    CHR,T2\r
3805         JUMPE   CHR,SIXO1\r
3806         ADDI    CHR,40          ;MAKE ASCII\r
3807         PUSHJ   P,PUT\r
3808         SOJ     T4,\r
3809         TLNN    T2,770000\r
3810 SIXO1:  POPJ    P,\r
3811         JRST    SIXOUT+2\r
3812 \f;DETERMINE NUMBER OF BLOCKS PER FILE AND TOTAL NUMBER OF\r
3813 ;BLOCKS USED BY USERS PROJECT,PROGRAMMER NUMBER\r
3814 \r
3815 BLKS:   MOVE    DOUT,RIBFIR+RBSIZ\r
3816         SKIPE   LEVEL           ;SKIP IF LEVEL C\r
3817         SKIP    3               ;LEVEL D WORD COUNT\r
3818         HLRE    DOUT,PP         ;GET WORD COUNT OF FILE\r
3819         JUMPGE  DOUT,BLKADD     ;IF POS = NO. OF BLOCKS\r
3820         MOVNS   DOUT            ;MAKE POSITIVE\r
3821         TRZE    DOUT,177        ;TAKE CARE OF PARTIAL BLOCKS\r
3822         ADDI    DOUT,200\r
3823         IDIVI   DOUT,200        ;CALCULATE BLOCK COUNT\r
3824 BLKADD: ADDM    DOUT,BLKSUM     ;CALCULATE TOTAL FOR ALL FILES\r
3825         PUSHJ   P,OUTDE4        ;OUTPUT NUMBER OF BLOCKS IN DECIMAL\r
3826         JRST    TABOUT          ;OUTPUT TAB\r
3827 \r
3828 ;END OF FILE ON UFD OUTPUT TOTAL BLOCKS XXX\r
3829 \r
3830 BLKLST: SKIPN   BLKSUM          ;ANY INFORMATION TO OUTPUT\r
3831         JRST    BLKLS1          ;NO - FINISHED\r
3832         LSTLIN  TOTAL           ;OUTPUT CR,LF "TOTAL BLOCKS"\r
3833         MOVE    DOUT,BLKSUM\r
3834         PUSHJ   P,OUTDE4        ;PRINT TOTALS\r
3835         PUSHJ   P,CRLF          ;BONUS CR-LF\r
3836 BLKLS1: SKIPN   GENERI          ;MORE FILE STRUCTURES?\r
3837 DIRFIN: JRST    [POP    P,DEVICE\r
3838                 JRST    MAIN1]\r
3839         SETZM   BLKSUM          ;START AFFRESH\r
3840         MOVE    T1,PPP          ;RESTORE PP\r
3841         MOVEM   T1,PP\r
3842         JRST    LSTU0           ;YES\r
3843 \r
3844 TOTAL:  ASCIZ   /\r
3845 Total Blocks    /\r
3846 \r
3847 CCASE:  CAIL    CHR,"a" ;FLUSH LOWER CASE LETTERS\r
3848         CAILE   CHR,"z" ;FROM OUTPUT IN CASE PDP-6 LPT\r
3849         POPJ    P,\r
3850         SUBI    CHR,40\r
3851         POPJ    P,\r
3852 \f;INPUT USERS FILE DIRECTORY\r
3853 \r
3854 UIN:    SETZ    IOS,            ;JUST IN CASE\r
3855         IN      DIR,\r
3856         JRST    CPOPJ1          ;NO ERRORS\r
3857         STATUS  DIR,IOS\r
3858         TRZN    IOS,EOFBIT\r
3859         JRST    UIN2            ;ERROR PRINT\r
3860         POPJ    P,\r
3861 \r
3862 ;INIT DIRECTORY DEVICE\r
3863 \r
3864 DSKDST: MOVE    T2,JOBFF        ;SAVE JOBFF IN T2\r
3865 \r
3866         MOVEI   T1,DBUF\r
3867         MOVEM   T1,JOBFF        ;MAKE MONITOR USE DBUF FOR DISK DIR.\r
3868 \r
3869         MOVEI   T1,14           ;BINARY MODE\r
3870         MOVEM   T1,ADSK1\r
3871 \r
3872         MOVEI   T1,UFDIN        ;LOC OF DIRECTORY ENTRY\r
3873         MOVEM   T1,ADSK+1       ;FOR UFD\r
3874 \r
3875         OPEN    DIR,ADSK1\r
3876         JRST    ERR1A\r
3877         INBUF   DIR,1           ;RESET JOBFF SAME AS ENTRY\r
3878         MOVEM   T2,JOBFF\r
3879         POPJ    P,\r
3880 \f;OUTPUT THE DIRECTORY LISTING HEADER\r
3881 \r
3882 HEADER: PUSHJ   P,HEDR4\r
3883 HEDR1:  LSTLIN  HEDL1\r
3884         HLRZ    DOUT,FNPPN\r
3885         PUSHJ   P,OUTDEC        ;PROJ, PROG\r
3886         MOVEI   CHR,","\r
3887         PUSHJ   P,PUT\r
3888         HRRZ    DOUT,FNPPN\r
3889         PUSHJ   P,OUTDEC\r
3890         PUSHJ   P,TABOUT\r
3891         PUSHJ   P,NOWOUT        ;PRINT CURRENT TIME, DATE\r
3892         DATE                    ;DATE REQ.\r
3893         PUSHJ   P,DATOUT\r
3894         PUSHJ   P,CLRF\r
3895         TRNE    CALFLG,LISTTY\r
3896         JRST    HEDR2           ;JUMP IF LISTING TO CONSOLE\r
3897         SOS     LIN\r
3898         LSTLIN  HEDLIN\r
3899 HEDR2:  JRST    CLRF\r
3900 \r
3901 HEDR3:  TRNN    AUXFLG,FFLG     ;POP BACK IF SHORT LISTING\r
3902         TRNE    CALFLG,LISTTY\r
3903         POPJ    P,\r
3904         PUSHJ   P,HEDR4\r
3905         LSTLIN  HEDL2\r
3906         JRST    HEDR1\r
3907 \fHEDLIN: ASCIZ /\r
3908     File             Protection   Access        Creation    \r
3909  Name   Ext     Blks               Date         Time    Date            Mode\r
3910 /\r
3911 HEDL1:  ASCIZ   /Directory     /\r
3912 HEDL2:  ASCIZ   /Continuation of /\r
3913 \f\r
3914 UIN2:   PUSHJ   P,COMERR\r
3915         JSP     T5,INICN2\r
3916         ERRPN2  </?Disk directory read />\r
3917         MOVEI   T3,UFD  ;LOCATION OF FILENAME(AND EXT)\r
3918         PUSHJ   P,FN.EX ;PRINT FILE NAME EXTENSION\r
3919         MOVE    T2,AUXFLG\r
3920         ANDI    T2,DSKIN\r
3921         PUSHJ   P,IOERR\r
3922         SETSTS  DIR,(IOS)\r
3923         JRST    CPOPJ1\r
3924
3925 ;OUTPUT THE TIME FOUND IN AC 0\r
3926 \r
3927 NOWOUT: MSTIME                  ;CALL MILLISEC TIMER\r
3928         IDIVI   0,^D60000       ;CONVERT TO MINUTES\r
3929 TIMOUT: IDIVI   0,^D60\r
3930         MOVE    DOUT,0\r
3931         PUSHJ   P,OUTDEC\r
3932         MOVEI   CHR,":"         ;SEPARATE BY A COLON\r
3933         PUSHJ   P,PUT\r
3934         MOVE    DOUT,1\r
3935         PUSHJ   P,OUTDEC\r
3936         JRST    TABOUT\r
3937 \f;SKIP TO HEAD OF FORM OR NEXT HALF PAGE, RESET COUNT\r
3938 \r
3939 HEDR4:  TRNE    CALFLG,LISTTY\r
3940         POPJ    P,              ;EXIT IF TTY\r
3941         SKIPLE  LIN\r
3942         JRST    HEDR6           ;ANYTHING ON THIS PAGE?\r
3943 HEDR5:  MOVEI   CHR,FF          ;FORM FEED IF FULL OR\r
3944         MOVEI   T2,^D50\r
3945 HEDR5A: MOVEM   T2,LIN          ;ALMOST FULL\r
3946         PUSHJ   P,PUT\r
3947         MOVEI   CHR,LF\r
3948         PUSHJ   P,PUT\r
3949         PUSHJ   P,PUT\r
3950         JRST    PUT             ;PRINT LINEFEEDS AND EXIT\r
3951 HEDR6:  CAIGE   T2,^D25\r
3952         JRST    HEDR5\r
3953         MOVEI   CHR,HPAGE\r
3954         MOVEI   T2,^D16\r
3955         JRST    HEDR5A\r
3956 \r
3957 ;OUTPUT OCTAL WORD FOUND IN AC 0\r
3958 \r
3959 OCTLS2: MOVEI   CHR," "\r
3960         CAIGE   0,10            ;AT LEAST 2 CHAR.?\r
3961         PUSHJ   P,PUT           ;NO,SO OUTPUT A BLANK\r
3962 OCTLST: MOVSI   T1,(POINT 3,0)\r
3963         ILDB    CHR,T1\r
3964         TLNE    T1,770000       ;ALLOW UPTO 12 OCTAL NOS\r
3965         JUMPE   CHR,.-2         ;GET MOST SIG. NUMBER\r
3966 OCTL1:  ADDI    CHR,60          ;CONVERT TO ASCII\r
3967         PUSHJ   P,PUT           ;OUTPUT CHAR\r
3968         ILDB    CHR,T1          ;GET SUCCEEDING CHARS\r
3969         TLNN    T1,400000       ;WAIT TILL POINTING TO NEW\r
3970         JRST    OCTL1           ;WORD, THEN EXIT. MEAN WHILE\r
3971         POPJ    P,              ;PRINT OCTAL NUMBERS\r
3972 \r
3973 ;OUTPUT PROTECTION BITS FOUND IN AC 0\r
3974 \r
3975 PROTO:  MOVEI   CHR,"<"\r
3976         MOVSI   T1,(POINT 3,,26)\r
3977         PUSHJ   P,OCTL1+1\r
3978         MOVEI   CHR,">"\r
3979         PUSHJ   P,PUT\r
3980         JRST    TABOUT          ;EXIT\r
3981 \r\f;THIS IS THE DISK ERROR ROUTINE.  CALL DERR4 WITH T3=FIRST WORD ADDRESS\r
3982 ;OF LOOKUP OR ENTER. USE T7 FOR SAVING THE ERROR CODE.\r
3983 \r
3984 DERR5A: MOVEI   T3,FILNAM       ;LOCATION OF FILENAME\r
3985         HRRZ    T7,1(T3)        ;GET ERROR CODE\r
3986         SKIPE   GENERI          ;FATAL IF NOT GENERIC "DSK"\r
3987         CAILE   T7,1            ;NO UFD IF 0 OR 1\r
3988         JRST    DERR4           ;ANY OTHER ERROR\r
3989         LSTLIN  NOUFD\r
3990         MOVEI   T1,LSTU0        ;RETURN ADDRESS\r
3991         HRRM    T1,(P)          ;OF POPJ\r
3992         JRST    DIRSK2          ;GET NEXT FILE STRUCTURE\r
3993 NOUFD:  ASCIZ   /       no UFD created\r
3994 /\r
3995 \r
3996 DERR6:  MOVEI   T3,DTON         ;LOCATION OF FILENAME (OUTPUT)\r
3997         SKIP    1\r
3998 DERR5:  MOVEI   T3,ZRF          ;LOCATION OF FILENAME (INPUT)\r
3999         HRRZ    T7,1(T3)        ;ERROR TYPE\r
4000 DERR4:  ERRPNT  </? />\r
4001         PUSHJ   P,FN.EX         ;PRINT FILE NAME .EXT\r
4002         CAIL    T7,TABLND-TABLE ;LEGAL ERROR?\r
4003         SKIPA   T1,TABLND       ;NO,USE CATCH ALL MESSAGE\r
4004         MOVE    T1,TABLE(T7)    ;PICK UP BYTE POINTER\r
4005         JRST    PTEXT1          ;AND PRINT MESSAGE\r
4006 \r
4007 TABLE:  POINT   7,[ASCII /(0) file was not found!/]\r
4008         POINT   7,[ASCII /(1) no such project-programmer number!/]\r
4009         POINT   7,[ASCII /(2) protection failure!/]\r
4010         POINT   7,[ASCII /(3) file was being modified!/]\r
4011         POINT   7,[ASCII /(4) rename file name already exists!/]\r
4012         POINT   7,[ASCII /(5) illegal sequence of UUOs!/]\r
4013         POINT   7,[ASCII /(6) bad UFD or bad RIB!/]\r
4014         POINT   7,[ASCII /(7) not a SAV file!/]\r
4015         POINT   7,[ASCII /(10) not enough core!/]\r
4016         POINT   7,[ASCII /(11) device not available!/]\r
4017         POINT   7,[ASCII /(12) no such device!/]\r
4018         POINT   7,[ASCII /(13) not two reloc reg. capability!/]\r
4019         POINT   7,[ASCII /(14) no room or quota exceeded!/]\r
4020         POINT   7,[ASCII /(15) write lock error!/]\r
4021         POINT   7,[ASCII /(16) not enough monitor table space!/]\r
4022         POINT   7,[ASCII /(17) partial allocation only!/]\r
4023         POINT   7,[ASCII /(20) block not free on allocation!/]\r
4024 \r
4025 TABLND: POINT   7,[ASCII /(?) lookup,enter,or rename error!/]\r
4026 \f\r
4027 ADATE:  POINT 12,FILNAM+1,35    ;ACCESS DATE\r
4028 CTIME:  POINT 11,FILNAM+2,23    ;CREATION TIME\r
4029 CDATE:  POINT 12,FILNAM+2,35    ;CREATION DATE\r
4030 PROT:   POINT 9,FILNAM+2,8      ;PROTECTION\r
4031 MODE:   POINT 4,FILNAM+2,12     ;RECORDING MODE\r
4032 ADSK1:  BLOCK   1               ;OPEN DIRECTORY, MODE\r
4033 ADSK:   BLOCK   2               ;FILENAME, EXT\r
4034 LIN:    BLOCK 1                 ;COUNT FOR DSK DIR LIST\r
4035 UFDIN:  BLOCK 3                 ;HEADER FOR READING DISK DIRECTORY\r
4036 UFD:    BLOCK 4                 ;[P,P] OR *FD*\r
4037                                 ;UFD OR SYS\r
4038 DTBLK:  BLOCK 1         ; OPEN DTA DIRECTORY BLOCK\r
4039 DTDEV:  BLOCK 2         ; SIXBIT /DTAN/\r
4040 IFN DISK30,<\r
4041 BLKHD:  BLOCK 3                 ;HEADER FOR READING BLOCKS OFF 10/30 DISK\r
4042 MASK:   BLOCK 1                 ;PROJ,PROG # 10/30 DISK>\r
4043 BLKSUM: BLOCK 1                 ;TOTAL NBR BLOCKS PER PROJ. PROG NBR\r
4044 LEVEL:  BLOCK   1               ;-2 IF LEVEL D DISK SERVICE\r
4045 GENERI: BLOCK   1               ;FILE STRUCTURE NAMES IF GENERIC DSK\r
4046 \r
4047         VAR\r
4048 LOWTOP:\r
4049 PIPEND: END PIP1          \r
4050 \f