--- /dev/null
+/TD8E DECTAPE COPY, V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1972, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f
+
+
+/DEFINITIONS FOR PAL8 AND PAL10
+
+BSW=7002
+MQL=7421
+MQA=7501
+CAM=7621
+SWP=7521
+ACL=7701
+CAF=6007
+CDI=6203
+KCF=6030
+SDSS=6771
+SDST=6772
+SDSQ=6773
+SDLC=6774
+SDLD=6775
+SDRC=6776
+SDRD=6777
+FIXTAB
+
+
+HALT=HLT
+
+
+/UNIT NUMBER DEFINITIONS FOR TD8E IOT'S
+
+UNIT01=0770
+UNIT23=0760
+UNIT45=0750
+UNIT67=0740
+
+\f
+
+LIMIT=7600
+
+*11
+
+X11, 0
+X12, 0
+
+/PAGE 0 CONSTANTS AND VARIABLES
+
+*20
+INPUT, 0 /INPUT UNIT CONSTANT
+OUTPUT, 0 /OUTPUT UNIT CONSTANTS
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+OCOUNT, 0 /NUMBER OF OUTPUT UNITS SPECIFIED
+OPOINT, 0
+LIST, OUTPUT-1
+OUTNUM, 0
+IBLOCK, 0 /STARTING INPUT BLOCK
+OBLOCK, 0 /STARTING OUTPUT BLOCK
+NUMBER, 0 /NUMBER OF BLOCKS TO TRANSFER
+FIELDS, 0 /-(HIGHEST FIELD AVAILABLE)
+COUNT, 0 /TEMPORARY COUNTERS
+COUNT1, 0 / "
+COUNT2, 0 / "
+COUNT3, 0 / "
+COUNT4, 0 / "
+UNIT, 0 /UNIT CONSTANT--THIS TRANSFER
+VERF, 0 /VERIFY SWITCH (1=YES,0=NO)
+WDCNT, 0 /-(NUMBER OF WORDS PER BLOCK)
+RW, 0 /READ/WRITE BIT--THIS TRANSFER
+FLD0, 0 /# OF BLOCKS IN FIELD 0 BUFFER
+FLDN, 0 /# OF BLOCKS IN FIELD N BUFFER
+BUF0, 0 /START OF FIELD 0 BUFFER
+BUFN, 0 /START OF FIELD N BUFFER
+XNUMB, 0 /# OF BLOCKS LEFT TO TRANSFER
+BLOCKN, 0 /STARTING BLOCK NUMBER--THIS TRANSFER
+NUMB1, 0
+NUMB2, 0
+VB, 0
+END0, 0 /BEGINNING OF FIELD 0 VERIFY BUFFER
+ENTRY, 0 /ENTRY TO TD8E HANDLER
+INB, 0
+OUTB, 0
+OHOLD, 0
+\f
+MESSG1, TEXT @TD8E COPY V4A@
+MESSG3, TEXT @ 12-BIT WORDS PER BLOCK@
+\f
+*200
+
+START, TLS
+ JMS CRLF
+ JMS I [MESSGE
+ MESSG1 /@TD8E COPY@
+ JMS CRLF
+ DCA COUNT
+ JMP I [END /ONCE ONLY CODE FOR MULTIPLE FIELD TEST
+START1, JMS QUEST
+ MESSG4 /@FROM UNIT:@
+ SWP
+ JMS UNITNO /MAKE UNIT NUMBER CONSTANT
+ DCA INPUT
+ TAD LIST
+ DCA OPOINT
+ SKP
+AGAIN, JMS ERR4 /*ILLEGAL RESPONSE*
+ DCA OCOUNT
+ DCA COUNT
+ JMS I [MESSGE
+ MESSG5 /@TO UNITS:@
+MORE2, JMS I [ANSWER
+ JMP AGAIN
+ ACL
+ JMS UNITNO /MAKE UNIT NUMBER CONSTANT
+ MQL /STORE IN MQ
+ MQA /RESTORE TO AC
+ CIA
+ TAD INPUT
+ SNA CLA /IS OUTPUT UNIT = INPUT UNIT ?
+ JMP MORE2+1 /YES--ERROR
+ ISZ OPOINT
+ ISZ OCOUNT /COUNT ONE MORE OUTPUT UNIT
+ TAD OCOUNT
+ TAD [-10
+ SPA CLA /WERE MORE THAN 7 UNITS SPECIFIED?
+ JMP .+3
+ JMS CRLF /YES--CARRIAGE RETURN
+ JMP OALL /IGNORE EXTRA ONE
+ SWP /NO--
+ DCA I OPOINT /STORE UNIT CONSTANT IN LIST
+ TAD COUNT
+ CIA
+ TAD OCOUNT
+ SPA SNA CLA /ALL UNITS IN?
+ JMP MORE2 /YES
+\f
+OALL, DCA COUNT
+ JMS I [MESSGE
+ MESSG6 /@FIRST INPUT BLOCK:@
+ JMS I [ANSWER
+ JMP WHOLE /COPY WHOLE TAPE
+ TAD COUNT
+ SNA CLA /WERE TOO MANY SPECIFIED?
+ JMP .+5
+ JMS I [MESSGE /YES
+ ERROR4 /@ILLEGAL RESPONSE@
+ JMS CRLF
+ JMP OALL /REPEAT THE QUESTION
+ ACL /NO
+ DCA IBLOCK /STORE
+ JMS QUEST
+ MESSG7 /@FIRST OUTPUT BLOCK:@
+ ACL
+ DCA OBLOCK
+ JMS QUEST
+ MESSG8 /@NUMBER OF BLOCKS TO COPY:@
+ ACL
+ SNA /WERE 0 BLOCKS SPECIFIED?
+ JMP QUEST1 /YES--REPEAT QUESTION
+ DCA NUMBER
+ JMP .+4
+WHOLE, DCA IBLOCK
+ DCA OBLOCK
+ DCA NUMBER /0 MEANS WHOLE TAPE
+ JMS QUEST
+ MESSG9 /@VERIFY OUTPUT (YES=1,NO=0):@
+ ACL
+ AND [7
+ DCA VERF
+ JMP I (SETUP
+\f
+/OUTPUT CARRIAGE RETURN/LINE FEED
+
+CRLF, 0
+ TAD (215
+ JMS I [TYPE
+ TAD [212
+ JMS I [TYPE
+ JMP I CRLF /--RETURN--
+
+ERR4, 0
+ JMS I [MESSGE
+ ERROR4 /@ILLEGAL RESPONSE@
+ JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+ TAD [-4
+ TAD ERR4
+ DCA ERR4
+ DCA COUNT
+ JMP I ERR4 /--RETURN--
+
+\f
+QUEST, 0
+ TAD I QUEST
+ DCA MNUM
+ ISZ QUEST
+ JMS I [MESSGE
+MNUM, 0
+ JMS I [ANSWER
+QUEST1, JMS ERR4
+ TAD COUNT
+ SZA CLA
+ JMP QUEST1
+ JMP I QUEST /--RETURN--
+
+
+/CONVERT UNIT NUMBER TO A WORD OF THE FORM
+/000 XXX XXX 000 OR
+/100 XXX XXX 000
+/WHERE XY0 IS THE THIRD DIGIT OF THE IOT
+/AND 0 OR 1 REFLECTS THE TD8E UNIT NUMBER
+/ENTER WITH THE UNIT NUMBER IN THE AC
+/EXIT WITH SPECIAL CODE IN AC
+
+UNITNO, 0
+ AND [7 /MASK OUT ALL EXTRANEOUS BITS
+ CLL RAR /SAVE 0/1 BIT IN LINK
+ MQL /STORE ROTATED WORD, CLEAR AC
+ RAR
+ SWP /PRESERVE 0/1 BIT IN MQ
+ TAD TABX /GET DEVICE NUMBER CORRECTLY
+ DCA CRLF
+ TAD I CRLF
+ MQA /OR IN 0/1 BIT
+ JMP I UNITNO /--RETURN--
+
+TABX, UNITS
+
+/SKIP 4 LINES AND FETCH MARK TRACK
+
+SKIPQ, 0
+IOTR5, SDSQ
+ JMP .-1
+IOTR6, SDRC
+ JMP I SKIPQ /--RETURN--
+\f
+*400
+
+/USER RESPONSE HANDLER
+/USES MQ FOR TEMPORARY STORAGE
+/EXIT WITH RESPONSE IN MQ
+/EXIT TO CALL+1 IF JUST CARRIAGE RETURN
+/OR ILLEGAL CHARACTER, CARRIAGE RETURN
+/OR ;,CARRIAGE RETURN
+/EXIT TO CALL+2 IF GOOD DATA, CARRIAGE RETURN
+/INCREMENT COUNT AND EXIT TO CALL+2 IF GOOD DATA;
+/ILLEGAL CHARACTERS CAUSE WHOLE ANSWER TO BE IGNORED
+/AND EXIT TO CALL+1
+
+ANSWER, 0
+ CAM /CLEAR AC AND MQ
+ TAD CLEAR
+ DCA SWITCH
+MORE, JMS LISTEN /FETCH A CHARACTER
+ TAD (-215
+ SZA /IS IT A CARRIAGE RETURN?
+ JMP .+5 /NO
+ TAD [212 /YES--OUTPUT LINE FEED
+ JMS TYPE
+SWITCH, NOP /SET UP EXIT ADDRESS
+ JMP I ANSWER /--RETURN--
+ TAD (215-260
+ SPA /IS CHARACTER LESS THAN 260?
+ JMP BAD /YES--ILLEGAL CHARACTER
+ TAD [260-270 /NO
+ SMA /IS IT MORE THAN 269?
+ JMP SEMI /YES--CHECK FOR SEMICOLON
+ TAD (270 /RESTORE CHARACTER
+ AND [7 /MASK OUT EXTRANEOUS BITS
+ CLL
+ SWP
+ AND (777 /MASK OUT FIRST DIGIT IF THERE ARE 4
+ RAL /ROTATE 3 LEFT
+ RTL
+ MQA /FETCH NEW CHARACTER
+ MQL /STORE RESULT IN MQ
+ TAD SKIP /SET UP TO SKIP ON RETURN
+ DCA SWITCH
+ JMP MORE /FETCH ANOTHER
+
+\f
+CLEAR, NOP
+SKIP, ISZ ANSWER
+
+BAD, CLA /ILLEGAL CHARACTER
+ JMS I [CRLF
+ JMP I ANSWER /--RETURN--
+
+
+/TEST FOR SEMICOLON
+
+SEMI, TAD (270-273
+ SZA CLA /IS CHARACTER A SEMICOLON?
+ JMP BAD /NO--ILLEGAL CHARACTER
+ ISZ COUNT /YES--INCREMENT COUNTER
+ JMP SWITCH /EXIT FROM ANSWER ROUTINE
+
+
+/TELETYPE INPUT AND ECHO HANDLER
+
+LISTEN, 0
+ KSF
+ JMP .-1
+ JMS I [PARITY
+ TLS /ECHO CHARACTER
+ JMS CHECK /CHECK FOR CTRL/C AND CTRL/S
+ JMP I LISTEN /--RETURN--
+
+/CHECK FOR CTRL/C AND CTRL/S
+/ENTER WITH INPUT CHARACTER IN AC
+/EXIT TO HANDLER OR WITH CHARACTER IN AC
+
+CHECK, 0
+ TAD (-203
+ SNA /IS IT CTRL/C?
+ JMP I CTRLC /YES--HANDLE IT
+ TAD (203-223
+ SNA /IS IT CTRL/S?
+ JMP I [REPEAT /YES--HANDLE IT
+ TAD (223 /RESTORE CHARACTER
+ JMP I CHECK /--RETURN--
+
+CTRLC, LIMIT
+\f
+/MESSAGE OUTPUT HANDLER
+
+/EXPECTS MESSAGE ADDRESS TO BE IN LOCATION AFTER CALL
+/EXITS TO CALL+2
+
+MESSGE, 0
+ TAD I MESSGE
+ DCA FINDER /SET UP POINTER
+ ISZ MESSGE
+ DCA LOC /SET L/R SWITCH TO L (EVEN)
+LNEXT, TAD I FINDER /GET WORD
+ BSW
+RHALF, AND [77
+ SNA /IS CHARACTER 0 (TERMINATOR)?
+ JMP I MESSGE /YES--RETURN--
+ DCA CHAR
+ TAD CHAR
+ AND (40
+ SNA CLA /IS IT A LETTER?
+ TAD [100 /YES--301-337
+ TAD [200 /NO--240-277
+ TAD CHAR /RESTORE CHARACTER
+ JMS TYPE /OUTPUT IT
+ ISZ LOC
+ TAD LOC
+ RAR
+ SZL CLA /WHICH HALF WAS THAT?
+ JMP .+3
+ ISZ FINDER /RIGHT
+ JMP LNEXT
+ TAD I FINDER /LEFT
+ JMP RHALF
+FINDER, 0
+LOC, 0
+CHAR, 0
+
+
+/TELETYPE OUTPUT ROUTINE
+
+
+TYPE, 0
+ TSF
+ JMP .-1
+ TLS
+ CLA
+ JMP I TYPE /--RETURN--
+
+\f
+/INSERT IOT'S ACCORDING TO TABLES
+/UNIT CONTAINS APPROPRIATE UNIT CODE
+/COUNT CONTAINS -(NUMBER OF IOT'S TO TRANSFER)
+/COUNT1 CONTAINS ADDRESS OF ADDRESS TABLE
+/UNIT CONTAINS UNIT CODE OF CURRENT UNIT
+
+INSERT, 0
+ TAD I COUNT1
+ DCA COUNT3
+ TAD UNIT
+ MQL
+ TAD I COUNT3 /MAKE NEW IOT
+ AND (7007
+ MQA
+ CIA
+ TAD I COUNT3 /COMPARE WITH IOT FROM PROGRAM
+ SNA CLA /ARE THE IOT'S THE SAME AS THE LAST UNIT?
+ JMP I INSERT /YES--RETURN--
+INS1, TAD I COUNT1
+ DCA COUNT3
+ TAD I COUNT3 /GET IOT FROM PROGRAM
+ AND (7007 /RETAIN ONLY SIGNIFICANT BITS
+ MQA /OR IN UNIT NUMBER
+ DCA I COUNT3 /PUT IT IN PROGRAM
+ ISZ COUNT1 /BUMP COUNTERS
+ ISZ COUNT /DONE YET?
+ JMP INS1 /NO
+ JMP I INSERT /YES--RETURN--
+
+
+PAGE
+\f
+/COUNT THE NUMBER OF WORDS PER BLOCK
+/PLACE IT IN MWORDS
+/BE SURE ALL TAPES MATCH INPUT FORMAT
+
+SETUP, TAD LIST
+ DCA OPOINT /SET POINTER TO I/O LIST
+ DCA COUNT2 /CLEAR COUNTER
+ TAD OCOUNT
+ CMA
+ DCA OUTNUM /SET # OF UNITS
+SET4, TAD (TABLE1-END1-1 /SET UP COUNTERS FOR IOT FIX
+ DCA COUNT
+ TAD (TABLE1
+ DCA COUNT1
+ TAD I OPOINT
+ DCA UNIT
+ JMS I [INSERT /PUT THE PROPER IOT'S IN THE FOLLOWING ROUTINE
+ DCA WDCNT /CLEAR WORD COUNT
+ TAD UNIT
+ AND [4000
+ TAD (2000
+IOTX7, SDLC
+ CLA
+IOTX8, SDRC
+ RTL
+ SZL /DOES UNIT EXIST?
+ JMP .+3 /YES
+SELERR, JMS I [ERR3 /@SELECT ERROR UNIT N@
+ JMP SETUP
+ AND (400
+ SZA CLA /TURNED ON?
+ JMP SELERR /NO
+ TAD UNIT /GET 0 OR 1 UNIT BIT (0 OR 4000)
+ AND [4000
+ TAD [1000 /GET GO BIT
+IOTX1, SDLC /START READING FORWARD
+ JMS SKIP4 /SKIP 8 LINES TO AVOID GARBAGE
+ JMS SKIP4
+IOTX3, SDSS /LOOK FOR FORWARD BLOCK NUMBER (26)
+ JMP .-1
+IOTX4, SDRC
+ AND [77
+ TAD (-26
+ SZA CLA /FOUND YET?
+ JMP IOTX3 /NO--KEEP LOOKING
+\f
+SET2, JMS SKIP4 /YES--START COUNTING LINES BY FOURS
+ ISZ WDCNT
+ NOP
+ AND [77
+ TAD (-51
+ SZA CLA /FOUND GUARD YET?
+ JMP SET2 /NO
+ TAD UNIT /YES
+ AND [4000
+IOTX2, SDLC /STOP UNIT
+ CLA
+ TAD COUNT2
+ SZA /IS THIS THE INPUT UNIT?
+ JMP SET5 /NO
+ TAD (-11 /YES--SAVE THE COUNT
+ TAD WDCNT
+ CIA
+ DCA COUNT2
+ JMP SET3 /FIRST OUTPUT UNIT
+SET5, TAD (-11 /NOT INPUT UNIT
+ TAD WDCNT
+ SZA CLA /SAME NUMBER OF WORDS AS INPUT UNIT?
+ JMP ERR5 /NO*ILLEGAL FORMAT*
+SET3, ISZ OPOINT /NEXT UNIT
+ ISZ OUTNUM /DONE YET?
+ JMP SET4 /NO
+ TAD COUNT2 /YES--PRINT MESSAGE
+ DCA I [MWORDS /SET UP NUMBER OF WORDS PER BLOCK
+ TAD I [MWORDS
+ CIA
+ JMS I [PRINT /PRINT 4 DIGIT NUMBER OF BLOCKS
+ JMS I [MESSGE /YES--PRINT REST OF MESSAGE
+ MESSG3
+ JMS I [CRLF
+\f
+/IF WHOLE TAPE IS TO BE COPIED, IT IS NECESSARY TO
+/COMPUTE THE NUMBER OF BLOCKS ON THE TAPE (NB)
+/USING THE NUMBER OF WORDS PER BLOCK (WB)
+/AND THE FORMULA:
+/OCTAL: NB=[63 6160/(WB+17)]+2
+/DECIMAL: NB=[212,080/(WB+15)]+2
+
+ TAD NUMBER
+ SZA CLA /COPY WHOLE TAPE?
+ JMP VERFQ /NO--
+ DCA COUNT /YES--COMPUTE NUMBER OF BLOCKS ON TAPE
+ TAD I [MWORDS
+ CIA
+ TAD (17
+ DCA COUNT1 /GET NUMBER OF WORDS PER BLOCK+17
+ TAD (-64
+ DCA COUNT2
+ TAD (-6160
+SUB, CLL
+ TAD COUNT1
+ ISZ COUNT /COUNT A BLOCK--TOO MANY?
+ SKP /NO
+ JMP ERR5 /YES--ERROR
+ SZL
+ ISZ COUNT2
+ JMP SUB
+ CLA CLL
+ TAD COUNT /COUNT IS [63 6160/WB+17]+1
+ IAC /ADD 1 MORE
+ DCA NUMBER /STORE AS # OF BLOCKS TO TRANSFER
+ JMP I .+1
+ VERFQ
+
+ERR5, CLA
+ JMS I [MESSGE
+ ERROR5 /*ILLEGAL FORMAT UNIT*
+ JMS I [DECODE /PRINT UNIT NUMBER
+ JMS I [CTRLR /WAIT FOR CTRL/R
+ JMS I [CRLF /CARRIAGE RETURN/LINE FEED
+ JMP SETUP /TRY AGAIN
+
+
+
+
+/READ FOUR LINES AND FETCH MARK TRACK
+
+SKIP4, 0
+IOTX5, SDSQ
+ JMP .-1
+IOTX6, SDRC
+ JMP I SKIP4 /--RETURN--
+
+
+
+\f
+PAGE
+
+/IS TAPE TO BE VERIFIED?
+/SET UP DEPENDING ON RESPONSE
+VERFQ, TAD VERF
+ SZA CLA /VERIFY?
+ JMP YES /YES--
+ TAD (NOP /NO--
+ DCA I VERF1A
+ TAD (OUTN
+ DCA I VERF2A
+ JMP CONT
+YES, TAD (RAR
+ DCA I VERF1A
+ TAD (VERIFY
+ DCA I VERF2A
+CONT, JMP I .+1
+ DOIT
+
+VERF1A, VERF1
+VERF2A, VERF2
+
+/WAIT FOR CTRL/R
+
+CTRLR, 0
+ JMS I [LISTEN /FETCH CHARACTER
+ TAD [-222
+ SZA CLA /IT IT CTRL/R?
+ JMP .-3 /NO--WAIT FOR ONE
+ JMS I [CRLF /CARRIAGE RETURN/LINE FEED
+ JMP I CTRLR /--RETURN--
+
+
+REPEAT, DCA COUNT
+ JMS I [CRLF
+ JMS I [QUEST /@REPEAT (YES=1;NO=0):@
+ MESS11
+ ACL
+ AND [7
+ SZA CLA
+ JMP I [CLEAN /YES
+ JMP I [START+4 /NO--RESTART
+\f
+MESSG6, TEXT @FIRST INPUT BLOCK:@
+MESSG7, TEXT @FIRST OUTPUT BLOCK:@
+MESSG8, TEXT @NUMBER OF BLOCKS TO COPY:@
+MESSG9, TEXT @VERIFY OUTPUT (YES=1,NO=0):@
+MESS10, TEXT @DONE@
+MESS11, TEXT @REPEAT (YES=1,NO=0):@
+ERROR1, TEXT @VERIFY ERROR BLOCK @
+ERROR2, TEXT @TAPE ERROR BLOCK @
+ERROR3, TEXT @SELECT ERROR UNIT @
+\f
+PAGE
+
+/SETUP FOR ACTUAL READ/WRITE/VERIFY OPERATION
+DOIT, TAD [LIMIT-END /SET UP NUMBER OF BLOCKS
+ JMS DIV1 /IN FIELD 0 BUFFER
+ DCA FLD0
+ TAD M200
+ JMS DIV1 /AND IN FIELD N BUFFERS
+ DCA FLDN
+ TAD IBLOCK /SET UP RUNNING COUNTERS AND POINTERS
+ DCA INB /FOR NEXT INPUT BLOCK
+ TAD OBLOCK
+ DCA OUTB /FOR NEXT OUTPUT BLOCK
+ TAD NUMBER
+ DCA NUMB1 /FOR NUMBER OF BLOCKS LEFT TO TRANSFER
+ JMP .+4
+ALLDUN, TAD XNUMB
+ SNA CLA /DONE WITH ALL BLOCKS YET?
+ JMP REWIND /YES
+/READ---
+READX, TAD LIST /NO--SET UP POINTER TO OUTPUT UNITS
+ DCA OPOINT
+ TAD OCOUNT
+ CMA
+ DCA OUTNUM
+ TAD INB
+ DCA BLOCKN
+ TAD NUMB1 /SET POINTERS FOR TRANSFER
+ DCA XNUMB
+ TAD NUMB1
+ DCA NUMB2 /SAVE COUNTER FOR WRITE
+ TAD INPUT /SELECT INPUT UNIT
+ DCA UNIT
+ DCA RW /SET R/W BIT TO READ
+\f
+ TAD [END /SET START OF BUFFERS IN CASE
+ DCA BUF0 /THEY WERE CHANGED BY VERIFY
+ DCA BUFN
+ JMS I [READY /FILL THE BUFFERS
+ TAD XNUMB /SAVE THE POINTERS
+ DCA NUMB1
+ TAD BLOCKN
+ DCA INB
+
+OUTN, ISZ OPOINT
+ ISZ OUTNUM /DONE WITH ALL UNITS YET?
+ JMP .+4 /NO--CONTINUE WRITING
+ TAD OHOLD /YES
+ DCA OUTB
+ JMP ALLDUN /READ ANOTHER BUFFER LOAD
+WRITEX, TAD OUTB
+ DCA OHOLD
+ TAD OHOLD /WRITE
+ DCA BLOCKN /RESET POINTERS
+ TAD OUTB
+ DCA VB /SAVE COUNTER FOR VERIFY
+ TAD NUMB2
+ DCA XNUMB
+ TAD I OPOINT /SELECT OUTPUT UNIT
+ DCA UNIT
+ CLA CLL CML RAR /AC=4000
+ DCA RW /SET R/W BIT TO WRITE
+ JMS I [READY
+ TAD BLOCKN
+ DCA OHOLD
+ JMP I .+1
+VERF2, VERIFY
+
+
+\f
+/SEE HOW MANY BLOCKS WILL FIT INTO BUFFER
+/ENTER WITH BUFFER SIZE IN AC
+/EXIT WITH # OF BLOCKS IN AC
+
+DIV1, 0
+ DCA COUNT1
+ DCA COUNT
+ TAD COUNT1 /TOTAL WORDS
+DIV2, CLL
+ TAD I [MWORDS /-NUMBER OF WORDS PER BLOCK
+ SNL /RUN OUT OF ROOM?
+ JMP .+3 /YES--
+ ISZ COUNT /NO--COUNT A BLOCK
+ JMP DIV2
+ CLA CLL /IGNORE LESS THAN A BLOCK LEFT
+ TAD COUNT
+VERF1, RAR /DIVIDE BY 2 IF VERIFY (NOP IF NO VERIFY)
+ JMP I DIV1 /--RETURN--
+
+/END OF OPERATION
+/REWIND TAPES TO INITIAL END ZONE
+
+REWIND, TAD OCOUNT
+ CMA
+ DCA COUNT2 /SET NUMBER OF TAPES STILL SPINNING
+RLIST, CLA CMA
+ TAD LIST
+ DCA OPOINT /SET POINTER TO UNIT LIST
+ TAD OCOUNT
+ IAC
+ CMA
+ DCA OUTNUM /SET NUMBER OF UNITS IN LIST
+RUNIT, JMS I [PARITY
+ JMS I [CHECK /CHECK TTY FOR CTRL/S OR CTRL/C
+ ISZ OUTNUM /DONE WITH WHOLE LIST YET?
+ SKP CLA /NO
+ JMP RLIST /YES--START THROUGH LIST AGAIN
+ ISZ OPOINT
+ TAD I OPOINT /GET UNIT CODE
+ RTL
+ SZL CLA /STILL SPINNING?
+ JMP RUNIT /NO--TRY NEXT TAPE
+ TAD I OPOINT /YES
+ DCA UNIT
+\f
+
+ TAD [-6
+ DCA COUNT
+ TAD [RTAB
+ DCA COUNT1
+ JMS I [INSERT /PUT PROPER IOT'S IN THIS ROUTINE
+ TAD I OPOINT
+ AND [4000 /UNIT/READ
+ TAD [3000 /REVERSE/GO
+IOTR1, SDLC
+ JMS I [SKIPQ
+ JMS I [SKIPQ /WAIT FOR DRIVE TO GET UP TO SPEED
+IOTR2, SDSS
+ JMP .-1
+IOTR3, SDRC /GET MARK TRACK BITS
+ AND [77
+ TAD [-22
+ SZA CLA /END ZONE?
+ JMP RUNIT /NO--NEXT UNIT
+ CLA CLL CML RTR /AC=2000
+ MQA /UNIT CODE STILL IN MQ FROM INSERT
+ DCA I OPOINT /SET STOPPED BIT
+ TAD I OPOINT
+ AND [6000
+IOTR4, SDLC /STOP UNIT
+M200, 7600 /CLA
+ ISZ COUNT2 /ALL TAPES STOPPED?
+ JMP RUNIT /NO--NEXT UNIT
+ JMS I [MESSGE /YES
+ MESS10 /@DONE@
+ JMP I [REPEAT
+
+\f
+
+PAGE
+
+/VERIFICATION ROUTINES
+
+VERIFY, TAD VB /SET POINTERS AND COUNTERS FOR TRANSFER
+ DCA BLOCKN
+ TAD NUMB2
+ DCA XNUMB
+ DCA RW
+ TAD END0 /SET BEGINNINGS OF VERIFY BUFFERS
+ DCA BUF0
+ TAD (3700
+ DCA BUFN
+ TAD CDF0
+ DCA COMP2
+ JMS I [READY /READ VERIFY BUFFERS FULL
+ TAD COUNT1 /GET # OF BLOCKS IN LAST BUFFER FILLED
+ DCA COUNT3
+ CMA /SET AUTOINDEX POINTERS TO BUFFERS
+ TAD [END
+ DCA X11
+ CMA CLL
+ TAD END0
+ DCA X12
+ TAD COUNT
+ CMA
+ TAD FIELDS
+ DCA COUNT /SET NUMBER OF FIELDS WHICH WERE FILLED
+ JMS COMP4 /GET NUMBER OF BLOCKS
+ TAD FLD0
+ CIA
+ DCA COUNT4 /SET COUNTER
+ JMS COMP /COMPARE THE BUFFERS
+\f
+COMP3, TAD COUNT
+ SNA CLA
+ JMP I [OUTN
+ JMS COMP4 /GET NUMBER OF BLOCKS
+ TAD FLDN
+ CIA
+ DCA COUNT4
+ TAD COMP2 /EACH FIELD------
+ TAD (10
+ DCA COMP2 /SET CDF INSTRUCTION PROPERLY
+ CMA CLL /SET AUTOINDEX POINTERS TO BUFFERS
+ DCA X11
+ TAD (3677
+ DCA X12
+ JMS COMP
+ JMP COMP3 /DO THE NEXT FIELD
+
+
+/ENTER WITH AC CLEAR
+/EXIT TO CALL+1 WITH AC CLEAR IF
+/NORMAL BUFFER FILL
+/EXIT TO CALL+2 WITH # OF BLOCKS IN AC IF
+/LAST BUFFER
+
+COMP4, 0
+ ISZ COUNT /LAST FIELD FILLED?
+ JMP I COMP4 /NO--RETURN--
+ TAD XNUMB /YES--OUT OF BLOCKS?
+ SZA CLA
+ JMP I COMP4 /NO--RETURN--
+ TAD COUNT3 /YES--GET ACTUAL # OF BLOCKS
+ ISZ COMP4 /INCREMENT RETURN ADDRESS
+ JMP I COMP4 /--RETURN--
+
+\f
+/COMPARE PORTION OF VERIFY ROUTINE
+
+COMP, 0
+ TAD I [MWORDS /SET NUMBER OF WORDS PER BLOCK COUNTER
+ DCA COUNT2
+COMP2, HALT /SHOULD CONTAIN CDF N
+ TAD I X11 /GET CORRESPONDING WORDS FROM EACH BUFFER
+ CIA
+ TAD I X12
+CDF0, CDF 0
+ SZA CLA /DO WORDS MATCH?
+ JMP ERR1 /NO--VERIFY ERROR
+TRY, ISZ COUNT2 /DONE WITH BLOCK?
+ JMP COMP2 /NO--CONTINUE
+ ISZ COUNT4 /DONE WITH ALL BLOCKS?
+ JMP COMP+1 /NO
+ JMP I COMP /YES--RETURN--
+
+ERR1, JMS I [MESSGE
+ ERROR1 /*VERIFY ERROR BLOCK *
+ TAD COUNT4 /GET CURRENT BLOCK NUMBER
+ CIA
+ TAD I (BLOCKS /FROM BLOCK THIS OPERATION STARTED WITH
+ JMS PRINT /PRINT 4 DIGIT BLOCK NUMBER
+ JMS I [MESSGE
+ ERROR6 /*UNIT *
+ JMS I [DECODE /PRINT UNIT NUMBER
+WAIT, JMS I [LISTEN /WAIT FOR RESPONSE
+ DCA PRINT
+ JMS I [CRLF
+ TAD PRINT
+ TAD [-224
+ SNA /WAS IT CTRL/T?
+ JMP I [WRITEX /YES--TRY AGAIN
+ TAD [2
+ SZA CLA /WAS IT CTRL/R?
+ JMP WAIT /NO--WAIT FOR A GOOD RESPONSE
+ JMP TRY /YES--IGNORE AND CONTINUE
+
+\f
+
+
+/PRINT A 4 DIGIT OCTAL NUMBER
+/ENTER WITH NUMBER IN AC
+
+PRINT, 0
+ DCA I [MESSGE /TEMPORARY STORAGE
+ TAD [-4
+ DCA I [ANSWER /SET DIGIT COUNTER
+ TAD I [MESSGE
+ RAL
+ DCA I [CRLF
+FOUR, TAD I [CRLF
+ RAL
+ RTL
+ DCA I [CRLF
+ TAD I [CRLF
+ AND [7
+ TAD [260
+ JMS I [TYPE /PRINT ONE DIGIT
+ ISZ I [ANSWER /DONE YET?
+ JMP FOUR /NO
+ JMP I PRINT /YES--RETURN--
+
+
+/CLEAN UP UNIT TABLES AFTER REWIND
+
+CLEAN, TAD LIST
+ DCA OPOINT
+ TAD OCOUNT
+ CMA
+ DCA OUTNUM /SET POINTER AND COUNTER
+CLEAN1, TAD I OPOINT /GET UNIT CODE
+ AND (4770 /MASK OUT EXTRANEOUS BITS
+ DCA I OPOINT /REPLACE IT
+ ISZ OPOINT
+ ISZ OUTNUM /DONE YET?
+ JMP CLEAN1 /NO
+ JMP I [DOIT /YES--NEXT OPERATION
+
+
+
+\f
+PAGE
+
+/FILL ALL N FIELDS ONCE
+/ENTER WITH AC CLEAR
+/# OF BLOCKS FOR FIELD 0 IN FLD0
+/# OF BLOCKS FOR OTHERS IN FLDN
+/ADDRESSES OF BUFFERS IN BUF0, BUFN
+/R/W BIT (0 OR 4000) IN RW
+
+
+
+READY, 0
+ TAD [IOTLOC-TABEND-1
+ DCA COUNT
+ TAD [IOTLOC
+ DCA COUNT1
+ JMS I [INSERT /PUT PROPER IOT'S IN HANDLER
+ TAD UNIT
+ SPA CLA /EVEN OR ODD UNIT NUMBER?
+ CLL IAC RTL /ODD
+ TAD [ORIGIN /EVEN
+ DCA ENTRY /SET UP ENTRY TO HANDLER
+ TAD RW
+ MQL /STORE UNIT BIT FOR LATER
+ CMA
+ TAD FIELDS /SET COUNTER FOR # OF FIELDS
+ DCA COUNT
+ CLL
+ TAD FLD0 /ADJUST NUMBER OF BLOCKS TO
+ JMS SUB1 /TRANSFER DEPENDING ON NUMBER
+ TAD FLD0 /LEFT TO BE TRANSFERRED
+ JMS SUB2 /RESET FUNCTION WORD
+ TAD BUF0 /SET UP BUFFER POINTERS
+ JMS SUB3
+ JMS TRANS /TRANSFER DATA--FIELD 0
+ZOOM, ISZ COUNT /BEGINNING OF LOOP FOR EACH FIELD ABOVE 0
+ SKP /DONE YET?
+ JMP I READY /YES--RETURN--
+\f
+ TAD FIELDS
+ CIA CLL
+ TAD COUNT
+ IAC
+ RAL
+ RTL /GET FIELD SETTING READY
+ MQL /STORE IN MQ
+ TAD FUNCTN /GET PREVIOUS FUNCTION WORD
+ AND [4000 /GET R/W BIT
+ MQA /OR IN FIELD SETTING
+ MQL /STORE
+ CLL
+ TAD FLDN /ADJUST NUMBER OF BLOCKS TO TRANSFER
+ JMS SUB1
+ TAD FLDN
+ JMS SUB2 /AND RESET FUNCTION WORD
+ TAD BUFN
+ JMS SUB3 /SET UP BUFFER POINTERS
+ JMS TRANS /TRANSFER DATA--FIELDS 1-N
+ JMP ZOOM /FILL ANOTHER FIELD
+
+SUB1, 0
+ CIA
+ TAD XNUMB
+ CLL CML /SET LINK=1
+ SMA /ARE THERE LESS BLOCKS LEFT THAN A FIELD FULL?
+ DCA XNUMB /NO--REDUCE COUNT OF BLOCKS LEFT
+ JMP I SUB1 /YES-TRANSFER BLOCKS LEFT--RETURN--
+
+SUB2, 0
+ DCA COUNT1 /LINK=1 IF BLOCKS LEFT, 0 IF NONE
+ SNL /DONE WITH ALL BLOCKS YET?
+ DCA XNUMB /YES--BUMP SWITCH
+ TAD COUNT1 /NO
+ BSW
+ MQA /PUT # OF BLOCKS INTO FUNCTION WORD
+ DCA FUNCTN /START REVERSE
+ JMP I SUB2 /--RETURN--
+
+\f
+SUB3, 0
+ DCA BUFADD
+ TAD BLOCKN /SET STARTING BLOCK NUMBER
+ DCA BLOCKS
+ TAD COUNT1
+ TAD BLOCKN
+ DCA BLOCKN /RESET STARTING BLOCK FOR NEXT TIME
+ JMP I SUB3 /--RETURN--
+
+
+/CALL TO THE HANDLER
+
+TRANS, 0
+ JMS I [PARITY /CHECK TELETYPE
+ JMS I [CHECK /WAS ^C OR ^S TYPED?
+ JMS I ENTRY
+FUNCTN, 0 /FUNCTION WORD
+BUFADD, 0 /BUFFER ADDRESS
+BLOCKS, 0 /STARTING BLOCK NUMBER
+ JMP ERR /ERROR RETURN
+ JMS I [PARITY /CHECK TELETYPE
+ JMS I [CHECK /WAS ^C OR ^S TYPED?
+ CLA
+ TAD XNUMB
+ SZA CLA /DONE YET?
+ JMP I TRANS /NO--RETURN--
+ ISZ COUNT
+ JMP I READY /--RETURN--
+ JMP I READY /--RETURN--
+
+/TRANSFER ERROR HANDLER
+
+ERR, SNA CLA /FATAL ERROR?
+ JMP SELECT /NO
+ JMS I [MESSGE /YES
+ ERROR2 /*TAPE ERROR BLOCK *
+ TAD I (BLOCK
+ JMS I [PRINT /PRINT BLOCK NUMBER
+ JMS I [MESSGE
+ ERROR6 /*UNIT *
+ JMS DECODE /PRINT UNIT NUMBER
+ JMS I [CRLF
+ JMP I [REWIND
+SELECT, JMS ERR3
+ ISZ FUNCTN /TURN AROUND AND TRY AGAIN
+ JMP FUNCTN-1
+
+\f
+ERR3, 0
+ JMS I [MESSGE
+ ERROR3 /*SELECT ERROR UNIT *
+ JMS DECODE /PRINT UNIT NUMBER
+ JMS CTRLR /WAIT FOR CTRL/R
+ JMP I ERR3 /--RETURN--
+
+
+/DECODE UNIT NUMBER FOR PRINTING
+/PRINT UNIT NUMBER BEFORE RETURNING
+
+DECODE, 0
+ CLL
+ TAD UNIT
+ RAL
+ MQL /SAVE ROTATED CODE IN MQ
+ RAL
+ SWP /SAVE EVEN/ODD BIT IN MQ
+ RAR /WORK ON IOT CODE
+ RTR
+ IAC
+ CMA
+ AND [7
+ MQA /INCLUDE EVEN/ODD BIT
+ TAD [260 /MAKE ASCII DIGIT
+ JMS I [TYPE
+ JMP I DECODE /--RETURN--
+
+
+PAGE
+
+\f
+/TD8E DECTAPE HANDLER
+
+/SLIGHTLY MODIFIED VERSION OF DEC-E8-UZTA-D
+/COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION
+/ MAYNARD, MASSACHUSETTS 01754
+
+/THE CALLING SEQUENCE IS:
+/ JMS ENTRY
+/ FUNCTION WORD
+/ BUFFER ADDRESS
+/ STARTING BLOCK
+/ ERROR RETURN
+/ NORMAL RETURN (AC CLEAR)
+
+/FUNCTION WORD:
+/ BIT 0: 0=READ, 1=WRITE
+/ BITS 1-5: # OF BLOCKS TO BE TRANSFERRED
+/ BITS 6-8: FIELD OF BUFFER AREA
+/ BITS 9-10: UNUSED
+/ BIT 11: 1=START FORWARD, 0=START REVERSE
+
+/ERRORS:
+/THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/FATAL ERRORS:
+/ PARITY ERROR
+/ TIMING ERROR
+/ TOO GREAT A BLOCK NUMBER
+/FATAL ERRORS TAKE ERROR RETURN WITH AC=4000
+/NON-FATAL ERROR:
+/ SELECT ERROR (IMPROPER UNIT NUMBER OR NO UNIT NUMBER)
+/NON-FATAL ERROR TAKES ERROR RETURN WITH AC=0
+\fPAGE
+
+MFIELD=0
+ORIGIN=.
+
+DTA0, 0 /ENTRY POINT FROM UNIT 0
+ CLA CLL /0 TO LINK
+ JMP DTA1X
+C1000, 1000
+DTA1, 0 /UNIT 2 ENTRY
+ CLA CLL CML /1 TO LINK
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA YUNIT /LINK TO UNIT POSITION
+ RDF
+ TAD C6203 /GET DATA FIELD AND SETUP RETURN
+ DCA LEAVE
+ TAD YUNIT /GET FUNCTION WORD
+IOT4, SDLC /PUT FUNCTION INTO DATA REGISTER
+ TAD I DTA0
+IOT1, SDLD
+ CLA
+ TAD MWORDS
+ DCA WCOUNT /STORE MASTER WORD COUNT
+ ISZ DTA0 /TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /TO BLOCK NUMBER
+ TAD I DTA0
+ DCA BLOCK
+ ISZ DTA0 /POINT TO ERROR EXIT
+ CIF CDF MFIELD /TO ROUTINES DATA FIELD
+IOT2, SDRD /GET FUNCTION INTO AC
+ CLL RAL
+ AND CM200 /GET # PAGES TO XFER
+ DCA PGCT
+IOT3, SDRD
+C374, AND C70 /GET FIELD FOR XFER
+ TAD C6201 /FORM CDF N
+ DCA XFIELD /IF=0 AND DF=N AT XFER.
+ CLA CLL CMA RTL
+ DCA TRYCNT /3 ERROR TRIES
+IOT5, SDRC
+ AND C100
+ SZA CLA
+ JMP FATAL-1
+\f
+IOT6, SDRD /PUT FUNCT INTO XFUNCT IN SECOND PG.
+ DCA I CXFUN
+ TAD WCOUNT
+ DCA I CXWCT
+IOT7, SDRD /GET MOTION BIT TO LINK
+ CLL RAR
+ JMP GO /AND START THE MOTION.
+RWCOM, SDST /ANY CHECKSUM ERRORS?
+ SZA CLA /OR CHECKSUM ERRORS?
+ JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS
+ /SET AT RWCOM. GETCHK SETS IT.
+ TAD PGCT /NO ERROR..FINISHED XFER?
+ TAD CM200
+ SNA
+ JMP EXIT /ALL DONE. GET OUT
+ DCA PGCT /NEW PAGE COUNT
+ ISZ BLOCK /NEXT BLOCK TO XFER
+ TAD WCOUNT /FORM NEXT BUFFER ADDRESS
+ CIA
+ TAD BUFF
+ DCA BUFF
+ CLL CML /FORCES MOTION FORWARD
+GO, CLA CML RTR /LINK BECOMES MOTION BIT
+ TAD C1000
+ TAD YUNIT /PUT IN 'GO' AND UNIT #
+IOT8, SDLC /LOOK FOR BLOCK NO.
+ JMS I CRDQUD /WAIT AT LEAST 6 LINES TO LOOK
+ JMS I CRDQUD
+CM200, 7600 /COULD HAVE SAVED A LOC. HERE
+SRCH, SDSS
+ JMP .-1 /WAIT FOR SINGLE LINE FLAG
+IOT9, SDRC
+ CLL RTL /DIRECTION TO LINK. INFO BITS
+ /ARE SHIFTED.
+ AND C374 /ISOLATE MARK TRACK BITS
+ TAD M110 /IS IT END ZONE?
+ SNA /THE LINK STAYS SAME THRU THIS
+ JMP ENDZ
+ TAD M20 /CHECK FOR BLOCK MARK
+ SZA CLA
+ JMP SRCH
+IOT10, SDRD /GET THE BLOCK NUMBER
+ SZL /IF WE ARE IN REVERSE, LOOK FOR 3
+ /BLOCKS BEFORE TARGET BLOCK. THIS
+ /ALLOWS TURNAROUND AND UP TO SPEED.
+ TAD C3 /REVERSE
+ CMA
+ TAD BLOCK
+ CMA /IS IT RIGHT BLOCK?
+ SNA
+ JMP FOUND /YES..HOORAY!
+M110, SZL SNA CLA /NO, BUT ARE WE HEADED FOR IT?
+ /ABOVE SNA IS SUPERFLUOUS.
+ JMP SRCH /YES
+ENDZ, SDRC /WE ARE IN THE END ZONE
+ CLL RTL /DIRECTION TO LINK
+ CLA /ARE WE IN REVERSE?
+ JMP GO /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3, CLL CLA
+ ISZ TRYCNT
+ JMP GO /TRY 3 TIMES
+ CLL CLA
+ JMP FATAL /LINK OFF MEANS AC=4000 ON RETURN
+EXIT, ISZ DTA0
+ CLL CML /AC=0 ON NORMAL RETURN
+FATAL, TAD YUNIT
+ SDLC /STOP THE UNIT
+ CLA CML RAR
+LEAVE, HLT
+ JMP I DTA0 /--RETURN--
+
+\f
+C6201, 6201
+C6203, 6203
+CRDQUD, RDQUAD
+WCOUNT, 0
+BUFF, 0
+MWORDS, 0
+YUNIT, 0
+CXFUN, XFUNCT
+M20, -20
+PGCT, 0
+CXWCT, XWCT
+C100, 100
+TRYCNT, -3
+BLOCK=DTA1
+
+
+ *ORIGIN+170
+FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION?
+ JMP GO /WRONG..TURN AROUND
+ TAD YUNIT /PUT UNIT INTO LINK
+ CLL RAL /AC IS NOW 0
+C70, 70 /********DON'T MOVE THIS!!!!******
+C3, 3
+ TAD BUFF /GET BUFFER ADDRESS
+XFIELD, HLT /INTO NEXT PAGE
+
+ *ORIGIN+200
+ XUNIT=EQUFUN
+
+ DCA XBUFF
+IOT16, SDRC
+IOT17, SDLC
+ RAR /NOW GET UNIT #
+ DCA XUNIT
+REVGRD, SDSS
+ JMP REVGRD /LOOK FOR REVERSE GUARD
+IOT11, SDRC
+ AND K77
+ TAD CM32 /IS IT REVERSE GUARD?
+ SZA CLA
+ JMP REVGRD /NO.KEEP LOOKING
+ TAD XWCT
+ DCA WORDS /WORD COUNTER
+ TAD XFUNCT /GET FUNCTION READ OR WRITE
+K7700, SMA CLA
+ JMP READ /NEG. IS WRITE
+WRITE, SDRC
+ AND C300 /CHECK FOR WRITE LOCK AND SELECT ERROR
+ CLL CML /LOCK OUT AND SELECT ARE AC 0 ERRORS
+ SZA CLA
+ JMP I CFATAL /FATAL ERROR. LINK MUST BE ON
+ JMS RDQUAD /NO ONE EVER USES THIS WORD!
+C7600, 7600
+ TAD C1400
+ TAD XUNIT /INITIATE WRITE MODE
+IOT12, SDLC
+ CLA CMA
+ JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM
+ CLA CMA
+ DCA CHKSUM
+WRLP, TAD I XBUFF /GLORY BE! THE ACTUAL WRITE!
+ JMS WRQUAD
+ ISZ XBUFF /BUMP CORE POINTER
+K77, 77 /ABOVE MAY SKIP
+ ISZ WORDS /DONE THIS BLOCK?
+ JMP WRLP /NOT YET..LOOP A WHILE
+ TAD XFUNCT /IS THE OPERATION FOR WDSBLK PER BLOCK?
+ CLL RTR /IF NO, WRITE A 0 WORD
+ SZL CLA
+\f
+ JMS WRQUAD /WRITE A WORD OF 0
+ JMS GETCHK /DO THE CHECK SUM
+ JMS WRQUAD /WRITE FORWARD CHECKSUM
+ JMS WRQUAD /ALLOW CHECKSUM TO BE WRITTEN
+ JMP I CRWCOM
+
+
+READ, JMS RDQUAD
+ JMS RDQUAD
+ JMS RDQUAD /SKIP CONTROL WORDS
+ AND K77
+ TAD K7700 /TACK 7700 ONTO CHECKSUM.
+ DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP, JMS RDQUAD
+ JMS EQUFUN /COMPUT CHECKSUM AS WE GO
+ DCA I XBUFF /IT GETS CONDENSED LATER
+ ISZ XBUFF
+C300, 300 /PROTECTION
+ ISZ WORDS /DONE THIS OP?
+ JMP RDLP /NO SUCH LUCK
+ TAD XFUNCT /IF OP WAS FOR WDSBLK-1, READ AND
+ CLL RTR /CHECKSUM THE LAST TAPE WORD
+ SNL CLA
+ JMP RDLP2
+ JMS RDQUAD /NOT NEEDED FOR WDSBLK/BLOCK
+ JMS EQUFUN /CHECKSUM IT
+RDLP2, JMS RDQUAD /READ CHECKSUM
+ AND K7700
+ JMS EQUFUN
+ JMS GETCHK /GET SIX BIT CHECKSUM
+ JMP I CRWCOM
+
+WRQUAD, 0 /WRITE OUT A 12 BIT WORD
+ JMS EQUFUN /ADD THIS TO CHECKSUM
+IOT13, SDSQ /SKIP ON QUADLINE FLAG
+ JMP .-1
+IOT14, SDLD /LOAD DATA ONTO BUS
+ CLA /SDLD DOESN'T CLEAR AC
+ JMP I WRQUAD
+
+RDQUAD, 0 /READ A 12 BIT WORD
+ SDSQ
+ JMP .-1
+IOT15, SDRD /READ DATA
+ JMP I RDQUAD
+
+\f
+EQUFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA EQUTMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD EQUTMP /EQUIVALENCE OF ALL WORDS IN A RECORD
+ AND CHKSUM /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE, WE CAN DO IT 12
+ CLL RAL /BITS AT A TIME AND CONDENSE LATER.
+ TAD EQUTMP /THIS ROUTINE USES THESE IDENTITIES:
+ TAD CHKSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CHKSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD EQUTMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EQUFUN
+
+GETCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CHKSUM
+ CMA
+ CLL RTL
+ RTL
+ RTL
+ JMS EQUFUN
+ CLA CLL CML /FORCES LINK ON AT RWCOM
+ TAD CHKSUM
+ AND K7700
+ JMP I GETCHK
+
+CFATAL, FATAL
+CRWCOM, RWCOM
+XFUNCT, 0
+CM32, -32
+C1400, 1400
+CHKSUM, 0
+WORDS, 0
+XBUFF, 0
+XWCT, 0
+EQUTMP, 0
+
+\fPAGE
+/
+/
+PARITY, 0
+ KRB
+ AND [177
+ TAD [200
+ JMP I PARITY
+
+/IOT TABLES FOR TD8E SUBROUTINE
+
+IOTLOC, IOT1
+ IOT2
+ IOT3
+ IOT4
+ IOT5
+ IOT6
+ IOT7
+ RWCOM
+ IOT8
+ SRCH
+ IOT9
+ IOT10
+ ENDZ
+ FATAL+1
+ REVGRD
+ IOT11
+ WRITE
+ IOT12
+ IOT13
+ IOT14
+ RDQUAD+1
+ IOT15
+ IOT16
+TABEND, IOT17
+
+UNITS=.
+ UNIT01
+ UNIT23
+ UNIT45
+ UNIT67
+
+RTAB, IOTR1
+ IOTR2
+ IOTR3
+ IOTR4
+ IOTR5
+ IOTR6
+
+
+/IOT TABLES FOR WORDS PER BLOCK ROUTINE
+
+TABLE1, IOTX1
+ IOTX2
+ IOTX3
+ IOTX4
+ IOTX5
+ IOTX6
+ IOTX7
+END1, IOTX8
+
+\fMESSG4, TEXT @FROM UNIT:@
+MESSG5, TEXT @TO UNITS:@
+ERROR5, TEXT @ILLEGAL FORMAT UNIT @
+ERROR6, TEXT @ UNIT @
+ERROR4, TEXT @ILLEGAL RESPONSE@
+
+\f
+PAGE
+/ONCE ONLY CODE
+
+END, JMS I (QUEST
+ MESSG2 /@HIGHEST FIELD AVAILABLE:@
+ ACL
+ AND [7
+ CIA
+ DCA FIELDS
+ TAD (CDF
+ DCA CDF00
+ TAD FIELDS
+ SNA /MORE THAN 1 FIELD??
+ JMP LIM /NO--NO PROBLEM
+ DCA COUNT1 /YES--ARE THEY ALL PRESENT?
+NEXT, TAD CDF00
+ TAD (10
+ DCA CDF00 /SET FOR DATA FIELD CHANGE
+ TAD (HLT
+CDF00, CDF
+ DCA I (10 /TRY LOCATION 10
+ TAD I (10
+ CDF 0
+ CIA
+ TAD (HLT
+ SNA CLA /IS FIELD THERE?
+ JMP NEXT1 /YES--TRY NEXT ONE
+ JMS I [MESSGE /NO
+ ERROR4 /ILLEGAL RESPONSE
+ JMS I [CRLF /CARRIAGE RETURN/LINE FEED
+ DCA COUNT /CLEAR COUNT
+ JMP END /TRY AGAIN
+NEXT1, ISZ COUNT1 /DONE YET?
+ JMP NEXT /NO
+
+LIM, TAD (LIMIT-END /SET BEGINNING OF VERIFY BUFFER
+ CLL RAR
+ TAD [END
+ DCA END0
+ TAD (NOP
+ DCA I (START1-1
+ JMP I (START1
+MESSG2, TEXT @HIGHEST FIELD AVAILABLE:@
+
+FIELD 0
+*200
+
+$
+\f\f
projects / pdp8.git / blobdiff