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