--- /dev/null
+/3 PIP FOR OS/8 MONITOR
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975,1977
+/BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ 4-MAY-1977 FILE: PIP.PA OS/8 VERSION 12A
+/RL/EF/ET.AL./S.R./E.S.
+
+
+
+/ABSTRACT----
+/PIP (PERIPHERAL INTERCHANGE PROGRAM) IS A GENERAL FILE
+/MANIPULATION PROGRAM FOR THE OS/8 PROGRAMMING SYSTEM.
+/PIP ACCOMPLISHES DATA TRANSFERS BETWEEN ANY DEVICES IN THE OS/8
+/CONFIGURATION.
+
+
+/VERSION 3 MODS:
+
+/FIXED PROBLEM WITH ONE-PAGE WRITE
+/IN /S OR /Z, =OPTION IS TAKEN MODULO 100 (OCTAL)
+/ WITH 100, 200, ETC. MEANING USE 0 ADDITIONAL WDS.
+/DATES STILL DON'T LINE UP
+/'0 FREE BLOCKS'
+/ALLOW FILLING UP DEVICE TO VERY LAST BLOCK
+/ALLOW 7-BIT ^C
+/ALTMODE ON CD LINE RETURNS TO MONITOR WHEN DONE
+/NO HALT ON /L IF NO TTY HANDLER (ACTS AS NOP)
+/ /V PRINTS VERSION NUMBER FIRST TIME CALLED
+/ /O AFFIRMS /Y ON ZERO SYS OR ARE YOU SURE
+/=NNNN ON /I OPTION SPECIFIES LENGTH TO CLOSE FILE
+
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. FIXED LENGTH OF ALL VARIETIES OF RF08
+/2. ADDED RX01 TO INTERNAL LENGTH TABLES
+/3. CHANGED VERSION NUMBER TO V10
+/4. ADDED CHECK FOR 7-BIT CTRL/Z TO ASCII HANDLER
+
+/E.S. DISABLED /E,/F,/L
+/E.S. FIXED /Y OPTION PER SPR
+
+\f/DETAILS OF PIP:
+
+/PIP RUNS WITH THE USR (USER SERVICE ROUTINES) ALWAYS IN CORE.
+/THIS ELIMINATES SWAPPING THE MONITOR. IF ANY CHANGES ARE MADE
+/TO PIP, CARE SHOULD BE TAKEN IN USING PAGE ZERO LOCATIONS, AS
+/THEY MUST NOT DESTROY ANY MONITOR LOCATIONS.
+
+/CORE USED:
+/FIELD 0
+
+/00000-02777- OUTPUT BUFFER
+/03000-06377- INPUT BUFFER
+/06400-06577- USED FOR /Y COMMAND ONLY
+/06600-07177- INPUT HANDLER
+/07200-07577- OUTPUT HANDLER
+
+/FIELD 1
+
+/10000-11777- OS/8 I/O MONITOR
+/12000-16577- EXECUTABLE CODE
+/16600-17177- HOLDS NEW DIRECTORY SEGMENT FOR /S OPTION
+/17200-17577- HOLDS OLD DIRECTORY SEGMENT IN /S OPTION
+
+
+/MAJOR PIECES OF CODE AND THEIR FUNCTION (BRIEFLY).
+/THIS IS A LIST OF ROUTINES AS THEY APPEAR PHYSICALLY, AND
+/NOT AS THEY ARE LOGICALLY CONNECTED.
+
+/ICHAR- GENERAL CHARACTER INPUT ROUTINE. ASSIGNS NEW
+/ DEVICE HANDLERS AS NEEDED.
+
+/OOPEN- ENTERS A FILE ON A SPECIFIED DEVICE.
+
+/OUTDMP- WRITES OUTPUT BUFFER TO OUTPUT DEVICE.
+
+/OCLOSE- CLOSES FILE CREATED BY OOPEN
+
+/OCHAR- CHARACTER OUTPUT ROUTINE. WRITES CHARACTERS
+/ TO OUTPUT BUFFER, CALLING OUTDMP WHEN FULL.
+
+/OTYPE- USES DEVICE NUMBER IN OUTPUT AREA OF CD TO
+/ INSPECT THE DEVICE CONTROL BLOCK WORD. THIS
+/ GIVES A CODE FOR THE TYPE OF DEVICE.
+
+/SLASHG- HANDLES I/O ERRORS. IF /G IS SET, HARD I/O
+/ ERRORS ARE IGNORED. IF /S AND /G ARE ON, A
+/ SPECIAL RETURN IS TAKEN.
+
+/IMAGE- IMAGE MODE PROCESSOR FOR PIP.
+
+/SQTRA- MAIN SUBROUTINE OF IMAGE MODE, AND /S OPTION.
+
+/PIP, PIP+1- MAIN ENTRANCES TO PIP. THE CODE ON THIS PAGE
+/ INSPECTS CD OPTION WORDS AND BRANCHES TO PROPER
+/ ROUTINES.
+
+/ASCII- THE DEFAULT TRANSFER MODE IN PIP IS ASCII.
+
+/DELETE- DELETES FILES ON OUTPUT SIDE OF CD LIST.
+
+/DZERO- ZEROES DIRECTORY OF FIRST OUTPUT DEVICE.
+
+/PIPERR- ERROR ROUTINR FOR PIP.
+
+/DIRPRE- DIRECTORY PRINTING ROUTINE.
+
+/BINARY- BINARY MODE PROCESSOR. HANDLES ABSOLUTE AND
+/ RELOCATABLE BINARY FILES.
+
+/ERPRNT- ERROR PRINTOUT.
+
+/SQUISH- FILE COMPRESSION PROCESSOR. ELIMINATES 'HOLES'
+/ IN DIRECTORY OF INPUT DEVICE.
+
+/SYSCOP- SYSTEM COPY PROCESSOR. ALLOWS TRANSFER OF THE
+/ OS/8 SYSTEM AREA.
+\f/OPTIONS AVAILABLE IN PIP:
+
+/A- ASCII TRANSFER; DEFAULT MODE
+/B- BINARY MODE TANSFER
+/C- DELETE TRAILING BLANKS. (ASCII MODE)
+/D- DELETE FIRST OUTPUT FILE BEFORE PROCEEDING
+/E- LIST INPUT DIRECTORY INCLUDING EMPTY FILES
+/F- LIST INPUT DIRECTORY; ONLY FILE NAMES
+/G- IGNORE ERRORS WHILE TRANSFERING
+/I- IMAGE MODE TRANSFER
+/L- LIST INPUT DIRECTORY; EXCLUDE EMPTY FILES
+/O- OK TO PERFORM A SQUISH OR ZERO WITHOUT ASKING
+/S- COMPRESS INPUT DEVICE ONTO OUTPUT DEVICE. ELIMINATES
+/ 'HOLES' ON INPUT DEVICE.
+/T- PROVIDE SIMPLE TTY FORMATTING. (ASCII ONLY)
+/Y- COPY OS/8 SYSTEM AREA
+/Z- ZERO OUTPUT DEVICE DIRECTORY BEFORE PROCEEDING
+/=N- LEAVE N WORDS EXTRA PER DIRECTORY ENTR. VALID
+/ ONLY WITH /S OR /Z.
+/=N- WITH /I OPTION CLOSES OUTPUT FILE WITH THIS LENGTH
+/V PRINTS VERSION # (FIRST TIME ONLY)
+
+/COMMENTS ON THE PROGRAM:
+
+ /SINCE PIP RUNS WITH USR IN CORE, NO PAGE ZERO LITERALS
+ /CAN BE USED. THE LOCATIONS CURRENTLY USED IN
+ /FIELD 1 ON PAGE ZERO ARE:
+
+ OUTXR=10
+ INXR=11
+ TEMP1=12
+ IHNDLR=24 /HOLDS INPUT HANDLER ADDRESS
+ OHNDLR=25 /OUTPUT HANDLER ADDRESS
+ SQFLAG=26 /'SQUISH INDICATOR
+ OUWAST=27 /# WASTE WORDS ON OUTPUT
+ OUTBLK=30
+ OUDLEN=31
+ SAME=32
+ INBLK=33
+ RECCNT=34
+
+/CONSTANTS USED BY THE DIRECTORY PRINTOUT ROUTINE (OVERLAPPING) ARE:
+
+ FLENGT=24
+ BLOKNO=25
+ DTYPE=27
+ DCOUNT=30
+ DLINK=31
+ WASTE=32
+ DDATE=33
+ ECOUNT=35
+\f /PIP FOR OS/8 MONITOR
+ /EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES
+
+ OUBUF=0 /MUST BE LOWER THAN INBUF
+ OUCTL=5400 /OUTPUT BUFFER OF 3000 WORDS
+ OUDEVH=7200 /PROVIDE ROOM FOR TWO-PAGE HANDLERS
+ INBUF=3000
+ INCTL=1600 /INPUT BUFFER OF 3400 WORDS
+ INRECS=7
+ INDEVH=6600
+
+ /PAGE 6400 IS FREE, EXCEPT DURING /Y COMMAND
+
+ /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR
+ DCB=7760
+ MPARAM=7643 /CD PARAMETER AREA
+ OLDDIR=7 /POINTER TO MONITOR VARIABLE "OLDT9"
+ MTEMP=27 /MONITOR SCRATCH AREA ON "SYS" - ***VOLATILE***
+ PTP=20 /INTERNAL TYPE CODE FOR PAPER TAPE PUNCH
+ XR=10
+ TEMP=20
+ CHAR=21
+ INFPTR=22
+ INEOF=23
+
+ ABUF=6601 /LINE BUFFER - 150 CHARACTERS LONG
+ SQBUF1=6600 /DIRECTORY BUFFER FOR "SQUISH" OPTION
+ SQBUF2=7200 /""
+
+ FIELD 1
+
+/TO ENABLE /E,/F,/L SET
+/OS78=0
+
+/TO DISABLE /E,/F,/L
+IFNDEF OS78 <OS78=1>
+
+\f /GENERAL CHARACTER I/O ROUTINES FOR BLEEP
+ /CALLED AS FOLLOWS:
+
+ /JMS I (IOPEN INITIALIZES THE INPUT ROUTINE
+
+ /JMS I (ICHAR READS A CHARACTER
+ /ERROR RETURN /AC>0 IF END OF FILE, AC<0 IF READ ERROR
+
+ /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE
+ /ERROR RETURN AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
+
+ /JMS I (OCHAR OUTPUTS A CHARACTER
+ /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT
+
+ /JMS I (OCLOSE CLOSES THE OUTPUT FILE
+ /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
+
+ /JMS I (OTYPE RETURNS DCB WORD OF OUTPUT DEVICE IN AC
+
+
+
+ /PARAMETERS NEEDED:
+
+ /INBUF= ADDRESS OF INPUT BUFFER
+ /INCTL= INPUT BUFFER CONTROL WORD
+ /OUBUF= ADDRESS OF OUTPUT BUFFER
+ /OUCTL= OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
+ /INRECS= [INCTL/256]
+ /INDEVH= ADDRESS OF PAGE FOR INPUT HANDLER
+ /OUDEVH= ADDRESS OF PAGE FOR OUTPUT HANDLER
+
+ /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
+ /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
+\f INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
+ OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
+
+ *2000
+
+IN7400, 7400
+IOPEN, 0
+ CLA CMA
+ DCA INCHCT /SET INCHCT TO FORCE A READ
+ ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE
+ TAD (7617
+ DCA INFPTR /RESET FILE POINTER
+ RDF
+ TAD INCDIF
+ DCA .+1
+INPTR, HLT /RESTORE CALLING FIELDS
+ JMP I IOPEN
+
+ICHAR, 0
+IN7600, 7600
+ RDF
+ TAD INCDIF
+ DCA INRTRN /SAVE CALLING FIELDS
+INCHAR, CDF INFLD
+ ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF
+ SNA CLA /DID LAST READ YIELD END-OF-FILE?
+ JMP INGBUF /NO - DO ANOTHER
+GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
+ JMP EOFERR /NO FILE TO OPEN
+INGBUF, TAD INCTR
+ CLL
+ TAD (INRECS
+ SNL
+ DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED
+ SZL /IS THIS THE LAST READ?
+ ISZ INEOF /YES - SET END-OF-FILE FLAG
+ /NOT END-OF-FILE IF INPUT DEVICE
+ /IS NON-FILE STRUCTURED!
+ CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ
+ RTR /FROM THE AMOUNT OF THE OVERFLOW
+ RTR /(IF ANY) AND THE STANDARD CONTROL WORD
+ TAD (INCTL+1
+ DCA INCTLW
+INCDIF, CDF CIF 0
+ CDF 10
+ JMS I INHNDL /CALL THE DEVICE HANDLER
+INCTLW, 0
+INBUFP, INBUF
+INREC, 0
+ JMS I (SLASHG /A HANDLER ERROR - SHOULD WE IGNORE?
+ INERRX-. /ADDRESS IF NOT
+INBREC, TAD INREC
+ TAD (INRECS
+ DCA INREC /UPDATE THE RECORD NUMBER
+ TAD INCTLW
+ AND IN7600
+ CLL RAL
+ TAD INCTLW
+ AND IN7600
+ CMA
+ DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
+ TAD INJMPP
+ DCA INJMP /RESET THE CHARACTER SWITCH
+ TAD INBUFP
+ DCA INPTR /AND THE WORD POINTER
+ JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
+INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
+ SMA CLA /WHICH TYPE WAS IT?
+ JMP INBREC /END OF FILE - RESUME THY PROCESSING
+INERR, CLA CLL CML RAR /BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC
+EOFERR, JMP INRTRN
+INJMP, HLT /THIS IS THE THREE - WAY CHARACTER SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+IN200, AND IN7400
+ CLL RTR
+ RTR /COMBINE THE HIGH-ORDER FOUR BITS OF
+ TAD INCTLW
+ RTR /THE TWO WORD TO FORM THE THIRD CHARACTER
+ RTR
+ ISZ INPTR
+ JMP INCOMN
+ICHAR2, TAD I INPTR
+ AND IN7400
+ DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
+ ISZ INPTR /BUMP THE WORD POINTER
+ICHAR1, TAD I INPTR
+INCOMN, AND (377
+ TAD (-232
+INCTZF, SNA /IS THE CHARACTER A ^Z?
+ JMP GETNEW /YES - GET A NEW FILE
+ TAD (232 /RESTORE THE CHARACTER
+ ISZ ICHAR /BUMP RETURN TO NORMAL RETURN
+INRTRN, 0 /RESTORE CALLING FIELDS
+ JMP I ICHAR /AND RETURN
+ /IOPEN IS UNNECESSARY.
+\fINNEWF, -1 /ROUTINE TO OPEN NEW INPUT FILE
+ INCHCT=INNEWF
+ CDF 10
+ TAD (INDEVH+1
+ DCA INHNDL /INITIALIZE HANDLER ADDRESS
+ TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
+ SNA /ANY MORE?
+ JMP I INNEWF /NO - OUT OF INPUT
+ JMS I IN200
+ 1 /ASSIGN, FETCH HANDLER
+INHNDL, 0
+ HLT /HUH?
+ TAD I INFPTR
+ AND (7760 /GET LENGTH PART OF WORD
+ SZA /LENGTH OF 0 MEANS LENGTH >=256
+ TAD (17 /ADD HIGH-ORDER BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INFPTR
+ TAD I INFPTR
+ DCA INREC /STORE STARTING RECORD NUMBER OF FILE
+ ISZ INFPTR
+ DCA INEOF /ZERO END-OF-FILE FLAG
+ ISZ INNEWF
+ JMP I INNEWF
+ INCTR=IOPEN
+ PAGE
+\fOOPEN, 0 /OPEN OUTPUT FILE
+OU7600, 7600
+/ RDF
+/ TAD OUCDIF
+/ DCA OORETN
+ TAD OU7601
+ DCA OUBLK
+ TAD (OUDEVH+1
+ DCA OUHNDL
+ CDF 10
+ TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
+ AND (17 /STRIP OFF ANY LENGTH INFO
+ SNA /IS THERE AN OUTPUT DEVICE?
+ JMP ONOFIL /NO - INHIBIT OUTPUT
+ JMS I (200
+ 1 /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ HLT /HUH?
+OUENTR, TAD I OU7600
+ JMS I (200
+ 3 /ENTER OUTPUT FILE
+OUBLK, 7601 /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
+ DCA OUCCNT
+ DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
+ JMS I (OUSETP
+ ISZ OOPEN
+OORETN, CDF CIF 10 /RESTORE CALLING FIELDS
+ JMP I OOPEN
+OEFAIL, TAD I OU7600
+ AND (7760 /GET REQUESTED LENGTH
+ SNA CLA /WAS IT AN INDEFINITE REQUEST
+ JMP ONTERR /YES - CANNOT ENTER THE FILE
+ TAD I OU7600
+ AND (17 /MAKE THE REQUESTED LENGTH ZERO
+ DCA I OU7600
+ JMP OUENTR /TRY, TRY AGAIN
+ONTERR, CLA CLL CML RAR
+ JMP OORETN /TAKE THE ERROR RETURN WITH AC<0
+ONOFIL, ISZ I (OUTINH
+ JMP OORETN /TAKE THE ERROR RETURN WITH AC=0
+\fOUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ CDF 10
+ TAD I (OUTINH
+ SZA CLA
+ JMP OUNOWR
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
+ TAD OUCTLW
+ CLL RTL
+ RTL
+ RTL
+ AND (17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH?
+ JMP I OUTDMP /YES - SIGNAL OUTPUT ERROR
+OUCDIF, CDF CIF 0
+ CDF 10
+ JMS I OUHNDL
+OUCTLW, 0
+ OUBUF
+OUREC, 0
+ JMS I (SLASHG
+ .+2-.
+OUNOWR, ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN
+ JMP I OUTDMP
+\fOCLOSE, 0
+ CDF 10
+ TAD I (OUTINH
+ SZA CLA /IS OUTPUT INHIBITED?
+ JMP OCISZ /YES - CLOSE IS A NOP
+ JMS I (OTYPE
+ AND (770
+ TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
+ SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
+ TAD (232 /OUTPUT A ^Z
+ JMS I (OCHAR
+ JMP OCRET
+ JMS I (OCHAR
+ JMP OCRET
+FILLLP, JMS I (OCHAR
+ JMP OCRET
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ TAD (100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
+ TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT
+ TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT
+ JMS OUTDMP
+ JMP OCRET /AN ERROR OCCURRED WHILE DUMPING THE BUFFER
+NODUMP, TAD I OU7600 /GET THE DEVICE NUMBER
+ JMS I (200
+ 4 /CLOSE THE OUTPUT FILE
+OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME
+OUCCNT, 0
+ SKP /ERROR WHILE CLOSING THE FILE - BAD!
+OCISZ, ISZ OCLOSE
+OCRET, CDF CIF 10 /RESTORE CALLING FIELDS
+ JMP I OCLOSE
+ PAGE
+\fOUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS
+ TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS
+ CIA /PAL10 IS DEFINITELY NOT NICE
+ DCA OUDWCT
+/ TAD (OUBUF
+ IFNZRO OUBUF <ERROR!> /V3
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
+ JMP I OUSETP
+
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ RDF
+ TAD (CDF CIF 0
+ DCA OUCRET
+ TAD OUTINH
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP OUCOMN /NO - EXIT
+OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF THIRD CHAR
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, ISZ OCHAR
+OUCRET, HLT /RESTORE CALLING FIELDS
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTINH, 0
+\fOTYPE, 0
+ RDF
+ TAD (CDF CIF 0
+ DCA OTRTN
+ CDF 10
+ TAD I (7600
+ AND (17
+ TAD (DCB-1
+ DCA OUTEMP
+ TAD I OUTEMP
+OTRTN, HLT
+ JMP I OTYPE
+CTCTST, 0
+ TAD (200 /V3
+ KRS
+ TAD (-203
+ SNA CLA /IS THE TELETYPE BUFFER A ^C
+ KSF /WITH THE TELETYPE FLAG ON?
+ JMP I CTCTST /NO
+LEAVE, CDF CIF 0 /YES - GO TO MONITOR
+ JMP I (7600 /THROUGH THE "SAVE CORE" RETURN
+
+SLASHG, 0
+ DCA CTCTST
+ TAD SQFLAG
+ SZA CLA /ARE WE SQUISHING?
+ JMP I (SQIOER /YES
+ TAD CTCTST
+ SPA CLA /ONLY IGNORE HARD ERRORS
+ TAD I (MPARAM
+ AND (40
+ SZA CLA / "G" SWITCH
+SLGRET, JMP I SLASHG /IGNORED!
+ TAD I SLASHG
+ TAD SLASHG
+ DCA SLASHG /SET UP NON-IGNORE ADDRESS
+ TAD CTCTST
+ JMP I SLASHG /RETURN WITH AC RESTORED
+
+\f
+ IFZERO OS78 <
+DIR, DCA DTYPE /SAVE TYPE OF REQUEST
+ TAD I (7600
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP I (DIRPRE /YES
+ DCA TTYDEV+1
+ JMS I (200
+ 12 /ASSIGN WITHOUT FETCH
+TTYDEV, 5524 /COMPRESSED CODE FOR "TTY"
+ 0
+ 0
+ JMP I (PIP /V3 WHAT - NO TELETYPE!
+ TAD TTYDEV+1
+ DCA I (7600
+ JMP I (DIRPRE
+ >
+
+ IFNZRO OS78 <
+DIR, JMS I (PIPERR /TYPE OUT MESSAGE
+ 14
+DIRMSG, TEXT "USE DIRECT"
+ >
+
+ PAGE
+\f /PIP PROPER BEGINS HERE
+ /**********************
+
+ /IMAGE MODE PROCESSOR FOR PIP
+
+IMAGE, JMS I (FIXLEN
+ JMS I (OUTOPN
+ JMS IMTRA
+IMCLOS, TAD I (OUTINH
+ SZA CLA /WAS THERE AN OUTPUT FILE?
+ JMP I (PIPCLR /NO - DON'T CLOSE IT
+ JMS I (OUK /GET THE LENGTH OF THE OUTPUT FILE
+ DCA IMCCNT
+ TAD I IM7600
+ JMS I (200
+ 4 /CLOSE
+ 7601 /FILE NAME
+IMCCNT, 0
+ JMP I (AOUERR
+ JMP I (PIPCLR
+
+ENDFUJ, 0 /PART OF DIRECTORY PRINTING ROUTINE
+ JMS I (PRNUM
+ TAD (-6
+ JMS I (PRWD /PRINT SIX WORDS
+ 0006 / F
+ 2205 /RE
+ 0500 /E
+ 0214 /BL
+ 1703 /OC
+ 1323 /KS
+ JMS I (PCRLF
+ JMS I (PCRLF /LEAVE A SPACE BETWEEN DIRECTORIES
+ ISZ INEOF /SIMULATE "END OF FILE" FOR INPUT ROUTINE
+ CLA CMA
+ DCA I (INCHCT /AS WELL AS "END OF BUFFER"
+ JMP I ENDFUJ
+\fIMHNDL, /V3
+SQTRA, 0
+ TAD SQTRA
+ DCA IMTRA /FAKE A CALL TO "IMTRA"
+ TAD RECCNT /SETTING UP THE ARGS TO DO THE SQUISHING FOR US
+ DCA I (INCTR
+ TAD IHNDLR
+ DCA IMHNDL
+ TAD INBLK
+ DCA IMREC
+ TAD OUTBLK
+ DCA I (OUCCNT
+ DCA INEOF
+ JMP IMRCLP
+
+IMTRA, 0
+ JMS I (IOPEN /INITIALIZE INPUT ROUTINE
+AGAIN, TAD INEOF /IOPEN ALWAYS SETS INEOF
+ SNA CLA /KEEP READING?
+ JMP IMRCLP /YES
+ /NO, OPEN NEXT FILE
+IMFILP, JMS I (INNEWF /SET UP PARAMS FOR NEXT FILE
+ JMP I IMTRA /NO NEXT FILE
+ TAD I (INHNDL
+ DCA IMHNDL /GET DEVICE HANDLER ENTRY
+ TAD I (INREC
+ DCA IMREC /AND STARTING BLOCK NUMBER
+IMRCLP, TAD I (INCTR
+ CLL
+ TAD (15
+ SNL /IF LINK IS ON, THERE ARE LESS THAN 16 BLOCKS LEFT
+ DCA I (INCTR
+ SZL
+ ISZ INEOF
+ CLL CML CMA RTR
+ RTR
+ RTR
+ TAD (3201 /FORM A FULL OR PARTIAL READ CONTROL WORD
+ DCA IMCTLW
+ JMS I (CTCTST /CHECK FOR ^C
+ CIF 0
+ JMS I IMHNDL
+IMCTLW, 0
+ OUBUF
+IMREC, 0
+ JMS I (SLASHG
+ IMERRX-.
+ TAD IMREC
+ TAD (15
+ DCA IMREC /UPDATE BLOCK NUMBER
+ CLA CLL CML RAR
+ TAD IMCTLW
+IMOUT, JMS I (OUTDMP /WRITE OUT WHAT WE JUST READ IN
+ JMP I (AOUERR /WRITE ERROR - BAD!
+ JMP AGAIN /V3
+\fIMERRX, ISZ INEOF /SIGNAL EOF OR WORSE
+ SPA CLA /WHICH ONE IS IT?
+ JMP IM7600
+ TAD (6377 /MARCH DOWN THROUGH CORE
+IMEFLP, DCA CHAR /LOOKING FOR THE FIRST NON-ZERO WORD
+ CDF 0
+ TAD I CHAR
+ SZA CLA
+ JMP IMNZRO
+ CLA CMA CLL
+ TAD CHAR
+ SZL /IF WE GO THROUGH THE BUFFER WITHOUT A NON-ZERO WORD
+ JMP IMEFLP
+IM7600, 7600
+ JMS I (PIPERR /SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
+ 4 /A ^Z AT LEAST)
+IMNZRO, CDF 10
+ TAD CHAR
+ CLL CML RAR
+ AND IM7600
+ TAD (200 /GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
+ JMP IMOUT /AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
+ PAGE
+\f/** PIP STARTS HERE (OR HERE+1 IF CHAINED TO) **
+
+PIPSA, JMP PIPCD /NORMAL ENTRY/RE-ENTRY - CALL CD
+ JMP NOPCD /ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
+ /PART OF ASCII PROCESSOR - CLEAN UP AT END OF LINE AND END OF FILE
+
+LFEED, TAD CHAR
+ DCA I XR /PUT THE LINE FEED IN THE LINE BUFFER
+EOL, DCA I XR /MARK THE END OF USEFUL INFO
+ JMS I (CTCTST
+ TAD (ABUF-1
+ DCA XR /RESET BUFFER POINTER
+EOLLP, TAD I XR /GET A CHARACTER FROM THE LINE BUFFER
+PIPSNA, SNA /ZERO MEANS NO MORE CHARS
+ JMP EOFTST
+ JMS I (OCHAR /OUTPUT THE CHARACTER
+ JMP I (AOUERR
+ JMP EOLLP
+EOFTST, TAD AEOFFG
+ SNA CLA /END OF INPUT ENCOUNTERED?
+ JMP I (ASCIGO /NO - GET NEXT LINE
+ACLOSE, JMS I (OCLOSE /YES - CLOSE THE OUTPUT FILE
+ JMP I (AOUERR /ERROR ON CLOSE
+PIP, TAD I (MPARAM-1 /V3
+ SMA CLA /ALTMODE TERMINATE LAST COMMAND STRING?
+ JMP PIPCD /NO
+ CDF CIF 0 /YES
+ JMP I (7605 /EXIT TO OS/8 WITHOUT SAVING CORE
+PIPCD, JMS I (200 /OF COURSE THE MONITOR IS IN CORE!
+ 5 /COMMAND DECODE
+ 0 /NO ASSUMED EXTENSIONS ON INPUT
+L20, /V3
+NOPCD, JMS I (ONCE /REPLACED BY '20' BY ONCE-ONLY CODE
+ JMS I (SRSTOR /CLEAR /S OR /Y;READ MONITOR
+ DCA SQFLAG /CLEAR /S INDICATOR
+ TAD PIPSNA
+ DCA I (INCTZF /RESET INPUT SWITCH TO DETECT "^Z"'S
+ TAD I (MPARAM+1
+ AND (40 /"S" SWITCH
+ SZA CLA
+ JMP I (SQUISH /IT WAS ON - COMPRESS THE INDICATED DEVICES
+ TAD I (MPARAM+2
+ RTL
+ SZL CLA /"Z" SWITCH IN THE LINK
+ JMS I (DZERO /ZERO DIRECTORY BEFORE PROCEEDING
+ TAD I (MPARAM
+ AND (400 /"D" SWITCH
+ SZA CLA
+ JMS I (DELETE /DELETE OUTPUT FILE
+ TAD I (MPARAM+2 /IS /Y ON?
+ SPA CLA
+ JMP I (SYSCOP /YEP..TRANSFER SYSTEM HEAD
+ TAD I (MPARAM
+ AND (301 /"E","F" AND "L" SWITCHES
+ SZA /ANY ONE OF THEM ON?
+ JMP I (DIR /YES - LIST A DIRECTORY
+ TAD I (MPARAM
+ RTL
+ AND (40 /"I" SWITCH ROTATED TWO LEFT
+ SZA CLA
+ JMP I (IMAGE /IMAGE MODE TRANSFER
+ TAD I (7617 /MUST PRESERVE THE LINK
+ SNA CLA /V3 IMAGE MODE ALLOWS NO INPUT FILE
+ JMP PIP /TERMINATE HERE IF NO INPUT SIDE
+ SZL CLA /"B" SWITCH IN LINK
+ JMP I (BINARY /BINARY MODE TRANSFER
+
+ /DEFAULT MODE OF TRANSFER IS ASCII
+
+ASCII, TAD I (MPARAM+1
+ AND L20
+ DCA COPTSW
+ TAD COPTSW
+ JMS I (ASCI2 /TEST FOR OUTPUT DEVICE
+ JMS I (OUTOPN
+ JMS I (IOPEN /OPEN THE INPUT FILES
+ DCA AEOFFG /ZERO THE END-OF-FILE FLAG
+ JMS I (LEADER
+ JMP I (ASCIGO
+
+ /ENTRY ON END OF INPUT
+ASCEOF, SPA CLA /WAS IT END OF INPUT OR AN INPUT ERROR?
+PER4, JMS I (PIPERR
+ 4
+ ISZ AEOFFG /SET END-OF-INPUT FLAG
+ JMP EOL /PROCESS LAST LINE (IF ANY)
+AEOFFG, 0
+\f /SUBROUTINE TO OUTPUT RUBOUTS AFTER FORM CONTROL CHARACTERS
+RUBOUT, 0 /UNLESS OUTPUT IS TO A DIRECTORY DEVICE
+ DCA TEMP /STORE COUNT
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ JMP I RUBOUT /DIRECTORY DEVICE - DON'T BOTHER
+RBTLP, TAD CHAR
+ TAD (-214
+ SNA CLA /IS THE FORM CONTROL CHAR A FORM-FEED?
+ IAC /YES - OUTPUT BLANK TAPE INSTEAD
+ TAD (377
+ DCA I XR /PUT IN BUFFER
+ ISZ TEMP
+ JMP RBTLP /LOOP FOR THE REQUISITE COUNT
+ JMP I RUBOUT
+COPTSW, 0
+
+DEND, SPA CLA
+ JMP PER4
+ JMP ACLOSE
+ PAGE
+\f *3200
+ /ASCII PROCESSOR CONTINUED
+
+ASCIGO, TAD (ABUF-2
+ DCA XR
+ DCA I XR /PROTECT AGAINST NULL LINE WITH "T" OPTION
+ DCA COLCT /ZERO COLUMN COUNTER FOR TAB CONVERSION
+ACHLP, JMS I (ICHAR /GET A CHARACTER
+ JMP I (ASCEOF /END OF INPUT OR WORSE
+ AND (177 /MASK OUT PARITY BIT
+ SZA /IGNORE BLANK TAPE AND LEADER/TRAILER
+ TAD (-177
+ SNA
+ JMP ACHLP /DITTO RUBOUTS
+ TAD (177-32 /V3C
+ SNA
+ JMP I (ASCPTCH /7-BIT ^Z CHECK
+ TAD (232 /FORCE COLUMN 8 ON
+ DCA CHAR
+ TAD CHAR
+ TAD (-216
+ CLL
+ TAD ASCI5
+ SNL /IS THE CHARACTER A FORM CONTROL CHARACTER?
+ JMP CINSRT /NO
+ TAD ASCJMP /YES - GO TO APPROPRIATE ROUTINE
+ DCA .+1
+ HLT
+ASCJMP, JMP I .+1
+ TAB
+ LFEED
+ VTAB
+ FFEED
+ CARRET
+CINSRT, 7600 /GRP 2 CLA
+ TAD CHAR
+ADCAXR, DCA I XR /STORE THE CHARACTER IN THE LINE BUFFER
+ ISZ COLCT /ALWAYS BUMP THE COLUMN POINTER
+TESTXR, TAD XR
+ TAD (-ABUF-226
+ SPA CLA /HAS THE BUFFER OVERFLOWED?
+ JMP ACHLP /NO - GET NEXT CHARACTER
+ JMS I (PIPERR
+ 1
+\fTAB, TAD I (COPTSW
+ SNA CLA /DO WE WANT TO CONVERT?
+ JMP TABRBT /NO
+TABLP, TAD (240
+ DCA I XR /OUTPUT A SPACE
+ ISZ COLCT
+ TAD COLCT
+ AND (7
+ SZA CLA /IS THE COLUMN COUNTER A MULTIPLE OF 8?
+ JMP TABLP /NOT YET
+ JMP TESTXR /YES - CHECK BUFFER OVERFLOW
+TABRBT, TAD CHAR
+ DCA I XR
+ CLA CMA
+ JMS I (RUBOUT /TWO RUBOUTS FOLLOW A TAB
+ JMP TESTXR /CHECK FOR BUFFER OVERFLOW
+VTAB, TAD I (COPTSW
+ SZA CLA /SHOULD WE CONVERT?
+ JMP VTLF /YES
+ TAD CHAR
+ DCA I XR
+ TAD (-4
+ JMS I (RUBOUT /FOUR RUBOUTS AFTER A VERTICAL TAB
+ JMP I (EOL
+FFLF, TAD (-4 /NINE LINE FEED SIMULATE A FORM FEED
+VTLF, TAD (-5 /FIVE LINE FEEDS SIMULATE A VERTICAL TAB
+ DCA TEMP
+ TAD (212
+ DCA I XR
+ ISZ TEMP
+ JMP .-3
+ JMP I (EOL /FORM FEED AND VERTICAL TAB ARE LINE ENDERS
+\fFFEED, TAD I (COPTSW
+ SZA CLA /SHOULD WE CONVERT?
+ JMP FFLF /YES
+ TAD CHAR
+ DCA I XR
+ TAD (-11 /NINE RUBOUTS AFTER A FORM FEED
+ JMS I (RUBOUT
+ JMP I (EOL
+CARRET, TAD I (MPARAM
+ RTL
+ SMA CLA /"C" SWITCH MEANS DELETE TRAILING BLANKS FROM CARDS
+ JMP NOTOPT /IT WASN'T ON
+TOPT, TAD XR
+ DCA TEMP
+ TAD I TEMP
+ TAD (-240
+ SZA CLA /WAS THE LAST CHAR ON THE LINE A SPACE?
+ JMP NOTOPT /NO
+ CLA CMA
+ TAD XR /YES - BACK UP THE LINE POINTER
+ DCA XR
+ JMP TOPT
+NOTOPT, TAD CHAR
+ DCA I XR /STORE THE CARRIAGE RETURN IN THE BUFFER
+ JMP TESTXR /CARRIAGE RETURN IS NOT A LINE TERMINATOR
+COLCT, 0
+
+OUTOPN, 0
+ JMS I (OOPEN
+ SMA CLA
+ JMP I OUTOPN
+ JMS I (PIPERR
+ASCI5, 5
+ PAGE
+\f /SUBROUTINES CALLED BY THE REST OF PIP
+
+K770, 770 /** DON'T MOVE THIS CONSTANT
+DELETE, 0
+ TAD P7600
+ DCA DPFILE
+ CLA CLL CMA RTL
+ DCA CHAR /MAXIMUM OF THREE OUTPUT FILES
+DELOOP, TAD (7201
+ DCA DLHNDL
+ TAD I DPFILE
+ SNA /DOES THIS FILE EXIST?
+ JMP I DELETE /THAT'S ALL
+ JMS I C200
+ 1 /ASSIGN HANDLER FOR THE DELETION
+DLHNDL, 0
+ HLT
+ TAD I DPFILE /RELOAD DEVICE NUMBER FOR DELETE
+ ISZ DPFILE /BUMP DPFILE TO POINT TO THE FILE NAME
+ JMS I C200 /DEVICE NUMBER IN AC
+DP4, 4 /CLOSE - USED AS DELETE IN THIS CASE
+DPFILE, 0 /POINTER TO FILE NAME
+ 0 /ZERO LENGTH FOR DELETE
+ JMS I (PIPERR /FILE WASN'T THERE TO BE DELETED
+ 3
+ TAD DPFILE
+ TAD DP4
+ DCA DPFILE
+ ISZ CHAR
+ JMP DELOOP /DELETE AS MANY FILES AS HE LISTED(UP TO 3)
+ JMP I DELETE
+\fDZERO, 0 /SUBROUTINE TO ZERO THE DIRECTORY OF THE
+ /FIRST OUTPUT DEVICE
+ JMS I (OTYPE
+ CLL RTL
+ SZL /IS DEVICE READ-ONLY?
+ JMP OZERR /YES - ERROR
+ RTR
+ AND K770 /MASK OUT DEVICE TYPE
+ CLL RTR
+ RAR
+ TAD (DEVLEN /USE IT TO INDEX A TABLE OF DEVICE LENGTHS
+ DCA PIPERR
+ TAD I PIPERR
+ SNA
+ JMP I DZERO /DEVICE LENGTH ZERO MEANS NON-DIRECTORY DEVICE
+ DCA PIPERR /STORE LENGTH
+ TAD (OUDEVH+1
+ DCA OZHNDL
+ TAD I P7600
+ JMS I C200
+ 1 /ASSIGN DEVICE, FETCH HANDLER
+OZHNDL, 0
+ HLT
+ TAD I (MPARAM+2 /IF /Y ON, DO SYSTEM ZERO
+ SPA CLA
+ JMP ZRO70
+ TAD OZHNDL /BUT IF NOT, CHECK FOR SYSTEM ZERO
+ TAD (-7607
+ SZA CLA
+ JMP ZRO70+1 /NOT SYSTEM FILES BEGIN AT 7
+ JMS I (CONFRM /ASK IF HE'S SURE
+ SYSZRO /V3
+ZRO70, TAD (61
+ TAD (7
+ DCA I (DFORG
+ DCA I (SQFLAG /AND CLEAR OUT SQUISHES
+ TAD PIPERR
+ TAD I (DFORG
+ DCA I (DLENGT
+ JMS I (GETEQ
+ DCA I (DWASTE /DEFINE # OF WASTE WORDS
+ DCA I (MPARAM+3 /KILL = OPTION FOR FUTURE /I TRANSFERS
+ CIF 0
+ JMS I OZHNDL
+ 5410 /V3 OUTPUT 6 BLOCKS FROM FIELD 1
+ DIRECT
+ 1 /ALL DIRECTORIES ARE IN RECORD 1
+OZERR, JMS I (PIPERR /ERROR WHILE ZEROING DIRECTORY
+ 2
+ DCA OLDDIR /ZERO DIRECTORY POINTER TO FORCE A NEW READ
+ JMP I DZERO
+\fPIPERR, 0
+P7600, 7600 /V3 CLA
+ JMS I (SRSTOR /RESET 07600!
+ CDF 10 /JUST IN CASE
+ TAD I PIPERR /GET ARG
+ TAD (ERRTBL
+ DCA TEMP
+ TAD I TEMP
+ JMS I (ERPRNT
+ JMP I (PIP /RESTART PIP
+
+LEADER, 0
+ JMS I (OTYPE
+C200, AND K770 /GET THE TYPE OF THE OUTPUT DEVICE
+ TAD (-PTP /IS IT A PAPER TAPE PUNCH?
+ SZA CLA
+ JMP I LEADER /NO
+ TAD P7600
+ DCA TEMP
+ JMS I (OCHAR /PUT OUT SOME LEADER
+ JMP I (AOUERR
+ ISZ TEMP
+ JMP .-3
+ JMP I LEADER
+ PAGE
+\f /TABLE OF DEVICE LENGTHS FOR /Z OPTION
+
+DEVLEN, 0;0;0;0;0;1520 /RK08 (1520= - DECIMAL 3248)
+ 6001;4001;2001;0001 /RF08 IN VARIOUS SIZES
+ /(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
+ 7601;7401;7201;7001 /DF32 IN VARIOUS SIZES
+ /(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
+ 6437;6437 /DECTAPE AND LINCTAPE
+ ZBLOCK 1 /20 MAGTAPE
+ 6437 /21 TD8E
+ 0
+ 1520 / 1/2 OF AN RK8E IS 23
+ 0 /24
+ 7022 /25 RX01 FLOPPY DISK
+ ZBLOCK 52 /ALL THE REST
+
+
+FIXLEN, 0 /ROUTINE TO ESTIMATE OUTPUT FILE LENGTH
+ TAD I (7600
+ AND (7760
+ SZA CLA /DID THE USER PROVIDE AN ESTIMATE?
+ JMP I FIXLEN /YES - USE IT
+ DCA CHAR
+ TAD (7617
+ DCA TEMP
+FIXLP, TAD I TEMP /GET NEXT INPUT FILE
+ SNA
+ JMP FIXOVR /NO MORE INPUT FILES
+ AND (7760
+ CIA CLL /GET LENGTH AS A POSITIVE NUMBER
+ /(LENGTH OF ZERO TURNS LINK ON)
+ TAD CHAR
+ DCA CHAR /UPDATE CUMULATIVE LENGTH
+ SZL CLA /DID CUMULATIVE LENGTH OVERFLOW 256 BLOCKS?
+ JMP I FIXLEN /YES - CAN'T ESTIMATE IT
+ ISZ TEMP
+ ISZ TEMP
+ JMP FIXLP
+FIXOVR, TAD CHAR
+ TAD I (7600
+ DCA I (7600 /STICK LENGTH IN OUTPUT FILE DESCRIPTOR
+ JMP I FIXLEN
+\fNOYES, TEXT /NO/
+ TEXT /YES/
+
+CONFRM, 0
+ TAD I (MPARAM+1
+ RTL /'O' BIT TO SIGN
+ SPA CLA
+ JMP GOTCON /V3 'O' MEANS OK, ASSUME 'YES'
+ TAD I CONFRM /V3
+ JMS I (ERPRNT
+ KSF
+ JMP .-1
+ JMS I (CTCTST
+ KRB /LOOK AT HIS REPLY
+ AND (177 /IGNORE PARITY TTY
+ TAD (-"Y!7600 /V3
+ SNA CLA /IS IT YES?
+ ISZ SQFLAG /SET SQFLAG TO 1 (NEEDED 1 LATER)
+ TAD SQFLAG /USE SQFLAG AS INDEX FOR MESSAGE
+ CLL RAL
+ TAD (NOYES
+ JMS I (ERPRNT
+ TAD SQFLAG
+ SNA CLA
+ JMP I (PIP
+CNFMXT, ISZ CONFRM
+ JMP I CONFRM
+
+GOTCON, ISZ SQFLAG /SET SQFLAG
+ JMP CNFMXT /AND TAKE SKIP EXIT
+ PAGE
+\f /DIRECTORY PRINTER FOR PIP
+ MDATE=7666
+
+DIRPRE, JMS I (OUTOPN /OPEN THE OUTPUT FILE
+ TAD (ABUF
+ DCA CHAR /ABUF WILL BE A TEMPORARY ARRAY OF STARTING FILES
+ TAD (7617
+ DCA TEMP
+ TAD I (7617
+ SNA
+ JMS I (DSKNUM
+ DCA I (7617 /DEFAULT DIRECTORY IS DSK:
+DFUJLP, TAD I TEMP
+ SNA /ARE WE THROUGH WITH THE INPUT DEVICES?
+ JMP GETDIR /YES
+ AND (17
+ DCA I TEMP /ONLY THE DEVICE NUMBER IS IMPORTANT
+ TAD I TEMP
+ TAD (DCB-1
+ DCA PRWD
+ CLA CLL CML RTL
+ TAD TEMP
+ DCA INFPTR /THIS SERVES NO FUNCTION EXCEPT IMPROVING ERROR MESSAGES
+ TAD I PRWD
+ SMA CLA /IS THE DEVICE A DIRECTORY DEVICE?
+ JMS I (PIPERR /NO
+ 6
+ ISZ TEMP
+ TAD I TEMP
+ DCA I CHAR /SAVE THE STARTING BLOCK NUMBER
+ CLA IAC
+ DCA I TEMP /READ FROM THE DIRECTORY
+ ISZ TEMP
+ ISZ CHAR
+ JMP DFUJLP
+GETDIR, TAD (ABUF
+ DCA CHAR
+ JMS PCRLF
+ TAD I (MDATE
+ JMS I (PDATE
+ JMS PCRLF
+ JMS I (IOPEN /RESET POINTERS - WERE GONNA FAKE OUT THOSE "GENERAL"
+ /ROUTINES
+ JMP I (NXTDIR
+\fPRWD, 0 /ROUTINE TO PRINT SIXBIT TEXT
+ SNA /IS COUNT ZERO?
+ CMA /MAKE IT ONE
+ DCA PRCT /STORE COUNT
+PRWDLP, TAD I PRWD
+PR212, RTR
+ RTR
+ RTR
+ JMS PR6BIT
+ TAD I PRWD
+ JMS PR6BIT
+ ISZ PRWD
+ ISZ PRCT
+ JMP PRWDLP
+ JMP I PRWD
+PRCT, 0
+PR6BIT, 0
+ AND (77
+ SZA
+ TAD (240 /V3
+ AND (77 /V3
+ TAD (240 /V3
+ JMS I (OCHAR
+ JMP I (AOUERR
+ JMP I PR6BIT
+\fPRNUM, 0
+ DCA PRWD
+ DCA TEMP
+ TAD (PWRTEN
+ DCA PCRLF
+PRNMLP, DCA PR6BIT
+ TAD I PCRLF
+ SNA
+ JMP PRLAST /V3
+ CLL
+ TAD PRWD
+ SNL
+ JMP .+4
+ DCA PRWD
+ ISZ PR6BIT
+ JMP PRNMLP+1
+ CLA
+ TAD PR6BIT
+ TAD TEMP
+ SNA
+PBLJMP, JMP PRBLNK /INCREMENTED BY PDATE TO KILL LEADING BLANKS
+ TAD (260
+ JMS PR6BIT
+ CLA CLL CML RAR
+ DCA TEMP
+ ISZ PCRLF
+ JMP PRNMLP
+PRBLNK, JMS PR6BIT
+ JMP .-3
+PRLAST, TAD PRWD /V3
+ TAD (260 /V3
+ JMS PR6BIT /V3
+ JMP I PRNUM /V3
+\fPCRLF, 0
+ TAD (215
+ JMS I (OCHAR
+ JMP I (AOUERR
+ TAD PR212
+ JMS I (OCHAR
+ JMP I (AOUERR
+ JMP I PCRLF
+
+PWRTEN, -1750;-144;-12;0 /V3
+ PAGE
+\f /MAIN DIRECTORY PRINTING LOOP
+
+NXTDIR, JMS I (ICHAR /FAKE, FAKE
+ JMP I (DEND
+ CLA /WE DON'T WANT THE CHARACTER
+ DCA ECOUNT
+ TAD (INBUF-1 /WE WANT THE BUFFER!
+NEWSEG, DCA XR
+ CDF 0
+ TAD I XR
+ DCA DCOUNT /NUMBER OF ENTRIES
+ TAD DCOUNT
+ CLL
+ TAD (100
+ SNL CLA
+ JMS I (PIPERR
+ 11
+ TAD I XR
+ DCA BLOKNO /FIRST BLOCK OF FILE STORAGE
+ TAD I XR
+ DCA DLINK /LINK TO NEXT SEGMENT
+ ISZ XR /BUMP XR PAST FLAG WORD
+ TAD I XR
+ DCA WASTE
+NAMELP, CDF 0
+ TAD I XR
+ SNA /WHAT TYPE OF ENTRY IS IT?
+ JMP DEMPTY /A FREE FILE
+ DCA NAME1 /A PERMENANT OR TENTATIVE FILE
+ TAD I XR
+ DCA NAME2
+ TAD I XR
+ DCA NAME3
+ TAD I XR
+ DCA NAME4
+ TAD I XR
+ DCA DDATE
+ TAD WASTE /COMPENSATE FOR THE DATE INCREMENT
+ CMA /AND THE WASTE WORDS
+ TAD XR
+ DCA XR
+ TAD I XR
+ SNA /IS IT A TENTATIVE FILE?
+ JMP ADDLEN+1 /YES - TENTATIVE FILES ARE ALWAYS IGNORED
+ CIA
+ DCA FLENGT /NO - STORE THE LENGTH
+ CDF 10
+ TAD I CHAR /GET THE STARTING FILE FOR THIS LISTING
+ CIA CLL
+ TAD BLOKNO
+ SNL CLA /ARE WE THERE YET?
+ JMP ADDLEN /NO - KEEP GOING
+ CLA CLL CMA RTL
+ JMS I (PRWD /PRINT THREE WORDS
+NAME1, 0
+NAME2, 0
+NAME3, 0
+ TAD NAME4
+ SNA CLA /IS THERE AN EXTENSION?
+ TAD (-16 /NO - PRINT A BLANK
+ TAD (56 /YES - PRINT A PERIOD
+ JMS I (PR6BIT
+ JMS I (PRWD
+NAME4, 0 /ZERO PRINTS AS TWO MORE BLANKS
+PRLNGT, TAD DTYPE
+ AND (100
+ SZA CLA /WAS THE LISTING SWITCH /F?
+ JMP PRTCRL /YES - DON'T PRINT LENGTH
+ TAD FLENGT
+ JMS I (PRNUM
+ TAD WASTE
+ SZA CLA
+ TAD DDATE
+ JMS I (PDATE /PRINT THE CREATION DATE OF THE FILE
+PRTCRL, JMS I (PCRLF
+ADDLEN, TAD FLENGT
+ TAD BLOKNO
+ DCA BLOKNO /UPDATE BLOCK NUMBER
+ ISZ DCOUNT
+ JMP NAMELP /LOOP UNTIL ALL FILES ARE PROCESSED
+ TAD DLINK
+ SNA CLA /MULTI-SEGMENT DIRECTORY?
+ JMP ENDDIR /NO - FINISH UP
+ TAD XR
+ AND (7400
+ TAD (377 /BUMP XR TO NEXT BLOCK
+ JMP NEWSEG /PROCESS NEXT LINK
+\fDEMPTY, TAD I XR
+ CIA
+ DCA FLENGT /STORE LENGTH OF FREE ENTRY
+ CDF 10
+ TAD FLENGT
+ TAD ECOUNT
+ DCA ECOUNT /BUMP COUNT OF FREE BLOCKS
+ TAD DTYPE
+ AND (200
+ SNA CLA /IS THE /E SWITCH ON?
+ JMP ADDLEN /NO - DON'T LIST FREE FILES
+ TAD (-4
+ JMS I (PRWD
+ TEXT /<EMPTY>/
+ JMS I (PR6BIT
+ TAD FLENGT
+ JMS I (PRNUM
+ JMP PRTCRL
+ENDDIR, ISZ CHAR /BUMP TEMP ARRAY TO NEXT ENTRY
+ TAD ECOUNT
+ JMS I (ENDFUJ
+ JMP NXTDIR
+ PAGE
+\f/BINARY MODE PROCESSOR FOR PIP
+
+BIN360, 360
+BINARY, JMS I (FIXLEN
+ JMS I (OUTOPN
+ JMS I (IOPEN
+ JMS I (LEADER /PUT OUT BLANK TAPE IF HS PUNCH OUTPUT
+ JMS LTCODE
+NEWTAP, JMS I (ICHAR
+ JMP BEOF /END OF FILE ON INPUT
+ SNA
+ JMP NEWTAP /BLANK TAPE - KEEP GOING
+ TAD BN7600
+ SZA CLA
+ JMP NEWTAP
+ JMS I (ICHAR
+ JMP BEOF
+ TAD BN7600
+ SNA
+ JMP .-4
+ TAD BIN200
+ DCA CHAR
+ TAD CHAR
+BIN200, AND BIN360
+ TAD (-240 /CHECK TYPE OF TAPE
+ SNA /IS IT RELOCATABLE?
+ JMP RELBIN /YES
+ TAD (-40 /IF A FIELD SETTING, IT'S ABSOLUTE
+ AND (7700
+ SNA
+ JMP ABSLUT
+ TAD BIN200 /CHECK FOR ORIGIN ALSO
+ SZA CLA
+ JMP NEWTAP /NOTHING..NEXT FRAME
+ABSLUT, CLA CMA
+ JMS LTCODE
+ABSBIN, JMS RCOPY1 /COPY THIS FRAME AND READ NEXT
+ TAD BN7600
+BNM140, SZA CLA /IS IT TRAILER?
+ JMP ABSBIN /NO - KEEP GOING
+BEOT, CLA CMA /END OF TAPE
+ JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
+ JMP NEWTAP /GET NEXT TAPE
+\fLTCODE, 0 /SUBROUTINE TO PUNCH 200 CODE
+ SMA /SHORT LEADER/TRAILER?
+ JMS I (OTYPE
+ SPA CLA /DIRECTORY DEVICE?
+ TAD (70 /YES
+ TAD (-100
+ DCA TEMP
+LTLOOP, TAD BIN200
+ JMS I (OCHAR /OUTPUT 64 OR 8 FRAMES OF L/T CODE
+ JMP I (AOUERR
+ ISZ TEMP
+ JMP LTLOOP
+ JMP I LTCODE
+
+RELBIN, TAD (SKP
+ DCA I (INCTZF /DISABLE CONTROL-Z CHECKING ON INPUT
+ CLA CMA
+ JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
+RELLP, TAD CHAR
+ RTR
+ RTR
+ AND (17
+ TAD (RELTBL
+ DCA TEMP
+ TAD I TEMP /GET DATA WORD FOR THIS FRAME
+ SMA SZA /POSITIVE MEANS SPECIAL OR ERROR
+ JMP RELERR
+RELSNA, SNA
+ JMP RELEND /ZERO MEANS CHECKSUM FRAME
+ DCA TEMP /NEGATIVE MEANS COUNT OF NUMBER OF SLAVE FRAMES
+ JMS RCOPY1
+BN7600, 7600
+ ISZ TEMP
+ JMP .-3 /COPY THIS FRAME AND ALL SLAVE FRAMES
+ JMP RELLP /GET NEXT CONTROL FRAME
+RELEND, JMS RCOPY1 /COPY THE FIRST FRAME OF THE CHECKSUM
+ JMS I (OCHAR
+ JMP I (AOUERR /OUTPUT THE SECOND FRAME
+ JMP BEOT /END TAPE - START NEXT ONE
+BEOF, JMS LTCODE
+ JMS I (OCLOSE
+ JMP I (AOUERR
+ JMP I (PIP
+\fRCOPY1, 0 /ROUTINE TO ADVANCE "CHAR" TO NEXT INPUT CHARACTER
+ TAD CHAR
+ JMS I (OCHAR
+ JMP I (AOUERR
+ JMS I (ICHAR
+ JMP INEFER
+ DCA CHAR
+ TAD CHAR
+ JMP I RCOPY1
+INEFER, SMA CLA /DETECT FATALITIES
+ JMS I (PIPERR
+ 7
+ JMS I (PIPERR /A REAL BAD READ
+ 4
+
+RELERR, CLL RAR
+ SZA CLA /CODE OF 1 MEANS SPECIAL
+ JMS I (PIPERR /ILLEGAL RELOCATABLE INPUT
+ 10
+ JMS RCOPY1
+ CLL CML CMA RTL /MULTIPLY NAME COUNT BY -6 (APPROXIMATELY)
+ TAD CHAR
+ CLL CML RAL /(ACTUALLY THIS PRODUCES -6X-1 WHICH IS WHAT WE WANT)
+ JMP RELSNA
+ PAGE
+\fERPRNT, 0 /ERROR MESSAGE PRINTOUT ROUTINE
+ DCA TEMP
+ERLP, TAD I TEMP
+ RTR
+ RTR
+ RTR
+ JMS ERPCH /PRINT HIGH-ORDER CHARACTER
+ TAD I TEMP
+ JMS ERPCH /PRINT LOW-ORDER CHARACTER
+ ISZ TEMP
+ JMP ERLP
+
+ERPCH, 0
+ AND (77
+ SNA
+ JMP ERCRLF /0 CHARACTER TERMINATES
+ JMS CHPRNT
+ JMP I ERPCH
+FILENR, TAD ("#
+ JMS I (TTYOUT
+ TAD INFPTR /GET PTR TO CURRENT INPUT FILE
+ TAD (321 /MAGIC NUMBER
+ CLL RAR
+ JMP FILENR-2
+
+CHPRNT, 0
+ TAD (-37 /IS IT A _?
+ SNA
+ JMP FILENR /YES..PRINT FILE NUMBER
+ IAC
+ SNA /MAYBE ^?
+ JMP I (SQFILE /YEP..PRINT FILE NAME
+ SPA
+ TAD (100
+ TAD (236
+ JMS I (TTYOUT
+ JMP I CHPRNT
+
+ERCRLF, TAD (215
+ JMS I (TTYOUT
+ TAD (212
+ JMS I (TTYOUT
+ JMP I ERPRNT
+\fPDATE, 0 /PRINTS THE DATE
+ SNA
+ JMP I PDATE /NO DATE TO PRINT
+ DCA ERPRNT
+ ISZ I (PBLJMP
+ JMS I (PR6BIT
+ TAD ERPRNT
+ CLL RTL
+ RTL
+ RAL
+ AND (17
+ JMS I (PRNUM
+ TAD (57
+ JMS I (PR6BIT
+ TAD ERPRNT
+ RTR
+ RAR
+ AND (37
+ JMS I (PRNUM
+ TAD (57
+ JMS I (PR6BIT
+ TAD ERPRNT
+ AND (7
+ TAD (106
+ JMS I (PRNUM
+ CLA CMA
+ TAD I (PBLJMP
+ DCA I (PBLJMP /RESET PRNUM TO PRINT LEADING SPACES
+ JMP I PDATE
+
+DSKNUM, 0
+ DCA DSKNAM+1
+ JMS I (200
+ 12
+DSKNAM, 5723
+ 0
+ 0
+ HLT
+ TAD DSKNAM+1
+ JMP I DSKNUM
+\fRELTBL, -2;-2;2;-10;-2;-2;-2;2;0;2;-2;2;2;2;2;1
+
+ERRTBL, ERR0
+ ERR1
+ ERR2
+ ERR3
+ ERR4
+ ERR5
+ ERR6
+ ERR7
+ ERR8
+ ERR9
+ ERR10
+ ERR11
+ IFNZRO OS78 <DIRMSG>
+
+ PAGE
+\f/ERROR MESSAGE TEXT GOES HERE
+
+
+ERR0, TEXT /NO ROOM FOR OUTPUT FILE/
+ERR1, TEXT /LINE TOO LONG IN FILE_/
+ERR3, TEXT /ERROR DELETING FILE/
+ERR4, TEXT /INPUT ERROR, FILE_/
+ERR5, TEXT /CAN'T OPEN OUTPUT FILE/
+ERR6, TEXT /DEVICE_ NOT A DIRECTORY DEVICE/
+ERR7, TEXT /PREMATURE END OF FILE, FILE_/
+ERR8, TEXT /ILLEGAL BINARY INPUT, FILE_/
+ERR9, TEXT /BAD DIRECTORY ON DEVICE_/
+ERR10, TEXT /DIRECTORY ERROR/
+
+
+TTYOUT, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTYOUT
+ PAGE
+\f/SQUISH PROCESSOR
+
+SQUISH, JMS I (CONFRM
+ SURE /V3
+SQUISX, DCA I (OUELEN /INITIALIZE PARAMS TO FAKE OUT "IMTRA"
+ DCA I (OUBLK
+ DCA I (7621 /ZERO SECOND FILE FOR "INNEWF"
+ DCA I (CTCFLG
+ JMS I (IOPEN
+ JMS I (INNEWF
+ JMP I (PIP /NO INPUT
+ TAD (OUDEVH+1
+ DCA SOHND
+ TAD I SQ7600
+ SNA
+ JMP I (PIP /NO OUTPUTEE, NO SQUISHEE
+ JMS I (200
+ 1
+SOHND, 0
+ HLT
+ JMS INTEST
+ JMS I (OTYPE
+ CLL RTR
+ RAR
+ AND (77
+ TAD (DEVLEN
+ DCA TEMP
+ TAD I TEMP /GET ENTRY FROM DEVICE LENGTH TABLE
+ DCA OUDLEN /SAVE OUTPUT DEVICE LENGTH
+ JMS GETEQ
+ DCA OUWAST
+ TAD SOHND
+ DCA OHNDLR
+ TAD OHNDLR
+ DCA I (OUHNDL
+ TAD I (INHNDL
+ DCA IHNDLR
+ JMS SETCTC
+ JMS I (CTCFLG
+ CIF 0
+ JMS I IHNDLR
+ 1400
+ 0
+ 1
+ JMP I (SQIDER+1
+ CIF 0
+ JMS I (7607
+ 5400
+ 0
+ MTEMP /MOVE THE INPUT DIRECTORY TO SYS:
+ JMP I (SQIDER+1
+ CLA IAC
+ DCA I (SQBUF2+2
+ DCA I (CTCFLG
+ TAD SOHND /SETUP DIRECTORY START
+ JMS I (SQDTST
+ JMS I (SETSAM /IF IHNDLR=OHNDLR, SAME=1
+ CLA CMA
+ DCA I (SQBUF2
+ DCA I (OUTSEG
+ JMP I (NEWOUT
+
+GETEQ, 0 /V3
+ TAD I (MPARAM+3
+ SNA
+ IAC
+ AND (77 /CONVERT 0 TO 1 AND 100 TO 0
+ CIA
+ JMP I GETEQ
+
+INTEST, 0 /TEST IF INPUT IS DIRECTORY
+ TAD I (7617
+ AND (17
+ TAD (DCB-1
+ DCA TEMP
+ TAD I TEMP
+ SMA CLA
+ JMS I (PIPERR
+ 6
+ JMP I INTEST
+
+SETCTC, 0 /MODIFY 07600 TO RETURN TO SQCTLC
+ TAD CDIF10
+ CDF 0
+ DCA I SQ7600
+ TAD (5602 /JMP I .+1
+ DCA I (7601
+ TAD (SQCTLC
+ DCA I (7602
+CDIF10, CIF CDF 10
+ JMP I SETCTC
+\fOUK, 0 /V3 ON IMAGE MODE TRANSFER
+ /CLOSE OUT FILE WITH = OPTION
+ /IF NOT TOO SMALL
+ TAD I (OUCCNT
+ CLL CIA
+ TAD I (MPARAM+3
+ SNL /IS = OPTION LARGER?
+SQ7600, 7600 /RETURN OUCCNT IF IT'S LARGER
+ TAD I (OUCCNT /RETURN LOW ORDER = OPTION IF IT'S LARGER
+ JMP I OUK
+ PAGE
+\fNEWIN, TAD (MTEMP-1
+ DCA INSEG
+ JMS I (CTCFLG
+ CIF 0
+ JMS I (7607
+ 0210
+S7200, SQBUF2
+INSEG, 0
+ JMP I (SQIDER
+ DCA I (CTCFLG
+ TAD I (SQBUF2+1
+ DCA INBLK
+ TAD (SQBUF2+4
+ DCA INXR
+SGETIN, TAD I INXR
+ SNA
+ JMP SEMPTY
+ DCA I OUTXR
+ TAD OUTXR
+ DCA OUSAVE
+ JMS I (CYWAST /COPY WASTE WORDS
+ TAD I INXR
+ DCA RECCNT
+ TAD RECCNT
+ SNA
+ JMP SNULL
+ CMA CLL /V3
+ TAD OUTBLK
+ TAD OUDLEN
+ SZL CLA
+ JMP SNULER
+ TAD RECCNT
+ DCA I OUTXR
+ CLA CMA
+ TAD I (SQBUF1
+ DCA I (SQBUF1
+ TAD INBLK
+ CIA
+ TAD OUTBLK
+ SNA CLA
+ TAD SAME
+ SNA CLA
+MOVFIL, JMS I (SQTRA /MOVE THE FILE DOWN
+ TAD RECCNT
+ CIA
+ TAD OUTBLK
+ DCA OUTBLK
+ TAD RECCNT
+DMTX, CIA
+ TAD INBLK
+ DCA INBLK
+ TAD OUTXR
+ CIA
+ TAD OUWAST
+ TAD OUWAST
+ TAD (SQBUF1+365
+ SMA CLA /DO WE HAVE ROOM FOR TWO MORE ENTRIES?
+ JMP NEXTIN
+
+ /DIRECTORY SEGMENT OVERFLOW ON OUTPUT...
+
+ ISZ I (OUTSEG
+ TAD I (OUTSEG
+ IAC
+ DCA I (SQBUF1+2 /STORE LINK TO NEXT SEGMENT
+ TAD I (SQBUF1+2
+ TAD (-7
+ SMA CLA
+ JMP I (SQIDER-1 /TOO MANY SEGMENTS
+ JMS I (OUTDIR /OUTPUT THIS SEGMENT
+NEWOUT, TAD (SQBUF1-1
+ DCA OUTXR /INITIALIZE XR FOR NEXT OUTPUT SEGMENT
+ DCA I (OUTINH /ZAP ANY OLD OUTPUT INHIBIT FLAG
+ DCA I OUTXR
+ TAD OUTBLK
+ DCA I OUTXR
+ DCA I OUTXR
+ DCA I OUTXR
+ TAD OUWAST
+ DCA I OUTXR
+NEXTIN, ISZ I S7200
+ JMP SGETIN
+ TAD I (SQBUF2+2
+ SNA /ANY MORE INPUT SEGMENTS?
+ JMP I (SQOVER
+ JMP NEWIN
+SNULER, TAD (NOROOM
+ JMS I (ERPRNT
+SNULL, CLA CMA
+ TAD OUSAVE
+ DCA OUTXR
+ JMP DMTX-1
+SEMPTY, TAD I INXR
+ JMP DMTX
+OUSAVE, 0
+\fSURE, TEXT /ARE YOU SURE?/
+
+SETSAM, 0
+ TAD IHNDLR
+ CIA
+ TAD OHNDLR
+ SNA CLA
+ IAC
+ DCA SAME
+ JMP I SETSAM
+ PAGE
+\fSQOVER, DCA I OUTXR
+ TAD OUDLEN
+ TAD OUTBLK
+ SNA
+ JMP CKZERO
+ DCA I OUTXR
+ CLA CMA
+ TAD I (SQBUF1
+ DCA I (SQBUF1
+CKZERO, TAD I (SQBUF1
+ SZA CLA
+ JMP ZEROK
+ CLA CLL CML RAR
+ JMS OUTDIR /READ IN LAST DIRECTORY
+ DCA I (SQBUF1+2 /ZERO OUT LINK WORD
+ SKP
+ZEROK, ISZ OUTSEG
+ JMS OUTDIR
+ZEROKS, JMS SRSTOR
+ JMP I (PIP
+
+ DCA I (SQBUF1+2
+SQIDER, JMS OUTDIR
+ JMS SRSTOR
+ JMS I (PIPERR
+ 12
+OUTDIR, 0
+ TAD (4210
+ DCA .+4
+ JMS CTCFLG
+ CIF 0
+ JMS I OHNDLR
+ 0
+ SQBUF1
+OUTSEG, 0
+ JMP SQIDER+1
+ DCA CTCFLG
+ JMP I OUTDIR
+
+SQIOER, TAD (IOMSG
+ JMS I (ERPRNT
+ JMP I (SLGRET
+\fSQCTLC, KCC /JUMPED TO BY CODE AT 07600
+ JMS I (TSTSAM /TEST IF OPERATION IS TO ITSELF
+ TAD (CTCMSG
+ JMS I (ERPRNT
+ TAD CTCFLG
+ SZA CLA
+ JMP I CTCFLG
+ TAD I (MPARAM+1 /IS IT /S?
+ AND (40
+ SNA CLA
+ JMP I (SYSCPY /NO../Y
+ JMP I (MOVFIL
+
+SRSTOR, 0
+ JMS I (7700 /MAKE SURE MONITOR IS IN CORE
+ 10
+ DCA .-2 /AND WIPE THE CALL AWAY
+ TAD (4207
+ CDF 0
+ DCA I (7600
+ TAD (5000
+ DCA I (7601
+ DCA I (7602
+ CDF 10
+ JMP I SRSTOR
+
+CTCFLG, 0
+ JMP I CTCFLG
+\fCTCMSG, TEXT /SORRY - NO INTERRUPTIONS/
+IOMSG, TEXT /I-O ERROR IN ^ - CONTINUING/
+NOROOM, TEXT /NO ROOM IN ^ - CONTINUING/
+ PAGE
+\fK7760, 7760
+SYSCOP, TAD K7622 /SET INFPTR IN CASE OF /Y ERROR
+ DCA INFPTR /WILL FILE #1
+ JMS I (SETCTC /KLUDGE UP 07600
+SYSCPY, TAD (INDEVH+1
+ DCA YIHAND /SET TO ASSIGN INPUT HANDLER
+ TAD (OUDEVH+1
+ DCA YOHAND
+ TAD (2000
+ DCA K2000 /THIS MAY GET CLOBBERED READING IN DIRECT.
+ TAD (10
+ DCA OFSET
+ TAD I K7617
+ SNA CLA /IS THERE AN INPUT DEVICE?
+ ISZ I K7617 /MAKE INPUT =SYS
+ JMS I (INTEST /SEE IF OPERATIONS ARE TO SAME DEVICE
+ TAD I K7617
+ JMS I K200 /ASSIGN HANDLER
+ 1
+YIHAND, 0
+K7622, 7622 /THINLY DISGUISED HALT
+ TAD I K7617
+K200, AND K7760 /CHECK INPUT FILE LENGTH
+ SNA /IF BLANK,INPUT SYSTEM HEAD
+ JMP YSOUT
+ TAD (-6340 /CHECK FOR PROPER LENGTH
+ SZA CLA
+ JMP PER13 /ERROR..NOT SYSTEM HEAD
+ TAD I (7601 /IS THERE OUTPUT DEVICE?
+ SZA CLA /IF YES..WE CAN DO IMAGE XFER
+ JMP I (IMGTST
+ TAD I (7620
+YOUSYS, DCA YINREC /PICK UP STARTING RECORD
+ CIF 0
+ JMS I YIHAND /READ IN FIRST INPUT RECORDS
+K2000, 2000 /(0-15 IF SYSTEM HEAD,0-7 IF FILE)
+ OUBUF
+YINREC, 0
+ JMP I (PER4 /INPUT ERROR
+ TAD I (7620 /IF INPUT FROM A FILE, OPEN
+ SZA CLA /A HOLE FOR OUTPUT DIRECTORY
+ JMS I (MOVE /DO A CORE MOVE
+ JMS I (TSTHED /TEST FOR VALID SYSTEM HEAD
+ TAD YINREC
+ TAD OFSET /BUMP TO NEXT RECORD
+ DCA NXTRD
+ TAD I (7600 /IF NO OUTPUT, FORGET IT
+ SNA
+ JMP PIPCLR /RESET AND GO TO PIP
+ JMS I K200
+ 1
+YOHAND, 0
+ HLT /V3
+ JMS I (FAKE
+ JMS I (SETSAM
+\f JMS I (TSTIO /TEST OUTPUT. SEE IF DIRECT. DEV.
+ CIF 0
+ JMS I YOHAND /READ OUTPUT DIRECTORY INTO PLACE
+ 1400
+ 400
+ 1
+ JMP I (PER4
+ CDF 0
+ TAD I (401 /NOW TEST FOR VALID OUTPUT DEVICE
+ CDF 10
+ TAD (-10 /IF LESS THAN 10, DON'T XFER
+ SPA CLA
+ JMS I (PIPERR
+ 11
+ TAD (-4
+ DCA YINREC /XFER COUNTER
+
+ JMP YDUMP
+YLOOP, CIF 0
+ JMS I YIHAND /READ NEXT
+K3400, 3400 /16 BLOCKS
+ OUBUF
+NXTRD, 0
+ JMP I (PER4
+ TAD NXTRD
+ TAD (16
+ DCA NXTRD
+YDUMP, TAD (7400
+ JMS I (OUTDMP /WRITE BUFFER
+ JMP I (AOUERR
+ ISZ YINREC /DONE YET?
+ JMP YLOOP /NOT YET..LOOP
+PIPCLR, JMS I (SRSTOR /CLEAR OUT 07600
+ JMP I (PIP
+\fYSOUT, TAD I (7601 /HERE IF INPUT FROM SYSTEM HEAD
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP I (YTSOUT /YES, SET UP FOR IMAGE MODE
+YNOOUT, TAD K3400 /SET TO READ IN DIRECTORY
+ DCA K2000 /PLUS FIRST 7 RECORDS
+ TAD (16 /AND RESTART READ AT RECORD 16
+ DCA OFSET
+ JMP YOUSYS
+OFSET, 0
+
+PER13, JMS I (PIPERR
+ 13
+K7617, 7617 /V3
+ PAGE
+\fDIRECT, -1
+DFORG, 0 /FILE STORAGE
+ 0
+ 0
+DWASTE, 0 /#WASTE WORDS
+ 0
+DLENGT, 0
+
+MOVE, 0
+ TAD (4400 /MOVES CORE TO OPEN DIRECTORY HOLE
+ DCA TEMP
+ TAD (3777
+ DCA MWAST
+ TAD (6777
+MOVE1, DCA TSTSAM
+ CDF 0
+ TAD I MWAST
+ DCA I TSTSAM
+ CMA
+ TAD MWAST
+ DCA MWAST
+ CMA
+ TAD TSTSAM
+ ISZ TEMP
+ JMP MOVE1
+ CLA
+ CDF 10
+ JMP I MOVE
+
+ERR11, TEXT /BAD SYSTEM HEAD/
+
+YTSOUT, TAD I (7617 /O.K. SETUP CD AREA FOR IMAGE XFER
+ TAD (7760 /FROM SYSTEM AREA OF INPUT DEVICE
+ DCA I (7617
+ TAD I (7617
+ AND (17
+ TAD (6360
+ DCA I (7621
+ TAD K7
+ DCA I (7622
+IMGTST, DCA SAME /ALLOW ^C IF TO OUTPUT FILE
+ TAD I (YIHAND /TEST FOT VALID SYSTEM
+ DCA IHNDLR
+ CIF 0
+ JMS I IHNDLR
+ 0200
+ 3400
+K7, 7
+ JMP I (PER4
+ JMS I (TSTHED
+ JMP I (IMAGE
+\fTSTSAM, 0
+ TAD SAME /IF /Y IS TO SAME DEVICE AS INPUT (SYS)
+ SNA CLA /^C GIVES MESSAGE AND RETRIES OPERATION
+ JMP I (ZEROKS
+ JMP I TSTSAM
+
+ERR2, TEXT /OUTPUT ERROR/
+
+SQFILE, DCA MWAST
+ TAD I (OUSAVE
+ DCA TSTSAM /IF ERROR DURING /S
+ DCA DWASTE
+ CLA CLL CMA RTL
+ DCA MOVE /-3 FOR FILE NAME
+SQFIL3, TAD I TSTSAM /FIRST 2 CHARS. IN NAME
+ CLL RTR
+ RTR
+ RTR
+SQFIL5, AND (77
+ SZA /IF ZERO, DON'T BOTHER
+ JMS I (CHPRNT
+ ISZ DWASTE /RIGHT HALF OR NEW WORD?
+ JMP SQFIL4 /RIGHT HALF
+ ISZ TSTSAM
+ ISZ MOVE /EXHAUSTED ALL?
+ JMP SQFIL3 /NOPE
+ TAD MWAST /DONE WITH IT YET?
+ SZA CLA
+ JMP I (FILENR-1 /YES
+ TAD I TSTSAM /IS THERE AN EXTENSION?
+ SNA CLA
+ JMP I (FILENR-1 /NO..CONTINUE ORIGINAL MSG
+ TAD (256
+ JMS I (TTYOUT
+ ISZ MWAST /SIGNAL END
+ CLA CMA
+ JMP SQFIL3-1
+SQFIL4, CLA CMA
+ DCA DWASTE
+ TAD I TSTSAM /GET RIGHT HALF
+ JMP SQFIL5
+\fMWAST, 0
+ DCA TEMP
+ TAD I INXR
+ DCA I OUTXR /ROUTINE TO COPY WASTE WORDS
+ ISZ TEMP
+ JMP .-3
+ JMP I MWAST
+ PAGE
+\fFAKE, 0
+ TAD I (YIHAND
+ DCA IHNDLR
+ TAD I (YOHAND
+ DCA OHNDLR
+ DCA I (OUCCNT
+ DCA I (OUBLK
+ DCA I (OUELEN
+ TAD I (YOHAND
+ DCA I (OUHNDL
+ JMP I FAKE
+
+CYWAST, 0 /ROUTINE TO COPY WASTE WORDS
+ CLA CLL CMA RTL /THREE MORE FOR FILE NAME
+ JMS I (MWAST /COPY THEM
+ TAD I (SQBUF2+4 /NOW ADJUST I/O WASTE WORDS
+ CIA
+ TAD OUWAST /DIFF. BETWEEN OUT AND IN WORDS
+ SMA /IF <0, MORE OUT THAN IN
+ JMP CGEWST /POS. MORE IN THAN OUT (OR SAME)
+ DCA TEMP1
+ TAD I (SQBUF2+4
+ SZA
+ JMS I (MWAST /COPY ALL INPUT WORDS
+ DCA I OUTXR /AND 0 ALL EXTRA OUTPUT WORDS
+ ISZ TEMP1
+ JMP .-2
+ JMP I CYWAST
+CGEWST, DCA TEMP1
+ TAD OUWAST /XFER ONLY ENOUGH OUTPUT WDS.
+ SZA
+ JMS I (MWAST
+ TAD INXR
+ TAD TEMP1 /POINT INPUT TO NEXT FILE
+ DCA INXR
+ JMP I CYWAST
+
+TSTHED, 0 /TESTS FOR KEYBOARD MONITOR
+ CDF 0
+ TAD I (3401
+ CDF 10
+ TAD (-7200
+ SZA CLA
+ JMP I (PER13 /IF NOT CLA, NOT VALID
+ JMP I TSTHED
+\fTSTIO, 0 /SEE IF OUTPUT IS DIRECTORY DEVICE
+ JMS I (OTYPE /GET DCB WORD FOR OUTPUT
+ SMA CLA /IF NOT NEG., NOT DIRECT DEVICE
+ JMS I (PIPERR
+ 5
+ TAD OHNDLR /IF OUTPUT=SYS, SET NO INTERRUPT
+ TAD (171
+ SNA CLA
+ ISZ SAME
+ JMP I TSTIO
+
+ASCI2, 0 /SEE IF VALID ASCII OUTPUT
+ DCA TSTIO
+ TAD I (7600
+ SNA CLA
+ JMP I (PIP /NO..BACK TO PIP
+ TAD TSTIO /SEE IF /C IS ON
+ SNA CLA
+ JMS I (FIXLEN /NO..TRY TO ESTIMATE OUTPUT
+ JMP I ASCI2
+
+SQDTST, 0 /ROUTINE TO CHECK /S DIRECTORIES
+ DCA NOHND /PRESERVE POSSIBLE SYS ON OUTPUT
+ TAD (7 /DEFAULT TO BLOCK 7
+ DCA OUTBLK /INITIAL GUESS
+ CDF 10 /NOW TRY TO READ DIRECTORY OF OUTPUT
+ JMS I (OTYPE /IF NON-FILE, DON'T READ IT
+ SMA CLA
+ JMP P1A
+ CIF 0 /COULD BE NON-FILE, HOWEVER.
+ JMS I NOHND
+ 0210
+ 1400
+P1, 1
+ JMP I (SQIDER+1 /ERROR IN READ
+P1A, DCA OLDDIR /WIPES ANY DIRECT. SEGMENT
+ TAD I (1401
+ TAD (-70 /IS OUTPUT A SYS DEVICE?
+ SNA CLA
+ JMP SYSDIR /YES.
+ TAD NOHND /IS OUTPUT THE SYSTEM DEVICE?
+ TAD (171
+ SZA CLA
+ JMP .+3
+SYSDIR, TAD (70
+ DCA OUTBLK
+ JMP I SQDTST
+
+NOHND=FAKE
+
+SYSZRO, TEXT /ZERO SYS?/
+\fAOUERR, SMA CLA /WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
+ JMP BOUERR /OUT OF SPACE
+PER2, JMS I (PIPERR
+ 2
+BOUERR, JMS I (PIPERR
+ 0
+
+ASCPTCH,TAD (ACHLP+1 /V3C FAKE OUT ICHAR
+ DCA I (ICHAR /SIMULATE CALL TO ICHAR FROM 'ACHLP'
+ JMP I (GETNEW /V3C SIMULATE OCCURRENCE OF 8-BIT ^Z IN ICHAR
+ PAGE
+\f/THIS IS ONCE-ONLY CODE
+
+ONCE, 0
+ STA
+ TAD ONCE
+ DCA ONCENF
+ TAD (20
+ DCA I ONCENF /RESTORE L20, DON'T ALLOW REENTRY
+ TAD I (MPARAM+1
+ AND (7
+ SNA CLA /IS /V SET?
+ JMP I ONCE /NO, RETURN
+ TAD (VER /YES
+ JMS I (ERPRNT /PRINT VERSION NUMBER
+ JMP I ONCE /RETURN
+
+VER, TEXT \OS/8 PIP V11A\
+ONCENF, 0
+ PAGE
+ $
+\f
projects / pdp8.git / blobdiff