/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.
/
/
/
/
/
/
/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
/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
*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
*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
/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
*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
*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
*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
*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
*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
*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
/
/
*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
*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
*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
$