software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape4 / TDFRMT.PA

/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

$