projects / pdp8.git / blob
? search:


a85dc26197ca8d614325de9d4a41f1b1609ce349
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape7 / PIP10.PA
1 /2 OS8 PIP10 - PDP-10 CONVERSION PROGRAM V3A
2 /
3 /
4 /
5 /
6 /
7 /
8 /
9 /
10 /
11 /COPYRIGHT (C) 1974,1975 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 DTRB=6772
46 DTLB=6774
47 DTXA=6764
48 DTCA=6762
49 DTRA=6761
50 DTSF=6771
51
52
53 /WRITTEN BY MARK BRAMHALL 1970
54 /MODIFIED FOR TD8E BY R. LARY 1973
55 /DATE 75 PATCH ADDED BY S.R. AFTER 1/5/75
56 /
57 /PIP10 IS A PIP FOR OS8 THAT HANDLES PDP-10 DECTAPES
58 /
59 /COMMAND DECODER RULES:
60 /
61 /*OUTPUT_INPUT,INPUT,...
62 /
63 /OUTPUT IS:
64 / DEV:FILE.EXT[NN]
65 / DEFAULT DEVICE IS DSK:
66 / [NN] IGNORED IF PDP-10 OUTPUT
67 / IF /L OR /F DEFAULT OUTPUT IS TTY:
68 /
69 /INPUT IS:
70 / DEV:FILE.EXT
71 / DEFAULT DEVICE IS DSK:
72 / FOLLOWING DEFAULT DEVICES ARE THE PRECEEDING DEVICE
73 / UP TO NINE (9) INPUT FILES
74 /
75 /OPTIONS ARE:
76 / /L IS LIST DIRECTORY (ONLY VALID IF PDP-10 INPUT)
77 / /F IS SHORT FORM DIRECTORY (ONLY PDP-10 INPUT)
78 / /Z IS ZERO DIRECTORY BEFORE TRANSFER (ONLY IF PDP-10 OUTPUT)
79 / /D IS DELETE OLD OUTPUT FILE BEFORE TRANSFER
80 / /B IS BINARY MODE TRANSFER (I.E. 8 BITS PER 36 BITS)
81 / /I IS IMAGE MODE TRANSFER (I.E. 3 12 BITS PER 36 BITS)
82 / /P IS PRESERVE LINE NUMBERS (DEFAULT IS TO DELETE THEM)
83
84
85 / MAINTENACE RELEASE FIXES:
86
87 /1. DATE 75 STUFF
88 /2. TD8E RELIABILITY IMPROVEMENTS
89 /3. ANSI DATE OUTPUT FORMAT
90 /4. INCORPORATED PATCH BY DAVID HEMBLEN [UNITED AIRCRAFT
91 / RESEARCH LABORATORIES] TO ALLOW WRITING PDP-6
92 / DECTAPES ON A TD8E.
93 \f/COMMAND DECODER SETS UP:
94 /
95 /AT "MOUTPU" THE LIST--
96 / LLL LLL LLD DDD OR UUU 100 000 000
97 / NAME (TRIMMED) NAME (EXCESS 40)
98 / NAME NAME
99 / NAME NAME
100 / EXTENSION EXTENSION
101 / 0 EXTENSION
102 /
103 / OS8 FILE OR PDP-10 FILE
104 /
105 /WHERE L IS LENGTH (8 BITS), D IS DEVICE (4 BITS), U IS UNIT (3 BITS)
106 /
107 /AT "MINPUT" THE LIST--
108 / LLL LLL LLD DDD OR UUU 100 000 000
109 / START BLOCK ANY BLOCK
110 /
111 / OS8 FILE OR PDP-10 FILE
112 /
113 /THE LIST ENDS WITH A ZERO (0) WORD
114 /
115 /AT "MPARAM" THE BLOCK--
116 / ABC DEF GHI JKL
117 / MNO PQR STU VWX
118 / YZ0 123 456 789
119 /
120 /WHICH ARE THE OPTION CHARACTERS
121 /
122 /THE = CONSTRUCTION IS NOT IMPLEMENTED
123 \f/DEFINITIONS
124
125 VERSION= 3 /VERSION NUMBER
126 SUBVER= 01 /PATCH LEVEL
127 /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
128
129 DIRECT=7000 /PDP-10 DIRECTORY BUFFER (FIELD 1)
130 IBUF10=3000 /PDP-10 INPUT BUFFER (FIELD 1)
131 INBUF=3000 /OS8 INPUT BUFFER (FIELD 1)
132 OBUF10=5000 /PDP-10 OUTPUT BUFFER (FIELD 1)
133 OUBUF=5000 /OS8 OUTPUT BUFFER (FIELD 1)
134
135 OUDEVH=7200 /OUTPUT DEVICE (FIELD 0)
136 INDEVH=6600 /INPUT DEVICE (FIELD 0)
137
138 INCTL=1010 /INPUT CONTROL
139 OUCTL=5010 /OUTPUT CONTROL
140 INRECS=4 /INPUT RECORDS
141
142 MDATE=7666 /MONITOR'S DATE (FIELD 1)
143
144 MINPUT=7617 /INPUT LIST (FIELD 1)
145 MOUTPU=7600 /OUTPUT LIST (FIELD 1)
146 MPARAM=7643 /PARAMETER LIST (FIELD 1)
147 JSBITS=7746 /0S8 JOB STATUS BITS
148
149 DCB=7760 /DEVICE CONTROL BLOCK (FIELD 1)
150 PTP=20 /DCB VALUE OF THE PAPER TAPE PUNCH
151 \f/PAGE ZERO AND POINTERS
152
153 *10
154
155 INDEX0, 0 /AUTO-INDEX REGISTERS
156 INDEX1, 0
157 INDEX2, 0
158 INDEX3, 0
159 INDEX4, 0
160 INDEX5, 0
161 INDEX6, 0
162 IXR, 0 /INPUT LIST INDEX REGISTER
163
164 *20
165
166 UNIT10, 0 /CURRENT PDP-10 UNIT (U400)
167
168 POINT, 0 /GENERAL POINTER
169
170 CNTR, 0 /GENERAL COUNTER
171
172 TEMP1, 0 /TEMPORARIES
173 TEMP2, 0
174 TEMP3, 0
175 TEMP4, 0
176 TEMP5, 0
177 TEMP6, 0
178
179 CHARNI, 0 /CHARACTER INPUT NUMBER
180 CHARNO, 0 /CHARACTER OUTPUT NUMBER
181
182 OUNIT, 0 /OUTPUT UNIT
183 IUNIT, 0 /INPUT UNIT
184
185 IBLOCK, 0 /INPUT BLOCK
186 OBLOCK, 0 /OUTPUT BLOCK
187
188 INPUT, 0 /INPUT ROUTINE POINTER
189 OUTPUT, 0 /OUTPUT ROUTINE POINTER
190
191 IPOINT, 0 /INPUT POINTER
192 OPOINT, 0 /OUTPUT POINTER
193
194 SAVELN, 0 /OPTION /P SWITCH
195
196 MODE, 0 /OPTION /I AND /B SWITCH
197
198 WORDS, 0 /WORDS LEFT COUNTER
199
200 DATE, 0 /TODAY'S DATE
201
202 FREEP, 0 /POINT TO FREE SPOT
203
204 PRINT0, 0 /PRINT ROUTINE TEMPORARIES
205 PRINT1, 0
206 PRINT2, 0
207 PRINT3, 0
208 PRINTC, 0 /240 FOR LEADING SPACES
209
210 RBFLAG, 0 /RUBOUT FLAG
211
212 CDDEVF, 0 /DEFAULT DEVICE NAME
213 0
214
215 CDNAME, 0 /FILE NAME
216 0
217 0
218 CDEXT, 0 /FILE EXTENSION
219 0
220 0 /FILLER WORD
221
222 PERSW, 0 /PERIOD SWITCH
223
224 DEVSW, 0 /DEVICE SWITCH
225
226 CDDEV, 0 /DEVICE
227 0
228
229 INSEG, 0 /PDP-10 UNIT WITH DIRECTORY IN CORE
230
231 PDP10D, ZBLOCK 10 /LIST OF KNOWN PDP-10 UNITS
232
233 CDCNT, 0 /INPUT LIST COUNTER
234
235 CDI04, 0 /POINTER SAVE
236
237 XDSK, TEXT /DSK/ /DEFAULT DEVICE DSK:
238
239 OCHARY, 0 /TEMPORARY
240 DVTYPE, 0 /DEVICE TYPE HOLDER
241 TDUNIT, 0 /0 OR 4000
242 TAPFUN, 0 /DECTAPE FUNCTION
243 DATE75, 0 /1 MEANS HAD H.O. BIT ON
244 XDATE, 0 /POINTS TO EXTRA DATE BIT
245 HIDATE, 0 /HIGH-ORDER BIT OF TODAY'S DATE
246
247 / KLUDGE FOR DATE-75 BUG:
248 / ONLY CONSIDER 1 MORE BIT OF PRECISION
249 / INSTEAD OF ALL 3 EXTRA BITS
250 / SINCE OS/8 DATE WILL RUN OUT BEFORE
251 / THAT FAILS
252 PAGE
253 \f JMP I (PIP10 /NORMAL ENTRY
254 JMS ERROR /PIP10 CANNOT BE CHAINED TO
255 ERMES0-1
256
257 /ERROR ROUTINES
258
259 IOERR, JMS ERROR /I/O ERROR
260 ERMES1-1
261
262 NOROOM, JMS ERROR /NO ROOM IN TAPE OR DIRECTORY
263 ERMES2-1
264
265 NOOFIL, JMS ERROR /NO SUCH DEVICE
266 ERMES3-1
267
268 FNOTFD, JMS ERROR /FILE NOT FOUND
269 ERMES9-1
270 NOT10F, JMS ERROR /NOT A PDP-10 FILE
271 ERMES4-1
272
273 ERDELF, JMS ERROR /ERROR DELETING A FILE
274 ERMES5-1
275
276 NOTPSF, JMS ERROR /NOT A OS8 FILE
277 ERMES6-1
278
279 NOOOFL, JMS ERROR /ERROR OPENING THE OUTPUT FILE
280 ERMES7-1
281
282 SYNTAX, JMS ERROR /SYNTAX ERROR
283 ERMES8-1
284
285 ERROR, 0 /ERROR ROUTINE
286 CLA
287 CDF
288 TAD I ERROR
289 DCA INDEX0 /POINT TO MESSAG-1
290 TAD (ERROR3
291 DCA OUTPUT /SET TTY: OUTPUT
292 JMS ERROR4 /PRINT THE STRING
293 JMP I (PIPCD /AND BACK TO NORMAL
294
295 ERROR4, 0 /PRINT THE STRING POINTED BY INDEX0
296 TAD I INDEX0
297 DCA TEMP1 /SAVE WORD
298 TAD TEMP1
299 RTR
300 RTR
301 RTR
302 JMS ERROR2 /BREAK IT DOWN
303 TAD TEMP1
304 JMS ERROR2
305 JMP ERROR4+1 /LOOP
306
307 ERROR2, 0
308 AND [77 /USE 6 BITS
309 SNA
310 JMP I ERROR4 /END
311 DCA TEMP2
312 TAD TEMP2
313 AND (40
314 SNA CLA
315 TAD (100
316 TAD [200 /MAKE A CHAR
317 TAD TEMP2
318 TAD (-337 /_ IS SPECIAL
319 SNA
320 TAD (215-337
321 TAD (337
322 JMS ERROR7 /PUT IT
323 JMP I ERROR2
324
325 ERROR7, 0
326 DCA TEMP2
327 TAD TEMP2
328 JMS I OUTPUT
329 TAD TEMP2
330 TAD (-215
331 SZA CLA
332 JMP I ERROR7
333 TAD (212
334 JMP ERROR7+1
335
336 ERROR3, 0
337 TLS
338 TSF
339 JMP .-1
340 CLA
341 JMP I ERROR3
342 \f/PRINT ROUTINE
343
344 PRINT, 0
345 DCA PRINT0
346 PRINT7, DCA PRINTC /SET SWITCH
347 TAD (PRINTL
348 DCA PRINT1
349 CLL CLA CMA RTL
350 DCA PRINT3
351 PRINT4, DCA PRINT2
352 JMP .+3
353
354 DCA PRINT0
355 ISZ PRINT2
356 TAD PRINT0
357 TAD I PRINT1
358 SMA
359 JMP .-5
360 CLA
361 ISZ PRINT1
362 TAD PRINT2
363 SZA
364 JMP PRINT5 /IT IS NON-ZERO
365 TAD PRINTC
366 SZA
367 JMS I OUTPUT /PRINT LEADING SPACE IF DESIRED
368 JMP PRINT6
369
370 PRINT5, TAD ("0
371 JMS I OUTPUT
372 CLL CLA CML RAR
373 PRINT6, ISZ PRINT3
374 JMP PRINT4
375 TAD PRINT0
376 TAD ("0
377 JMS I OUTPUT
378 JMP I PRINT
379 PAGE
380 \f/PDP-10 DECTAPE SERVICE ROUTINE
381 /
382 /CALL:
383 / JMS READT /READ PDP-10 DECTAPE
384 / BUFFER /BUFFER ADDRESS - FIELD 1
385 / BLOCK /BLOCK NUMBER
386 /
387 / JMS WRITET /WRITE PDP-10 DECTAPE
388 / BUFFER /BUFFER ADDRESS - FIELD 1
389 / BLOCK /BLOCK NUMBER
390 /
391 /THE UNIT IS IN "UNIT10"
392
393 TCON2, 2 /MUST BE AT BEGINNING OF PAGE!
394
395 WRITET, 0 /WRITE PDP-10 DECTAPE
396 CDF /BE SURE OF FIELD 0
397 TAD WRITET
398 STL
399 JMS I (TDIOCK /CHECK FOR TD IO
400 TAD I WRITET /GET BUFFER ADDRESS
401 DCA TBUF /AND SAVE IT
402 JMS RWTEST /TEST DIRECTION
403 WRITE2, JMS I (FLIP /REVERSE - FLIP BUFFER NOW
404 TAD (50
405 WRITE1, DCA TAPFUN /SET FUNCTION (30=READ, 50=WRITE)
406 DTLB /SEARCH INTO FIELD 0
407 TAD (TBLK
408 DCA I TCA /TAPE BLOCK INTO "TBLK"
409 TERR, RTL /ERROR BIT IS 0 INITIALLY
410 RAL /SHIFT END ZONE BIT INTO LINK
411 CML CLA /CLEAR REST OF THE JUNK
412 TAD [200 /'GO' BIT
413 TSTART, SNL /SKIP IF NO REVERSE DIRECTION
414 TAD [400 /'REVERSE' BIT
415 DTXA /START DRIVE GOING
416 TLOOP, JMS I (DTWAIT
417
418 TOUT, SPA /ERROR?
419 JMP TERR /YES - CHECK IT
420 DTRA /CHECK DIRECTION
421 RTL
422 RTL /DIRECTION BIT INTO LINK
423 TMOD1, SZL CLA /'SNL CLA' IF REVERSE MODE
424 TMOD4, TAD TCON2 /'CLL CLA CMA RAL' IF REVERSE MODE
425 TAD TBLK /GET BLOCK FOUND
426 CMA
427 TAD I WRITET /GET BLOCK DESIRED
428 CMA
429 SZA CLA /SKIP IF FOUND THE BLOCK
430 JMP TSTART /NOT FOUND - GO AGAIN
431 TMOD2, SZL CLA /'SNL CLA' IF REVERSE MODE
432 JMP TSTART+1 /FOUND BUT WRONG DIRECTION - REVERSE IT
433 CLA CMA
434 TAD TBUF /GET BUFFER ADDRESS-1
435 DCA I TCA /SET ADDRESS
436 TAD (10
437 DTLB /SET FIELD 1 BUFFER
438 TAD TAPFUN
439 DTXA /SET READ OR WRITE
440 TAD TM600
441 DCA I TWC /SET WORD COUNT OF 600 OCTAL WORDS
442 DTSF /FLAG?
443 JMP .-1 /NO - WAIT
444 DTRB /CHECK FOR ERRORS
445 SPA CLA
446 JMP I (IOERR /ERROR!!
447 TAD [200
448 DTXA /STOP THE DRIVE
449 TMOD3, JMS I (FLIP /POSSIBLE FLIP AFTER READ
450 ISZ WRITET
451 JMP I WRITET /EXIT
452
453 TCA, 7755 /DECTAPE CURRENT ADDRESS
454 TWC, 7754 /DECTAPE WORD COUNT
455 TBLK, 0 /SET TO BLOCK FOUND IN SEARCH
456 TBUF, 0 /HOLDS BUFFER ADDRESS
457
458 /READ ENTRY POINT
459
460 READT, 0 /PDP-10 DECTAPE READ
461 CDF /INSURE FIELD 0
462 TAD READT
463 CLL
464 JMS I (TDIOCK /CHECK FOR TD IO
465 TAD I READT /GET BUFFER ADDRESS
466 DCA TBUF /AND SAVE IT
467 TAD READT
468 DCA WRITET /MOVE RETURN ADDRESS
469 JMS RWTEST /CHECK DIRECTION
470 NOP /NO INITIAL FLIP IF REVERSE
471 TAD (30 /READ FUNCTION
472 JMP WRITE1 /GO DO REST OF THE ROUTINE
473 \fRWTEST, 0 /CHECK DIRECTION TO READ/WRITE AND SEARCH
474 ISZ WRITET
475 JMS I (GOLDBK /GET OLD BLOCK NUMBER (NEGATIVE)
476 TAD I WRITET /GET DESIRED BLOCK
477 DCA TBLK /SAVE FOR FUTURE USE
478 SZL CLA
479 TAD (10 /FORWARD - SZL CLA
480 TAD TMOD6 /REVERSE - SNL CLA
481 DCA TMOD1 /SET UP FOR DIRECTION
482 TAD TMOD1
483 DCA TMOD2
484 SNL CLA
485 TAD WRITE2 /REVERSE - FLIP BUFFER AFTER
486 DCA TMOD3 /FORWARD - NO BUFFER FLIP
487 TMOD6, SNL CLA
488 TAD (7344-1200 /REVERSE - CLL CLA CMA RAL
489 TAD TMOD5 /FORWARD - TAD TCON2
490 DCA TMOD4 /X0002 OR 17776
491 SZL CLA
492 ISZ RWTEST /FORWARD - 2ND EXIT
493 IAC
494 SNL
495 CIA /REVERSE DIRECTION
496 TAD I WRITET
497 SPA
498 TM600, CLA /NO LOWER THAN 0
499 DCA I TAPFUN /SET NEW LAST SERVICED BLOCK
500 TAD TBLK /REMEMBER SAVING THIS?
501 CLL
502 SMA SZA /<0 AND 0 SKIP AND HAVE LINK=0
503 CLL CML CIA />0 BECOMES <0 AND HAS LINK=1
504 TMOD5, TAD TCON2
505 CLA RTR /LINK HAS SEARCH DIRECTION
506 RTR
507 TAD (10 /ADD 'SEARCH' BIT
508 DTCA DTXA /LOAD SEARCH AND DIRECTION
509 TAD UNIT10 /GET UNIT
510 DTXA /ADD UNIT (ALSO FLIPS DIRECTION)
511 JMP I RWTEST /EXIT
512 PAGE
513 \f/"OLDTBL" IS LIST OF LAST SERVICED BLOCKS
514
515 OLDTBL, 0;0;0;0;0;0;0;0
516 /FLIP THE BUFFER ROUTINE
517
518 FLIP, 0 /FLIP A 600 WORD BUFFER (FIELD 1)
519 TAD I (TBUF /BUFFER START
520 DCA FLIP1 /SET START
521 TAD (577
522 TAD I (TBUF
523 DCA FLIP2 /SET END (END=START+577)
524 TAD (-300
525 DCA FLIP3 /SET COUNT (600/2=300)
526 CDF 10 /BUFFER IS IN FIELD 1
527 FLIP6, TAD I FLIP1 /GET START
528 JMS FLIP4 /FLIP IT
529 DCA FLIP5 /SAVE TEMPORARILY
530 TAD I FLIP2 /GET END
531 JMS FLIP4 /FLIP IT
532 DCA I FLIP1 /PUT END INTO START
533 TAD FLIP5
534 DCA I FLIP2 /PUT START INTO END
535 ISZ FLIP1 /BUMP POINTERS
536 CLA CMA
537 TAD FLIP2
538 DCA FLIP2
539 ISZ FLIP3 /DONE?
540 JMP FLIP6 /NO - LOOP
541 CDF /BACK TO FIELD 0
542 JMP I FLIP /EXIT
543
544 FLIP1, 0 /START POINTER
545 FLIP2, 0 /END POINTER
546 FLIP3, 0 /COUNTER
547 FLIP5, 0 /TEMPORARY
548 FLIP7, 0 /FLIPPING TEMPORARIES
549 FLIP8, 0 /" "
550
551 FLIP4, 0 /FLIP A CELL
552 DCA FLIP7 /SAVE IT
553 TAD FLIP7
554 RTL
555 RTL
556 AND (7 /GET ...1
557 DCA FLIP8 /ACCUMULATE RESULT
558 TAD FLIP7
559 RTR
560 RAR
561 AND (70 /GET ..2.
562 TAD FLIP8
563 DCA FLIP8 /BUILD RESULT
564 TAD FLIP7
565 AND (70
566 CLL RTL
567 RAL /GET .3..
568 TAD FLIP8
569 DCA FLIP8 /BUILD RESULT
570 TAD FLIP7
571 AND (7
572 CLL RTR
573 RTR /GET 4...
574 TAD FLIP8
575 CMA /GET NOT 4321
576 JMP I FLIP4 /EXIT
577 \f/TD8E I/O ROUTINE - CALLS STANDARD ROUTINE
578
579 TDIOCK, 0
580 DCA TDRET /SAVE RETURN ADDR
581 RAR
582 DCA TDFUN /SAVE READ/WRITE
583 JMS I (GET10D /GET TYPE OF DECTAPE
584 TAD (-2
585 SZA CLA
586 JMP I TDIOCK /TC08 - CONTINUE
587 TAD I TDRET
588 DCA TDBUF /SAVE BUF ADDR
589 ISZ TDRET
590 JMS GOLDBK /GET OLD BLOCK #
591 TAD I TDRET
592 CLA RAL /GET DIRECTION
593 TAD (110 /ONE BLOCK, FIELD 1
594 TAD TDFUN
595 DCA TDFUN /SAVE FINAL FUNCTION WORD
596 JMS I (TDUSET /SET UP HANDLER
597 TAD TDUNIT
598 SPA CLA
599 TAD (DTA1-DTA0
600 TAD (DTA0
601 DCA TDIOCK /SET UP HANDLER ENTRY PTR
602 TAD I TDRET
603 DCA I TAPFUN
604 TAD I TAPFUN
605 DCA TDBLK
606 JMS I TDIOCK
607 TDFUN, 0
608 TDBUF, 0
609 TDBLK, 0
610 JMP I (IOERR
611 ISZ TDRET
612 JMP I TDRET
613 TDRET, 0
614
615 GOLDBK, 0
616 TAD UNIT10 /GET THE UNIT WE NEED
617 CLL RTL
618 RTL /SHIFT INTO BITS 9-11
619 TAD (OLDTBL
620 DCA TAPFUN /POINT TO THIS UNIT'S POSITION
621 TAD I TAPFUN /GET LAST SERVICED BLOCK
622 CLL CIA
623 JMP I GOLDBK
624 PAGE
625 \f/GET A LINE ROUTINE
626
627 GLINE, 0 /GET A LINE
628 TAD ["*
629 JMS I [ERROR3 /ANNOUNCE US WITH A *
630 DCA RBFLAG /RESET RUBOUT FLAG
631 TAD [LINBUF-1
632 DCA IXR /POINT TO THE BUFFER
633 CHLOOP, KSF
634 JMP CHLOOP /WAIT FOR TTY:
635 TAD [200
636 KRS /READ TTY:
637 DCA TEMP1
638 KCC
639 TAD [SPADR-1
640 DCA INDEX0 /SET LIST SEARCH
641 TAD I INDEX0
642 SNA
643 JMP .+6 /END OF LIST
644 TAD TEMP1
645 SNA CLA
646 JMP I INDEX0 /FOUND SO JUMP
647 ISZ INDEX0
648 JMP .-7 /LOOP
649
650 JMS PRNT /PRINT IT
651 CINSRT, TAD TEMP1
652 DCA I IXR /STORE THE CHARACTER
653 TAD IXR
654 TAD (-LINBUF-100
655 SZA CLA
656 JMP CHLOOP /GET ANOTHER CHARACTER
657 JMS CRCR
658 JMP I (SYNTAX /ERROR
659
660 CARRET, JMS CRCR
661 CLFINI, DCA I IXR /SET END
662 DCA I IXR
663 JMP I GLINE /EXIT
664
665 SPADR, -225;JMP CTRLU
666 -215;JMP CARRET
667 -377;JMP RUBOUT
668 -375;JMP ALTMOD
669 -376;JMP ALTMOD
670 -233;JMP ALTMOD
671 -200;JMP CHLOOP
672 -217;JMP CHLOOP
673 -337;JMP BAKARR
674 -212;JMP LFEED
675 -203;JMP CTRLC
676 0
677
678 BAKARR, JMS PRNT /"_"
679 TAD ["<
680 JMP CINSRT+1 /USE "<" INSTEAD
681
682 CTRLC,
683 CTRLU, TAD ["^
684 JMS I [ERROR3 /CONTROL CHARACTERS
685 TAD TEMP1
686 TAD [100
687 CLRLIN, JMS I [ERROR3
688 JMS CRCR
689 TAD I INDEX0
690 SZA CLA
691 JMP GLINE+1 /NOT "^C"
692 TSF
693 JMP .-1
694 JMP I (7605 /TO MONITOR
695
696 CRCR, 0
697 TAD [215
698 DCA TEMP1
699 JMS PRNT
700 TAD [212
701 JMS I [ERROR3 /PRINT CR-LF
702 JMP I CRCR
703
704 ALTMOD, TAD ["$
705 DCA TEMP1 /ALTMODE IS "$"
706 JMS PRNT
707 JMP CLFINI /ENDS THE LINE
708
709 RUBOUT, TAD IXR
710 TAD (1-LINBUF
711 SNA CLA
712 JMP RBSPCL /SPECIAL TREATMENT
713 TAD ("\
714 ISZ RBFLAG
715 JMS I [ERROR3 /PRINT \
716 CLA CMA
717 DCA RBFLAG /SET FLAG
718 TAD IXR
719 DCA TEMP2
720 TAD I TEMP2
721 JMS I [ERROR3 /PRINT RUBED CHAR
722 LBCKUP, CLA CMA
723 TAD IXR
724 JMP CHLOOP-1 /GO GET ANOTHER
725
726 RBSPCL, ISZ RBFLAG
727 JMP CLRLIN+1 /NOT INTO RUBOUTS
728 TAD ("\
729 JMP CLRLIN
730
731 PRNT, 0
732 ISZ RBFLAG
733 JMP .+3
734 TAD ("\
735 JMS I [ERROR3 /END OF RUBOUTS
736 DCA RBFLAG
737 TAD TEMP1
738 JMS I [ERROR3 /PRINT CHAR
739 JMP I PRNT
740
741 LFEED, JMS CRCR
742 DCA I IXR /SET END
743 TAD [LINBUF-1
744 DCA IXR
745 TAD ["*
746 JMS I [ERROR3
747 TAD I IXR /PRINT THE LINE
748 SNA
749 JMP LBCKUP
750 JMP .-4
751 PAGE
752 \f/FIND A SLOT ROUTINE
753 /SLOT NUMBERS BETWEEN 0 AND 1101
754 /RETURN WITH A 5 BIT NUMBER (1 TO 26 OCTAL)
755 /
756 /CALL:
757 / JMS FINDSL /FIND A SLOT
758 / SLOT# /SLOT NUMBER
759 / (AC) /VALUE OF SLOT RETURNED
760 /
761 /SLOT NUMBER OF 0 RETURNS 7777
762
763 FINDSL, 0 /FIND A SLOT
764 CLA CMA
765 TAD I FINDSL /GET SLOT NUMBER-1
766 ISZ FINDSL
767 SPA /WAS IT 0?
768 JMP FINDSA /YES
769 JMS DIV7 /NO - DIVIDE BY 7
770 TAD (JMP I FINDS0+7
771 DCA DIV1 /USE REMAINDER FOR JUMPING
772 CDF 10 /BUFFER IS IN FIELD 1
773 DIV1, HLT /TEMPORARY AND JUMP CELL
774
775 FINDSA, CLA CMA
776 JMP I FINDSL /EXIT WITH 7777 FOR SLOT NUMBER 0
777
778 FINDS0, FINDS1 /JUMP TABLE
779 FINDS2
780 FINDS3
781 FINDS4
782 FINDS5
783 FINDS6
784 FINDS7
785
786 /DIVIDE BY 7 ROUTINE
787
788 DIV7, 0 /DIVIDE BY 7
789 DCA DIV1 /SAVE IT
790 TAD (DIRECT
791 DCA POINT /POINT TO DIRECTORY
792 TAD DIV1
793 DIV3, TAD (-7 /SUBTRACT 7'S
794 SPA
795 JMP I DIV7 /EXIT WITH REMAINDER
796 ISZ POINT /BUMP POINTER BY 3
797 ISZ POINT
798 ISZ POINT
799 JMP DIV3 /AND LOOP
800
801 /FIND SLOT ROUTINE #1
802 /USE WORD 1 BITS 0-4
803
804 FINDS1, TAD I POINT /GET CELL
805 RTL
806 RTL
807 RTL /GET FIRST 5 BITS
808 FINDS8, AND [37 /ONLY 5 BITS
809 CDF /BACK TO FIELD 0
810 JMP I FINDSL /AND EXIT WITH VALUE IN AC
811
812 /FIND SLOT ROUTINE #2
813 /USE WORD 1 BITS 5-9
814
815 FINDS2, TAD I POINT
816 RTR /USE BITS 5-9
817 JMP FINDS8
818
819 /FIND SLOT ROUTINE #3
820 /USE WORD 1 BITS 10-11 AND WORD 2 BITS 0-2
821
822 FINDS3, TAD I POINT
823 AND [3 /USE BITS 10-11 OF 1ST WORD
824 CLL RTL
825 RAL /SHIFT TO BITS 7-8
826 DCA DIV1 /SAVE IT
827 ISZ POINT /NEXT WORD
828 TAD I POINT
829 CLL RTL
830 FINDS9, RTL /GET INTO BITS 8-11
831 AND [17 /GET ONLY BITS 8-11
832 TAD DIV1 /ADD OTHER BITS
833 JMP FINDS8
834
835 /FIND SLOT ROUTINE #4
836 /USE WORD 2 BITS 3-7
837
838 FINDS4, ISZ POINT /USE 2ND WORD
839 TAD I POINT
840 RTR /USE BITS 3-7
841 JMP FINDS2+1
842
843 /FIND SLOT ROUTINE #5
844 /USE WORD 2 BITS 8-11 AND WORD 3 BIT 0
845
846 FINDS5, ISZ POINT /USE 2ND WORD
847 TAD I POINT
848 AND [17
849 CLL RAL /GET BITS 7-10
850 DCA DIV1 /AND SAVE THEM
851 ISZ POINT /NEXT WORD
852 CLL CLA CML RAR
853 AND I POINT /GET BIT 0
854 JMP FINDS9
855
856 /FIND SLOT ROUTINE #6
857 /USE WORD 2 BITS 1-5
858
859 FINDS6, ISZ POINT
860 ISZ POINT /USE 3RD WORD
861 TAD I POINT
862 RAL
863 JMP FINDS1+1
864
865 /FIND SLOT ROUTINE #7
866 /USE WORD 3 BITS 6-10
867
868 FINDS7, ISZ POINT
869 ISZ POINT /USE 3RD WORD
870 TAD I POINT
871 RAR /GET RID OF LAST BIT
872 JMP FINDS8
873 \f/DELETE A PDP-10 ENTRY
874 /
875 /CALL:
876 / (AC) /POINT TO NAME-1 (FIELD 1)
877 / JMS DELETE /DELETE A PDP-10 ENTRY
878 / -NO- /NOT FOUND
879 / -OK- /ENTRY DELETED
880
881 DELETE, 0 /DELETE A PDP-10 ENTRY
882 JMS I (FIND /TRY TO FIND IT FIRST
883 JMP I DELETE /NOT FOUND
884 ISZ DELETE /FOUND - 2ND EXIT
885 DCA DELET1 /SAVE SLOT NUMBER
886 CLA IAC
887 DCA DELET2 /START AT SLOT 1
888 TAD (-1101
889 DCA DELET3 /DO 1101 SLOTS
890 JMS FINDSL /FIND A SLOT
891 DELET2, 0 /SLOT NUMBER
892 CIA
893 TAD DELET1 /IS IT ONE OF OURS?
894 SZA CLA
895 JMP DELET4 /NO
896 TAD DELET2 /YES
897 DCA .+2 /SET SLOT NUMBER AGAIN
898 JMS I (FILLSL /FILL WITH A 0
899 0
900 0 /FILL WITH A 0
901 DELET4, ISZ DELET2 /NEXT SLOT
902 ISZ DELET3 /MORE?
903 JMP DELET2-1 /YES - LOOP
904 CDF 10 /DIRECTORY IS IN FIELD 1
905 DCA I INDEX0 /REMEMBER "FIND" SETTING THIS UP?
906 DCA I INDEX0 /REMOVE THE FILE NAME
907 DCA I INDEX0
908 TAD INDEX0
909 TAD [77
910 DCA INDEX0 /POINT TO EXTENSION
911 DCA I INDEX0
912 DCA I INDEX0 /REMOVE EXTENSION
913 DCA I INDEX0
914 CDF
915 JMP I DELETE /EXIT
916
917 DELET1, 0 /HOLDS FOUND SLOT NUMBER
918 DELET3, 0 /COUNTER
919 PAGE
920 \f/FILL A SLOT ROUTINE
921 /
922 /CALL:
923 / JMS FILLSL /FILL A SLOT
924 / SLOT# /SLOT NUMBER
925 / VALUE /VALUE TO FILL SLOT WITH
926 /
927 /SLOT NUMBER 0 IS ILLEGAL!
928
929 FILLSL, 0 /FILL A SLOT ROUTINE
930 CLA CMA
931 TAD I FILLSL /GET SLOT NUMBER-1
932 ISZ FILLSL
933 JMS I (DIV7 /DIVIDE BY 7
934 TAD (JMP I FILLS0+7
935 DCA FILLS9 /USE REMAINDER FOR JUMPING
936 TAD I FILLSL /GET VALUE
937 ISZ FILLSL
938 AND [37 /5 BIT VALUE ONLY
939 CDF 10 /DIRECTORY IS IN FIELD 1
940 FILLS9, HLT /TEMPORARY AND JUMP CELL
941
942 /JUMP TABLE
943
944 FILLS0, FILLS1
945 FILLS2
946 FILLS3
947 FILLS4
948 FILLS5
949 FILLS6
950 FILLS7
951
952 FILLSA, 0 /TEMPORARY
953
954 /FILL SLOT ROUTINE #1
955 /BITS 0-4 OF WORD 1
956
957 FILLS1, CLL RTR
958 RTR /VALUE INTO BITS 0-4
959 RTR
960 DCA FILLS9 /SAVE VALUE
961 TAD I POINT
962 AND [177 /AND OFF BITS 0-4
963 FILLS8, TAD FILLS9 /ADD IN VALUE
964 DCA I POINT /SET NEW WORD
965 CDF /BACK TO FIELD 0
966 JMP I FILLSL /EXIT
967
968 /FILL SLOT ROUTINE #2
969 /BITS 5-9 OF WORD 1
970
971 FILLS2, CLL RTL /VALUE INTO BITS 5-9
972 DCA FILLS9 /SAVE VALUE
973 TAD I POINT
974 AND (7603 /AND OFF BITS 5-9
975 JMP FILLS8
976
977 /FILL SLOT ROUTINE #3
978 /BITS 10-11 OF WORD 1 AND BITS 0-2 OF WORD 2
979
980 FILLS3, DCA FILLS9 /SAVE VALUE
981 TAD FILLS9
982 CLL RAR
983 CLL RAR /GET BITS 10-11
984 CLL RAR
985 DCA FILLSA /SAVE
986 TAD I POINT
987 AND (7774 /AND OFF BITS 10-11
988 TAD FILLSA /ADD IN BITS 10-11
989 DCA I POINT /SET NEW WORD
990 ISZ POINT /GOTO WORD 2
991 TAD FILLS9
992 AND [7 /GET BITS 0-2
993 CLL RTR
994 RTR /SHIFT THEM
995 DCA FILLS9 /SAVE VALUE
996 TAD I POINT
997 AND (777 /AND OFF BITS 0-2
998 JMP FILLS8
999
1000 /FILL SLOT ROUTINE #4
1001 /BITS 3-7 OF WORD 2
1002
1003 FILLS4, CLL RTL
1004 RTL /SHIFT INTO POSITION
1005 DCA FILLS9 /AND SAVE
1006 ISZ POINT /USE WORD 2
1007 TAD I POINT
1008 AND (7017 /AND OFF BITS 3-7
1009 JMP FILLS8
1010
1011 /FILL SLOT ROUTINE #5
1012 /BITS 8-11 OF WORD 2 AND BIT 0 OF WORD 3
1013
1014 FILLS5, DCA FILLS9
1015 TAD FILLS9 /GET VALUE
1016 CLL RAR /GET BITS 8-11
1017 DCA FILLSA /AND SAVE
1018 ISZ POINT /USE WORD 2 FIRST
1019 TAD I POINT
1020 AND [7760 /AND OFF BITS 8-11
1021 TAD FILLSA /ADD IN THOSE BITS
1022 DCA I POINT /SET NEW WORD 2
1023 ISZ POINT /NOW WORD 3
1024 CLA IAC
1025 AND FILLS9 /GET BIT 0
1026 CLL RTR /AND SHIFT INTO POSITION
1027 DCA FILLS9 /AND SAVE IT
1028 CLL CLA CMA RAR
1029 AND I POINT /AND OFF BIT 0
1030 JMP FILLS8
1031
1032 /FILL SLOT ROUTINE #6
1033 /BITS 1-5 OF WORD 3
1034
1035 FILLS6, CLL RTL
1036 RTL /SHIFT INTO POSITION
1037 RTL
1038 DCA FILLS9 /AND SAVE
1039 ISZ POINT
1040 ISZ POINT /USE WORD 3
1041 TAD I POINT
1042 AND (4077 /AND OFF BITS 1-5
1043 JMP FILLS8
1044
1045 /FILL SLOT ROUTINE #7
1046 /BITS 6-10 OF WORD 3
1047 /BIT 11 OF WORD 3 A 0
1048
1049 FILLS7, CLL RAL /SHIFT INTO POSITION
1050 DCA FILLS9 /AND SAVE
1051 ISZ POINT
1052 ISZ POINT /USE WORD 3
1053 TAD I POINT
1054 AND [7700 /AND OFF BITS 6-11
1055 JMP FILLS8
1056 \fFIX75, 0 /DF 10
1057 CDF /SET H.O. DATE WORD OF FILE
1058 TAD I (SLOTNO /ENTRY NO. OF FILE
1059 CLL RAL /*3
1060 TAD I (SLOTNO /SINCE 1 -10 WORD= 3 -8 WORDS
1061 TAD (DIRECT-1 /POINT TO HIGH ORDER BIT OF DATE
1062 DCA FIXPTR /V3C
1063 CDF 10
1064 STA CLL RAL /OTHER STUFF IS VERY IMPORTANT
1065 AND I FIXPTR /SO KEEP IT
1066 TAD HIDATE /OR IN THIS BIT
1067 DCA I FIXPTR /AND WRITE IT BACK
1068 JMP I FIX75
1069
1070 FIXPTR, 0 /POINTS TO WORD CONTAINING H.O. DATE
1071 PAGE
1072 \f/GET NEXT SLOT ROUTINE
1073 /GOES BY 5'S EITHER FORWARD OR BACKWARD
1074 /
1075 /CALL:
1076 / (AC) /CURRENT BLOCK NUMBER
1077 / JMS NEXTSL /GET NEXT SLOT
1078 / (AC) /NEXT BLOCK NUMBER
1079 /
1080 /GOES TO "NOROOM" IF DIRECTORY FULL
1081
1082 NEXTSL, 0 /GET NEXT SLOT
1083 TAD NEXTDI /ADD IN DIRECTION FACTOR
1084 SPA
1085 JMP NEXTS2 /<0 MEANS REVERSE DIRECTION
1086 TAD [-1102
1087 SMA
1088 JMP NEXTS2 />1101 MEANS REVERSE DIRECTION
1089 TAD (1102
1090 DCA NEXTS1 /SET NEW BLOCK NUMBER
1091 JMS I (FINDSL /IS THIS SLOT FREE?
1092 NEXTS1, 0 /BLOCK NUMBER
1093 SZA CLA
1094 JMP NEXTS3 /NO - NOT FREE
1095 TAD NEXTS1 /FREE
1096 DCA NEXTS7+1 /SET BLOCK AGAIN
1097 NEXTS7, JMS I (FILLSL /FILL THIS SLOT THEN
1098 0 /SLOT TO FILL
1099 SLOTNO, 0 /VALUE TO FILL WITH
1100 TAD NEXTDI
1101 SMA CLA /MAKE SURE DIRECTION IS -4 OR 4
1102 TAD (10
1103 TAD (-4
1104 DCA NEXTDI
1105 TAD NEXTS7+1 /GET NEW BLOCK
1106 JMP I NEXTSL /EXIT
1107
1108 NEXTS2, CLA /REVERSE DIRECTION
1109 TAD NEXTDI
1110 SMA CLA /SET 0 OR 1101
1111 TAD (1101
1112 DCA NEXTS1 /INTO BLOCK NUMBER
1113 TAD NEXTDI
1114 CIA /REVERSE DIRECTION
1115 JMP NEXTS3+1 /GO PRETEND WE FOUND A FULL SLOT
1116
1117 NEXTS3, TAD NEXTDI
1118 SMA CLA /MAKE DIRECTION -1 OR 1
1119 CLL CLA CMA RAL
1120 CMA
1121 DCA NEXTDI /DIRECTION IS -1 OR 1
1122 TAD [-1102
1123 DCA NEXTS4 /CHECK 1102 BLOCKS
1124 TAD NEXTS1
1125 DCA NEXTS5 /SET START BLOCK
1126 JMS I (FINDSL /CHECK A SLOT
1127 NEXTS5, 0 /SLOT TO CHECK
1128 SNA CLA
1129 JMP NEXTS6 /FOUND A FREE SLOT
1130 ISZ NEXTS4 /TRY MORE?
1131 SKP /YES
1132 JMP I (NOROOM /NO - OUT OF ROOM
1133 TAD NEXTS5
1134 TAD NEXTDI /ADD DIRECTION TO SLOT
1135 SPA
1136 JMP NEXTS2 /<0 IS TOO FAR
1137 TAD [-1102
1138 SMA
1139 JMP NEXTS2 />1101 IS TOO FAR
1140 TAD (1102
1141 DCA NEXTS5 /SET NEW BLOCK
1142 JMP NEXTS5-1 /KEEP GOING
1143
1144 NEXTS6, TAD NEXTS5 /GET FREE BLOCK
1145 JMP NEXTS7-1 /AND SET IT
1146
1147 NEXTS4, 0 /COUNTER
1148
1149 NEXTDI, 0 /DIRECTION (5, -5, 1, -1)
1150
1151 /MORE PDP-10 OUTPUT
1152
1153 /OUTPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
1154
1155 OCHAR3, TAD OCHARY
1156 CLL RTR
1157 RTR
1158 AND [7
1159 TAD I OPOINT
1160 DCA I OPOINT
1161 ISZ OPOINT
1162 TAD OCHARY
1163 AND [17
1164 CLL RTR
1165 RTR
1166 RAR
1167 JMP I (OCHARD
1168 \fMONTBL, "J;"A;"N
1169 "F;"E;"B
1170 "M;"A;"R
1171 "A;"P;"R
1172 "M;"A;"Y
1173 "J;"U;"N
1174 "J;"U;"L
1175 "A;"U;"G
1176 "S;"E;"P
1177 "O;"C;"T
1178 "N;"O;"V
1179 "D;"E;"C
1180 PAGE
1181 \f/PDP-10 CHARACTER OUTPUT ROUTINE
1182 /
1183 /CALL:
1184 / (AC) /CHARACTER
1185 / JMS OCHR10 /OUTPUT TO PDP-10
1186 / -RETURN- /O.K. RETURN
1187
1188 OCHR10, 0 /OUTPUT TO PDP-10
1189 DCA OCHARY /SAVE CHAR
1190 TAD MODE /IMAGE MODE?
1191 SZA
1192 JMP OC10A1 /YES /I OR /B
1193 TAD OCHARY /NO - USE 7 BITS
1194 AND [177
1195 OC10A2, DCA OCHARY
1196 OC10A3, TAD CHARNO /GET CHAR NUMBER
1197 TAD (JMP I OCHARX
1198 DCA OCHARZ /USE TO SET UP JUMP
1199 CDF 10 /BUFFER IS IN FIELD 1
1200 OCHARZ, 0 /JUMP TO THE ROUTINE
1201
1202 OC10A1, SMA CLA /BINARY?
1203 JMP OC10A3 /NO
1204 TAD OCHARY /YES
1205 AND [377
1206 JMP OC10A2
1207
1208 OCHARX, OCHAR0
1209 OCHAR1
1210 OCHAR2
1211 OCHAR3
1212 OCHAR4
1213
1214 /OUTPUT CHARACTER #0 - BITS 0-6 WORD 1
1215
1216 OCHAR0, TAD I [OBUF10+2
1217 AND [177 /GET COUNT
1218 TAD (-177
1219 SZA CLA
1220 JMP OCHARA /STILL ROOM IN BUFFER
1221 CDF /NO ROOM IN BUFFER
1222 TAD OBLOCK
1223 JMS I (NEXTSL /GET THE NEXT BLOCK NUMBER
1224 DCA OCHARZ /AND SAVE IT
1225 CDF 10 /BACK TO FIELD 1
1226 TAD OCHARZ
1227 AND [7700
1228 CLL RTR
1229 RTR
1230 RTR /GET LINK POINTER
1231 DCA I [OBUF10
1232 TAD OCHARZ
1233 AND [77
1234 CLL RTL
1235 RTL
1236 RTL
1237 TAD I [OBUF10+1
1238 DCA I [OBUF10+1 /AND SET POINTER
1239 TAD OUNIT
1240 DCA UNIT10 /SET OUR UNIT
1241 TAD OBLOCK
1242 DCA .+3 /AND OUR BLOCK
1243 JMS I (WRITET /WRITE PDP-10 DECTAPE
1244 OBUF10
1245 0 /BLOCK NUMBER IS SET
1246 CDF 10 /BACK TO FIELD 1
1247 DCA I [OBUF10
1248 TAD I [OBUF10+1
1249 AND [77
1250 DCA I [OBUF10+1 /CLEAR POINTER
1251 TAD OCHARZ
1252 DCA OBLOCK /SET NEW BLOCK
1253 TAD I [OBUF10+2
1254 AND [7400
1255 DCA I [OBUF10+2 /ZERO COUNT
1256 TAD (OBUF10+3
1257 DCA OPOINT /RESET POINTER
1258 OCHARA, ISZ I [OBUF10+2 /BUMP COUNT
1259 TAD MODE /IMAGE MODE?
1260 SNA
1261 JMP OCHARB /NO
1262 SMA CLA /BINARY?
1263 JMP OC10A4 /NO
1264 DCA I OPOINT /YES
1265 ISZ OPOINT
1266 DCA I OPOINT
1267 ISZ OPOINT
1268 TAD OCHARY
1269 DCA I OPOINT /SET 8 BITS
1270 ISZ OPOINT
1271 OCHARC, CDF /BACK TO FIELD 0
1272 JMP I OCHR10 /EXIT
1273
1274 OC10A5, ISZ OPOINT
1275 OC10A4, TAD OCHARY
1276 JMP OCHARD
1277
1278 OCHARB, TAD OCHARY
1279 CLL RTL
1280 RTL
1281 RAL /USE BITS 0-6
1282 OCHARD, DCA I OPOINT /SET IT
1283 ISZ CHARNO /BUMP CHARACTER NUMBER
1284 JMP OCHARC
1285
1286 /OUTPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
1287
1288 OCHAR1, TAD MODE
1289 SZA CLA
1290 JMP OC10A5
1291 TAD OCHARY
1292 CLL RAR /GET BITS 7-11
1293 CLL RAR
1294 TAD I OPOINT
1295 DCA I OPOINT /SET WORD 1
1296 ISZ OPOINT /NOW WORD 2
1297 TAD OCHARY
1298 AND [3
1299 CLL RTR
1300 RAR /GET BITS 0-1
1301 JMP OCHARD
1302
1303 /OUTPUT CHARACTER #2 - BITS 2-8 WORD 2
1304
1305 OCHAR2, TAD MODE
1306 SZA CLA
1307 JMP OC10A6
1308 TAD OCHARY
1309 CLL RTL
1310 RAL /GET BITS 2-8
1311 TAD I OPOINT
1312 JMP OCHARD
1313
1314 /OUTPUT CHARACTER #4 - BITS 4-10 WORD 3
1315 /BIT 11 WORD 3 IS 0
1316
1317 OCHAR4, TAD OCHARY
1318 CLL RAL /BITS 4-10
1319 TAD I OPOINT
1320 OC10A7, DCA I OPOINT /SET WORD 3
1321 ISZ OPOINT
1322 DCA CHARNO /RESET CHARACTER NUMBER
1323 JMP OCHARC
1324
1325 OC10A6, ISZ OPOINT
1326 TAD OCHARY
1327 JMP OC10A7
1328 PAGE
1329 \f/PDP-10 CHARACTER INPUT
1330 /
1331 /CALL:
1332 / JMS ICHR10 /PDP-10 INPUT
1333 / -EOF- /END OF FILE RETURN
1334 / (AC) /NORMAL RETURN - CHARACTER IN AC
1335
1336 ICHR10, 0 /PCP-10 INPUT ROUTINE
1337 TAD CHARNI
1338 TAD (JMP I ICHARX
1339 DCA ICHARY /USE CHARACTER NUMBER TO FORM JUMP
1340 CDF 10 /BUFFER IS IN FIELD 1
1341 ICHARY, 0 /TEMPORARY AND JUMP CELL
1342
1343 ICHARX, ICHAR0
1344 ICHAR1
1345 ICHAR2
1346 ICHAR3
1347 ICHAR4
1348
1349 /INPUT CHARACTER #0 - BITS 0-6 WORD 1
1350
1351 ICHAR0, TAD WORDS /GET NUMBER OF WORD LEFT
1352 SZA CLA
1353 JMP ICHARA /STILL MORE WORDS LEFT
1354 TAD IBLOCK /GET NEXT BLOCK
1355 SNA
1356 JMP ICHARC+1 /NONE - EOF
1357 DCA .+5 /SET NEXT BLOCK
1358 TAD IUNIT
1359 DCA UNIT10 /SET OUR UNIT
1360 JMS I (READT /READ PDP-10 DECTAPE
1361 IBUF10
1362 0 /OUR BLOCK IS SET
1363 CDF 10 /BACK TO FIELD 1
1364 TAD I [IBUF10+2
1365 AND [177
1366 DCA WORDS /SET NUMBER OF WORDS
1367 TAD I [IBUF10+1
1368 RTR
1369 RTR
1370 RTR
1371 AND [77
1372 DCA IBLOCK /SET NEXT BLOCK
1373 TAD I [IBUF10
1374 AND [77
1375 CLL RTL
1376 RTL
1377 RTL
1378 TAD IBLOCK
1379 DCA IBLOCK /SET NEXT BLOCK
1380 TAD (IBUF10+3
1381 DCA IPOINT /RESET POINTER
1382 JMP ICHAR0
1383
1384 ICHARA, CLA CMA
1385 TAD WORDS
1386 DCA WORDS /COUNT DOWM ON NUMBER OF WORDS
1387 TAD MODE /IMAGE MODE?
1388 SNA
1389 JMP ICHARB /NO
1390 SMA CLA
1391 JMP IC10A1
1392 ISZ IPOINT /YES
1393 ISZ IPOINT
1394 TAD I IPOINT /GET WORD 3
1395 ISZ IPOINT
1396 AND [377 /USE 8 BITS
1397 ICHARC, ISZ ICHR10 /2ND EXIT
1398 CDF /BACK TO FIELD 0
1399 JMP I ICHR10 /EXIT
1400
1401 ICHARB, TAD SAVELN /PRESERVE OPTION?
1402 SZA CLA
1403 JMP ICHARF /YES
1404 CLL CLA CML RTL /NO
1405 TAD IPOINT
1406 DCA ICHARY /POINT TO WORD 3
1407 TAD I ICHARY
1408 CLL RAR
1409 SNL CLA
1410 JMP ICHARF /WORD O.K.
1411 ISZ IPOINT
1412 ISZ IPOINT /IGNORE THIS WORD
1413 ISZ IPOINT
1414 JMP ICHAR0
1415
1416 ICHARF, TAD I IPOINT
1417 RTR
1418 RTR /GET BITS 0-6
1419 RAR
1420 ICHARD, ISZ CHARNI /BUMP COUNTER
1421 AND [177 /USE 7 BITS
1422 TAD [200 /ADD BIT 8
1423 JMP ICHARC
1424
1425 /INPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
1426
1427 ICHAR1, TAD MODE
1428 SZA CLA
1429 JMP IC10A1
1430 TAD I IPOINT
1431 AND [37
1432 CLL RTL /GET BITS 7-11
1433 DCA ICHARY
1434 ISZ IPOINT /USE WORD 2 NOW
1435 TAD I IPOINT
1436 CLL RTL
1437 RAL
1438 AND [3 /GET BITS 0-1
1439 ICHARE, TAD ICHARY /ADD IN OTHER BITS
1440 JMP ICHARD
1441
1442 /INPUT CHARACTER #2 - BITS 2-8 WORD 2
1443
1444 ICHAR2, TAD MODE
1445 SZA CLA
1446 JMP IC10A3
1447 TAD I IPOINT
1448 RAR
1449 RTR /GET BITS 2-8
1450 JMP ICHARD
1451
1452 /INPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
1453
1454 ICHAR3, TAD I IPOINT
1455 AND [7
1456 CLL RTL
1457 RTL /GET BITS 9-11
1458 DCA ICHARY
1459 ISZ IPOINT /USE WORD 3 NOW
1460 TAD I IPOINT
1461 RTL
1462 RTL
1463 RAL
1464 AND [17 /GET BITS 0-3
1465 JMP ICHARE
1466
1467 /INPUT CHARACTER #4 - BITS 4-10 WORD 3
1468
1469 ICHAR4, DCA CHARNI /RESET CHARACTER COUNT
1470 TAD I IPOINT
1471 ISZ IPOINT
1472 RAR
1473 JMP ICHARD+1
1474
1475 IC10A3, DCA CHARNI
1476 SKP
1477 IC10A1, ISZ CHARNI
1478 TAD I IPOINT
1479 ISZ IPOINT
1480 JMP ICHARC
1481 PAGE
1482 \f/CLOSE A PDP-10 FILE
1483 /
1484 /CALL:
1485 / JMS CLOS10 /CLOSE A PDP-10 FILE
1486 / -RETURN-
1487
1488 CLOS10, 0 /CLOSE A PDP-10 FILE
1489 TAD MODE /IMAGE MODE?
1490 SPA CLA
1491 JMP CLOS1A /YES - NO FILL NEEDED
1492 TAD CHARNO
1493 SNA CLA
1494 JMP CLOS1A /CHARACTER NUMBER IS 0 - FILL DONE
1495 JMS I (OCHR10 /0 FILL
1496 JMP .-4 /LOOP
1497
1498 CLOS1A, TAD OUNIT
1499 DCA UNIT10 /SET OUR UNIT
1500 TAD OBLOCK
1501 DCA .+3 /SET THE BLOCK
1502 JMS I (WRITET /WRITE PDP-10 DECTAPE
1503 OBUF10
1504 0 /BLOCK IS SET
1505 TAD (MOUTPU
1506 JMS I (DELETE /DELETE THE OLD FILE
1507 NOP /O.K. IF IT IS NOT THERE
1508 TAD FREEP
1509 DCA INDEX0 /POINT TO THE FREE SPOT
1510 TAD [MOUTPU
1511 DCA INDEX1 /POINT TO THE FILE NAME
1512 CDF 10 /TO FIELD 1
1513 TAD I INDEX1
1514 DCA I INDEX0
1515 TAD I INDEX1 /SET THE NAME
1516 DCA I INDEX0
1517 TAD I INDEX1
1518 DCA I INDEX0
1519 TAD INDEX0
1520 TAD [77
1521 DCA INDEX0 /POINT TO THE EXTENSION
1522 TAD I INDEX1
1523 DCA I INDEX0 /SET THE EXTENSION
1524 TAD I INDEX1
1525 DCA I INDEX0
1526 TAD DATE
1527 DCA I INDEX0 /SET THE DATE
1528 JMS I (FIX75 /V3C SET HIGH ORDER BIT TOO
1529 JMS I (WRITET /WRITE PDP-10 DECTAPE
1530 DIRECT /DIRECTORY
1531 144 /BLOCK 100 BASE 10
1532 JMP I CLOS10 /EXIT
1533 \f/OPEN A PDP-10 FILE FOR OUTPUT
1534 /
1535 /CALL:
1536 / JMS OOPN10 /OPEN A PDP-10 FILE
1537 / -RETURN-
1538
1539 OOPN10, 0 /OPEN A PDP-10 FILE
1540 TAD (ZFREE-1
1541 JMS I (FIND /FIND A FREE SPOT
1542 JMP I (NOROOM /NO ROOM LEFT
1543 DCA I (SLOTNO /SET THIS SLOT
1544 TAD INDEX0
1545 DCA FREEP /SAVE POINTER TO FREE SPOT
1546 CLA CMA
1547 DCA I (NEXTDI /SET DIRECTION = -1
1548 TAD (144
1549 JMS I (NEXTSL /FIND FIRST OPEN SLOT
1550 DCA OBLOCK /AND SET IT
1551 CDF 10
1552 TAD I [MOUTPU
1553 DCA OUNIT /SET UNIT
1554 TAD OBLOCK
1555 AND [17
1556 CLL RTR
1557 RTR
1558 RAR
1559 DCA I [OBUF10+2 /SET FIRST BLOCK POINTER
1560 TAD OBLOCK
1561 CLL RTR
1562 RTR
1563 AND [77
1564 DCA I [OBUF10+1 /SET FIRST BLOCK POINTER
1565 DCA I [OBUF10 /ZERO LINK POINTER
1566 DCA CHARNO /RESET CHARACTER NUMBER
1567 TAD (OBUF10+3
1568 DCA OPOINT /RESET POINTER
1569 CDF
1570 JMP I OOPN10 /EXIT
1571 \f/OPEN PDP-10 INPUT FILE
1572 /
1573 /CALL:
1574 / (AC) /POINT TO FILE NAME-1
1575 / JMS IOPN10 /OPEN PDP-10 INPUT FILE
1576 / -NO- /NOT THERE
1577 / (AC) /ANY BLOCK OF THE FILE
1578
1579 IOPN10, 0 /OPEN PDP-10 INPUT FILE
1580 JMS I (FIND /FIND THE FILE
1581 JMP I IOPN10 /NOT THERE
1582 DCA IOPN1B /SAVE SLOT NUMBER
1583 TAD (143
1584 DCA IOPN1A
1585 TAD (CLA CMA
1586 DCA IOPN1D
1587 IOPN1F, JMS I (FINDSL /FIND A SLOT
1588 IOPN1A, 0 /SLOT TO FIND
1589 CIA
1590 TAD IOPN1B /IS IT US?
1591 SNA CLA
1592 JMP IOPN1C /YES
1593 IOPN1D, CLA CMA
1594 TAD IOPN1A /BUMP BLOCK NUMBER
1595 SPA
1596 JMP IOPN1E /TOO FAR
1597 TAD [-1102
1598 SMA
1599 JMP I IOPN10 /TOO FAR - EXIT
1600 TAD (1102
1601 DCA IOPN1A /SET NEW BLOCK
1602 JMP IOPN1F /RETRY
1603
1604 IOPN1B, 0 /SLOT THAT WE WANT
1605
1606 IOPN1E, CLA
1607 TAD (CLA IAC
1608 JMP IOPN1F-1 /CHANGE DIRECTION AND RETRY
1609
1610 IOPN1C, TAD IOPN1A
1611 CDF
1612 ISZ IOPN10
1613 JMP I IOPN10 /EXIT
1614 PAGE
1615 \f/CONVERT OS8 DATE TO PDP-10 DATE
1616
1617 CVDATE, 0
1618 SNA
1619 JMP I CVDATE /0 CONVERTS TO 0
1620 DCA TEMP1
1621 TAD TEMP1 /V3C
1622 RTR
1623 RAR
1624 AND [37
1625 TAD (-1 /GET DAY
1626 DCA DATE4 /V3C
1627 TAD TEMP1
1628 AND [7 /GET OS8 YEAR (-1970)
1629 DECIMAL
1630 TAD (1970-1964
1631 OCTAL
1632 DCA DATE1 /SAVE YEAR
1633 TAD DATE1
1634 CLL RAL /*2
1635 TAD DATE1 /*2+1=*3
1636 CLL RTL /*3*4=*12
1637 DCA DATE1 /DATE1=DATE1*12
1638 TAD TEMP1
1639 RTL
1640 RTL
1641 RAL
1642 AND [17 /GET MONTH
1643 TAD (-1
1644 TAD DATE1 /ADD IN MONTH
1645 DCA DATE1
1646 TAD DATE1
1647 CLL RAL /*2
1648 TAD DATE1 /*2+1=*3
1649 DCA TEMP2
1650 TAD TEMP2
1651 CLL RTL /*3*4=*12
1652 TAD TEMP2 /*12+*3=*15
1653 CLL RAL /*15*2=*30
1654 TAD DATE1 /*30+1=*31
1655 TAD DATE4 /V3C ADD IN DAY
1656 DCA DATE1 /DATE1=DATE1+MONTH-1 * 31
1657 RAL /V3C LINK NOW HAS HIGH ORDER DATE BIT
1658 DCA HIDATE /ONLY WITHIN RANGE OF OS/8
1659 TAD DATE1 /RETURN LOW ORDER 12 BITS OF DATE
1660 JMP I CVDATE
1661
1662 DATE1, 0
1663 DATE4, 0
1664
1665 /TYPE A PDP-10 DATE
1666 \fDATE10, 0
1667 SZL /LINK HAD HIGH ORDER BIT
1668 TAD (4 /IF ON, WANT ADDITIONAL 11 YEARS, 4 DAYS
1669 DCA DATE1 /SAVE VALUE
1670 RAL /V3C
1671 DCA DATE75 /SAVE FACT THAT NEED 'NUTHER 11 YEARS
1672 TAD (100 /V3C BASE IS (19)64
1673 DCA DATE2 /WILL BE YEAR
1674 DATE11, TAD DATE1
1675 SMA CLA
1676 JMP DATE12 /MUST BE POSITIVE
1677 ISZ DATE2 /BUMP YEAR
1678 TAD DATE1
1679 TAD (-564 /-372 DECIMAL (DAYS PER YEAR)
1680 DCA DATE1
1681 JMP DATE11
1682
1683 DATE12, DCA DATE3 /WILL BE MONTH
1684 TAD DATE1 /DIVIDE BY 31
1685 TAD (-37
1686 SPA
1687 JMP .+4
1688 ISZ DATE3 /BUMP MONTH
1689 DCA DATE1
1690 JMP .-6
1691
1692 CLA
1693 ISZ DATE1 /+1 IS DAY
1694 TAD DATE3 /DIVIDE BY 12
1695 TAD (-14
1696 SPA
1697 JMP .+4
1698 ISZ DATE2 /BUMP YEAR
1699 DCA DATE3
1700 JMP .-6
1701
1702 CLA
1703 TAD DATE1
1704 TAD (-12
1705 SMA CLA
1706 JMP DATE9
1707 TAD ("0
1708 JMS I OUTPUT /PRINT LEADING 0 IF NECESSARY
1709 DATE9, TAD DATE1
1710 JMS I (PRINT /PRINT DAY
1711 TAD ("-
1712 JMS I OUTPUT
1713 TAD DATE3
1714 TAD DATE3
1715 TAD DATE3 /V3C MULTIPLY BY 3
1716 TAD (MONTBL /ADD IN BASE OF MONTH NAMES
1717 DCA MONPTR /POINT TO PROPER MONTH NAME
1718 TAD I MONPTR /GET CHAR 1
1719 JMS I OUTPUT /PRINT IT
1720 ISZ MONPTR /POINT TO NEXT CHAR
1721 TAD I MONPTR /GET CHAR 2
1722 JMS I OUTPUT /PRINT IT
1723 ISZ MONPTR /V3C
1724 TAD I MONPTR
1725 JMS I OUTPUT
1726 TAD ("-
1727 JMS I OUTPUT
1728 TAD DATE75 /V3C
1729 SZA CLA
1730 TAD (13 /ADD 11 YEARS IF H.O. BIT ON
1731 TAD DATE2
1732 JMS I (PRINT /PRINT YEAR
1733 JMP I DATE10
1734
1735 DATE2, 0 /YEAR
1736 DATE3, 0 /MONTH
1737 MONPTR, 0 /V3C POINTS TO MONTH NAME
1738 PAGE
1739 \fDECIMAL
1740 PRINTL, -1000
1741 -100
1742 -10
1743 OCTAL
1744
1745 PRINTZ, 0 /PRINT WITH LEADING SPACES
1746 DCA PRINT0
1747 TAD PRINTZ
1748 DCA I (PRINT
1749 TAD (240
1750 JMP I (PRINT7
1751
1752 /ZERO A DIRECTORY (PDP-10)
1753
1754 ZERO10, 0 /ZERO THE PDP-10 DIRECTORY
1755 TAD I [MOUTPU
1756 AND [17
1757 SZA CLA
1758 JMP I (NOT10F /NOT A PDP-10
1759 TAD I [MOUTPU
1760 DCA UNIT10 /SET UNIT
1761 TAD (DIRECT-1
1762 DCA INDEX0 /POINT TO DIRECTORY
1763 TAD (-600
1764 DCA CNTR /COUNT OF 600
1765 DCA I INDEX0 /ZERO THE DIRECTORY
1766 ISZ CNTR
1767 JMP .-2 /LOOP
1768 TAD (7570
1769 DCA I (DIRECT /SAVE BLOCKS 1 AND 2
1770 TAD (170
1771 DCA I (DIRECT+52 /SAVE BLOCK 144
1772 TAD (777
1773 DCA I (DIRECT+367 /SAVE BLOCKS 1102 ON UP
1774 CLA CMA
1775 DCA I (DIRECT+370
1776 JMS I (WRITET /WRITE PDP-10 DECTAPE
1777 DIRECT /DIRECTORY
1778 144 /DIRECTORY BLOCK
1779 CDF 10
1780 JMP I ZERO10 /EXIT
1781 \f/DELETE A PDP-10 FILE
1782
1783 DELE10, 0 /DELETE A PDP-10 FILE
1784 TAD I [MOUTPU
1785 AND [17
1786 SZA
1787 JMP DELOS8 /DELETE A OS8 FILE
1788 TAD I [MOUTPU
1789 DCA UNIT10 /SET UNIT
1790 TAD [MOUTPU
1791 CDF
1792 JMS I (DELETE /DELETE THE PDP-10 FILE
1793 JMP I (ERDELF /NOT THERE
1794 JMS I (WRITET /WRITE PDP-10 DECTAPE
1795 DIRECT
1796 144 /DIRECTORY BLOCK
1797 JMP I DELE10 /EXIT
1798
1799 DELOS8, CIF CDF 10
1800 JMS I (DELPS1 /DELETE A OS8 FILE
1801 JMP I DELE10
1802 JMP I (ERDELF /ERROR DELETING THE FILE
1803 \fPAGE
1804
1805 /GET THE NEXT INPUT FILE
1806
1807 NEXIFL, 0 /GET THE NEXT INPUT FILE
1808 DCA CHARNI /RESET STUFF
1809 DCA WORDS
1810 CDF 10
1811 CLA CMA
1812 DCA I (INCHCT
1813 DCA I (INEOF
1814 TAD (INDEVH+1
1815 DCA INDEVX
1816 TAD I IXR /GET NEXT
1817 SNA
1818 JMP NEXIF2 /E.O.F
1819 DCA IUNIT
1820 TAD I IXR
1821 DCA IBLOCK /SET START BLOCK
1822 CDF
1823 TAD IUNIT
1824 AND [17
1825 SNA
1826 JMP NEXIF1 /PDP-10 FILE
1827 CIF 10
1828 JMS I [200
1829 1
1830 INDEVX, 0
1831 JMP I (NOOFIL
1832 CDF 10
1833 TAD INDEVX
1834 DCA I (INHNDL
1835 TAD IBLOCK
1836 DCA I (INREC
1837 TAD IUNIT
1838 AND [7760
1839 SZA
1840 TAD [17
1841 CLL CML RTR
1842 RTR
1843 DCA I (INCTR
1844 TAD (ICHRPS
1845 JMP NEXIF3
1846
1847 NEXIF1, TAD IUNIT
1848 DCA UNIT10
1849 TAD IBLOCK
1850 DCA .+3
1851 JMS I (READT
1852 IBUF10
1853 0 /READ ANY BLOCK
1854 CDF 10
1855 TAD I [IBUF10+2
1856 RTL
1857 RTL
1858 RAL
1859 AND [17
1860 DCA IBLOCK
1861 TAD I [IBUF10+1
1862 AND [77
1863 CLL RTL
1864 RTL
1865 TAD IBLOCK
1866 DCA IBLOCK /SET START BLOCK
1867 TAD (ICHR10
1868 NEXIF3, DCA INPUT /SET ROUTINE POINTER
1869 ISZ NEXIFL
1870 NEXIF2, CDF
1871 JMP I NEXIFL /EXIT
1872
1873 ICHRPS, 0
1874 CIF CDF 10
1875 JMS I (ICHARP
1876 SKP
1877 ISZ ICHRPS
1878 JMP I ICHRPS
1879
1880 OCHRPS, 0
1881 CIF 10
1882 JMS I (OCHARP
1883 JMP I (IOERR
1884 JMP I OCHRPS
1885 PAGE
1886 \fPIP10, CDF 10 /STARTS HERE - JUMPED TO FROM 200
1887 DCA HIDATE /V3C
1888 TAD I (MDATE /GET TODAY'S DATE
1889 CDF
1890 JMS I (CVDATE /CONVERT IT
1891 DCA DATE /AND STORE IT
1892 TAD (3401 /UNRESTARTABLE, DOESN'T DESTROY BATCH OR USR AREA
1893 DCA I (JSBITS
1894 PIPCD, CDF
1895 JMS I (CD /COMMAND DECODE
1896 CDF 10
1897 TAD I (MPARAM
1898 AND (2010
1899 CLL RAL
1900 DCA MODE /SET /I SWITCH
1901 TAD I (MPARAM+1
1902 AND (400
1903 DCA SAVELN /SET /P SWITCH
1904 TAD I (MPARAM
1905 AND (101
1906 SZA CLA
1907 JMP I (LIST10 /EITHER /F OR /L
1908 TAD I [MOUTPU
1909 SZA CLA
1910 JMP PIP001 /IS AN OUTPUT FILE
1911 TAD I (MINPUT
1912 SNA CLA
1913 JMP PIPCD /NO OUTPUT OR INPUT FILES
1914 JMP I (NOOOFL /INPUT, BUT NO OUTPUT
1915
1916 PIP001, CLL CLA CML RTR
1917 AND I (MPARAM+2
1918 SZA CLA
1919 JMS I (ZERO10 /IT IS /Z OPTION
1920 TAD (OUDEVH+1
1921 DCA OUDEVX
1922 TAD I [MOUTPU
1923 AND [17
1924 SZA
1925 JMP PIPB /OUTPUT IS OS8
1926 TAD I [MOUTPU
1927 DCA UNIT10 /SET UNIT
1928 JMS I (READT
1929 DIRECT /GET DIRECTORY INTO CORE
1930 144
1931 PIPA, CDF 10
1932 TAD OUDEVX
1933 DCA I (OUHNDL
1934 TAD I (MPARAM
1935 AND (400
1936 SZA CLA
1937 JMS I (DELE10 /DELETE A PDP-10 FILE FIRST
1938 CDF 10
1939 TAD (MINPUT-1
1940 DCA IXR
1941 TAD I IXR
1942 SNA CLA
1943 JMP PIPCD /NO INPUT
1944 TAD (MINPUT-1
1945 DCA IXR /SET INPUT LIST
1946 TAD I [MOUTPU
1947 AND [17
1948 CDF
1949 SZA CLA
1950 JMP PIPC /OUTPUT IS OS8
1951 JMS I (OOPN10 /OPEN PDP-10 OUTPUT
1952 TAD (OCHR10
1953 PIPD, DCA OUTPUT /SET OUTPUT ROUTINE
1954 PIPE, SZA CLA /IS IT ERROR OR EOF
1955 JMP I (IOERR /ERROR
1956 JMS I (NEXIFL /GET NEXT FILE
1957 JMP PIPF /FINAL EOF
1958 JMS I INPUT /GET INPUT
1959 JMP PIPE /EOF OR ERROR
1960 JMS I OUTPUT /OUTPUT
1961 JMP .-3 /LOOP
1962
1963 PIPC, CIF CDF 10
1964 JMS I (OOPNPS /OPEN OS8 OUTPUT
1965 JMP I (NOOOFL
1966 TAD (OCHRPS
1967 JMP PIPD
1968
1969 PIPB, CDF 0
1970 CIF 10
1971 JMS I [200
1972 1 /GET OS8 OUTPUT HANDLER
1973 OUDEVX, 0
1974 JMP I (NOOFIL
1975 JMP PIPA
1976
1977 PIPF, CDF 10
1978 TAD I [MOUTPU /NOW CLOSE THE OUTPUT FILE
1979 AND [17
1980 CDF
1981 SZA CLA
1982 JMP PIPG
1983 JMS I (CLOS10
1984 JMP PIPCD
1985
1986 PIPG, CIF CDF 10
1987 JMS I (OCLOSE
1988 JMP I (IOERR
1989 JMP PIPCD
1990 PAGE
1991 \fLIST10, TAD (OUDEVH+1
1992 DCA OUDEVY
1993 TAD (OUDEVH+1
1994 DCA OUDEVZ
1995 TAD (3100 /RESET THINGS
1996 DCA LISTDV+1
1997 TAD I [MOUTPU
1998 SZA
1999 JMP LIST11 /OUTPUT FILE EXISTS
2000 CDF 0
2001 CIF 10
2002 JMS I [200
2003 1
2004 LISTDV, TEXT /TTY/ /LOOKUP THE TTY:
2005 OUDEVY, 0
2006 JMP I (NOOOFL
2007 CDF 10
2008 TAD LISTDV+1
2009 DCA I [MOUTPU /SET TTY: DEVICE NUMBER
2010 TAD I [MOUTPU
2011 LIST11, AND [17
2012 SNA
2013 JMP I (NOTPSF /NOT A OS8 FILE
2014 CDF 0
2015 CIF 10
2016 JMS I [200
2017 1 /LOOKUP DEVICE
2018 OUDEVZ, 0
2019 JMP I (NOOFIL
2020 LIST12, CDF CIF 10
2021 TAD OUDEVZ
2022 DCA I (OUHNDL
2023 JMS I (OOPNPS /OPEN OUTPUT FILE
2024 JMP I (NOOOFL
2025 TAD (OCHRPS
2026 DCA OUTPUT /SET OUTPUT ROUTINE
2027 CDF 10
2028 TAD I (MINPUT
2029 DCA UNIT10
2030 CDF
2031 TAD UNIT10
2032 SNA
2033 JMP I (PIPCD /NO INPUT
2034 AND [17
2035 SZA CLA
2036 JMP I (NOT10F
2037 JMS I (READT /READ THE DIRECTORY
2038 DIRECT
2039 144
2040 TAD (LISTL-1
2041 DCA INDEX0
2042 TAD (-40
2043 DCA CNTR
2044 DCA I INDEX0 /CLEAR THE COUNTS
2045 ISZ CNTR
2046 JMP .-2
2047 TAD (-1101
2048 DCA LIST13
2049 CLA IAC
2050 DCA LIST14
2051 JMS I (FINDSL /FIND ALL SLOTS
2052 LIST14, 0
2053 TAD (LISTL
2054 DCA LIST15
2055 ISZ I LIST15 /COUNT THE NUMBER IN EACH SLOT
2056 ISZ LIST14
2057 ISZ LIST13
2058 JMP LIST14-1
2059 JMS I (CRLF
2060 TAD I (LISTL
2061 JMS I (PRINTZ /PRINT FREE BLOCKS
2062 TAD (LISTM1-1
2063 DCA INDEX0
2064 JMS I (ERROR4 /"FREE BLOCKS"
2065 JMS I (CRLF
2066 TAD (-26
2067 DCA LIST13
2068 TAD (DIRECT+370
2069 DCA INDEX6
2070 TAD (DIRECT+2 /HIGH ORDER BIT (4096'S) OCCURS AT END OF EACH
2071 DCA XDATE /PDP-10 WORD AT BEGIN OF DIRECTORY
2072 /THIS IS END OF EVERY 3RD PDP-8 WORD
2073 LIST17, CDF 10 /MAIN LOOP
2074 TAD I INDEX6
2075 SNA
2076 JMP I (LIST16 /DO NOT PRINT THIS BLANK ENTRY
2077 JMS I (LIST18
2078 TAD I INDEX6
2079 JMS I (LIST18
2080 TAD I INDEX6
2081 JMS I (LIST18
2082 CDF
2083 TAD (".
2084 JMS I OUTPUT
2085 JMP I (LIST22
2086
2087 LIST13, 0
2088 LIST15, 0
2089 PAGE
2090 \fLIST22, CDF 10
2091 TAD INDEX6
2092 TAD [77
2093 DCA INDEX5
2094 TAD I INDEX5 /GET EXTENSION
2095 JMS LIST18
2096 TAD I INDEX5
2097 AND [7700
2098 JMS LIST18
2099 CLA IAC
2100 AND I (MPARAM
2101 SNA CLA
2102 JMP LIST19 /NO EXTRA IF NOT /L
2103 JMS LIST18
2104 CDF
2105 TAD I (LIST13
2106 TAD (LISTL+27
2107 DCA LIST23
2108 TAD I LIST23 /GET NUMBER OF BLOCKS
2109 JMS I (PRINTZ
2110 JMS LIST18
2111 TAD I XDATE /V3C
2112 RAR /HIGH ORDER BIT OF DATE TO LINK
2113 CLA
2114 TAD I INDEX5
2115 CDF
2116 JMS I (DATE10
2117 LIST19, CDF
2118 JMS CRLF
2119 LIST20, CDF
2120 TAD XDATE /V3C
2121 TAD (3 /POINT TO NEXT DATE H.O. BIT
2122 DCA XDATE
2123 ISZ I (LIST13
2124 JMP I (LIST17 /LOOP
2125 JMS CRLF
2126 JMP I (PIPG /CLOSE THE FILE
2127
2128 LIST16, ISZ INDEX6
2129 ISZ INDEX6
2130 JMP LIST20
2131
2132 CRLF, 0
2133 TAD [215
2134 JMS I OUTPUT
2135 TAD [212
2136 JMS I OUTPUT
2137 JMP I CRLF
2138
2139 LIST23, 0
2140
2141 LIST18, 0
2142 CDF
2143 DCA TEMP1
2144 TAD TEMP1
2145 RTR
2146 RTR
2147 RTR
2148 JMS LIST21
2149 TAD TEMP1
2150 JMS LIST21
2151 CDF 10
2152 JMP I LIST18
2153
2154 LIST21, 0
2155 AND [77
2156 TAD [240
2157 JMS I OUTPUT
2158 JMP I LIST21
2159 \f/FIND A PDP-10 ENTRY IN DIRECTORY
2160 /
2161 /CALL:
2162 / (AC) /POINT TO NAME-1 (FIELD 1)
2163 / JMS FIND /FIND A PDP-10 ENTRY
2164 / -NO- /NOT FOUND
2165 / (AC) /SLOT NUMBER IF FOUND
2166
2167 FIND, 0 /FIND A PDP-10 FILE
2168 DCA FIND4 /SAVE POINTER
2169 TAD (DIRECT+370
2170 DCA INDEX0 /POINT TO DIRECTORY START
2171 TAD (-26
2172 DCA CNTR /22 DECIMAL FILES
2173 CDF 10 /DIRECTORY IS IN FIELD 1
2174 FIND2, TAD FIND4 /GET POINTER
2175 DCA INDEX2 /POINT TO NAME,EXT
2176 TAD I INDEX0
2177 CIA
2178 TAD I INDEX2 /CHECK WORD 1
2179 SZA CLA
2180 JMP FIND1 /NO
2181 TAD I INDEX0
2182 CIA
2183 TAD I INDEX2 /CHECK WORD 2
2184 SZA CLA
2185 JMP FIND1+1 /NO
2186 TAD I INDEX0
2187 CIA
2188 TAD I INDEX2 /CHECK WORD 3
2189 SZA CLA
2190 JMP FIND1+2 /NO
2191 TAD INDEX0
2192 TAD [77
2193 DCA INDEX1 /POINT TO EXTENSIONS
2194 TAD I INDEX1
2195 CIA
2196 TAD I INDEX2 /CHECK WORD 4
2197 SZA CLA
2198 JMP FIND1+2 /NO
2199 TAD I INDEX1
2200 AND [7700
2201 CIA
2202 TAD I INDEX2 /CHECK WORD 5
2203 SZA CLA
2204 JMP FIND1+2 /NO
2205 CLL CLA CMA RTL
2206 TAD INDEX0
2207 DCA INDEX0 /POINT TO ENTRY AGAIN
2208 TAD CNTR
2209 TAD (27
2210 ISZ FIND /WE FOUND IT - 2ND EXIT
2211 FIND3, CDF /BACK TO FIELD 0
2212 JMP I FIND /EXIT
2213
2214 FIND1, ISZ INDEX0 /EXTRA POINTER BUMPS
2215 ISZ INDEX0
2216 ISZ CNTR /MORE FILES?
2217 JMP FIND2 /YES - LOOP
2218 JMP FIND3 /NO - NOT FOUND
2219
2220 FIND4, 0 /POINTER TO NAME-1
2221 PAGE
2222 \fLINBUF=.
2223 LISTL, ZBLOCK 105
2224
2225 LISTM1, TEXT / FREE BLOCKS PIP10 V/
2226 VERLOC, *.-1
2227 60+VERSION^100+SUBVER
2228 3700
2229
2230 ERMES0, TEXT /_PIP10 CANNOT BE CHAINED TO_/
2231 ERMES1, TEXT #_I/O ERROR_#
2232
2233 ERMES2, TEXT /_DEVICE FULL_/
2234
2235 ERMES3, TEXT /_NO SUCH DEVICE_/
2236
2237 ERMES4, TEXT /_NOT PDP-10 FILE_/
2238
2239 ERMES5, TEXT /_ERROR DELETING FILE_/
2240
2241 ERMES6, TEXT /_NOT OS8 FILE_/
2242
2243 ERMES7, TEXT /_OUTPUT FILE OPEN ERROR_/
2244
2245 ERMES8, TEXT /_SYNTAX ERROR_/
2246 ERMES9, TEXT /_FILE NOT FOUND_/
2247 \f/ROUTINE TO SET TD8E UNIT INFORMATION FROM UNIT10
2248
2249 TDUSET, 0
2250 TAD UNIT10
2251 CLL RTL
2252 RAL
2253 AND (7
2254 TAD (DVCTBL
2255 DCA DVCPTR
2256 RAR
2257 DCA TDUNIT /SAVE EVEN/ODD BIT
2258 TAD (TDUTBL
2259 DCA TDUPTR
2260 TDULP, TAD I TDUPTR
2261 SNA
2262 JMP I TDUSET
2263 DCA TDUT
2264 TAD I TDUT
2265 AND (7
2266 TAD I DVCPTR
2267 DCA I TDUT
2268 ISZ TDUPTR
2269 JMP TDULP
2270 TDUPTR, 0
2271 TDUT, 0
2272 DVCPTR, 0
2273 DVCTBL, 6770;6760;6750;6740
2274
2275 TDUTBL, DIO01
2276 DIO02
2277 DIO03
2278 DIO04
2279 DIO05
2280 DIO06
2281 DIO07
2282 DIO08
2283 DIO09
2284 DIO10
2285 DIO11
2286 DIO12
2287 DIO13
2288 DIO14
2289 DIO15
2290 DIO16
2291 DIO17
2292 DIO18
2293 DIO19
2294 DIO20
2295 DIO21
2296 DIO22
2297 IOTX1
2298 IOTX2
2299 IOTX3
2300 IOTX4
2301 IOTX5
2302 IOTX6
2303 IOTX7
2304 IOTX8
2305 0
2306 PAGE
2307 \f/GET A CHARACTER
2308
2309 GCH, 0
2310 TAD I IXR /GET A CHAR
2311 TAD (-240
2312 SNA
2313 JMP GCH+1 /IGNORE SPACES
2314 TAD (240-"/
2315 SNA
2316 JMP SLASH
2317 TAD ("/-"(
2318 SNA
2319 JMP OPENP
2320 TAD ("(
2321 JMP I GCH /EXIT
2322
2323 SLASH, TAD I IXR
2324 JMS SLSHCH /GET OPTION
2325 JMP GCH+1
2326
2327 OPENP, TAD I IXR
2328 TAD (-")
2329 SNA
2330 JMP GCH+1 /END
2331 TAD (")
2332 JMS SLSHCH /GET OPTION
2333 JMP OPENP
2334
2335 SLSHCH, 0
2336 SNA
2337 JMP I (SYNTAX /ERROR
2338 DCA TEMP6
2339 TAD (MPARAM-1
2340 DCA TEMP5 /POINT TO PARAMETERS
2341 JMS DECODE
2342 JMP I (SYNTAX
2343 SZL
2344 TAD (32 /ADD
2345 TAD (-14
2346 ISZ TEMP5
2347 SMA
2348 JMP .-3 /FIND DIVIDED BY 12
2349 DCA TEMP4
2350 CLL CML
2351 RAL
2352 ISZ TEMP4
2353 JMP .-2 /SHIFT A BIT
2354 DCA TEMP4 /SAVE IT
2355 CDF 10
2356 TAD TEMP4
2357 CMA
2358 AND I TEMP5
2359 TAD TEMP4 /OR IN THAT BIT
2360 DCA I TEMP5
2361 CDF
2362 JMP I SLSHCH
2363
2364 DECODE, 0
2365 TAD TEMP6
2366 TAD (-"9-1
2367 CLL
2368 TAD ("9+1-"0
2369 SZL
2370 JMP DECOD1
2371 TAD ("0-"Z-1
2372 CLL CML
2373 TAD ("Z-"A+1
2374 SNL
2375 DECOD1, ISZ DECODE
2376 JMP I DECODE
2377
2378 EXA40, 0
2379 TAD (CDNAME
2380 DCA TEMP5
2381 TAD (-5
2382 DCA TEMP4
2383 EXA401, CLL CLA CML RAR
2384 TAD I TEMP5
2385 AND [7700
2386 CLL RAL
2387 SZA
2388 RAR
2389 DCA TEMP3
2390 TAD I TEMP5
2391 TAD (40
2392 AND [77
2393 TAD (-40
2394 SZA
2395 TAD (40
2396 TAD TEMP3
2397 DCA I TEMP5
2398 ISZ TEMP5
2399 ISZ TEMP4
2400 JMP EXA401
2401 JMP I EXA40
2402 PAGE
2403 \f/GET A NAME ROUTINE
2404
2405 GNAME, 0
2406 DCA CDDEV /CLEAR AREA
2407 DCA CDDEV+1
2408 CLA CMA
2409 DCA DEVSW /ALLOW DEVICES
2410 GNAME1, DCA CDNAME /CLEAR NAME,EXTENSION
2411 DCA CDNAME+1
2412 DCA CDNAME+2
2413 DCA CDEXT
2414 DCA CDEXT+1
2415 CLA CMA
2416 DCA PERSW /ALLOW EXTENSIONS
2417 TAD (CDNAME
2418 DCA POINT /SET POINTER
2419 DCA CNTR /SET SWITCH
2420 GNAME2, JMS I (GCH /GET A CHAR
2421 DCA TEMP6
2422 TAD TEMP6
2423 SNA
2424 JMP GNAME6 /END
2425 TAD (-":
2426 SNA
2427 JMP GNAME5 /: IS DEVICE
2428 TAD (":-".
2429 SNA
2430 JMP GNAME4 /. IS EXTENSION
2431 TAD (".
2432 DCA TEMP6 /SAVE THE CHAR
2433 JMS I (DECODE
2434 JMP GNAME6-1 /NOT 0-9 OR A-Z IS END
2435 CLA
2436 TAD TEMP6
2437 AND [77 /GET TRIMMED ASCII
2438 ISZ CNTR
2439 JMP GNAME3 /LEFT HALF
2440 TAD I POINT
2441 DCA I POINT /SET RIGHT HALF
2442 ISZ POINT
2443 JMP GNAME2 /LOOP
2444
2445 GNAME3, CLL RTL
2446 RTL
2447 RTL
2448 DCA I POINT /SET LEFT HALF
2449 CLA CMA
2450 DCA CNTR
2451 TAD POINT
2452 TAD (-CDEXT-2
2453 SZA CLA
2454 JMP GNAME2 /LOOP
2455 JMP GNAME2-1 /LOOP - IGNORE
2456
2457 GNAME4, TAD CDNAME
2458 SZA CLA
2459 ISZ PERSW
2460 JMP I (SYNTAX /ERROR
2461 DCA CDEXT
2462 DCA CDEXT+1 /CLEAR EXTENSION
2463 TAD (CDEXT
2464 JMP GNAME2-2 /GET EXTENSION
2465
2466 GNAME5, ISZ DEVSW
2467 JMP I (SYNTAX /ERROR
2468 ISZ PERSW
2469 JMP I (SYNTAX /ERROR
2470 TAD CDNAME
2471 SNA
2472 JMP I (SYNTAX /ERROR
2473 DCA CDDEV
2474 TAD CDNAME+1
2475 DCA CDDEV+1 /SET DEVICE
2476 JMP GNAME1 /NOW GET THE NAME
2477
2478 CLA
2479 GNAME6, DCA CDEXT+2
2480 TAD CDEXT+1
2481 AND [7700
2482 DCA CDEXT+1
2483 ISZ PERSW
2484 JMP I GNAME /EXIT
2485 DCA CDEXT
2486 DCA CDEXT+1 /CLEAR EXTENSION
2487 JMP I GNAME /EXIT
2488 PAGE
2489 \fCD, 0
2490 TAD [MOUTPU-1
2491 DCA INDEX0
2492 TAD (-47
2493 DCA CNTR
2494 CDF 10
2495 DCA I INDEX0 /CLEAR AREAS
2496 ISZ CNTR
2497 JMP .-2
2498 CDF
2499 CIF 10
2500 JMS I [200
2501 13 /RESET TABLES
2502 0
2503 DCA INSEG /NO DIRECTORY IN CORE
2504 DCA PDP10D /NO KNOWN PDP-10 DRIVES
2505 DCA PDP10D+1
2506 DCA PDP10D+2
2507 DCA PDP10D+3
2508 DCA PDP10D+4
2509 DCA PDP10D+5
2510 DCA PDP10D+6
2511 DCA PDP10D+7
2512 DCA CDCNT /ZERO INPUT COUNT
2513 JMS I (GLINE /GET A LINE
2514 TAD [LINBUF-1
2515 DCA IXR
2516 TAD I IXR
2517 SNA
2518 JMP NOBAKB /NO "<" IS LINE
2519 TAD (-"<
2520 SZA CLA
2521 JMP .-5
2522 TAD [LINBUF-1
2523 DCA IXR
2524 TAD XDSK
2525 DCA CDDEVF /SET "DSK" AS DEFAULT
2526 TAD XDSK+1
2527 DCA CDDEVF+1
2528 JMS I (GNAME /GET THE NAME
2529 TAD TEMP6
2530 TAD (-"[
2531 SZA CLA
2532 JMP CDX03 /NO SIZE SPECIFIED
2533 CDX01, JMS I (GCH
2534 TAD (-"]
2535 SNA
2536 JMP CDX02 /END OF SIZE
2537 TAD ("]-"0
2538 SPA
2539 JMP I (SYNTAX /ERROR
2540 DCA TEMP1
2541 TAD CDEXT+2
2542 CLL RTL
2543 TAD CDEXT+2
2544 RAL
2545 TAD TEMP1
2546 DCA CDEXT+2 /ADD IN NUMBER
2547 TAD TEMP1
2548 TAD (-11
2549 SMA SZA CLA
2550 JMP I (SYNTAX /ERROR
2551 JMP CDX01
2552
2553 CDX02, JMS I (GCH
2554 SKP
2555 CDX03, TAD TEMP6
2556 TAD (-"<
2557 SZA CLA
2558 JMP I (SYNTAX /ERROR
2559 JMS I (CDOUTX /SET OUTPUT STUFF
2560 NOBAKA, TAD (MINPUT-1
2561 DCA INDEX6
2562 TAD XDSK
2563 DCA CDDEVF /SET DEFAULT
2564 TAD XDSK+1
2565 DCA CDDEVF+1
2566 TAD IXR
2567 DCA CDI04 /SAVE POINTER
2568 JMS I (GCH
2569 SNA CLA
2570 JMP I CD /NO INPUT FILES
2571 TAD CDI04
2572 DCA IXR /RESET POINTER
2573 CDI01, JMS I (GNAME /GET A FILE
2574 ISZ DEVSW
2575 JMP CDI02 /DEVICE SPECIFIED
2576 TAD CDDEVF
2577 DCA CDDEV
2578 TAD CDDEVF+1
2579 DCA CDDEV+1 /SET DEFAULT DEVICE
2580 CDI02, TAD CDDEV
2581 DCA CDDEVF
2582 TAD CDDEV+1
2583 DCA CDDEVF+1 /SET NEW DEFAULT
2584 ISZ CDCNT /COUNT INPUT FILES
2585 TAD CDCNT
2586 TAD (-12
2587 SMA CLA
2588 JMP I (SYNTAX /TOO MANY FILES
2589 JMS I (CDINX /SET INPUT STUFF
2590 TAD TEMP6
2591 SNA
2592 JMP I CD /MAIN EXIT
2593 TAD (-",
2594 SNA CLA
2595 JMP CDI01
2596 JMP I (SYNTAX /ERROR
2597
2598 NOBAKB, TAD [LINBUF-1
2599 DCA IXR
2600 JMP NOBAKA
2601 PAGE
2602 \fCDOUTX, 0 /SET OUTPUT STUFF
2603 ISZ DEVSW
2604 JMP CDOUT9 /DEVICE SPECIFIED
2605 TAD CDNAME
2606 SNA CLA
2607 JMP I CDOUTX /NO NAME AND NO DEVICE IS NOTHING
2608 TAD CDDEVF
2609 DCA CDDEV
2610 TAD CDDEVF+1
2611 DCA CDDEV+1 /SET DEFAULT DEVICE
2612 CDOUT9, TAD (OUDEVH+1
2613 DCA CDOUT2 /SET OUTPUT HANDLER ADDRESS
2614 TAD [MOUTPU-1
2615 DCA INDEX6
2616 TAD CDDEV
2617 DCA CDOUT1
2618 TAD CDDEV+1
2619 DCA CDOUT1+1 /SET DEVICE
2620 CIF 10
2621 JMS I [200
2622 12 /FIND HANDLER
2623 CDOUT1, 0
2624 0
2625 CDOUT2, 0
2626 JMP I (NOOFIL
2627 TAD CDOUT1+1
2628 JMS I (GTDVTP /GET DEVICE TYPE AND COMPARE WITH TC08 AND TD8E
2629 SZA CLA
2630 JMP CDOUT3 /NOT DECTAPE
2631 TAD (OUDEVH+1
2632 DCA CDOUT5
2633 TAD CDOUT1+1
2634 CIF 10
2635 JMS I [200
2636 1 /GET HANDLER
2637 CDOUT5, 0
2638 JMP I (NOOFIL
2639 TAD CDOUT5
2640 JMS SETUNT /SET UP PHYSICAL UNIT FROM HANDLER ENTRY POINT
2641 JMS I (ROCK /CHECK THE TAPE
2642 JMP CDOUT3 /NOT PDP-10 DECTAPE
2643 JMS I (EXA40 /EXCESS 40 CONVERSION
2644 TAD UNIT10
2645 JMP CDOUT4 /SET PARAMETERS
2646
2647 CDOUT3, DCA CDEXT+1
2648 TAD CDEXT+2 /GET LENGTH
2649 TAD (-400
2650 SPA CLA
2651 TAD CDEXT+2 /O.K. - USE LENGTH
2652 CLL RTL
2653 RTL
2654 AND [7760 /8 BIT LENGTH
2655 TAD CDOUT1+1 /ADD IN DEVICE NUMBER
2656 CDOUT4, CDF 10
2657 DCA I INDEX6 /SET DEVICE
2658 TAD CDNAME
2659 DCA I INDEX6 /SET NAME
2660 TAD CDNAME+1
2661 DCA I INDEX6
2662 TAD CDNAME+2
2663 DCA I INDEX6
2664 TAD CDEXT
2665 DCA I INDEX6
2666 TAD CDEXT+1
2667 DCA I INDEX6
2668 CDF
2669 JMP I CDOUTX /EXIT
2670
2671 SETUNT, 0
2672 STL
2673 TAD (-7607
2674 SZA /IF IT IS 7607,
2675 TAD (7 /ITS UNIT 0
2676 AND (7
2677 CLL CML RTR
2678 RTR
2679 DCA UNIT10
2680 TAD DVTYPE
2681 AND (10
2682 SNA CLA
2683 JMP I SETUNT /TC08 - FINISHED
2684 CLL
2685 TAD UNIT10
2686 AND (7000 /TD8E ENTRY POINTS ARE STRANGE -
2687 TAD UNIT10 /MUST ROTATE UNIT NUMBER LEFT 1
2688 SZL
2689 TAD (1000
2690 DCA UNIT10
2691 JMS I (TDUSET /SET UP TD8E OPCODES
2692 JMP I SETUNT
2693 PAGE
2694 \fCDINX, 0 /SET INPUT STUFF
2695 TAD (OUDEVH+1
2696 DCA CDIN1
2697 TAD CDDEV
2698 DCA CDIN2 /SET DEVICE
2699 TAD CDDEV+1
2700 DCA CDIN2+1
2701 CIF 10
2702 JMS I [200
2703 1 /GET HANDLER
2704 CDIN2, 0
2705 0
2706 CDIN1, 0
2707 JMP I (NOOFIL
2708 TAD CDIN2+1
2709 JMS GTDVTP /COMPARE DCB ENTRY WITH TC08 OR TD8E
2710 SZA CLA
2711 JMP CDIN3 /NOT DECTAPE
2712 TAD CDIN1
2713 JMS I (SETUNT /SET UP UNIT NUMBER
2714 JMS I (ROCK /CHECK THE TAPE
2715 JMP CDIN3 /NOT PDP-10 DECTAPE
2716 JMS I (EXA40 /DO EXCESS 40
2717 TAD INSEG
2718 CIA
2719 TAD UNIT10 /IS DIRECTORY IN CORE?
2720 SNA CLA
2721 JMP CDIN8 /YES - NO READ
2722 TAD CDNAME
2723 SNA CLA
2724 JMP CDIN7 /NO NAME - NO READ
2725 JMS I (READT
2726 DIRECT /READ DIRECTORY
2727 144
2728 TAD UNIT10
2729 DCA INSEG /SET DIRECTORY IN CORE
2730 CDIN8, TAD (-5
2731 DCA CNTR
2732 TAD (CDNAME-1
2733 DCA INDEX0
2734 TAD (CDINXX-1
2735 DCA INDEX1
2736 TAD I INDEX0
2737 CDF 10
2738 DCA I INDEX1
2739 CDF
2740 ISZ CNTR
2741 JMP .-5
2742 TAD (CDINXX-1
2743 JMS I (IOPN10 /OPEN THE PDP-10 FILE
2744 JMP I (FNOTFD
2745 CDIN7, DCA CDIN4
2746 TAD UNIT10
2747 JMP CDIN6
2748
2749 CDIN3, TAD (CDNAME
2750 DCA CDIN4
2751 TAD CDNAME
2752 SNA CLA
2753 JMP CDIN9 /NO LOOKUP IF NO NAME
2754 TAD CDIN2+1
2755 CIF 10
2756 JMS I [200
2757 2
2758 CDIN4, CDNAME /LOOKUP
2759 CDIN5, 0
2760 JMP I (FNOTFD
2761 TAD CDIN5
2762 TAD (400
2763 SPA
2764 CLA
2765 CLL RTL
2766 RTL
2767 AND [7760 /GET LENGTH
2768 TAD CDIN2+1 /ADD DEVICE
2769 CDIN6, CDF 10
2770 DCA I INDEX6
2771 TAD CDIN4
2772 DCA I INDEX6 /SET BLOCK STARTING
2773 CDF
2774 JMP I CDINX
2775
2776 CDIN9, DCA CDIN4
2777 JMP CDIN6-1
2778
2779 GTDVTP, 0
2780 TAD (DCB-1
2781 DCA TEMP1
2782 CDF 10
2783 TAD I TEMP1 /GET DCB ENTRY
2784 CDF
2785 DCA DVTYPE
2786 TAD DVTYPE
2787 AND (770
2788 TAD (-210
2789 SZA
2790 TAD (30
2791 JMP I GTDVTP
2792 PAGE
2793 \fROCK, 0
2794 JMS GET10D /GET ENTRY IN TAPE TYPE TABLE
2795 SNA
2796 JMP ROCK4 /UNKNOWN - ROCK IT
2797 SMA CLA
2798 ISZ ROCK
2799 JMP I ROCK /EXIT
2800
2801 GET10D, 0
2802 TAD UNIT10
2803 CLL RTL
2804 RTL
2805 TAD (PDP10D
2806 DCA TEMP5 /POINT TO KNOWN TABLE
2807 TAD I TEMP5
2808 JMP I GET10D
2809
2810 ROCK4, CLA CMA
2811 DCA I TEMP5
2812 TAD DVTYPE
2813 AND (10
2814 SZA CLA /WHAT KIND OF TAPE?
2815 JMP TDCHK /TD8E
2816 TAD (OBUF10-1
2817 DCA I (7755
2818 TAD (10
2819 DTLB
2820 ROCK1, RTL
2821 RAL
2822 SZL CLA
2823 TAD (-400
2824 TAD UNIT10
2825 TAD (210
2826 DTCA DTXA
2827 ROCK2, JMS DTWAIT
2828
2829 ROCK3, SPA
2830 JMP ROCK1
2831 CLA
2832 TAD (OBUF10-1
2833 DCA I (7755
2834 TAD (-600
2835 DCA I (7754
2836 TAD (30
2837 DTXA
2838 DTSF DTRB
2839 JMP .-1
2840 SPA CLA
2841 JMP ROCK4 /RETRY
2842 TAD [200
2843 DTXA /STOP DRIVE
2844 TAD I (7754
2845 SZA CLA
2846 JMP I ROCK /OS8 UNIT
2847 CLA IAC
2848 SET10, DCA I TEMP5
2849 ISZ ROCK
2850 JMP I ROCK /PDP-10 UNIT
2851
2852 DTWAIT, 0 /WAIT FOR DECTAPE FLAG
2853 DTSF DTRB
2854 SKP CLA
2855 JMP I DTWAIT
2856 KSF
2857 JMP DTWAIT+1
2858 TAD [200
2859 KRS
2860 TAD (-203
2861 SZA CLA
2862 JMP DTWAIT+1
2863 TAD [200
2864 DTXA /STOP THE TAPE
2865 JMP I [7600
2866
2867 TDCHK, CLA STL RTR
2868 TAD TDUNIT
2869 IOTX1, SDLC
2870 CLA
2871 IOTX2, SDRC
2872 AND (100 /CHECK FOR TAPE NOT READY
2873 SZA CLA
2874 JMP TDCHK /WAIT FOR TAPE TO COME UP
2875 TAD TDUNIT
2876 TAD (1000
2877 IOTX3, SDLC
2878 JMS SKIP4
2879 JMS SKIP4
2880 IOTX4, SDSS
2881 JMP .-1
2882 IOTX5, SDRC
2883 AND [77
2884 TAD (-26
2885 SZA CLA /WAIT FOR GUARD
2886 JMP IOTX4
2887 DCA TDT
2888 TDCLP, JMS SKIP4
2889 ISZ TDT
2890 AND [77
2891 TAD (-51 /SEARCH FOR SOME CRAP NEAR END OF RECORD
2892 SZA CLA
2893 JMP TDCLP
2894 TAD I (UNIT
2895 IOTX6, SDLC /STOP TAPE
2896 CLA
2897 TAD TDT
2898 TAD (-611 /9 WORDS FOR GOOD LUCK
2899 SZA CLA
2900 JMP I ROCK
2901 STL RTL /SET TABLE ENTRY TO 2 FOR TD8E TAPE
2902 JMP SET10
2903
2904 SKIP4, 0
2905 IOTX7, SDSQ
2906 JMP .-1
2907 IOTX8, SDRC
2908 JMP I SKIP4
2909 TDT, 0
2910 PAGE
2911 FIELD 0 /DUMP PG 0 LITERALS HERE
2912 \f/TD8E DECTAPE ROUTINE
2913 /VERSION 01
2914
2915 /JULY 2 1971 GB/RL/EF
2916
2917 /COPYRIGHT 1971 DIGITAL EQUIPMENT CORP.
2918 / MAYNARD, MASS.
2919
2920 /ABSTRACT--
2921 / THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
2922 /DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
2923 /CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
2924 /WHICH IS COMPATIBLE WITH PS/8 DEVICE HANDLER CALLING
2925 /SEQUENCES.
2926 \f
2927 /THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
2928 /VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
2929 /CONTROL:
2930 /A) WHAT DRIVES (UNITS 0-7) WILL BE USED
2931 /B) THE ORIGIN OF THE TWO PAGE ROUTINE
2932 /C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
2933 /D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
2934
2935 /FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
2936 /DEC VERSION OF THIS ROUTINE:
2937
2938 DRIVE=10 /UNITS 0 AND 1 SELECTED
2939 ORIGIN=6200 /ENTRIES AT 6200 AND 6204
2940 AFIELD=0 /INITIAL FIELD SETTING
2941 MFIELD=00 /AFIELD*10=MFIELD
2942 WDSBLK=600 /384 WORDS PER BLOCK
2943
2944 /THE USE OF THE PARAMETERS IS AS FOLLOWS:
2945
2946 / DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
2947 / DRIVE=10 IMPLIES UNITS 0 &1
2948 / DRIVE=20 IMPLIES UNITS 2&3
2949 / DRIVE=30 IMPLIES UNITS 4&5
2950 / DRIVE=40 IMPLIES UNITS 6&7
2951
2952 /ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
2953 / MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
2954 /THAT THIS IS A TWO PAGE ROUTINE.
2955
2956 /AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
2957 / LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
2958
2959 /MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
2960 / THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
2961 / THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
2962
2963 /WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE
2964 / IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
2965 / 128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
2966 / BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
2967 / FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
2968 / FORMATTED TO CONTAIN.
2969
2970 /IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
2971 /FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
2972 /PER BLOCK, THE PARAMETERS WOULD BE:
2973 / DRIVE=20
2974 / ORIGIN=3000
2975 / AFIELD=2
2976 / MFIELD=20
2977 / WDSBLK=400
2978 \f
2979 /THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
2980 /CALLING SEQUENCE FOR PS/8 DEVICE HANDLERS.
2981 /THE CALLING SEQUENCE IS:
2982
2983 / CDF CURRENT
2984 / CIF MFIELD /MFIELD=FIELD ASSEMBLED IN
2985 / JMS ENTRY /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
2986 /AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
2987 / ARG1
2988 / ARG2
2989 / ARG3
2990 / ERROR RETURN
2991 / NORMAL RETURN
2992
2993 /THE ARGUMENTS ARE:
2994
2995 /ARG1: FUNCTION WORD BIT0: 0=READ, 1=WRITE
2996 / BITS 1-5: # BLOCKS IN OPERATION
2997 / BITS 6-8: FIELD OF BUFFER AREA
2998 / BIT 9: UNUSED
2999 / BIT 10: # OF WORDS/BLOCK.
3000 / 0= WDSBLK, 1=WDSBLK-1
3001 / BIT 11: 1=START FORWARD, 0=REVERSE
3002
3003 /ARG2: BUFFER ADDRESS FOR OPERATION
3004 /ARG3: STARTING BLOCK FOR OPERATION
3005
3006 /ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
3007 /A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
3008 / TOO GREAT A BLOCK NUMBER
3009 / FATAL ERRORS TAKE ERROR RETURN WITH THE
3010 / AC=4000.
3011 /B) NON-FATAL- SELECT ERROR.
3012 / IF NO PROPER UNIT IS SELECTED, THE ERROR
3013 / RETURN IS TAKEN WITH CLEAR AC.
3014 /FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
3015 /THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
3016 /BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
3017 \f
3018 /THE TD8E IOT'S ARE:
3019 SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
3020 SDST=7002-DRIVE /SKIP ON TIMING ERROR
3021 SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
3022 SDLC=7004-DRIVE /LOAD COMMAND REGISTER
3023 SDLD=7005-DRIVE /LOAD DATA REGISTER
3024 SDRC=7006-DRIVE /READ COMMAND REGISTER
3025 SDRD=7007-DRIVE /READ DATA REGISTER
3026
3027 /THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
3028 /THE OTHERS CONTROL UNITS 2-7.
3029
3030 BLOCK=DTA1
3031
3032 FIELD AFIELD
3033 *ORIGIN
3034 DTA0, 0 /ENTRY POINT FROM UNIT 0
3035 CLA CLL /0 TO LINK
3036 JMP DTA1X
3037 C1000, 1000
3038 DTA1, 0 /UNIT 2 ENTRY
3039 CLA CLL CML /1 TO LINK
3040 TAD DTA1
3041 DCA DTA0 /PICK UP ARGS AT DTA0
3042 DTA1X, RAR
3043 DCA UNIT /LINK TO UNIT POSITION
3044 RDF
3045 TAD C6203 /GET DATA FIELD AND SETUP RETURN
3046 DCA LEAVE
3047 TAD I DTA0 /GET FUNCTION WORD
3048 DIO01, SDLD /PUT FUNCTION INTO DATA REGISTER
3049 CLL RTR /AC STILL HAS FUNCTION. PUT # WORDS PER
3050 /BLOCK INTO LINK
3051 SZL CLA /KNOCK ONE OFF WDSBLK?
3052 IAC /YES
3053 TAD MWORDS
3054 DCA WCOUNT /STORE MASTER WORD COUNT
3055 ISZ DTA0 /TO BUFFER
3056 TAD I DTA0
3057 DCA BUFF
3058 ISZ DTA0 /TO BLOCK NUMBER
3059 TAD I DTA0
3060 DCA BLOCK
3061 ISZ DTA0 /POINT TO ERROR EXIT
3062 CIF CDF MFIELD /TO ROUTINES DATA FIELD
3063 DIO02, SDRD /GET FUNCTION INTO AC
3064 CLL RAL
3065 AND CM200 /GET # PAGES TO XFER
3066 DCA PGCT
3067 DIO03, SDRD
3068 C374, AND C70 /GET FIELD FOR XFER
3069 TAD C6203 /FORM CDF N
3070 DCA XFIELD /IF=0 AND DF=N AT XFER.
3071 CLA CLL CMA RTL
3072 DCA TRYCNT /3 ERROR TRIES
3073 TAD UNIT /TEST FOR SELECT ERROR
3074 DIO04, SDLC
3075 DIO05, SDRC
3076 AND C100
3077 SZA CLA
3078 JMP FATAL-1
3079 \f
3080 DIO06, SDRD /PUT FUNCT INTO XFUNCT IN SECOND PG.
3081 DCA I CXFUN
3082 TAD WCOUNT
3083 DCA I CXWCT
3084 DIO07, SDRD /GET MOTION BIT TO LINK
3085 CLL RAR
3086 JMP GO /AND START THE MOTION.
3087 DIO08,
3088 RWCOM, SDST /ANY CHECKSUM ERRORS?
3089 SZA CLA /OR CHECKSUM ERRORS?
3090 JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS
3091 /SET AT RWCOM. GETCHK SETS IT.
3092 TAD PGCT /NO ERROR..FINISHED XFER?
3093 TAD CM200
3094 SNA
3095 JMP EXIT /ALL DONE. GET OUT
3096 DCA PGCT /NEW PAGE COUNT
3097 ISZ BLOCK /NEXT BLOCK TO XFER
3098 TAD WCOUNT /FORM NEXT BUFFER ADDRESS
3099 CIA
3100 TAD BUFF
3101 DCA BUFF
3102 CLL CML /FORCES MOTION FORWARD
3103 GO, CLA CML RTR /LINK BECOMES MOTION BIT
3104 TAD C1000
3105 TAD UNIT /PUT IN 'GO' AND UNIT #
3106 DIO09, SDLC /LOOK FOR BLOCK NO.
3107
3108 JMS I CRDQUD /WAIT AT LEAST 6 LINES TO LOOK
3109 JMS I CRDQUD
3110 CM200, 7600 /COULD HAVE SAVED A LOC. HERE
3111 DIO10,
3112 SRCH, SDSS
3113 JMP .-1 /WAIT FOR SINGLE LINE FLAG
3114 DIO11, SDRC
3115 CLL RTL /DIRECTION TO LINK. INFO BITS
3116 /ARE SHIFTED.
3117 AND C374 /ISOLATE MARK TRACK BITS
3118 TAD M110 /IS IT END ZONE?
3119 SNA /THE LINK STAYS SAME THRU THIS
3120 JMP ENDZ
3121 TAD M20 /CHECK FOR BLOCK MARK
3122 SZA CLA
3123 JMP SRCH
3124 DIO12, SDRD /GET THE BLOCK NUMBER
3125 SZL /IF WE ARE IN REVERSE, LOOK FOR 3
3126 /BLOCKS BEFORE TARGET BLOCK. THIS
3127 /ALLOWS TURNAROUND AND UP TO SPEED.
3128 TAD C3 /REVERSE
3129 CMA
3130 TAD BLOCK
3131 CMA /IS IT RIGHT BLOCK?
3132 SNA
3133 JMP FOUND /YES..HOORAY!
3134 M110, SZL SNA CLA /NO, BUT ARE WE HEADED FOR IT?
3135 /ABOVE SNA IS SUPERFLUOUS.
3136 JMP SRCH /YES
3137 DIO13,
3138 ENDZ, SDRC /WE ARE IN THE END ZONE
3139 CLL RTL /DIRECTION TO LINK
3140 /V3C SZL CLA /ARE WE IN REVERSE?
3141 JMP GO /YES..TURN US AROUND
3142 /IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
3143 TRY3, CLA CLL /V3C
3144 ISZ TRYCNT
3145 JMP GO /TRY 3 TIMES
3146 JMP FATAL /LINK OFF MEANS AC=4000 ON RETURN
3147 EXIT, ISZ DTA0
3148 CLL CML /AC=0 ON NORMAL RETURN
3149 FATAL, TAD UNIT
3150 DIO14, SDLC /STOP THE UNIT
3151 CLA CML RAR
3152 LEAVE, HLT
3153 JMP I DTA0
3154
3155 \f
3156 C6203, 6203
3157 CRDQUD, RDQUAD
3158 WCOUNT, 0
3159 BUFF, 0
3160 MWORDS, -WDSBLK
3161 UNIT, 0
3162 CXFUN, XFUNCT
3163 M20, -20
3164 PGCT, 0
3165 CXWCT, XWCT
3166 C100, 100
3167 TRYCNT, -3
3168
3169
3170 *ORIGIN+170
3171 FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION?
3172 JMP GO /WRONG..TURN AROUND
3173 TAD UNIT /PUT UNIT INTO LINK
3174 CLL RAL /AC IS NOW 0
3175 C70, 70 /********DON'T MOVE THIS!!!!******
3176 C3, 3
3177 TAD BUFF /GET BUFFER ADDRESS
3178 XFIELD, HLT /INTO NEXT PAGE
3179
3180 *ORIGIN+200
3181
3182 CIF MFIELD
3183 DCA XBUFF /SAVE ADDRESS
3184 RAR /NOW GET UNIT #
3185 DCA XUNIT
3186 SDRC /V3C
3187 SDLC /V3C
3188 TAD XWCT
3189 DCA DWORDS /WORD COUNTER
3190 DIO15,
3191 REVGRD, SDSS
3192 JMP .-1 /LOOK FOR REVERSE GUARD
3193 DIO16, SDRC
3194 AND K77
3195 TAD CM32 /IS IT REVERSE GUARD?
3196 SZA CLA
3197 JMP REVGRD /NO.KEEP LOOKING
3198 TAD XFUNCT /GET FUNCTION READ OR WRITE
3199 K7700, SMA CLA
3200 JMP READ /NEG. IS WRITE
3201 DIO17,
3202 WRITE, SDRC
3203 AND C300 /CHECK FOR WRITE LOCK AND SELECT ERROR
3204 CLL CML /LOCK OUT AND SELECT ARE AC 0 ERRORS
3205 SZA CLA
3206 JMP I CFATAL /FATAL ERROR. LINK MUST BE ON
3207 / JMS RDQUAD /NO ONE EVER USES THIS WORD!
3208 / CLA
3209 STA /V3C HACK FOR PDP-6
3210 JMS WRQUAD /V3C 7777 FOR REV CHECKSUM AND SKIP OVER LOCK
3211 TAD C1400
3212 TAD XUNIT /INITIATE WRITE MODE
3213 DIO18, SDLC
3214 CLA CMA
3215 JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM
3216 CLA CMA
3217 DCA CHKSUM
3218 WRLP, TAD I XBUFF /GLORY BE! THE ACTUAL WRITE!
3219 JMS WRQUAD
3220 ISZ XBUFF /BUMP CORE POINTER
3221 K77, 77 /ABOVE MAY SKIP
3222 ISZ DWORDS /DONE THIS BLOCK?
3223 JMP WRLP /NOT YET..LOOP A WHILE
3224 TAD XFUNCT /IS THE OPERATION FOR WDSBLK PER BLOCK?
3225 CLL RTR /IF NO, WRITE A 0 WORD
3226 SZL CLA
3227
3228 JMS WRQUAD /WRITE A WORD OF 0
3229 JMS GETCHK /DO THE CHECK SUM
3230 JMS WRQUAD /WRITE FORWARD CHECKSUM
3231 JMS WRQUAD /ALLOW CHECKSUM TO BE WRITTEN
3232 JMS WRQUAD /V3C WRITE REST OF CHECKSUM [PDP-6]
3233 JMP I CRWCOM
3234
3235
3236 READ, JMS RDQUAD
3237 JMS RDQUAD
3238 JMS RDQUAD /SKIP CONTROL WORDS
3239 AND K77
3240 TAD K7700 /TACK 7700 ONTO CHECKSUM.
3241 DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY
3242 RDLP, JMS RDQUAD
3243 JMS EQUFUN /COMPUT CHECKSUM AS WE GO
3244 DCA I XBUFF /IT GETS CONDENSED LATER
3245 ISZ XBUFF
3246 C300, 300 /PROTECTION
3247 ISZ DWORDS /DONE THIS OP?
3248 JMP RDLP /NO SUCH LUCK
3249 TAD XFUNCT /IF OP WAS FOR WDSBLK-1, READ AND
3250 CLL RTR /CHECKSUM THE LAST TAPE WORD
3251 SNL CLA
3252 JMP RDLP2
3253 JMS RDQUAD /NOT NEEDED FOR WDSBLK/BLOCK
3254 JMS EQUFUN /CHECKSUM IT
3255 RDLP2, JMS RDQUAD /READ CHECKSUM
3256 AND K7700
3257 JMS EQUFUN
3258 JMS GETCHK /GET SIX BIT CHECKSUM
3259 JMP I CRWCOM
3260
3261 WRQUAD, 0 /WRITE OUT A 12 BIT WORD
3262 JMS EQUFUN /ADD THIS TO CHECKSUM
3263 DIO19, SDSQ /SKIP ON QUADLINE FLAG
3264 JMP .-1
3265 DIO20, SDLD /LOAD DATA ONTO BUS
3266 CLA /SDLD DOESN'T CLEAR AC
3267 JMP I WRQUAD
3268
3269 RDQUAD, 0 /READ A 12 BIT WORD
3270 DIO21, SDSQ
3271 JMP .-1
3272 DIO22, SDRD /READ DATA
3273 JMP I RDQUAD
3274
3275 \f
3276 EQUFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
3277 CMA
3278 DCA EQUTMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
3279 TAD EQUTMP /EQUIVALENCE OF ALL WORDS IN A RECORD
3280 AND CHKSUM /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
3281 CIA /IS ASSOCIATIVE, WE CAN DO IT 12
3282 CLL RAL /BITS AT A TIME AND CONDENSE LATER.
3283 TAD EQUTMP /THIS ROUTINE USES THESE IDENTITIES:
3284 TAD CHKSUM /A+B=(A.XOR.B)+2*(A.AND.B)
3285 DCA CHKSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
3286 TAD EQUTMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
3287 CMA
3288 JMP I EQUFUN
3289
3290 GETCHK, 0 /FORM 6 BIT CHECKSUM
3291 CLA
3292 TAD CHKSUM
3293 CMA
3294 CLL RTL
3295 RTL
3296 RTL
3297 JMS EQUFUN
3298 CLA CLL CML /FORCES LINK ON AT RWCOM
3299 TAD CHKSUM
3300 AND K7700
3301 JMP I GETCHK
3302
3303 CFATAL, FATAL
3304 CRWCOM, RWCOM
3305 XFUNCT, 0
3306 CM32, -32
3307 C1400, 1400
3308 CHKSUM, 0
3309 DWORDS, 0
3310 XBUFF, 0
3311 XWCT, 0
3312 EQUTMP, 0
3313 XUNIT, 0
3314 PAGE
3315 \fFIELD 1
3316
3317 *2000
3318
3319 ZFREE, ZBLOCK 5
3320
3321 INCTR, 0
3322 INHNDL, 0
3323 INPTR, 0
3324
3325 DELPS1, 0
3326 JMS I (200
3327 4
3328 MOUTPU+1
3329 0
3330 ISZ DELPS1
3331 CIF CDF 0
3332 JMP I DELPS1
3333
3334 ICHARP, 0
3335 ISZ INJMP
3336 ISZ INCHCT
3337 INJMPP, JMP INJMP
3338 TAD INEOF
3339 SZA CLA
3340 JMP INEXIT
3341 INGBUF, TAD INCTR
3342 CLL
3343 TAD (INRECS
3344 SNL
3345 DCA INCTR
3346 SZL
3347 ISZ INEOF
3348 CLL CML CMA RTR
3349 RTR
3350 RTR
3351 TAD (INCTL+1
3352 DCA INCTLW
3353 CIF 0
3354 JMS I INHNDL
3355 INCTLW, 0
3356 INBUFP, INBUF
3357 INREC, 0
3358 JMP INERRX
3359 INBREC, TAD INREC
3360 TAD (INRECS
3361 DCA INREC
3362 TAD INCTLW
3363 AND (7600
3364 CLL RAL
3365 TAD INCTLW
3366 AND (7600
3367 CMA
3368 DCA INCHCT
3369 TAD INJMPP
3370 DCA INJMP
3371 TAD INBUFP
3372 DCA INPTR
3373 JMP ICHARP+1
3374
3375 INERRX, ISZ INEOF
3376 SMA CLA
3377 JMP INBREC
3378 INERR, CLL CLA CML RAR
3379 JMP INEXIT
3380
3381 INJMP, HLT
3382 JMP INCHR1
3383 JMP INCHR2
3384 INCHR3, TAD INJMPP
3385 DCA INJMP
3386 TAD I INPTR
3387 AND (7400
3388 CLL RTR
3389 RTR
3390 TAD INCTLW
3391 RTR
3392 RTR
3393 ISZ INPTR
3394 JMP INCOMN
3395
3396 INCHR2, CDF 0
3397 TAD I (MODE
3398 CDF 10
3399 SMA SZA CLA
3400 JMP IC8A1
3401 TAD I INPTR
3402 AND (7400
3403 DCA INCTLW
3404 ISZ INPTR
3405 IC8A2, TAD I INPTR
3406 INCOMN, AND (377
3407 TAD (-232
3408 SNA
3409 JMP INEXIT
3410 TAD (232
3411 ISZ ICHARP
3412 INEXIT, CIF CDF 0
3413 JMP I ICHARP
3414
3415 INEOF, 1
3416 INCHCT, -1
3417
3418 INCHR1, CDF 0
3419 TAD I (MODE
3420 CDF 10
3421 SPA SNA CLA
3422 JMP IC8A2
3423 IC8A3, TAD I INPTR
3424 ISZ INPTR
3425 JMP INEXIT-1
3426
3427 IC8A1, TAD INJMPP
3428 DCA INJMP
3429 ISZ INCHCT
3430 JMP IC8A3
3431 PAGE
3432 \fOOPNPS, 0
3433 TAD (MOUTPU+1
3434 DCA OUBLK
3435 TAD I (MOUTPU
3436 JMS I (200
3437 3
3438 OUBLK, 0
3439 OUELEN, 0
3440 JMP OUEFAL
3441 DCA OUCCNT
3442 JMS I (OUSETP
3443 ISZ OOPNPS
3444 OUEEXT, CIF CDF 0
3445 JMP I OOPNPS
3446
3447 OUEFAL, TAD I (MOUTPU
3448 AND (7760
3449 SNA CLA
3450 JMP OUEEXT
3451 TAD I (MOUTPU
3452 AND (17
3453 DCA I (MOUTPU
3454 JMP OOPNPS+1
3455
3456 OUHNDL, 0
3457
3458 OUTDMP, 0
3459 DCA OUCTLW
3460 TAD OUCCNT
3461 SNA
3462 ISZ OUCTLW
3463 TAD OUBLK
3464 DCA OUREC
3465 TAD OUCTLW
3466 CLL RTL
3467 RTL
3468 RTL
3469 AND (17
3470 TAD OUCCNT
3471 DCA OUCCNT
3472 TAD OUCCNT
3473 CLL CML
3474 TAD OUELEN
3475 SNL SZA CLA
3476 JMP I OUTDMP
3477 CIF 0
3478 JMS I OUHNDL
3479 OUCTLW, 0
3480 OUBUF
3481 OUREC, 0
3482 JMP I OUTDMP
3483 ISZ OUTDMP
3484 JMP I OUTDMP
3485
3486 OCLOSE, 0
3487 CDF 0
3488 TAD I (MODE
3489 CDF 10
3490 SMA SZA CLA
3491 JMP OULLLP+2
3492 JMS I (OTYPE
3493 AND (770
3494 TAD (-PTP
3495 SZA CLA
3496 TAD (232
3497 JMS I (OCHARP
3498 JMP OURET
3499 JMS I (OCHARP
3500 JMP OURET
3501 OULLLP, JMS I (OCHARP
3502 JMP OURET
3503 JMS I (OTYPE
3504 SPA CLA
3505 TAD (100
3506 TAD (77
3507 AND I (OUDWCT
3508 SZA CLA
3509 JMP OULLLP
3510 TAD I (OUDWCT
3511 TAD (OUCTL&3700
3512 SNA
3513 JMP OUDUMP
3514 TAD (4010
3515 JMS OUTDMP
3516 JMP OURET
3517 OUDUMP, TAD I (MOUTPU
3518 JMS I (200
3519 4
3520 MOUTPU+1
3521 OUCCNT, 0
3522 SKP
3523 ISZ OCLOSE
3524 OURET, CIF CDF 0
3525 JMP I OCLOSE
3526 PAGE
3527 \fOUTEMP, 0
3528
3529 OUJMP, HLT
3530 JMP OCHR1
3531 JMP OCHR2
3532 OCHR3, TAD OUTEMP
3533 CLL RTL
3534 RTL
3535 AND (7400
3536 TAD I OUPOLD
3537 DCA I OUPOLD
3538 TAD OUTEMP
3539 CLL RTR
3540 RTR
3541 RAR
3542 AND (7400
3543 TAD I OUPTR
3544 OC8A1, DCA I OUPTR
3545 TAD OUJMPP
3546 DCA OUJMP
3547 ISZ OUPTR
3548 ISZ OUDWCT
3549 JMP OUCOMN
3550 TAD (OUCTL
3551 JMS I (OUTDMP
3552 JMP OUCRET
3553 JMS OUSETP
3554 JMP OUCOMN
3555
3556 OUSETP, 0
3557 TAD (OUCTL&3700
3558 CIA
3559 DCA OUDWCT
3560 TAD (OUBUF
3561 DCA OUPTR
3562 TAD OUJMPP
3563 DCA OUJMP
3564 JMP I OUSETP
3565
3566 OCHARP, 0
3567 DCA OUTEMP
3568 RDF
3569 TAD (CIF CDF 0
3570 DCA OUCRET
3571 CDF 0
3572 TAD I (MODE
3573 SMA SZA CLA
3574 JMP .+4
3575 TAD OUTEMP
3576 AND (377
3577 DCA OUTEMP
3578 CDF 10
3579 ISZ OUJMP
3580 OUJMPP, JMP OUJMP
3581
3582 OCHR2, CDF 0
3583 TAD I (MODE
3584 CDF 10
3585 SMA SZA CLA
3586 JMP OC8A2
3587 TAD OUPTR
3588 DCA OUPOLD
3589 ISZ OUPTR
3590 OCHR1, TAD OUTEMP
3591 DCA I OUPTR
3592 OUCOMN, ISZ OCHARP
3593 OUCRET, CIF CDF 0
3594 JMP I OCHARP
3595
3596 OUPOLD, 0
3597 OUPTR, 0
3598 OUDWCT, 0
3599
3600 OTYPE, 0
3601 TAD I (MOUTPU
3602 AND (17
3603 TAD (DCB-1
3604 DCA OUSETP
3605 TAD I OUSETP
3606 JMP I OTYPE
3607
3608 CDINXX, ZBLOCK 5
3609
3610 OC8A2, ISZ OUPTR
3611 TAD OUTEMP
3612 JMP OC8A1
3613 PAGE
3614 \f$-$-$
3615 \f
My complete PDP-8 universe