File: MCPIP.PA of Tape: OS8/OS8-V3/dec-s8-osysb-a-ua8
(Source file text)
/4 OS/8 MCPIP MAGTAPE AND CASSETTE PIP
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1974 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.
/
/
/
/
/
/
/
/
/
/
/ S.R.
/ REVISED FEB. 11, 1974
KCLR=6700 /CLEAR ALL
/CLEAR STATUS A AND B REGISTERS.
KSDR=6701 /SKIP ON DATA FLAG
KSEN=6702 /SKIP ON ERROR
KSBF=6703 /SKIP ON READY FLAG
KLSA=6704 /LOAD STATUS A FROM AC 4-11
/CLEAR AC, THEN
/LOAD 8 BIT COMPLEMENT OF STATUS A
/BACK INTO AC
KSAF=6705 /SKIP ON ANY FLAG OR ERROR
KGOA=6706 /ASSERT THE CONTENTS OF STATUS A,
/TRANSFER DATA IF READ OR WRITE
KRSB=6707 /READ STATUS B INTO AC 4-11
FIXMRI CALL=4400
FIXMRI EXIT=5400
FIXMRI INCR=2000
/CORE ALLOCATION
/00000-01777 COMMAND DECODER
/02000-02377 OUTPUT HANDLER
/02400-02777 INPUT HANDLER
/03000-03777 CASSETTE OUTPUT BUFFER
/04000-04777 CASSETTE INPUT BUFFER
/05000-05577 STAND ALONE CASSETTE HANDLER
/05600-07577 LOOKUP, ENTER, CLOSE
/07600-07777 OS/8
/10000-11777 USR
/12000-14577 PIPC
/14600-17577 OS/8 INPUT/OUTPUT BUFFER
/17600-17777 OS/8
/USR HAS THE FOLLOWING FREE LOCATIONS:
/0-6
/10-17 (BUT GET DESTROYED)
/20-37
TEMP=20
TEMP1=21
TEMP2=22
TEMP3=23
/ STARTING ADDRESS = 12000
/ JOB STATUS WORD = 6003
INHAND=2400
OUTHAND=2000
COBUF=3000
CIBUF=4000
PIPVERSION=4
PATCHLEV=77&"
SPCODE=6
CLCODE=0
REWCOD=1
FICODE=3
EOCODE=5
RECCOD=2
/V3 CHANGES:
/1. SHRUNK 0S/8 BUFFER TO 3000 WORDS
/2. ADDED VERSION NUMBER (/V)
/3. MADE INDEPENDENT OF MAGIC LOCATIONS IN CASSETTE HANDLER
/4. ADDED MAGTAPE SUPPORT OF CASSETTE FILE STRUCTURE
/5. ALTMODE MEANS RETURN TO KBM
/6. ^C DOESN'T CLOSE CASSETTES UNLESS WE ALREADY WROTE ON IT
/7. FIXED BUG THAT CSA2 THRU CSA7 DIDN'T WORK
/8. CR ALONE TO CD GIVES NO ERROR MESSAGE
/9. ADDED ^O AND ^C SUPPORT TO MESSAGE PRINTOUT
/10. GIVE ERRORS ON ILLEGAL * OR ? IN NAME
/11. USES TTY: AS DEFAULT OUTPUT DEVICE ON /L
/PROPOSED:
/8. ALLOW *.* FOR CASSETTE INPUT
/9. SUPPORT OF UNLABELED MAGTAPE STANDARD
/10. /7 OR /9 SPECIFIES CHANNEL
/FIXES SINCE FIELD TEST :
/1. ^C ALWAYS BRINGS YOU BACK TO KBM
/2. FIXED BUG RE CHECK FOR FILE FULL
/3. MADE COMPATIBLE WITH NEW TM8E HANDLER
/4. TIME-OUT ON CASSETTE READ
/5. BE NICE-GUY IF OS/8 LOOKUP FAILURE
/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
/AND READY.
/THE NEW UNIT NUMBER (0-7) IS IN THE AC.
/THE UNIT NUMBER IS IN BITS 8-11 OF THE AC.
/RETURN 1 IS MADE IF THE UNIT IS NOT READY.
/CINUSE IS SET TO 1.
/THE HANDLER MUST NOT ALREADY BE IN USE.
/THE DATA FIELD IS INTERROGATED
/AND A RETURN CIF CDF IS BUILT
/AND STORED IN LOCATION RETCIF
*5000
FIXDVC, 0
DCA DVC
RDF
TAD (CIF CDF
CDF 0
DCA TMP
TAD I FIXDVC
DCA ERRET
ISZ FIXDVC
TAD TMP
DCA I ERRET
TAD DVC
SNA
JMP CHECKR
RAR /MOVE UNIT TO LINK; DEVICE TO AC
AND (3 /MASK OFF DEVICE CODE
DCA DVC /SAVE DEVICE CODE
SZL
TAD (100
DCA I (ABUNIT /SET UNIT IN BIT 5
TAD DVC
CLL RTL
RAL /UGLY
DCA DVC /MOVE TO BITS 6-8
TAD (IOTBL
DCA IOTPTR
IOTLOOP,TAD I IOTPTR
SNA /END OF TABLE?
JMP CHECKR /YES
DCA TMP
TAD I TMP
AND (7707 /MASK OUT OLD DVC
TAD DVC /INSERT NEW ONE
DCA I TMP /REPLACE
ISZ IOTPTR /POINT TO NEXT ONE
JMP IOTLOOP
TMP, 0
DVC, 0 /DEVICE CODE
IOTPTR, 0
CHECKR, JMS I (CLEAR
TAD (200
JMS I (LOADA /SELECT DRIVE
JMS I (CHECKB
AND (7735 /IGNORE EOT/BOT FLAG
/AND WLO
TAD (-1
SZA CLA
JMP I ERRET /NOT READY
ISZ I (CINUSE
JMP I FIXDVC
ERRET, 0 /ERROR RETURN LOCATION
FIDDLE, 0
CIF 10
JMS I (FID2 /NEED ROOM
TAD (CIBUF+11
DCA 10
TAD FAST
SZA CLA
JMP DIREOL
TAD (40
DCA I 10
TAD I (CIBUF+20
DCA I 10
TAD I (CIBUF+20
AND (177
SZA
TAD (-40
SZA CLA
TAD ("/-40
TAD (40
DCA SLSH
TAD I (CIBUF+21
DCA I 10
TAD SLSH
DCA I 10
INCR 10
INCR 10
TAD SLSH
DCA I 10
TAD I (CIBUF+22
DCA I 10
TAD I (CIBUF+23
DCA I 10
DIREOL, TAD (15
DCA I 10
TAD (12
DCA I 10
TAD (32
DCA I 10
FIDLV, EXIT FIDDLE
/0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 17 20 21 22 23 24 25
/F I L E N A M E S D D M M Y Y
/F I L E N A . M E S M M / D D / Y Y CR LF ^Z
FAST, 0 /0 MEANS F NOT SPECIFIED
SLSH, "/
IOTBL, IOT0
IOT1
IOT4
IOT5
IOT6
IOT6C
IOT7
0
PAGE
UTIL, 0
DCA TEMPU
DCA REWSW /ZERO REWIND SWITCH
TAD I UTIL
TAD (-10
SNA
ISZ REWSW
ISZ UTIL
TAD (210
DCA TEMPFN
TAD TEMPU
JMS I (FIXDVC /FIX DEVICE CODE
UTEND /UNIT NOT READY
TAD (UT
DCA CRET /SET RETURN ADDRESS
STA
DCA I (RW /NOTE FACT THAT OP AINT READ
TAD TEMPFN
JMS I (LOADA
JMS GO /INITIATE UTIL
JMP CRET+1
ISZ UTIL
UTEND, HLT
JMP I UTIL
UT, JMS CHECKB /LOOK AT STATUS B
AND (50 /CHECK FOR CL, EMPTY, OR WLO
/GIVE NO ERROR ON WLO ************
/BAD FOR WRGAP
SNA
JMP OK /NO ERRORS
TAD (-40
SZA CLA
JMP NOTOK /ERROR NOT CL
TAD REWSW
SNA CLA /CL OK IF DID REWIND
NOTOK, STA
OK, JMS CLEAR
TAD CINUSE
SMA CLA
JMP UTEND-1
TAD BSTATE /ERROR
JMP UTEND
TEMPU, 0
TEMPFN, 0
REWSW, 0 /1 MEANS OPERATION IS REWIND
CHECKB, 0
IOT7, KRSB /READ STATUS B INTO AC 4-11
DCA BSTATE /SAVE STATUS B
TAD BSTATE
JMP I CHECKB
CLEAR, 0
DCA CINUSE /LEAVE STATUS CONDITION IN AC; -1 MEANS ERROR
IOT0, KCLR /CLEAR STATUS A AND B
JMP I CLEAR
GO, 0
IOT6, KGOA /ASSERT CONTENTS OF STATUS A
CLA
JMP I GO
CHK, 0
JMS I (CHECKB
AND (374
IOT1, KSDR
SKP /DATA FLAG NOT UP -
JMP I CHK
TAD (-20
SNA CLA /IS IT END OF FILE?
JMP I (ERRR /YES, ERROR - BUT DON'T RETRY
TAD BSTATE
JMP I CHK
CINUSE, 0 /1 MEANS HANDLER IN USE
BSTATE, 0 /STATUS OF REGISTER B ON ERROR
DTEM, 0
DOPTION,JMS I (CONVRT
7601
DCA DTEM
TAD I (OUNIT
JMS I (LOOKUP
JMP I (XER4
JMP MBNF /NOT FOUND
INCR DTEM
JMS I (DELET
JMP I (XER77 /OUTPUT ERROR
MBNF, TAD DTEM
SNA CLA /ANYTHING DELETED?
JMP I (XER24 /NO
JMS UTIL
REWIND
CLA
CIF CDF 10 /YES
JMP I (DECODE
CRET, 0
CDF 0
TAD (-200 /COUNT OF HOW LONG TO WAIT
DCA I (OUTER
IOL, JMS I (CTRLC
JMS I (TIMEOUT
IOT5, KSAF
JMP IOL
EXIT CRET
PAGE
HANDLER,0
DCA TUN
TAD I HANDLER /GET FUNCTION CONTROL WORD
AND L70 /ISOLATE FIELD OF BUFFER
TAD LCDF
DCA WCDF
TAD I HANDLER /RETRIEVE FUNCTION CONTROL WORD
RAL /READ/WRITE BIT TO LINK
CLA RAL
DCA RW /RW=1 IF WRITE
ISZ HANDLER /POINT TO BUFFER ADDRESS
TAD I HANDLER /GET BUFFER ADDRESS
DCA BUFFER /SAVE IT
ISZ HANDLER /POINT TO ERROR RETURN
TAD TUN
JMS I (FIXDVC
LV /NOT READY
TAD WCDF
DCA BFIELD
TAD WCDF
DCA BFLD
STA CLL RTL /TAD (-3
DCA ERKNT
JMS SETUP /SET UP READ OR WRITE
JMP I (CRET+1
ISZ HANDLER /POINT TO GOOD RETURN
LV, HLT
JMP I HANDLER
RW, 0 /1 IF WRITE (-1 IF UTIL)
ERKNT, -3
SETUP, 0
TAD RW
TAD (WRITEX
DCA I (CRET /SET RETURN ADDRESS
TAD BUFFER
DCA BPTR
TAD BSIZE
CMA /WANT TO READ ONE MORE
TAD RW
DCA BKNT
TAD RW
DCA OUTSW
TAD RW
CLL RTL
RTL /WRITE FN CODE=20
TAD (200 /SELECT AND INTERRUPT ENABLE
JMS I (LOADA
WCDF, HLT
TAD RW
SZA CLA
TAD I BPTR
LCDF, CDF 0
JMS I (GO
JMP I SETUP
READX, JMS I (CHK
AND L374
SZA
JMP ERRX
IOT6C, KGOA /GET CHAR JUST READ
DCA BYTE
ISZ BKNT
SKP
JMP RWCRC
BMODE, TAD BYTE
TUN,
BFLD, HLT
DCA I BPTR
ISZ BPTR
L374, 374
JMP I (CRET+1 /CRET ALREADY SET UP
BSIZE, 200
OUTSW, 0 /1 MEANS WE BEGAN TO WRITE
RWCRC, TAD (260 /ENABLE, ENABLE INTER, READ CRC
JMS I (LOADA
JMS I (GO
JMS I (CRET
JMS I (CHK
CRCMN, JMS I (GO
JMS I (CRET
JMS I (CHECKB
AND (7775 /IGNORE WLO
TAD (-1
ERRX, SNA CLA /ERRORS?
JMP ERRR+1 /NO - CLEAN BILL OF HEALTH
ISZ ERKNT /TRY 3 TIMES
JMP I (ERRCOV /RETRY
ERRR, STA /ERROR WHILE READING CRC
JMS I (CLEAR
TAD I (CINUSE
SMA CLA
JMP LV-1
TAD I (BSTATE
JMP LV
WRITEX, JMP READX
JMS I (CHK
SZA
JMP ERRX
ISZ BKNT
SKP
JMP WCRC
BFIELD, HLT
ISZ BPTR
L70, 70
TAD I BPTR
JMS I (GO
JMP I (CRET+1
WCRC, TAD (260
JMS I (LOADA
JMP CRCMN
BKNT, 0 /NUMBER OF CHARS EXPECTED
BPTR, 0 /NEXT LOCATION IN BUFFER TO STORE INTO
BYTE, 0 /TEMPORARILY HOLDS BYTE FOUND
BUFFER, 0
PAGE
/ LOOKUP, ETC.
F1=10
READ=0
WRITE=4000
REWIND=10
BACKFIL=30
WRGAP=40
BACKBLOCK=50
SKPFIL=70
HSIZE=40
OBUFFER=4600 /LOCATION OF OS/8 I/O BUFFER
BINBUF=OBUFFER
OBUFLEN=3000
HOBUFLEN=OBUFLEN%2
MAXBLK=OBUFLEN%400
FILNUM, 0
/ ENTER
/ TAD UNIT
/ JMS I (ENTER
/ <ERROR RETURN>
/ <NORMAL RETURN>
/ ENTER FILENAME AS SPECIFIED IN SINCH
/ USER MUST SET SINCH BUT ONLY FIRST 25 (OCTAL) LOCATIONS.
ENTER, 0
JMS I (LOOKUP
JMP ERET /ERROR WHILE READING
JMP NTF
JMS I (DELET
JMP ERET /ERROR WHILE DELETING
NTF, JMS BACK
JMP ERET /ERROR BACKING UP
JMS I QH1 /WRITE NEW HEADER
WRITE
SINCH
JMP ERET /CASSETTE NOT READY
TAD I (RECSIZ
DCA I (BSIZE
INCR ENTER
ERET, EXIT ENTER
RDOR, 0
AND (374 /CASSETTE ONLY
TAD (-200
SZA CLA /WAS ERROR JUST CRC?
EXIT BACK /NO
EXIT RDOR /YES, OK CONTINUE
BACK, 0
BK4, JMS I QU1
BK2, BACKFIL /GO BACK TO FILE GAP
EXIT BACK
BK3, JMS I QU1
BACKBLOCK /BACK TO LAST RECORD
JMP BKERR
TAD I (RECSIZ
DCA I (BSIZE
JMS I QH1 /READ LAST RECORD OF PREV FILE
READ+F1 /DON'T STORE IN BUFFER
BINBUF
JMS RDOR /^*******
/ERROR READING LAST BLOCK
NEWGAP, JMS I QU1
WRGAP /WRITE A NEW GAP
EXIT BACK
BK9, TAD (HSIZE
DCA I (BSIZE
INCR BACK
EXIT BACK
BKERR, AND (3775 /CASSETTES ONLY
TAD (-41
SZA CLA /WAS ERROR CLEAR LEADER?
EXIT BACK
JMP NEWGAP
BK1, JMP BK9
/FOR MAGTAPES:
/BK2_BACKBLOCK
/BK3_BK1
CLOSE, 0
JMS I QU1
WRGAP
JMP CLRET /ERROR WHILE WRITING GAP
TAD (HSIZE
DCA I (BSIZE
JMS I QH1
WRITE /WRITE SENTINEL
ZER
JMP CLRET
JMS I QU1
REWIND
JMP CLRET
INCR CLOSE /SKIP ERROR RETURN
CLRET, EXIT CLOSE
CRED, 0
TAD I (INRECSZ
DCA I (BSIZE
TAD I (IUNIT
JMS I QH1
READ
CIBUF
JMP INER
TAD (CIBUF
DCA I (CIPTR
TAD I (INRECSZ
CIA
DCA I (CIKNT
/ CLA IAC
/ DCA DATAFLG
EXIT CRED
INER, AND EOFBIT
SZA CLA /REAL ERROR?
JMP I (XER4 /YES
/ TAD DATAFLG
/ SNA CLA /READ ANY DATA?
/ JMP INTO /NO REWIND
/ DCA DATAFLG /YES, COULD CLOSE OUTPUT AND OPEN NEXT INPUT
INTO, CLA
TAD I (IUNIT
JMS I QU1
REWIND
CLA
TAD I (BIPTR
CIF CDF 10 /NO, MERELY END-OF-FILE
TAD (-OBUFFER+377
CLL RTL
RTL
RAL
AND (17
DCA I (INTEN /NUMBER OF BLOCKS GOT
JMP I (XFIN
LOADA, 0
TAD ABUNIT
IOT4, KLSA
CLA
JMP I LOADA
EOFBIT, 254 /CHANGED TO 3673 FOR MAGTAPE
/DATAFLG,0 /1 MEANS READ DATA
QU1, UTIL
QH1, HANDLER
ABUNIT, 0
PAGE
/ LOOKUP
/ TAD UNIT
/ JMS I (LOOKUP
/ I/O ERROR RETURN
/ <NOT FOUND RETURN>
/ <FOUND RETURN>
/ ALWAYS LOOKS FOR THING SPECIFIED IN SINCH
LOOKUP, 0
DCA P1
CDF 10
TAD I (7644
CDF 0
AND (10 /IS /U SPECIFIED?
SZA CLA
JMP GOODRT /YES, DO NOTHING
TAD P1
JMS I QU2
REWIND
JMP ERRIT
TAD (HSIZE /SET LENGTH OF RECORD HEADER
DCA I (BSIZE
DCA I (FILNUM
FL1, JMP FL2 /ZERO THIS LOCATION FOR MAGTAPES
FLOOP, JMS I QU2
SKPFIL
JMP ERRIT
FL2, INCR I (FILNUM
JMS I QH2
READ
INCH
JMP ERRIT
TAD (INCH
DCA P1
TAD I P1
SNA CLA /SENTINEL FILE?
JMP NFNDRET /YES, NOT FOUND
TAD (SINCH /NO, IS THIS THE ONE WANTED?
DCA P2
TAD (-10
DCA SCNT
SLOOP, TAD I P1
CIA
TAD I P2
AND (177 /ONLY LAST 7 BITS NEED MATCH
SZA CLA
JMP FLOOP /FILE KEY NOT ONE DESIRED
INCR P1
INCR P2
ISZ SCNT
JMP SLOOP
GOODRT, INCR LOOKUP /SKIP NOT FOUND RETURN
NFNDRET,INCR LOOKUP /SKIP ERROR RETURN
ERRIT, CLA
TAD I (RECSIZ
DCA I (BSIZE /BE NICE TO USER
LRET, EXIT LOOKUP /BYE-BYE
ERRT, AND EOTBIT /REAL ERROR?
SZA CLA
JMP ERRIT /YES
JMP NFNDRET /NO, MERELY END-OF CASSETTE
/END OF CASSETTD IS SIGNALLED BY
/A SENTINEL FILE
/B DOUBLE FILE GAP
/C EOT
EOTBIT, 314 /CHANGE TO 3663 FOR MAGTAPE
P1, 0
P2, 0
SCNT, 0
DELET, 0
JMS I (BACK
EXIT DELET
JMS I QH2 /WRITE EMPTY HEADER
WRITE+10
EMPTINCH
EXIT DELET /ERROR WHILE DELETING
CLL STA RAL /-2
TAD LOOKUP
DCA LOOKUP
JMP FLOOP /JUMP INTO LOOKUP TO CONTINUE
ZER, 0
QH2, HANDLER
QU2, UTIL
FL3, JMP FL2
ERRCOV, JMS I (CLEAR
JMS I (CTRLC
TAD (250
JMS I (LOADA
JMS I (GO /BACKSPACE BLOCK
JMS I (CRET /WAIT
JMS I (CHECKB
AND (374 /KILL WRITE-LOCK BIT
SZA CLA
JMP I (ERRR
JMS I (SETUP /RE-SET UP OPERATION
JMP I (CRET+1 /GO AWAY
TIMEOUT,0
ISZ INNER
JMP I TIMEOUT
ISZ OUTER
JMP I TIMEOUT
TAD I (RW / I/O HAS TAKEN A LOT OF TIME
SZA CLA /IS IT A READ OP?
JMP I TIMEOUT /NO, RETURN
JMP I (ERRR /YES, ERROR
INNER, 0
OUTER, -200
PAGE
/SEND CONTENTS OF OS/8 BUFFER TO CASSETTE
/VIA CASSETTE OUTPUT BUFFER
CWRITE, 0
TAD (OBUFFER
DCA BUPTR /PT TO BEGIN OF BUFFER
CDF 10
TAD I (INTEN /GET NO. OF BLOCKS READ
SNA
JMP CWLV
CDF 0
CLL RTR
RTR
RAR /CONVERT TO WORDS
IAC
AND (7776 /ROUND UP TO EVEN NO.
CLL RAR /DIVIDE BY TWO
CIA /USE AS COUNT OF DOUBLE-WORDS
DCA BUKNT /2000 TWO-WORD ENTRIES
CWLOOP, CDF 10
TAD I BUPTR
JMS CWR /SENT TO CASSETTE OUTPUT BUFFER
CDF 10
TAD I BUPTR
AND (7400
DCA TEMP1
INCR BUPTR /PT TO 2ND HALF
TAD I BUPTR
JMS CWR
CDF 10
TAD I BUPTR
AND (7400
CLL RTR
RTR
TAD TEMP1
RTR
RTR
JMS CWR
INCR BUPTR /PT TO NEXT DOUBLE-WORD
ISZ BUKNT /AT END OF BUFFER?
JMP CWLOOP /NO
CWLV, CIF CDF 10
EXIT CWRITE /YES, RETURN
BUPTR, 0 /PTS INTO OBUUFER
BUKNT, 0
/INSERT CHAR IN CASSETTE OUTPUT BUFFER
/AND OUTPUT BUFFER IF BUFFER FULL
CWR, 0
AND (377
CDF 0
DCA CWTMP
TAD LDRFLG
SZA CLA
JMS I (LDRTST
CDF 10
TAD I (7643
RTL /PUT /B OPTION IN LINK
CDF 0
SNL CLA
JMP GOK
TAD CWTMP
TAD M200
SNA CLA
JMP I (PREFIN
GOK, TAD CWTMP2
JMS CWR2
TAD CWTMP1
DCA CWTMP2
TAD CWTMP
DCA CWTMP1
CWREX, EXIT CWR
CWR2, 0
SPA
JMP CWRIGN /IGNORE -1
CDF 0
DCA I COPTR /INSERT CHAR IN COBUF
INCR COPTR
ISZ COKNT /COBUF FULL?
EXIT CWR2 /NO, SO RETURN
JMS CWRI
M200,
CWRIGN, 7600 /CLA
EXIT CWR2
CWRI, 0
TAD COKNT
TAD RECSIZ
SNA CLA
EXIT CWRI /DO NOTHING IF BUFFER EMPTY
TAD RECSIZ
DCA I (BSIZE
TAD I (OUNIT
JMS I QH3 /YES, WRITE OUT BUFFER
WRITE /WRITE FROM FIELD 0
PCOBUF, COBUF /LOCATION COBUF
JMP XER7 /OUTPUT ERROR
TAD PCOBUF
DCA COPTR /BUFFER IS NOW EMPTY
TAD RECSIZ
CIA
DCA COKNT
EXIT CWRI
RECSIZ, 0 /RECORD SIZE ON OUTPUT
COPTR, COBUF /PTS TO NEXT FREE LOCATION IN COBUF
COKNT, -1000 /NUMBER OF EMPTY SLOTS LEFT IN COBUF
XER7, CIF CDF 10
AND (40
SZA CLA /CLEAR LEADER?
JMP I (ER5 /YES, DEVICE FULL
JMP I (ER7 /OUTPUT ERROR
XER4, CIF CDF 10
JMP I (ER4
XER8, CIF CDF 10
JMP I (ER8
LDRFLG, 0 /NON-ZERO IF IGNORING LEADER
CWTMP1, -1
CWTMP2, -1
CWTMP, 0
QH3, HANDLER
PAGE
PREFIN, TAD (200
JMS I (CWR2 /WRITE OUT TRAILER
JMP CFIN2 /BUT NO CHECKSUM
CFIN, TAD I (CWTMP1
JMS I (CWR2
TAD I (CWTMP
JMS I (CWR2
CFIN2, JMS I (CWRI
TAD I (OUNIT
XCLOSE, JMS I (CLOSE
JMP I (XER8
XLV, CIF CDF 10
JMP I (DECODE
CTRTEM,
CREAD, 0
TAD (OBUFFER
DCA BIPTR
TAD (-OBUFLEN
DCA BIKNT
ZRLUP, CDF 10
DCA I BIPTR /ZERO BUFFER
CLA IAC
AND I (7643
SZA CLA
TAD (DCRE-CRE /GOT L OPTION
TAD (CRE
CDF 0
DCA XCRE /PT TO INPUT SUBR
INCR BIPTR
ISZ BIKNT
JMP ZRLUP
TAD (OBUFFER
DCA BIPTR
TAD (-HOBUFLEN
DCA BIKNT /# OF DOUBLE-WORDS
CRLOOP, JMS I XCRE
CDF 10
DCA I BIPTR
JMS I XCRE
DCA TEMP2
JMS I XCRE
DCA TEMP3
CDF 10
TAD TEMP3
RTL
RTL
AND (7400
TAD I BIPTR
DCA I BIPTR
INCR BIPTR
TAD TEMP3
RTR
RTR
RAR
AND (7400
TAD TEMP2
DCA I BIPTR
INCR BIPTR
ISZ BIKNT
JMP CRLOOP /REITERATE
CIF CDF 10
TAD (MAXBLK
DCA I (INTEN /READ 10 BLOCKS
EXIT CREAD /ALL DONE
BIPTR, 0 /PTS INTO OBUFFER
BIKNT, 0
XCRE, CRE
CTRLC, 0
KSF
EXIT CTRLC
TAD (7600
KRS
TAD (-7603
SZA CLA
EXIT CTRLC
JMS I (CLEAR
TAD I (OUNIT
SPA CLA
JMP I (7600
TAD I (OUNIT
DCA CTRTEM
STA
DCA I (OUNIT
TAD CTRTEM
JMS I (CLOSE
JMP I (XER8
JMP I (7600
LOPTION,TAD I (IUNIT
JMS I QU3
REWIND
JMP I (INER
CLA IAC
DCA I (CIBUF
LM1, JMP LM2 /ZERO FOR MAGTAPE
JMS I QU3
SKPFIL
JMP I (INER
LM2, CIF CDF 10
JMP I (CHLOOP
LM3, JMP LM2
QU3, UTIL
PAGE
CIKNT, -1 /ONE'S COMPLEMENT OF # OF BYTES LEFT IN CIBUF
CIPTR, CIBUF /PTS TO NEXT BYTE IN CIBUF TO BE READ
CRE, 0
CDF 0
TAD FTFLG /FIRST TIME THROUGH?
SZA CLA
JMP FT /YES
TAD TLRFLG
SNA CLA
JMP EPI /TRAILER
ISZ CIKNT
SKP
JMS I (CRED
TAD I CIPTR
JMS CHKSUM
JMS CHKTLR
TAD I CIPTR
INCR CIPTR
/ AND (377
EXIT CRE
/READ DIRECTORY
DCRE, 0
CDF 0
ISZ CIKNT
SKP
JMS DCRED
TAD I CIPTR
TAD (-32
SNA
JMP DCRE+1 /ALLOW '32' TO SHORTEN BUFFER
TAD (32
SNA
TAD (232
INCR CIPTR
EXIT DCRE
FT, DCA FTFLG
TAD (200 /SEND LEADER
EXIT CRE
CHKSUM, 0
DCA CHTEM
TAD CHTEM
AND (200
SNA CLA
TAD CHTEM
TAD CHECKSUM
DCA CHECKSUM
EXIT CHKSUM
CHTEM, 0
CHECKSUM,0
FTFLG, 1 /1 IF FIRST TIME HERE
CHKPTR, CHKTBL
TLRFLG, 0
CHKTBL, 0 /CHECKSUM LEFT PART
0 /CHECKSUM RIGHT PART
200 /TRAILER
32 /CTRL/Z
-1 /TABLE END
CHKTLR, 0
CDF 10
TAD I (7643
CDF 0
RTL /B SWITCH TO LINK
SNL CLA
EXIT CHKTLR
TAD I CIPTR
TAD (-200
SZA CLA
EXIT CHKTLR
DCA TLRFLG
TAD (CHKTBL
DCA CHKPTR
TAD CHECKSUM
RTR
RTR
RTR
AND (77
DCA CHKTBL
TAD CHECKSUM
AND (77
DCA CHKTBL+1
EPI, TAD I CHKPTR
SPA
JMP I (INTO
INCR CHKPTR
EXIT CRE
DCRED, 0
TAD (40
DCA I (BSIZE
TAD I PCIBUF
SNA CLA
JMP I (INTO
TAD I (IUNIT
JMS I QH4
READ
PCIBUF, CIBUF
JMP I (INER
TAD PCIBUF
DCA CIPTR
TAD I CIPTR
SZA CLA
TAD (-23
TAD (-2
DCA CIKNT
JMS I (FIDDLE
TAD I CIPTR
SNA CLA
EXIT DCRED
JMS I QU4
SKPFIL
JMP I (INER
EXIT DCRED
QH4, HANDLER
QU4, UTIL
/THIS WAS VERY UNOPTIMAL ADDING IN MAGTAPE SUPPORT
/AFTER THE PROGRAM WAS ALL DONE AND BURIED.
/IT COULD HAVE BEEN DONE IN A MUCH BETTER METHOD
/IF IT WAS DESIGNED IN BEFORE THE PROGRAM WAS WRITTEN.
PAGE
/FIRST ARG: PTS TO OS/8 FILENAME IN FIELD 1
CONVRT, 0
STA
TAD I CONVRT
DCA ONPTR
INCR CONVRT
TAD (SINCH
DCA CNPTR
TAD (-4
DCA CKNT
CONLUP, CDF 10
INCR ONPTR
TAD I ONPTR
CDF 0
RTR
RTR
RTR
JMS CNV
DCA I CNPTR
INCR CNPTR
CDF 10
TAD I ONPTR
CDF 0
JMS CNV
DCA I CNPTR
INCR CNPTR
ISZ CKNT
JMP CONLUP
TAD (40
DCA I CNPTR
CDF 10
TAD I (7643
CDF 0
RTL
SNL CLA
EXIT CONVRT / NOT /B
CDF 10
TAD I (7643
RAL
CLA
TAD I ONPTR
CDF 0
SZA CLA
EXIT CONVRT /EXTENSION SPECIFIED
SZL
EXIT CONVRT / /A
CLL STA RAL
TAD CNPTR
DCA CNPTR
TAD ("B /SET EXTENSION TO .BIN
DCA I CNPTR
INCR CNPTR
TAD ("I
DCA I CNPTR
INCR CNPTR
TAD ("N
DCA I CNPTR
EXIT CONVRT
CNV, 0
AND (77
SZA /CHANGE 0 TO BLANK
TAD (40
AND (77
TAD (40
EXIT CNV
ONPTR, 0
CNPTR, 0
CKNT, 0
LOOK4ME,JMS CONVRT
7606
TAD IUNIT
JMS I (LOOKUP
JMP I (XER4
JMP XER24
TAD I (INCH+12 /GET H.O. INPUT RECORD SIZE
CLL RTR
RTR
RAR
TAD I (INCH+13
DCA INRECSZ
TAD INRECSZ
SNA
JMP XER40 /RECORD SIZE 0
CLL
TAD (-1001
SZL CLA
JMP XER10
CIF CDF 10
JMP I (CHLOOP
XER24, CIF CDF 10
JMP I (ER24
XER25, CIF CDF 10
JMP I (ER3
OUNIT, 0
IUNIT, 0
/IN CASE OF CASSETTES, CONTAINS UNIT (AS CHAR)
/IN CASE OF MAGTAPE, CONTAINS HANDLER ENTRY ADDRESS
/OUNIT IS -1 DURING A ^C CLOSE
/-1 MEANS DON'T CLOSE ON ERROR
INRECSZ,200 /RECORD SIZE ON INPUT
XER40, CIF CDF 10
JMP I (ER40
XER10, CIF CDF 10
JMP I (ER10
F1CTRLC,0
JMS I (CTRLC
CIF CDF 10
EXIT F1CTRLC
PAGE
SINCH, ZBLOCK 16
40;40;40;40;40;40
ZBLOCK 14
INCH, ZBLOCK 40
LDRTST, 0
TAD I (CWTMP
TAD (-200
SNA CLA /LEADER?
JMP I (CWREX /YES, EXIT CWR
DCA I (LDRFLG /NO
EXIT LDRTST
ENTERO, TAD (COBUF
DCA I (COPTR
JMS I (CONVRT
7601
JMS I (MAKDAT
TAD I (RECSIZ
CLL RTL
RTL
RAL
AND (17
DCA I (SINCH+12
TAD I (RECSIZ
AND (377
DCA I (SINCH+13
CDF 10
TAD I (FILTYP
CDF 0
DCA I (SINCH+11
DCA I (SINCH+14
DCA I (SINCH+15
CDF 10
TAD I (VRSNO
CDF 0
DCA I (SINCH+24
TAD I (OUNIT
JMS I (ENTER
JMP I (XER25
CIF CDF 10
DCA I (OSWITCH
JMP I (CONT1
PAGE
ZOPTION,TAD I (OUNIT
JMS I QU5
REWIND
JMP XER77 /OUTPUT ERROR
CDF 10
TAD I (7601
CDF 0
SNA CLA
JMP NOFILE
JMS I (CONVRT
7601
JMS I (LOOKUP
JMP I (XER4
JMP I (XER24
JMS I QU5
SKPFIL
JMP I (XER24
TAD (40
DCA I (BSIZE
JMS I QH5
READ
INCH
JMP XER77
CLO3, JMS I (BACK
JMP XER77
JMS I QH5
WRITE
ZER
JMP XER77
NOFILE, JMP I (XCLOSE
MAKDAT, 0
CDF 10
TAD I (DATE
CDF 0
SNA
JMP SETOBL
DCA SKNT
TAD (SINCH+16
DCA SPTR
TAD SKNT
RTR
RAR
AND (37
JMS TWO /INSERT DAY
TAD SKNT
RTL
RTL
RAL
AND (17
JMS TWO /INSERT MONTH
TAD SKNT
AND (7
TAD (106
JMS TWO /INSERT YEAR
EXIT MAKDAT
SETOBL, TAD (-6 /SET DATE TO BLANKS
DCA SKNT
TAD (SINCH+16
DCA SPTR
SELOOP, TAD (40
DCA I SPTR
INCR SPTR
ISZ SKNT
JMP SELOOP
EXIT MAKDAT
SPTR, 0
SKNT, 0
TEM2, 0
TENS, 0
TWO, 0
DCA TEM2
TAD (60
DCA TENS
TAD TEM2
TWOLUP, TAD (-12
SPA
JMP NEG
INCR TENS
JMP TWOLUP
NEG, TAD (72
DCA TEM2
TAD TENS
DCA I SPTR
INCR SPTR
TAD TEM2
DCA I SPTR
INCR SPTR
EXIT TWO
XER77, CIF CDF 10
JMP I (ER7 /OUTPUT ERROR
QU5, UTIL
QH5, HANDLER
MHANDLER,0 /AC CONTAINS HANDLER ENTRY ADDRESS
CIF 10
JMP I (MHAN /KLUDGEY LINK TO FIELD 1
MUTIL, 0 /AC CONTAINS ETC.
CIF 10
JMP I (MUT
PAGE
FIELD 1
XR=10
*2000
START, JMP DEC2 /NORMAL STARTING ADDRESS
CHAIN, JMP NODEC /CHAIN STARTING ADDRESS
DECODE, STL CLA RAR
AND I (7642
SZA CLA
JMP KBM /RETURN TO KBM ON $
/ WOULD BE NICE HERE TO TELL CD/BATCH NOT TO SPOOL
DEC2, CALL (200
5 /COMMAND DECODE
5200 /USING SPECIAL MODE
NODEC, TAD (OUTHAND+1
DCA ENTR /RESET PTR TO HANDLER LOCATION
STA
DCA I (OSWITCH
JMS I (CHKSW /CHECK FOR SWITCH OPTIONS
CDF 0
DCA I (OUTSW
STA
DCA I (OUNIT
CDF 10
TAD I (7666
DCA I (DATE
FET, TAD I (7600 /GET DEVICE NUMBER OF OUTPUT FILE
SNA /WAS ONE SPECIFIED?
JMP NOF /NO - NO OUTPUT FILE
CALL (200
1 /FETCH HANDLER
ENTR, OUTHAND+1 /INTO PAGES 2400 AND 2600
/REPLACED BY HANDLER STARTING ADDRESS
JMP I (ER6 /OUTPUT DEVICE DOESN'T EXIST
TAD I (7644
AND (1000
SZA CLA
JMP I (FOXOUT /O SPECIFIED
STL CLA RTR
AND I (7645
TAD I (7601
SNA CLA
JMP NOCAS /NO OUTPUT NAME
TAD (7600
JMS I (CHKNAM
JMP I (STARER /*.*
TAD I (7600
JMS I (TCAS /CASSETTE?
JMP I (FIXOUT /YES
JMP I (FXMOUT /MAGTAPE
NOCAS, TAD (7601 /NO
DCA OBLK /GET PTR TO OUTPUT FILE NAME
TAD ENTR
DCA I (OENTRY /STORE AWAY OUTPUT HANDLER ENTRY PT
TAD (OWRITE
DCA PWRITE
TAD (FINIO
DCA I (XFINIO
TAD I (7643
RTL
SNL CLA
JMP NOB
TAD I (7604 /GET EXT
SZA CLA
JMP NOB
TAD (216 /SET TO .BN
DCA I (7604
NOB, TAD I (7600 /GET DEVICE NUMBER AGAIN
CALL (200
3 /OPEN OUTPUT FILE
OBLK, 7601 /PTS TO OUTPUT FILE NAME
/REPLACED BY STARTING BLOCK NUMBER
LEN, 0 /REPLACED BY NEGATIVE OF LENGTH OF OUT AREA
JMP I (ER3 /FILE OPEN ERROR
DCA I (REALEN /ZERO REAL LENGTH
TAD OBLK
DCA I (OBLOCK /SET STARTING BLOCK NUMBER
CONT1, JMS I (GETIN
/ INITIALIZE INPUT STUFF
CHLOOP, CIF CDF 0
JMS I (F1CTRLC
CALL PREAD
CIF CDF 0
JMS I (F1CTRLC
CALL PWRITE
JMP CHLOOP
PREAD, OREAD
PWRITE, OWRITE
NOF, STL CLA RTR
AND I (7645
SNA CLA
JMP I (ER1
JMP I (FOXOUT /Z IMPLIES O
KBM, CIF CDF 0
JMP I (7605
PAGE
UDIG, 0
GETSWDIG,0
DCA UDIG
TAD I (7645
AND (1774
SNA
EXIT GETSWDIG /NO UNIT
INCR GETSWDIG
RTL
RAL
LUDIG, SZL
JMP GOTUD
INCR UDIG
RAL
JMP LUDIG
G7600,
GOTUD, 7600
TAD UDIG
TAD (60
EXIT GETSWDIG
FOXOUT, JMS GETSWDIG
JMP I (ER1 /NO OUTPUT UNIT
JMP GOTOU
FIXOUT, TAD I (ENTR
JMS I (GETDVC
GOTOU, CDF 0
DCA I (OUNIT
CDF 10
JMS I (SETCAS
YAHAOU, TAD I (7643
AND (400
SZA CLA
JMP DOPT
STL CLA RTR
AND I (7645
SZA CLA
JMP ZOPT
TAD I G7600
RTR
RTR
AND (377 /ISOLATE FILE TYPE
DCA FILTYP /SAVE IT
JMS I (GETLEN
TAD (CW
DCA I (PWRITE
TAD (CFINIO
DCA I (XFINIO
TAD I (7643
RTL /B TO LINK
SZL CLA
CLA IAC
CIF CDF 0
DCA I (LDRFLG
STA
DCA I (CWTMP1
STA
DCA I (CWTMP2
DCA I (CHECKSUM
JMP I (ENTERO
/ RETURN TO CONT1
FXMOUT, TAD I (ENTR
CDF 0
DCA I (OUNIT
CDF 10
JMS I (SETMAG
TAD I (ENTR /GET LOCATION OF MAGTAPE HANDLER
JMS SETDEN
JMP YAHAOU
SETDEN, 0
AND G7600
DCA MTA
TAD I (7644
AND (10
SZA CLA /IS /U SPECIFIED?
IAC /YES, USE DENSITY 3
TAD (2 /NO, USE DENSITY 2
DCA DEN
CDF 0
TAD PARITY
CLL RAR /LINK ON IF PARITY SPECIFIED
SZL
TAD PAR
SNL
TAD I MTA /GET RELATIVE LOC 0
AND (400 /ISOLATE PARITY
TAD DEN /FORCE CORE DUMP MODE
DCA I MTA /STORE BACK DENSITY AND PARITY
CDF 10
JMP I SETDEN
FILTYP, 0
BINTYP, 0 /SET BINARY TYPE - DON'T TOUCH LINK
IAC
IAC
DCA FILTYP
EXIT BINTYP
DOPT, CIF CDF 0
JMP I (DOPTION
ZOPT, CIF CDF 0
JMP I (ZOPTION
MTA, 0 /FIRST LOC OF MAGTAPE HANDLER
PARITY, 0 /0 MENAS NOT SPECIFIED, 1 MEANS SPECIFIED PARITY
PAR, 0 /0 OR 400 SPECIFYING PARITY
DEN, 2 /DENSITY
PAGE
FID2, 0
TAD I (CIBUF
AND (177 /DF=0
TAD (-52
SNA CLA
JMS EMPTY
TAD I (CIBUF+10
DCA I (CIBUF+11
TAD I (CIBUF+7
DCA I (CIBUF+10
TAD I (CIBUF+6
DCA I (CIBUF+7
TAD (".
DCA I (CIBUF+6
CIF 0
JMP I FID2
EMPTY, 0
TAD I (FAST
SNA CLA
JMP I EMPTY
STA
DCA I (CIKNT
TAD (32
DCA I (CIBUF
CIF 0
JMP I (FIDLV
GETLEN, 0
CLL STA RAR /3777
AND I (7642 /GET H.O. OPTION
DCA VRSNO
TAD I (7646 /GET = OPTION (L.O. 12 BITS)
CLL
TAD (-1001
SZL CLA /LESS THAN 1001?
JMP I (ER10 /NO, ERROR
TAD I (7646 /YES
SNA
TAD (200 /200 IS DEFAULT RECORD SIZE
CDF 0
DCA I (RECSIZ
TAD I (RECSIZ
CIA
DCA I (COKNT
CDF 10
EXIT GETLEN
FINIO, JMS I (OWRITE
TAD I (7600 /GET OUTPUT DEVICE NUMBER
CALL (200
4 /CLOSE
7601 /PTR TO FILE NAME
REALEN, 0 /LENGTH OF NEW OUTPUT FILE
JMP ER8 /CLOSE ERROR
JMP I (DECODE
ER8, JMS I (PRINT
TEXT /?CLOSE ERROR/
ER5, JMS I (PRINT
TEXT /?OUTPUT DEVICE FULL/
ER30, JMS I (PRINT
TEXT /?OUT=IN/
VRSNO, 0
PAGE
OREAD, 0
TAD (MAXBLK
DCA INTEN /TRY TO READ 10 BLOCKS
TAD (MAXBLK^200+10
DCA READSZ
TAD I (7605
AND (17
TAD (7757
DCA TEMP /GET DCB ADDR
TAD I TEMP /GET DCB
AND (1000
SZA CLA
JMP ER4 /INPUT DEVICE IS WRITE-ONLY
TAD I TEMP
SMA CLA
JMP YES /NOT FILE-STRUCTURED
TAD I (INLEN
TAD (MAXBLK
SMA SZA CLA /CAN I READ IN 10 BLOCKS?
JMS SHORT /NO
YES, CIF 0 /YES
JMS I IENTRY /CALL INPUT HANDLER
READSZ, 2010 /READ 20 PAGES INTO FIELD 1
OBUFFER /LOCATION 4000
IBLOCK, 0 /INPUT BLOCK NUMBER
JMP QER4 /INPUT ERROR
TAD IBLOCK
TAD INTEN
DCA IBLOCK /UPDATE BLOCK NUMBER
TAD I (INLEN
TAD INTEN
DCA I (INLEN /UPDATE LENGTH LEFT
TAD INTEN
TAD (-MAXBLK
SZA CLA
JMP XFIN
EXIT OREAD /RETURN
INTEN, 10 /NUMBER OF BLOCKS JUST READ
XFINIO, FINIO
SHORT, 0
TAD I (INLEN /HOW MANY BLOCKS LEFT?
CIA /MAKE POSITIVE
DCA INTEN /THAT'S AS MUCH AS WE CAN READ
TAD INTEN
SNA
XFIN, JMP I XFINIO /NO MORE
CLL RTR
RTR
RTR /CONVERT TO PAGES IN BITS 1-5
TAD (10 /ADD IN FIELD 1 BIT
DCA READSZ
EXIT SHORT /RETURN
IENTRY, 0 /PTS TO INPUT HANDLER ENTRY POINT
QER4, SMA CLA
JMP SFIN /NON-FATAL END-OF FILE
ER4, JMS I (PRINT
TEXT /?INPUT ERROR/
ER26, JMS I (PRINT
TEXT /?TOO MANY FILES/
SFIN, TAD (7600
DCA TPTR
SLUP, STA
TAD TPTR
DCA TPTR
TAD I TPTR
SNA CLA
JMP SLUP
TAD TPTR
TAD (-OBUFFER+1
SNA
JMP ALLZ
TAD (377 /CHANGED FROM PIPC'S 376
CLL RTL
RTL
RAL
AND (17
DCA INTEN
JMP XFIN
ALLZ, CLA IAC
JMP .-3
TPTR, 0
ER3, JMS I (PRINT
TEXT /?ENTER ERROR/
PAGE
GETIN, 0 /OPEN INPUT FILE
DCA DATE
TAD I (7605 /ANY MORE FILES SPECIFIED?
SNA CLA
JMP NOIN /NO
TAD I (7612
SZA CLA
JMP I (ER26 /2ND INPUT FILE IS BAD
TAD (7605
JMS I (CHKNAM
JMP I (STARER /*.*
TAD (7606
DCA IN /SET PTR TO FILE NAME
TAD (INHAND+1
DCA IN3
TAD I (7605 /GET DEVICE NUMBER
CALL (200
1 /FETCH NEW DEVICE HANDLER
IN3, INHAND+1 /INTO PAGES 3200 AND 3400
/REPLACED BY ENTRY PT TO INPUT HANDLER
JMP ER6 /FETCH ERROR
TAD I (7643
AND (10
SZA CLA
JMP I (FOXIN /I SPECIFIED
TAD I (7606
SNA CLA
JMP NOCAS2
FIXASS, TAD I (7605
JMS I (TCAS /CASSETTE?
JMP I (FIXIN /YES
JMP I (FIXMIN /MAGTAPE
/**** FIX BETTER THAN THIS. IT WILL CAUSE /L TO HANG ON REG HANDLER
NOCAS2, CLA IAC
AND I (7643
SZA CLA
JMP FIXASS
TAD (OREAD
DCA I (PREAD
TAD IN3 /GET NEW HANDLER ENTRY PT
DCA I (IENTRY /STORE AWAY
TAD I (7605 /GET DEVICE NUMBER AGAIN
CALL (200
2 /PERFORM A LOOKUP
IN, 0 /PTR TO FILE NAME
/REPLACED BY INPUT BLOCK NUMBER
IN2, 0 /REPLACED BY NEGATIVE OF INPUT FILE LENGTH
JMP LKERR /LOOKUP ERROR
TAD IN /GET NEW INPUT BLOCK
DCA I (IBLOCK /STORE AWAY
TAD IN2 /GET NEW INPUT FILE LENGTH
DCA INLEN
TAD I (1404 /GET # OF ADDITIONAL WORDS
SNA
JMP NONE
TAD 17
DCA POINTER
TAD I POINTER /GET FILE CREATION DATE
SNA
JMP NONE
SETDAT, DCA DATE
EXIT GETIN
NONE, TAD I (7666 /USE TODAY'S DATE
JMP SETDAT
LKERR, CLA
TAD I (7611
SZA CLA
JMP ER24 /FILE NOT FOUND
TAD I (7643 /TRY .BN
RTL
SNL CLA
JMP ER24 / NOT /B
TAD (216
DCA I (7611
JMP GETIN+1
INLEN, 0
DATE, 0 /OS8 DATE OF INPUT FILE
POINTER,0
NOIN, CLA IAC
AND I (7643
SNA CLA
JMP I (ER21
JMP I (FOXIN / /L SPECIFIED
ER6, JMS I (PRINT
TEXT /?FETCH ERROR/
ER24, STA
DCA I (SPSWTCH /RETURN FROM PRINT
JMS I (PRINT
TEXT /?FILE NOT FOUND/
ISZ I (FUDSW /FIXUP CASSETTE
JMP I (CLO
PAGE
/ENTER WITH INTEN BLOCKS TO WRITE
OWRITE, 0
TAD I (INTEN /HOW MUCH IS THERE TO WRITE?
SNA
EXIT OWRITE /NOTHING
DCA OUTEN /SAVE NUMBER OF BLOCKS TO WRITE
TAD I (7600
AND (17
TAD (7757
DCA TEMP
STL CLA RTR
AND I TEMP
SZA CLA
JMP I (ER7 /OUTPUT DEVICE IS READ-ONLY
TAD OUTEN
CLL RTR
RTR
RTR /CONVERT TO PAGES
TAD (4010 /FIELD 1 (WRITE DIRECTLY FROM INPUT BUFFER)
DCA WRSIZ
TAD I (LEN
SNA CLA
JMP NFS /NON-FILE STRUCTURED
TAD I (REALEN
TAD OUTEN
STL
TAD I (LEN
SNL SZA CLA
JMP I (ER5
NFS, CIF 0
JMS I OENTRY /CALL OUTPUT HANDLER
WRSIZ, 6010 /WRITE 20 PAGES FROM FIELD 1
OBUFFER /LOCATION 4000
OBLOCK, 0 /OUTPUT BLOCK NUMBER
JMP I (ER7 /OUTPUT ERROR
TAD OBLOCK
TAD OUTEN
DCA OBLOCK /UPDATE OUTPUT BLOCK NUMBER
TAD I (REALEN
TAD OUTEN
DCA I (REALEN /UPDATE LENGTH WROTE
EXIT OWRITE
OENTRY, 0
OUTEN, 0
FOXIN, JMS I (GETSWDIG
JMP I (ER21
JMP GOTIU
FIXIN, TAD I (IN3 /GET INPUT HANDLER ADDRESS
JMS I (GETDVC
GOTIU, CDF 0
DCA I (IUNIT
CDF 10
JMS I (SETCAS
YAHAIN, CDF 0
TAD I (OUNIT
CIA
TAD I (IUNIT
SNA CLA
JMP I (ER30
STA
DCA I (CIKNT
DCA I (CHECKSUM
CLA IAC
DCA I (TLRFLG
CDF 10
TAD (CR
DCA I (PREAD
TAD I (7643
RTL
CLA RAL
CDF 0
DCA I (FTFLG
CDF 10
JMS I (GETLEN
TAD I (7643
AND (100 / F OPTION?
CDF 0
DCA I (FAST
CDF 10
CLA IAC
AND I (7643
CIF CDF 0
SZA CLA
JMP I (LOPTION
JMP I (LOOK4ME
/RETURN TO CHLOOP
FIXMIN, TAD I (IN3
CDF 0
DCA I (IUNIT
CDF 10
JMS I (SETMAG
TAD I (IN3
JMS I (SETDEN
JMP YAHAIN
PAGE
PRINT, 0
CLA
CDF 10
DCA CTOFLG /ALLOW ECHOING
JMS CRLF
PRLUP, TAD I PRINT
RTR
RTR
RTR
JMS PRIN
TAD I PRINT
JMS PRIN
INCR PRINT
JMP PRLUP
PRIN, 0
AND (77
SNA
JMP PRFIN
TAD (240
AND (77
TAD (240
DCA TM
KSF
JMP NOBOTH
TAD (200
KRS
TAD (-203
SNA
JMP KBM2
TAD (203-217
SZA CLA
JMP NOBOTH
TAD ("^
JMS TYPE
TAD ("O
JMS TYPE
JMS CRLF
ISZ CTOFLG
NOBOTH, TAD TM
JMS TYPE
EXIT PRIN
PRFIN, JMS CRLF
DCA FUDSW
TAD I (SPSWTCH
SNA CLA
JMP CLO
DCA I (SPSWTCH /SWITCH NON-ZERO MEANS RETURN
INCR PRINT /POINT TO RETURN
JMP I PRINT
/DO A CLOSE IF OUTPUT CASSETTE OPEN
CLO, CDF 0
TAD I (OUNIT
CDF 10
SPA CLA
JMP I (DECODE
TAD OSWITCH
SZA CLA
JMP I (DECODE
CDF 0
TAD I (OUTSW
CDF 10
SNA CLA /DID WE WRITE ON OUTPUT CASSETTE?
JMP I (DECODE /NO
CIF CDF 0
TAD I (OUNIT
DCA TEMP
STA
DCA I (OUNIT
TAD FUDSW
SZA CLA
JMP I (CLO3
TAD TEMP
JMP I (XCLOSE
OSWITCH,-1 /0 MEANS OUTPUT CASSETTE OPEN
KBM2, CIF CDF 0
JMP I L7600 /RETURN TO OS/8
FUDSW, 0 /1 MEANS GOT OS/8 LOOKUP FAILURE
TYPE, 0
DCA TM
TAD CTOFLG
SZA CLA
EXIT TYPE /NOT ECHOING
TAD TM
TLS
TSF
JMP .-1
L7600, 7600
EXIT TYPE
CRLF, 0
TAD (215
JMS TYPE
TAD (212
JMS TYPE
EXIT CRLF
CTOFLG, 0 /1 MEANS DON'T ECHO
TM, 0
ER7, JMS PRINT
TEXT /?OUTPUT ERROR/
CFINIO, CIF CDF 0
JMS I (CWRITE
CIF CDF 0
JMP I (CFIN /FINISH OUTPUT AND WRITE SENTINEL
/RETURN TO DECODE
PAGE
ER10, JMS I (PRINT
TEXT /?RECORD SIZE TOO BIG/
/ENTRY POINT REL 1: UNIT 1
/ENTRY POINT REL 7: UNIT 0
GETDVC, 0
IAC
DCA TEMP
STL CLA RTL /2
AND TEMP
RAR
DCA UNIT /DETERMINE IF UNIT 0 OR 1
TAD TEMP
AND (7600
DCA TEMP
CDF 0
LOOKIO, ISZ TEMP
TAD I TEMP /SEARCH HANDLER FOR ANY IOT
AND (7700
TAD (-6700
SZA CLA
JMP LOOKIO
TAD I TEMP /GET CASSETETE IOT
CDF 10
AND (30 /V3 BUG FIX FROM V2
CLL RTR
TAD UNIT
TAD (60
EXIT GETDVC /LEAVE IT IN AC
UNIT, 0
CHKNAM, 0 /DON'T ALLOW *'S OR ?'S
DCA XR /IN OUTPUT OR INPUT NAME
TAD I XR
TAD (-5200
SNA
JMP STARNM /ENTIRE NAME IS *
TAD (5200
JMS CHKSTR
TAD I XR
JMS CHKSTR
TAD I XR
JMS CHKSTR
TAD I XR
JMS CHKSTR
ISZ CHKNAM
JMP I CHKNAM /NAME GOOD, RETURN 2
CHKSTR, 0
DCA TEM
TAD TEM
CLL RTR
RTR
RTR
JMS CHC
TAD TEM
JMS CHC
JMP I CHKSTR
CHC, 0
AND (77
TAD (-52
SNA
JMP STARER /* IN NAME
TAD (52-77
SZA CLA
JMP I CHC /OKAY
STARER, JMS I (PRINT
TEXT /?ILLEGAL * OR ?/
STARNM, ISZ XR
ISZ XR
TAD I XR
TAD (-5200
SZA CLA
JMP STARER /NOT *.*
JMP I CHKNAM /TAKE SPECIAL RETURN ON *.*
TEM, 0
CHKSW, 0 /CHECK SWITCHES
TAD I (7644
AND (4 /CHECK FOR /V
SZA CLA
JMS I (VERSN /PRINT MCPIP VERSION #
TAD I (7644
AND (400 /CHECK FOR /P
/NOTE /P = 400 SAME AS ODD PARITY CODE
SZA
JMP ODDPAR
TAD I (7643
AND (200 /CHECK FOR /E
SZA CLA
JMP EVPAR
GOTP, NOP
JMP I CHKSW
ODDPAR, /400 IN AC
EVPAR, DCA I (PAR
CLA IAC
DCA I (PARITY
JMP GOTP
PAGE
SPSWTCH,0 /NON-ZERO MEANS RETURN FROM PRINT
/RET 1: CASSETTE
/RET 2: MAGTAPE
/RET 3: NEITHER
TCAS, 0
AND (17 /ISOLATE
TAD (7757 /ADD IN BASE OF DCB TABLE
DCA TEMP /TO GET DCB ADDRESS
TAD I TEMP /GET DCB
AND (770 /ISOLATE UNIT TYPE
TAD (-270 /CASSETTE HANDLER TYPE IS 27
SNA
JMP ITSCAS
TAD (270-200
SZA CLA
INCR TCAS /NOTHING SPECIAL
INCR TCAS /MAGTAPE
ITSCAS, EXIT TCAS
VERSN, 0
STA
DCA SPSWTCH /RETURN FROM PRINT
JMS I (PRINT
TEXT \OS/8 MCPIP V\
*.-1
PIPVERSION+60^100+PATCHLEV
0
JMP I VERSN
ER1, TAD I (7605
SNA CLA
JMP I (DECODE /NO OUT AND NO IN
CLA IAC
AND I (7643 /WAS /L SPECIFIED?
SZA CLA
JMP SETTY /YES
JMS I (PRINT
TEXT /?NO OUTPUT FILE/
ER40, JMS I (PRINT
TEXT /?CANNOT HANDLE VARIABLE-LENGTH RECORDS/
SETTY, TAD (3100
DCA Y
JMS I (200
12 /INQUIRE
TT, 2424
Y, 3100 /DEVICE TTY
0
JMP ER99
TAD Y /GET DEVICE NO. OF TTY:
DCA I (7600
JMP I (FET
ER99, JMS I (PRINT
TEXT /?TTY DOES NOT EXIST/
ER21, JMS I (PRINT
TEXT /?NO INPUT FILE/
CW, 0
CIF CDF 0
JMS I (CWRITE
EXIT CW
CR, 0
CIF CDF 0
JMS I (CREAD
EXIT CR
PAGE
SETCAS, 0
TAD (UTIL
JMS SETU
TAD (HANDLER
JMS SETH
CDF 0
TAD (BACKFIL
DCA I (BK2
TAD I (BK4
DCA I (BK3
TAD (254
DCA I (EOFBIT
TAD I (FL3
DCA I (FL1
TAD (314
DCA I (EOTBIT
TAD I (LM3
DCA I (LM1
CDF 10
JMP I SETCAS
SETMAG, 0
TAD (MUTIL
JMS SETU
TAD (MHANDLER
JMS SETH
CDF 0
TAD (BACKBLOCK
DCA I (BK2
TAD I (BK1
DCA I (BK3
TAD (3673
DCA I (EOFBIT
DCA I (FL1
TAD (3663
DCA I (EOTBIT
DCA I (LM1
CDF 10
JMP I SETMAG
SETU, 0
DCA SETH
CDF 0
TAD SETH
DCA I (QU1
TAD SETH
DCA I (QU2
TAD SETH
DCA I (QU3
TAD SETH
DCA I (QU4
TAD SETH
DCA I (QU5
CDF 10
JMP I SETU
SETH, 0
DCA SETU
CDF 0
TAD SETU
DCA I (QH1
TAD SETU
DCA I (QH2
TAD SETU
DCA I (QH3
TAD SETU
DCA I (QH4
TAD SETU
DCA I (QH5
CDF 10
JMP I SETH
PAGE
MH, 0
MHAN, SZA
DCA MENTRY
TAD I (MHANDLER
DCA MH /PICK UP ARGS VIA MH
TAD I MH /GET FN WORD
TAD (SPCODE /ADD SPECIAL CODE
DCA MARG1
ISZ MH
TAD I MH /GET CORE LOC
DCA MARG2
ISZ MH /PT TO ERROR RETURN
TAD I (BSIZE /GET BLOCKSIZE
CIA
DCA MARG3 /STORE NEG
CDF 10
CIF 0
JMS I MENTRY /CALL MAGTAPE HANDLER
MARG1, HLT
MARG2, HLT
MARG3, HLT
SKP /TAKE ERROR RETURN
ISZ MH /NORMAL RETURN
CIF CDF 0
JMP I MH /GO BACK TO FIELD 0
MENTRY, 0
MU, 0
MUT, SZA
DCA MENTRY /DF=0
TAD I (MUTIL /PICK UP ARGS
DCA MU /VIA 'MU'
TAD I MU /GET UTILITY FUNCTION
ISZ MU
CDF 10
TAD (-REWIND
SNA
JMP REWT
TAD (REWIND-BACKFIL
SNA
JMP BAKFT
TAD (BACKFIL-WRGAP
SNA
JMP WRGT
TAD (WRGAP-BACKBLOCK
SNA
JMP BAKBT
TAD (BACKBLOCK-SKPFIL
SZA CLA
HLT /IMPOSSIBLE
SKPFT, STL CLA RAR /4000=WRITE
BAKFT, TAD (WRITE+FICODE-REWCOD
REWT, TAD (REWCOD-EOCODE
WRGT, TAD (EOCODE-RECCOD-WRITE
BAKBT, TAD (RECCOD+WRITE
DCA MRG1
CIF 0
JMS I MENTRY
MRG1, HLT
MCA, HLT /IRRELEVANT
MWC, -1
SKP /ERROR RETURN
ISZ MU
CIF CDF 0
JMP I MU /RETURN
EMPTINCH,52;105;115;120;124;131;40;40;40;14
0;0;0;0;40;40;40;40;40;40
ZBLOCK 14
PAGE
*2000
$