File: PIP40.PA of Tape: OS8/OS8-V40/v40-5
(Source file text)
/3 PIP V40 FOR OS/8 MONITOR V40
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
/ AND 1979, 1980 BY DATAPLAN GMBH
/
/
/
/
/
/
/
/
/
/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.
/
/
/
/
/
/
/
/
/
/
/ 1-JUL-79 FILE: PIP.PA OS/8 VERSION 40A
/RL/EF/ET.AL./S.R./E.S.
/JVZ/WVDM/DEVEXT VERSION 40A
/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 'YES' ON '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
/WVDM ENABLED EFL
/ FIXED /Y IN SOURCE
/ ADDED NEW DATE FORMAT
/DEVEXT ADDED RX02 SUPPORT
/ /Y OPTION FOR NEW MONITOR
/ GERMAN MESSAGES
GERMAN=1
/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 NOTHING
/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.
/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
/N- NUMERIC DATES
/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
/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
MDATE=7666 /MONITOR DATE
BIPCCL=7777 /BATCH,CCL,CORE,EX DATE
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=1400 /DIRECTORY BUFFER FOR "SQUISH" OPTION
SQBUF2=7200 /""
FIELD 1 /TO ENABLE /E,/F,/L SET
OS78=0
IFNDEF OS78 <OS78=1>
/ .PAL PIP12B
/ .LOAD PIP12B=13000
/ .SA SYS PIP=6403
/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.
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.
INNEWF, -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
OOPEN, 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
OUTDMP, 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
OCLOSE, 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
OUSETP, 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
OTYPE, 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
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
/PIP PROPER BEGINS HERE
/**********************
/IMAGE MODE PROCESSOR FOR PIP
IM7600, 7600 /KEEP AT BEGINNING OF PAGE
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 IM200
4 /CLOSE
7601 /FILE NAME
IMCCNT, 0
JMP I (AOUERR
JMP I (PIPCLR
ENDFUJ, 0 /PART OF DIRECTORY PRINTING ROUTINE
JMS I (PRNUM
TAD (-7
JMS I (PRWD /PRINT SEVEN WORDS
IFNDEF GERMAN < TEXT \ FREE BLOCKS \>
IFDEF GERMAN < TEXT \ FREIE BLOECKE\>
*.-1
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
IMHNDL, /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
IMERRX, ISZ INEOF /SIGNAL EOF OR WORSE
SPA CLA /WHICH ONE IS IT?
JMP IMERR4
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
IMERR4, JMS I (PIPERR /SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
4 /A ^Z AT LEAST)
IMNZRO, CDF 10
TAD CHAR
CLL CML RAR
IM200, AND IM7600
TAD IM200 /GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
JMP IMOUT /AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
PAGE
/** 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
/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
SZA CLA /IS THE FORM CONTROL CHAR A FORM-FEED?
STA /NO - RUBOUT
TAD (400 /YES - OUTPUT BLANK TAPE INSTEAD
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
*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
TAB, 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
FFEED, 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
/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
DZERO, 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
SMA /FILE STRUCTURED HAVE 4000 BIT ON
JMP NONDIR /NON DIRECTORY DEVICE
AND K770 /MASK OUT DEVICE TYPE
CLL RTR
RAR
TAD (DEVLEN /USE IT TO INDEX A TABLE OF DEVICE LENGTHS
DCA PIPERR
TAD (OUDEVH+1
DCA OZHNDL
TAD I P7600
JMS I C200
1 /ASSIGN DEVICE, FETCH HANDLER
OZHNDL, 0
HLT
TAD I PIPERR
SNA /IS THE LENGTH ZERO?
JMS I (DVREDE /IF LENGTH ZERO GO "READ LENGTH"
DCA PIPERR /STORE LENGTH
JMS I (CONFRM /ASK IF HE'S SURE
SURE /V3
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
SNA CLA
ZRO70, TAD (61
TAD (7 /NOT SYSTEM FILES BEGIN AT 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
NONDIR, CLA /NON DIRECTORY RETURN
JMP I DZERO
PIPERR, 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
/TABLE OF DEVICE LENGTHS FOR /Z OPTION
/I.E. THE ONE THAT IS IN 'PIP' AT 13600
/LAST UPDATE 1-JAN-1980
DEVLEN, 0000 /0:TTY
0000 /1:PTR
0000 /2:PTP
0000 /3:CDR
0000 /4:LPT
1520 /5:RK08 (1520= - DECIMAL 3248)
6001 /6: RF08 IN VARIOUS SIZES
4001 /7: "
2001 /10:"
0001 /11:"(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
7601 /12: DF32 IN VARIOUS SIZES
7401 /13:"
7201 /14:"
7001 /15:"(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
6437 /16:TC08 DECTAPE
6437 /17:LINCTAPE
0000 /20: MAGTAPE
6437 /21: TD8E
0000 /22: BAT: BATCH HANDLER
1520 /23: 1/2 OF AN RK8E
0000 /24: NULL: NULL HANDLER
7022 /25: RX01 FLOPPY DISK
0017 /26: RL01 A,B BIG
0000 /27: TA8E CASSETTE
0000 /30: PDP-12 SCOPE AND TEK DISPLAY
4027 /31: RL01 C SMALL
0000 /32: NEW RX MUST BE ZERO TO EXAMINE MEDIA
7600 /33: VX EXT.MEM. PLATTER #1
7400 /34: VX EXT.MEM. PLATTER #1,2
7200 /35: VX EXT.MEM. PLATTER #1,2,3
0000 /36: DUMP
7000 /37: TU58 DECTAPE II (6-BIT BYTES)
1520 /40: SYS. IND. MOD43 DISK
6556 /41: RB01 1.5 DENSITY FLOPPY - INTERLEAVE 2
6556 /42: RB07 1.5 DENSITY FLOPPY - INTERLEAVE 4
ZBLOCK 5 /USER DEVICES
0 /50: MULTI8 VIRTUAL DEV
0 /51: "
0 /52: "
0 /53: "
0 /54: "
0 /55: "
0 /56: "
0 /57: "
0000 /60: ASYNCHRONOUS COMMUNICATION
ZBLOCK 17
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
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
DCA FIXLEN
TAD FIXLEN
JMS I (TTYOUT /ECHO IT
TAD FIXLEN
AND (137 /ALLOW LOWER CASE
TAD (-"Y!7600
SZA /IS IT YES?
TAD ("Y-"J
SNA CLA /ODER IST ES JA?
GOTCON, ISZ SQFLAG /YES: SET SQFLAG TO 1 (NEEDED 1 LATER)
TAD SQFLAG
SNA CLA
JMP I (PIP
ISZ CONFRM
JMP I CONFRM
PAGE
/DIRECTORY PRINTER FOR PIP
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
PRWD, 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
PRNUM, 0 /REDO THIS FOR BETTER RESULTS
DCA PCRLF /SAVE VALUE
TAD I PRNUM
CIA
DCA PRWD /SAVE BLANK COUNT (OPTIONAL)
TAD (TAD PWRTEN
DCA PRNMLP /INITIALIZE
DCA PR6BIT /CLEAR PRINT FLAG
DCA DIGIT /CLEAR QUOTIENT
PRNMLP, TAD PWRTEN /**INCREMENTED**
SNA
JMP I PRNUM /DONE
CLL
TAD PCRLF
SNL
JMP PRXX60 /TOO MUCH
DCA PCRLF
ISZ DIGIT /FORM QUOTIENT
JMP PRNMLP
PRXX60, STA STL /THIS INSTRUCTION ENDS IN '60'
AND DIGIT
ISZ PRNMLP /ADJUST DIVISOR
ISZ PR6BIT /TEST PRINT FLAG
SZA
JMP .+3 /PRINT THE RESULT
ISZ PRWD /TEST BLANK COUNT
JMP PRBLNK
TAD PRXX60 /CONVERT TO ASCII
JMS PR6BIT
CMA
JMP PRNMLP-2 /REPEAT
PRBLNK, JMS PR6BIT /CLEARED BY PDATE
JMP PRNMLP-2 /TO SUPPRESS BLANKS
PCRLF, 0
TAD (215
JMS I (OCHAR
JMP I (AOUERR
TAD PR212
JMS I (OCHAR
JMP I (AOUERR
JMP I PCRLF
PWRTEN, -1750;-144;-12;-1 /V3
DIGIT, 0
JMSPR6=JMS PR6BIT /USEFUL LATER ON
PAGE
/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
DEMPTY, 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
IFNDEF GERMAN < TEXT /<EMPTY>/>
IFDEF GERMAN < TEXT /<FREI> />
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
/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
LTCODE, 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
RCOPY1, 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
ERPRNT, 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
PDATE, 0 /V3D CHANGES
SNA
JMP I PDATE
DCA TEMP /SAVE DATE
TAD I (MDATE /CHECK SYSTEM DATE
SNA CLA /NEED IT TO INTERPRET OTHERS
JMP I PDATE
DCA I (PRBLNK /SUPPRESS LEADING BLANKS
JMS I (PRDAMO /PRINT THE MONTH, DAY
TAD TEMP
AND (7 /MASK THE YEAR
DCA TEMP
TAD I (MDATE /CURRENT DATE
AND (7
CIA
TAD TEMP /COMPARE YEARS
SMA SZA CLA
TAD (-10 /-10
TAD (106 /106 = 1970
TAD TEMP
DCA TEMP /SAVE THIS MUCH
CDF 0
TAD I (BIPCCL /GET EXTENSION BITS
CDF 10
JMS I (PRYEAR /PUT IT ALL TOGETHER
TAD JMSPR
DCA I (PRBLNK /RESTORE BLANKS
JMP I PDATE
JMSPR, JMSPR6
DSKNUM, 0
DCA DSKNAM+1
JMS I (200
12
DSKNAM, 5723
0
0
HLT
TAD DSKNAM+1
JMP I DSKNUM
RELTBL, -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
TTYOUT, 0
TLS
TSF
JMP .-1
CLA
JMP I TTYOUT
/ERROR MESSAGE TEXT GOES HERE
IFNDEF GERMAN <
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/
>
IFDEF GERMAN <
ERR0, TEXT /DATEI HAT KEINEN PLATZ/
ERR1, TEXT /ZEILE ZU LANG IN DATEI_/
ERR3, TEXT /LOESCH-FEHLER/
ERR4, TEXT /LESEFEHLER, DATEI_/
ERR5, TEXT /KANN DATEI NICHT OEFFNEN/
ERR6, TEXT /GERAET_ OHNE VERZEICHNIS/
ERR7, TEXT /VERFRUEHTES ENDE, DATEI_/
ERR8, TEXT /KEIN BINAER FORMAT, DATEI_/
ERR9, TEXT /VERZEICHNIS KAPUTT, GERAET_/
ERR10, TEXT \VERZEICHNIS L/S-FEHLER\
>
PAGE
/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 SOHND /SET UP OZHNDL
DCA I (OZHNDL /IN CASE OF JMP TO 'DVREDE'
TAD I TEMP /GET ENTRY FROM DEVICE LENGTH TABLE
SNA /IS THE DEVICE LENGTH ZERO?
JMS I (DVREDE /IF SO, READ LENGTH
DCA OUDLEN /SAVE OUTPUT DEVICE LENGTH
JMS I (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
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
OUK, 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
NEWIN, 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
SURE,
IFNDEF GERMAN < TEXT /ARE YOU SURE?/>
IFDEF GERMAN < TEXT /GANZ SICHER? />
SETSAM, 0
TAD IHNDLR
CIA
TAD OHNDLR
SNA CLA
IAC
DCA SAME
JMP I SETSAM
PAGE
SQOVER, 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
SQCTLC, 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
IFNDEF GERMAN <
CTCMSG, TEXT \SORRY - NO INTERRUPTIONS\
IOMSG, TEXT \I-O ERROR IN ^ - CONTINUING\
NOROOM, TEXT \NO ROOM FOR ^ - CONTINUING\
>
IFDEF GERMAN <
CTCMSG, TEXT \KEINE UNTERBRECHUNGEN!\
IOMSG, TEXT \L/S-FEHLER BEI ^ - KEIN HALT\
NOROOM, TEXT \KEIN PLATZ FUER ^ - KEIN HALT\
>
PAGE
K7760, 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
IFNZRO OUDEVH-7200 <ERR,___>/ TAD (OUDEVH+1
TAD .+2
DCA YOHAND
CLA IAC /BOOTSTRAP OFFSET
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 IMGOUT
TAD I (7620
YOUSYS, DCA YINREC /PICK UP STARTING RECORD
CIF 0
JMS I YIHAND /READ IN FIRST INPUT RECORDS
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,
SNA CLA /TEST LOC 605
TAD (3000 /IF FROM HEAD, TEST 3605
TAD (605
DCA I (HDTST
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
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 (-10 /8*7=56 BLKS - DIR= 50 BLKS
DCA YINREC /XFER COUNTER
JMP YDUMP
YLOOP, CIF 0
JMS I YIHAND /READ NEXT
1600 /READ 7 BLKS
OUBUF
NXTRD, 0
JMP I (PER4
TAD NXTRD
TAD (7
DCA NXTRD
YDUMP, TAD (5600
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
IMGOUT, DCA SAME
TAD YIHAND
DCA IHNDLR
JMP I (IMAGE
YSOUT, 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 (7 /RESTART READ AT RECORD 7
DCA OFSET
JMP YOUSYS
OFSET, 0
PER13, JMS I (PIPERR
13
K7617, 7617 /V3
PAGE
DIRECT, -1
DFORG, 0 /FILE STORAGE
0
0
DWASTE, 0 /#WASTE WORDS
0
DLENGT, 0
ERR11,
IFNDEF GERMAN < TEXT \BAD SYSTEM HEAD \>
IFDEF GERMAN < TEXT \KEIN SYSTEM-KOPF\>
YTSOUT, TAD I (7617 /O.K. SETUP CD AREA FOR IMAGE XFER
TAD (7760 /FROM SYSTEM AREA OF INPUT DEVICE
DCA I (7617 /1 BLK
TAD I (7617
AND (17 /7620=0: BLK 0
TAD (6360
DCA I (7621 /61 BLKS
TAD K7
DCA I (7622 /FROM BLK 7
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
TSTSAM, 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,
IFNDEF GERMAN < TEXT \OUTPUT ERROR \>
IFDEF GERMAN < TEXT \SCHREIB-FEHLER\>
SQFILE, DCA MWAST
TAD I (OUSAVE
DCA TSTSAM /IF ERROR DURING /S
DCA DWASTE
CLA CLL CMA RTL
DCA MOVCNT /-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 MOVCNT /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
MOVCNT, 0
MWAST, 0
DCA TEMP
TAD I INXR
DCA I OUTXR /ROUTINE TO COPY WASTE WORDS
ISZ TEMP
JMP .-3
JMP I MWAST
GETEQ, 0 /V3
TAD I (MPARAM+3
SNA
IAC
AND (77 /CONVERT 0 TO 1 AND 100 TO 0
CIA
JMP I GETEQ
DVREDE, 0 /READ DEVICE FROM BAD BLOCK
TAD I (OZHNDL /GET DEVICE ENTRY POINT
DCA GETEQ
CIF 0
JMS I GETEQ
0011
0000
-111 /NEGATIVE BLOCK - RETURNS MINUS LENGTH
CIF 10
JMP I DVREDE /ERROR RETURN FOR READ YIELDS RESULT
PAGE
FAKE, 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 HDTST
CDF 10
TAD (-7200
SZA CLA
JMP I (PER13 /IF NOT CLA, NOT VALID
JMP I TSTHED
HDTST, 3605
TSTIO, 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 NOHND /IS OUTPUT THE SYSTEM DEVICE?
TAD (171
SNA CLA
JMP SYSDIR
TAD I (1401
TAD (-70 /IS OUTPUT A SYS DEVICE?
SZA CLA
JMP I SQDTST
SYSDIR, TAD (70
DCA OUTBLK
JMP I SQDTST
NOHND=FAKE
AOUERR, SMA CLA /WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
BOUERR, JMS I (PIPERR /OUT OF SPACE
0
PER2, JMS I (PIPERR
2
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
/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 SUMMOR /NO, RETURN
TAD (VER /YES
JMS I (ERPRNT /PRINT VERSION NUMBER
JMP SUMMOR /RETURN
VER, TEXT \OS/8 PIP V40B\
ONCENF, 0
SUMMOR, TAD RELPTR
SNA
JMP I ONCE
DCA I RELPTR
ISZ RELPTR
ISZ SUMMOR
JMP SUMMOR
RELPTR=.
RELOC 7046
/WE'VE ADDED A NEW SWITCH: /N = NUMERIC DATES
PRDAMO, . /DA-MON-YR OR MM/DD/YY
JMS I LPR6BT /START WITH A SPACE
STL RTR
AND I L17644 /TEST THE /N SWITCH
SNA CLA
JMP ALPHA /NEW STYLE DATES
JMS MONTH
JMS I LPRNUM
3 /BLANK COUNT
TAD LSLASH
JMS I LPR6BT
ALPHA, TAD TEMP /PRINT THE DAY
RAR
RTR
AND L37
JMS I LPRNUM
3
STL RTR
AND I L17644 /CHECK /N AGAIN
SZA CLA
JMP NUMERC /OLD STYLE DATES
JMS MONTH
TAD LM15 /.GT. DEC?
SPA CLA
JMS MONTH
CLL RAL /X2
TAD DATTAB
DCA MONTH
JMS PRMON /PRINT THE MONTH
ISZ MONTH
JMS PRMON
CMA CLL RAL /TURN SLASH INTO DASH
NUMERC, TAD LSLASH
JMS I LPR6BT
JMP I PRDAMO
PRYEAR, . /PRINT THE YEAR
RTR
RTR /AC = BIPCCL WORD
AND L30
TAD TEMP /MERGE
JMS I LPRNUM
JMP I PRYEAR
PRMON, . /PRINT ALPHA MONTH
TAD I MONTH
DCA .+2
JMS I LPRWD
DATTAB
JMP I PRMON
MONTH, . /EXTRACT MONTH BITS
TAD TEMP
CLL RAL
RTL
RTL
AND L37
JMP I MONTH
L30, 30
L37, 37
LM15, -15
LSLASH, "/
LPRWD, PRWD
LPRNUM, PRNUM
LPR6BT, PR6BIT
L17644, MPARAM+1
DATTAB, .+1
IFNDEF GERMAN < TEXT /-BAD-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC/>
IFDEF GERMAN < TEXT /-???-JAN-FEB-MAR-APR-MAI-JUN-JUL-AUG-SEP-OKT-NOV-DEZ/>
RELOC
PAGE
FIELD 1
*3000
$