software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape6 / MCPIP.PA
CommitLineData
7af5ad59
PH
1/7 OS/8 MCPIP MAGTAPE AND CASSETTE PIP
2/
3/
4/
5/
6/
7/
8/
9/
10/
11/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
12/
13/
14/
15/
16/
17/
18/
19/
20/
21/
22/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
23/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
24/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
25/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
26/
27/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
28/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
29/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
30/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
31/
32/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
33/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
34/DIGITAL.
35/
36/
37/
38/
39/
40/
41/
42/
43/
44/
45\f
46/ S.R.
47
48/ REVISED FEB. 11, 1974
49/ SECOND REVISION: 7-AUG-75
50
51
52/1. INSTALLED PATCH SEQ #1 , SEPT. 1974 DSN
53/ (NOW TRANSFERS LAST 2 BYTES CORRECTLY IN IMAGE MODE)
54/2. BUMPED VERSION NUMBER TO V5
55/3. FIXED /L BUG IF DEVICE NOT MAGTAPE OR CASSETTE
56
57 KCLR=6700 /CLEAR ALL
58 /CLEAR STATUS A AND B REGISTERS.
59 KSDR=6701 /SKIP ON DATA FLAG
60 KSEN=6702 /SKIP ON ERROR
61 KSBF=6703 /SKIP ON READY FLAG
62 KLSA=6704 /LOAD STATUS A FROM AC 4-11
63 /CLEAR AC, THEN
64 /LOAD 8 BIT COMPLEMENT OF STATUS A
65 /BACK INTO AC
66 KSAF=6705 /SKIP ON ANY FLAG OR ERROR
67 KGOA=6706 /ASSERT THE CONTENTS OF STATUS A,
68 /TRANSFER DATA IF READ OR WRITE
69 KRSB=6707 /READ STATUS B INTO AC 4-11
70
71
72 FIXMRI CALL=4400
73 FIXMRI EXIT=5400
74 FIXMRI INCR=2000
75
76/CORE ALLOCATION
77
78/00000-01777 COMMAND DECODER
79/02000-02377 OUTPUT HANDLER
80/02400-02777 INPUT HANDLER
81/03000-03777 CASSETTE OUTPUT BUFFER
82/04000-04777 CASSETTE INPUT BUFFER
83/05000-05577 STAND ALONE CASSETTE HANDLER
84/05600-07577 LOOKUP, ENTER, CLOSE
85/07600-07777 OS/8
86
87/10000-11777 USR
88/12000-14577 PIPC
89/14600-17577 OS/8 INPUT/OUTPUT BUFFER
90/17600-17777 OS/8
91\f/USR HAS THE FOLLOWING FREE LOCATIONS:
92/0-6
93/10-17 (BUT GET DESTROYED)
94/20-37
95
96 TEMP=20
97 TEMP1=21
98 TEMP2=22
99 TEMP3=23
100
101/ STARTING ADDRESS = 12000
102/ JOB STATUS WORD = 6003
103
104 INHAND=2400
105 OUTHAND=2000
106 COBUF=3000
107 CIBUF=4000
108
109 PIPVERSION=6
110 PATCHLEV=77&"A
111
112 SPCODE=6
113 CLCODE=0
114 REWCOD=1
115 FICODE=3
116 EOCODE=5
117 RECCOD=2
118\f/V3 CHANGES:
119
120/1. SHRUNK 0S/8 BUFFER TO 3000 WORDS
121/2. ADDED VERSION NUMBER (/V)
122/3. MADE INDEPENDENT OF MAGIC LOCATIONS IN CASSETTE HANDLER
123/4. ADDED MAGTAPE SUPPORT OF CASSETTE FILE STRUCTURE
124/5. ALTMODE MEANS RETURN TO KBM
125/6. ^C DOESN'T CLOSE CASSETTES UNLESS WE ALREADY WROTE ON IT
126/7. FIXED BUG THAT CSA2 THRU CSA7 DIDN'T WORK
127/8. CR ALONE TO CD GIVES NO ERROR MESSAGE
128/9. ADDED ^O AND ^C SUPPORT TO MESSAGE PRINTOUT
129/10. GIVE ERRORS ON ILLEGAL * OR ? IN NAME
130/11. USES TTY: AS DEFAULT OUTPUT DEVICE ON /L
131
132/PROPOSED:
133/8. ALLOW *.* FOR CASSETTE INPUT
134/9. SUPPORT OF UNLABELED MAGTAPE STANDARD
135/10. /7 OR /9 SPECIFIES CHANNEL
136
137/FIXES SINCE FIELD TEST :
138
139/1. ^C ALWAYS BRINGS YOU BACK TO KBM
140/2. FIXED BUG RE CHECK FOR FILE FULL
141/3. MADE COMPATIBLE WITH NEW TM8E HANDLER
142/4. TIME-OUT ON CASSETTE READ
143/5. BE NICE-GUY IF OS/8 LOOKUP FAILURE
144\f/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
145/AND READY.
146/THE NEW UNIT NUMBER (0-7) IS IN THE AC.
147/THE UNIT NUMBER IS IN BITS 8-11 OF THE AC.
148/RETURN 1 IS MADE IF THE UNIT IS NOT READY.
149/CINUSE IS SET TO 1.
150/THE HANDLER MUST NOT ALREADY BE IN USE.
151/THE DATA FIELD IS INTERROGATED
152/AND A RETURN CIF CDF IS BUILT
153/AND STORED IN LOCATION RETCIF
154
155\f *5000
156
157FIXDVC, 0
158 DCA DVC
159 RDF
160 TAD (CIF CDF
161 CDF 0
162 DCA TMP
163 TAD I FIXDVC
164 DCA ERRET
165 ISZ FIXDVC
166 TAD TMP
167 DCA I ERRET
168 TAD DVC
169 SNA
170 JMP CHECKR
171 RAR /MOVE UNIT TO LINK; DEVICE TO AC
172 AND (3 /MASK OFF DEVICE CODE
173 DCA DVC /SAVE DEVICE CODE
174 SZL
175 TAD (100
176 DCA I (ABUNIT /SET UNIT IN BIT 5
177 TAD DVC
178 CLL RTL
179 RAL /UGLY
180 DCA DVC /MOVE TO BITS 6-8
181 TAD (IOTBL
182 DCA IOTPTR
183IOTLOOP,TAD I IOTPTR
184 SNA /END OF TABLE?
185 JMP CHECKR /YES
186 DCA TMP
187 TAD I TMP
188 AND (7707 /MASK OUT OLD DVC
189 TAD DVC /INSERT NEW ONE
190 DCA I TMP /REPLACE
191 ISZ IOTPTR /POINT TO NEXT ONE
192 JMP IOTLOOP
193
194TMP, 0
195DVC, 0 /DEVICE CODE
196IOTPTR, 0
197\fCHECKR, JMS I (CLEAR
198 TAD (200
199 JMS I (LOADA /SELECT DRIVE
200 JMS I (CHECKB
201 AND (7735 /IGNORE EOT/BOT FLAG
202 /AND WLO
203 TAD (-1
204 SZA CLA
205 JMP I ERRET /NOT READY
206 ISZ I (CINUSE
207 JMP I FIXDVC
208
209ERRET, 0 /ERROR RETURN LOCATION
210\fFIDDLE, 0
211 CIF 10
212 JMS I (FID2 /NEED ROOM
213 TAD (CIBUF+11
214 DCA 10
215 TAD FAST
216 SZA CLA
217 JMP DIREOL
218 TAD (40
219 DCA I 10
220 TAD I (CIBUF+20
221 DCA I 10
222 TAD I (CIBUF+20
223 AND (177
224 SZA
225 TAD (-40
226 SZA CLA
227 TAD ("/-40
228 TAD (40
229 DCA SLSH
230 TAD I (CIBUF+21
231 DCA I 10
232 TAD SLSH
233 DCA I 10
234 INCR 10
235 INCR 10
236 TAD SLSH
237 DCA I 10
238 TAD I (CIBUF+22
239 DCA I 10
240 TAD I (CIBUF+23
241 DCA I 10
242DIREOL, TAD (15
243 DCA I 10
244 TAD (12
245 DCA I 10
246 TAD (32
247 DCA I 10
248FIDLV, EXIT FIDDLE
249
250/0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 17 20 21 22 23 24 25
251/F I L E N A M E S D D M M Y Y
252/F I L E N A . M E S M M / D D / Y Y CR LF ^Z
253
254FAST, 0 /0 MEANS F NOT SPECIFIED
255\fSLSH, "/
256
257IOTBL, IOT0
258 IOT1
259 IOT4
260 IOT5
261 IOT6
262 IOT6C
263 IOT7
264 0
265 PAGE
266\fUTIL, 0
267 DCA TEMPU
268 DCA REWSW /ZERO REWIND SWITCH
269 TAD I UTIL
270 TAD (-10
271 SNA
272 ISZ REWSW
273 ISZ UTIL
274 TAD (210
275 DCA TEMPFN
276 TAD TEMPU
277 JMS I (FIXDVC /FIX DEVICE CODE
278 UTEND /UNIT NOT READY
279 TAD (UT
280 DCA CRET /SET RETURN ADDRESS
281 STA
282 DCA I (RW /NOTE FACT THAT OP AINT READ
283 TAD TEMPFN
284 JMS I (LOADA
285 JMS GO /INITIATE UTIL
286 JMP CRET+1
287 ISZ UTIL
288UTEND, HLT
289 JMP I UTIL
290UT, JMS CHECKB /LOOK AT STATUS B
291 AND (50 /CHECK FOR CL, EMPTY, OR WLO
292 /GIVE NO ERROR ON WLO ************
293 /BAD FOR WRGAP
294 SNA
295 JMP OK /NO ERRORS
296 TAD (-40
297 SZA CLA
298 JMP NOTOK /ERROR NOT CL
299 TAD REWSW
300 SNA CLA /CL OK IF DID REWIND
301NOTOK, STA
302OK, JMS CLEAR
303 TAD CINUSE
304 SMA CLA
305 JMP UTEND-1
306 TAD BSTATE /ERROR
307 JMP UTEND
308
309TEMPU, 0
310TEMPFN, 0
311REWSW, 0 /1 MEANS OPERATION IS REWIND
312\fCHECKB, 0
313IOT7, KRSB /READ STATUS B INTO AC 4-11
314 DCA BSTATE /SAVE STATUS B
315 TAD BSTATE
316 JMP I CHECKB
317
318CLEAR, 0
319 DCA CINUSE /LEAVE STATUS CONDITION IN AC; -1 MEANS ERROR
320IOT0, KCLR /CLEAR STATUS A AND B
321 JMP I CLEAR
322
323GO, 0
324IOT6, KGOA /ASSERT CONTENTS OF STATUS A
325 CLA
326 JMP I GO
327
328CHK, 0
329 JMS I (CHECKB
330 AND (374
331IOT1, KSDR
332 SKP /DATA FLAG NOT UP -
333 JMP I CHK
334 TAD (-20
335 SNA CLA /IS IT END OF FILE?
336 JMP I (ERRR /YES, ERROR - BUT DON'T RETRY
337 TAD BSTATE
338 JMP I CHK
339
340CINUSE, 0 /1 MEANS HANDLER IN USE
341BSTATE, 0 /STATUS OF REGISTER B ON ERROR
342\fDTEM, 0
343
344DOPTION,JMS I (CONVRT
345 7601
346 DCA DTEM
347 TAD I (OUNIT
348 JMS I (LOOKUP
349 JMP I (XER4
350 JMP MBNF /NOT FOUND
351 INCR DTEM
352 JMS I (DELET
353 JMP I (XER77 /OUTPUT ERROR
354MBNF, TAD DTEM
355 SNA CLA /ANYTHING DELETED?
356 JMP I (XER24 /NO
357 JMS UTIL
358 REWIND
359 CLA
360 CIF CDF 10 /YES
361 JMP I (DECODE
362\fCRET, 0
363 CDF 0
364 TAD (-200 /COUNT OF HOW LONG TO WAIT
365 DCA I (OUTER
366IOL, JMS I (CTRLC
367 JMS I (TIMEOUT
368IOT5, KSAF
369 JMP IOL
370 EXIT CRET
371 PAGE
372\fHANDLER,0
373 DCA TUN
374 TAD I HANDLER /GET FUNCTION CONTROL WORD
375 AND L70 /ISOLATE FIELD OF BUFFER
376 TAD LCDF
377 DCA WCDF
378 TAD I HANDLER /RETRIEVE FUNCTION CONTROL WORD
379 RAL /READ/WRITE BIT TO LINK
380 CLA RAL
381 DCA RW /RW=1 IF WRITE
382 ISZ HANDLER /POINT TO BUFFER ADDRESS
383 TAD I HANDLER /GET BUFFER ADDRESS
384 DCA BUFFER /SAVE IT
385 ISZ HANDLER /POINT TO ERROR RETURN
386 TAD TUN
387 JMS I (FIXDVC
388 LV /NOT READY
389 TAD WCDF
390 DCA BFIELD
391 TAD WCDF
392 DCA BFLD
393 STA CLL RTL /TAD (-3
394 DCA ERKNT
395 JMS SETUP /SET UP READ OR WRITE
396 JMP I (CRET+1
397 ISZ HANDLER /POINT TO GOOD RETURN
398LV, HLT
399 JMP I HANDLER
400RW, 0 /1 IF WRITE (-1 IF UTIL)
401ERKNT, -3
402\fSETUP, 0
403 TAD RW
404 TAD (WRITEX
405 DCA I (CRET /SET RETURN ADDRESS
406 TAD BUFFER
407 DCA BPTR
408 TAD BSIZE
409 CMA /WANT TO READ ONE MORE
410 TAD RW
411 DCA BKNT
412 TAD RW
413 DCA OUTSW
414 TAD RW
415 CLL RTL
416 RTL /WRITE FN CODE=20
417 TAD (200 /SELECT AND INTERRUPT ENABLE
418 JMS I (LOADA
419WCDF, HLT
420 TAD RW
421 SZA CLA
422 TAD I BPTR
423LCDF, CDF 0
424 JMS I (GO
425 JMP I SETUP
426
427\fREADX, JMS I (CHK
428 AND L374
429 SZA
430 JMP ERRX
431IOT6C, KGOA /GET CHAR JUST READ
432 DCA BYTE
433 ISZ BKNT
434 SKP
435 JMP RWCRC
436BMODE, TAD BYTE
437TUN,
438BFLD, HLT
439 DCA I BPTR
440 ISZ BPTR
441L374, 374
442 JMP I (CRET+1 /CRET ALREADY SET UP
443
444BSIZE, 200
445OUTSW, 0 /1 MEANS WE BEGAN TO WRITE
446\fRWCRC, TAD (260 /ENABLE, ENABLE INTER, READ CRC
447 JMS I (LOADA
448 JMS I (GO
449 JMS I (CRET
450 JMS I (CHK
451CRCMN, JMS I (GO
452 JMS I (CRET
453 JMS I (CHECKB
454 AND (7775 /IGNORE WLO
455 TAD (-1
456ERRX, SNA CLA /ERRORS?
457 JMP ERRR+1 /NO - CLEAN BILL OF HEALTH
458 ISZ ERKNT /TRY 3 TIMES
459 JMP I (ERRCOV /RETRY
460ERRR, STA /ERROR WHILE READING CRC
461 JMS I (CLEAR
462 TAD I (CINUSE
463 SMA CLA
464 JMP LV-1
465 TAD I (BSTATE
466 JMP LV
467\fWRITEX, JMP READX
468 JMS I (CHK
469 SZA
470 JMP ERRX
471 ISZ BKNT
472 SKP
473 JMP WCRC
474BFIELD, HLT
475 ISZ BPTR
476L70, 70
477 TAD I BPTR
478 JMS I (GO
479 JMP I (CRET+1
480
481
482WCRC, TAD (260
483 JMS I (LOADA
484 JMP CRCMN
485BKNT, 0 /NUMBER OF CHARS EXPECTED
486BPTR, 0 /NEXT LOCATION IN BUFFER TO STORE INTO
487BYTE, 0 /TEMPORARILY HOLDS BYTE FOUND
488BUFFER, 0
489 PAGE
490\f/ LOOKUP, ETC.
491
492 F1=10
493 READ=0
494 WRITE=4000
495
496 REWIND=10
497 BACKFIL=30
498 WRGAP=40
499 BACKBLOCK=50
500 SKPFIL=70
501
502 HSIZE=40
503 OBUFFER=4600 /LOCATION OF OS/8 I/O BUFFER
504 BINBUF=OBUFFER
505 OBUFLEN=3000
506 HOBUFLEN=OBUFLEN%2
507 MAXBLK=OBUFLEN%400
508
509FILNUM, 0
510/ ENTER
511
512/ TAD UNIT
513/ JMS I (ENTER
514/ <ERROR RETURN>
515/ <NORMAL RETURN>
516
517/ ENTER FILENAME AS SPECIFIED IN SINCH
518/ USER MUST SET SINCH BUT ONLY FIRST 25 (OCTAL) LOCATIONS.
519
520ENTER, 0
521 JMS I (LOOKUP
522 JMP ERET /ERROR WHILE READING
523 JMP NTF
524 JMS I (DELET
525 JMP ERET /ERROR WHILE DELETING
526NTF, JMS BACK
527 JMP ERET /ERROR BACKING UP
528 JMS I QH1 /WRITE NEW HEADER
529 WRITE
530 SINCH
531 JMP ERET /CASSETTE NOT READY
532 TAD I (RECSIZ
533 DCA I (BSIZE
534 INCR ENTER
535ERET, EXIT ENTER
536
537RDOR, 0
538 AND (374 /CASSETTE ONLY
539 TAD (-200
540 SZA CLA /WAS ERROR JUST CRC?
541 EXIT BACK /NO
542 EXIT RDOR /YES, OK CONTINUE
543\fBACK, 0
544BK4, JMS I QU1
545BK2, BACKFIL /GO BACK TO FILE GAP
546 EXIT BACK
547BK3, JMS I QU1
548 BACKBLOCK /BACK TO LAST RECORD
549 JMP BKERR
550 TAD I (RECSIZ
551 DCA I (BSIZE
552 JMS I QH1 /READ LAST RECORD OF PREV FILE
553 READ+F1 /DON'T STORE IN BUFFER
554 BINBUF
555 JMS RDOR /^*******
556 /ERROR READING LAST BLOCK
557NEWGAP, JMS I QU1
558 WRGAP /WRITE A NEW GAP
559 EXIT BACK
560BK9, TAD (HSIZE
561 DCA I (BSIZE
562 INCR BACK
563 EXIT BACK
564
565BKERR, AND (3775 /CASSETTES ONLY
566 TAD (-41
567 SZA CLA /WAS ERROR CLEAR LEADER?
568 EXIT BACK
569 JMP NEWGAP
570
571BK1, JMP BK9
572
573/FOR MAGTAPES:
574
575/BK2_BACKBLOCK
576/BK3_BK1
577\fCLOSE, 0
578 JMS I QU1
579 WRGAP
580 JMP CLRET /ERROR WHILE WRITING GAP
581 TAD (HSIZE
582 DCA I (BSIZE
583 JMS I QH1
584 WRITE /WRITE SENTINEL
585 ZER
586 JMP CLRET
587 JMS I QU1
588 REWIND
589 JMP CLRET
590 INCR CLOSE /SKIP ERROR RETURN
591CLRET, EXIT CLOSE
592\fCRED, 0
593 TAD I (INRECSZ
594 DCA I (BSIZE
595 TAD I (IUNIT
596 JMS I QH1
597 READ
598 CIBUF
599 JMP INER
600 TAD (CIBUF
601 DCA I (CIPTR
602 TAD I (INRECSZ
603 CIA
604 DCA I (CIKNT
605/ CLA IAC
606/ DCA DATAFLG
607 EXIT CRED
608INER, AND EOFBIT
609 SZA CLA /REAL ERROR?
610 JMP I (XER4 /YES
611/ TAD DATAFLG
612/ SNA CLA /READ ANY DATA?
613/ JMP INTO /NO REWIND
614/ DCA DATAFLG /YES, COULD CLOSE OUTPUT AND OPEN NEXT INPUT
615INTO, CLA
616 TAD I (IUNIT
617 JMS I QU1
618 REWIND
619 CLA
620 TAD I (BIPTR
621 CIF CDF 10 /NO, MERELY END-OF-FILE
622 TAD (-OBUFFER+377
623 CLL RTL
624 RTL
625 RAL
626 AND (17
627 DCA I (INTEN /NUMBER OF BLOCKS GOT
628 JMP I (XFIN
629
630LOADA, 0
631 TAD ABUNIT
632IOT4, KLSA
633 CLA
634 JMP I LOADA
635
636EOFBIT, 254 /CHANGED TO 3673 FOR MAGTAPE
637/DATAFLG,0 /1 MEANS READ DATA
638\fQU1, UTIL
639QH1, HANDLER
640ABUNIT, 0
641 PAGE
642\f
643/ LOOKUP
644
645/ TAD UNIT
646/ JMS I (LOOKUP
647/ I/O ERROR RETURN
648/ <NOT FOUND RETURN>
649/ <FOUND RETURN>
650/ ALWAYS LOOKS FOR THING SPECIFIED IN SINCH
651
652LOOKUP, 0
653 DCA P1
654 CDF 10
655 TAD I (7644
656 CDF 0
657 AND (10 /IS /U SPECIFIED?
658 SZA CLA
659 JMP GOODRT /YES, DO NOTHING
660 TAD P1
661 JMS I QU2
662 REWIND
663 JMP ERRIT
664 TAD (HSIZE /SET LENGTH OF RECORD HEADER
665 DCA I (BSIZE
666 DCA I (FILNUM
667FL1, JMP FL2 /ZERO THIS LOCATION FOR MAGTAPES
668FLOOP, JMS I QU2
669 SKPFIL
670 JMP ERRIT
671FL2, INCR I (FILNUM
672 JMS I QH2
673 READ
674 INCH
675 JMP ERRIT
676 TAD (INCH
677 DCA P1
678 TAD I P1
679 SNA CLA /SENTINEL FILE?
680 JMP NFNDRET /YES, NOT FOUND
681 TAD (SINCH /NO, IS THIS THE ONE WANTED?
682 DCA P2
683 TAD (-10
684 DCA SCNT
685\fSLOOP, TAD I P1
686 CIA
687 TAD I P2
688 AND (177 /ONLY LAST 7 BITS NEED MATCH
689 SZA CLA
690 JMP FLOOP /FILE KEY NOT ONE DESIRED
691 INCR P1
692 INCR P2
693 ISZ SCNT
694 JMP SLOOP
695GOODRT, INCR LOOKUP /SKIP NOT FOUND RETURN
696NFNDRET,INCR LOOKUP /SKIP ERROR RETURN
697ERRIT, CLA
698 TAD I (RECSIZ
699 DCA I (BSIZE /BE NICE TO USER
700LRET, EXIT LOOKUP /BYE-BYE
701
702ERRT, AND EOTBIT /REAL ERROR?
703 SZA CLA
704 JMP ERRIT /YES
705 JMP NFNDRET /NO, MERELY END-OF CASSETTE
706
707/END OF CASSETTD IS SIGNALLED BY
708
709/A SENTINEL FILE
710/B DOUBLE FILE GAP
711/C EOT
712
713EOTBIT, 314 /CHANGE TO 3663 FOR MAGTAPE
714\fP1, 0
715P2, 0
716SCNT, 0
717DELET, 0
718 JMS I (BACK
719 EXIT DELET
720 JMS I QH2 /WRITE EMPTY HEADER
721 WRITE+10
722 EMPTINCH
723 EXIT DELET /ERROR WHILE DELETING
724 CLL STA RAL /-2
725 TAD LOOKUP
726 DCA LOOKUP
727 JMP FLOOP /JUMP INTO LOOKUP TO CONTINUE
728ZER, 0
729
730QH2, HANDLER
731QU2, UTIL
732FL3, JMP FL2
733\fERRCOV, JMS I (CLEAR
734 JMS I (CTRLC
735 TAD (250
736 JMS I (LOADA
737 JMS I (GO /BACKSPACE BLOCK
738 JMS I (CRET /WAIT
739 JMS I (CHECKB
740 AND (374 /KILL WRITE-LOCK BIT
741 SZA CLA
742 JMP I (ERRR
743 JMS I (SETUP /RE-SET UP OPERATION
744 JMP I (CRET+1 /GO AWAY
745\fTIMEOUT,0
746 ISZ INNER
747 JMP I TIMEOUT
748 ISZ OUTER
749 JMP I TIMEOUT
750 TAD I (RW / I/O HAS TAKEN A LOT OF TIME
751 SZA CLA /IS IT A READ OP?
752 JMP I TIMEOUT /NO, RETURN
753 JMP I (ERRR /YES, ERROR
754
755INNER, 0
756OUTER, -200
757 PAGE
758\f/SEND CONTENTS OF OS/8 BUFFER TO CASSETTE
759/VIA CASSETTE OUTPUT BUFFER
760
761CWRITE, 0
762 TAD (OBUFFER
763 DCA BUPTR /PT TO BEGIN OF BUFFER
764 CDF 10
765 TAD I (INTEN /GET NO. OF BLOCKS READ
766 SNA
767 JMP CWLV
768 CDF 0
769 CLL RTR
770 RTR
771 RAR /CONVERT TO WORDS
772 IAC
773 AND (7776 /ROUND UP TO EVEN NO.
774 CLL RAR /DIVIDE BY TWO
775 CIA /USE AS COUNT OF DOUBLE-WORDS
776 DCA BUKNT /2000 TWO-WORD ENTRIES
777CWLOOP, CDF 10
778 TAD I BUPTR
779 JMS CWR /SENT TO CASSETTE OUTPUT BUFFER
780 CDF 10
781 TAD I BUPTR
782 AND (7400
783 DCA TEMP1
784 INCR BUPTR /PT TO 2ND HALF
785 TAD I BUPTR
786 JMS CWR
787 CDF 10
788 TAD I BUPTR
789 AND (7400
790 CLL RTR
791 RTR
792 TAD TEMP1
793 RTR
794 RTR
795 JMS CWR
796 INCR BUPTR /PT TO NEXT DOUBLE-WORD
797 ISZ BUKNT /AT END OF BUFFER?
798 JMP CWLOOP /NO
799CWLV, CIF CDF 10
800 EXIT CWRITE /YES, RETURN
801BUPTR, 0 /PTS INTO OBUUFER
802BUKNT, 0
803\f/INSERT CHAR IN CASSETTE OUTPUT BUFFER
804/AND OUTPUT BUFFER IF BUFFER FULL
805
806CWR, 0
807 AND (377
808 CDF 0
809 DCA CWTMP
810 TAD LDRFLG
811 SZA CLA
812 JMS I (LDRTST
813 CDF 10
814 TAD I (7643
815 RTL /PUT /B OPTION IN LINK
816 CDF 0
817 SNL CLA
818 JMP GOK
819 TAD CWTMP
820 TAD M200
821 SNA CLA
822 JMP I (PREFIN
823GOK, TAD CWTMP2
824 JMS CWR2
825 TAD CWTMP1
826 DCA CWTMP2
827 TAD CWTMP
828 DCA CWTMP1
829CWREX, EXIT CWR
830
831CWR2, 0
832 SPA
833 JMP CWRIGN /IGNORE -1
834 CDF 0
835 DCA I COPTR /INSERT CHAR IN COBUF
836 INCR COPTR
837 ISZ COKNT /COBUF FULL?
838 EXIT CWR2 /NO, SO RETURN
839 JMS CWRI
840M200,
841CWRIGN, 7600 /CLA
842 EXIT CWR2
843\fCWRI, 0
844 TAD COKNT
845 TAD RECSIZ
846 SNA CLA
847 EXIT CWRI /DO NOTHING IF BUFFER EMPTY
848 TAD RECSIZ
849 DCA I (BSIZE
850 TAD I (OUNIT
851 JMS I QH3 /YES, WRITE OUT BUFFER
852 WRITE /WRITE FROM FIELD 0
853PCOBUF, COBUF /LOCATION COBUF
854 JMP XER7 /OUTPUT ERROR
855 TAD PCOBUF
856 DCA COPTR /BUFFER IS NOW EMPTY
857 TAD RECSIZ
858 CIA
859 DCA COKNT
860 EXIT CWRI
861
862RECSIZ, 0 /RECORD SIZE ON OUTPUT
863COPTR, COBUF /PTS TO NEXT FREE LOCATION IN COBUF
864COKNT, -1000 /NUMBER OF EMPTY SLOTS LEFT IN COBUF
865
866XER7, CIF CDF 10
867 AND (40
868 SZA CLA /CLEAR LEADER?
869 JMP I (ER5 /YES, DEVICE FULL
870 JMP I (ER7 /OUTPUT ERROR
871XER4, CIF CDF 10
872 JMP I (ER4
873XER8, CIF CDF 10
874 JMP I (ER8
875
876LDRFLG, 0 /NON-ZERO IF IGNORING LEADER
877CWTMP1, -1
878CWTMP2, -1
879CWTMP, 0
880QH3, HANDLER
881 PAGE
882\fPREFIN, TAD (200
883 JMS I (CWR2 /WRITE OUT TRAILER
884 JMP CFIN2 /BUT NO CHECKSUM
885CFIN, TAD I (CWTMP2 /V3C
886 JMS I (CWR2
887 TAD I (CWTMP1 /V3C
888 JMS I (CWR2
889CFIN2, JMS I (CWRI
890 TAD I (OUNIT
891XCLOSE, JMS I (CLOSE
892 JMP I (XER8
893XLV, CIF CDF 10
894 JMP I (DECODE
895\fCTRTEM,
896CREAD, 0
897 TAD (OBUFFER
898 DCA BIPTR
899 TAD (-OBUFLEN
900 DCA BIKNT
901ZRLUP, CDF 10
902 DCA I BIPTR /ZERO BUFFER
903 CLA IAC
904 AND I (7643
905 SZA CLA
906 TAD (DCRE-CRE /GOT L OPTION
907 TAD (CRE
908 CDF 0
909 DCA XCRE /PT TO INPUT SUBR
910 INCR BIPTR
911 ISZ BIKNT
912 JMP ZRLUP
913 TAD (OBUFFER
914 DCA BIPTR
915 TAD (-HOBUFLEN
916 DCA BIKNT /# OF DOUBLE-WORDS
917CRLOOP, JMS I XCRE
918 CDF 10
919 DCA I BIPTR
920 JMS I XCRE
921 DCA TEMP2
922 JMS I XCRE
923 DCA TEMP3
924 CDF 10
925 TAD TEMP3
926 RTL
927 RTL
928 AND (7400
929 TAD I BIPTR
930 DCA I BIPTR
931 INCR BIPTR
932 TAD TEMP3
933 RTR
934 RTR
935 RAR
936 AND (7400
937 TAD TEMP2
938 DCA I BIPTR
939 INCR BIPTR
940 ISZ BIKNT
941 JMP CRLOOP /REITERATE
942 CIF CDF 10
943 TAD (MAXBLK
944 DCA I (INTEN /READ 10 BLOCKS
945 EXIT CREAD /ALL DONE
946\fBIPTR, 0 /PTS INTO OBUFFER
947BIKNT, 0
948XCRE, CRE
949
950CTRLC, 0
951 KSF
952 EXIT CTRLC
953 TAD (7600
954 KRS
955 TAD (-7603
956 SZA CLA
957 EXIT CTRLC
958 JMS I (CLEAR
959 TAD I (OUNIT
960 SPA CLA
961 JMP I (7600
962 TAD I (OUNIT
963 DCA CTRTEM
964 STA
965 DCA I (OUNIT
966 TAD CTRTEM
967 JMS I (CLOSE
968 JMP I (XER8
969 JMP I (7600
970\fLOPTION,TAD I (IUNIT
971 JMS I QU3
972 REWIND
973 JMP I (INER
974 CLA IAC
975 DCA I (CIBUF
976LM1, JMP LM2 /ZERO FOR MAGTAPE
977 JMS I QU3
978 SKPFIL
979 JMP I (INER
980LM2, CIF CDF 10
981 JMP I (CHLOOP
982LM3, JMP LM2
983QU3, UTIL
984 PAGE
985\fCIKNT, -1 /ONE'S COMPLEMENT OF # OF BYTES LEFT IN CIBUF
986CIPTR, CIBUF /PTS TO NEXT BYTE IN CIBUF TO BE READ
987
988CRE, 0
989 CDF 0
990 TAD FTFLG /FIRST TIME THROUGH?
991 SZA CLA
992 JMP FT /YES
993 TAD TLRFLG
994 SNA CLA
995 JMP EPI /TRAILER
996 ISZ CIKNT
997 SKP
998 JMS I (CRED
999 TAD I CIPTR
1000 JMS CHKSUM
1001 JMS CHKTLR
1002 TAD I CIPTR
1003 INCR CIPTR
1004/ AND (377
1005 EXIT CRE
1006
1007
1008/READ DIRECTORY
1009DCRE, 0
1010 CDF 0
1011 ISZ CIKNT
1012 SKP
1013 JMS DCRED
1014 TAD I CIPTR
1015 TAD (-32
1016 SNA
1017 JMP DCRE+1 /ALLOW '32' TO SHORTEN BUFFER
1018 TAD (32
1019 SNA
1020 TAD (232
1021 INCR CIPTR
1022 EXIT DCRE
1023\fFT, DCA FTFLG
1024 TAD (200 /SEND LEADER
1025 EXIT CRE
1026
1027CHKSUM, 0
1028 DCA CHTEM
1029 TAD CHTEM
1030 AND (200
1031 SNA CLA
1032 TAD CHTEM
1033 TAD CHECKSUM
1034 DCA CHECKSUM
1035 EXIT CHKSUM
1036CHTEM, 0
1037CHECKSUM,0
1038FTFLG, 1 /1 IF FIRST TIME HERE
1039CHKPTR, CHKTBL
1040TLRFLG, 0
1041
1042CHKTBL, 0 /CHECKSUM LEFT PART
1043 0 /CHECKSUM RIGHT PART
1044 200 /TRAILER
1045 32 /CTRL/Z
1046 -1 /TABLE END
1047
1048CHKTLR, 0
1049 CDF 10
1050 TAD I (7643
1051 CDF 0
1052 RTL /B SWITCH TO LINK
1053 SNL CLA
1054 EXIT CHKTLR
1055 TAD I CIPTR
1056 TAD (-200
1057 SZA CLA
1058 EXIT CHKTLR
1059 DCA TLRFLG
1060 TAD (CHKTBL
1061 DCA CHKPTR
1062 TAD CHECKSUM
1063 RTR
1064 RTR
1065 RTR
1066 AND (77
1067 DCA CHKTBL
1068 TAD CHECKSUM
1069 AND (77
1070 DCA CHKTBL+1
1071EPI, TAD I CHKPTR
1072 SPA
1073 JMP I (INTO
1074 INCR CHKPTR
1075 EXIT CRE
1076\fDCRED, 0
1077 TAD (40
1078 DCA I (BSIZE
1079 TAD I PCIBUF
1080 SNA CLA
1081 JMP I (INTO
1082 TAD I (IUNIT
1083 JMS I QH4
1084 READ
1085PCIBUF, CIBUF
1086 JMP I (INER
1087 TAD PCIBUF
1088 DCA CIPTR
1089 TAD I CIPTR
1090 SZA CLA
1091 TAD (-23
1092 TAD (-2
1093 DCA CIKNT
1094 JMS I (FIDDLE
1095 TAD I CIPTR
1096 SNA CLA
1097 EXIT DCRED
1098 JMS I QU4
1099 SKPFIL
1100 JMP I (INER
1101 EXIT DCRED
1102
1103QH4, HANDLER
1104QU4, UTIL
1105/THIS WAS VERY UNOPTIMAL ADDING IN MAGTAPE SUPPORT
1106/AFTER THE PROGRAM WAS ALL DONE AND BURIED.
1107/IT COULD HAVE BEEN DONE IN A MUCH BETTER METHOD
1108/IF IT WAS DESIGNED IN BEFORE THE PROGRAM WAS WRITTEN.
1109 PAGE
1110\f/FIRST ARG: PTS TO OS/8 FILENAME IN FIELD 1
1111
1112CONVRT, 0
1113 STA
1114 TAD I CONVRT
1115 DCA ONPTR
1116 INCR CONVRT
1117 TAD (SINCH
1118 DCA CNPTR
1119 TAD (-4
1120 DCA CKNT
1121CONLUP, CDF 10
1122 INCR ONPTR
1123 TAD I ONPTR
1124 CDF 0
1125 RTR
1126 RTR
1127 RTR
1128 JMS CNV
1129 DCA I CNPTR
1130 INCR CNPTR
1131 CDF 10
1132 TAD I ONPTR
1133 CDF 0
1134 JMS CNV
1135 DCA I CNPTR
1136 INCR CNPTR
1137 ISZ CKNT
1138 JMP CONLUP
1139 TAD (40
1140 DCA I CNPTR
1141 CDF 10
1142 TAD I (7643
1143 CDF 0
1144 RTL
1145 SNL CLA
1146 EXIT CONVRT / NOT /B
1147 CDF 10
1148 TAD I (7643
1149 RAL
1150 CLA
1151 TAD I ONPTR
1152 CDF 0
1153 SZA CLA
1154 EXIT CONVRT /EXTENSION SPECIFIED
1155 SZL
1156 EXIT CONVRT / /A
1157 CLL STA RAL
1158 TAD CNPTR
1159 DCA CNPTR
1160 TAD ("B /SET EXTENSION TO .BIN
1161 DCA I CNPTR
1162 INCR CNPTR
1163 TAD ("I
1164 DCA I CNPTR
1165 INCR CNPTR
1166 TAD ("N
1167 DCA I CNPTR
1168 EXIT CONVRT
1169\fCNV, 0
1170 AND (77
1171 SZA /CHANGE 0 TO BLANK
1172 TAD (40
1173 AND (77
1174 TAD (40
1175 EXIT CNV
1176
1177ONPTR, 0
1178CNPTR, 0
1179CKNT, 0
1180
1181LOOK4ME,JMS CONVRT
1182 7606
1183 TAD IUNIT
1184 JMS I (LOOKUP
1185 JMP I (XER4
1186 JMP XER24
1187 TAD I (INCH+12 /GET H.O. INPUT RECORD SIZE
1188 CLL RTR
1189 RTR
1190 RAR
1191 TAD I (INCH+13
1192 DCA INRECSZ
1193 TAD INRECSZ
1194 SNA
1195 JMP XER40 /RECORD SIZE 0
1196 CLL
1197 TAD (-1001
1198 SZL CLA
1199 JMP XER10
1200 CIF CDF 10
1201 JMP I (CHLOOP
1202
1203XER24, CIF CDF 10
1204 JMP I (ER24
1205XER25, CIF CDF 10
1206 JMP I (ER3
1207\fOUNIT, 0
1208IUNIT, 0
1209/IN CASE OF CASSETTES, CONTAINS UNIT (AS CHAR)
1210/IN CASE OF MAGTAPE, CONTAINS HANDLER ENTRY ADDRESS
1211/OUNIT IS -1 DURING A ^C CLOSE
1212/-1 MEANS DON'T CLOSE ON ERROR
1213INRECSZ,200 /RECORD SIZE ON INPUT
1214XER40, CIF CDF 10
1215 JMP I (ER40
1216XER10, CIF CDF 10
1217 JMP I (ER10
1218F1CTRLC,0
1219 JMS I (CTRLC
1220 CIF CDF 10
1221 EXIT F1CTRLC
1222 PAGE
1223\fSINCH, ZBLOCK 16
1224 40;40;40;40;40;40
1225 ZBLOCK 14
1226INCH, ZBLOCK 40
1227
1228LDRTST, 0
1229 TAD I (CWTMP
1230 TAD (-200
1231 SNA CLA /LEADER?
1232 JMP I (CWREX /YES, EXIT CWR
1233 DCA I (LDRFLG /NO
1234 EXIT LDRTST
1235\fENTERO, TAD (COBUF
1236 DCA I (COPTR
1237 JMS I (CONVRT
1238 7601
1239 JMS I (MAKDAT
1240 TAD I (RECSIZ
1241 CLL RTL
1242 RTL
1243 RAL
1244 AND (17
1245 DCA I (SINCH+12
1246 TAD I (RECSIZ
1247 AND (377
1248 DCA I (SINCH+13
1249 CDF 10
1250 TAD I (FILTYP
1251 CDF 0
1252 DCA I (SINCH+11
1253 DCA I (SINCH+14
1254 DCA I (SINCH+15
1255 CDF 10
1256 TAD I (VRSNO
1257 CDF 0
1258 DCA I (SINCH+24
1259 TAD I (OUNIT
1260 JMS I (ENTER
1261 JMP I (XER25
1262 CIF CDF 10
1263 DCA I (OSWITCH
1264 JMP I (CONT1
1265 PAGE
1266\fZOPTION,TAD I (OUNIT
1267 JMS I QU5
1268 REWIND
1269 JMP XER77 /OUTPUT ERROR
1270 CDF 10
1271 TAD I (7601
1272 CDF 0
1273 SNA CLA
1274 JMP NOFILE
1275 JMS I (CONVRT
1276 7601
1277 JMS I (LOOKUP
1278 JMP I (XER4
1279 JMP I (XER24
1280 JMS I QU5
1281 SKPFIL
1282 JMP I (XER24
1283 TAD (40
1284 DCA I (BSIZE
1285 JMS I QH5
1286 READ
1287 INCH
1288 JMP XER77
1289CLO3, JMS I (BACK
1290 JMP XER77
1291 JMS I QH5
1292 WRITE
1293 ZER
1294 JMP XER77
1295NOFILE, JMP I (XCLOSE
1296\fMAKDAT, 0
1297 CDF 10
1298 TAD I (DATE
1299 CDF 0
1300 SNA
1301 JMP SETOBL
1302 DCA SKNT
1303 TAD (SINCH+16
1304 DCA SPTR
1305 TAD SKNT
1306 RTR
1307 RAR
1308 AND (37
1309 JMS TWO /INSERT DAY
1310 TAD SKNT
1311 RTL
1312 RTL
1313 RAL
1314 AND (17
1315 JMS TWO /INSERT MONTH
1316 TAD SKNT
1317 AND (7
1318 TAD (106
1319 JMS TWO /INSERT YEAR
1320 EXIT MAKDAT
1321
1322SETOBL, TAD (-6 /SET DATE TO BLANKS
1323 DCA SKNT
1324 TAD (SINCH+16
1325 DCA SPTR
1326SELOOP, TAD (40
1327 DCA I SPTR
1328 INCR SPTR
1329 ISZ SKNT
1330 JMP SELOOP
1331 EXIT MAKDAT
1332
1333SPTR, 0
1334SKNT, 0
1335TEM2, 0
1336TENS, 0
1337\fTWO, 0
1338 DCA TEM2
1339 TAD (60
1340 DCA TENS
1341 TAD TEM2
1342TWOLUP, TAD (-12
1343 SPA
1344 JMP NEG
1345 INCR TENS
1346 JMP TWOLUP
1347NEG, TAD (72
1348 DCA TEM2
1349 TAD TENS
1350 DCA I SPTR
1351 INCR SPTR
1352 TAD TEM2
1353 DCA I SPTR
1354 INCR SPTR
1355 EXIT TWO
1356
1357XER77, CIF CDF 10
1358 JMP I (ER7 /OUTPUT ERROR
1359
1360QU5, UTIL
1361QH5, HANDLER
1362\fMHANDLER,0 /AC CONTAINS HANDLER ENTRY ADDRESS
1363 CIF 10
1364 JMP I (MHAN /KLUDGEY LINK TO FIELD 1
1365
1366MUTIL, 0 /AC CONTAINS ETC.
1367 CIF 10
1368 JMP I (MUT
1369 PAGE
1370\f FIELD 1
1371
1372 XR=10
1373
1374 *2000
1375
1376START, JMP DEC2 /NORMAL STARTING ADDRESS
1377CHAIN, JMP NODEC /CHAIN STARTING ADDRESS
1378DECODE, STL CLA RAR
1379 AND I (7642
1380 SZA CLA
1381 JMP KBM /RETURN TO KBM ON $
1382/ WOULD BE NICE HERE TO TELL CD/BATCH NOT TO SPOOL
1383DEC2, CALL (200
1384 5 /COMMAND DECODE
1385 5200 /USING SPECIAL MODE
1386NODEC, TAD (OUTHAND+1
1387 DCA ENTR /RESET PTR TO HANDLER LOCATION
1388 STA
1389 DCA I (OSWITCH
1390 JMS I (CHKSW /CHECK FOR SWITCH OPTIONS
1391 CDF 0
1392 DCA I (OUTSW
1393 STA
1394 DCA I (OUNIT
1395 CDF 10
1396 TAD I (7666
1397 DCA I (DATE
1398FET, TAD I (7600 /GET DEVICE NUMBER OF OUTPUT FILE
1399 SNA /WAS ONE SPECIFIED?
1400 JMP NOF /NO - NO OUTPUT FILE
1401 CALL (200
1402 1 /FETCH HANDLER
1403ENTR, OUTHAND+1 /INTO PAGES 2400 AND 2600
1404 /REPLACED BY HANDLER STARTING ADDRESS
1405 JMP I (ER6 /OUTPUT DEVICE DOESN'T EXIST
1406 TAD I (7644
1407 AND (1000
1408 SZA CLA
1409 JMP I (FOXOUT /O SPECIFIED
1410 STL CLA RTR
1411 AND I (7645
1412 TAD I (7601
1413 SNA CLA
1414 JMP NOCAS /NO OUTPUT NAME
1415 TAD (7600
1416 JMS I (CHKNAM
1417 JMP I (STARER /*.*
1418 TAD I (7600
1419 JMS I (TCAS /CASSETTE?
1420 JMP I (FIXOUT /YES
1421 JMP I (FXMOUT /MAGTAPE
1422NOCAS, TAD (7601 /NO
1423 DCA OBLK /GET PTR TO OUTPUT FILE NAME
1424 TAD ENTR
1425 DCA I (OENTRY /STORE AWAY OUTPUT HANDLER ENTRY PT
1426 TAD (OWRITE
1427 DCA PWRITE
1428 TAD (FINIO
1429 DCA I (XFINIO
1430 TAD I (7643
1431 RTL
1432 SNL CLA
1433 JMP NOB
1434 TAD I (7604 /GET EXT
1435 SZA CLA
1436 JMP NOB
1437 TAD (216 /SET TO .BN
1438 DCA I (7604
1439NOB, TAD I (7600 /GET DEVICE NUMBER AGAIN
1440 CALL (200
1441 3 /OPEN OUTPUT FILE
1442OBLK, 7601 /PTS TO OUTPUT FILE NAME
1443 /REPLACED BY STARTING BLOCK NUMBER
1444LEN, 0 /REPLACED BY NEGATIVE OF LENGTH OF OUT AREA
1445 JMP I (ER3 /FILE OPEN ERROR
1446 DCA I (REALEN /ZERO REAL LENGTH
1447 TAD OBLK
1448 DCA I (OBLOCK /SET STARTING BLOCK NUMBER
1449CONT1, JMS I (GETIN
1450/ INITIALIZE INPUT STUFF
1451CHLOOP, CIF CDF 0
1452 JMS I (F1CTRLC
1453 CALL PREAD
1454 CIF CDF 0
1455 JMS I (F1CTRLC
1456 CALL PWRITE
1457 JMP CHLOOP
1458\fPREAD, OREAD
1459PWRITE, OWRITE
1460NOF, STL CLA RTR
1461 AND I (7645
1462 SNA CLA
1463 JMP I (ER1
1464 JMP I (FOXOUT /Z IMPLIES O
1465
1466KBM, CIF CDF 0
1467 JMP I (7605
1468 PAGE
1469\fUDIG, 0
1470
1471GETSWDIG,0
1472 DCA UDIG
1473 TAD I (7645
1474 AND (1774
1475 SNA
1476 EXIT GETSWDIG /NO UNIT
1477 INCR GETSWDIG
1478 RTL
1479 RAL
1480LUDIG, SZL
1481 JMP GOTUD
1482 INCR UDIG
1483 RAL
1484 JMP LUDIG
1485G7600,
1486GOTUD, 7600
1487 TAD UDIG
1488 TAD (60
1489 EXIT GETSWDIG
1490\fFOXOUT, JMS GETSWDIG
1491 JMP I (ER1 /NO OUTPUT UNIT
1492 JMP GOTOU
1493FIXOUT, TAD I (ENTR
1494 JMS I (GETDVC
1495GOTOU, CDF 0
1496 DCA I (OUNIT
1497 CDF 10
1498 JMS I (SETCAS
1499YAHAOU, TAD I (7643
1500 AND (400
1501 SZA CLA
1502 JMP DOPT
1503 STL CLA RTR
1504 AND I (7645
1505 SZA CLA
1506 JMP ZOPT
1507 TAD I G7600
1508 RTR
1509 RTR
1510 AND (377 /ISOLATE FILE TYPE
1511 DCA FILTYP /SAVE IT
1512 JMS I (GETLEN
1513 TAD (CW
1514 DCA I (PWRITE
1515 TAD (CFINIO
1516 DCA I (XFINIO
1517 TAD I (7643
1518 RTL /B TO LINK
1519 SZL CLA
1520 CLA IAC
1521 CIF CDF 0
1522 DCA I (LDRFLG
1523 STA
1524 DCA I (CWTMP1
1525 STA
1526 DCA I (CWTMP2
1527 DCA I (CHECKSUM
1528 JMP I (ENTERO
1529/ RETURN TO CONT1
1530
1531FXMOUT, TAD I (ENTR
1532 CDF 0
1533 DCA I (OUNIT
1534 CDF 10
1535 JMS I (SETMAG
1536 TAD I (ENTR /GET LOCATION OF MAGTAPE HANDLER
1537 JMS SETDEN
1538 JMP YAHAOU
1539\fSETDEN, 0
1540 AND G7600
1541 DCA MTA
1542 TAD I (7644
1543 AND (10
1544 SZA CLA /IS /U SPECIFIED?
1545 IAC /YES, USE DENSITY 3
1546 TAD (2 /NO, USE DENSITY 2
1547 DCA DEN
1548 CDF 0
1549 TAD PARITY
1550 CLL RAR /LINK ON IF PARITY SPECIFIED
1551 SZL
1552 TAD PAR
1553 SNL
1554 TAD I MTA /GET RELATIVE LOC 0
1555 AND (400 /ISOLATE PARITY
1556 TAD DEN /FORCE CORE DUMP MODE
1557 DCA I MTA /STORE BACK DENSITY AND PARITY
1558 CDF 10
1559 JMP I SETDEN
1560\fFILTYP, 0
1561BINTYP, 0 /SET BINARY TYPE - DON'T TOUCH LINK
1562 IAC
1563 IAC
1564 DCA FILTYP
1565 EXIT BINTYP
1566
1567DOPT, CIF CDF 0
1568 JMP I (DOPTION
1569
1570ZOPT, CIF CDF 0
1571 JMP I (ZOPTION
1572
1573MTA, 0 /FIRST LOC OF MAGTAPE HANDLER
1574PARITY, 0 /0 MENAS NOT SPECIFIED, 1 MEANS SPECIFIED PARITY
1575PAR, 0 /0 OR 400 SPECIFYING PARITY
1576DEN, 2 /DENSITY
1577 PAGE
1578\fFID2, 0
1579 TAD I (CIBUF
1580 AND (177 /DF=0
1581 TAD (-52
1582 SNA CLA
1583 JMS EMPTY
1584 TAD I (CIBUF+10
1585 DCA I (CIBUF+11
1586 TAD I (CIBUF+7
1587 DCA I (CIBUF+10
1588 TAD I (CIBUF+6
1589 DCA I (CIBUF+7
1590 TAD (".
1591 DCA I (CIBUF+6
1592 CIF 0
1593 JMP I FID2
1594
1595EMPTY, 0
1596 TAD I (FAST
1597 SNA CLA
1598 JMP I EMPTY
1599 STA
1600 DCA I (CIKNT
1601 TAD (32
1602 DCA I (CIBUF
1603 CIF 0
1604 JMP I (FIDLV
1605\fGETLEN, 0
1606 CLL STA RAR /3777
1607 AND I (7642 /GET H.O. OPTION
1608 DCA VRSNO
1609 TAD I (7646 /GET = OPTION (L.O. 12 BITS)
1610 CLL
1611 TAD (-1001
1612 SZL CLA /LESS THAN 1001?
1613 JMP I (ER10 /NO, ERROR
1614 TAD I (7646 /YES
1615 SNA
1616 TAD (200 /200 IS DEFAULT RECORD SIZE
1617 CDF 0
1618 DCA I (RECSIZ
1619 TAD I (RECSIZ
1620 CIA
1621 DCA I (COKNT
1622 CDF 10
1623 EXIT GETLEN
1624
1625FINIO, JMS I (OWRITE
1626 TAD I (7600 /GET OUTPUT DEVICE NUMBER
1627 CALL (200
1628 4 /CLOSE
1629 7601 /PTR TO FILE NAME
1630REALEN, 0 /LENGTH OF NEW OUTPUT FILE
1631 JMP ER8 /CLOSE ERROR
1632 JMP I (DECODE
1633ER8, JMS I (PRINT
1634 TEXT /?CLOSE ERROR/
1635ER5, JMS I (PRINT
1636 TEXT /?OUTPUT DEVICE FULL/
1637\fER30, JMS I (PRINT
1638 TEXT /?OUT=IN/
1639VRSNO, 0
1640
1641ER6, JMS I (PRINT
1642 TEXT /?FETCH ERROR/
1643ER24, STA
1644 DCA I (SPSWTCH /RETURN FROM PRINT
1645 JMS I (PRINT
1646 TEXT /?FILE NOT FOUND/
1647 ISZ I (FUDSW /FIXUP CASSETTE
1648 JMP I (CLO
1649 PAGE
1650\fOREAD, 0
1651 TAD (MAXBLK
1652 DCA INTEN /TRY TO READ 10 BLOCKS
1653 TAD (MAXBLK^200+10
1654 DCA READSZ
1655 TAD I (7605
1656 AND (17
1657 TAD (7757
1658 DCA TEMP /GET DCB ADDR
1659 TAD I TEMP /GET DCB
1660 AND (1000
1661 SZA CLA
1662 JMP ER4 /INPUT DEVICE IS WRITE-ONLY
1663 TAD I TEMP
1664 SMA CLA
1665 JMP YES /NOT FILE-STRUCTURED
1666 TAD I (INLEN
1667 TAD (MAXBLK
1668 SMA SZA CLA /CAN I READ IN 10 BLOCKS?
1669 JMS SHORT /NO
1670YES, CIF 0 /YES
1671 JMS I IENTRY /CALL INPUT HANDLER
1672READSZ, 2010 /READ 20 PAGES INTO FIELD 1
1673 OBUFFER /LOCATION 4000
1674IBLOCK, 0 /INPUT BLOCK NUMBER
1675 JMP QER4 /INPUT ERROR
1676 TAD IBLOCK
1677 TAD INTEN
1678 DCA IBLOCK /UPDATE BLOCK NUMBER
1679 TAD I (INLEN
1680 TAD INTEN
1681 DCA I (INLEN /UPDATE LENGTH LEFT
1682 TAD INTEN
1683 TAD (-MAXBLK
1684 SZA CLA
1685 JMP XFIN
1686 EXIT OREAD /RETURN
1687INTEN, 10 /NUMBER OF BLOCKS JUST READ
1688XFINIO, FINIO
1689
1690SHORT, 0
1691 TAD I (INLEN /HOW MANY BLOCKS LEFT?
1692 CIA /MAKE POSITIVE
1693 DCA INTEN /THAT'S AS MUCH AS WE CAN READ
1694 TAD INTEN
1695 SNA
1696XFIN, JMP I XFINIO /NO MORE
1697 CLL RTR
1698 RTR
1699 RTR /CONVERT TO PAGES IN BITS 1-5
1700 TAD (10 /ADD IN FIELD 1 BIT
1701 DCA READSZ
1702 EXIT SHORT /RETURN
1703\fIENTRY, 0 /PTS TO INPUT HANDLER ENTRY POINT
1704QER4, SMA CLA
1705 JMP SFIN /NON-FATAL END-OF FILE
1706ER4, JMS I (PRINT
1707 TEXT /?INPUT ERROR/
1708ER26, JMS I (PRINT
1709 TEXT /?TOO MANY FILES/
1710SFIN, TAD (7600
1711 DCA TPTR
1712SLUP, STA
1713 TAD TPTR
1714 DCA TPTR
1715 TAD I TPTR
1716 SNA CLA
1717 JMP SLUP
1718 TAD TPTR
1719 TAD (-OBUFFER+1
1720 SNA
1721 JMP ALLZ
1722 TAD (377 /CHANGED FROM PIPC'S 376
1723 CLL RTL
1724 RTL
1725 RAL
1726 AND (17
1727 DCA INTEN
1728 JMP XFIN
1729ALLZ, CLA IAC
1730 JMP .-3
1731TPTR, 0
1732\fER3, JMS I (PRINT
1733 TEXT /?ENTER ERROR/
1734 PAGE
1735\fGETIN, 0 /OPEN INPUT FILE
1736 DCA DATE
1737 TAD I (7605 /ANY MORE FILES SPECIFIED?
1738 SNA CLA
1739 JMP NOIN /NO
1740 TAD I (7612
1741 SZA CLA
1742 JMP I (ER26 /2ND INPUT FILE IS BAD
1743 TAD (7605
1744 JMS I (CHKNAM
1745 JMP I (STARER /*.*
1746 TAD (7606
1747 DCA IN /SET PTR TO FILE NAME
1748 TAD (INHAND+1
1749 DCA IN3
1750 TAD I (7605 /GET DEVICE NUMBER
1751 CALL (200
1752 1 /FETCH NEW DEVICE HANDLER
1753IN3, INHAND+1 /INTO PAGES 3200 AND 3400
1754 /REPLACED BY ENTRY PT TO INPUT HANDLER
1755 JMP I (ER6 /FETCH ERROR
1756 TAD I (7643
1757 AND (10
1758 SZA CLA
1759 JMP I (FOXIN /I SPECIFIED
1760 CLA IAC /V3C
1761 AND I (7643 /LOOK AT /L OPTION
1762 TAD I (7606
1763 SNA CLA
1764 JMP NOCAS2
1765/IF NO NAME IS GIVEN AND /L IS NOT SPECIFIED, THEN USE
1766/MAGTAPE OR CASSETTE HANDLER AS IS, I.E. AS
1767/A NON-FILE-STRUCTURED OS/8 DRIVER.
1768 TAD I (7605
1769 JMS I (TCAS /CASSETTE?
1770 JMP I (FIXIN /YES
1771 JMP I (FIXMIN /MAGTAPE
1772NOCAS2, CLA IAC
1773 AND I (7643
1774 SZA CLA
1775 JMP ER11 /V3C /L SPECIFIED WHEN DEVICE WAS NOT MAGTAPE OR CASSETTE
1776 TAD (OREAD
1777 DCA I (PREAD
1778 TAD IN3 /GET NEW HANDLER ENTRY PT
1779 DCA I (IENTRY /STORE AWAY
1780 TAD I (7605 /GET DEVICE NUMBER AGAIN
1781 CALL (200
1782 2 /PERFORM A LOOKUP
1783IN, 0 /PTR TO FILE NAME
1784 /REPLACED BY INPUT BLOCK NUMBER
1785IN2, 0 /REPLACED BY NEGATIVE OF INPUT FILE LENGTH
1786 JMP LKERR /LOOKUP ERROR
1787 TAD IN /GET NEW INPUT BLOCK
1788 DCA I (IBLOCK /STORE AWAY
1789 TAD IN2 /GET NEW INPUT FILE LENGTH
1790 DCA INLEN
1791 TAD I (1404 /GET # OF ADDITIONAL WORDS
1792 SNA
1793 JMP NONE
1794 TAD 17
1795 DCA POINTER
1796 TAD I POINTER /GET FILE CREATION DATE
1797 SNA
1798 JMP NONE
1799SETDAT, DCA DATE
1800 EXIT GETIN
1801NONE, TAD I (7666 /USE TODAY'S DATE
1802 JMP SETDAT
1803LKERR, CLA
1804 TAD I (7611
1805 SZA CLA
1806 JMP I (ER24 /FILE NOT FOUND
1807 TAD I (7643 /TRY .BN
1808 RTL
1809 SNL CLA
1810 JMP I (ER24 / NOT /B
1811 TAD (216
1812 DCA I (7611
1813 JMP GETIN+1
1814
1815INLEN, 0
1816DATE, 0 /OS8 DATE OF INPUT FILE
1817POINTER,0
1818
1819NOIN, CLA IAC
1820 AND I (7643
1821 SNA CLA
1822 JMP I (ER21
1823 JMP I (FOXIN / /L SPECIFIED
1824\fER11, JMS I (PRINT /V3C
1825 TEXT /?L OPTION OUT OF CONTEXT/
1826 PAGE
1827\f/ENTER WITH INTEN BLOCKS TO WRITE
1828OWRITE, 0
1829 TAD I (INTEN /HOW MUCH IS THERE TO WRITE?
1830 SNA
1831 EXIT OWRITE /NOTHING
1832 DCA OUTEN /SAVE NUMBER OF BLOCKS TO WRITE
1833 TAD I (7600
1834 AND (17
1835 TAD (7757
1836 DCA TEMP
1837 STL CLA RTR
1838 AND I TEMP
1839 SZA CLA
1840 JMP I (ER7 /OUTPUT DEVICE IS READ-ONLY
1841 TAD OUTEN
1842 CLL RTR
1843 RTR
1844 RTR /CONVERT TO PAGES
1845 TAD (4010 /FIELD 1 (WRITE DIRECTLY FROM INPUT BUFFER)
1846 DCA WRSIZ
1847 TAD I (LEN
1848 SNA CLA
1849 JMP NFS /NON-FILE STRUCTURED
1850 TAD I (REALEN
1851 TAD OUTEN
1852 STL
1853 TAD I (LEN
1854 SNL SZA CLA
1855 JMP I (ER5
1856NFS, CIF 0
1857 JMS I OENTRY /CALL OUTPUT HANDLER
1858WRSIZ, 6010 /WRITE 20 PAGES FROM FIELD 1
1859 OBUFFER /LOCATION 4000
1860OBLOCK, 0 /OUTPUT BLOCK NUMBER
1861 JMP I (ER7 /OUTPUT ERROR
1862 TAD OBLOCK
1863 TAD OUTEN
1864 DCA OBLOCK /UPDATE OUTPUT BLOCK NUMBER
1865 TAD I (REALEN
1866 TAD OUTEN
1867 DCA I (REALEN /UPDATE LENGTH WROTE
1868 EXIT OWRITE
1869
1870OENTRY, 0
1871OUTEN, 0
1872\fFOXIN, JMS I (GETSWDIG
1873 JMP I (ER21
1874 JMP GOTIU
1875FIXIN, TAD I (IN3 /GET INPUT HANDLER ADDRESS
1876 JMS I (GETDVC
1877GOTIU, CDF 0
1878 DCA I (IUNIT
1879 CDF 10
1880 JMS I (SETCAS
1881YAHAIN, CDF 0
1882 TAD I (OUNIT
1883 CIA
1884 TAD I (IUNIT
1885 SNA CLA
1886 JMP I (ER30
1887 STA
1888 DCA I (CIKNT
1889 DCA I (CHECKSUM
1890 CLA IAC
1891 DCA I (TLRFLG
1892 CDF 10
1893 TAD (CR
1894 DCA I (PREAD
1895 TAD I (7643
1896 RTL
1897 CLA RAL
1898 CDF 0
1899 DCA I (FTFLG
1900 CDF 10
1901 JMS I (GETLEN
1902 TAD I (7643
1903 AND (100 / F OPTION?
1904 CDF 0
1905 DCA I (FAST
1906 CDF 10
1907 CLA IAC
1908 AND I (7643
1909 CIF CDF 0
1910 SZA CLA
1911 JMP I (LOPTION
1912 JMP I (LOOK4ME
1913/RETURN TO CHLOOP
1914\fFIXMIN, TAD I (IN3
1915 CDF 0
1916 DCA I (IUNIT
1917 CDF 10
1918 JMS I (SETMAG
1919 TAD I (IN3
1920 JMS I (SETDEN
1921 JMP YAHAIN
1922 PAGE
1923\fPRINT, 0
1924 CLA
1925 CDF 10
1926 DCA CTOFLG /ALLOW ECHOING
1927 JMS CRLF
1928PRLUP, TAD I PRINT
1929 RTR
1930 RTR
1931 RTR
1932 JMS PRIN
1933 TAD I PRINT
1934 JMS PRIN
1935 INCR PRINT
1936 JMP PRLUP
1937
1938PRIN, 0
1939 AND (77
1940 SNA
1941 JMP PRFIN
1942 TAD (240
1943 AND (77
1944 TAD (240
1945 DCA TM
1946 KSF
1947 JMP NOBOTH
1948 TAD (200
1949 KRS
1950 TAD (-203
1951 SNA
1952 JMP KBM2
1953 TAD (203-217
1954 SZA CLA
1955 JMP NOBOTH
1956 TAD ("^
1957 JMS TYPE
1958 TAD ("O
1959 JMS TYPE
1960 JMS CRLF
1961 ISZ CTOFLG
1962NOBOTH, TAD TM
1963 JMS TYPE
1964 EXIT PRIN
1965PRFIN, JMS CRLF
1966 DCA FUDSW
1967 TAD I (SPSWTCH
1968 SNA CLA
1969 JMP CLO
1970 DCA I (SPSWTCH /SWITCH NON-ZERO MEANS RETURN
1971 INCR PRINT /POINT TO RETURN
1972 JMP I PRINT
1973\f/DO A CLOSE IF OUTPUT CASSETTE OPEN
1974CLO, CDF 0
1975 TAD I (OUNIT
1976 CDF 10
1977 SPA CLA
1978 JMP I (DECODE
1979 TAD OSWITCH
1980 SZA CLA
1981 JMP I (DECODE
1982 CDF 0
1983 TAD I (OUTSW
1984 CDF 10
1985 SNA CLA /DID WE WRITE ON OUTPUT CASSETTE?
1986 JMP I (DECODE /NO
1987 CIF CDF 0
1988 TAD I (OUNIT
1989 DCA TEMP
1990 STA
1991 DCA I (OUNIT
1992 TAD FUDSW
1993 SZA CLA
1994 JMP I (CLO3
1995 TAD TEMP
1996 JMP I (XCLOSE
1997OSWITCH,-1 /0 MEANS OUTPUT CASSETTE OPEN
1998
1999KBM2, CIF CDF 0
2000 JMP I L7600 /RETURN TO OS/8
2001
2002FUDSW, 0 /1 MEANS GOT OS/8 LOOKUP FAILURE
2003\fTYPE, 0
2004 DCA TM
2005 TAD CTOFLG
2006 SZA CLA
2007 EXIT TYPE /NOT ECHOING
2008 TAD TM
2009 TLS
2010 TSF
2011 JMP .-1
2012L7600, 7600
2013 EXIT TYPE
2014
2015CRLF, 0
2016 TAD (215
2017 JMS TYPE
2018 TAD (212
2019 JMS TYPE
2020 EXIT CRLF
2021
2022CTOFLG, 0 /1 MEANS DON'T ECHO
2023TM, 0
2024
2025ER7, JMS PRINT
2026 TEXT /?OUTPUT ERROR/
2027
2028CFINIO, CIF CDF 0
2029 JMS I (CWRITE
2030 CIF CDF 0
2031 JMP I (CFIN /FINISH OUTPUT AND WRITE SENTINEL
2032/RETURN TO DECODE
2033 PAGE
2034\fER10, JMS I (PRINT
2035 TEXT /?RECORD SIZE TOO BIG/
2036/ENTRY POINT REL 1: UNIT 1
2037/ENTRY POINT REL 7: UNIT 0
2038
2039GETDVC, 0
2040 IAC
2041 DCA TEMP
2042 STL CLA RTL /2
2043 AND TEMP
2044 RAR
2045 DCA UNIT /DETERMINE IF UNIT 0 OR 1
2046 TAD TEMP
2047 AND (7600
2048 DCA TEMP
2049 CDF 0
2050LOOKIO, ISZ TEMP
2051 TAD I TEMP /SEARCH HANDLER FOR ANY IOT
2052 AND (7700
2053 TAD (-6700
2054 SZA CLA
2055 JMP LOOKIO
2056 TAD I TEMP /GET CASSETETE IOT
2057 CDF 10
2058 AND (30 /V3 BUG FIX FROM V2
2059 CLL RTR
2060 TAD UNIT
2061 TAD (60
2062 EXIT GETDVC /LEAVE IT IN AC
2063
2064UNIT, 0
2065\fCHKNAM, 0 /DON'T ALLOW *'S OR ?'S
2066 DCA XR /IN OUTPUT OR INPUT NAME
2067 TAD I XR
2068 TAD (-5200
2069 SNA
2070 JMP STARNM /ENTIRE NAME IS *
2071 TAD (5200
2072 JMS CHKSTR
2073 TAD I XR
2074 JMS CHKSTR
2075 TAD I XR
2076 JMS CHKSTR
2077 TAD I XR
2078 JMS CHKSTR
2079 ISZ CHKNAM
2080 JMP I CHKNAM /NAME GOOD, RETURN 2
2081
2082CHKSTR, 0
2083 DCA TEM
2084 TAD TEM
2085 CLL RTR
2086 RTR
2087 RTR
2088 JMS CHC
2089 TAD TEM
2090 JMS CHC
2091 JMP I CHKSTR
2092\fCHC, 0
2093 AND (77
2094 TAD (-52
2095 SNA
2096 JMP STARER /* IN NAME
2097 TAD (52-77
2098 SZA CLA
2099 JMP I CHC /OKAY
2100STARER, JMS I (PRINT
2101 TEXT /?ILLEGAL * OR ?/
2102
2103STARNM, ISZ XR
2104 ISZ XR
2105 TAD I XR
2106 TAD (-5200
2107 SZA CLA
2108 JMP STARER /NOT *.*
2109 JMP I CHKNAM /TAKE SPECIAL RETURN ON *.*
2110
2111TEM, 0
2112\fCHKSW, 0 /CHECK SWITCHES
2113 TAD I (7644
2114 AND (4 /CHECK FOR /V
2115 SZA CLA
2116 JMS I (VERSN /PRINT MCPIP VERSION #
2117 TAD I (7644
2118 AND (400 /CHECK FOR /P
2119 /NOTE /P = 400 SAME AS ODD PARITY CODE
2120 SZA
2121 JMP ODDPAR
2122 TAD I (7643
2123 AND (200 /CHECK FOR /E
2124 SZA CLA
2125 JMP EVPAR
2126GOTP, NOP
2127 JMP I CHKSW
2128
2129ODDPAR, /400 IN AC
2130EVPAR, DCA I (PAR
2131 CLA IAC
2132 DCA I (PARITY
2133 JMP GOTP
2134 PAGE
2135\fSPSWTCH,0 /NON-ZERO MEANS RETURN FROM PRINT
2136
2137/RET 1: CASSETTE
2138/RET 2: MAGTAPE
2139/RET 3: NEITHER
2140
2141TCAS, 0
2142 AND (17 /ISOLATE
2143 TAD (7757 /ADD IN BASE OF DCB TABLE
2144 DCA TEMP /TO GET DCB ADDRESS
2145 TAD I TEMP /GET DCB
2146 AND (770 /ISOLATE UNIT TYPE
2147 TAD (-270 /CASSETTE HANDLER TYPE IS 27
2148 SNA
2149 JMP ITSCAS
2150 TAD (270-200
2151 SZA CLA
2152 INCR TCAS /NOTHING SPECIAL
2153 INCR TCAS /MAGTAPE
2154ITSCAS, EXIT TCAS
2155\fVERSN, 0
2156 STA
2157 DCA SPSWTCH /RETURN FROM PRINT
2158 JMS I (PRINT
2159 TEXT \OS/8 MCPIP V\
2160 *.-1
2161 PIPVERSION+60^100+PATCHLEV
2162 0
2163 JMP I VERSN
2164
2165ER1, TAD I (7605
2166 SNA CLA
2167 JMP I (DECODE /NO OUT AND NO IN
2168 CLA IAC
2169 AND I (7643 /WAS /L SPECIFIED?
2170 SZA CLA
2171 JMP SETTY /YES
2172 JMS I (PRINT
2173 TEXT /?NO OUTPUT FILE/
2174ER40, JMS I (PRINT
2175 TEXT /?CANNOT HANDLE VARIABLE-LENGTH RECORDS/
2176\fSETTY, TAD (3100
2177 DCA Y
2178 JMS I (200
2179 12 /INQUIRE
2180TT, 2424
2181Y, 3100 /DEVICE TTY
2182 0
2183 JMP ER99
2184 TAD Y /GET DEVICE NO. OF TTY:
2185 DCA I (7600
2186 JMP I (FET
2187
2188ER99, JMS I (PRINT
2189 TEXT /?TTY DOES NOT EXIST/
2190ER21, JMS I (PRINT
2191 TEXT /?NO INPUT FILE/
2192\fCW, 0
2193 CIF CDF 0
2194 JMS I (CWRITE
2195 EXIT CW
2196
2197CR, 0
2198 CIF CDF 0
2199 JMS I (CREAD
2200 EXIT CR
2201 PAGE
2202\fSETCAS, 0
2203 TAD (UTIL
2204 JMS SETU
2205 TAD (HANDLER
2206 JMS SETH
2207 CDF 0
2208 TAD (BACKFIL
2209 DCA I (BK2
2210 TAD I (BK4
2211 DCA I (BK3
2212 TAD (254
2213 DCA I (EOFBIT
2214 TAD I (FL3
2215 DCA I (FL1
2216 TAD (314
2217 DCA I (EOTBIT
2218 TAD I (LM3
2219 DCA I (LM1
2220 CDF 10
2221 JMP I SETCAS
2222
2223SETMAG, 0
2224 TAD (MUTIL
2225 JMS SETU
2226 TAD (MHANDLER
2227 JMS SETH
2228 CDF 0
2229 TAD (BACKBLOCK
2230 DCA I (BK2
2231 TAD I (BK1
2232 DCA I (BK3
2233 TAD (3673
2234 DCA I (EOFBIT
2235 DCA I (FL1
2236 TAD (3663
2237 DCA I (EOTBIT
2238 DCA I (LM1
2239 CDF 10
2240 JMP I SETMAG
2241\fSETU, 0
2242 DCA SETH
2243 CDF 0
2244 TAD SETH
2245 DCA I (QU1
2246 TAD SETH
2247 DCA I (QU2
2248 TAD SETH
2249 DCA I (QU3
2250 TAD SETH
2251 DCA I (QU4
2252 TAD SETH
2253 DCA I (QU5
2254 CDF 10
2255 JMP I SETU
2256\fSETH, 0
2257 DCA SETU
2258 CDF 0
2259 TAD SETU
2260 DCA I (QH1
2261 TAD SETU
2262 DCA I (QH2
2263 TAD SETU
2264 DCA I (QH3
2265 TAD SETU
2266 DCA I (QH4
2267 TAD SETU
2268 DCA I (QH5
2269 CDF 10
2270 JMP I SETH
2271 PAGE
2272\fMH, 0
2273
2274MHAN, SZA
2275 DCA MENTRY
2276 TAD I (MHANDLER
2277 DCA MH /PICK UP ARGS VIA MH
2278 TAD I MH /GET FN WORD
2279 TAD (SPCODE /ADD SPECIAL CODE
2280 DCA MARG1
2281 ISZ MH
2282 TAD I MH /GET CORE LOC
2283 DCA MARG2
2284 ISZ MH /PT TO ERROR RETURN
2285 TAD I (BSIZE /GET BLOCKSIZE
2286 CIA
2287 DCA MARG3 /STORE NEG
2288 CDF 10
2289 CIF 0
2290 JMS I MENTRY /CALL MAGTAPE HANDLER
2291MARG1, HLT
2292MARG2, HLT
2293MARG3, HLT
2294 SKP /TAKE ERROR RETURN
2295 ISZ MH /NORMAL RETURN
2296 CIF CDF 0
2297 JMP I MH /GO BACK TO FIELD 0
2298
2299MENTRY, 0
2300\fMU, 0
2301
2302MUT, SZA
2303 DCA MENTRY /DF=0
2304 TAD I (MUTIL /PICK UP ARGS
2305 DCA MU /VIA 'MU'
2306 TAD I MU /GET UTILITY FUNCTION
2307 ISZ MU
2308 CDF 10
2309 TAD (-REWIND
2310 SNA
2311 JMP REWT
2312 TAD (REWIND-BACKFIL
2313 SNA
2314 JMP BAKFT
2315 TAD (BACKFIL-WRGAP
2316 SNA
2317 JMP WRGT
2318 TAD (WRGAP-BACKBLOCK
2319 SNA
2320 JMP BAKBT
2321 TAD (BACKBLOCK-SKPFIL
2322 SZA CLA
2323 HLT /IMPOSSIBLE
2324SKPFT, STL CLA RAR /4000=WRITE
2325BAKFT, TAD (WRITE+FICODE-REWCOD
2326REWT, TAD (REWCOD-EOCODE
2327WRGT, TAD (EOCODE-RECCOD-WRITE
2328BAKBT, TAD (RECCOD+WRITE
2329 DCA MRG1
2330 CIF 0
2331 JMS I MENTRY
2332MRG1, HLT
2333MCA, HLT /IRRELEVANT
2334MWC, -1
2335 SKP /ERROR RETURN
2336 ISZ MU
2337 CIF CDF 0
2338 JMP I MU /RETURN
2339\fEMPTINCH,52;105;115;120;124;131;40;40;40;14
2340 0;0;0;0;40;40;40;40;40;40
2341 ZBLOCK 14
2342 PAGE
2343\f *2000
2344 $