--- /dev/null
+/TD8E FORMATTER V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1971, 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
+
+/TD8E DECTAPE FORMATTER COPYRIGHT 1971
+/DIGITAL EQUIPMENT CORP.
+/MAYNARD , MASS
+
+
+
+
+
+ X1=10
+ X2=11
+
+/SYMBOL TABLE AUGMENTATION
+
+ SDSS=6771
+ SDST=6772
+ SDSQ=6773
+ SDLC=6774
+ SDLD=6775
+ SDRC=6776
+ SDRD=6777
+
+
+ *0
+ 0
+ JMP 1 /HLT PROGRAM GOT INTERRUPTED SOMEHOW
+ 2
+ 3
+ 0
+ 0
+
+/WORKING LOCATIONS
+
+ *20
+
+W1, 0000
+W2, 0000
+W3, 0000
+W4, 0000
+W5, 0000
+W6, 0000
+BLOCKS, 0000
+DTA, 0000
+PHASE, 0000
+TOTAL, 0000
+VAR1, 0000
+VAR2, 0000
+/CONSTANTS
+
+C0017, 0017
+C0070, 0070
+C0077, 0077
+C0007, 0007
+C0700, 0700
+C203, 0203
+C201, 0201
+C260, 0260
+C261, 0261
+C270, 0270
+C271, 0271
+C277, 0277
+C1620, 1620
+C7000, 7000
+C7700, 7700
+C7714, 7714
+C7761, 7761
+CRCOD, 0215
+LETK, 0313
+LFCOD, 0212
+M2, -2
+M3, -3
+M6, -6
+M7, -7
+M14, -14
+M144, -144
+SPCOD, 0240
+
+BADD, BUFFER-1
+BFR, BUFFER
+COMPAR, COMPRE
+IT, INIT1
+QU1, Q1
+QU2, Q2
+QU3, Q3
+QU4, Q4
+MESS, MES
+STX, START
+TYOCT, TYCT
+TYPE, MESAGE
+TYPIN, TYPN
+WAIT, STALL
+WC, 0
+MTR, 0
+SLRDRC, SRDRC
+DATRD, 0
+M55, -55
+M25, -25
+M26, -26
+M32, -32
+M10, -10
+M70, -70
+M73, -73
+M51, -51
+M45, -45
+M22, -22
+M143, -143
+M52, -52
+M31, -31
+M306, -306
+CNT, 0
+M4, -4
+M307, -307
+SSDSQT, SDSQT
+SA3LNS, A3LNS
+SCEXPC, CEXPC
+MSK77, 0077
+NUD, NUDTA
+BLK, 0
+REVBLK, 0
+BCXOR, SBCXOR
+CHKSUM, 0
+SBWORD, 0
+
+
+
+/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
+ CLA CLL /C(AC)+C(L)=0
+ TAD C277 /"?"
+ JMS RSEND /TYPE THE CHARACTER
+ JMP I .+1 /RESTART
+ INIT
+
+/DECTAPE CONTROL WORDS
+
+DT1400, 1400
+DT0400, 0400
+DT2000, 2000
+DT3000, 3000
+DT1000, 1000
+
+BINCO, BINCON
+SELTIM, ZTIM
+MARKER, ZMKTK
+BLKERR, ZBLK
+DATERR, ZDATA
+CHKERR, ZPAR
+DOMARK, STMK
+DBUFPT, 0 /POINTER TO CURRENT POSITION IN DTA LIST
+
+
+
+*200 /PAGE 1
+/TYPE CANNED MESSAGES.....
+/THANKS TO DIGITAL 8-18-U
+ JMP I .+1
+ PATCH
+
+MESAGE, 0
+ IOF
+ 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
+/ROUTINE WAITS UNTILL A COMPLETE MESSAGE HAS BEEN ENTERED
+/SIGNIFIED BY A CR.
+
+TYPN, 0
+ IOF
+ 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 /CAF- CLEAR ALL FLAGS
+ NOP /JUST IN CASE
+ CLA
+ JMP 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
+ IOF
+ 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
+*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
+/THE CODING BELOW CREATES THE BLOCK NUMBER
+/CONVERSION PRIOR TO THE TAPE WRITE.
+
+MES, 0
+ DCA W4 /SAVE WORD
+ CLL
+ TAD W4
+ CMA RTR
+ RTR
+ AND C7000
+ DCA V1
+ TAD W4
+ CMA RTL
+ RAL
+ AND C0700
+ DCA V2
+ TAD W4
+ CMA RTR
+ RAR
+ AND C0070
+ DCA V3
+ TAD W4
+ CMA RTL
+ RTL
+ AND C0007
+ TAD V1
+ TAD V2
+ TAD V3
+ JMP I MES
+
+V1, 0000
+V2, 0000
+ 7777
+ 7700
+ 0000
+V3, 0000
+ 0000
+
+PATCH, CLA
+ TAD .+4
+ DCA 1
+ JMP I .+1
+ START
+ HLT
+/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 RIGHT
+ 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
+*600
+
+STALL, 0
+ CLA
+ TAD I 12 /WORD TO BE WRITTEN
+ SDSQ /WAIT FOR QUADLINE FLAG
+ JMP .-1
+ SDLD /LOAD DATA REGISTERS
+ SDST /CHECK FOR TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ CLA
+ JMP I STALL /GO GET NEXT WORD
+
+
+
+/WAIT TILL WORD COUNT REGISTER GOES TO ZERO
+
+/BLOCK NUMBER ERROR
+ZBLK, 0
+ CLA
+ TAD DTA
+ SDLC /STOP MOVEMENT OF TAPE
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD ZBLK
+ JMS I TYOCT
+ JMS I TYPE
+ 4040 /DOUBLE SPACE
+ 0214 /BL
+ 1703 /OC
+ 1340 /K
+ 1625 /NU
+ 1502 /MB
+ 0522 /ER
+ 4000 /END
+ JMP ZCOM
+
+ /DATA ERRORS
+ZDATA, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003
+ 4000
+ CLA CMA
+ TAD ZDATA
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 0401 /DA
+ 2401 /TA
+ 4000 /END
+ JMP ZCOM
+
+/MARK TRACK ERROR
+
+ZMKTK, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD ZMKTK
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 1501 /MA
+ 2213 /RK
+ 4024 / T
+ 2201 /RA
+ 0313 /CK
+ 4000 / 0
+ JMP ZCOM
+/PARITY ERROR
+
+ZPAR, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD ZPAR
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 0310 /CH
+ 0503 /EC
+ 1323 /KS
+ 2515 /UM
+ 4000 /0
+ JMP ZCOM
+
+
+/TIMING ERROR
+
+ZTIM, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003
+ 4000
+ CLA CMA
+ TAD ZTIM
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 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
+ 4543 /CR+LF
+ 0000 /END
+ JMP I .+1
+ RETRY
+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:
+
+
+/UNIT? (0 OR 1 OR 0 1)
+/FORMAT? (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, "FORMAT?" WOULD BE TYPED OUT.
+/IF THE DRIVE WAS WRONG, HE WOULD TYPE RESTART.
+/IF HE HAD TYPED "MARK" IN RESPONSE TO "FORMAT?" 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
+
+
+
+
+
+*1000
+
+/MAKE A CALL FOR THE DECTAPE NUMBERS TO BE
+/WORKED.
+
+STAR0, JMS I TYPE /TYPE VERSION NUMBER
+ 4543 /CR+LF
+ 4300 /LF+0
+ JMS I TYPE
+ TEXT /TDFMT V4A/
+START, JMS I TYPE /SET UP TYPER
+ 4543 /CR+LF
+ 4300 /LF+END
+
+TYQU, JMS I TYPE /"UNIT?"
+ 2516 /UN
+ 1124 /IT
+ 7740 /?
+ 0000 /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 C260 /SEE IF # IS LESS THAN
+ CIA /ASCII 0 (260)
+ TAD I BFR /SUBTRACT BUFFER DATA
+ SPA CLA /IS IT LESS THAN ASII 0?
+ JMP TYQU /YES: TELL OUTSIDE WORLD
+ TAD C261 /NO: SEE IF GREATER THAN
+ CMA /ASC II 1 (261)
+ 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
+ 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 "FORMAT" AND WAIT FOR THE REPLY
+
+INIT, JMS I TYPE /MESSAGE OUT
+ 0617 /FO
+ 2215 /RM
+ 0124 /AT
+ 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
+/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
+ SWCHK /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 I BINCO /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
+/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
+/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
+/SEE IF A YES OR NO ANSWER WAS GIVEN
+
+ JMS I COMPAR
+ 0331 /Y
+ 0305 /E
+ 0323 /S
+ 0000 /END
+ JMP I IT
+
+ JMP I .+1
+ SWCHK
+FORM10, F10PAT
+
+
+\f
+*1400
+/SET THE TAPE INTO MOTION. ALL VARIABLES ARE SET.
+
+/WRITE TIMING AND MARK TRACK
+
+STMK, CLA
+ DCA PHASE
+ TAD DT1400 /FWD, WRITE, GO
+ TAD DTA /GET UNIT NUMBER
+ SDLC /LOAD COMMAND REGISTER
+ TAD VAR2 /TO MAKE A RESTART FOR THE SAME
+ DCA W6 /OPTION POSSIBLE
+
+/WRITE ABOUT 10 FEET OF END ZONE
+ DCA W1
+CEZ, TAD REZ /ADDRESS OF DATA
+ JMS SETUP
+ ISZ W1
+ JMP CEZ /NOT END FOOTAGE
+ TAD M144 /OK WRITE INTERBLOCK SYNC
+ DCA W1
+ JMS INBLSY
+ ISZ W1
+ JMP .-2
+ JMP WDZ
+
+ /WRITE INTERBLOCK SYNC
+INBLSY, 0
+ TAD VAR1 /RESET THE WORDS
+ DCA W5
+ TAD IBZ /ADDRESS OF DATA
+ JMS SETUP /GO OUT AND WRITE 1
+ JMP I INBLSY /GO DO AGAIN
+
+ /WRITE FORWARD BLOCKMARK AND REVERSE GUARD
+WDZ, TAD FBM /ADDRESS OF PATTERN
+ JMS SETUP
+
+ /WRITE LOCKMARK, REVERSE CHECKSUM, REV FINAL, REV PREFINAL
+LRCFP, TAD WLMRF
+ JMS SETUP1
+
+ /WRITE THE DATA TRACK
+DTRK, TAD DZ /ADDRESS OF PATTERN
+ JMS SETUP
+ ISZ W5
+ JMP DTRK /NOW WRITE DATA MARK TRACK AGAIN
+ /WRITE PREFINAL, FINAL, CHECKSUM, AND REVERSE LOCK
+PFCRC, TAD FEZ /ADDRESS OF DATA
+ JMS SETUP1
+
+ /WRITE GUARD REVERSE BLOCK
+GRB, TAD GRZ
+ JMS SETUP
+
+ /THIS COMPLETES 1 BLOCK, GO BACK AND WRITE THE REST
+ JMS INBLSY /WRITE INTERBLOCK SYNC
+ ISZ W6 /TOTAL NUMBER OF BLOCKS
+ JMP WDZ /WRITTEN? NO:
+
+ /ALL DATA BLOCKS WRITTEN NOW WRITE BUFFER ZONE OF INTERBLOCK SYNC
+ TAD M143 /198 EXPAND CODES AT END OF BLOCKS
+ DCA W1
+ JMS INBLSY
+ ISZ W1
+ JMP .-2
+
+ /FINISHED BLOCK WRITTING, WRITE ANOTHER 10(1) OF END ZONES
+ DCA W1
+WEZF, TAD EZM
+ JMS SETUP
+ ISZ W1
+ JMP WEZF
+ SDST
+ SKP CLA
+ JMS I SELTIM /TIMING ERROR
+ TAD C1
+ DCA PHASE
+ JMP I .+1
+ MWTM
+
+SETUP, 0
+ DCA 12 /WORD TO BE WRITTEN ON MARK TRACK
+ TAD M3
+ DCA WC
+ JMS I WAIT
+ ISZ WC
+ JMP .-2
+ JMP I SETUP
+
+SETUP1, 0
+ DCA 12
+ TAD M6
+ DCA WC
+ JMS I WAIT
+ ISZ WC
+ JMP .-2
+ JMP I SETUP1
+/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
+/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
+C1, 0001
+\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
+/"OFF/WTM" SWITCH TO "OFF"
+/HE WILL THEN CONTINUE AFTER THIS ACTION
+
+
+ /KILL WRITE,STOP TAPE
+
+MWTM, CLA
+ TAD DTA /UNIT
+ SDLC
+ JMS NUDTA
+ JMP I DOMARK
+
+ /MESSAGE TO THE OPERATOR
+OFF, JMS I TYPE
+ 2305 /SE
+ 2440 /T
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4024 /T
+ 1740 /O
+ 1706 /OF
+ 0600 /F
+ JMS I TYPIN /WAIT FOR CR
+ JMP I .+1
+ SWOFF /CHECK TO MAKE SURE THAT SWITCH IS OFF
+ /REVERSE TAPE AND READ MARK TRACK
+PSER, TAD DT3000 /REVERSE GO
+ TAD DTA /UNIT
+ SDLC /LOAD COMMAND REGISTER
+ DCA W1 /STALL ROUTINE TO GET UP TO SPEED
+ SDSQ
+ JMP .-1
+ SDRC
+ ISZ W1
+ JMP .-4
+ SDSQ /SKIP ON QUAD LINE IF SET AFTER WAIT ROUTINE
+ SKP
+ JMP .+3 /FLAG WAS SET
+ SDSS /READ IN A LINE OF TAPE
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ SDST /CHECK FOR A TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77 /CHECK TO SEE IF TAPE IS STILL IN END ZONE
+ TAD M55
+ SZA CLA
+ JMP .-11 /NOT A 55 YET
+ JMS I SSDSQT /YES,READ IN SOME MORE
+ TAD M55 /IS IT END ZONE
+ SNA CLA
+ JMP .-3 /STILL IN END ZONE
+ TAD MTR /GET THE MARK TRACK
+ TAD M25 /IS IT EXPAND CODE
+ SZA CLA
+ JMS I SCEXPC /NOT YET,CHECK FOR A 52,AND ADVANCE 3 LINES
+ CLA /YES IT IS EXPAND CODE
+ TAD M306 /SET UP FOR 198 EXPAND CODES
+ DCA CNT
+ JMS I SSDSQT /THE TAPE SHOULD BE IN SYNC NOW
+ TAD M25 /READ THE REST OF EXPAND CODE
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT /INCREMENT COUNTER
+ JMP .-5
+ TAD VAR2 /NUMBER OF BLOCKS
+ DCA W6
+RSTBLK, JMS I SSDSQT /START OF A STANDARD BLOCK
+ TAD M25 /FIRST EXPAND CODE AT BEGINNING
+ SZA CLA /OF BLOCK
+ JMS I MARKER /MARK TRACK ERROR
+ JMS I SSDSQT /READ MARK BLOCK NUMBER
+ TAD M26
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ JMS I SSDSQT /READ MARK GUARD
+ TAD M32
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ TAD M4
+ DCA CNT
+ JMS I SSDSQT /READ L,CK,F,PF
+ TAD M10
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT
+ JMP .-5
+ CLA CLL
+ TAD VAR1
+ RAL
+ DCA W5 /NUMBER OF DATA MARKS
+ JMS I SSDSQT /READ DATA MARKS
+ TAD M70
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ W5 /COUNT FOR NUMBER OF BLOCKS
+ JMP .-5
+ TAD M4
+ DCA CNT
+ JMS I SSDSQT /READ PF,F,CK,L
+ TAD M73
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT
+ JMP .-5
+ JMS I SSDSQT /READ REVERSE GUARD
+ TAD M51
+ SZA CLA
+ JMS I MARKER
+
+ JMS I SSDSQT /READ BLOCK NUMBER
+ TAD M45
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ JMS I SSDSQT /READ EXPAND CODE
+ TAD M25
+ SZA CLA
+ JMS I MARKER /END OF ONE BLOCK,MARK TRACK ERROR
+
+ ISZ W6 /FINISHED ALL BLOCKS
+ JMP RSTBLK /NO:DO OTHER BLOCKS
+ TAD M307 /SET UP FOR INTERBLOCK SYNC AT END OF TAPE
+ DCA CNT
+ JMS I SSDSQT /CHECK FOR 199 EXPAND CODES
+ TAD M25
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT
+ JMP .-5
+ JMS I SSDSQT
+ TAD M22
+ SZA CLA
+ JMS I MARKER
+ TAD DTA
+ SDLC
+ JMP I .+1
+WDBLKN, DBLKN /GO OUT TO WRITE DATA AND BLOCK NUMBERS FORWARD
+
+
+\f
+*2000
+DBLKN, TAD C2
+ DCA PHASE
+ TAD VAR2 /NUMBER OF BLOCKS
+
+ DCA W6
+ DCA BLK /INITIAL BLOCK IS 0
+ TAD BLK
+ JMS I MESS /COMPUTE THE COMP OBVERSE OF REV BLK
+ DCA REVBLK
+ SDLD
+ TAD DT1400 /FORWARD,WRITE,GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ SDRC /CHECK TO MAKE SURE WRITE IS SET
+ RTL
+ RAL
+ SMA CLA
+ JMS WLO /WRITE FAILED TO SET
+ TAD M6
+ DCA CNT
+ SDSQ /ROUTINE TO GET UP TO SPEED
+ JMP .-1
+ SDLD
+ ISZ CNT
+ JMP .-4
+ SDLD
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+LINE, SDSS /WRITE ALL ZEROES TO THE FIRST BLOCK
+ JMP .-1
+ SDLD /LOAD THE DATA BUFFER
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77
+ DCA MTR
+ TAD MTR
+ TAD M26
+ SZA CLA
+ JMP LINE
+ SDLD
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ JMP WDOBLK /GO AND WRITE REVERSE GUARD
+WDBLK, CLA CLL /BEGINNING OF BLOCK,WRITE DATA AND BLOCK NUMBER
+ JMS W4L /WRITE EIGHT LINES
+ JMS W4L /END OF EXPAND CODE,BEGINNING OF BLK NUMBER
+ TAD BLK /GET FORWARD BLOCK NUMBER
+ JMS W4L /WRITE IT
+ CLA
+ JMS W4L /WRITE FIRST WORD OF REV GUARD
+WDOBLK, CLA
+ JMS W4L /SECOND WORD OF REVERSE GUARD
+ JMS W4L
+ JMS W4L /FIRST WORD OF REVERSE CHECKSUM
+WDATA, TAD TOTAL /NUMBER OF DATA WORDS TO BE WRITTEN
+ CIA
+ DCA W5 /SET UP COUNTER
+ JMS W4L
+ ISZ W5 /INCREMENT COUNTER
+ JMP .-2
+ CLA CLL
+ TAD MSK77 /COME BACK TO WRITE LAST WORD AND CHECKSUM
+ JMS W4L
+ CLA
+ JMS W4L /FINISH CHECKSUM
+ JMS W4L /FIRST WORD OF REVERSE LOCK
+ JMS W4L /LAST WORD OF RL. AND HALF OF GUARD
+ JMS W4L /REST OF GUARD
+ TAD REVBLK /GET REVERSE BLOCK NUMBER
+ JMS W4L
+ CLA CMA
+ JMS W4L /END OF BLOCK NUMBER AND HALF OF EXPAND CODE
+ JMS W4L /END OF EXPAND CODE
+ ISZ BLK
+ CLA
+ TAD BLK
+ JMS I MESS /COMPUTE NEW BLK NUMBER
+ DCA REVBLK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ ISZ W6 /IS IT DONE WRITING BLK AND DATA
+ JMP WDBLK /NO
+ SDSQ
+ JMP .-1
+ SDRD
+ CLA
+ TAD DT1000 /SEARCH FOR END ZONE
+ TAD DTA /GET UNIT
+ SDLC /LOAD THE COMMAND REG
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ JMP I .+1
+ DBLOCK
+
+W4L, 0
+ SDSQ
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDLD /LOAD THE DATA BUFFER
+ SDST /CHECK FOR A TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ JMP I W4L
+
+C2, 0002
+
+WLO, 0
+ TAD DTA /STOP THE TAPE
+ SDLC /LOAD THE COMMAND REGISTER
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD WLO
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 2722 /WR
+ 1124 /IT
+ 0540 /E
+ 0000 /END
+ JMP I .+1
+ ZCOM
+
+
+
+\f
+*2200
+BLCSD, TAD C4
+ DCA PHASE
+ CLA CLL
+ TAD VAR2
+ DCA W6 /SET UP FOR THE NUMBER OF BLOCKS
+ DCA BLK /SET BLK TO 0
+ TAD DT1000 /FORWARD READ
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REG
+ TAD BLK
+ JMS I MESS /CALCULATE THE COMPLEMENT OBVERSE
+ DCA REVBLK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ TAD M6 /WAIT TO GET UP TO SPEED
+ DCA CNT /SET UP COUNTER
+ SDSQ /SKIP ON A QUAD LINE FLAG
+ JMP .-1
+ SDRD /READ THE DATA BUFFER TO CLEAR FLAG
+ ISZ CNT
+ JMP .-4
+ CLA
+BLCSDA, DCA CHKSUM
+ JMS I SLRDRC /READ A SINGLE LINE AT A TIME
+ TAD M26
+ SZA CLA /IS IT BLOCK MARK
+ JMP SRDRC+4 /NO,GO BACK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ TAD DATRD
+ CIA
+ TAD BLK
+ SZA CLA
+ JMS I BLKERR /BLK NUMBER ERROR
+ JMS I SSDSQT /READ GUARD
+ JMS I SSDSQT /READ REVERSE LOCK
+ JMS I SSDSQT /READ CHECKSUM
+ SDRD /READ THE DATA BUFFER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77
+ JMS I BCXOR /GO OUT TO CHECKSUM ROUTINE
+RDATA, TAD TOTAL /NUMBER OF WORDS PER BLOCK
+ CIA
+ DCA W5 /SET UP COUNTER
+ SDSQ
+ JMP .-1
+ SDRD /READ THE DATA BUFFER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ DCA DATRD
+ TAD DATRD /SAVE THE DATA WORD
+ SZA CLA
+ JMS I DATERR /DATA ERROR
+ TAD DATRD
+ JMS I BCXOR
+ SDST /CHECK FOR A TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ ISZ W5
+ JMP RDATA+3
+ SDSQ /READ REVERSE CHECKSUM
+ JMP .-1
+ SDRD /READ IT IN
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND C7700
+ JMS I BCXOR /CHECK CHECK SUM
+ TAD CHKSUM
+ AND MSK77
+ IAC
+ TAD C7700
+ SZA CLA
+ JMS I CHKERR /CHECKSUM ERROR
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ JMS I SLRDRC /ADVANCE A SINGLE LINE FLAG
+ TAD M31 /LOOK FOR REV BLK NUMBER
+ SZA CLA
+ JMP SRDRC+4
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ TAD DATRD
+ CIA
+ TAD REVBLK /COMPARE BLOCK READ WITH ONE COMPUTED
+ SZA CLA
+ JMS I BLKERR /BLOCK NUMBER ERROR
+ SDSQ
+ JMP .-1
+ SDRD
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ CLA CLL
+ ISZ BLK
+ TAD BLK
+ JMS I MESS
+ DCA REVBLK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ ISZ W6
+ JMP BLCSDA
+ TAD DT1000
+ TAD DTA
+ SDLC
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ JMP I .+1
+ RDBLKS
+
+C4, 0004
+
+\f
+*2400
+DBLOCK, TAD C3
+ DCA PHASE
+ CLA CLL
+ DCA DISBLK
+ TAD DT3000 /REVERSE,GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ CLA CLL
+DISLUP, SDSS
+ JMP .-1
+ CLA CLL
+ SDRD
+ DCA DISDAT /SAVE THE DATA BUFFER
+ SDRC
+ AND MSK77 /MASK OUT THE MARK TRACK
+ TAD M26 /CHECK FOR BLOCK NUMBER
+ SZA
+ JMP DISEND /NOT BLK MARK,CHECK FOR END ZONE
+ TAD DISDAT /DISPLAY THE NUMBER IN THE AC
+ ISZ DISBLK
+ JMP .-1
+ JMP DISLUP /GO SEARCH FOR THE NEXT BLOCK
+DISEND, TAD FOUR /IS IT END ZONE
+ SZA CLA
+ JMP DISLUP /NO,GO GET NEXT LINE
+ TAD DTA /STOP GET READY TO READ
+ SDLC /LOAD THE COMMAND REGISTER
+ JMP I .+1
+ BLCSD
+DISBLK, 0
+DISDAT, 0
+FOUR, 4
+C3, 0003
+C5, 0005
+
+RDBLKS, TAD C5
+ DCA PHASE
+ TAD VAR2
+ DCA W5 /SET UP FOR NUMBER OF BLOCKS
+ IAC
+ TAD VAR2
+ DCA W6 /SET UP TO CHECK BLK REVERSE
+ TAD DT3000 /READ REVERSE GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT
+ SDSS
+ JMP .-1
+ SDRC
+ CLA
+ ISZ CNT
+ JMP .-5
+RDBLK, SDSS
+ JMP .-1
+ SDRD /READ THE DATA BUFFER AND STORE IT AWAY
+ DCA CNT
+ SDRC
+ AND MSK77
+ TAD M26
+ SZA CLA /IS IT BLOCK NUMBER
+ JMP RDBLK
+ TAD CNT
+ TAD W6
+ SZA CLA
+ JMS I BLKERR /BLOCK NUMBER ERROR
+ IAC
+ TAD W6 /INCREMENT A NUMBER FOR COMPARE COUNTER
+ DCA W6
+ ISZ W5 /INCREMENT BLK COUNTER
+ JMP RDBLK
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ TAD DTA
+ SDLC /LOAD THE COMMAND REGISTER WITH UNIT STOP
+ IAC
+ DCA PHASE
+ JMS NUDTA
+ JMP PSER
+ JMP I .+1
+ INIT /END GO BACK TO DIRECT
+/
+/
+/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
+
+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 #
+/
+/
+/THIS SECTION DOES THE ACTUAL COMPARISON BETWEEN
+/THE DTA# PASSED TO THE ROUTINE AND A NUMBER ON THE LIST
+
+DOCOMP, TAD I DBUFPT /GET NXT DTA NUMBER PASSED
+ 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
+/
+/
+
+\f
+*2600
+
+RDFA, CLA CLL
+ TAD DT3000 /REVERSE READ GO
+ TAD DTA /GET UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ SDSS /SKIP ON A SINGLE LINE FLAG
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ AND MSK77
+ TAD M22 /IS IT END ZONE
+ SZA CLA /YES
+ JMP .-6 /NO GO BACK AND LOOK AGAIN
+ TAD DT1000 /FORWARD READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT
+ SDSS
+ JMP .-1
+ SDRC
+ CLA
+ ISZ CNT
+ JMP .-5
+RDFA1, TAD M26
+ DCA W3 /SET UP COUNTER TO READ 22 BLOCKS
+ TAD BADD /SET UP BUFFER ADDRESS
+ DCA X2
+ SDSS /GO SINGLE LINE FLAGS
+ JMP .-1
+ SDRD /READ THE DATA BUFFER
+ DCA CNT
+ SDRC /READ THE COMMAND REGISTER
+ AND MSK77
+ TAD M26 /SEARCH FOR BLOCK NUMBER
+ SZA CLA
+ JMP RDFA1+4 /NOT BLOCK NUMBER YET GO BACK AGAIN
+ TAD CNT /OK BLK NUMBER STORE IT AWAY
+ DCA I X2
+ ISZ W3 /INCREMENT COUNTER
+ JMP RDFA1+4 /NOT 22 BLOCKS YET
+ TAD DTA
+ SDLC /STOP THE DTA
+
+/TYPE OUT BLOCK NUMBERS AND DTA UNIT#
+
+ JMS I TYPE
+ 0424 /DT
+ 0140 /A
+ 0000 /END
+ TAD DTA /GET UNIT NUMBER
+ RTL
+ JMS I TYOCT /AND TYPE IT OUT
+ JMS I TYPE
+ 4345 /CR&LF
+ 0000 /END
+ TAD M26 /WILL TYPE ALL
+ DCA W1 /22 WORDS
+ TAD BADD /ADDRESS OF BLOCK
+ DCA X2 /NUMBERS TO INDEX
+ TAD I X2 /FIRST OR NEXT BLOCK
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE /CR&LF
+ 4345 /CR&LF
+ 0000 /END
+ ISZ W1 /COMPLETE
+ JMP .-6
+ JMP I IT /GO ASK FOR FORMAT
+
+RDR, CLA CLL
+ TAD DT1000 /FORWARD READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ SDSS /SKIP ON A SINGLE LINE FLAG
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ AND MSK77
+ TAD M22 /CHECK FOR END ZONE
+ SZA CLA
+ JMP .-6 /NOT YET GO BACK
+ TAD DT3000 /REVERSE READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT
+ SDSS
+ JMP .-1
+ SDRC
+ CLA
+ ISZ CNT
+ JMP .-5
+ JMP RDFA1 /STORE NUMBERS IN REVERSE
+
+RETRY, JMS I TYPIN
+ JMS I COMPAR
+ 0322 /R
+ 0305 /E
+ 0324 /T
+ 0322 /R
+ 0331 /Y
+ 0000 /END
+ JMP I IT /GUESS HE DOESN'T WANT TO TRY AGAIN
+ CLA
+ TAD DT1000 /FORWARD READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT /WAIT 6 LINES
+ SDSS
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ ISZ CNT
+ JMP .-4
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ TAD DT3000
+ TAD DTA
+ SDLC
+ CLA IAC
+ DCA PHASE
+ JMP I .+1
+ PSER+11
+
+
+\f
+*3000
+
+
+SDSQT, 0
+ SDSQ /ADVANCE SIX LINES
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDRC /READ COMMAND REGISTER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1 /SKIP ON SINGLE LINE FLAG
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77 /SAVE THE MARK TRACK LAST 6 BITS
+ DCA MTR
+ TAD MTR
+ JMP I SDSQT
+
+A3LNS, 0 /ADVANCE THREE LINES
+ SDSS
+ JMP .-1 /SKIP ON SINGLE LINE FLAG
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77
+ DCA MTR
+ TAD MTR
+ JMP I A3LNS
+
+CEXPC, 0
+ TAD MTR
+ TAD M52
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ JMS A3LNS /READ THREE MORE LINES
+ TAD M25 /IS IT 25 NOW
+ SZA CLA
+ JMS I MARKER /NO ,MARK TRACK ERROR
+ JMP I CEXPC /YES:IT IS EXPAND CODE NUMBER 1
+
+ /SIXBIT COMPLEMENT XOR SUBROUTINE
+ /SUBROUTINE IS ENTERED WITH DATA WORD TO BE XORED IN AC
+ /TWO SIX-BIT COMPLEMENT XORS WILL TAKE PLACE TO LOC CHKSUM
+ /WITH THE RESULT IN CHKSUM
+
+SBCXOR, 0
+ CMA /COMPLEMENT WORD
+ DCA SBWORD /AND SAV
+ TAD SBWORD
+ AND CHKSUM
+ CIA
+ CLL RAL
+ TAD SBWORD
+ TAD CHKSUM
+ DCA CHKSUM
+ TAD SBWORD
+ RTR CLL;RTR;RTR
+ DCA SBWORD
+ TAD SBWORD
+ AND CHKSUM
+ CIA
+ CLL RAL
+ TAD SBWORD
+ TAD CHKSUM
+ AND MSK77
+ DCA CHKSUM
+ JMP I SBCXOR
+
+SRDRC, 0
+ SDSQ
+ SKP
+ JMP .+3
+ SDSS
+ JMP .-1
+ SDRD
+ DCA DATRD
+ SDRC
+ AND MSK77
+ JMP I SRDRC
+
+NUDTA, 0
+ TAD I LSTPT /GET CURRENT VALUE OF DATA LIST PTR
+ DCA TBUFPT /STORE IT AS TEM,BUF,PTR
+ TAD I TBUFPT /GET A DTA # FROM THE LIST
+ AND C0007
+ SZA CLA /IS IT A 7777
+ JMP LSTEND /YES END OF LIST
+ TAD I TBUFPT /NO;GET IT BACK
+ DCA DTA
+ ISZ I LSTPT /INCREMENT LIST POINTER
+ JMP I NUDTA /RETURN
+/COME HERE AT END OF LIST TO RESET POINTERS AND RETURN TO CALL+2
+LSTEND, ISZ NUDTA /INCREMENT RETURN POINTER
+ TAD I STRTPT /GET ADR OF START OF LIST
+ DCA I LSTPT
+ JMP NUDTA+1 /GO GET FIRST DTA# AND RETURN
+STRTPT, DBUFAD /POINTER TO START OF DATA LIST
+TBUFPT, 0 /TEM STORAGE FOR BOT PTR
+LSTPT, DBUFPT /POINTER TO CURRENT VALUE OF DTA LIST PTR
+
+/CONSTANTS FOR FORMULA TRANSLATION SECTION
+BINCON, .+1
+ 0001
+ 0012
+ 0144
+ 1750
+DTABUF, 0
+
+
+
+
+\f
+*3200
+ /CHECK SWITCH TO SEE IF SET TO WTM POSITION
+SWCHK, JMS I TYPE /TYPE OUT MESSAGE
+ 2305 /SE
+ 2440 /T
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4024 /T
+ 1740 /O
+ 2724 /WT
+ 1500 /M
+ JMS I TYPIN /WAIT FOR CR
+ CLA
+ DCA CNTERL
+ SDLD /CLEAR SINGLE AND QUAD FLAGS
+ SDSS
+ SKP
+ JMP .+4
+ ISZ CNTERL
+ JMP .-4
+ JMP SWCHER /ERROR,TYPE ERROR MESSAGE AND GO TO SWCHK
+ /SEE IF THE DRIVE IS OK
+RSTSM, SDLC /LOAD CR TO CLEAR TIMEING ERROR
+ SDLD /LOAD DATA BUFFER TO CLEAR S Q FLAGS
+ TAD DT0400 /SET WRITE
+ TAD DTA /GET UNIT
+ DCA SAV /STORE IT AWAY
+ TAD SAV
+ SDSS
+ JMP .-1
+ SDLC
+ TAD SAV
+ SDLC /LOAD THE TRANSPORT
+ SDRC /READ THE COMMAND REGISTER AND CHECK IT
+ RTL
+ RAL
+ SMA /CHECK WRITE TO BE SET
+ JMP ERCHK /WRITE IS NOT SET
+ RAL /CHECK WLO
+ SPA
+ JMP ERCHK /WLO
+ RAL /CHECK SELECT AND TIMING ERROR
+ SPA CLA
+ JMP ERCHK /SELECT OR TIMING ERROR
+ JMS NUDTA /CHECK OTHER DRIVE IF ANY
+ JMP RSTSM-11 /CHECK OTHER DRIVE
+ JMP I .+1
+ STMK
+CNTERL, 0
+SAV, 0
+
+ERCHK, JMS I TYPE /INCORRECT SETUP
+ 2305 /SE
+ 2425 /TU
+ 2077 /P
+ 0000 /END
+ JMP I .+1
+ START
+
+SWCHER, JMS I TYPE
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4016 /N
+ 1724 /OT
+ 4023 /S
+ 0524 /ET
+ 4024 /T
+ 1740 /O
+ 2724 /WT
+ 1540 /M
+ 1722 /OR
+ 4023 /S
+ 1116 /IN
+ 0714 /GL
+ 0540 /E
+ 1411 /LI
+ 1605 /NE
+ 4006 /F
+ 1401 /LA
+ 0740 /G
+ 0601 /FA
+ 1114 /IL
+ 0504 /ED
+ 4024 /T
+ 1740 /O
+ 2305 /SE
+ 2440 /T
+ 4543 /CR LF
+ 0000 /END
+ JMP SWCHK
+
+SWOFF, CLA
+ DCA CNTERL
+ SDLD /CLEAR ANY FLAGS THAT ARE SET
+ SDSS
+ SKP
+ JMP OFF /FLAG SHOULDN'T BE SET
+ ISZ CNTERL
+ JMP .-4
+ CLA
+ JMP I .+1
+ PSER
+
+
+*3400
+/INPUT BUFFER FOR TELETYPE THIS MUST BE AT THE END OF PROGRAM
+
+BUFFER, 0
+
+$
projects / pdp8.git / blobdiff