projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add README.md
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape4 / PIP.PA
CommitLineData
7af5ad59
PH		 1/3 PIP FOR OS/8 MONITOR
2/
3/
4/
5/
6/
7/
8/
9/
10/
11/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975,1977
12/BY DIGITAL EQUIPMENT CORPORATION
13/
14/
15/
16/
17/
18/
19/
20/
21/
22/
23/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
24/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
25/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
26/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
27/
28/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
29/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
30/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
31/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
32/
33/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
34/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
35/DIGITAL.
36/
37/
38/
39/
40/
41/
42/
43/
44/
45/
46\f/ 4-MAY-1977 FILE: PIP.PA OS/8 VERSION 12A
47/RL/EF/ET.AL./S.R./E.S.
48
49
50
51/ABSTRACT----
52/PIP (PERIPHERAL INTERCHANGE PROGRAM) IS A GENERAL FILE
53/MANIPULATION PROGRAM FOR THE OS/8 PROGRAMMING SYSTEM.
54/PIP ACCOMPLISHES DATA TRANSFERS BETWEEN ANY DEVICES IN THE OS/8
55/CONFIGURATION.
56
57
58/VERSION 3 MODS:
59
60/FIXED PROBLEM WITH ONE-PAGE WRITE
61/IN /S OR /Z, =OPTION IS TAKEN MODULO 100 (OCTAL)
62/ WITH 100, 200, ETC. MEANING USE 0 ADDITIONAL WDS.
63/DATES STILL DON'T LINE UP
64/'0 FREE BLOCKS'
65/ALLOW FILLING UP DEVICE TO VERY LAST BLOCK
66/ALLOW 7-BIT ^C
67/ALTMODE ON CD LINE RETURNS TO MONITOR WHEN DONE
68/NO HALT ON /L IF NO TTY HANDLER (ACTS AS NOP)
69/ /V PRINTS VERSION NUMBER FIRST TIME CALLED
70/ /O AFFIRMS /Y ON ZERO SYS OR ARE YOU SURE
71/=NNNN ON /I OPTION SPECIFIES LENGTH TO CLOSE FILE
72
73
74/MAINTENANCE RELEASE CHANGES:
75
76/1. FIXED LENGTH OF ALL VARIETIES OF RF08
77/2. ADDED RX01 TO INTERNAL LENGTH TABLES
78/3. CHANGED VERSION NUMBER TO V10
79/4. ADDED CHECK FOR 7-BIT CTRL/Z TO ASCII HANDLER
80
81/E.S. DISABLED /E,/F,/L
82/E.S. FIXED /Y OPTION PER SPR
83
84\f/DETAILS OF PIP:
85
86/PIP RUNS WITH THE USR (USER SERVICE ROUTINES) ALWAYS IN CORE.
87/THIS ELIMINATES SWAPPING THE MONITOR. IF ANY CHANGES ARE MADE
88/TO PIP, CARE SHOULD BE TAKEN IN USING PAGE ZERO LOCATIONS, AS
89/THEY MUST NOT DESTROY ANY MONITOR LOCATIONS.
90
91/CORE USED:
92/FIELD 0
93
94/00000-02777- OUTPUT BUFFER
95/03000-06377- INPUT BUFFER
96/06400-06577- USED FOR /Y COMMAND ONLY
97/06600-07177- INPUT HANDLER
98/07200-07577- OUTPUT HANDLER
99
100/FIELD 1
101
102/10000-11777- OS/8 I/O MONITOR
103/12000-16577- EXECUTABLE CODE
104/16600-17177- HOLDS NEW DIRECTORY SEGMENT FOR /S OPTION
105/17200-17577- HOLDS OLD DIRECTORY SEGMENT IN /S OPTION
106
107
108/MAJOR PIECES OF CODE AND THEIR FUNCTION (BRIEFLY).
109/THIS IS A LIST OF ROUTINES AS THEY APPEAR PHYSICALLY, AND
110/NOT AS THEY ARE LOGICALLY CONNECTED.
111
112/ICHAR- GENERAL CHARACTER INPUT ROUTINE. ASSIGNS NEW
113/ DEVICE HANDLERS AS NEEDED.
114
115/OOPEN- ENTERS A FILE ON A SPECIFIED DEVICE.
116
117/OUTDMP- WRITES OUTPUT BUFFER TO OUTPUT DEVICE.
118
119/OCLOSE- CLOSES FILE CREATED BY OOPEN
120
121/OCHAR- CHARACTER OUTPUT ROUTINE. WRITES CHARACTERS
122/ TO OUTPUT BUFFER, CALLING OUTDMP WHEN FULL.
123
124/OTYPE- USES DEVICE NUMBER IN OUTPUT AREA OF CD TO
125/ INSPECT THE DEVICE CONTROL BLOCK WORD. THIS
126/ GIVES A CODE FOR THE TYPE OF DEVICE.
127
128/SLASHG- HANDLES I/O ERRORS. IF /G IS SET, HARD I/O
129/ ERRORS ARE IGNORED. IF /S AND /G ARE ON, A
130/ SPECIAL RETURN IS TAKEN.
131
132/IMAGE- IMAGE MODE PROCESSOR FOR PIP.
133
134/SQTRA- MAIN SUBROUTINE OF IMAGE MODE, AND /S OPTION.
135
136/PIP, PIP+1- MAIN ENTRANCES TO PIP. THE CODE ON THIS PAGE
137/ INSPECTS CD OPTION WORDS AND BRANCHES TO PROPER
138/ ROUTINES.
139
140/ASCII- THE DEFAULT TRANSFER MODE IN PIP IS ASCII.
141
142/DELETE- DELETES FILES ON OUTPUT SIDE OF CD LIST.
143
144/DZERO- ZEROES DIRECTORY OF FIRST OUTPUT DEVICE.
145
146/PIPERR- ERROR ROUTINR FOR PIP.
147
148/DIRPRE- DIRECTORY PRINTING ROUTINE.
149
150/BINARY- BINARY MODE PROCESSOR. HANDLES ABSOLUTE AND
151/ RELOCATABLE BINARY FILES.
152
153/ERPRNT- ERROR PRINTOUT.
154
155/SQUISH- FILE COMPRESSION PROCESSOR. ELIMINATES 'HOLES'
156/ IN DIRECTORY OF INPUT DEVICE.
157
158/SYSCOP- SYSTEM COPY PROCESSOR. ALLOWS TRANSFER OF THE
159/ OS/8 SYSTEM AREA.
160\f/OPTIONS AVAILABLE IN PIP:
161
162/A- ASCII TRANSFER; DEFAULT MODE
163/B- BINARY MODE TANSFER
164/C- DELETE TRAILING BLANKS. (ASCII MODE)
165/D- DELETE FIRST OUTPUT FILE BEFORE PROCEEDING
166/E- LIST INPUT DIRECTORY INCLUDING EMPTY FILES
167/F- LIST INPUT DIRECTORY; ONLY FILE NAMES
168/G- IGNORE ERRORS WHILE TRANSFERING
169/I- IMAGE MODE TRANSFER
170/L- LIST INPUT DIRECTORY; EXCLUDE EMPTY FILES
171/O- OK TO PERFORM A SQUISH OR ZERO WITHOUT ASKING
172/S- COMPRESS INPUT DEVICE ONTO OUTPUT DEVICE. ELIMINATES
173/ 'HOLES' ON INPUT DEVICE.
174/T- PROVIDE SIMPLE TTY FORMATTING. (ASCII ONLY)
175/Y- COPY OS/8 SYSTEM AREA
176/Z- ZERO OUTPUT DEVICE DIRECTORY BEFORE PROCEEDING
177/=N- LEAVE N WORDS EXTRA PER DIRECTORY ENTR. VALID
178/ ONLY WITH /S OR /Z.
179/=N- WITH /I OPTION CLOSES OUTPUT FILE WITH THIS LENGTH
180/V PRINTS VERSION # (FIRST TIME ONLY)
181
182/COMMENTS ON THE PROGRAM:
183
184 /SINCE PIP RUNS WITH USR IN CORE, NO PAGE ZERO LITERALS
185 /CAN BE USED. THE LOCATIONS CURRENTLY USED IN
186 /FIELD 1 ON PAGE ZERO ARE:
187
188 OUTXR=10
189 INXR=11
190 TEMP1=12
191 IHNDLR=24 /HOLDS INPUT HANDLER ADDRESS
192 OHNDLR=25 /OUTPUT HANDLER ADDRESS
193 SQFLAG=26 /'SQUISH INDICATOR
194 OUWAST=27 /# WASTE WORDS ON OUTPUT
195 OUTBLK=30
196 OUDLEN=31
197 SAME=32
198 INBLK=33
199 RECCNT=34
200
201/CONSTANTS USED BY THE DIRECTORY PRINTOUT ROUTINE (OVERLAPPING) ARE:
202
203 FLENGT=24
204 BLOKNO=25
205 DTYPE=27
206 DCOUNT=30
207 DLINK=31
208 WASTE=32
209 DDATE=33
210 ECOUNT=35
211\f /PIP FOR OS/8 MONITOR
212 /EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES
213
214 OUBUF=0 /MUST BE LOWER THAN INBUF
215 OUCTL=5400 /OUTPUT BUFFER OF 3000 WORDS
216 OUDEVH=7200 /PROVIDE ROOM FOR TWO-PAGE HANDLERS
217 INBUF=3000
218 INCTL=1600 /INPUT BUFFER OF 3400 WORDS
219 INRECS=7
220 INDEVH=6600
221
222 /PAGE 6400 IS FREE, EXCEPT DURING /Y COMMAND
223
224 /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR
225 DCB=7760
226 MPARAM=7643 /CD PARAMETER AREA
227 OLDDIR=7 /POINTER TO MONITOR VARIABLE "OLDT9"
228 MTEMP=27 /MONITOR SCRATCH AREA ON "SYS" - ***VOLATILE***
229 PTP=20 /INTERNAL TYPE CODE FOR PAPER TAPE PUNCH
230 XR=10
231 TEMP=20
232 CHAR=21
233 INFPTR=22
234 INEOF=23
235
236 ABUF=6601 /LINE BUFFER - 150 CHARACTERS LONG
237 SQBUF1=6600 /DIRECTORY BUFFER FOR "SQUISH" OPTION
238 SQBUF2=7200 /""
239
240 FIELD 1
241
242/TO ENABLE /E,/F,/L SET
243/OS78=0
244
245/TO DISABLE /E,/F,/L
246IFNDEF OS78 <OS78=1>
247
248\f /GENERAL CHARACTER I/O ROUTINES FOR BLEEP
249 /CALLED AS FOLLOWS:
250
251 /JMS I (IOPEN INITIALIZES THE INPUT ROUTINE
252
253 /JMS I (ICHAR READS A CHARACTER
254 /ERROR RETURN /AC>0 IF END OF FILE, AC<0 IF READ ERROR
255
256 /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE
257 /ERROR RETURN AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
258
259 /JMS I (OCHAR OUTPUTS A CHARACTER
260 /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT
261
262 /JMS I (OCLOSE CLOSES THE OUTPUT FILE
263 /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
264
265 /JMS I (OTYPE RETURNS DCB WORD OF OUTPUT DEVICE IN AC
266
267
268
269 /PARAMETERS NEEDED:
270
271 /INBUF= ADDRESS OF INPUT BUFFER
272 /INCTL= INPUT BUFFER CONTROL WORD
273 /OUBUF= ADDRESS OF OUTPUT BUFFER
274 /OUCTL= OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
275 /INRECS= [INCTL/256]
276 /INDEVH= ADDRESS OF PAGE FOR INPUT HANDLER
277 /OUDEVH= ADDRESS OF PAGE FOR OUTPUT HANDLER
278
279 /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
280 /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
281\f INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
282 OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
283
284 *2000
285
286IN7400, 7400
287IOPEN, 0
288 CLA CMA
289 DCA INCHCT /SET INCHCT TO FORCE A READ
290 ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE
291 TAD (7617
292 DCA INFPTR /RESET FILE POINTER
293 RDF
294 TAD INCDIF
295 DCA .+1
296INPTR, HLT /RESTORE CALLING FIELDS
297 JMP I IOPEN
298
299ICHAR, 0
300IN7600, 7600
301 RDF
302 TAD INCDIF
303 DCA INRTRN /SAVE CALLING FIELDS
304INCHAR, CDF INFLD
305 ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
306 ISZ INCHCT
307INJMPP, JMP INJMP
308 TAD INEOF
309 SNA CLA /DID LAST READ YIELD END-OF-FILE?
310 JMP INGBUF /NO - DO ANOTHER
311GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
312 JMP EOFERR /NO FILE TO OPEN
313INGBUF, TAD INCTR
314 CLL
315 TAD (INRECS
316 SNL
317 DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED
318 SZL /IS THIS THE LAST READ?
319 ISZ INEOF /YES - SET END-OF-FILE FLAG
320 /NOT END-OF-FILE IF INPUT DEVICE
321 /IS NON-FILE STRUCTURED!
322 CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ
323 RTR /FROM THE AMOUNT OF THE OVERFLOW
324 RTR /(IF ANY) AND THE STANDARD CONTROL WORD
325 TAD (INCTL+1
326 DCA INCTLW
327INCDIF, CDF CIF 0
328 CDF 10
329 JMS I INHNDL /CALL THE DEVICE HANDLER
330INCTLW, 0
331INBUFP, INBUF
332INREC, 0
333 JMS I (SLASHG /A HANDLER ERROR - SHOULD WE IGNORE?
334 INERRX-. /ADDRESS IF NOT
335INBREC, TAD INREC
336 TAD (INRECS
337 DCA INREC /UPDATE THE RECORD NUMBER
338 TAD INCTLW
339 AND IN7600
340 CLL RAL
341 TAD INCTLW
342 AND IN7600
343 CMA
344 DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
345 TAD INJMPP
346 DCA INJMP /RESET THE CHARACTER SWITCH
347 TAD INBUFP
348 DCA INPTR /AND THE WORD POINTER
349 JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
350INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
351 SMA CLA /WHICH TYPE WAS IT?
352 JMP INBREC /END OF FILE - RESUME THY PROCESSING
353INERR, CLA CLL CML RAR /BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC
354EOFERR, JMP INRTRN
355INJMP, HLT /THIS IS THE THREE - WAY CHARACTER SWITCH
356 JMP ICHAR1
357 JMP ICHAR2
358ICHAR3, TAD INJMPP
359 DCA INJMP
360 TAD I INPTR
361IN200, AND IN7400
362 CLL RTR
363 RTR /COMBINE THE HIGH-ORDER FOUR BITS OF
364 TAD INCTLW
365 RTR /THE TWO WORD TO FORM THE THIRD CHARACTER
366 RTR
367 ISZ INPTR
368 JMP INCOMN
369ICHAR2, TAD I INPTR
370 AND IN7400
371 DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
372 ISZ INPTR /BUMP THE WORD POINTER
373ICHAR1, TAD I INPTR
374INCOMN, AND (377
375 TAD (-232
376INCTZF, SNA /IS THE CHARACTER A ^Z?
377 JMP GETNEW /YES - GET A NEW FILE
378 TAD (232 /RESTORE THE CHARACTER
379 ISZ ICHAR /BUMP RETURN TO NORMAL RETURN
380INRTRN, 0 /RESTORE CALLING FIELDS
381 JMP I ICHAR /AND RETURN
382 /IOPEN IS UNNECESSARY.
383\fINNEWF, -1 /ROUTINE TO OPEN NEW INPUT FILE
384 INCHCT=INNEWF
385 CDF 10
386 TAD (INDEVH+1
387 DCA INHNDL /INITIALIZE HANDLER ADDRESS
388 TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
389 SNA /ANY MORE?
390 JMP I INNEWF /NO - OUT OF INPUT
391 JMS I IN200
392 1 /ASSIGN, FETCH HANDLER
393INHNDL, 0
394 HLT /HUH?
395 TAD I INFPTR
396 AND (7760 /GET LENGTH PART OF WORD
397 SZA /LENGTH OF 0 MEANS LENGTH >=256
398 TAD (17 /ADD HIGH-ORDER BITS
399 CLL CML RTR
400 RTR
401 DCA INCTR /STORE LENGTH OF FILE
402 ISZ INFPTR
403 TAD I INFPTR
404 DCA INREC /STORE STARTING RECORD NUMBER OF FILE
405 ISZ INFPTR
406 DCA INEOF /ZERO END-OF-FILE FLAG
407 ISZ INNEWF
408 JMP I INNEWF
409 INCTR=IOPEN
410 PAGE
411\fOOPEN, 0 /OPEN OUTPUT FILE
412OU7600, 7600
413/ RDF
414/ TAD OUCDIF
415/ DCA OORETN
416 TAD OU7601
417 DCA OUBLK
418 TAD (OUDEVH+1
419 DCA OUHNDL
420 CDF 10
421 TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
422 AND (17 /STRIP OFF ANY LENGTH INFO
423 SNA /IS THERE AN OUTPUT DEVICE?
424 JMP ONOFIL /NO - INHIBIT OUTPUT
425 JMS I (200
426 1 /ASSIGN, FETCH HANDLER
427OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
428 HLT /HUH?
429OUENTR, TAD I OU7600
430 JMS I (200
431 3 /ENTER OUTPUT FILE
432OUBLK, 7601 /REPLACED WITH STARTING BLOCK
433OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
434 JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
435 DCA OUCCNT
436 DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
437 JMS I (OUSETP
438 ISZ OOPEN
439OORETN, CDF CIF 10 /RESTORE CALLING FIELDS
440 JMP I OOPEN
441OEFAIL, TAD I OU7600
442 AND (7760 /GET REQUESTED LENGTH
443 SNA CLA /WAS IT AN INDEFINITE REQUEST
444 JMP ONTERR /YES - CANNOT ENTER THE FILE
445 TAD I OU7600
446 AND (17 /MAKE THE REQUESTED LENGTH ZERO
447 DCA I OU7600
448 JMP OUENTR /TRY, TRY AGAIN
449ONTERR, CLA CLL CML RAR
450 JMP OORETN /TAKE THE ERROR RETURN WITH AC<0
451ONOFIL, ISZ I (OUTINH
452 JMP OORETN /TAKE THE ERROR RETURN WITH AC=0
453\fOUTDMP, 0
454 DCA OUCTLW /STORE THE CONTROL WORD
455 CDF 10
456 TAD I (OUTINH
457 SZA CLA
458 JMP OUNOWR
459 TAD OUCCNT
460 SNA
461 ISZ OUCTLW
462 TAD OUBLK
463 DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
464 TAD OUCTLW
465 CLL RTL
466 RTL
467 RTL
468 AND (17 /COMPUTE THE NUMBER OF RECORDS
469 TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE
470 DCA OUCCNT
471 TAD OUCCNT
472 CLL CML
473 TAD OUELEN
474 SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH?
475 JMP I OUTDMP /YES - SIGNAL OUTPUT ERROR
476OUCDIF, CDF CIF 0
477 CDF 10
478 JMS I OUHNDL
479OUCTLW, 0
480 OUBUF
481OUREC, 0
482 JMS I (SLASHG
483 .+2-.
484OUNOWR, ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN
485 JMP I OUTDMP
486\fOCLOSE, 0
487 CDF 10
488 TAD I (OUTINH
489 SZA CLA /IS OUTPUT INHIBITED?
490 JMP OCISZ /YES - CLOSE IS A NOP
491 JMS I (OTYPE
492 AND (770
493 TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
494 SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
495 TAD (232 /OUTPUT A ^Z
496 JMS I (OCHAR
497 JMP OCRET
498 JMS I (OCHAR
499 JMP OCRET
500FILLLP, JMS I (OCHAR
501 JMP OCRET
502 JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
503 SPA CLA
504 TAD (100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
505 TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD
506 AND I (OUDWCT
507 SZA CLA /UP TO THE BOUNDARY YET?
508 JMP FILLLP /NO - FILL WITH ZEROS
509 TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
510 TAD (OUCTL&3700
511 SNA /A FULL WRITE LEFT?
512 JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT
513 TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT
514 JMS OUTDMP
515 JMP OCRET /AN ERROR OCCURRED WHILE DUMPING THE BUFFER
516NODUMP, TAD I OU7600 /GET THE DEVICE NUMBER
517 JMS I (200
518 4 /CLOSE THE OUTPUT FILE
519OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME
520OUCCNT, 0
521 SKP /ERROR WHILE CLOSING THE FILE - BAD!
522OCISZ, ISZ OCLOSE
523OCRET, CDF CIF 10 /RESTORE CALLING FIELDS
524 JMP I OCLOSE
525 PAGE
526\fOUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS
527 TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS
528 CIA /PAL10 IS DEFINITELY NOT NICE
529 DCA OUDWCT
530/ TAD (OUBUF
531 IFNZRO OUBUF <ERROR!> /V3
532 DCA OUPTR /INITIALIZE WORD POINTER
533 TAD OUJMPE
534 DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
535 JMP I OUSETP
536
537OCHAR, 0
538 AND (377
539 DCA OUTEMP
540 RDF
541 TAD (CDF CIF 0
542 DCA OUCRET
543 TAD OUTINH
544 SZA CLA /IS THERE AN OUTPUT FILE?
545 JMP OUCOMN /NO - EXIT
546OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
547 ISZ OUJMP /BUMP THE CHARACTER SWITCH
548OUJMP, HLT /THREE WAY CHARACTER SWITCH
549 JMP OCHAR1
550 JMP OCHAR2
551OCHAR3, TAD OUTEMP
552 CLL RTL
553 RTL
554 AND (7400
555 TAD I OUPOLD
556 DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
557 /ORDER 4 BITS OF THIRD CHAR
558 TAD OUTEMP
559 CLL RTR
560 RTR
561 RAR
562 AND (7400
563 TAD I OUPTR
564 DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
565 TAD OUJMPE
566 DCA OUJMP /RESET SWITCH
567 ISZ OUPTR
568 ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
569 JMP OUCOMN
570 TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
571 JMS I (OUTDMP /DUMP THE BUFFER
572 JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN
573 JMS OUSETP /RE-INITIALIZE THE POINTERS
574 JMP OUCOMN
575OCHAR2, TAD OUPTR
576 DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
577 ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
578OCHAR1, TAD OUTEMP
579 DCA I OUPTR
580OUCOMN, ISZ OCHAR
581OUCRET, HLT /RESTORE CALLING FIELDS
582 JMP I OCHAR
583OUTEMP, 0
584OUPOLD, 0
585OUPTR, 0
586OUJMPE, JMP OUJMP
587OUDWCT, 0
588OUTINH, 0
589\fOTYPE, 0
590 RDF
591 TAD (CDF CIF 0
592 DCA OTRTN
593 CDF 10
594 TAD I (7600
595 AND (17
596 TAD (DCB-1
597 DCA OUTEMP
598 TAD I OUTEMP
599OTRTN, HLT
600 JMP I OTYPE
601CTCTST, 0
602 TAD (200 /V3
603 KRS
604 TAD (-203
605 SNA CLA /IS THE TELETYPE BUFFER A ^C
606 KSF /WITH THE TELETYPE FLAG ON?
607 JMP I CTCTST /NO
608LEAVE, CDF CIF 0 /YES - GO TO MONITOR
609 JMP I (7600 /THROUGH THE "SAVE CORE" RETURN
610
611SLASHG, 0
612 DCA CTCTST
613 TAD SQFLAG
614 SZA CLA /ARE WE SQUISHING?
615 JMP I (SQIOER /YES
616 TAD CTCTST
617 SPA CLA /ONLY IGNORE HARD ERRORS
618 TAD I (MPARAM
619 AND (40
620 SZA CLA / "G" SWITCH
621SLGRET, JMP I SLASHG /IGNORED!
622 TAD I SLASHG
623 TAD SLASHG
624 DCA SLASHG /SET UP NON-IGNORE ADDRESS
625 TAD CTCTST
626 JMP I SLASHG /RETURN WITH AC RESTORED
627
628\f
629 IFZERO OS78 <
630DIR, DCA DTYPE /SAVE TYPE OF REQUEST
631 TAD I (7600
632 SZA CLA /IS THERE AN OUTPUT FILE?
633 JMP I (DIRPRE /YES
634 DCA TTYDEV+1
635 JMS I (200
636 12 /ASSIGN WITHOUT FETCH
637TTYDEV, 5524 /COMPRESSED CODE FOR "TTY"
638 0
639 0
640 JMP I (PIP /V3 WHAT - NO TELETYPE!
641 TAD TTYDEV+1
642 DCA I (7600
643 JMP I (DIRPRE
644 >
645
646 IFNZRO OS78 <
647DIR, JMS I (PIPERR /TYPE OUT MESSAGE
648 14
649DIRMSG, TEXT "USE DIRECT"
650 >
651
652 PAGE
653\f /PIP PROPER BEGINS HERE
654 /**********************
655
656 /IMAGE MODE PROCESSOR FOR PIP
657
658IMAGE, JMS I (FIXLEN
659 JMS I (OUTOPN
660 JMS IMTRA
661IMCLOS, TAD I (OUTINH
662 SZA CLA /WAS THERE AN OUTPUT FILE?
663 JMP I (PIPCLR /NO - DON'T CLOSE IT
664 JMS I (OUK /GET THE LENGTH OF THE OUTPUT FILE
665 DCA IMCCNT
666 TAD I IM7600
667 JMS I (200
668 4 /CLOSE
669 7601 /FILE NAME
670IMCCNT, 0
671 JMP I (AOUERR
672 JMP I (PIPCLR
673
674ENDFUJ, 0 /PART OF DIRECTORY PRINTING ROUTINE
675 JMS I (PRNUM
676 TAD (-6
677 JMS I (PRWD /PRINT SIX WORDS
678 0006 / F
679 2205 /RE
680 0500 /E
681 0214 /BL
682 1703 /OC
683 1323 /KS
684 JMS I (PCRLF
685 JMS I (PCRLF /LEAVE A SPACE BETWEEN DIRECTORIES
686 ISZ INEOF /SIMULATE "END OF FILE" FOR INPUT ROUTINE
687 CLA CMA
688 DCA I (INCHCT /AS WELL AS "END OF BUFFER"
689 JMP I ENDFUJ
690\fIMHNDL, /V3
691SQTRA, 0
692 TAD SQTRA
693 DCA IMTRA /FAKE A CALL TO "IMTRA"
694 TAD RECCNT /SETTING UP THE ARGS TO DO THE SQUISHING FOR US
695 DCA I (INCTR
696 TAD IHNDLR
697 DCA IMHNDL
698 TAD INBLK
699 DCA IMREC
700 TAD OUTBLK
701 DCA I (OUCCNT
702 DCA INEOF
703 JMP IMRCLP
704
705IMTRA, 0
706 JMS I (IOPEN /INITIALIZE INPUT ROUTINE
707AGAIN, TAD INEOF /IOPEN ALWAYS SETS INEOF
708 SNA CLA /KEEP READING?
709 JMP IMRCLP /YES
710 /NO, OPEN NEXT FILE
711IMFILP, JMS I (INNEWF /SET UP PARAMS FOR NEXT FILE
712 JMP I IMTRA /NO NEXT FILE
713 TAD I (INHNDL
714 DCA IMHNDL /GET DEVICE HANDLER ENTRY
715 TAD I (INREC
716 DCA IMREC /AND STARTING BLOCK NUMBER
717IMRCLP, TAD I (INCTR
718 CLL
719 TAD (15
720 SNL /IF LINK IS ON, THERE ARE LESS THAN 16 BLOCKS LEFT
721 DCA I (INCTR
722 SZL
723 ISZ INEOF
724 CLL CML CMA RTR
725 RTR
726 RTR
727 TAD (3201 /FORM A FULL OR PARTIAL READ CONTROL WORD
728 DCA IMCTLW
729 JMS I (CTCTST /CHECK FOR ^C
730 CIF 0
731 JMS I IMHNDL
732IMCTLW, 0
733 OUBUF
734IMREC, 0
735 JMS I (SLASHG
736 IMERRX-.
737 TAD IMREC
738 TAD (15
739 DCA IMREC /UPDATE BLOCK NUMBER
740 CLA CLL CML RAR
741 TAD IMCTLW
742IMOUT, JMS I (OUTDMP /WRITE OUT WHAT WE JUST READ IN
743 JMP I (AOUERR /WRITE ERROR - BAD!
744 JMP AGAIN /V3
745\fIMERRX, ISZ INEOF /SIGNAL EOF OR WORSE
746 SPA CLA /WHICH ONE IS IT?
747 JMP IM7600
748 TAD (6377 /MARCH DOWN THROUGH CORE
749IMEFLP, DCA CHAR /LOOKING FOR THE FIRST NON-ZERO WORD
750 CDF 0
751 TAD I CHAR
752 SZA CLA
753 JMP IMNZRO
754 CLA CMA CLL
755 TAD CHAR
756 SZL /IF WE GO THROUGH THE BUFFER WITHOUT A NON-ZERO WORD
757 JMP IMEFLP
758IM7600, 7600
759 JMS I (PIPERR /SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
760 4 /A ^Z AT LEAST)
761IMNZRO, CDF 10
762 TAD CHAR
763 CLL CML RAR
764 AND IM7600
765 TAD (200 /GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
766 JMP IMOUT /AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
767 PAGE
768\f/** PIP STARTS HERE (OR HERE+1 IF CHAINED TO) **
769
770PIPSA, JMP PIPCD /NORMAL ENTRY/RE-ENTRY - CALL CD
771 JMP NOPCD /ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
772 /PART OF ASCII PROCESSOR - CLEAN UP AT END OF LINE AND END OF FILE
773
774LFEED, TAD CHAR
775 DCA I XR /PUT THE LINE FEED IN THE LINE BUFFER
776EOL, DCA I XR /MARK THE END OF USEFUL INFO
777 JMS I (CTCTST
778 TAD (ABUF-1
779 DCA XR /RESET BUFFER POINTER
780EOLLP, TAD I XR /GET A CHARACTER FROM THE LINE BUFFER
781PIPSNA, SNA /ZERO MEANS NO MORE CHARS
782 JMP EOFTST
783 JMS I (OCHAR /OUTPUT THE CHARACTER
784 JMP I (AOUERR
785 JMP EOLLP
786EOFTST, TAD AEOFFG
787 SNA CLA /END OF INPUT ENCOUNTERED?
788 JMP I (ASCIGO /NO - GET NEXT LINE
789ACLOSE, JMS I (OCLOSE /YES - CLOSE THE OUTPUT FILE
790 JMP I (AOUERR /ERROR ON CLOSE
791PIP, TAD I (MPARAM-1 /V3
792 SMA CLA /ALTMODE TERMINATE LAST COMMAND STRING?
793 JMP PIPCD /NO
794 CDF CIF 0 /YES
795 JMP I (7605 /EXIT TO OS/8 WITHOUT SAVING CORE
796PIPCD, JMS I (200 /OF COURSE THE MONITOR IS IN CORE!
797 5 /COMMAND DECODE
798 0 /NO ASSUMED EXTENSIONS ON INPUT
799L20, /V3
800NOPCD, JMS I (ONCE /REPLACED BY '20' BY ONCE-ONLY CODE
801 JMS I (SRSTOR /CLEAR /S OR /Y;READ MONITOR
802 DCA SQFLAG /CLEAR /S INDICATOR
803 TAD PIPSNA
804 DCA I (INCTZF /RESET INPUT SWITCH TO DETECT "^Z"'S
805 TAD I (MPARAM+1
806 AND (40 /"S" SWITCH
807 SZA CLA
808 JMP I (SQUISH /IT WAS ON - COMPRESS THE INDICATED DEVICES
809 TAD I (MPARAM+2
810 RTL
811 SZL CLA /"Z" SWITCH IN THE LINK
812 JMS I (DZERO /ZERO DIRECTORY BEFORE PROCEEDING
813 TAD I (MPARAM
814 AND (400 /"D" SWITCH
815 SZA CLA
816 JMS I (DELETE /DELETE OUTPUT FILE
817 TAD I (MPARAM+2 /IS /Y ON?
818 SPA CLA
819 JMP I (SYSCOP /YEP..TRANSFER SYSTEM HEAD
820 TAD I (MPARAM
821 AND (301 /"E","F" AND "L" SWITCHES
822 SZA /ANY ONE OF THEM ON?
823 JMP I (DIR /YES - LIST A DIRECTORY
824 TAD I (MPARAM
825 RTL
826 AND (40 /"I" SWITCH ROTATED TWO LEFT
827 SZA CLA
828 JMP I (IMAGE /IMAGE MODE TRANSFER
829 TAD I (7617 /MUST PRESERVE THE LINK
830 SNA CLA /V3 IMAGE MODE ALLOWS NO INPUT FILE
831 JMP PIP /TERMINATE HERE IF NO INPUT SIDE
832 SZL CLA /"B" SWITCH IN LINK
833 JMP I (BINARY /BINARY MODE TRANSFER
834
835 /DEFAULT MODE OF TRANSFER IS ASCII
836
837ASCII, TAD I (MPARAM+1
838 AND L20
839 DCA COPTSW
840 TAD COPTSW
841 JMS I (ASCI2 /TEST FOR OUTPUT DEVICE
842 JMS I (OUTOPN
843 JMS I (IOPEN /OPEN THE INPUT FILES
844 DCA AEOFFG /ZERO THE END-OF-FILE FLAG
845 JMS I (LEADER
846 JMP I (ASCIGO
847
848 /ENTRY ON END OF INPUT
849ASCEOF, SPA CLA /WAS IT END OF INPUT OR AN INPUT ERROR?
850PER4, JMS I (PIPERR
851 4
852 ISZ AEOFFG /SET END-OF-INPUT FLAG
853 JMP EOL /PROCESS LAST LINE (IF ANY)
854AEOFFG, 0
855\f /SUBROUTINE TO OUTPUT RUBOUTS AFTER FORM CONTROL CHARACTERS
856RUBOUT, 0 /UNLESS OUTPUT IS TO A DIRECTORY DEVICE
857 DCA TEMP /STORE COUNT
858 JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
859 SPA CLA
860 JMP I RUBOUT /DIRECTORY DEVICE - DON'T BOTHER
861RBTLP, TAD CHAR
862 TAD (-214
863 SNA CLA /IS THE FORM CONTROL CHAR A FORM-FEED?
864 IAC /YES - OUTPUT BLANK TAPE INSTEAD
865 TAD (377
866 DCA I XR /PUT IN BUFFER
867 ISZ TEMP
868 JMP RBTLP /LOOP FOR THE REQUISITE COUNT
869 JMP I RUBOUT
870COPTSW, 0
871
872DEND, SPA CLA
873 JMP PER4
874 JMP ACLOSE
875 PAGE
876\f *3200
877 /ASCII PROCESSOR CONTINUED
878
879ASCIGO, TAD (ABUF-2
880 DCA XR
881 DCA I XR /PROTECT AGAINST NULL LINE WITH "T" OPTION
882 DCA COLCT /ZERO COLUMN COUNTER FOR TAB CONVERSION
883ACHLP, JMS I (ICHAR /GET A CHARACTER
884 JMP I (ASCEOF /END OF INPUT OR WORSE
885 AND (177 /MASK OUT PARITY BIT
886 SZA /IGNORE BLANK TAPE AND LEADER/TRAILER
887 TAD (-177
888 SNA
889 JMP ACHLP /DITTO RUBOUTS
890 TAD (177-32 /V3C
891 SNA
892 JMP I (ASCPTCH /7-BIT ^Z CHECK
893 TAD (232 /FORCE COLUMN 8 ON
894 DCA CHAR
895 TAD CHAR
896 TAD (-216
897 CLL
898 TAD ASCI5
899 SNL /IS THE CHARACTER A FORM CONTROL CHARACTER?
900 JMP CINSRT /NO
901 TAD ASCJMP /YES - GO TO APPROPRIATE ROUTINE
902 DCA .+1
903 HLT
904ASCJMP, JMP I .+1
905 TAB
906 LFEED
907 VTAB
908 FFEED
909 CARRET
910CINSRT, 7600 /GRP 2 CLA
911 TAD CHAR
912ADCAXR, DCA I XR /STORE THE CHARACTER IN THE LINE BUFFER
913 ISZ COLCT /ALWAYS BUMP THE COLUMN POINTER
914TESTXR, TAD XR
915 TAD (-ABUF-226
916 SPA CLA /HAS THE BUFFER OVERFLOWED?
917 JMP ACHLP /NO - GET NEXT CHARACTER
918 JMS I (PIPERR
919 1
920\fTAB, TAD I (COPTSW
921 SNA CLA /DO WE WANT TO CONVERT?
922 JMP TABRBT /NO
923TABLP, TAD (240
924 DCA I XR /OUTPUT A SPACE
925 ISZ COLCT
926 TAD COLCT
927 AND (7
928 SZA CLA /IS THE COLUMN COUNTER A MULTIPLE OF 8?
929 JMP TABLP /NOT YET
930 JMP TESTXR /YES - CHECK BUFFER OVERFLOW
931TABRBT, TAD CHAR
932 DCA I XR
933 CLA CMA
934 JMS I (RUBOUT /TWO RUBOUTS FOLLOW A TAB
935 JMP TESTXR /CHECK FOR BUFFER OVERFLOW
936VTAB, TAD I (COPTSW
937 SZA CLA /SHOULD WE CONVERT?
938 JMP VTLF /YES
939 TAD CHAR
940 DCA I XR
941 TAD (-4
942 JMS I (RUBOUT /FOUR RUBOUTS AFTER A VERTICAL TAB
943 JMP I (EOL
944FFLF, TAD (-4 /NINE LINE FEED SIMULATE A FORM FEED
945VTLF, TAD (-5 /FIVE LINE FEEDS SIMULATE A VERTICAL TAB
946 DCA TEMP
947 TAD (212
948 DCA I XR
949 ISZ TEMP
950 JMP .-3
951 JMP I (EOL /FORM FEED AND VERTICAL TAB ARE LINE ENDERS
952\fFFEED, TAD I (COPTSW
953 SZA CLA /SHOULD WE CONVERT?
954 JMP FFLF /YES
955 TAD CHAR
956 DCA I XR
957 TAD (-11 /NINE RUBOUTS AFTER A FORM FEED
958 JMS I (RUBOUT
959 JMP I (EOL
960CARRET, TAD I (MPARAM
961 RTL
962 SMA CLA /"C" SWITCH MEANS DELETE TRAILING BLANKS FROM CARDS
963 JMP NOTOPT /IT WASN'T ON
964TOPT, TAD XR
965 DCA TEMP
966 TAD I TEMP
967 TAD (-240
968 SZA CLA /WAS THE LAST CHAR ON THE LINE A SPACE?
969 JMP NOTOPT /NO
970 CLA CMA
971 TAD XR /YES - BACK UP THE LINE POINTER
972 DCA XR
973 JMP TOPT
974NOTOPT, TAD CHAR
975 DCA I XR /STORE THE CARRIAGE RETURN IN THE BUFFER
976 JMP TESTXR /CARRIAGE RETURN IS NOT A LINE TERMINATOR
977COLCT, 0
978
979OUTOPN, 0
980 JMS I (OOPEN
981 SMA CLA
982 JMP I OUTOPN
983 JMS I (PIPERR
984ASCI5, 5
985 PAGE
986\f /SUBROUTINES CALLED BY THE REST OF PIP
987
988K770, 770 /** DON'T MOVE THIS CONSTANT
989DELETE, 0
990 TAD P7600
991 DCA DPFILE
992 CLA CLL CMA RTL
993 DCA CHAR /MAXIMUM OF THREE OUTPUT FILES
994DELOOP, TAD (7201
995 DCA DLHNDL
996 TAD I DPFILE
997 SNA /DOES THIS FILE EXIST?
998 JMP I DELETE /THAT'S ALL
999 JMS I C200
1000 1 /ASSIGN HANDLER FOR THE DELETION
1001DLHNDL, 0
1002 HLT
1003 TAD I DPFILE /RELOAD DEVICE NUMBER FOR DELETE
1004 ISZ DPFILE /BUMP DPFILE TO POINT TO THE FILE NAME
1005 JMS I C200 /DEVICE NUMBER IN AC
1006DP4, 4 /CLOSE - USED AS DELETE IN THIS CASE
1007DPFILE, 0 /POINTER TO FILE NAME
1008 0 /ZERO LENGTH FOR DELETE
1009 JMS I (PIPERR /FILE WASN'T THERE TO BE DELETED
1010 3
1011 TAD DPFILE
1012 TAD DP4
1013 DCA DPFILE
1014 ISZ CHAR
1015 JMP DELOOP /DELETE AS MANY FILES AS HE LISTED(UP TO 3)
1016 JMP I DELETE
1017\fDZERO, 0 /SUBROUTINE TO ZERO THE DIRECTORY OF THE
1018 /FIRST OUTPUT DEVICE
1019 JMS I (OTYPE
1020 CLL RTL
1021 SZL /IS DEVICE READ-ONLY?
1022 JMP OZERR /YES - ERROR
1023 RTR
1024 AND K770 /MASK OUT DEVICE TYPE
1025 CLL RTR
1026 RAR
1027 TAD (DEVLEN /USE IT TO INDEX A TABLE OF DEVICE LENGTHS
1028 DCA PIPERR
1029 TAD I PIPERR
1030 SNA
1031 JMP I DZERO /DEVICE LENGTH ZERO MEANS NON-DIRECTORY DEVICE
1032 DCA PIPERR /STORE LENGTH
1033 TAD (OUDEVH+1
1034 DCA OZHNDL
1035 TAD I P7600
1036 JMS I C200
1037 1 /ASSIGN DEVICE, FETCH HANDLER
1038OZHNDL, 0
1039 HLT
1040 TAD I (MPARAM+2 /IF /Y ON, DO SYSTEM ZERO
1041 SPA CLA
1042 JMP ZRO70
1043 TAD OZHNDL /BUT IF NOT, CHECK FOR SYSTEM ZERO
1044 TAD (-7607
1045 SZA CLA
1046 JMP ZRO70+1 /NOT SYSTEM FILES BEGIN AT 7
1047 JMS I (CONFRM /ASK IF HE'S SURE
1048 SYSZRO /V3
1049ZRO70, TAD (61
1050 TAD (7
1051 DCA I (DFORG
1052 DCA I (SQFLAG /AND CLEAR OUT SQUISHES
1053 TAD PIPERR
1054 TAD I (DFORG
1055 DCA I (DLENGT
1056 JMS I (GETEQ
1057 DCA I (DWASTE /DEFINE # OF WASTE WORDS
1058 DCA I (MPARAM+3 /KILL = OPTION FOR FUTURE /I TRANSFERS
1059 CIF 0
1060 JMS I OZHNDL
1061 5410 /V3 OUTPUT 6 BLOCKS FROM FIELD 1
1062 DIRECT
1063 1 /ALL DIRECTORIES ARE IN RECORD 1
1064OZERR, JMS I (PIPERR /ERROR WHILE ZEROING DIRECTORY
1065 2
1066 DCA OLDDIR /ZERO DIRECTORY POINTER TO FORCE A NEW READ
1067 JMP I DZERO
1068\fPIPERR, 0
1069P7600, 7600 /V3 CLA
1070 JMS I (SRSTOR /RESET 07600!
1071 CDF 10 /JUST IN CASE
1072 TAD I PIPERR /GET ARG
1073 TAD (ERRTBL
1074 DCA TEMP
1075 TAD I TEMP
1076 JMS I (ERPRNT
1077 JMP I (PIP /RESTART PIP
1078
1079LEADER, 0
1080 JMS I (OTYPE
1081C200, AND K770 /GET THE TYPE OF THE OUTPUT DEVICE
1082 TAD (-PTP /IS IT A PAPER TAPE PUNCH?
1083 SZA CLA
1084 JMP I LEADER /NO
1085 TAD P7600
1086 DCA TEMP
1087 JMS I (OCHAR /PUT OUT SOME LEADER
1088 JMP I (AOUERR
1089 ISZ TEMP
1090 JMP .-3
1091 JMP I LEADER
1092 PAGE
1093\f /TABLE OF DEVICE LENGTHS FOR /Z OPTION
1094
1095DEVLEN, 0;0;0;0;0;1520 /RK08 (1520= - DECIMAL 3248)
1096 6001;4001;2001;0001 /RF08 IN VARIOUS SIZES
1097 /(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
1098 7601;7401;7201;7001 /DF32 IN VARIOUS SIZES
1099 /(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
1100 6437;6437 /DECTAPE AND LINCTAPE
1101 ZBLOCK 1 /20 MAGTAPE
1102 6437 /21 TD8E
1103 0
1104 1520 / 1/2 OF AN RK8E IS 23
1105 0 /24
1106 7022 /25 RX01 FLOPPY DISK
1107 ZBLOCK 52 /ALL THE REST
1108
1109
1110FIXLEN, 0 /ROUTINE TO ESTIMATE OUTPUT FILE LENGTH
1111 TAD I (7600
1112 AND (7760
1113 SZA CLA /DID THE USER PROVIDE AN ESTIMATE?
1114 JMP I FIXLEN /YES - USE IT
1115 DCA CHAR
1116 TAD (7617
1117 DCA TEMP
1118FIXLP, TAD I TEMP /GET NEXT INPUT FILE
1119 SNA
1120 JMP FIXOVR /NO MORE INPUT FILES
1121 AND (7760
1122 CIA CLL /GET LENGTH AS A POSITIVE NUMBER
1123 /(LENGTH OF ZERO TURNS LINK ON)
1124 TAD CHAR
1125 DCA CHAR /UPDATE CUMULATIVE LENGTH
1126 SZL CLA /DID CUMULATIVE LENGTH OVERFLOW 256 BLOCKS?
1127 JMP I FIXLEN /YES - CAN'T ESTIMATE IT
1128 ISZ TEMP
1129 ISZ TEMP
1130 JMP FIXLP
1131FIXOVR, TAD CHAR
1132 TAD I (7600
1133 DCA I (7600 /STICK LENGTH IN OUTPUT FILE DESCRIPTOR
1134 JMP I FIXLEN
1135\fNOYES, TEXT /NO/
1136 TEXT /YES/
1137
1138CONFRM, 0
1139 TAD I (MPARAM+1
1140 RTL /'O' BIT TO SIGN
1141 SPA CLA
1142 JMP GOTCON /V3 'O' MEANS OK, ASSUME 'YES'
1143 TAD I CONFRM /V3
1144 JMS I (ERPRNT
1145 KSF
1146 JMP .-1
1147 JMS I (CTCTST
1148 KRB /LOOK AT HIS REPLY
1149 AND (177 /IGNORE PARITY TTY
1150 TAD (-"Y!7600 /V3
1151 SNA CLA /IS IT YES?
1152 ISZ SQFLAG /SET SQFLAG TO 1 (NEEDED 1 LATER)
1153 TAD SQFLAG /USE SQFLAG AS INDEX FOR MESSAGE
1154 CLL RAL
1155 TAD (NOYES
1156 JMS I (ERPRNT
1157 TAD SQFLAG
1158 SNA CLA
1159 JMP I (PIP
1160CNFMXT, ISZ CONFRM
1161 JMP I CONFRM
1162
1163GOTCON, ISZ SQFLAG /SET SQFLAG
1164 JMP CNFMXT /AND TAKE SKIP EXIT
1165 PAGE
1166\f /DIRECTORY PRINTER FOR PIP
1167 MDATE=7666
1168
1169DIRPRE, JMS I (OUTOPN /OPEN THE OUTPUT FILE
1170 TAD (ABUF
1171 DCA CHAR /ABUF WILL BE A TEMPORARY ARRAY OF STARTING FILES
1172 TAD (7617
1173 DCA TEMP
1174 TAD I (7617
1175 SNA
1176 JMS I (DSKNUM
1177 DCA I (7617 /DEFAULT DIRECTORY IS DSK:
1178DFUJLP, TAD I TEMP
1179 SNA /ARE WE THROUGH WITH THE INPUT DEVICES?
1180 JMP GETDIR /YES
1181 AND (17
1182 DCA I TEMP /ONLY THE DEVICE NUMBER IS IMPORTANT
1183 TAD I TEMP
1184 TAD (DCB-1
1185 DCA PRWD
1186 CLA CLL CML RTL
1187 TAD TEMP
1188 DCA INFPTR /THIS SERVES NO FUNCTION EXCEPT IMPROVING ERROR MESSAGES
1189 TAD I PRWD
1190 SMA CLA /IS THE DEVICE A DIRECTORY DEVICE?
1191 JMS I (PIPERR /NO
1192 6
1193 ISZ TEMP
1194 TAD I TEMP
1195 DCA I CHAR /SAVE THE STARTING BLOCK NUMBER
1196 CLA IAC
1197 DCA I TEMP /READ FROM THE DIRECTORY
1198 ISZ TEMP
1199 ISZ CHAR
1200 JMP DFUJLP
1201GETDIR, TAD (ABUF
1202 DCA CHAR
1203 JMS PCRLF
1204 TAD I (MDATE
1205 JMS I (PDATE
1206 JMS PCRLF
1207 JMS I (IOPEN /RESET POINTERS - WERE GONNA FAKE OUT THOSE "GENERAL"
1208 /ROUTINES
1209 JMP I (NXTDIR
1210\fPRWD, 0 /ROUTINE TO PRINT SIXBIT TEXT
1211 SNA /IS COUNT ZERO?
1212 CMA /MAKE IT ONE
1213 DCA PRCT /STORE COUNT
1214PRWDLP, TAD I PRWD
1215PR212, RTR
1216 RTR
1217 RTR
1218 JMS PR6BIT
1219 TAD I PRWD
1220 JMS PR6BIT
1221 ISZ PRWD
1222 ISZ PRCT
1223 JMP PRWDLP
1224 JMP I PRWD
1225PRCT, 0
1226PR6BIT, 0
1227 AND (77
1228 SZA
1229 TAD (240 /V3
1230 AND (77 /V3
1231 TAD (240 /V3
1232 JMS I (OCHAR
1233 JMP I (AOUERR
1234 JMP I PR6BIT
1235\fPRNUM, 0
1236 DCA PRWD
1237 DCA TEMP
1238 TAD (PWRTEN
1239 DCA PCRLF
1240PRNMLP, DCA PR6BIT
1241 TAD I PCRLF
1242 SNA
1243 JMP PRLAST /V3
1244 CLL
1245 TAD PRWD
1246 SNL
1247 JMP .+4
1248 DCA PRWD
1249 ISZ PR6BIT
1250 JMP PRNMLP+1
1251 CLA
1252 TAD PR6BIT
1253 TAD TEMP
1254 SNA
1255PBLJMP, JMP PRBLNK /INCREMENTED BY PDATE TO KILL LEADING BLANKS
1256 TAD (260
1257 JMS PR6BIT
1258 CLA CLL CML RAR
1259 DCA TEMP
1260 ISZ PCRLF
1261 JMP PRNMLP
1262PRBLNK, JMS PR6BIT
1263 JMP .-3
1264PRLAST, TAD PRWD /V3
1265 TAD (260 /V3
1266 JMS PR6BIT /V3
1267 JMP I PRNUM /V3
1268\fPCRLF, 0
1269 TAD (215
1270 JMS I (OCHAR
1271 JMP I (AOUERR
1272 TAD PR212
1273 JMS I (OCHAR
1274 JMP I (AOUERR
1275 JMP I PCRLF
1276
1277PWRTEN, -1750;-144;-12;0 /V3
1278 PAGE
1279\f /MAIN DIRECTORY PRINTING LOOP
1280
1281NXTDIR, JMS I (ICHAR /FAKE, FAKE
1282 JMP I (DEND
1283 CLA /WE DON'T WANT THE CHARACTER
1284 DCA ECOUNT
1285 TAD (INBUF-1 /WE WANT THE BUFFER!
1286NEWSEG, DCA XR
1287 CDF 0
1288 TAD I XR
1289 DCA DCOUNT /NUMBER OF ENTRIES
1290 TAD DCOUNT
1291 CLL
1292 TAD (100
1293 SNL CLA
1294 JMS I (PIPERR
1295 11
1296 TAD I XR
1297 DCA BLOKNO /FIRST BLOCK OF FILE STORAGE
1298 TAD I XR
1299 DCA DLINK /LINK TO NEXT SEGMENT
1300 ISZ XR /BUMP XR PAST FLAG WORD
1301 TAD I XR
1302 DCA WASTE
1303NAMELP, CDF 0
1304 TAD I XR
1305 SNA /WHAT TYPE OF ENTRY IS IT?
1306 JMP DEMPTY /A FREE FILE
1307 DCA NAME1 /A PERMENANT OR TENTATIVE FILE
1308 TAD I XR
1309 DCA NAME2
1310 TAD I XR
1311 DCA NAME3
1312 TAD I XR
1313 DCA NAME4
1314 TAD I XR
1315 DCA DDATE
1316 TAD WASTE /COMPENSATE FOR THE DATE INCREMENT
1317 CMA /AND THE WASTE WORDS
1318 TAD XR
1319 DCA XR
1320 TAD I XR
1321 SNA /IS IT A TENTATIVE FILE?
1322 JMP ADDLEN+1 /YES - TENTATIVE FILES ARE ALWAYS IGNORED
1323 CIA
1324 DCA FLENGT /NO - STORE THE LENGTH
1325 CDF 10
1326 TAD I CHAR /GET THE STARTING FILE FOR THIS LISTING
1327 CIA CLL
1328 TAD BLOKNO
1329 SNL CLA /ARE WE THERE YET?
1330 JMP ADDLEN /NO - KEEP GOING
1331 CLA CLL CMA RTL
1332 JMS I (PRWD /PRINT THREE WORDS
1333NAME1, 0
1334NAME2, 0
1335NAME3, 0
1336 TAD NAME4
1337 SNA CLA /IS THERE AN EXTENSION?
1338 TAD (-16 /NO - PRINT A BLANK
1339 TAD (56 /YES - PRINT A PERIOD
1340 JMS I (PR6BIT
1341 JMS I (PRWD
1342NAME4, 0 /ZERO PRINTS AS TWO MORE BLANKS
1343PRLNGT, TAD DTYPE
1344 AND (100
1345 SZA CLA /WAS THE LISTING SWITCH /F?
1346 JMP PRTCRL /YES - DON'T PRINT LENGTH
1347 TAD FLENGT
1348 JMS I (PRNUM
1349 TAD WASTE
1350 SZA CLA
1351 TAD DDATE
1352 JMS I (PDATE /PRINT THE CREATION DATE OF THE FILE
1353PRTCRL, JMS I (PCRLF
1354ADDLEN, TAD FLENGT
1355 TAD BLOKNO
1356 DCA BLOKNO /UPDATE BLOCK NUMBER
1357 ISZ DCOUNT
1358 JMP NAMELP /LOOP UNTIL ALL FILES ARE PROCESSED
1359 TAD DLINK
1360 SNA CLA /MULTI-SEGMENT DIRECTORY?
1361 JMP ENDDIR /NO - FINISH UP
1362 TAD XR
1363 AND (7400
1364 TAD (377 /BUMP XR TO NEXT BLOCK
1365 JMP NEWSEG /PROCESS NEXT LINK
1366\fDEMPTY, TAD I XR
1367 CIA
1368 DCA FLENGT /STORE LENGTH OF FREE ENTRY
1369 CDF 10
1370 TAD FLENGT
1371 TAD ECOUNT
1372 DCA ECOUNT /BUMP COUNT OF FREE BLOCKS
1373 TAD DTYPE
1374 AND (200
1375 SNA CLA /IS THE /E SWITCH ON?
1376 JMP ADDLEN /NO - DON'T LIST FREE FILES
1377 TAD (-4
1378 JMS I (PRWD
1379 TEXT /<EMPTY>/
1380 JMS I (PR6BIT
1381 TAD FLENGT
1382 JMS I (PRNUM
1383 JMP PRTCRL
1384ENDDIR, ISZ CHAR /BUMP TEMP ARRAY TO NEXT ENTRY
1385 TAD ECOUNT
1386 JMS I (ENDFUJ
1387 JMP NXTDIR
1388 PAGE
1389\f/BINARY MODE PROCESSOR FOR PIP
1390
1391BIN360, 360
1392BINARY, JMS I (FIXLEN
1393 JMS I (OUTOPN
1394 JMS I (IOPEN
1395 JMS I (LEADER /PUT OUT BLANK TAPE IF HS PUNCH OUTPUT
1396 JMS LTCODE
1397NEWTAP, JMS I (ICHAR
1398 JMP BEOF /END OF FILE ON INPUT
1399 SNA
1400 JMP NEWTAP /BLANK TAPE - KEEP GOING
1401 TAD BN7600
1402 SZA CLA
1403 JMP NEWTAP
1404 JMS I (ICHAR
1405 JMP BEOF
1406 TAD BN7600
1407 SNA
1408 JMP .-4
1409 TAD BIN200
1410 DCA CHAR
1411 TAD CHAR
1412BIN200, AND BIN360
1413 TAD (-240 /CHECK TYPE OF TAPE
1414 SNA /IS IT RELOCATABLE?
1415 JMP RELBIN /YES
1416 TAD (-40 /IF A FIELD SETTING, IT'S ABSOLUTE
1417 AND (7700
1418 SNA
1419 JMP ABSLUT
1420 TAD BIN200 /CHECK FOR ORIGIN ALSO
1421 SZA CLA
1422 JMP NEWTAP /NOTHING..NEXT FRAME
1423ABSLUT, CLA CMA
1424 JMS LTCODE
1425ABSBIN, JMS RCOPY1 /COPY THIS FRAME AND READ NEXT
1426 TAD BN7600
1427BNM140, SZA CLA /IS IT TRAILER?
1428 JMP ABSBIN /NO - KEEP GOING
1429BEOT, CLA CMA /END OF TAPE
1430 JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
1431 JMP NEWTAP /GET NEXT TAPE
1432\fLTCODE, 0 /SUBROUTINE TO PUNCH 200 CODE
1433 SMA /SHORT LEADER/TRAILER?
1434 JMS I (OTYPE
1435 SPA CLA /DIRECTORY DEVICE?
1436 TAD (70 /YES
1437 TAD (-100
1438 DCA TEMP
1439LTLOOP, TAD BIN200
1440 JMS I (OCHAR /OUTPUT 64 OR 8 FRAMES OF L/T CODE
1441 JMP I (AOUERR
1442 ISZ TEMP
1443 JMP LTLOOP
1444 JMP I LTCODE
1445
1446RELBIN, TAD (SKP
1447 DCA I (INCTZF /DISABLE CONTROL-Z CHECKING ON INPUT
1448 CLA CMA
1449 JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
1450RELLP, TAD CHAR
1451 RTR
1452 RTR
1453 AND (17
1454 TAD (RELTBL
1455 DCA TEMP
1456 TAD I TEMP /GET DATA WORD FOR THIS FRAME
1457 SMA SZA /POSITIVE MEANS SPECIAL OR ERROR
1458 JMP RELERR
1459RELSNA, SNA
1460 JMP RELEND /ZERO MEANS CHECKSUM FRAME
1461 DCA TEMP /NEGATIVE MEANS COUNT OF NUMBER OF SLAVE FRAMES
1462 JMS RCOPY1
1463BN7600, 7600
1464 ISZ TEMP
1465 JMP .-3 /COPY THIS FRAME AND ALL SLAVE FRAMES
1466 JMP RELLP /GET NEXT CONTROL FRAME
1467RELEND, JMS RCOPY1 /COPY THE FIRST FRAME OF THE CHECKSUM
1468 JMS I (OCHAR
1469 JMP I (AOUERR /OUTPUT THE SECOND FRAME
1470 JMP BEOT /END TAPE - START NEXT ONE
1471BEOF, JMS LTCODE
1472 JMS I (OCLOSE
1473 JMP I (AOUERR
1474 JMP I (PIP
1475\fRCOPY1, 0 /ROUTINE TO ADVANCE "CHAR" TO NEXT INPUT CHARACTER
1476 TAD CHAR
1477 JMS I (OCHAR
1478 JMP I (AOUERR
1479 JMS I (ICHAR
1480 JMP INEFER
1481 DCA CHAR
1482 TAD CHAR
1483 JMP I RCOPY1
1484INEFER, SMA CLA /DETECT FATALITIES
1485 JMS I (PIPERR
1486 7
1487 JMS I (PIPERR /A REAL BAD READ
1488 4
1489
1490RELERR, CLL RAR
1491 SZA CLA /CODE OF 1 MEANS SPECIAL
1492 JMS I (PIPERR /ILLEGAL RELOCATABLE INPUT
1493 10
1494 JMS RCOPY1
1495 CLL CML CMA RTL /MULTIPLY NAME COUNT BY -6 (APPROXIMATELY)
1496 TAD CHAR
1497 CLL CML RAL /(ACTUALLY THIS PRODUCES -6X-1 WHICH IS WHAT WE WANT)
1498 JMP RELSNA
1499 PAGE
1500\fERPRNT, 0 /ERROR MESSAGE PRINTOUT ROUTINE
1501 DCA TEMP
1502ERLP, TAD I TEMP
1503 RTR
1504 RTR
1505 RTR
1506 JMS ERPCH /PRINT HIGH-ORDER CHARACTER
1507 TAD I TEMP
1508 JMS ERPCH /PRINT LOW-ORDER CHARACTER
1509 ISZ TEMP
1510 JMP ERLP
1511
1512ERPCH, 0
1513 AND (77
1514 SNA
1515 JMP ERCRLF /0 CHARACTER TERMINATES
1516 JMS CHPRNT
1517 JMP I ERPCH
1518FILENR, TAD ("#
1519 JMS I (TTYOUT
1520 TAD INFPTR /GET PTR TO CURRENT INPUT FILE
1521 TAD (321 /MAGIC NUMBER
1522 CLL RAR
1523 JMP FILENR-2
1524
1525CHPRNT, 0
1526 TAD (-37 /IS IT A _?
1527 SNA
1528 JMP FILENR /YES..PRINT FILE NUMBER
1529 IAC
1530 SNA /MAYBE ^?
1531 JMP I (SQFILE /YEP..PRINT FILE NAME
1532 SPA
1533 TAD (100
1534 TAD (236
1535 JMS I (TTYOUT
1536 JMP I CHPRNT
1537
1538ERCRLF, TAD (215
1539 JMS I (TTYOUT
1540 TAD (212
1541 JMS I (TTYOUT
1542 JMP I ERPRNT
1543\fPDATE, 0 /PRINTS THE DATE
1544 SNA
1545 JMP I PDATE /NO DATE TO PRINT
1546 DCA ERPRNT
1547 ISZ I (PBLJMP
1548 JMS I (PR6BIT
1549 TAD ERPRNT
1550 CLL RTL
1551 RTL
1552 RAL
1553 AND (17
1554 JMS I (PRNUM
1555 TAD (57
1556 JMS I (PR6BIT
1557 TAD ERPRNT
1558 RTR
1559 RAR
1560 AND (37
1561 JMS I (PRNUM
1562 TAD (57
1563 JMS I (PR6BIT
1564 TAD ERPRNT
1565 AND (7
1566 TAD (106
1567 JMS I (PRNUM
1568 CLA CMA
1569 TAD I (PBLJMP
1570 DCA I (PBLJMP /RESET PRNUM TO PRINT LEADING SPACES
1571 JMP I PDATE
1572
1573DSKNUM, 0
1574 DCA DSKNAM+1
1575 JMS I (200
1576 12
1577DSKNAM, 5723
1578 0
1579 0
1580 HLT
1581 TAD DSKNAM+1
1582 JMP I DSKNUM
1583\fRELTBL, -2;-2;2;-10;-2;-2;-2;2;0;2;-2;2;2;2;2;1
1584
1585ERRTBL, ERR0
1586 ERR1
1587 ERR2
1588 ERR3
1589 ERR4
1590 ERR5
1591 ERR6
1592 ERR7
1593 ERR8
1594 ERR9
1595 ERR10
1596 ERR11
1597 IFNZRO OS78 <DIRMSG>
1598
1599 PAGE
1600\f/ERROR MESSAGE TEXT GOES HERE
1601
1602
1603ERR0, TEXT /NO ROOM FOR OUTPUT FILE/
1604ERR1, TEXT /LINE TOO LONG IN FILE_/
1605ERR3, TEXT /ERROR DELETING FILE/
1606ERR4, TEXT /INPUT ERROR, FILE_/
1607ERR5, TEXT /CAN'T OPEN OUTPUT FILE/
1608ERR6, TEXT /DEVICE_ NOT A DIRECTORY DEVICE/
1609ERR7, TEXT /PREMATURE END OF FILE, FILE_/
1610ERR8, TEXT /ILLEGAL BINARY INPUT, FILE_/
1611ERR9, TEXT /BAD DIRECTORY ON DEVICE_/
1612ERR10, TEXT /DIRECTORY ERROR/
1613
1614
1615TTYOUT, 0
1616 TLS
1617 TSF
1618 JMP .-1
1619 CLA
1620 JMP I TTYOUT
1621 PAGE
1622\f/SQUISH PROCESSOR
1623
1624SQUISH, JMS I (CONFRM
1625 SURE /V3
1626SQUISX, DCA I (OUELEN /INITIALIZE PARAMS TO FAKE OUT "IMTRA"
1627 DCA I (OUBLK
1628 DCA I (7621 /ZERO SECOND FILE FOR "INNEWF"
1629 DCA I (CTCFLG
1630 JMS I (IOPEN
1631 JMS I (INNEWF
1632 JMP I (PIP /NO INPUT
1633 TAD (OUDEVH+1
1634 DCA SOHND
1635 TAD I SQ7600
1636 SNA
1637 JMP I (PIP /NO OUTPUTEE, NO SQUISHEE
1638 JMS I (200
1639 1
1640SOHND, 0
1641 HLT
1642 JMS INTEST
1643 JMS I (OTYPE
1644 CLL RTR
1645 RAR
1646 AND (77
1647 TAD (DEVLEN
1648 DCA TEMP
1649 TAD I TEMP /GET ENTRY FROM DEVICE LENGTH TABLE
1650 DCA OUDLEN /SAVE OUTPUT DEVICE LENGTH
1651 JMS GETEQ
1652 DCA OUWAST
1653 TAD SOHND
1654 DCA OHNDLR
1655 TAD OHNDLR
1656 DCA I (OUHNDL
1657 TAD I (INHNDL
1658 DCA IHNDLR
1659 JMS SETCTC
1660 JMS I (CTCFLG
1661 CIF 0
1662 JMS I IHNDLR
1663 1400
1664 0
1665 1
1666 JMP I (SQIDER+1
1667 CIF 0
1668 JMS I (7607
1669 5400
1670 0
1671 MTEMP /MOVE THE INPUT DIRECTORY TO SYS:
1672 JMP I (SQIDER+1
1673 CLA IAC
1674 DCA I (SQBUF2+2
1675 DCA I (CTCFLG
1676 TAD SOHND /SETUP DIRECTORY START
1677 JMS I (SQDTST
1678 JMS I (SETSAM /IF IHNDLR=OHNDLR, SAME=1
1679 CLA CMA
1680 DCA I (SQBUF2
1681 DCA I (OUTSEG
1682 JMP I (NEWOUT
1683
1684GETEQ, 0 /V3
1685 TAD I (MPARAM+3
1686 SNA
1687 IAC
1688 AND (77 /CONVERT 0 TO 1 AND 100 TO 0
1689 CIA
1690 JMP I GETEQ
1691
1692INTEST, 0 /TEST IF INPUT IS DIRECTORY
1693 TAD I (7617
1694 AND (17
1695 TAD (DCB-1
1696 DCA TEMP
1697 TAD I TEMP
1698 SMA CLA
1699 JMS I (PIPERR
1700 6
1701 JMP I INTEST
1702
1703SETCTC, 0 /MODIFY 07600 TO RETURN TO SQCTLC
1704 TAD CDIF10
1705 CDF 0
1706 DCA I SQ7600
1707 TAD (5602 /JMP I .+1
1708 DCA I (7601
1709 TAD (SQCTLC
1710 DCA I (7602
1711CDIF10, CIF CDF 10
1712 JMP I SETCTC
1713\fOUK, 0 /V3 ON IMAGE MODE TRANSFER
1714 /CLOSE OUT FILE WITH = OPTION
1715 /IF NOT TOO SMALL
1716 TAD I (OUCCNT
1717 CLL CIA
1718 TAD I (MPARAM+3
1719 SNL /IS = OPTION LARGER?
1720SQ7600, 7600 /RETURN OUCCNT IF IT'S LARGER
1721 TAD I (OUCCNT /RETURN LOW ORDER = OPTION IF IT'S LARGER
1722 JMP I OUK
1723 PAGE
1724\fNEWIN, TAD (MTEMP-1
1725 DCA INSEG
1726 JMS I (CTCFLG
1727 CIF 0
1728 JMS I (7607
1729 0210
1730S7200, SQBUF2
1731INSEG, 0
1732 JMP I (SQIDER
1733 DCA I (CTCFLG
1734 TAD I (SQBUF2+1
1735 DCA INBLK
1736 TAD (SQBUF2+4
1737 DCA INXR
1738SGETIN, TAD I INXR
1739 SNA
1740 JMP SEMPTY
1741 DCA I OUTXR
1742 TAD OUTXR
1743 DCA OUSAVE
1744 JMS I (CYWAST /COPY WASTE WORDS
1745 TAD I INXR
1746 DCA RECCNT
1747 TAD RECCNT
1748 SNA
1749 JMP SNULL
1750 CMA CLL /V3
1751 TAD OUTBLK
1752 TAD OUDLEN
1753 SZL CLA
1754 JMP SNULER
1755 TAD RECCNT
1756 DCA I OUTXR
1757 CLA CMA
1758 TAD I (SQBUF1
1759 DCA I (SQBUF1
1760 TAD INBLK
1761 CIA
1762 TAD OUTBLK
1763 SNA CLA
1764 TAD SAME
1765 SNA CLA
1766MOVFIL, JMS I (SQTRA /MOVE THE FILE DOWN
1767 TAD RECCNT
1768 CIA
1769 TAD OUTBLK
1770 DCA OUTBLK
1771 TAD RECCNT
1772DMTX, CIA
1773 TAD INBLK
1774 DCA INBLK
1775 TAD OUTXR
1776 CIA
1777 TAD OUWAST
1778 TAD OUWAST
1779 TAD (SQBUF1+365
1780 SMA CLA /DO WE HAVE ROOM FOR TWO MORE ENTRIES?
1781 JMP NEXTIN
1782
1783 /DIRECTORY SEGMENT OVERFLOW ON OUTPUT...
1784
1785 ISZ I (OUTSEG
1786 TAD I (OUTSEG
1787 IAC
1788 DCA I (SQBUF1+2 /STORE LINK TO NEXT SEGMENT
1789 TAD I (SQBUF1+2
1790 TAD (-7
1791 SMA CLA
1792 JMP I (SQIDER-1 /TOO MANY SEGMENTS
1793 JMS I (OUTDIR /OUTPUT THIS SEGMENT
1794NEWOUT, TAD (SQBUF1-1
1795 DCA OUTXR /INITIALIZE XR FOR NEXT OUTPUT SEGMENT
1796 DCA I (OUTINH /ZAP ANY OLD OUTPUT INHIBIT FLAG
1797 DCA I OUTXR
1798 TAD OUTBLK
1799 DCA I OUTXR
1800 DCA I OUTXR
1801 DCA I OUTXR
1802 TAD OUWAST
1803 DCA I OUTXR
1804NEXTIN, ISZ I S7200
1805 JMP SGETIN
1806 TAD I (SQBUF2+2
1807 SNA /ANY MORE INPUT SEGMENTS?
1808 JMP I (SQOVER
1809 JMP NEWIN
1810SNULER, TAD (NOROOM
1811 JMS I (ERPRNT
1812SNULL, CLA CMA
1813 TAD OUSAVE
1814 DCA OUTXR
1815 JMP DMTX-1
1816SEMPTY, TAD I INXR
1817 JMP DMTX
1818OUSAVE, 0
1819\fSURE, TEXT /ARE YOU SURE?/
1820
1821SETSAM, 0
1822 TAD IHNDLR
1823 CIA
1824 TAD OHNDLR
1825 SNA CLA
1826 IAC
1827 DCA SAME
1828 JMP I SETSAM
1829 PAGE
1830\fSQOVER, DCA I OUTXR
1831 TAD OUDLEN
1832 TAD OUTBLK
1833 SNA
1834 JMP CKZERO
1835 DCA I OUTXR
1836 CLA CMA
1837 TAD I (SQBUF1
1838 DCA I (SQBUF1
1839CKZERO, TAD I (SQBUF1
1840 SZA CLA
1841 JMP ZEROK
1842 CLA CLL CML RAR
1843 JMS OUTDIR /READ IN LAST DIRECTORY
1844 DCA I (SQBUF1+2 /ZERO OUT LINK WORD
1845 SKP
1846ZEROK, ISZ OUTSEG
1847 JMS OUTDIR
1848ZEROKS, JMS SRSTOR
1849 JMP I (PIP
1850
1851 DCA I (SQBUF1+2
1852SQIDER, JMS OUTDIR
1853 JMS SRSTOR
1854 JMS I (PIPERR
1855 12
1856OUTDIR, 0
1857 TAD (4210
1858 DCA .+4
1859 JMS CTCFLG
1860 CIF 0
1861 JMS I OHNDLR
1862 0
1863 SQBUF1
1864OUTSEG, 0
1865 JMP SQIDER+1
1866 DCA CTCFLG
1867 JMP I OUTDIR
1868
1869SQIOER, TAD (IOMSG
1870 JMS I (ERPRNT
1871 JMP I (SLGRET
1872\fSQCTLC, KCC /JUMPED TO BY CODE AT 07600
1873 JMS I (TSTSAM /TEST IF OPERATION IS TO ITSELF
1874 TAD (CTCMSG
1875 JMS I (ERPRNT
1876 TAD CTCFLG
1877 SZA CLA
1878 JMP I CTCFLG
1879 TAD I (MPARAM+1 /IS IT /S?
1880 AND (40
1881 SNA CLA
1882 JMP I (SYSCPY /NO../Y
1883 JMP I (MOVFIL
1884
1885SRSTOR, 0
1886 JMS I (7700 /MAKE SURE MONITOR IS IN CORE
1887 10
1888 DCA .-2 /AND WIPE THE CALL AWAY
1889 TAD (4207
1890 CDF 0
1891 DCA I (7600
1892 TAD (5000
1893 DCA I (7601
1894 DCA I (7602
1895 CDF 10
1896 JMP I SRSTOR
1897
1898CTCFLG, 0
1899 JMP I CTCFLG
1900\fCTCMSG, TEXT /SORRY - NO INTERRUPTIONS/
1901IOMSG, TEXT /I-O ERROR IN ^ - CONTINUING/
1902NOROOM, TEXT /NO ROOM IN ^ - CONTINUING/
1903 PAGE
1904\fK7760, 7760
1905SYSCOP, TAD K7622 /SET INFPTR IN CASE OF /Y ERROR
1906 DCA INFPTR /WILL FILE #1
1907 JMS I (SETCTC /KLUDGE UP 07600
1908SYSCPY, TAD (INDEVH+1
1909 DCA YIHAND /SET TO ASSIGN INPUT HANDLER
1910 TAD (OUDEVH+1
1911 DCA YOHAND
1912 TAD (2000
1913 DCA K2000 /THIS MAY GET CLOBBERED READING IN DIRECT.
1914 TAD (10
1915 DCA OFSET
1916 TAD I K7617
1917 SNA CLA /IS THERE AN INPUT DEVICE?
1918 ISZ I K7617 /MAKE INPUT =SYS
1919 JMS I (INTEST /SEE IF OPERATIONS ARE TO SAME DEVICE
1920 TAD I K7617
1921 JMS I K200 /ASSIGN HANDLER
1922 1
1923YIHAND, 0
1924K7622, 7622 /THINLY DISGUISED HALT
1925 TAD I K7617
1926K200, AND K7760 /CHECK INPUT FILE LENGTH
1927 SNA /IF BLANK,INPUT SYSTEM HEAD
1928 JMP YSOUT
1929 TAD (-6340 /CHECK FOR PROPER LENGTH
1930 SZA CLA
1931 JMP PER13 /ERROR..NOT SYSTEM HEAD
1932 TAD I (7601 /IS THERE OUTPUT DEVICE?
1933 SZA CLA /IF YES..WE CAN DO IMAGE XFER
1934 JMP I (IMGTST
1935 TAD I (7620
1936YOUSYS, DCA YINREC /PICK UP STARTING RECORD
1937 CIF 0
1938 JMS I YIHAND /READ IN FIRST INPUT RECORDS
1939K2000, 2000 /(0-15 IF SYSTEM HEAD,0-7 IF FILE)
1940 OUBUF
1941YINREC, 0
1942 JMP I (PER4 /INPUT ERROR
1943 TAD I (7620 /IF INPUT FROM A FILE, OPEN
1944 SZA CLA /A HOLE FOR OUTPUT DIRECTORY
1945 JMS I (MOVE /DO A CORE MOVE
1946 JMS I (TSTHED /TEST FOR VALID SYSTEM HEAD
1947 TAD YINREC
1948 TAD OFSET /BUMP TO NEXT RECORD
1949 DCA NXTRD
1950 TAD I (7600 /IF NO OUTPUT, FORGET IT
1951 SNA
1952 JMP PIPCLR /RESET AND GO TO PIP
1953 JMS I K200
1954 1
1955YOHAND, 0
1956 HLT /V3
1957 JMS I (FAKE
1958 JMS I (SETSAM
1959\f JMS I (TSTIO /TEST OUTPUT. SEE IF DIRECT. DEV.
1960 CIF 0
1961 JMS I YOHAND /READ OUTPUT DIRECTORY INTO PLACE
1962 1400
1963 400
1964 1
1965 JMP I (PER4
1966 CDF 0
1967 TAD I (401 /NOW TEST FOR VALID OUTPUT DEVICE
1968 CDF 10
1969 TAD (-10 /IF LESS THAN 10, DON'T XFER
1970 SPA CLA
1971 JMS I (PIPERR
1972 11
1973 TAD (-4
1974 DCA YINREC /XFER COUNTER
1975
1976 JMP YDUMP
1977YLOOP, CIF 0
1978 JMS I YIHAND /READ NEXT
1979K3400, 3400 /16 BLOCKS
1980 OUBUF
1981NXTRD, 0
1982 JMP I (PER4
1983 TAD NXTRD
1984 TAD (16
1985 DCA NXTRD
1986YDUMP, TAD (7400
1987 JMS I (OUTDMP /WRITE BUFFER
1988 JMP I (AOUERR
1989 ISZ YINREC /DONE YET?
1990 JMP YLOOP /NOT YET..LOOP
1991PIPCLR, JMS I (SRSTOR /CLEAR OUT 07600
1992 JMP I (PIP
1993\fYSOUT, TAD I (7601 /HERE IF INPUT FROM SYSTEM HEAD
1994 SZA CLA /IS THERE AN OUTPUT FILE?
1995 JMP I (YTSOUT /YES, SET UP FOR IMAGE MODE
1996YNOOUT, TAD K3400 /SET TO READ IN DIRECTORY
1997 DCA K2000 /PLUS FIRST 7 RECORDS
1998 TAD (16 /AND RESTART READ AT RECORD 16
1999 DCA OFSET
2000 JMP YOUSYS
2001OFSET, 0
2002
2003PER13, JMS I (PIPERR
2004 13
2005K7617, 7617 /V3
2006 PAGE
2007\fDIRECT, -1
2008DFORG, 0 /FILE STORAGE
2009 0
2010 0
2011DWASTE, 0 /#WASTE WORDS
2012 0
2013DLENGT, 0
2014
2015MOVE, 0
2016 TAD (4400 /MOVES CORE TO OPEN DIRECTORY HOLE
2017 DCA TEMP
2018 TAD (3777
2019 DCA MWAST
2020 TAD (6777
2021MOVE1, DCA TSTSAM
2022 CDF 0
2023 TAD I MWAST
2024 DCA I TSTSAM
2025 CMA
2026 TAD MWAST
2027 DCA MWAST
2028 CMA
2029 TAD TSTSAM
2030 ISZ TEMP
2031 JMP MOVE1
2032 CLA
2033 CDF 10
2034 JMP I MOVE
2035
2036ERR11, TEXT /BAD SYSTEM HEAD/
2037
2038YTSOUT, TAD I (7617 /O.K. SETUP CD AREA FOR IMAGE XFER
2039 TAD (7760 /FROM SYSTEM AREA OF INPUT DEVICE
2040 DCA I (7617
2041 TAD I (7617
2042 AND (17
2043 TAD (6360
2044 DCA I (7621
2045 TAD K7
2046 DCA I (7622
2047IMGTST, DCA SAME /ALLOW ^C IF TO OUTPUT FILE
2048 TAD I (YIHAND /TEST FOT VALID SYSTEM
2049 DCA IHNDLR
2050 CIF 0
2051 JMS I IHNDLR
2052 0200
2053 3400
2054K7, 7
2055 JMP I (PER4
2056 JMS I (TSTHED
2057 JMP I (IMAGE
2058\fTSTSAM, 0
2059 TAD SAME /IF /Y IS TO SAME DEVICE AS INPUT (SYS)
2060 SNA CLA /^C GIVES MESSAGE AND RETRIES OPERATION
2061 JMP I (ZEROKS
2062 JMP I TSTSAM
2063
2064ERR2, TEXT /OUTPUT ERROR/
2065
2066SQFILE, DCA MWAST
2067 TAD I (OUSAVE
2068 DCA TSTSAM /IF ERROR DURING /S
2069 DCA DWASTE
2070 CLA CLL CMA RTL
2071 DCA MOVE /-3 FOR FILE NAME
2072SQFIL3, TAD I TSTSAM /FIRST 2 CHARS. IN NAME
2073 CLL RTR
2074 RTR
2075 RTR
2076SQFIL5, AND (77
2077 SZA /IF ZERO, DON'T BOTHER
2078 JMS I (CHPRNT
2079 ISZ DWASTE /RIGHT HALF OR NEW WORD?
2080 JMP SQFIL4 /RIGHT HALF
2081 ISZ TSTSAM
2082 ISZ MOVE /EXHAUSTED ALL?
2083 JMP SQFIL3 /NOPE
2084 TAD MWAST /DONE WITH IT YET?
2085 SZA CLA
2086 JMP I (FILENR-1 /YES
2087 TAD I TSTSAM /IS THERE AN EXTENSION?
2088 SNA CLA
2089 JMP I (FILENR-1 /NO..CONTINUE ORIGINAL MSG
2090 TAD (256
2091 JMS I (TTYOUT
2092 ISZ MWAST /SIGNAL END
2093 CLA CMA
2094 JMP SQFIL3-1
2095SQFIL4, CLA CMA
2096 DCA DWASTE
2097 TAD I TSTSAM /GET RIGHT HALF
2098 JMP SQFIL5
2099\fMWAST, 0
2100 DCA TEMP
2101 TAD I INXR
2102 DCA I OUTXR /ROUTINE TO COPY WASTE WORDS
2103 ISZ TEMP
2104 JMP .-3
2105 JMP I MWAST
2106 PAGE
2107\fFAKE, 0
2108 TAD I (YIHAND
2109 DCA IHNDLR
2110 TAD I (YOHAND
2111 DCA OHNDLR
2112 DCA I (OUCCNT
2113 DCA I (OUBLK
2114 DCA I (OUELEN
2115 TAD I (YOHAND
2116 DCA I (OUHNDL
2117 JMP I FAKE
2118
2119CYWAST, 0 /ROUTINE TO COPY WASTE WORDS
2120 CLA CLL CMA RTL /THREE MORE FOR FILE NAME
2121 JMS I (MWAST /COPY THEM
2122 TAD I (SQBUF2+4 /NOW ADJUST I/O WASTE WORDS
2123 CIA
2124 TAD OUWAST /DIFF. BETWEEN OUT AND IN WORDS
2125 SMA /IF <0, MORE OUT THAN IN
2126 JMP CGEWST /POS. MORE IN THAN OUT (OR SAME)
2127 DCA TEMP1
2128 TAD I (SQBUF2+4
2129 SZA
2130 JMS I (MWAST /COPY ALL INPUT WORDS
2131 DCA I OUTXR /AND 0 ALL EXTRA OUTPUT WORDS
2132 ISZ TEMP1
2133 JMP .-2
2134 JMP I CYWAST
2135CGEWST, DCA TEMP1
2136 TAD OUWAST /XFER ONLY ENOUGH OUTPUT WDS.
2137 SZA
2138 JMS I (MWAST
2139 TAD INXR
2140 TAD TEMP1 /POINT INPUT TO NEXT FILE
2141 DCA INXR
2142 JMP I CYWAST
2143
2144TSTHED, 0 /TESTS FOR KEYBOARD MONITOR
2145 CDF 0
2146 TAD I (3401
2147 CDF 10
2148 TAD (-7200
2149 SZA CLA
2150 JMP I (PER13 /IF NOT CLA, NOT VALID
2151 JMP I TSTHED
2152\fTSTIO, 0 /SEE IF OUTPUT IS DIRECTORY DEVICE
2153 JMS I (OTYPE /GET DCB WORD FOR OUTPUT
2154 SMA CLA /IF NOT NEG., NOT DIRECT DEVICE
2155 JMS I (PIPERR
2156 5
2157 TAD OHNDLR /IF OUTPUT=SYS, SET NO INTERRUPT
2158 TAD (171
2159 SNA CLA
2160 ISZ SAME
2161 JMP I TSTIO
2162
2163ASCI2, 0 /SEE IF VALID ASCII OUTPUT
2164 DCA TSTIO
2165 TAD I (7600
2166 SNA CLA
2167 JMP I (PIP /NO..BACK TO PIP
2168 TAD TSTIO /SEE IF /C IS ON
2169 SNA CLA
2170 JMS I (FIXLEN /NO..TRY TO ESTIMATE OUTPUT
2171 JMP I ASCI2
2172
2173SQDTST, 0 /ROUTINE TO CHECK /S DIRECTORIES
2174 DCA NOHND /PRESERVE POSSIBLE SYS ON OUTPUT
2175 TAD (7 /DEFAULT TO BLOCK 7
2176 DCA OUTBLK /INITIAL GUESS
2177 CDF 10 /NOW TRY TO READ DIRECTORY OF OUTPUT
2178 JMS I (OTYPE /IF NON-FILE, DON'T READ IT
2179 SMA CLA
2180 JMP P1A
2181 CIF 0 /COULD BE NON-FILE, HOWEVER.
2182 JMS I NOHND
2183 0210
2184 1400
2185P1, 1
2186 JMP I (SQIDER+1 /ERROR IN READ
2187P1A, DCA OLDDIR /WIPES ANY DIRECT. SEGMENT
2188 TAD I (1401
2189 TAD (-70 /IS OUTPUT A SYS DEVICE?
2190 SNA CLA
2191 JMP SYSDIR /YES.
2192 TAD NOHND /IS OUTPUT THE SYSTEM DEVICE?
2193 TAD (171
2194 SZA CLA
2195 JMP .+3
2196SYSDIR, TAD (70
2197 DCA OUTBLK
2198 JMP I SQDTST
2199
2200NOHND=FAKE
2201
2202SYSZRO, TEXT /ZERO SYS?/
2203\fAOUERR, SMA CLA /WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
2204 JMP BOUERR /OUT OF SPACE
2205PER2, JMS I (PIPERR
2206 2
2207BOUERR, JMS I (PIPERR
2208 0
2209
2210ASCPTCH,TAD (ACHLP+1 /V3C FAKE OUT ICHAR
2211 DCA I (ICHAR /SIMULATE CALL TO ICHAR FROM 'ACHLP'
2212 JMP I (GETNEW /V3C SIMULATE OCCURRENCE OF 8-BIT ^Z IN ICHAR
2213 PAGE
2214\f/THIS IS ONCE-ONLY CODE
2215
2216ONCE, 0
2217 STA
2218 TAD ONCE
2219 DCA ONCENF
2220 TAD (20
2221 DCA I ONCENF /RESTORE L20, DON'T ALLOW REENTRY
2222 TAD I (MPARAM+1
2223 AND (7
2224 SNA CLA /IS /V SET?
2225 JMP I ONCE /NO, RETURN
2226 TAD (VER /YES
2227 JMS I (ERPRNT /PRINT VERSION NUMBER
2228 JMP I ONCE /RETURN
2229
2230VER, TEXT \OS/8 PIP V11A\
2231ONCENF, 0
2232 PAGE
2233 $
2234\f
My complete PDP-8 universe