Added version 10 of basic.
[retro-software/dec/tops10/v4.5.git] / src / tendmp.mac
1 TITLE TENDMP - DTAPE/MTAPE UTILITY - R CLEMENTS/GBH/RH/RD/RCC/JEF 6 APR 71 - V032\r
2         IFNDEF REL,<REL=0>      ;0 PAPER TAPE, 1 RELOCATABLE BINARY\r
3         IFNDEF MAGT,<MAGT=0>    ;0 DTAPE, 1 MTAPE\r
4         IFN MAGT,<\r
5 ; MAGTAPE UTILITY ROUTINE - COURTSEY DATALINE SYSTEMS J HANCOCK\r
6         >\r
7         IFNDEF MODE,<MODE=0>    ;0 IS TD10, 1 IS 551/136\r
8         IFNDEF CORE,<CORE=4>    ;NUMBER OF 8K MEMORY BLOCKS\r
9 \r
10         IFE MODE,<SUBTTL TD10 VERSION>\r
11         IFN MODE,<SUBTTL 551/136 VERSION>\r
12 \r
13 IFE REL,<\r
14 IFE MAGT,<RIM10B>\r
15 IFN MAGT,<RIM10>>\r
16         UTC=210\r
17         UTS=214\r
18         DC=200\r
19         DTC=320\r
20         DTS=324\r
21 \r
22 F=0     ;MUST BE 0. USED BY JRA'S\r
23 A=2     ;MISC TEMP. HOLDS 136 CONO INDEX IN UWAIT\r
24 B=1     ;TEMP. HOLDS BLOCK # COMPUTATION IN SEARCH\r
25 C=3     ;HOLDS BITS FOR DECTAPE CONO DURING I/O\r
26 D=4     ;HOLDS POINTERS FOR AOBJN'S THROUGH CORE\r
27 E=5     ;HOLDS COUNT OF WORDS IN CURRENT DT BLOCK\r
28 P=6     ;PC FOR JSP'S\r
29 CKS=7   ;HAD BEEN CHECKSUM IN MACDMP\r
30 FILN=10 ;NUMBER OF FILE IN DIRECTORY, 1 TO 26 OCTAL\r
31 BLKNO=11        ;BLOCK NUMBER SEARCHED FOR ON TAPE\r
32 WRITE=12        ;MULTI-STATE FLAG FOR DEFINING I/O OPERATION\r
33                 ;1=D 0=K -1=ELSE\r
34 PNTR=13 ;POINTER TO BYTE TABLE IN DIRECTORY\r
35 CH=14   ;HOLDS 6BIT CHARACTER OF COMMAND, OR -1\r
36 Q=15    ;ANOTHER JSP AC\r
37 G=16    ;RARELY USED VERY TEMP\r
38 CT=17   ;COUNT OF WORDS TO DUMP\r
39 \r
40 COMPTR=BEGR+377 ;COMMAND POINTER, IF SUPPLIED\r
41         LOZAD=BEGR-203  ;WHEN CORE IS CLEARED, IT\r
42                         ;IS FROM 40 THRU LOZAD\r
43         LOW=20  ;FIRST LOCATION CONSIDERED FOR DUMPING\r
44         HIGH=BEGR-203   ;LAST LOCATION CONSIDERED FOR DUMPING\r
45                         ;ZEROED AT BEG THESE DAYS\r
46         FOOF=BEGR-202   ;NEEDED FOR ZERO CORE SEARCH, ZEROED AT BEG1\r
47 TAB=BEGR-201            ;FILE DIRECTORY\r
48 LINK=BEGR-1             ;0-17=LINK, 18-27=FBN, 29-35=WC\r
49 IFE REL,<IFE MAGT,<LOC 17400+<<CORE-1>*20000>>\r
50          IFN MAGT,<LOC 17377+<<CORE-1>*20000>\r
51         IOWD    LAST-BEGR+1,BEGR>>\r
52 \f;INITIAL ENTRY IS AT BEGR, UNLESS A COMMAND POINTER IS\r
53 ;SUPPLIED IN COMPTR. IN THAT CASE, ENTRY IS AT BEGR+1\r
54 \r
55 BEGR:   SETZM COMPTR    ;CLEAR ANY JUNK IN COMMAND POINTER\r
56         CONO 635550     ;I/O RESET, ETC.\r
57 BEG:    JSP P,CRR       ;TYPE A CR-LF\r
58         MOVEI D,SPNT-2  ;PREPARE TO REMOVE AOBJN POINTERS\r
59 BEG1:   SETZB A,FOOF    ;CLEAR A TO PUT IN CORE, CLEAR\r
60                         ;FOOF FOR  THE NEXT ZERO CORE SEARCH\r
61         EXCH A,2(D)     ;REMOVE HEADER LIST\r
62         AOBJN A,.       ;COUNT THROUGH TO NEXT HEADER\r
63         MOVEI D,-1(A)   ;ACCOUNT FOR OVERSHOOT IN AOBJN\r
64         JUMPN D,BEG1    ;IF WE DIDNT AOBJN A 0, GO FOR NEXT HDR\r
65         MOVE PNTR,[XWD 500,TAB-1]       ;5 BIT BYTES IN DIRECTORY\r
66         SETZB CH,F\r
67 CRCH:   SETOI WRITE,215 ;USED FOR CARRET TYPEOUT\r
68 TYI:    SETZB C,HIGH    ;HOPEFULLY HIGH IS TEMPORARY\r
69         SETZB B,E       ;NAME INITIALIZING\r
70         TLOA B,400000   ;NULL NAME IS "@. "\r
71 SPACE:  MOVEI E,C-1     ;EXTENSION INTO C\r
72         HRLI E,20600    ;FAKE OUT END TEST OF BYTE PTR\r
73 ;STOP TAPE DRIVE\r
74 IFN MODE,<CONO UTC,0>\r
75 IFE MODE,<CONO DTC,400000>\r
76 NEXT:   ILDB A,@BEGR    ;GIVES A 0 UNLESS COMMAND POINTER SUPPLIED\r
77                         ;RH OF NEXT IS USED AS A CONSTANT\r
78 BELL:   SETOI FILN,207  ;INITIALIZATION FOR SEARCH\r
79         SETZB BLKNO,CT  ; "\r
80         SETZM LINK\r
81         JUMPN A,RCH     ;JUMP IF COMMAND READ FROM CORE\r
82         CONSO TTY,40    ;TYPEIN FLAG?\r
83         JRST .-1        ;NO,WAIT\r
84         DATAI TTY,A     ;GET TYPED IN CHARACTER\r
85         JSP P,TYO       ;ECHO IT (WITH PARITY)\r
86 RCH:    ANDI A,177      ;STRIP OFF PARITY\r
87         CAIN A,177      ;RUBOUT?\r
88         JRST BEGR       ;YES. RESTART TENDMP\r
89         CAIE A,33       ;NEW ALTMODE?\r
90         CAIL A,175      ;OR 175 OR 176 ALTMODES?\r
91         JRST ALTTST     ;YES, SOME ALTMODE.\r
92         CAIL A,140      ;LOWER CASE CHARACTER?\r
93         TRZ A,40        ;YES. CHANGE TO UPPER CASE\r
94         SUBI A,40       ;CONVERT TO SIXBIT\r
95         JUMPL A,CARRET  ;ANY CONTROL CHARACTER\r
96         JUMPE A,SPACE   ;CHAR WAS 40\r
97 NEXT1:  TLNE E,770000   ;NO MORE THAN SIX CHARS\r
98         IDPB A,E        ;GOES INTO AC1 = B\r
99         JRST NEXT       ;GET ANOTHER CHARACTER\r
100 \r
101 \f\r
102 ;HERE ON JUMP BLOCK DURING LOADS, OR NUMBER>7 ALT\r
103 JBLK:\r
104 ;STOP TAPE DRIVE\r
105 IFN MODE,<CONO UTC,0>\r
106 IFE MODE,<CONO DTC,400000>\r
107         HRRM D,SADR     ;SAVE STARTING ADDRESS\r
108         JUMPN CH,BEG    ;IF NOT LOADGO COMMAND\r
109 SADR:   JRST BEG        ;CURRENT S.A.\r
110 LOADS:                  ;HERE TO LOAD TAPE TO CORE\r
111         MOVEI D,LOZAD+1 ;FIRST LOC NOT TO ZERO\r
112         SETZM 40        ;A "FEATURE"\r
113         MOVE C,[XWD 40,41]      ;PREPARE TO CLEAR CORE.\r
114         TRNN CH,3       ;SKIP ON M,N   NOT ON L,T,@\r
115         BLT C,-1(D)     ;ZERO CORE\r
116 LOAD:   JSP Q,LODUMP    ;START READING FILE. LODUMP PROCESSES\r
117                         ;ONE HEADER AND ITS DATA\r
118         JRST LOAD       ;IF OK, GET NEXT BLOCK.(IF NONE, \r
119                         ;LODUMP RETURNS TO JBLK.)\r
120 DELE:   SKIPN E,WRITE   ;SKIP IF NOT IN THE K PHASE OF A D COMMAND.\r
121                         ;OR A K COMMAND\r
122                         ;ALSO, SET E =0, SO SEARCH HAPPENS IN RBLK\r
123 CLS1:   AOJA WRITE,CLSTP        ; 0 TO 1. GO DUMP OUT DIRECTORY.\r
124 ERR:    SKIPA P,NEXT    ;SET TO RETURN TO BEGR\r
125 CRR:    SKIPA A,CRCH    ;LIKE HRROI A,215 AND SKIPA\r
126         SKIPA A,BELL    ;GET A BELL CHARACTER\r
127 TYO:    SKIPN COMPTR    ;DONT TYO IF NO TYI, UNLESS ERR\r
128         DATAO TTY,A     ;TYPE OUT\r
129         CONSZ TTY,20    ;WAIT FOR TTY TO FINISH\r
130         JRST .-1        ;NOT YET\r
131         CAIE A,215      ;IF CR TYPED IN,\r
132         JUMPGE A,(P)    ;OR SIGN BIT OF CHAR ON,(SEE CRR)\r
133         MOVEI A,12      ;APPEND A LINEFEED\r
134         JRST TYO        ;GO TYPE LF\r
135 \r
136 \fALTTST:        TLNN B,4040     ;IF ALPHA CHARACTERS, DONT GET CH\r
137         LDB CH,E        ;LAST CH BEFORE ALT, -40\r
138         JUMPN CH,ALTMD  ;IF CH NOT NULL, GOT PROCESS ALTMODE\r
139 CARRET: MOVSI FILN,-26  ;FILE NAME SPECIFIED. FIRST THING TO\r
140                         ;DO IS LOOK IT UP IN DIRECTORY\r
141 LUP:    SKIPN TAB+123(FILN)     ;SEARCH FOR FREE FILE\r
142         SKIPE BLKNO,TAB+151(FILN)       ;CHECK BOTH WORDS\r
143         TDZA BLKNO,BLKNO        ;ENSURE CLEAR BLOCK NUMBER\r
144         HRRM FILN,FREE  ;SAVE NUMBER OF A FREE FILE\r
145         HLLZ G,TAB+151(FILN)    ;ONLY CHECK LEFT OF 2ND WD\r
146         CAMN B,TAB+123(FILN)    ;SEARCH FOR TYPED-IN FILE\r
147         CAME C,G                ;BOTH WORDS\r
148         AOBJN FILN,LUP  ;NOT THIS ONE. KEEP LOOKING\r
149         JUMPL FILN,BEG69        ;IF FILE FOUND, JUMP\r
150         JUMPLE WRITE,ERR        ;IF NOT FOUND, BETTER BE DUMP\r
151 FREE:   MOVEI FILN,.    ;DUMP & NOT FOUND, MAKE ENTRY WHERE FREE\r
152                         ;(ADDRESS MODIFIED ABOVE)\r
153         SKIPE TAB+123(FILN)     ;MAKE SURE HOLE AVAILABLE\r
154         JRST ERR        ;NO FREE SLOTS\r
155 \r
156 BEG69:  MOVEI FILN,1(FILN)      ;FILN IS FILE #+1; CLR LH\r
157         JUMPL WRITE,LOADS       ;ALL LOAD INSTRUCTIONS\r
158 IFE MAGT,<\r
159         SKIPN WRITE     ;DELETE? (K COMMAND)\r
160         SETZB B,C       ;YES, KILL FILE\r
161         MOVEM B,TAB+122(FILN)   ;CLEAR IF DELE, ENTER IF NEW DUMP\r
162         HLLZM C,TAB+150(FILN)   ;BOTH WORDS\r
163                                 ;FALL INTO DUMP ROUTINE\r
164                                 ;WHICH IS A NO-OP FOR K\r
165 \r
166 \f\r
167 ;DUMP WRITES OUT CORE ONTO TAPE\r
168 \r
169 ;DUMP THRU DUMP2-1 SETS UP POINTERS TO NON-ZERO CORE AREAS. THESE\r
170 ;AOBJN POINTERS ARE CALLED  "HEADERS", AND PRECEDE THE DATA WHEN\r
171 ;THE TAPE IS WRITTEN.\r
172 ;THE FIRST HEADER IS KEPT IN SPNT. SUCCESIVE HEADERS GO INTO THE FIRST\r
173 ;ZERO WORD FOLLOWING THE BLOCK CORRESPONDING TO THE PREVIOUS HEADER.\r
174 ;AFTER THE LAST NON-ZERO BLOCK IS (BY DEFINITION) A ZERO, WHICH\r
175 ;TERMINATES THE HEADER LIST. THIS WORD MAY BE LOCATION FOOF (37176) IF\r
176 ;CORE WAS FILLED UP TO THE BASE OF TENDMP.\r
177 \r
178 DUMP:                   ;HERE ON D,K. (BLKN)=0, FILN SET UP\r
179         MOVN A,[XWD HIGH-LOW-1,-LOW+1]  ;COUNTER TO EXAMINE \r
180                                         ;CORE FOR BLOCKS OF 0\r
181         MOVEI CKS,SPNT-1        ;FIRST HEADER GOES INTO SPNT\r
182 DMP1:   SKIPN 1(A)      ;FIND SOME NON-ZERO CORE\r
183         AOBJN A,.-1     ;ZERO. KEEP LOOKING.\r
184         MOVEM A,D       ;SAVE ADR\r
185         SKIPN 1(A)      ;FIND SOME ZERO CORE\r
186         SKIPE 2(A)      ;DON'T MAKE NEW BLOCK FOR 1 ZERO\r
187         AOBJN A,.-2     ;NON-ZERO. KEEP LOOKING\r
188         SUB D,A         ;GET -COUNT IN BOTH HALVES OF D\r
189         SUBI CT,-1(D)   ;COUNT N WORDS DATA, 1 HDR\r
190         ADDI D,(A)      ;GET F.A.-1 IN RH OF D\r
191         MOVEM D,1(CKS)  ;SAVE HEADER\r
192         JUMPGE D,.+2    ;ON DATA GROUPS,\r
193         MOVE CKS,A      ;GET THE HEADER\r
194                         ;F.A.+W.C. IS ADR OF NEXT HEADER\r
195                         ;I.E., FIRST 0 AFTER NON-ZERO BLOCK\r
196         JUMPL A,DMP1    ;LOOP IF MORE CORE\r
197         LSH CKS,2       ;SHIFT CORE SIZ FOR DIR\r
198         SKIPLE WRITE    ;IF DUMPING, SET JOBREL\r
199         HRRM CKS,TAB+150(FILN)  ;PUT IN DIR\r
200 DMP2:   MOVEI D,SPNT-1  ;SET UP TO FOLLOW THE HEADERS.\r
201         MOVEI CT,1(CT)  ;CLR LH, COUNT JBLK\r
202 DMP3:   MOVE D,1(D)     ;GET HEADER\r
203         JUMPGE D,THRU   ;IF NULL HEADER FOUND\r
204         MOVEI Q,DMP3    ;Q:= DMP3 AS A RETURN AFTER AOBJN\r
205         >\r
206 \r
207 IFN MAGT,<\r
208         JRST    ERR             ;HOW DID WE GET HERE?  DLS***\r
209 ;DUMP WRITES OUT CORE ONTO MAGNETIC TAPE\r
210 ;DUMP WRITES OUT A CORE IMAGE ON MAGNETIC TAPE WITHOUT\r
211 ;ZERO COMPRESSION. THE RECORDS ARE 200(OCTAL) WORDS IN LENGTH\r
212 ;AND BEGIN WITH WORD ZERO. BEFORE STARTING THE TAPE IS REWOUND.\r
213 ;IT ASSUMES MTA0, AT LEAST FOR NOW.\r
214  \r
215         MTC=    340\r
216         MTS=    344\r
217 DUMP:   CONO    MTC,1000        ;REWIND\r
218         CONSO   MTS,300000      ;WAIT FOR BOT OR REWINDING\r
219         JRST    .-1\r
220         CONSO   MTS,40          ;TRANSPORT READY?\r
221         JRST    .-1\r
222         SETZ    A,\r
223 DUMP1:  HRLI    A,-200          ;WORDS PER BLOCK\r
224         CONO    MTC,64100       ;START WRITE OPERATION\r
225 DUMP2:  CONSO   MTS,1           ;TD10 READY FOR DATA?\r
226         JRST    .-1\r
227         DATAO   MTC,(A)         ;SEND OUT DATA\r
228         AOBJN   A,DUMP2         ;POINT TO NEXT WORD AND LOOP\r
229         CONO    MTS,1           ;STOP THE DRIVE\r
230         CONSO   MTS,100         ;WAIT TILL STOPPED\r
231         JRST    .-1\r
232         CONSZ   MTS,464610      ;ANY ERRORS?\r
233         JRST    ERR             ;YES, GO RING BELL\r
234         AOSE    [-CORE*20000/200+2]     ;ALL CORE DUMPED?\r
235         JRST    DUMP1           ;NO\r
236         CONO    MTC,65100       ;WRITE END OF FILE\r
237         CONSO   MTS,100         ;DONE?\r
238         JRST    .-1\r
239         CONO    MTC,65100\r
240         CONSO   MTS,100\r
241         JRST    .-1\r
242         JRST    BEGR            ;ALL DONE\r
243         >\r
244 \r
245 \r
246 LODUMP: JSP P,UWAIT\r
247         JFCL D          ;IN/OUTPUT HEADER\r
248         JUMPGE D,JBLK   ;IF JRST BLOCK READ. CANT HAPPEN ON WRITE\r
249 DMP5:   JSP P,UWAIT\r
250         JFCL 1(D)       ;IN/OUTPUT DATA WORD\r
251         AOBJN D,DMP5    ;COUNT DOWN THE HEADER\r
252         JRST (Q)        ;END OF HEADER. TO DMP3 OR LOAD+1\r
253 ;WRITE:  1=D  0=K  -1=ELSE\r
254 \r
255 THRU:   JSP P,UWAIT     ;WRITE OUT JRST BLOCK\r
256         JFCL SADR       ;FROM LOC SADR\r
257 IFE MODE,<      AOJL E,UWAIT1   ;FILL OUT BLOCK, TO GET CKSM OUT>\r
258         TRZA WRITE,-1   ;THEN SET WRITE TO 0, AND GO CLOBBER\r
259                         ;ANY FURTHER BLOCKS WITH THIS FILN\r
260 UWAIT:  AOJL E,UWAIT1   ;RETURN ADDR = (P)      DATA ADDR = @(P)\r
261                         ;E IS -WD COUNT IN BLOCK OR POSITIVE\r
262                         ;BYTE POINTER FIRST TIME THRU\r
263         HLRZ BLKNO,LINK         ;SET TO FOLLOW LINK\r
264 MNLUP0: JUMPGE WRITE,MNLUP      ;WRITING OR DELETING\r
265         JUMPN BLKNO,RBLK\r
266 MNLUP:  AOSA BLKNO      ;NEXT BLOCK IN THE DIRECTORY\r
267 MNLUP1: DPB B,PNTR      ;FOR DELETE, 0 FILE NAME AND NUMBER\r
268         ILDB A,PNTR     ;SEARCH FILE DIR\r
269         CAIN A,37\r
270         JRST DELE       ;END OF TAB MARKER, DELE GOES TO\r
271                         ;CLSTP ON A "D" TO DUMP DIRECTORY\r
272         TLO A,-1(WRITE) ;0 ON D, -1 ON K OR K PHASE OF D\r
273         CAIE FILN,(A)   ;IS THIS BLOCK ASSIGNED TO CURRENT FILE?\r
274         JUMPN A,MNLUP   ;OR MAYBE FREE? JUMP IF IN USE BY\r
275                         ;ANOTHER FILE.\r
276         DPB FILN,PNTR   ;SMASH AWAY WRITE BLOCK ON D OR K. BUT\r
277                         ;SEE MNLUP1 ON K.\r
278         JUMPE WRITE,MNLUP1      ;K COMMAND\r
279         SKIPN C,LINK            ;HAS LINK BEEN SET UP?\r
280         DPB BLKNO,[XWD 101200,LINK]     ;NO. PUT BLOCK IN AS FIRST BLK NO\r
281         HRLM BLKNO,LINK ;PUT BLOCK IN AS LINK\r
282         JUMPE C,MNLUP0          ;JUMP IF THIS IS THE FIRST PASS THRU DIRECTORY\r
283         HLRZ BLKNO,C            ;GET LINKED BLOCK CHOSEN BEFORE\r
284         MOVEI C,177             ;PUT IN A WORD COUNT FOR PIP\r
285         IORM C,LINK             ;AND PUT ALL THAT INTO LINK WORD\r
286         SUBI CT,177             ;DECREMENT WORDS LEFT TO GO\r
287 \r
288 \f\r
289 ;RBLK SEARCHES FOR THE BLOCK IN BLKNO, ENTERS IT GOING FORWARD,\r
290 ;AND THEN READS INTO CORE, DUMPS CORE, OR COMPARES CORE AS\r
291 ;DETERMINED BY CONTENTS OF WRITE.\r
292 \r
293 RBLK:   HRRO C,TAPENO   ;CURRENT TAPE NO.\r
294                         ;SET LH TO  PREPARE FOR JUMPN IN DELE\r
295 IFE MODE,<\r
296         TRO B,-1        ;ENSURE GOING FORWARD WHEN FIRST SEARCH\r
297         CONSO DTC,300000        ;IS A DIRECTION ASSERTED?\r
298         TRO C,210000    ;NO. GO FORWARD\r
299 RB1:    TRNN B,400001   ;DECIDE WHETHER TO TURN AROUND\r
300         TRO C,300000    ;TURN AROUND\r
301 RBG:    CONO DTC,20200(C)       ;ISSUE THE COMMAND TO TD10.\r
302                                 ;200=SEARCH, 300=READ, 700=WRITE.\r
303 UWAIT1: CONSZ DTS,672700        ;ANY ERRORS?\r
304         JRST ERR        ;YES. GO DING AND THEN TYI\r
305         CONSO DTS,1     ;DATA READY?\r
306         JRST .-3        ;NO. GO WAIT SOME MORE\r
307         JUMPL E,INOUT(WRITE)    ;IF IN MIDST OF A DT BLOCK, DISPATCH\r
308         DATAI DTC,B     ;NO. SEARCHING. GET BLOCK NO.\r
309         TRZ C,310000    ;CLOBBER DIRECTION BITS IN CONO\r
310         SUBI B,(BLKNO)  ;COMPARE WITH DESIRED BLOCK\r
311         CONSZ DTC,100000        ;COMPLEMENT DECISION IF GOING REVERSE\r
312         TRC B,-2        ;BIT 35 IS FOR  TURNAROUND SPACE.\r
313 >\r
314 \f\r
315 IFN MODE,<\r
316         SETOB A,B       ;GO FORWARD, SET DC FOR SEARCH\r
317         CONSZ UTS,40    ;IS CHECKSUM BEING WRITTEN?\r
318         JRST .-1        ;WAIT\r
319 RB1:    TRNN B,400001   ;DECIDE WHETHER TO TURN AROUND\r
320         TRCA C,10000    ;CHANGE DIRECTION AND DELAY\r
321         CONSO UTC,200000        ;UNIT SELECTED?\r
322         TRO C,2000      ;INVOKE STARTUP DELAY\r
323 RBG:    CONO UTC,220200(C)      ;COMMAND TO THE  551.\r
324                                 ;200=SEARCH, 300=READ, 700=WRITE.\r
325         CONO DC,4011(A) ;COMMAND TO THE 136.\r
326 UWAIT1: CONSZ UTS,6     ;ANY ERRORS?\r
327         JRST ERR        ;YES. GO DING AND THEN TYI\r
328         CONSO DC,1000   ;DATA READY?\r
329         JRST .-3        ;NO. WAIT SOME MORE\r
330         JUMPL E,INOUT(WRITE)    ;IF IN MIDST OF A DT BLOCK, DISPATCH\r
331         DATAI DC,B      ;NO. SEARCHING. GET BLOCK NUMBER\r
332         TRZ C,2000      ;DONT DELAY ANY MORE\r
333         SUBI B,(BLKNO)  ;COMPARE WITH DESIRED BLOCK\r
334         TRNE C,10000    ;COMPLEMENT IF GOING REVERSE\r
335         TRC B,-2        ;BIT 35 IS FOR TURNAROUND SPACE.\r
336 >\r
337         JUMPN B,RB1     ;JUMP IF NOT GOING FORWARD INTO (BLKNO)\r
338         MOVNI E,200     ;WORDS PER BLOCK\r
339         MOVEM P,F       ;SAVE RETURN IN AC0\r
340         TRO C,100       ;READ COMMAND, MAYBE\r
341         JUMPLE WRITE,RB2        ;JUMP IF READ\r
342         TRO C,400       ;CHANGE TO WRITE COMMAND\r
343 IFN MODE,<MOVNI A,401   ;SET 136 TO OUTPUT>\r
344         JUMPG CT,.+3\r
345         HRRZS LINK      ;IF LAST BLK, KILL LINK\r
346         DPB E,PNTR              ;AND THE DIR BYTE _ 0\r
347 RB2:    CAIE BLKNO,^D100        ;IF NOT DIRECTORY BLOCK\r
348         MOVEI P,.+2     ;SETUP NEW RETURN\r
349         JRST RBG\r
350         AOJ E,LINK      ;IN/OUTPUT LINK\r
351         JRA P,UWAIT1    ;RESTORE CALLER ADR\r
352                         ;AND PROCESS DATA WORDS\r
353 \f\r
354 IFE MODE,<\r
355         DATAI DTC,@(P)  ;READ COMMANDS. GET WORD TO CORE\r
356 INOUT:  JRST UWAIT2     ;INOUT-1 TO INOUT +1 ARE DISPATCHED TO.\r
357         DATAO DTC,@(P)  ;OUTPUT TO TAPE\r
358 UWAIT2: AOJN E,UWAIT3   ;WAS THAT THE LAST WORD IN THE DT BLOCK?\r
359         CONO DTS,1      ;YES. GIVE FUNCTION STOP TO TD10\r
360         CONSO DTS,100000        ;AND WAIT FOR CHECKSUM TO BE DONE\r
361         JRST .-1        ;NOT YET. WAIT\r
362 UWAIT3: SOJA E,0(P)     ;DONE. COMPENSATE FOR THE AOJN ABOVE, AND\r
363                         ;RETURN TO CALLER OF UWAIT OR RBLK\r
364 >\r
365 \r
366 IFN MODE,<\r
367         DATAI DC,@(P)   ;READ COMMANDS. GET WORD TO CORE\r
368 INOUT:  JRST UWAIT2     ;INOUT-1 THRU INOUT+1 ARE DISPATCHED TO.\r
369         DATAO DC,@(P)   ;OUTPUT TO TAPE\r
370 UWAIT2: JRST 0(P)       ;RETURN TO CALLER OF UWAIT OR RBLK.\r
371 >\r
372 \f\r
373 ALTMD:  MOVEI A,"$"\r
374         JSP P,TYO       ;ALTMODE IS PRINTED AS "$"\r
375 \r
376 IFE MAGT,<\r
377         CAIE CH,"K"-40  ;FOR K, WRITE := 0\r
378         CAIN CH,"D"-40  ;FOR D, WRITE :=1\r
379         AOJLE WRITE,.-1 ;COUNT (WRITE)\r
380         >\r
381 \r
382 IFN MAGT,<\r
383         CAIN CH,"D"-40  ;FOR D, WRITE :=1\r
384         AOJLE WRITE,.-1 ;COUNT (WRITE)\r
385         JUMPG WRITE,DUMP        ;D MEANS GO DUMP ON MAG TAPE\r
386         >\r
387 \r
388         CAIN CH,"G"-40  ;GO TO PROGRAM?\r
389         JRST @SADR      ;YES. JUMP OUT\r
390         CAIN CH,"F"-40  ;FILE DIR PRINT?\r
391         JRST FDIR       ;YES. PRINT FILE DIR OF THIS TAPE\r
392         CAIN CH,"Z"-40  ;ZERO DIRECTORY?\r
393         JRST ZDIR       ;DISPATCH\r
394         CAILE CH,27     ;SKIP IF OCTAL NUMBER\r
395         JRST TYI        ;NO. GO PROCESS FILE NAME\r
396         LSH B,3 ;CONVERT SIXBIT TO OCTAL\r
397         LSHC F,3        ;F+1=B\r
398         JUMPN B,.-2     ;MAY BE MORE THAN 1 DIGIT (START ADR)\r
399         CAILE F,7       ;SKIP IF ONE DIGIT\r
400         JRA D,JBLK      ;D:=SADR. DISPATCH TO JBLK WHICH SAVES SADR.\r
401 OPNTP:                  ;SHIFT UNIT NUMBER LEFT FOR CONO\r
402 IFE MODE,<LSH F,11>\r
403 IFN MODE,<LSH F,3>\r
404         HRRM F,TAPENO   ;SAVE IN CORE\r
405 CLSTP:  MOVEI BLKNO,^D100       ;BLK NO OF FILE DIR\r
406         SETZI PNTR,0    ;DONT CLOBBER DIRECTORY BYTE\r
407         JSP P,RBLK      ;MOVE TO BLOCK 100\r
408         JFCL TAB+200(E) ;READ OR WRITE DIR TAB AS DETERMINED BY WRITE\r
409         AOJL E,UWAIT1   ;COUNT THE 200 WORDS\r
410         JRST BEG        ;GO ASK FOR NEXT COMMAND\r
411 \r
412 ZDIR:   MOVE A,[XWD FOOF,TAB]   ;FOOF IS CLEAR\r
413         BLT A,TAB+176   ;CLEAR DIRECTORY, EXCEPT LAST WORD FOR ID\r
414         MOVSI A,(36B4+36B9)     ;RESERVE BLOCKS 1 & 2\r
415         MOVEM A,TAB     ;IN DIRECTORY\r
416         MOVSI A,(36B9)\r
417         MOVEM A,TAB+16  ;BLK 100 (DIR) IS RESERVED TOO\r
418         HRLOI A,7       ;AND BLOCKS >1100 ARE EOT\r
419         MOVEM A,TAB+122 ;END OF BYTE TAB\r
420         AOJA WRITE,CLS1 ;SET WRITE TO OUTPUT\r
421                                 ;AND DUMP BLK 100.\r
422 \fFDIR:  MOVNI FILN,26   ;26 FILES (OCTAL)\r
423 FD2:    JSP P,CRR       ;CR-LF\r
424 FD3:    SKIPN C,TAB+123+26(FILN)        ;FIRST WORD OF NAME. IS IT BLANK?\r
425         AOJA C,FD1      ;YES. SET C=1 AND LOOP\r
426         JSP G,SIXBP     ;PRINT FIRST WORD AND A SPACE\r
427         HLLZ C,TAB+151+26(FILN) ;SECOND WORD OF FILE NAME\r
428         JSP G,SIXBP     ;PRINT AND CLEAR C\r
429 FD1:    AOJL FILN,FD2(C)        ;CAN JUMP TO FD2 OR FD3. COUNT FILES.\r
430         JRST BEG        ;ALL FILES PRINTED OR BLANK. RETURN.\r
431 \r
432 SIXBP:  MOVEI B,7       ;SIXBP PRINTS C(C) IN 6BIT\r
433                         ;AND ADDS A TRAILING SPACE\r
434                         ;AND LEAVES (C)=0\r
435 \r
436 TAPENO:                 ;USE ADR AS TEMP FOR CURRENT UNIT\r
437 SIXBP1: SETZI A,.-.     ;CLEAR A\r
438         LSHC A,6\r
439         ADDI A,40       ;SIXBIT TO ASCII\r
440         JSP P,TYO       ;TYPE OUT CHARACTER\r
441         SOJG B,SIXBP1   ;LOOP IF MORE CHARACTERS\r
442         JRST 0(G)       ;RETURN\r
443 \r
444 SPNT:   0               ;POINTER TO HEADERS IN CORE.\r
445 \r
446         LIT\r
447 \r
448 \r
449 IFN MAGT,<\r
450 SLOP:   MOVE    .+3\r
451         MOVEM   COMPTR\r
452         JRST    BEGR+1\r
453         XWD     440700,.+1\r
454         BYTE    (7) "0",33,177\r
455 LAST:   JRST    SLOP\r
456         >\r
457 IFE MAGT,<\r
458         SLOP=COMPTR-17-.        ;THIS MANY WORDS BEFORE RESERVED AREA\r
459                                 ;FOR COMMAND STRINGS.\r
460 ;!!!!!  NOTE: ABOVE PARAMETER MUST COME OUT POSITIVE IN\r
461 ;       ORDER TO MEET THE DOCUMENTATION OF RESERVED COMMAND STRING AREA.\r
462 ;\r
463 ;       THIS MEANS ANY CODE ADDED MUST BE COMPENSATED FOR BY\r
464 ;       A CORRESPONDING TIGHTENING SOMEWHERE. GOOD LUCK.\r
465 ;       TENDMP IS VERY TIGHT ALREADY.\r
466         >\r
467 \r
468         END BEGR\r
469 \f