--- /dev/null
+/TC08 DECTAPE FORMATTER, V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 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/COPYRIGHT 1970 DIGITAL EQUIPMENT CORP.
+/MAYNARD, MASS.
+/REVISED APRIL 1970
+
+/ TOG-8 TO MARK AND CHECK PDP-8 DECTAPE
+/THIS PROGRAM WRITES TIMING AND MARK TRACKS ON
+/DECTAPE MOUNTED ON THE TCO1-TU55 TAPE CONTROL UNIT.
+
+
+
+
+
+ X1=10
+ X2=11
+
+/SYMBOL TABLE AUGMENTATION
+
+ DTRA=6761
+ DTCA=6762
+ DTXA=6764
+ DTSF=6771
+ DTRB=6772
+ DTLB=6774
+ DTCX=6766
+
+/SET 0 FOR THE LOGIN FEATURE
+
+ *0
+ 0
+ JMP I .+1
+ CONC /CONTROL "C" AND LOGIN
+
+/WORKING LOCATIONS
+
+ *20
+
+W1, 0000
+W2, 0000
+W3, 0000
+W4, 0000
+W5, 0000
+W6, 0000
+BLOCKS, 0000
+BLOCKA, 0000
+DTA, 0000
+ERX, 0000
+PHASE, 0000
+TOTAL, 0000
+VAR1, 0000
+VAR2, 0000
+\f/CONSTANTS
+
+C1, 0001
+C2, 0002
+C3, 0003
+C4, 0004
+C0017, 0017
+C0070, 0070
+C0077, 0077
+C0007, 0007
+C0030, 0030
+C0400, 0400
+C0700, 0700
+C203, 0203
+C201, 0201
+C210, 0210
+C260, 0260
+C261, 0261
+C267, 0267
+C270, 0270
+C271, 0271
+C277, 0277
+C1000, 1000
+C1620, 1620
+C7000, 7000
+C7700, 7700
+C7714, 7714
+C7761, 7761
+C7772, 7772
+C7775, 7775
+CRCOD, 0215
+LETK, 0313
+LFCOD, 0212
+M2, -2
+M3, -3
+M4, -4
+M6, -6
+M7, -7
+M14, -14
+M144, -144
+M300, -300
+SPCOD, 0240
+\f/INTERPAGE LINKS
+
+ADW2, W2-1
+ADW3, W3-1
+BADD, BUFFER-1
+BFR, BUFFER
+CA, 7755
+COMPAR, COMPRE
+FCON, 0000
+IT, INIT1
+FORMA, FORM-1
+FORMB, FORM
+QU1, Q1
+QU2, Q2
+QU3, Q3
+QU4, Q4
+MESS, MES
+STX, START
+TURN, TRN
+TYOCT, TYCT
+TYPE, MESAGE
+TYPIN, TYPN
+WAIT, STALL
+WC, 7754
+DBUFPT, 0 /POINTER TO CURRENT POSITION IN DTA LIST
+
+
+\f
+
+
+/TYPE THE CHARACTER IN THE AC ON THE KEYBOARD PRINTER
+
+RSEND, 0000
+ TLS /LOAD AND PRINT, CLEAR FLAG
+ TSF /WAIT FOR CONFIRMATION
+ JMP .-1 /ENDLESSLY
+ TCF /CLEAR THE FLAG ANYWAY
+ JMP I RSEND
+
+
+/PRINT A "?" ON THE KEYBOARD TYPER
+
+QU, .+1
+ IOF /KILL LOG AND CONTROL C FCTN
+ CLA CLL /C(AC)+C(L)=0
+ TAD C277 /"?"
+ JMS RSEND /TYPE THE CHARACTER
+ JMP I .+1 /RESTART
+ INIT
+
+/DECTAPE CONTROL WORDS
+
+DT0030, 0030
+DT0060, 0060
+DT0070, 0070
+DT0100, 0100
+DT0130, 0130
+DT0140, 0140
+DT0200, 0200
+DT0210, 0210
+DT0360, 0360
+DT0510, 0510
+DT0600, 0600
+DT0610, 0610
+
+/SOME SPECIAL LINKS
+
+ADBA, 2475
+ADWA, 2476
+ADWAB, 2477
+
+/CONSTANTS FOR FORMULA TRANSLATION SECTION
+
+BINCON, .+1
+ 0001
+ 0012
+ 0144
+ 1750
+\f *200 /PAGE 1
+/TYPE CANNED MESSAGES.....
+/THANKS TO DIGITAL 8-18-U
+
+MESAGE, 0
+ IOF /KILL LOG AND CONTROL FUNCTION
+ CLA CMA /SET C(AC)=-1
+ TAD MESAGE /ADD LOCATION
+ DCA 10 /AUTO INDEX REGISTER
+ TAD I 10 /FETCH FIRST WORD
+ DCA MSRGHT /SAVE IT
+ TAD MSRGHT
+ RTR
+ RTR /ROTATE 6 BITS TO THE RIGHT
+ RTR
+ JMS TYPECH /TYPE IT
+ TAD MSRGHT /GET DATA AGAIN
+ JMS TYPECH /TYPE RIGHT HALF
+ JMP MESAGE+5 /CONTINUE
+MSRGHT, 0 /TEMPORARY STORAGE
+TYPECH, 0 /TYPE CHARACTER IN C(AC)6-11
+ AND C0077
+ SNA /IS IT END OF MESSAGE?
+ JMP I 10 /YES: EXIT
+ TAD M40 /SUBTRACT 40
+ SMA /<40?
+ JMP .+3 /NO
+ TAD C340 /YES: ADD 300
+ JMP MTP /TO CODES <40
+ TAD M3 /SUBTRACT 3
+ SZA /IS IT ZERO?
+ JMP .+3 /NO
+ TAD C212 /YES: CODE 43 IS
+ JMP MTP /LINE-FEED (212)
+ TAD M2 /SUBTRACT 2
+ SZA /IS IT ZERO?
+ JMP .+3 /NO
+ TAD C215 /YES: CODE 45 IS
+ JMP MTP /CARRIAGE RETURN (215)
+ TAD C245 /ADD 200 TO OTHERS >40
+MTP, TLS /TRANSMIT CHARACTER
+ TSF /WAIT FOR THE FLAG
+ JMP .-1 /NOT SET YET
+ CLA /SET: CLEAR C(AC)
+ JMP I TYPECH /RETURN
+
+/CONSTANTS
+
+M40, -40
+C340, 340
+C212, 212
+C215, 215
+C245, 245
+\f/ROUTINE WAITS UNTILL A COMPLETE MESSAGE HAS BEEN ENTERED
+/SIGNIFIED BY A CR.
+
+TYPN, 0
+ IOF /KILL THE LOG AND CONTROL C FUNCTION
+ KCC /CLEAR AC, KEYBOARD FLAG
+ TAD BADD /GET BUFFER ADDRESS
+ DCA W1 /STORE FOR THE CHARACTER STRING
+
+/READ AND RESPOND WITH THE CHARACTER
+
+NTYRTN, ISZ W1 /NORMAL RETURN. INCREMENT BUFFER
+ KSF /WAIT FOR KEYBOARD
+ JMP .-1 /FLAG TO RAISE
+ KRB /GOT FLAG, RESET IT, GET CHARACTER
+ JMS RSEND /SEND CHARACTER BACK
+ AND (177 /TAKE CARE OF PARITY
+ TAD (200
+ DCA I W1 /LOAD CHARACTER INTO BUFFER AREA
+ TAD I W1 /CHECK FOR CTRL C
+ CIA
+ TAD C203
+ SZA CLA
+ JMP CHKSP /NO- CHECK FOR SPACE
+ 6007 /CTRL C -CLEAR ALL FLAGS
+ NOP /FOR OLD MACHINES
+ CLA /JUST IN CASE
+ DTLB /CLEAR STATUS REGISTER B
+ JMP I (7605
+
+/IF CHARACTER IS A SPACE, IGNORE IT
+
+CHKSP, TAD I W1 /CHARACTER INTO THE AC
+ CIA /SUBTRACT FROM SPACE CODE (240)
+ TAD SPCOD /COMPLETE COMPARISON
+ SNA CLA /WAS IT A SPACE?
+ JMP NTYRTN+1 /YES: DO NOT INCREMENT BUFFER
+
+/IF CHARACTER IS A CR, EXIT FROM ROUTINE
+
+ TAD I W1 /CHARACTER TO AC
+ CIA /SET AC TO SUBTRACT CR (215)
+ TAD CRCOD /COMPLETE COMPARISON
+ SZA CLA /WAS IT CR?
+ JMP NTYRTN /NO: INCREMENT BUFFER + WAIT
+
+/CARRIAGE RETURN FOUND, EXIT FROM ROUTINE
+
+ TAD LFCOD /GIVE KEYBOARD LINE FEED
+ JMS RSEND /EXECUTE LINE FEED
+ CLA CLL /EXIT WITH C(ACC) + AND C(L)=0
+ ION /RESET LOG AND CONTROL C FUNCTION
+ JMP I TYPN /RETURN TO CALL
+\f/COMPARE A STRING OF CHARACTERS IN "BUFFER"
+/TO A CHARACTER STRING AFTER A JMS IN ASCII
+
+COMPRE, 0
+ CLA CMA /C(AC)=7777
+ TAD COMPRE /SUBTRACT 1 FOR INDEX REG 1
+ DCA 10 /AUTO INDEX 1 SET TO CHA STRING
+ TAD BADD /AUTO INDEX 2 SET TO BUFFER-1
+ DCA 11 /LOAD X2
+
+/COMPARE CHARACTERS TILL ONE DOESN'T COMPARE OR TILL
+/A 0 IS FOUND IN X1. IF OK, RETURN TO TWO PLUS THE
+/ZERO, IF BAD ONE PLUS
+
+ TAD I X1 /CHARACTER FROM PROGRAM
+ CIA /TO SUBTRACT FROM
+ TAD I X2 /CHARACTER IN BUFFER
+ SZA CLA /COMPARE?
+ JMP CERR /NO:RESYNC FOR NON COMPARE EXIT
+ TAD I X1 /YES: CHECK FOR GOOD EXIT
+ SZA /IF 0, EXIT GOOD
+ JMP .-6 /NO: TEST NEXT CHAACTER
+ ISZ X1 /+1 TO X1(TOTAL 2 FROM THE 0)
+ JMP I X1 /+1 TO X1, EXIT
+
+/ERROR FOUND. RESYNC AND EXIT NO COMPARE
+
+CERR, TAD I X1 /CHARACTER FROM PROGRAM
+ SZA CLA /IS THIS EXIT KEY? (0000)
+ JMP .-2 /NO: GET NEXT
+ JMP I X1 /YES: EXIT, NOT COMPARE
+\f\f *400
+/VARIOUS ERROR MESSAGES
+/"NOT DECIMAL"
+
+Q1, JMS I TYPE
+ 1617 /NO
+ 2440 /T
+ 0405 /DE
+ 0311 /CI
+ 1501 /MA
+ 1400 /L
+ JMP QUX
+
+/"TO MANY WORDS"
+
+Q2, JMS I TYPE
+ 2417 /TO
+ 1740 /O
+ 1501 /MA
+ 1631 /NY
+ 4027 / W
+ 1722 /OR
+ 0423 /DS
+ 0000 /00
+ JMP QUX
+
+/"TO MANY BLOCKS"
+
+Q3, JMS I TYPE
+ 2417 /TO
+ 1740 /O
+ 1501 /MA
+ 1631 /NY
+ 4002 / B
+ 1417 /LO
+ 0313 /CK
+ 2300 /S0
+ JMP QUX
+
+/"NOT DIVISIBLE BY 3"
+Q4, JMS I TYPE
+ 1617 /NO
+ 2440 /T
+ 0411 /DI
+ 2611 /VI
+ 2311 /SI
+ 0214 /BL
+ 0540 /E
+ 0231 /BY
+ 4063 / 3
+ 0000 /00
+QUX, JMS I TYPE
+ 4345 /CR+LF
+ 0000 /END
+ JMP I .+1
+ INIT
+\f/THE CODING BELOW CREATES THE BLOCK NUMBER
+/CONVERSION PRIOR TO THE TAPE WRITE.
+
+MES, 0
+ DCA W4 /BLOCK NUMBER GIVEN IN AC
+ TAD W4 /RESTORE TO AC AGAIN
+ CMA /COMPLEMENTED
+ RTL
+ RAL /LEFT 3
+ DCA W5 /TEMP SAVE
+ TAD W5 /TO AC AGAIN
+ AND C7000 /ISOLATE HIGH CHA
+ DCA V2 /FORWARD BLOCK NUMBER
+ TAD W5 /SHIFTED VALUE
+ AND C0070 /ISOLATE 6,7,8
+ DCA V1 /FORWARD BLOCK NUMBER
+ TAD W4 /ORIGIONAL SET
+ CMA /UPSIDE DOWN
+ RTR
+ RAR /RIGHT 3
+ DCA W5 /TEMP SAVE
+ TAD W5 /TO AC AGAIN
+ AND C0700 /ISOLATE 3,4,5
+ TAD V2 /COMBINE FORWARD BLOCK NUMBER
+ TAD C0077
+ DCA V2 /1/2 COMPLETE
+ TAD W5 /SHIFTED VALUE
+ AND C0007 /ISOLATE 9, 10,11
+ TAD V1 /COMBINE WITH BN
+ DCA V1 /FORWARD BLOCK NUMBER COMPLETE
+
+/CONVERT REVERSE BLOCK NUMBER
+
+ CMA /-1 TO GIVEN BLOCK #
+ TAD W4 /ORIGIONAL BLOCK #
+ DCA W5 /TEMP SAVE
+ TAD W5 /TO AC AGAIN
+ RTR
+ RTR /6 RIGHT
+ RTR
+ AND C0077 /ISOLATE LOW
+ DCA V3 /HIGH REVERSE
+ TAD W5 /COMPLEMENT ORIGIONAL -1
+ RTL
+ RTL /6 LEFT
+ RTL
+ AND C7700 /ISOLATE HIGH
+ DCA V4 /REVERSE COMPLETED
+ JMP I MES
+\f/FORM USED TO WRITE 12 DATA WORDS FOR BLOCK NUMBERING
+
+FORM, 0000
+ 0000
+ 0000
+ 0000
+V1, 0000
+V2, 0000
+ 7777
+ 7700
+ 0000
+V3, 0000
+V4, 0000
+ 0000
+\f//THIS ROUTINE ALLOWS KEYBOARD INTERRUPTION
+/FOR LOGGING ON THE KEYBOARD, OR FOR A MAJOR
+/CLEAR IN THE PROGRAM. BY HITTING "CONTROL C"
+/A SYSTEM RESTART WILL OCCUR.
+
+CONC, TSF /IS THE PRINTER FLAG ON?
+ JMP .+5 /NO, CHECK READER
+ TCF /YES: RESET IT
+ KSF /IS THE READER FLAG ON?
+ JMP RTNS /NO: RETURN TO SEQUENCE
+ JMP .+3
+ KSF
+ HLT
+
+/OK. CHECK FOR EITHER LOG OR CONTROL C.
+
+ DCA MES /SAVE C(AC)
+ RAL /SAVE THE LINK
+ DCA RSYC+6 /FOR LOGGING
+ KRB /GET CHARACTER FROM KEYBOARD
+ TLS /RETURN CHARACTER
+ CIA /TO SEE IF
+ TAD C203 /"CONTROL C"
+ SNA CLA /IS IT?
+ JMP RSYC /YES: RESYNC THE PROGRAM
+ TAD RSYC+6 /RESTORE THE LINK
+ RAR /FOR EXIT.
+ TAD MES /THE AC TOO
+RTNS, ION /INTERRUPT ON
+ JMP I 0 /RETURN
+\f
+*600
+/RESYNC THE SYSTEM TO START
+
+RSYC, TSF /WAIT FOR FLAG
+ JMP .-1 /ON LAST SENDOFF
+ JMS I TYPE
+ 2205 /RE
+ 2331 /SY
+ 1603 /NC
+ 0000 /END
+ TAD DTA /TO KILL EXISTING TAPE MOTION
+ DTCX /NOW
+ JMP I STX /RETURN TO START
+\f/WAIT FOR THE DECTAPE FLAG TO RISE
+
+STALL, 0
+ CLA
+ DTRB /READ TCU "B" REGISTER
+ SPA /ERROR?
+ JMP ERROR /YES, DECIDE WHAT TO DO
+ RAR /DECTAPE FLAG TO LINK
+ SNL CLA /FLAG?
+ JMP .-5 /NO: CONTINUE WATCH
+RERR, DTXA /RESET THE DECTAPE FLAG
+ DCA ERX /CLEAR THE END TAPE FLAG
+ JMP I STALL /GOT FLAG, EXIT
+
+/DRIVE TAPE INTO THE END ZONE, AND TURN IT
+/AROUND.
+/IF C(AC)=0400, TAPE INTO REVERSE END ZONE
+/IF C(AC)=0000, TAPE INTO FORWARD END ZONE
+
+TRN, 0
+ ISZ ERX /END ZONE IS LEGAL
+ DCA W4 /SAVE DIRECTION
+ TAD DT0200 /MOVE FUNCTION,GO
+ TAD W4 /DIRECTION TO MOVE
+ TAD DTA /DRIVE TO MOVE
+ DTCX /CLEAR AND RESET "A"
+ JMS I WAIT /FOR END ZONE FLAG
+ TAD DT0610 /SEARCH, GO
+ TAD W4 /DIRECTION TO SEARCH
+ AND C0777 /DELETE OVERFLOW BIT
+ TAD DTA /SET THE DECTAPE
+ DTCX /RESET STATUS "A"
+ DCA ERX /END ZONE NOT LEGAL NOW
+ JMP I TRN /RETURN TO SEQUENCE
+C0777, 0777
+
+\f/AN ERROR FLAG HAS BEEN SET. IN SOME CASES
+/END ZONE IS LEGAL, OTHERWISE, A RESTART ATTEMPT
+/MAY BE INITIATED.
+
+/DETERMINE WHICH FLAG SET THE DECTAPE FLAG
+
+ERROR, DCA W5 /SAVE "B" REGISTER
+ TAD DTA /GOING TO KILL
+ DTCX /TAPE MOTION
+ TAD W5 /RESTORE "B" REGISTER
+ RTL /POSITION BITS 1+2
+ SPA /END OF TAPE FLAG?
+ JMP ZEOT /YES: GO TO ROUTINE
+ SZL /MARK TRACK ERROR?
+ JMP ZMKTK /YES: GO TO ROUTINE
+ RTL /POSITION BITS 2+3
+ SPA /PARITY ERROR?
+ JMP ZPAR /YES: GO TO PARITY ERROR ROUTINE
+ SZL CLA /SELECT ERROR?
+ JMP ZSEL /YES: GO TO ROUTINE
+ JMP ZTIM /MUST BE TIMING ERROR
+
+/END OF TAPE FLAG FOUND, SEE IF IT'S LEGAL
+
+ZEOT, CLA CLL /CLEAR REMAINS
+ TAD ERX /SWITCH
+ SZA CLA /ERROR?
+ JMP RERR /OK, IT'S LEGAL
+
+/NOT LEGAL END ZONE FLAG
+
+ JMS I TYPE
+ 0516 /EN
+ 0440 /D
+ 2401 /TA
+ 2005 /PE
+ 4000 / 0
+ JMP ZCOM
+
+/MARK TRACK ERROR
+
+ZMKTK, JMS I TYPE
+ 1501 /MA
+ 2213 /RK
+ 4024 / T
+ 2201 /RA
+ 0313 /CK
+ 4000 / 0
+ JMP ZCOM
+\f/PARITY ERROR
+
+ZPAR, JMS I TYPE
+ 2001 /PA
+ 2211 /RI
+ 2431 /TY
+ 4000 / 0
+ JMP ZCOM
+
+/SELECT ERROR
+
+ZSEL, JMS I TYPE
+ 2305 /SE
+ 1405 /LE
+ 0324 /CT
+ 4000 / 0
+ JMP ZCOM
+
+/TIMING ERROR
+
+ZTIM, JMS I TYPE
+ 2411 /TI
+ 1511 /MI
+ 1607 /NG
+ 4000 / 0
+
+/TYPE "ERROR PHASE X"
+
+ZCOM, TAD PHASE /WHAT PHASE OF OPERATION
+ TAD PFORM /WAS THE MACHINE IN
+ DCA TFORM /WHEN ERROR OCCURED
+ JMS I TYPE
+ 0522 /ER
+ 2217 /RO
+ 2240 /R
+ 2010 /PH
+ 0123 /AS
+ 0540 /E
+TFORM, 4060 / X
+ 4345 /CR+LF
+ 0000 /END
+ JMS I TYPIN
+
+/HE CAN RESTART IF HE TYPES "RETRY"
+
+ JMS I COMPAR
+ 0322 /R
+ 0305 /E
+ 0324 /T
+ 0322 /R
+ 0331 /Y
+ 0000 /0
+ JMP I IT /GUESS HE DOESN'T WISH TO TRY AGAIN
+\f/ATTEMPT RESTART. NOTE, "ATTEMPT"
+
+ TAD PHASE /RESTART ACCORDING TO
+ TAD ZFORM /WHICH PHASE WAS HE IN
+ DCA .+3
+ JMP I .+2
+ZFORM, .+2
+ 0000
+ JMP I .+5 /PHASE 0
+ JMP I .+5 /PHASE 1
+ JMP I .+5 /PHASE 2
+ JMP I .+5 /PHASE 3
+ JMP I .+5 /PHASE 4
+ START
+ PSER
+ DOBLK
+ DBN
+ NOP
+PFORM, 4060
+\f
+
+
+/HERE STARTS THIS PROGRAM. IT WILL ASK THE
+/OPERATOR FOR DRIVE NUMBERS, THEN ASK HIM FOR
+/A DIRECTION ON WHAT TO DO WITH THE DRIVES.
+
+/THE SEQUENCE FOR MARKING A TAPE WOULD APPEAR AS:
+
+
+/DTA? (3 OR 1 2 3 OR 2 4 7)
+/DIRECT? (MARK 1215)
+/2277 WORDS, 0256 BLOCKS.OK? YES OR NO
+/(YES)
+
+
+/THAT DATA IN PARENTHESIS IS TYPED BY THE OPERATOR
+/(HE DOESN'T TYPE THE PARENTHESIS)
+/IF HE HAD ANSWERED NO, "DIRECT?" WOULD BE TYPED OUT.
+/IF THE DRIVE WAS WRONG, HE WOULD TYPE RESTART.
+/IF HE HAD TYPED "MARK" IN RESPONSE TO "DIRECT?" THE
+/TAPE WOULD BE MARKED WITH THE STANDARD PDP-8 CONFIGURATION.
+/IF HE HAD TYPED "MARK 384" THE TAPE WOULD
+/BE MARKED WITH THE STANDARD PDP-10 CONFIGURATION
+/NOTE: THE WORD AND BLOCK NUMBERS ARE TYPED IN OCTAL
+/IF A MISTAKE OCCURS ON THE OPERATORS PART (WITH REFERANCE
+/TO BLOCK + WORD SIZE) HE WILL BE TOLD ABOUT IT
+
+
+
+
+
+\f *1000
+
+/MAKE A CALL FOR THE DECTAPE NUMBERS TO BE
+/WORKED.
+
+
+START0, JMS I TYPE /PRINT TITLE
+ 4543
+ 4300
+ JMS I TYPE
+ TEXT /DTFRMT V4A/
+
+
+START, JMS I TYPE /SET UP TYPER
+ 4543 /CR+LF
+ 4300 /LF+END
+TYQU, JMS I TYPE /"DTA?"
+ 0424 /DT
+ 0177 /A?
+ 4000 / END
+
+/WAIT FOR A REPLY
+
+ JMS I TYPIN /GET NUMBERS
+ TAD BADD /INITIALIZE POINTER (BFR)
+ IAC /(BADD=BUFFER-1, SO BUMP THE AC)
+ DCA BFR /TO START OF INPUT BUFFER
+ DCA DCTR /INITIALIZE DTA COUNTER TO 0
+ DCA CRFLAG /CLEAR FLAG SO CR NOT ACCEPTIBLE
+CRCHK, TAD CRCOD /GET CODE FOR CAR. RETN
+ CIA /NEGATE IT
+ TAD I BFR /SEE IF NEXT CHAR. IN
+ SNA /BUFFER IS CAR. RETN.
+ JMP OKCR /YES: SEE IF C.R. LEGAL HERE
+ DCA CRFLAG /NO: SO C.R. IS LEGAL NOW
+VALCHK, TAD C261 /SEE IF # IS LESS THAN
+ CIA /ASCII 1 (261)
+ TAD I BFR /SUBTRACT BUFFER DATA
+ SPA CLA /IS IT LESS THAN ASII 0?
+ JMP TYQU /YES: TELL OUTSIDE WORLD
+ TAD C270 /NO: SEE IF GREATER THAN
+ CMA /ASC II 8 (270)
+ TAD I BFR /SUBTRACT BUFFER DATA
+ SMA CLA /GREATER THAN ASCII 7?
+ JMP TYQU /YES: TELL OUTSIDE WORLD
+ TAD I BFR /NO: ACCEPT BUFFER
+ RTR
+ RTR /4 BITS RIGHT
+ AND C7000 /ISOLATE DTA
+ JMS REPEAT /GO CHECK FOR REPEATED DTA AND STORE #
+ ISZ BFR /INCREMENT INPUT BUF. PTR.
+ JMP CRCHK /GO LOOK AT NEXT CHAR.
+
+/THIS SECTION CHECKS TO SEE IF THERE HAS BEEN ANY
+/VALID INPUT ONCE A CARRIAGE RETURN IS SEEN
+OKCR, CLA /CLEAR AC
+ TAD CRFLAG /LOAD CR FLAG; 0 MEANS NO GOOD
+ SNA CLA
+ JMP START /0: NO VALID INPUT; RESTART
+ TAD DCTR /NOT 0: SO HAVE VALID INPUT
+ TAD DBUFAD /CALCULATE END OF DTA LIST +1
+ DCA DBUFPT /STORE IT IN BUFFER POINTER, THEN
+ CMA /COMPLEMENT THE AC AND
+ DCA I DBUFPT /TERMINATE DTA LIST WITH 7777
+INIT1, CLA /CLEAR AC IF COME THRU LOC IT
+ TAD DBUFAD /AND RESET LIST POINTER
+ DCA DBUFPT /TO START OF LIST
+ JMS I GETDTA /GO GET A DTA NUMBER
+
+/INFORM THE OPERATOR THAT THE PROGRAM IS SET TO START
+/TYPE "DIRECT" AND WAIT FOR THE REPLY
+
+INIT, JMS I TYPE /MESSAGE OUT
+ 0411 /DI
+ 2205 /RE
+ 0324 /CT
+ 7740 /?
+ 0000 /END
+ JMS I TYPIN /WAIT FOR A REPLY
+ JMS I COMPAR /DID HE TYPE "MARK"?
+ 0315 /M
+ 0301 /A
+ 0322 /R
+ 0313 /K
+ 0000 /END
+ JMP .+3
+ JMP I .+1
+ MARK /TO MARK A TAPE
+\f/SEE IF HE TYPED "RDR" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS IN REVERSE).
+
+ JMS I COMPAR
+ 0322 /R
+ 0304 /D
+ 0322 /R
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RDR /TYPE BLOCKS
+
+/SEE IF HE TYPED "RDF" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS FORWARD).
+
+ JMS I COMPAR
+ 0322 /R
+ 0304 /D
+ 0306 /F
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RDFA /TYPE BLOCKS
+
+/SEE IF HE TYPED "SAME" (MEANING MARK A TAPE
+/USING THE SAME CONSTANTS AS BEFORE).
+
+ JMS I COMPAR
+ 0323 /S
+ 0301 /A
+ 0315 /M
+ 0305 /E
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RSTSM /TO MARK AS BEFORE
+
+/SEE IF HE TYPED "RESTART"
+
+ JMS I COMPAR
+ 0322 /R
+ 0305 /E
+ 0323 /S
+ 0324 /T
+ 0301 /A
+ 0322 /R
+ 0324 /T
+ 0000 /0
+ JMS QU /MUST BE NONSENSE
+ JMP START /START ALL OVER
+GETDTA, NUDTA /POINTER TO ROUTINE TO SWITCH UNITS
+CRFLAG, 0 /=0, CR NO GOOD; NOT 0, CR IS OK
+\f/
+\f *1200
+/MARK WAS TYPED IN, IF W1-1 IS NOT A "K",ASSUME THAT
+/A NUMBER WAS TYPED IN, AND VERIFY THIS. IF W1-1 IS
+/A "K", ASSUME STANDARD FORMAT.(W1=LAST ENTRY INTO THE BUFFER)
+
+MARK, TAD BINCON /ADDRESS OF FIRST BINARY
+ DCA W5 /CONSTANT FOR DEC TO BIN
+ DCA TOTAL /WILL BE BINARY EQUIVILANT
+
+/SAVE C(X1) FOR DECREMENT THROUGH BUFFER
+
+DNC, CLA CMA /DECREMENT BUFFER ADDRESS
+ TAD W1 /ADDRESS BY 1
+ DCA W1 /W1=SWEEP ADDRESS
+
+/LOOK FOR END OF PROCESSING BY LOOKING FOR A "K" IN BUFFER
+
+ TAD LETK /LETTER ASCII "K"
+ CIA /SUBTRACT FROM CHARACTER
+ TAD I W1 /IN BUFFER
+ SNA CLA /EQUAL?
+ JMP DIV3 /YES: SEE IF DIVISIBLE BY 3
+
+/VERIFY THIS CHARACTER AS BEING OF DECIMAL ORIGIN
+
+ TAD C260 /ASCII FOR 0
+ CIA /TO SEE IF CHARACTER
+ TAD I W1 /IS LESS THAN 260
+ SPA CLA /IS IT?
+ JMP I QU1 /YES: NOT DECIMAL CHARACTER
+ TAD C271 /ASCII FOR 9
+ CMA /TO SEE IF GREATER THAN
+ TAD I W1 /9
+ SMA CLA /IS IT?
+ JMP I QU1 /NOT A DECIMAL CHARACTER
+\f/CHARACTER IS DECIMAL. NOW CONVERT IT TO BINARY
+/REMEMBER POSITION OF CHARACTER IN BUFFER MAY BE
+/10,100,1000.
+
+ TAD I W1 /ISOLATE THE NUMBER
+ AND C0017 /FOR PROPER CONVERSION
+ SNA /IF 0, NO BINARY CONVERSION NEEDED
+ JMP IBS /YES: 0: INCREMENT BINARY CONVERSION
+
+/NOT 0, SET UP CONVERSION LOOP
+
+ CLL CIA /NUMBER OF ADDITIONS
+ DCA W4 /TO NEGATIVE FOR ISZ
+ TAD I W5 /BINARY POSITION TO C(ACC)
+ TAD TOTAL /ADD TO PRESENT TOTAL
+ SZL /CHECK ON TO MANY WORDS
+ JMP I QU2 /TO MANY WORDS CALLED FOR
+ DCA TOTAL /KEEP RUNNING SUM
+ ISZ W4 /LAST ADDITION?
+ JMP .-6 /NO: ADD AGAIN
+
+/FINAL ADDITION FOR THIS POSITION COMPLETED
+
+IBS, ISZ W5 /NEXT POSITION
+ JMP DNC /DO NEXT CHARACTER
+
+/LAST CHARACTER COMPLETED. SEE IF DIVISIBLE BY 3
+/IF NOT A NORMAL INPUT
+
+DIV3, TAD TOTAL /GET TOTAL WORDS
+ SNA /IF TOTAL 0, NORMAL INPUT
+ TAD C201 /129 OCT. THIS TEST REDUNDANT
+ TAD C0017 /ADD CONSTANT 15 TO TOTAL
+ DCA TOTAL /FOR FUTURE CONSIDERATIONS
+ DCA VAR1 /# OF WORDS/3 FOR MARK TRACK WRITING
+ TAD TOTAL /RESTORE IN THE ACC
+ CLL /TO DIVIDE BY 3, LINK KEEPS OVERFLOW
+ TAD M3 /SUBTRACT 3
+ ISZ VAR1 /ON EACH DIVISION, KEEP RUNNING SUM
+ SZA /IF AC = 0,NO REMAINDER
+ SNL /WHEN LINC GOES TO 0, DIVISION ENDED
+ SKP /NOW SEE IF IT DIVIDED EVENLY
+ JMP .-6 /SUBTRACT 3 MORE
+ SZA CLA /IF 0,OK. OTHERWISE ERROR
+ JMP I QU4 /NOT DIVISIBLE BY 3
+
+/CORRECT "VAR1" ( THE NUMBER OF WORDS/3) FOR THE +15
+/ADDED JUST ABOVE AND AN INHERANT +2 DUE TO MARK TRACK
+/CONFIGURATION TO BE WRITTEN.
+
+ TAD M7 /SUBTRACT 7 FROM PHONY SETUP
+ TAD VAR1 /GIVING THE NUMBER OF TIMES
+ CIA /TO BE USED LATER IN A ISZ
+ DCA VAR1 /DATA MARK WILL BE WRITTEN
+\f
+/COMPUTE A VALUE FOR TOTAL NUMBER OF BLOCKS
+/RECORD SIZE + 15 INTO 636160 OCT.
+
+ TAD C7714 /EXTENDED 64 VALUE. SETS AC#2
+ DCA W1 /SET FOR 640000
+ JMS I FORM10 /PATCH TO CHECK FOR STD.10 FORMAT
+ TAD C1620 /VERNIER ADJUSTMENT FOR FORMULA
+ CLL /ACC#2 CARRY FUNCTION
+ TAD TOTAL /WORD COUNT
+ ISZ BLOCKS /+1 TO BLOCK COUNT
+ SKP
+ JMP I QU3 /TO MANY BLOCKS CALLED FOR
+ SNL /CARRY INTO ACC#2?
+ JMP .-5 /NO: CONTINUE COUNT
+ ISZ W1 /YES: FULLY DIVIDED?
+ JMP .-10 /NO: CONTINUE PROCESS
+ CLA CLL /C(ACC)+ C(L)=0
+F10RTN, TAD BLOCKS /FOR MARK TRACK (COME HERE FR F10PAT IF 10 FRMT)
+ CMA /WRITING
+ DCA VAR2 /SEE MARK WRITE
+
+/VALUES FOR BLOCK AND RECORD SIZE HAVE BEEN
+/COMPUTED. TELL OUTSIDE WORLD AND GET THE OK.
+
+ TAD TOTAL /SUBTRACT 15 FROM TOTAL
+ TAD C7761 /WORDS FOOLING OPERATOR
+ DCA TOTAL /CORRECTED FOR TAPE WRITING
+ TAD TOTAL /FOR OCTAL TYPEOUT
+ JMS I TYOCT /TYPE OCTAL WORDS
+ JMS I TYPE /TYPE MESSAGE
+ 4027 / W
+ 1722 /OR
+ 0423 /DS
+ 5400 /, END
+ TAD BLOCKS /TYPE OUT BLOCK #S
+ IAC /TO FOOL THE OPERATOR
+ JMS I TYOCT /IN OCTAL
+ JMS I TYPE /TYPE MESSAGES
+ 4002 / B
+ 1417 /LO
+ 0313 /CK
+ 2356 /S.
+ 1713 /OK
+ 7733 /?(
+ 3105 /YE
+ 2340 /S
+ 1722 /OR
+ 4016 / N
+ 1735 /O)
+ 4543 /CR+LF
+ 0000 /END
+ JMS I TYPIN /WAIT FOR REPLY
+\f/SEE IF A YES OR NO ANSWER WAS GIVEN
+
+ JMS I COMPAR
+ 0331 /Y
+ 0305 /E
+ 0323 /S
+ 0000 /END
+ JMP I IT
+
+/SEE IF THE DRIVE IS OK
+
+RSTSM, TAD DT0060 /GIVE WRTM, NO GO
+ TAD DTA /AND DTA #
+ DTCX /ORDER EXECUTE
+ DCA W1 /STALL FUNCTION
+CDTRD, DTRB /READ STATUS "B"
+ SMA CLA /ERROR?
+ JMP CIZ /NO: TIME OUT STALL
+ JMS I TYPE /YES: INCORRECT SETUP
+ 2305 /SE
+ 2425 /TU
+ 2077 /P
+ 0000 /END
+ JMP I .+1
+ START
+
+/STALL FOR A WHILE FOR THE INTERRUPT
+
+CIZ, ISZ W1 /ONE ROUND'S WORTH
+ JMP CDTRD /OF ISZ
+ JMP I .+1
+ STMK /OK, GO DO THE MARK TRACK
+FORM10, F10PAT
+
+\f *1400
+/SET THE TAPE INTO MOTION. ALL VARIABLES ARE
+/SET. FROM THIS POINT ON, CONTROL IS EXECUTED
+/VIA THE WCO INTERRUPT
+
+/CLEAR OUT STATUS "A" AND RELOAD IT WITH CONTINUOUS
+/WRITE TIMING AND MARK TRACK COMMAND
+
+STMK, TAD DT0360 /FWD, CONT, T+M,GO,INT
+ TAD DTA /ADD IN THE DTA
+ DTCX /CLEAR FLAGS START MOTION
+ DCA PHASE /FOR ERROR ROUTINE
+ TAD VAR2 /TO MAKE A RESTART FOR THE "SAME"
+ DCA W6 /OPTION POSSIBLE
+
+/WRITE END ZONE. WRITE ABOUT 10' OF THIS
+/CONFIGURATION. 4044
+/ 0440 ON TAPE AS
+/ 4404 (5555) OCTAL.
+
+ DCA W1 /CLEAR COUNTER, 7777= ABOUT 10'
+CEZ, TAD REZ /LOAD ADDRESS OF DATA
+ DCA I CA /TO BE WRITTEN INTO THE CA
+ TAD M3 /LOAD # WORDS TO BE WRITTEN INTO
+ DCA I WC /WC LOCATION
+
+/WAIT FOR INTERRUPT, TEST FOR END OF
+/END ZONE WRITING.
+
+ JMS I WAIT /FOR INTERRUPT
+ ISZ W1 /END OF FOOTAGE?
+ JMP CEZ /NOT END FOOTAGE, CONTINUE
+ /OK, WRITE INTERBLOCK SYNC
+
+/WRITE INTERBLOCK SYNC. SINCE THIS CONFIGURATION
+/ACT AS A NOP TO THE TCU, AT THE BEGINING OF
+/TAPE, MORE LENGTH OF THIS IS NEEDED FOR TURN AROUND
+/TIME TO GUARANTEE BLOCK 0000 TO THE LIBRARY SYSTEM
+/THEREFORE AT THE BEGINING OF TAPE ONLY, WRITE SEVERAL
+/INTERBLOCK ZONES
+
+ TAD M144 /NUMBER OF TIMES TO
+ DCA W1 /WRITE INTERBLOCK SYNC
+ JMS INBLSY /WRITE 1 INTERBLOCK SYNC
+ ISZ W1 /CONFIGURATION, TEST END
+ JMP .-2 /NOT TOTAL FOOTAGE. WRITE AGAIN
+ JMP WDZ /COMPLETED, GO ON
+\f/AT NORMAL RETURN, WRITE ONLY ONE INTERBLOCK SYNC
+/CONFIGURATION. APPEARS AS 0404
+/ 0404 ON TAPE AS
+/ 0404 2525 OCTAL
+
+INBLSY, 0
+ TAD IBZ /COUNTER AND WORD
+ DCA I CA /COUNT WITH KEYS
+ TAD M3 /FOR CONTROL
+ DCA I WC
+ TAD VAR1 /RESET THE WORDS
+ DCA W5 /PER BLOCK COUNTER
+
+/WAIT FOR INTERRUPT, RETURN TO SEQUENCE
+
+ JMS I WAIT /FOR INTERRUPT
+ JMP I INBLSY
+
+
+/WRITE FORWARD BLOCK MARK AND REVERSE GUARD
+/THREE WORDS 0404
+/ 4004 ON TAPE AS
+/ 4040 2632 OCTAL
+
+WDZ, TAD FBM /ADDRESS OF PATTERN
+ DCA I CA /TO CURRENT ADDRESS
+ TAD M3 /NUMBER OF WORDS
+ DCA I WC /TO WORD COUNTER
+ JMS I WAIT /DROP THROUGH AFTER WRITE
+
+
+/WRITE LOCK MARK, REVERSE CKSUM, REVERSE FINAL,REV PREFINAL
+/SIX WORDS 1. 0040 4. 0040
+/ 2. 0000 5. 0000 ON TAPE OCTAL
+/ 3. 4000 6. 4000 10101010
+
+ TAD WLMRF /ADDRESS OF PATTERN
+ DCA I CA /TO CURRENT ADDRESS
+ TAD M6 /NUMBER OF WORDS
+ DCA I WC /TO WORD COUNTER
+ JMS I WAIT /DROP THROUGH AFTER WRITE
+
+
+/ WRITE THE DATA TRACK. SINCE THE LENGTH OF EACH
+/RECORD IS A VARIABLE, "VAR1" KEEPS TRACK OF THE
+/NUMBER OF TIMES THIS CONFIGURATION WILL BE WRITTEN
+/"VAR1" WAS DECIDED FROM ABOVE IN THE FORMULA
+/TRANSLATION SECTION
+/THREE WORDS 4440
+/ 0044 ON TAPE AS
+/ 4000 7070 OCTAL
+DTRK, TAD DZ /LOAD ADDRESS OF THE DATA
+ DCA I CA /CONFIGURATION INTO CA
+ TAD M3 /LOAD # WORDS
+ DCA I WC /INTO WORD COUNT
+\f/WRITE ONE SET TEST "VAR1" FOR LAST SET
+
+ JMS I WAIT /ONE CONFIGURATION
+ ISZ W5 /LAST?
+ JMP DTRK /NOW WRITE DATA MARK TRACK AGAIN
+
+/ MARK TRACK CODE FOR DATA IS COMPLETE. NOW WRITE
+/PREFINAL, FINAL, CHECKSUM AND REVERSE CHECKSUM.
+/SIX WORDS 1 4440 4 4440
+/ 2 4444 5 4444 ON TAPE AS
+/ 3 4044 6 4044 73737373 OCTAL
+
+ TAD FEZ /LOAD ADDRESS OF
+ DCA I CA /DATA CONFIGURATION INTO CA
+ TAD M6 /LOAD # WORDS
+ DCA I WC /INTO WORD COUNT
+ JMS I WAIT /TILL COMPLETED WRITE
+
+
+
+/WRITE GUARD, REVERSE BLOCK
+/THREE WORDS 4040
+/ 0440 ON TAPE AS
+/ 0404 5145 OCTAL
+
+ TAD GRZ /DATA ADDRESS TO
+ DCA I CA /THE CA
+ TAD M3 /NUMBER OF WORDS
+ DCA I WC /TO WORD COUNT
+ JMS I WAIT /TILL COMPLETE
+
+
+
+/THIS COMPLETE SET OF DATA TRANSFERES
+/COMPLETES ONE BLOCK ON TAPE. SINCE THE
+/NUMBER OF BLOCKS IS VARIABLE, "VAR2" IS
+/USED TO RECYCLE. "VAR2" WAS SET UP ABOVE IN
+/THE FORMULA TRANSLATION SECTION
+
+ JMS INBLSY /WRITE INTERBLOCK SYNC
+ ISZ W6 /TOTAL NUMBER OF BLOCKS
+ JMP WDZ /WRITTEN? NO:
+
+
+\f/ALL DATA BLOCKS HAVE BEEN WRITTEN.
+/NOW PROVIDE A BUFFER ZONE OF INTERBLOCK SYNC AT THE END
+/OF TAPE AS AT THE START OF TAPE
+
+ TAD M144 /ABOUT TWO BLOCKS(STANDARD) WORTH
+ DCA W1 /ABOUT 100 TIMES
+ JMS INBLSY /WRITE ONE PATTERN
+ ISZ W1 /AT END YET?
+ JMP .-2 /NO CONTINUE WRITING INTERBLOCK SYNC
+
+/COMPLETED BLOCK WRITING
+/WRITE ANOTHER 10' OF END ZONE (FORWARD)
+/BEFORE LOADING BLOCK NUMBERS.
+/THREE WORDS 0400
+/ 4004 ON TAPE AS
+/ 0040 2222 OCTAL
+
+ DCA W1 /ISZ=10 FEET
+WEZF, TAD EZM /LOAD ADDRESS OF DATA
+ DCA I CA /INTO CA
+ TAD M3 /NUMBER OF WORDS
+ DCA I WC /WORD COUNT
+
+/WRITE 1 SET, CHECK END OF 10'.
+
+ JMS I WAIT /TILL COMPLETE
+ ISZ W1 /END OF FOOTAGE?
+ JMP WEZF /NO, CONTINUE WITH END ZONE
+ JMP I .+1 /GO AND START BLOCK NUMBER
+ MWTM /SEQUENCING
+\f/THESE ARE THE DATA CONFIGURATIONS FOR THE MARK TRACK
+
+
+/REVERSE END ZONE
+
+REZ, .
+ 4044 /ON TAPE AS 5555 (OCT)
+ 0440
+ 4404
+
+/INTERBLOCK SYNC
+
+IBZ, .
+ 0404 /ON TAPE AS 2525 (OCT)
+ 0404
+ 0404
+
+/FORWARD BLOCK MARK AND REVERSE GUARD
+
+FBM, .
+ 0404 /ON TAPE AS 2632 (OCT)
+ 4004
+ 4040
+
+/LOCK MARK, REVERSE CHECKSUM, REVERSE FINAL
+/AND REVERSE PREFINAL
+
+WLMRF, .
+ 0040 /ON TAPE AS 10101010 (OCT)
+ 0000
+ 4000
+ 0040
+ 0000
+ 4000
+
+/DATA MARK
+
+DZ, .
+ 4440 /ON TAPE AS 7070 (OCT)
+ 0044
+ 4000
+
+/PREFINAL, FINAL, FWD CHECKSUM, AND REVERSE LOCK
+
+FEZ, .
+ 4440 /ON TAPE AS 73737373 (OCT)
+ 4444
+ 4044
+ 4440
+ 4444
+ 4044
+\f/FORWARD GUARD AND REVERSE BLOCK NUMBER
+
+GRZ, .
+ 4040 /ON TAPE AS 5145 (OCT)
+ 0440
+ 0404
+
+/FORWARD END ZONE
+
+EZM, .
+ 0400 /ON TAPE AS 2222 (OCT)
+ 4004
+ 0040
+/SUBROUTINE TO SEE IF USER TYPED MARK 384
+/TO SPECIFY STANDARD PDP-10 FORMAT
+F10PAT, 0
+ DCA BLOCKS /CLEAR LOC. BLOCKS IN CASE NOT 10-FORMAT
+ TAD TOTAL /AND GET NUMBER TYPED BY USER
+ TAD M617 /WAS IT 384?
+ SZA CLA
+ JMP I F10PAT /NO-RETURN
+ DCA W1 /YES-CLEAR W1 FOR WAIT LOOP
+ TAD C1101 /AND ADJUST BLOCK TOTAL FOR
+ DCA BLOCKS /1102(OCTAL) BLOCKS.
+ JMP I .+1
+F10BAK, F10RTN
+M617, -617
+C1101, 1101
+\f
+ *1600
+/THE MARK TRACK HAS BEEN WRITTEN, AND TAPE IS
+/MOVING FORWARD IN THE FORWARD END ZONE. STOP
+/THE TAPE AND SEE IF THERE ARE ANY TAPES LEFT TO
+/MARK--IF SO GO DO THEM, ELSE TELL OPERATOR TO THROW THE
+/"NORMAL/WRTM/RDTM" SWITCH TO "NORMAL"
+/HE WILL THEN CONTINUE AFTER THIS ACTION
+
+/KILL WRITE, STOP TAPE
+
+MWTM, TAD DT0070 /STOP TAPE WITH SELECT ERROR
+ TAD DTA /LOAD DTA INTO ORDER
+ DTCX /EXECUTE THE ABOVE
+ JMS NUDTA /ANY MORE DTAS TO MARK?
+ JMP I DOMARK /YES: GO MARK THEM
+
+/MESSAGE TO OPERATOR
+
+ JMS I TYPE /NO: BACK TO FIRST DTA AND CONTINUE
+ 2305 /SE
+ 2440 /T
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4024 / T
+ 1740 /O
+ 1617 /NO
+ 2215 /RM
+ 0114 /AL
+ 0000 /END
+ JMS I TYPIN /WAIT FOR CR
+
+/REVERSE TAPE FOR A FEW SECONDS TO GUARANTEE
+/BLOCK MARK SECT WILL BE UNDER THE HEAD
+
+PSER, TAD DT0600 /REVERSE, MOVE, GO
+ TAD DTA /ADD DTA TO ORDER
+ DTCX /CLEAR TCU,GET MOVING IN REVERSE
+
+/STALL A FEW SECONDS
+
+ TAD M300 /AROUND 2 SECONDS
+ DCA W2 /MAJOR STALL
+MSTALL, ISZ W1 /MINOR STALL
+ JMP .-1 /LOOP MINOR
+ DTSF
+ SKP
+ JMP PSER
+ ISZ W2 /MAJOR STALL
+ JMP MSTALL /LOOP MAJOR
+\f/TAPE OUT ON MARK TRACK NOW, TURN AND GET IT
+/MOVING FORWARD. AT THIS POINT, THE LAST REVERSE
+/BLOCK NUMBER WILL BE WRITTEN UNTILL END ZONE IS
+/REACHED. THEREFORE, WHEN THE BOUNCE OUT OF THE END
+/ZONE TAKES PLACE, THE SYSTEM WILL BE ABLE TO SYNC ON
+/THE REVERSE BLOCK NUMBER TO WRITE THE REST OF
+/THE BLOCK NUMBERS AND KNOWN GOOD DATA IN REVERSE.
+/THIS PROCESS WILL ELIMINATE A NEEDLESS REWIND AND
+/KEEP THE ENTIRE PROCESS TO TWO COMPLETE PASSES
+
+/WRITE LAST REVERSE BLOCK NUMBER GOING FORWARD
+
+ TAD RZ
+ DCA I CA
+ TAD DT0210 /FORWARD, SEARCH, GO
+ TAD DTA /ADD IN THE DTA
+ DTCX /CLEAR STATUS "A" AND RELOAD IT
+ TAD C1 /PHASE 1 ERROR
+ DCA PHASE /FOR ERROR ROUTINE
+
+/WAIT HERE FOR DECTAPE FLAG. CHECK ALSO FOR ERRORS
+/SET BLOCK NUMBER (REVERSE) INTO FORM
+
+ TAD BLOCKS /INTO AC WITH LAST BLOCK NUMBER
+ JMS I MESS /CONVERT BLOCK NUMBER FOR TAPE
+
+/INTERRUPTED? ERROR?
+
+ DTRB /READ STATUS "B"
+ RAR /DECTAPE FLAG TO LINK
+ SNL CLA /FLAG SET?
+ JMP .-3 /NO: CONTINUE WAIT
+
+/BLOCK FOUND. SWITCH TO READ DATA WITH WC ONE LESS THAN
+/NUMBER OF WORDS TO BE READ. READ TILL WC=0
+
+ TAD DT0130 /TO SET STATUS "A" INTO
+RCYBR, DTXA /THE READ DATA MODE
+ CLA CMA /SUBTRACT 1 FROM TOTAL
+ TAD TOTAL /GIVING TOTAL-1 (HO HO)
+ CMA /INVERT FOR ISZ
+ DCA I WC /SET WC
+ TAD C4 /NOP
+ DCA I CA /JIMMIED TO DO NOTHING
+ DTRB /READ "B" REGISTER
+ AND C1000 /ISOLATE END ZONE BIT
+ SZA CLA /END ZONE?
+ JMP I GDBLK /YES: GO AND WRITE THE BLOCK NUMBERS
+ TAD I WC /WAIT TILL WORD COUNT ZERO
+ SZA CLA /EQUAL TO ZERO?
+ JMP .-10 /NO: LOOP AGAIN
+\f/END OF BLOCK FOUND. WRITE JUNK AND REVERSE BLOCK NUMBER
+
+ TAD M14 /12 WORDS TO BE WRITTEN
+ DCA I WC /TO WORD COUNT REG.
+ TAD FORMB /FORM TO CA
+ DCA I CA /OF NUMBERING FORM
+ TAD DT0070 /SWITCH TO WRITE ALL
+ DTXA /MODE.
+
+/LOOK FOR THE DECTAPE FLAG INDICATING ANOTHER RECYCLE
+
+ DTRB /NO: GET "B" AGAIN
+ RAR /FLAG TO LINK
+ SNL CLA /FLAG SET?
+ JMP .-3 /NO: BE PATIENT. HAST NOT.
+ TAD DT0070 /TO SWITCH TO READ DATA
+ JMP RCYBR
+GDBLK, DOBLK
+DOMARK, STMK /POINTER TO START OF MARK ROUTINE
+
+/SUBROUTINE TO GET NEXT DTA UNIT # FROM INPUT LIST OR
+/RECYCLE TO FIRST UNIT IF ALL HAVE BEEN PROCESSED UP TO
+/THIS POINT--CALL SEQUENCE
+/ JMS NUDTA /CALL THE ROUTINE
+/ (RETN1) /RETURNS HERE IF MORE DTAS TO PROCESS
+/ (RETN2) /RETURNS HERE IF END OF LIST
+/END OF LIST MEANS RESET TO FIRST AND RETURN TO (RETN2)
+/RETURN IS WITH DTA SET TO NEW VALUE AND AC=0
+
+NUDTA, 0
+ TAD I LSTPT /GET CURRENT VALUE OF DTA LIST PTR
+ DCA TBUFPT /STORE IT AS TEM. BUF. PTR.
+ TAD I TBUFPT /GET A DTA # FROM THE LIST
+ AND C0007 /ISOLATE LOW ORDER DIGIT
+ SZA CLA /IS IT 7777?
+ JMP LSTEND /YES: END OF LIST
+ TAD I TBUFPT /NO: GET IT BACK
+ DCA DTA /AND STORE AS NEW DTA #
+ ISZ I LSTPT /INCREMENT LIST POINTER
+ JMP I NUDTA /RETURN
+/COMES HERE AT END OF LIST TO RESET PTRS AND RETN TO CALL+2
+LSTEND, ISZ NUDTA /INCREMENT RETURN POINTER
+ TAD I STRTPT /GET ADR. OF START OF LIST
+ DCA I LSTPT /STORE TO RE-INITIALIZE LIST PTR.
+ JMP NUDTA+1 /GO GET FIRST DTA # AND RETURN
+
+STRTPT, DBUFAD /POINTER TO START OF DTA LIST
+TBUFPT, 0 /TEM. STORAGE FOR BUF. PTR.
+LSTPT, DBUFPT /POINTER TO CURRENT VALUE OF DTA LIST PTR
+DTABUF, 0 /START OF DTA # LIST - MAX. 9 WORDS
+RZ, .+1
+ 0
+/SUBROUTINE TO CHECK FOR REPEATED DTA NUMBERS
+/DTA # TO COMPARE TO LIST IS IN AC ON ENTRY--THIS
+/ROUTINE STORES THE DTA # IF IT IS NEW AND IGNORES IT
+/IF IT IS NOT-CALL BY JMS REPEAT WITH DTA # IN AC
+REPEAT, 0
+ DCA DNUM /TEM STORAGE FOR NEW DTA #
+ TAD DBUFAD /INITIALIZE POINTER (DBUFPT)
+ DCA DBUFPT /TO START OF DTA LIST
+ TAD DCTR /LOAD NUM. OF DTAS STORED
+ CMA /COMPLEMENT IT
+ DCA COMCTR /STORE IN COMPARE COUNTER
+COMCHK, ISZ COMCTR /DONE WITH ALL COMPARES?
+ JMP DOCOMP /NO: GO DO COMPARE
+ TAD DNUM /YES: STORE NEW DTA#
+ DCA I DBUFPT /AT END OF LIST
+ ISZ DCTR /INCR. # OF DTAS STORED
+ JMP I REPEAT /RETURN
+
+/THIS SECTION DOES THE ACTUAL COMPARISON BETWEEN
+/THE DTA# PASSED TO THE ROUTINE AND A NUMBER ON THE LIST
+
+DOCOMP, TAD I DBUFPT /GET NEXT DTA NUMBER FROM LIST
+ CIA /NEGATE IT
+ TAD DNUM /ADD IN DTA NUMBER PASSED
+ SNA CLA /ARE THEY THE SAME?
+ JMP I REPEAT /YES: RETURN
+ ISZ DBUFPT /NO: INCREMENT LIST POINTER
+ JMP COMCHK /SEE IF DONE ALL COMPARES
+/
+/
+COMCTR, 0 /COUNTER FOR # OF LIST COMPARISONS TO BE DONE
+DCTR, 0 /COUNTER FOR # OF DTAS IN LIST
+DBUFAD, DTABUF /START OF DTA NUM. LIST
+DNUM, 0 /TEM STORAGE FOR DTA #
+/
+\f *2000
+/GO INTO SEARCH IN REVERSE MODE LOOKING FOR
+/THE LAST BLOCK NUMBER. WHEN FOUND, SYNC THE SYSTEM
+/AND WRITE ALL DATA AND BLOCK NUMBERS
+
+DOBLK, JMS I TURN /INTO REVERSE AND SEARCH MODE
+ TAD BLOCKS /TO SET UP
+ DCA BLOCKA /FOR BLOCK DECREMENTING
+ TAD C2 /PHASE 2 ERROR
+ DCA PHASE /FOR ERROR ROUTINE
+
+/LOOK FOR INTERRUPT INDICATING BLOCK NUMBER
+
+ JMS I WAIT /FOR DECTAPE FLAG
+
+/SWITCH TO WRITE ALL. SYSTEM NOW IN SYNC
+
+ TAD DT0140 /SWITCH TO WRITE ALL
+ DTXA /EXECUTE ORDER
+NEXTBN, TAD ADF3 /ADDRESS OF FIRST 3 WORDS INCLUDING
+ DCA I CA /THE FORWARD CHECKSUM TO BE WRITTEN
+ TAD M3 /NUMBER OF WORDS TO BE WRITTEN
+ DCA I WC /TO WORD COUNT
+ JMS CEZN /CHECK FOR END ZONE
+ TAD I WC /CHECK FOR WC=0
+ SZA CLA /=0?
+ JMP .-3 /NOPE: TRY AGAIN
+ DTXA /YUP: CLEAR THE FLAG
+
+/WRITE DATA TRACK. REMEMBER CORRECT DATA IS BEING WRITTEN
+
+ TAD TOTAL /ONE FROM TOTAL NUMBER
+ CIA /OF WORDS FOR COUNTING
+ DCA I WC /DATA WORDS WRITTEN
+ TAD AD7777 /ADDRESS OF SEVENS
+ DCA I CA /DATA TO BE WRITTEN
+
+/MONITOR WORD COUNT FOR A ZERO READING
+/SOME OF THIS TIME IS USED TO SET THE NEXT
+/BLOCK NUMBER INTO THE FORM.
+
+ TAD BLOCKA /CURRENT BLOCK NUMBER
+ JMS I MESS /CONVERT INTO FORM
+ CLA CMA /TO DECREMENT
+ TAD BLOCKA /THE BLOCK COUNT
+ DCA BLOCKA /DOWN TO ZERO
+ JMP CEZB /BYPASS FOLLOWING ROUTINE
+
+/CHECK FOR END ZONE
+CEZN, 0
+ DTRB /READ STATUS "B"
+ AND C1000 /ISOLATE END ZONE
+ SNA CLA /HAVE IT?
+ JMP I CEZN /NOT EZ, RETURN
+ JMP I GDBN /COMPLETED
+\f/CHECK HERE ALSO TO SEE IF END ZONE, INDICATING
+/THAT THE LAST BLOCK HAS BEEN WRITTEN
+
+CEZB, JMS CEZN /END ZONE?
+
+/LOOK FOR WORD COUNT AS BEING EQUAL TO ZERO
+
+ TAD I WC /WC TO C(AC)
+ SNA CLA /END OF DATA WRITE?
+ JMP WBN /YES: GO TO WRITE BLOCK NUMBER
+ TAD AD7777 /RESET CURRENT ADDRESS COUNT
+ DCA I CA /DON'T LET THE CA ADVANCE TO
+ JMP CEZB /MUCH
+
+/DATA HAS BEEN WRITTEN. NOW WRITE REVERSE
+/BLOCK NUMBER, FORWARD BLOCK NUMBER, AND REVERSE
+/CHECKSUM. (12 WORDS)
+
+WBN, DTXA /CLEAR OUT DECTAPE FLAG
+ TAD M14 /WILL WRITE 12 WORDS
+ DCA I WC /FOR THIS BIT
+ TAD FORMA /FROM A FORM CONTAINING
+ DCA I CA /BLOCK NUMBERS
+
+/WAIT FOR END
+
+ JMS CEZN /END ZONE?
+ TAD I WC /NO: SEE IF DONE THE WRITE
+ SZA CLA /DONE YET ?
+ JMP .-3 /NO: PATIENCE IS A VIRTUE????
+ DTXA /RESET THE CURRENT FLAG
+ JMP NEXTBN /YES: GO RECYCLE COMPLETLY
+GDBN, DBN
+
+/ FIRST 3 WORDS TO BE WRITTEN
+
+ADF3, .
+ 0000
+ 0000
+ 0077
+
+/DATA TO BE WRITTEN ON TAPE (REVERSE)
+
+AD7777, .
+ 7777
+ 7777
+ 7777
+ 7777
+/CHECK IF ALL DTAS ARE DONE BEFORE RESTARTING
+
+SETDTA, JMS I GDTA /ALL DTAS DONE?
+ JMP I CONTNU /NO: BACK TO WRITE BLOCK #S ON NEXT
+ JMP I IT /YES: GO ASK "DIRECT?"
+GDTA, NUDTA /POINTER TO SUBR FOR GETTING NEXT UNIT #
+CONTNU, PSER /POINTER TO START OF BLOCK # WRITE ROUTINE
+\f
+
+/TYPE ONE FOUR CHARACTER OCTAL WORD GIVEN TO THE
+/ROUTINE VIA C(ACC). C(ACC)=0 ON EXIT
+
+TYCT, 0
+ DCA TW1 /STORE WORD GIVEN
+ TAD TW1 /TO C(ACC) AGAIN
+ RTR
+ RTR /6 BITS GIGHT
+ RTR
+ DCA TYCT1+2 /SAVE ROTATED VALUE, 1ST TWO
+ TAD TYCT1+2 /TO C(ACC) AGAIN
+ AND C0007 /ISOLATE SECOND CHARACTER
+ TAD C6060 /CONVERT TO ASCII
+ DCA TYCT1+1 /STORE AS FIRST PARTIAL 2
+ TAD TYCT1+2 /ROTATED VALUE STORED ABOVE
+ RTL
+ RAL /3 BITS LEFT
+ AND C0700 /ISOLATE FIRST CHARACTER
+ TAD TYCT1+1 /CONVERT 1ST TO ASCII
+ DCA TYCT1+1 /1ST AND 2ND CHARACTERS READY
+ TAD TW1 /ORIGIONAL WORD
+ AND C0007 /ISOLATE 4TH CHARACTER
+ TAD C6060 /CONVERT 4 TH TO ASCII
+ DCA TYCT1+2 /STORE 4TH FOR A MOMENT
+ TAD TW1 /ORIGIONAL WORD
+ RTL
+ RAL /POSITION IT 3RD CHARACTER
+ AND C0700 /ISOLATE 3RD CHARACTER
+ TAD TYCT1+2 /CONVERT TO ASCII
+ DCA TYCT1+2 /CONVERSION COMPLETE
+TYCT1, JMS I TYPE /TYPE THE FOUR CHARACTERS
+ 0 /FIRST 2
+ 0 /SECOND 2
+ 0 /KILL KEY
+ JMP I TYCT /EXIT FROM ROUTINE
+
+/SOME CONSTANTS FOR THE ROUTINE
+
+TW1, 0000
+C6060, 6060
+\f *2200
+/VERIFY THE TAPE AS BEING WRITTEN CORRECTLY
+/WITH DATA AND BLOCK NUMBERS. THE INFORMATION WRITTEN
+/WAS WRITTEN IN SUCH A WAY AS TO BE CORRECT
+/UPON READING IT BACK
+
+
+/TURN TAPE AND HAVE IT GOING FORWARD
+
+DBN, TAD ISZV /RESET INCREMENT
+ DCA VISZ /BLOCK NUMBERS FORWARD
+ DCA FCON /WILL BE ZEROS FORWARD
+ DCA W1 /FIRST BLOCK NUMBER FORWARD
+ TAD C0400 /TURN TO GO FORWARD
+DBNAUX, JMS I TURN
+ TAD C3 /ERROR IN PHASE 3
+ DCA PHASE /FOR ERROR ROUTINE
+
+/SET SOME OF THE CONTROL REGS
+
+DAB, DCA I WC /WORD COUNT DON'T CARE
+ TAD ADBA /SOME WHERE UP ABOVE
+ DCA I CA /TO GET BLOCK NUMBERS
+
+/WAIT FOR INTERRUPT
+
+ JMS I WAIT /INTERRUPT
+ TAD W1 /FIRST OR NEXT BLOCK NUMBER
+ CIA /TO COMPARE
+ TAD I ADBA /GET THE BLOCK NUMBER
+ SZA CLA /COMPARE OK?
+ JMP BLKERZ /BLOCK ERROR FOUND
+
+/BLOCK COMPARES, NOW CHECK DATA
+
+ TAD DT0030 /TO SWITCH INTO READ
+ DTXA /DATA MODE
+ DCA I WC /DON'T CARE ABOUT THE WC
+CTST, TAD ADWA /FOR COMPARING
+ DCA I CA /FROM TAPE
+
+/EVERY TIME THE WORD COUNT MOVES
+/A DATA TRANSFERE HAS BEEN COMPLETED.
+/MAKE SURE THAT THE INFORMATION IS OK
+
+ TAD I WC /GET WORD COUNT
+ SNA CLA /STILL AT ZERO?
+ JMP CEFR /YES: SEE IF AT END
+ TAD FCON /NO: SEE IF DATA
+ CIA /IS SAME AS WRITTEN
+ TAD I ADWAB /RECEIVED DATA
+ SZA CLA /SAME?
+ JMP DTAR /DATA ERROR FOUND
+ DCA I WC /YES: RESET WORD COUNT
+\f/CHECK FOR DECTAPE FLAG INDICATING END OF
+/BLOCK OR ERROR
+
+CEFR, DTRB /READ "B" REGISTER
+ SPA /ERROR?
+ JMP PARIR /PARITY ERROR, I GUESS
+
+/NO ERROR, END OF BLOCK?
+
+ RAR /FLAG TO THE LINK
+ SNL CLA /END?
+ JMP CTST /NO: CONTINUE CHECKING
+ TAD DT0030 /CLEAR DECTAPE FLAG
+ DTXA /AND RETURN TO SEARCH
+
+/END OF BLOCK. SEE IF END OF TAPE
+
+ TAD W1 /BLOCK NUMBER JUST TESTED
+VISZ, ISZ W1 /+1 OR -1 TO BLOCK COUNT
+ SKP
+ HLT /ABSOLUTE PANIC
+ CIA /TO BE COMPARED WITH
+ TAD BLOCKS /TOTAL BLOCKS
+ SZA CLA /LAST?
+ JMP DAB /NO, DO ANOTHER BLOCK
+
+
+/HERE PUT IN THE REVERSE CHECK
+
+DDSF, DTSF /WAIT FOR ANY FLAG TO APPEAR
+ JMP .-1 /NOT YET
+ CLA CLL /RID AC OF GARBAGE
+ DTRB /READ THE "B" REGISTER
+ AND C1000 /BETTER BE END ZONE
+ SNA CLA /IS IT?
+ JMP LNE /LAST INTERRUPT NOT END ZONE
+ DTCX /YUP: A OK
+\f/BLOCK NUMBERS AND DATA HAVE BEEN CHECKED FORWARD
+/AND ARE OK. USING THE ABOVE ROUTINE FOR CHECKING
+/RESET A FEW THINGS AND CHECK IN REVERSE
+
+/WAS COMPLETION FOUND FORWARD? IF SO GO CHECK
+/IN REVERSE; IF NOT GO SEE IF ALL TAPES HAVE BEEN CHECKED.
+
+
+ TAD FCON /IF 0'S, IT WAS FWD
+ SZA CLA /FWD?
+ JMP I FINCHK /N0: REVERSE-SEE IF ALL DTAS DONE
+
+/RESET THE ABOVE ROUTINE TO READ IN REVERSE
+
+ CMA /DATA WILL BE AS WRITTEN
+ DCA FCON /I.E., 7777'S
+ TAD SJMP /INSTEAD OF INCREMENTING
+ DCA VISZ /WE WILL DECREMENT BLOCK NUMBERS
+ TAD BLOCKS /STARTING WITH THE HIGHEST
+ DCA W1 /AND WILL WORK TO ZERO
+ JMP DBNAUX /ALL SET, TRAVEL ONWARD
+
+/RETURN HERE AFTER EACH BLOCK FOR CHECKING WHEN LAST BLOCK
+/HAS BEN PROCESSED????????????
+
+SJMP, JMP .+1
+ SNA /IF AC = 0, WE ARE DONE
+ JMP DDSF /AND NEXT FLAG SHOULD BE END ZONE
+ CIA /OTHERWISE, SUBTRACT ONE FROM
+ CMA /BLOCKS GIVING BLOCKS-1......?
+ DCA W1 /NOT DONE
+ JMP DAB /GO DO ANOTHER BLOCK
+
+ISZV, ISZ W1 /VARIABLE TAG
+FINCHK, SETDTA
+\f/BLOCK ERROR FOUND
+
+BLKERZ, TAD DTA /TO RESET TAPE
+ DTCX /MOTION
+ TAD I ADBA /GET BAD BLOCK NUMBER
+ JMS I TYOCT /AND TYPE IT OUT
+ JMS TYSB /TYPE "SHOULD BE"
+ TAD W1 /GOOD BLOCK NUMBER
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE
+ 4002 / B
+ 1413 /LK
+ 4005 / E
+ 2243 /R CR
+ 4500 /LF+END
+DBERZ, JMP I .+1
+ ZCOM
+
+/COMMON ROUTINE
+
+TYSB, 0
+ JMS I TYPE
+ 4023 / S
+ 1017 /HO
+ 2514 /UL
+ 0440 /D
+ 0205 /BE
+ 4000 / 0
+ JMP I TYSB
+
+/DATA ERROR
+
+DTAR, TAD DTA /TO STOP TAPE
+ DTCX /MOTION
+ TAD I ADWA /GET THE BAD WORD
+ JMS I TYOCT
+ JMS TYSB /TYPE "SHOULD BE"
+ TAD FCON /GOOD WORD
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE
+ 4004 /D
+ 0124 /AT
+ 0140 /A
+ 0522 /ER
+ 4543 /CR+LF
+ 0000 /END
+ JMP DBERZ
+\f/PARITY ERROR FOUND
+
+PARIR, JMP I .+1
+ ERROR /MAIN ERROR ROUTINE
+
+/LAST INTERRUPT WAS NOT END ZONE
+
+LNE, JMS I TYPE
+ 1401 /LA
+ 2324 /ST
+ 4011 / I
+ 1624 /NT
+ 4016 / N
+ 1724 /OT
+ 4005 / E
+ 1724 /OT
+ 4345 /LF+CR
+ 0000 /END
+ JMP DBERZ
+\f *2400
+/ TYPE OUT THE DTA UNIT NUMBER AND THE FIRST 12 BLOCK
+/NUMBERS IN EITHER DIRECTION. IF RDR, IN REVERSE
+/IF RDF, TYPE THEM OUT GOING IN THE FORWARD
+/DIRECTION FROM THE BEGINING OF TAPE
+
+RDFA, TAD C0400 /DIRECTION FOR TURNING
+ DCA SAVEIT /STORE DIRECTION FOR NEXT DTA UNIT
+ TAD SAVEIT /GET DIRECTION FOR TURNING
+ JMS I TURN /AROUND
+ TAD M14 /READ 12 BLOCK
+ DCA W3 /COUNTER
+ TAD BADD /ADDRESS OF BUFFER
+ DCA X2 /TO AUTO INDEX 2
+ TAD ADW3 /ADDRESS OF W2
+ DCA I CA /FOR DATA XFER
+ JMS I WAIT /FOR BLOCK INTERRUPT
+ TAD W2 /BLOCK NUMBER
+ DCA I X2 /STORE BLOCK NUMBER
+ ISZ W3 /TOTAL = 12?
+ JMP .-4 /NO: GRAB NEXT
+ TAD DTA /KILL TAPE MOTION
+ DTCX /HERE
+
+/TYPE OUT BLOCK NUMBERS AND DTA UNIT #
+
+ JMS I TYPE /TYPE "DTA"
+ 0424 /DT
+ 0140 /A
+ 0000 /END
+ TAD DTA /GET UNIT #
+ JMS I TYOCT /AND TYPE IT OUT
+ JMS I TYPE
+ 4345 /CR&LF
+ 0000 /END
+ TAD M14 /WILL TYPE ALL
+ DCA W1 /TWELVE WORDS
+ TAD BADD /ADDRESS OF BLOCK
+ DCA X2 /NUMBERS TO INDEX 2
+ TAD I X2 /FIRST OR NEXT BLOCK
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE /CR AND LINE FEED
+ 4345 /CR+LF
+ 0000
+ ISZ W1 /COMPLETE?
+ JMP .-6 /NO
+ JMS I NEWDTA /YES: ANY MORE DTAS?
+ JMP RDFA+2 /YES: GO GET BLOCK #S
+ JMP I IT /NO: GO ASK FOR "DIRECT?"
+RDR, JMP RDFA+1 /OTHER DIRECTION
+
+SAVEIT, 0 /TEM. STORAGE FOR DIRECTION
+NEWDTA, NUDTA /POINTER TO SUBR. TO GET A NEW DTA UNIT #
+\f
+/INPUT BUFFER FOR THE TELETYPE.
+/NOTE ,,,,,,,THIS MUST BE AT THE END OF THE PROGRAM
+
+BUFFER, 0000
+
+$
+\f
projects / pdp8.git / blobdiff