Add README.md

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

/TC08 DECTAPE FORMATTER, V4
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
\f/COPYRIGHT 1970 DIGITAL EQUIPMENT CORP.
/MAYNARD, MASS.
/REVISED APRIL 1970

/   TOG-8	TO MARK AND CHECK PDP-8 DECTAPE
/THIS PROGRAM WRITES TIMING AND MARK TRACKS ON
/DECTAPE MOUNTED ON THE TCO1-TU55 TAPE CONTROL UNIT.





	X1=10
	X2=11

/SYMBOL TABLE AUGMENTATION

	DTRA=6761
	DTCA=6762
	DTXA=6764
	DTSF=6771
	DTRB=6772
	DTLB=6774
	DTCX=6766

/SET 0 FOR THE LOGIN FEATURE

	*0
	0
	JMP I .+1
	CONC	/CONTROL "C" AND LOGIN

/WORKING LOCATIONS

	*20

W1,	0000
W2,	0000
W3,	0000
W4,	0000
W5,	0000
W6,	0000
BLOCKS,	0000
BLOCKA,	0000
DTA,	0000
ERX,	0000
PHASE,	0000
TOTAL,	0000
VAR1,	0000
VAR2,	0000
\f/CONSTANTS

C1,	0001
C2,	0002
C3,	0003
C4,	0004
C0017,	0017
C0070,	0070
C0077,	0077
C0007,	0007
C0030,	0030
C0400,	0400
C0700,	0700
C203,	0203
C201,	0201
C210,	0210
C260,	0260
C261,	0261
C267,	0267
C270,	0270
C271,	0271
C277,	0277
C1000,	1000
C1620,	1620
C7000,	7000
C7700,	7700
C7714,	7714
C7761,	7761
C7772,	7772
C7775,	7775
CRCOD,	0215
LETK,	0313
LFCOD,	0212
M2,	-2
M3,	-3
M4,	-4
M6,	-6
M7,	-7
M14,	-14
M144,	-144
M300,	-300
SPCOD,	0240
\f/INTERPAGE LINKS

ADW2,	W2-1
ADW3,	W3-1
BADD,	BUFFER-1
BFR,	BUFFER
CA,	7755
COMPAR,	COMPRE
FCON,	0000
IT,	INIT1
FORMA,	FORM-1
FORMB,	FORM
QU1,	Q1
QU2,	Q2
QU3,	Q3
QU4,	Q4
MESS,	MES
STX,	START
TURN,	TRN
TYOCT,	TYCT
TYPE,	MESAGE
TYPIN,	TYPN
WAIT,	STALL
WC,	7754
DBUFPT,	0	/POINTER TO CURRENT POSITION IN DTA LIST


\f


/TYPE THE CHARACTER IN THE AC ON THE KEYBOARD PRINTER

RSEND,	0000
	TLS		/LOAD AND PRINT, CLEAR FLAG
	TSF		/WAIT FOR CONFIRMATION
	JMP   .-1	/ENDLESSLY
	TCF		/CLEAR THE FLAG ANYWAY
	JMP I RSEND


/PRINT A "?" ON THE KEYBOARD TYPER

QU,	.+1
	IOF		/KILL LOG AND CONTROL C FCTN
	CLA   CLL	/C(AC)+C(L)=0
	TAD   C277	/"?"
	JMS   RSEND	/TYPE THE CHARACTER
	JMP I .+1	/RESTART
	INIT

/DECTAPE CONTROL WORDS

DT0030,	0030
DT0060,	0060
DT0070,	0070
DT0100,	0100
DT0130,	0130
DT0140,	0140
DT0200,	0200
DT0210,	0210
DT0360,	0360
DT0510,	0510
DT0600,	0600
DT0610,	0610

/SOME SPECIAL LINKS

ADBA,	2475
ADWA,	2476
ADWAB,	2477

/CONSTANTS FOR FORMULA TRANSLATION SECTION

BINCON,	.+1
	0001
	0012
	0144
	1750
\f	*200	/PAGE 1
/TYPE CANNED MESSAGES.....
/THANKS TO DIGITAL 8-18-U

MESAGE,	0
	IOF		/KILL LOG AND CONTROL FUNCTION
	CLA   CMA	/SET C(AC)=-1
	TAD   MESAGE	/ADD LOCATION
	DCA   10	/AUTO INDEX REGISTER
	TAD I 10	/FETCH FIRST WORD
	DCA   MSRGHT	/SAVE IT
	TAD   MSRGHT
	RTR
	RTR		/ROTATE 6 BITS TO THE RIGHT
	RTR
	JMS   TYPECH	/TYPE IT
	TAD   MSRGHT	/GET DATA AGAIN
	JMS   TYPECH	/TYPE RIGHT HALF
	JMP   MESAGE+5	/CONTINUE
MSRGHT,	0		/TEMPORARY STORAGE
TYPECH,	0		/TYPE CHARACTER IN C(AC)6-11
	AND   C0077
	SNA		/IS IT END OF MESSAGE?
	JMP I 10	/YES: EXIT
	TAD   M40	/SUBTRACT 40
	SMA		/<40?
	JMP   .+3	/NO
	TAD   C340	/YES: ADD 300
	JMP   MTP	/TO CODES <40
	TAD   M3	/SUBTRACT 3
	SZA		/IS IT ZERO?
	JMP   .+3	/NO
	TAD   C212	/YES: CODE 43 IS
	JMP   MTP	/LINE-FEED (212)
	TAD   M2	/SUBTRACT 2
	SZA		/IS IT ZERO?
	JMP   .+3	/NO
	TAD   C215	/YES: CODE 45 IS
	JMP   MTP	/CARRIAGE RETURN (215)
	TAD   C245	/ADD 200 TO OTHERS >40
MTP,	TLS		/TRANSMIT CHARACTER
	TSF		/WAIT FOR THE FLAG
	JMP   .-1	/NOT SET YET
	CLA 		/SET: CLEAR C(AC)
	JMP I TYPECH	/RETURN

/CONSTANTS

M40,	-40
C340,	340
C212,	212
C215,	215
C245,	245
\f/ROUTINE WAITS UNTILL A COMPLETE MESSAGE HAS BEEN ENTERED
/SIGNIFIED BY A CR.

TYPN,	0
	IOF		/KILL THE LOG AND CONTROL C FUNCTION
	KCC		/CLEAR AC, KEYBOARD FLAG
	TAD   BADD	/GET BUFFER ADDRESS
	DCA   W1	/STORE FOR THE CHARACTER STRING

/READ AND RESPOND WITH THE CHARACTER

NTYRTN,	ISZ   W1	/NORMAL RETURN. INCREMENT BUFFER
	KSF		/WAIT FOR KEYBOARD
	JMP   .-1	/FLAG TO RAISE
	KRB		/GOT FLAG, RESET IT, GET CHARACTER
	JMS   RSEND	/SEND CHARACTER BACK
	AND	(177	/TAKE CARE OF PARITY
	TAD	(200
	DCA I W1	/LOAD CHARACTER INTO BUFFER AREA
	TAD I	W1	/CHECK FOR CTRL C
	CIA
	TAD	C203
	SZA	CLA
	JMP	CHKSP	/NO- CHECK FOR SPACE
	6007		/CTRL C	-CLEAR ALL FLAGS
	NOP		/FOR OLD MACHINES
	CLA		/JUST IN CASE
	DTLB		/CLEAR STATUS REGISTER B
	JMP I	(7605

/IF CHARACTER IS A SPACE, IGNORE IT

CHKSP,	TAD I W1	/CHARACTER INTO THE AC
	CIA		/SUBTRACT FROM SPACE CODE (240)
	TAD   SPCOD	/COMPLETE COMPARISON
	SNA   CLA	/WAS IT A SPACE?
	JMP   NTYRTN+1	/YES: DO NOT INCREMENT BUFFER

/IF CHARACTER IS A CR, EXIT FROM ROUTINE

	TAD I W1	/CHARACTER TO AC
	CIA		/SET AC TO SUBTRACT CR (215)
	TAD   CRCOD	/COMPLETE COMPARISON
	SZA   CLA	/WAS IT CR?
	JMP   NTYRTN	/NO: INCREMENT BUFFER + WAIT

/CARRIAGE RETURN FOUND, EXIT FROM ROUTINE

	TAD   LFCOD	/GIVE KEYBOARD LINE FEED
	JMS   RSEND	/EXECUTE LINE FEED
	CLA   CLL	/EXIT WITH C(ACC) + AND C(L)=0
	ION		/RESET LOG AND CONTROL C FUNCTION
	JMP I TYPN	/RETURN TO CALL
\f/COMPARE A STRING OF CHARACTERS IN "BUFFER"
/TO A CHARACTER STRING AFTER A JMS IN ASCII

COMPRE,	0
	CLA   CMA	/C(AC)=7777
	TAD   COMPRE	/SUBTRACT 1 FOR INDEX REG 1
	DCA   10	/AUTO INDEX 1 SET TO CHA STRING
	TAD   BADD	/AUTO INDEX 2 SET TO BUFFER-1
	DCA   11	/LOAD X2

/COMPARE CHARACTERS TILL ONE DOESN'T COMPARE OR TILL
/A 0 IS FOUND IN X1. IF OK, RETURN TO TWO PLUS THE
/ZERO, IF BAD ONE PLUS

	TAD I X1	/CHARACTER FROM PROGRAM
	CIA		/TO SUBTRACT FROM
	TAD I X2	/CHARACTER IN BUFFER
	SZA   CLA	/COMPARE?
	JMP   CERR	/NO:RESYNC FOR NON COMPARE EXIT
	TAD I X1	/YES: CHECK FOR GOOD EXIT
	SZA		/IF 0, EXIT GOOD
	JMP   .-6	/NO: TEST NEXT CHAACTER
	ISZ   X1	/+1 TO X1(TOTAL 2 FROM THE 0)
	JMP I X1	/+1 TO X1, EXIT

/ERROR FOUND. RESYNC AND EXIT NO COMPARE

CERR,	TAD I X1	/CHARACTER FROM PROGRAM
	SZA   CLA	/IS THIS EXIT KEY? (0000)
	JMP   .-2	/NO: GET NEXT
	JMP I X1	/YES: EXIT, NOT COMPARE
\f\f	*400
/VARIOUS ERROR MESSAGES
/"NOT DECIMAL"

Q1,	JMS I TYPE
	1617  /NO
	2440  /T
	0405  /DE
	0311  /CI
	1501  /MA
	1400  /L
	JMP   QUX

/"TO MANY WORDS"

Q2,	JMS I TYPE
	2417  /TO
	1740	/O 
	1501	/MA
	1631	/NY
	4027	/ W
	1722	/OR
	0423	/DS
	0000	/00
	JMP   QUX

/"TO MANY BLOCKS"

Q3,	JMS I TYPE
	2417  /TO
	1740	/O 
	1501	/MA
	1631	/NY
	4002	/ B
	1417	/LO
	0313	/CK
	2300	/S0
	JMP   QUX

/"NOT DIVISIBLE BY 3"
Q4,	JMS I TYPE
	1617  /NO
	2440  /T
	0411  /DI
	2611  /VI
	2311  /SI
	0214  /BL
	0540  /E
	0231  /BY
	4063  / 3
	0000  /00
QUX,	JMS I TYPE
	4345  /CR+LF
	0000  /END
	JMP I .+1
	INIT
\f/THE CODING BELOW CREATES THE BLOCK NUMBER
/CONVERSION PRIOR TO THE TAPE WRITE.

MES,	0
	DCA   W4	/BLOCK NUMBER GIVEN IN AC
	TAD   W4	/RESTORE TO AC AGAIN
	CMA		/COMPLEMENTED
	RTL
	RAL		/LEFT 3
	DCA   W5	/TEMP SAVE
	TAD   W5	/TO AC AGAIN
	AND   C7000	/ISOLATE HIGH CHA
	DCA   V2	/FORWARD BLOCK NUMBER
	TAD   W5	/SHIFTED VALUE
	AND   C0070	/ISOLATE 6,7,8
	DCA   V1	/FORWARD BLOCK NUMBER
	TAD   W4	/ORIGIONAL SET
	CMA  		/UPSIDE DOWN
	RTR
	RAR		/RIGHT 3
	DCA   W5	/TEMP SAVE
	TAD   W5	/TO AC AGAIN
	AND   C0700	/ISOLATE 3,4,5
	TAD   V2	/COMBINE FORWARD BLOCK NUMBER
	TAD	C0077
	DCA   V2	/1/2 COMPLETE
	TAD   W5	/SHIFTED VALUE
	AND   C0007	/ISOLATE 9, 10,11
	TAD   V1	/COMBINE WITH BN
	DCA   V1	/FORWARD BLOCK NUMBER COMPLETE

/CONVERT REVERSE BLOCK NUMBER

	CMA		/-1 TO GIVEN BLOCK #
	TAD   W4	/ORIGIONAL BLOCK #
	DCA   W5	/TEMP SAVE
	TAD   W5	/TO AC AGAIN
	RTR
	RTR		/6 RIGHT
	RTR
	AND   C0077	/ISOLATE LOW
	DCA   V3	/HIGH REVERSE
	TAD   W5	/COMPLEMENT ORIGIONAL -1
	RTL
	RTL		/6 LEFT
	RTL
	AND   C7700	/ISOLATE HIGH
	DCA   V4	/REVERSE COMPLETED
	JMP I MES
\f/FORM USED TO WRITE 12 DATA WORDS FOR BLOCK NUMBERING

FORM,	0000
	0000
	0000
	0000
V1,	0000
V2,	0000
	7777
	7700
	0000
V3,	0000
V4,	0000
	0000
\f//THIS ROUTINE ALLOWS KEYBOARD INTERRUPTION
/FOR LOGGING ON THE KEYBOARD, OR FOR A MAJOR
/CLEAR IN THE PROGRAM. BY HITTING "CONTROL C"
/A SYSTEM RESTART WILL OCCUR.

CONC,	TSF		/IS THE PRINTER FLAG ON?
	JMP   .+5	/NO, CHECK READER
	TCF		/YES: RESET IT
	KSF		/IS THE READER FLAG ON?
	JMP	RTNS	/NO: RETURN TO SEQUENCE
	JMP	.+3
	KSF
	HLT

/OK. CHECK FOR EITHER LOG OR CONTROL C.

	DCA   MES	/SAVE C(AC)
	RAL		/SAVE THE LINK
	DCA   RSYC+6	/FOR LOGGING
	KRB		/GET CHARACTER FROM KEYBOARD
	TLS		/RETURN CHARACTER
	CIA		/TO SEE IF
	TAD   C203	/"CONTROL C"
	SNA   CLA	/IS IT?
	JMP   RSYC	/YES: RESYNC THE PROGRAM
	TAD   RSYC+6	/RESTORE THE LINK
	RAR		/FOR EXIT.
	TAD   MES	/THE AC TOO
RTNS,	ION		/INTERRUPT ON 
	JMP I 0		/RETURN
\f
*600
/RESYNC THE SYSTEM TO START

RSYC,	TSF		/WAIT FOR FLAG
	JMP   .-1	/ON LAST SENDOFF
	JMS I TYPE
	2205  /RE
	2331  /SY
	1603  /NC
	0000  /END
	TAD   DTA	/TO KILL EXISTING TAPE MOTION
	DTCX		/NOW
	JMP I STX	/RETURN TO START
\f/WAIT FOR THE DECTAPE FLAG TO RISE

STALL,	0
	CLA
	DTRB		/READ TCU "B" REGISTER
	SPA		/ERROR?
	JMP   ERROR	/YES, DECIDE WHAT TO DO
	RAR		/DECTAPE FLAG TO LINK
	SNL   CLA	/FLAG?
	JMP   .-5	/NO: CONTINUE WATCH
RERR,	DTXA		/RESET THE DECTAPE FLAG
	DCA   ERX	/CLEAR THE END TAPE FLAG
	JMP I STALL	/GOT FLAG, EXIT

/DRIVE TAPE INTO THE END ZONE, AND TURN IT 
/AROUND.
/IF C(AC)=0400, TAPE INTO REVERSE END ZONE
/IF C(AC)=0000, TAPE INTO FORWARD END ZONE

TRN,	0
	ISZ   ERX	/END ZONE IS LEGAL
	DCA   W4	/SAVE DIRECTION
	TAD   DT0200	/MOVE FUNCTION,GO
	TAD   W4	/DIRECTION TO MOVE
	TAD   DTA	/DRIVE TO MOVE
	DTCX		/CLEAR AND RESET "A"
	JMS I WAIT	/FOR END ZONE FLAG
	TAD   DT0610	/SEARCH, GO
	TAD   W4	/DIRECTION TO SEARCH
	AND   C0777	/DELETE OVERFLOW BIT
	TAD   DTA	/SET THE DECTAPE
	DTCX		/RESET STATUS "A"
	DCA   ERX	/END ZONE NOT LEGAL NOW
	JMP I TRN	/RETURN TO SEQUENCE
C0777,	0777

\f/AN ERROR FLAG HAS BEEN SET. IN SOME CASES
/END ZONE IS LEGAL, OTHERWISE, A RESTART ATTEMPT
/MAY BE INITIATED.

/DETERMINE WHICH FLAG SET THE DECTAPE FLAG

ERROR,	DCA   W5	/SAVE "B" REGISTER
	TAD   DTA	/GOING TO KILL
	DTCX		/TAPE MOTION
	TAD   W5	/RESTORE "B" REGISTER
	RTL		/POSITION BITS 1+2
	SPA  		/END OF TAPE FLAG?
	JMP   ZEOT	/YES: GO TO ROUTINE
	SZL		/MARK TRACK ERROR?
	JMP   ZMKTK	/YES: GO TO ROUTINE
	RTL		/POSITION BITS 2+3
	SPA		/PARITY ERROR?
	JMP   ZPAR	/YES: GO TO PARITY ERROR ROUTINE
	SZL   CLA	/SELECT ERROR?
	JMP   ZSEL	/YES: GO TO ROUTINE
	JMP   ZTIM	/MUST BE TIMING ERROR

/END OF TAPE FLAG FOUND, SEE IF IT'S LEGAL

ZEOT,	CLA   CLL	/CLEAR REMAINS
	TAD   ERX	/SWITCH
	SZA   CLA	/ERROR?
	JMP   RERR	/OK, IT'S LEGAL

/NOT LEGAL END ZONE FLAG

	JMS I TYPE
	0516   /EN
	0440   /D 
	2401   /TA
	2005   /PE
	4000   / 0
	JMP   ZCOM

/MARK TRACK ERROR

ZMKTK,	JMS I TYPE
	1501   /MA
	2213   /RK
	4024   / T
	2201   /RA
	0313   /CK
	4000   / 0
	JMP   ZCOM
\f/PARITY ERROR

ZPAR,	JMS I TYPE
	2001   /PA
	2211   /RI
	2431   /TY
	4000   / 0
	JMP   ZCOM

/SELECT ERROR

ZSEL,	JMS I TYPE
	2305   /SE
	1405   /LE
	0324   /CT
	4000   / 0
	JMP   ZCOM

/TIMING ERROR

ZTIM,	JMS I TYPE
	2411   /TI
	1511   /MI
	1607   /NG
	4000   / 0

/TYPE "ERROR PHASE X"

ZCOM,	TAD   PHASE	/WHAT PHASE OF OPERATION
	TAD   PFORM	/WAS THE MACHINE IN
	DCA   TFORM	/WHEN ERROR OCCURED
	JMS I TYPE
	0522   /ER
	2217   /RO
	2240   /R 
	2010   /PH
	0123   /AS
	0540   /E
TFORM,	4060   / X
	4345   /CR+LF
	0000   /END
	JMS I TYPIN

/HE CAN RESTART IF HE TYPES "RETRY"

	JMS I COMPAR
	0322  /R
	0305  /E
	0324  /T
	0322  /R
	0331  /Y
	0000  /0
	JMP I IT	/GUESS HE DOESN'T WISH TO TRY AGAIN
\f/ATTEMPT RESTART. NOTE, "ATTEMPT"

	TAD   PHASE	/RESTART ACCORDING TO 
	TAD   ZFORM	/WHICH PHASE WAS HE IN
	DCA   .+3
	JMP I .+2
ZFORM,	.+2
	0000
	JMP I .+5	/PHASE 0
	JMP I .+5	/PHASE 1
	JMP I .+5	/PHASE 2
	JMP I .+5	/PHASE 3
	JMP I .+5	/PHASE 4
	START
	PSER
	DOBLK
	DBN
	NOP
PFORM,	4060
\f


/HERE STARTS THIS PROGRAM. IT WILL ASK THE
/OPERATOR FOR  DRIVE NUMBERS, THEN ASK HIM FOR
/A DIRECTION ON WHAT TO DO WITH THE DRIVES.

/THE SEQUENCE FOR MARKING A TAPE WOULD APPEAR AS:


/DTA? (3 OR 1 2 3 OR 2 4 7)
/DIRECT? (MARK 1215)
/2277 WORDS, 0256 BLOCKS.OK? YES OR NO
/(YES)


/THAT DATA IN PARENTHESIS IS TYPED BY THE OPERATOR
/(HE DOESN'T TYPE THE PARENTHESIS)
/IF HE HAD ANSWERED NO, "DIRECT?" WOULD BE TYPED OUT.
/IF THE DRIVE WAS WRONG, HE WOULD TYPE RESTART.
/IF HE HAD TYPED "MARK" IN RESPONSE TO "DIRECT?" THE
/TAPE WOULD BE MARKED WITH THE STANDARD PDP-8 CONFIGURATION.
/IF HE HAD TYPED "MARK 384" THE TAPE WOULD
/BE MARKED WITH THE STANDARD PDP-10 CONFIGURATION
/NOTE: THE WORD AND BLOCK NUMBERS ARE TYPED IN OCTAL
/IF A MISTAKE OCCURS ON THE OPERATORS PART (WITH REFERANCE
/TO BLOCK + WORD SIZE) HE WILL BE TOLD ABOUT IT





\f	*1000

/MAKE A CALL FOR THE DECTAPE NUMBERS TO BE
/WORKED.


START0,	JMS I	TYPE	/PRINT TITLE
	4543
	4300
	JMS I	TYPE
	TEXT	/DTFRMT V4A/


START,	JMS I TYPE	/SET UP TYPER
	4543  /CR+LF
	4300  /LF+END
TYQU,	JMS I TYPE	/"DTA?"
	0424  /DT
	0177  /A?
	4000  / END

/WAIT FOR A REPLY

	JMS I TYPIN	/GET NUMBERS
	TAD	BADD	/INITIALIZE POINTER (BFR)
	IAC		/(BADD=BUFFER-1, SO BUMP THE AC)
	DCA	BFR	/TO START OF INPUT BUFFER
	DCA	DCTR	/INITIALIZE DTA COUNTER TO 0
	DCA	CRFLAG	/CLEAR FLAG SO CR NOT ACCEPTIBLE
CRCHK,	TAD	CRCOD	/GET CODE FOR CAR. RETN
	CIA		/NEGATE IT
	TAD I	BFR	/SEE IF NEXT CHAR. IN
	SNA		/BUFFER IS CAR. RETN.
	JMP	OKCR	/YES: SEE IF C.R. LEGAL HERE
	DCA	CRFLAG	/NO: SO C.R. IS LEGAL NOW
VALCHK,	TAD	C261	/SEE IF # IS LESS THAN
	CIA		/ASCII 1 (261)
	TAD I BFR	/SUBTRACT BUFFER DATA
	SPA   CLA	/IS IT LESS THAN ASII 0?
	JMP   TYQU	/YES: TELL OUTSIDE WORLD
	TAD   C270	/NO: SEE IF GREATER THAN
	CMA		/ASC II 8 (270)
	TAD I BFR	/SUBTRACT BUFFER DATA
	SMA   CLA	/GREATER THAN ASCII 7?
	JMP   TYQU	/YES: TELL OUTSIDE WORLD
	TAD I BFR	/NO: ACCEPT BUFFER 
	RTR
	RTR		/4 BITS RIGHT
	AND   C7000	/ISOLATE DTA
	JMS	REPEAT	/GO CHECK FOR REPEATED DTA AND STORE #
	ISZ	BFR	/INCREMENT INPUT BUF. PTR.
	JMP	CRCHK	/GO LOOK AT NEXT CHAR.

/THIS SECTION CHECKS TO SEE IF THERE HAS BEEN ANY
/VALID INPUT ONCE A CARRIAGE RETURN IS SEEN
OKCR,	CLA		/CLEAR AC
	TAD	CRFLAG	/LOAD CR FLAG; 0 MEANS NO GOOD
	SNA	CLA
	JMP	START	/0: NO VALID INPUT; RESTART
	TAD	DCTR	/NOT 0: SO HAVE VALID INPUT
	TAD	DBUFAD	/CALCULATE END OF DTA LIST +1
	DCA	DBUFPT	/STORE IT IN BUFFER POINTER, THEN
	CMA		/COMPLEMENT THE AC AND
	DCA I	DBUFPT	/TERMINATE DTA LIST WITH 7777
INIT1,	CLA		/CLEAR AC IF COME THRU LOC IT
	TAD	DBUFAD	/AND RESET LIST POINTER
	DCA	DBUFPT	/TO START OF LIST
	JMS I	GETDTA	/GO GET A DTA NUMBER

/INFORM THE OPERATOR THAT THE PROGRAM IS SET TO START
/TYPE "DIRECT" AND WAIT FOR THE REPLY

INIT,	JMS I TYPE	/MESSAGE OUT
	0411  /DI
	2205  /RE
	0324  /CT
	7740  /?
	0000  /END
	JMS I TYPIN	/WAIT FOR A REPLY
	JMS I COMPAR	/DID HE TYPE "MARK"?
	0315  /M
	0301  /A
	0322  /R
	0313  /K
	0000  /END
	JMP   .+3
	JMP I .+1
	MARK		/TO MARK A TAPE
\f/SEE IF HE TYPED "RDR" (READ AND TYPE FIRST 12
/BLOCK NUMBERS IN REVERSE).

	JMS I COMPAR
	0322  /R
	0304  /D
	0322  /R
	0000  /0
	JMP   .+3
	JMP I .+1
	RDR		/TYPE BLOCKS 

/SEE IF HE TYPED "RDF" (READ AND TYPE FIRST 12
/BLOCK NUMBERS FORWARD).

	JMS I COMPAR
	0322  /R
	0304  /D
	0306  /F
	0000  /0
	JMP   .+3
	JMP I .+1
	RDFA		/TYPE BLOCKS

/SEE IF HE TYPED "SAME" (MEANING MARK A TAPE
/USING THE SAME CONSTANTS AS BEFORE).

	JMS I COMPAR
	0323  /S
	0301  /A
	0315  /M
	0305  /E
	0000  /0
	JMP   .+3
	JMP I .+1
	RSTSM		/TO MARK AS BEFORE

/SEE IF HE TYPED "RESTART"

	JMS I COMPAR
	0322  /R
	0305  /E
	0323  /S
	0324  /T
	0301  /A
	0322  /R
	0324  /T
	0000  /0
	JMS   QU	/MUST BE NONSENSE
	JMP	START	/START ALL OVER
GETDTA,	NUDTA		/POINTER TO ROUTINE TO SWITCH UNITS
CRFLAG,	0		/=0, CR NO GOOD; NOT 0, CR IS OK
\f/
\f	*1200
/MARK WAS TYPED IN, IF W1-1 IS NOT A "K",ASSUME THAT
/A NUMBER WAS TYPED IN, AND VERIFY THIS. IF W1-1 IS
/A "K", ASSUME STANDARD FORMAT.(W1=LAST ENTRY INTO THE BUFFER)

MARK,	TAD   BINCON	/ADDRESS OF FIRST BINARY
	DCA   W5	/CONSTANT FOR DEC TO BIN
	DCA   TOTAL	/WILL BE BINARY EQUIVILANT

/SAVE C(X1) FOR DECREMENT THROUGH BUFFER

DNC,	CLA   CMA	/DECREMENT BUFFER ADDRESS
	TAD   W1	/ADDRESS BY 1
	DCA   W1	/W1=SWEEP ADDRESS

/LOOK FOR END OF PROCESSING BY LOOKING FOR A "K" IN BUFFER

	TAD   LETK	/LETTER ASCII "K"
	CIA		/SUBTRACT FROM CHARACTER
	TAD I W1	/IN BUFFER
	SNA   CLA	/EQUAL?
	JMP   DIV3	/YES: SEE IF DIVISIBLE BY 3

/VERIFY THIS CHARACTER AS BEING OF DECIMAL ORIGIN

	TAD   C260	/ASCII FOR 0
	CIA		/TO SEE IF CHARACTER
	TAD I W1	/IS LESS THAN 260
	SPA   CLA	/IS IT?
	JMP I QU1	/YES: NOT DECIMAL CHARACTER
	TAD   C271	/ASCII FOR 9
	CMA		/TO SEE IF GREATER THAN
	TAD I W1	/9
	SMA   CLA	/IS IT?
	JMP I QU1	/NOT A DECIMAL CHARACTER
\f/CHARACTER IS DECIMAL. NOW CONVERT IT TO BINARY
/REMEMBER POSITION OF CHARACTER IN BUFFER MAY BE
/10,100,1000.

	TAD I W1	/ISOLATE THE NUMBER
	AND   C0017	/FOR PROPER CONVERSION
	SNA 		/IF 0, NO BINARY CONVERSION NEEDED
	JMP   IBS	/YES: 0: INCREMENT BINARY CONVERSION

/NOT 0, SET UP CONVERSION LOOP

	CLL   CIA	/NUMBER OF ADDITIONS
	DCA   W4	/TO NEGATIVE FOR ISZ
	TAD I W5	/BINARY POSITION TO C(ACC)
	TAD   TOTAL	/ADD TO PRESENT TOTAL
	SZL		/CHECK ON TO MANY WORDS
	JMP I QU2	/TO MANY WORDS CALLED FOR
	DCA   TOTAL	/KEEP RUNNING SUM
	ISZ   W4	/LAST ADDITION?
	JMP   .-6	/NO: ADD AGAIN

/FINAL ADDITION FOR THIS POSITION COMPLETED

IBS,	ISZ   W5	/NEXT POSITION
	JMP   DNC	/DO NEXT CHARACTER

/LAST CHARACTER COMPLETED. SEE IF DIVISIBLE BY 3
/IF NOT A NORMAL INPUT

DIV3,	TAD   TOTAL	/GET TOTAL WORDS
	SNA		/IF TOTAL 0, NORMAL INPUT
	TAD   C201	/129 OCT. THIS TEST REDUNDANT
	TAD   C0017	/ADD CONSTANT 15 TO TOTAL
	DCA   TOTAL	/FOR FUTURE CONSIDERATIONS
	DCA   VAR1	/# OF WORDS/3 FOR MARK TRACK WRITING
	TAD   TOTAL	/RESTORE IN THE ACC
	CLL		/TO DIVIDE BY 3, LINK KEEPS OVERFLOW
	TAD   M3	/SUBTRACT 3
	ISZ   VAR1	/ON EACH DIVISION, KEEP RUNNING SUM
	SZA		/IF AC = 0,NO REMAINDER
	SNL		/WHEN LINC GOES TO 0, DIVISION ENDED
	SKP		/NOW SEE IF IT DIVIDED EVENLY
	JMP   .-6	/SUBTRACT 3 MORE
	SZA   CLA	/IF 0,OK. OTHERWISE ERROR
	JMP I QU4	/NOT DIVISIBLE BY 3

/CORRECT "VAR1" ( THE NUMBER OF WORDS/3) FOR THE +15
/ADDED JUST ABOVE AND AN INHERANT +2 DUE TO MARK TRACK
/CONFIGURATION TO BE WRITTEN.

	TAD   M7	/SUBTRACT 7 FROM PHONY SETUP
	TAD   VAR1	/GIVING THE NUMBER OF TIMES
	CIA		/TO BE USED LATER IN A ISZ
	DCA   VAR1	/DATA MARK WILL BE WRITTEN
\f
/COMPUTE A VALUE FOR TOTAL NUMBER OF BLOCKS
/RECORD SIZE + 15 INTO 636160 OCT.

	TAD   C7714	/EXTENDED 64 VALUE. SETS AC#2
	DCA   W1	/SET FOR 640000
	JMS I FORM10	/PATCH TO CHECK FOR STD.10 FORMAT
	TAD   C1620	/VERNIER ADJUSTMENT FOR FORMULA
	CLL		/ACC#2 CARRY FUNCTION
	TAD   TOTAL	/WORD COUNT
	ISZ   BLOCKS	/+1 TO BLOCK COUNT
	SKP
	JMP I QU3	/TO MANY BLOCKS CALLED FOR
	SNL		/CARRY INTO ACC#2?
	JMP   .-5	/NO: CONTINUE COUNT
	ISZ   W1	/YES: FULLY DIVIDED?
	JMP   .-10	/NO: CONTINUE PROCESS
	CLA   CLL	/C(ACC)+ C(L)=0
F10RTN,	TAD   BLOCKS	/FOR MARK TRACK (COME HERE FR F10PAT IF 10 FRMT)
	CMA		/WRITING
	DCA   VAR2	/SEE MARK WRITE

/VALUES FOR BLOCK AND RECORD SIZE HAVE BEEN
/COMPUTED. TELL OUTSIDE WORLD AND GET THE OK.

	TAD   TOTAL	/SUBTRACT 15 FROM TOTAL
	TAD   C7761	/WORDS FOOLING OPERATOR
	DCA   TOTAL	/CORRECTED FOR TAPE WRITING
	TAD   TOTAL	/FOR OCTAL TYPEOUT
	JMS I TYOCT	/TYPE OCTAL WORDS
	JMS I TYPE	/TYPE MESSAGE
	4027  / W
	1722  /OR
	0423  /DS
	5400  /, END
	TAD   BLOCKS	/TYPE OUT BLOCK #S
	IAC		/TO FOOL THE OPERATOR
	JMS I TYOCT	/IN OCTAL
	JMS I TYPE	/TYPE MESSAGES
	4002  / B
	1417  /LO
	0313  /CK
	2356  /S.
	1713  /OK
	7733  /?(
	3105  /YE
	2340  /S
	1722  /OR
	4016  / N
	1735  /O)
	4543  /CR+LF
	0000  /END
	JMS I TYPIN	/WAIT FOR REPLY
\f/SEE IF A YES OR NO ANSWER WAS GIVEN

	JMS I COMPAR
	0331   /Y
	0305   /E
	0323   /S
	0000   /END
	JMP I IT

/SEE IF THE DRIVE IS OK

RSTSM,	TAD   DT0060	/GIVE WRTM, NO GO
	TAD   DTA	/AND DTA #
	DTCX		/ORDER EXECUTE
	DCA   W1	/STALL FUNCTION
CDTRD,	DTRB		/READ STATUS "B"
	SMA   CLA	/ERROR?
	JMP   CIZ	/NO: TIME OUT STALL
	JMS I TYPE	/YES: INCORRECT SETUP
	2305  /SE
	2425  /TU
	2077  /P
	0000  /END
	JMP I .+1
	START

/STALL FOR A WHILE FOR THE INTERRUPT

CIZ,	ISZ   W1	/ONE ROUND'S WORTH
	JMP   CDTRD	/OF ISZ
	JMP I .+1
	STMK		/OK, GO DO THE MARK TRACK
FORM10,	F10PAT

\f	*1400
/SET THE TAPE INTO MOTION. ALL VARIABLES ARE
/SET. FROM THIS POINT ON, CONTROL IS EXECUTED
/VIA THE WCO INTERRUPT

/CLEAR OUT STATUS "A" AND RELOAD IT WITH CONTINUOUS
/WRITE TIMING AND MARK TRACK COMMAND

STMK,	TAD   DT0360	/FWD, CONT, T+M,GO,INT
	TAD   DTA	/ADD IN THE DTA
	DTCX		/CLEAR FLAGS START MOTION
	DCA   PHASE	/FOR ERROR ROUTINE
	TAD   VAR2	/TO MAKE A RESTART FOR THE "SAME"
	DCA   W6	/OPTION  POSSIBLE

/WRITE END ZONE. WRITE ABOUT 10' OF THIS
/CONFIGURATION.	4044
/		0440   ON TAPE AS
/		4404   (5555) OCTAL.

	DCA   W1	/CLEAR COUNTER, 7777= ABOUT 10'
CEZ,	TAD   REZ	/LOAD ADDRESS OF DATA
	DCA I CA	/TO BE WRITTEN INTO THE CA
	TAD   M3	/LOAD # WORDS TO BE WRITTEN INTO
	DCA I WC	/WC LOCATION

/WAIT FOR INTERRUPT, TEST FOR END OF
/END ZONE WRITING.

	JMS I WAIT	/FOR INTERRUPT
	ISZ   W1	/END OF FOOTAGE?
	JMP   CEZ	/NOT END FOOTAGE, CONTINUE 
			/OK, WRITE INTERBLOCK SYNC

/WRITE INTERBLOCK SYNC. SINCE THIS CONFIGURATION
/ACT AS A NOP TO THE TCU, AT THE BEGINING OF
/TAPE, MORE LENGTH OF THIS IS NEEDED FOR TURN AROUND
/TIME TO GUARANTEE BLOCK 0000 TO THE LIBRARY SYSTEM
/THEREFORE AT THE BEGINING OF TAPE ONLY, WRITE SEVERAL
/INTERBLOCK ZONES

	TAD   M144	/NUMBER OF TIMES TO
	DCA   W1	/WRITE INTERBLOCK SYNC
	JMS   INBLSY	/WRITE 1 INTERBLOCK SYNC
	ISZ   W1	/CONFIGURATION, TEST END
	JMP   .-2	/NOT TOTAL FOOTAGE. WRITE AGAIN
	JMP   WDZ	/COMPLETED, GO ON
\f/AT NORMAL RETURN, WRITE ONLY ONE INTERBLOCK SYNC 
/CONFIGURATION. APPEARS AS	0404
/				0404   ON TAPE AS
/				0404   2525 OCTAL

INBLSY,	0
	TAD   IBZ	/COUNTER AND WORD
	DCA I CA	/COUNT WITH KEYS
	TAD   M3	/FOR CONTROL
	DCA I WC	
	TAD   VAR1	/RESET THE WORDS
	DCA   W5	/PER BLOCK COUNTER

/WAIT FOR INTERRUPT, RETURN TO SEQUENCE

	JMS I WAIT	/FOR INTERRUPT
	JMP I INBLSY


/WRITE FORWARD BLOCK MARK AND REVERSE GUARD
/THREE WORDS	0404
/		4004   ON TAPE AS
/		4040   2632 OCTAL

WDZ,	TAD   FBM	/ADDRESS OF PATTERN
	DCA I CA	/TO CURRENT ADDRESS
	TAD   M3	/NUMBER OF WORDS
	DCA I WC	/TO WORD COUNTER
	JMS I WAIT	/DROP THROUGH AFTER WRITE


/WRITE LOCK MARK, REVERSE CKSUM, REVERSE FINAL,REV PREFINAL
/SIX WORDS	1. 0040   4. 0040
/		2. 0000   5. 0000   ON TAPE OCTAL
/		3. 4000   6. 4000   10101010

	TAD   WLMRF	/ADDRESS OF PATTERN
	DCA I CA	/TO CURRENT ADDRESS
	TAD   M6	/NUMBER OF WORDS
	DCA I WC	/TO WORD COUNTER
	JMS I WAIT	/DROP THROUGH AFTER WRITE


/   WRITE THE DATA TRACK. SINCE THE LENGTH OF EACH
/RECORD IS A VARIABLE, "VAR1" KEEPS TRACK OF THE
/NUMBER OF TIMES THIS CONFIGURATION WILL BE WRITTEN
/"VAR1" WAS DECIDED FROM ABOVE IN THE FORMULA
/TRANSLATION SECTION
/THREE WORDS	4440
/		0044   ON TAPE AS
/		4000   7070 OCTAL
DTRK,	TAD   DZ	/LOAD ADDRESS OF THE DATA
	DCA I CA	/CONFIGURATION INTO CA
	TAD   M3	/LOAD # WORDS
	DCA I WC	/INTO WORD COUNT
\f/WRITE ONE SET TEST "VAR1" FOR LAST SET

	JMS I WAIT	/ONE CONFIGURATION
	ISZ   W5	/LAST?
	JMP   DTRK	/NOW WRITE DATA MARK TRACK AGAIN

/   MARK TRACK CODE FOR DATA IS COMPLETE. NOW WRITE
/PREFINAL, FINAL, CHECKSUM AND REVERSE CHECKSUM.
/SIX WORDS	1 4440   4 4440
/		2 4444   5 4444   ON TAPE AS
/		3 4044   6 4044   73737373 OCTAL

	TAD   FEZ	/LOAD ADDRESS OF
	DCA I CA	/DATA CONFIGURATION INTO CA
	TAD   M6	/LOAD # WORDS
	DCA I WC	/INTO WORD COUNT
	JMS I WAIT	/TILL COMPLETED WRITE



/WRITE GUARD, REVERSE BLOCK
/THREE WORDS	4040
/		0440   ON TAPE AS
/		0404   5145 OCTAL

	TAD   GRZ	/DATA ADDRESS TO
	DCA I CA	/THE CA
	TAD   M3	/NUMBER OF WORDS
	DCA I WC	/TO WORD COUNT
	JMS I WAIT	/TILL COMPLETE



/THIS COMPLETE SET OF DATA TRANSFERES
/COMPLETES ONE BLOCK ON TAPE. SINCE THE 
/NUMBER OF BLOCKS IS VARIABLE, "VAR2" IS
/USED TO RECYCLE. "VAR2" WAS SET UP ABOVE IN
/THE FORMULA TRANSLATION SECTION

	JMS   INBLSY	/WRITE INTERBLOCK SYNC
	ISZ   W6	/TOTAL NUMBER OF BLOCKS
	JMP   WDZ	/WRITTEN? NO:


\f/ALL DATA BLOCKS HAVE BEEN WRITTEN.
/NOW PROVIDE A BUFFER ZONE OF INTERBLOCK SYNC AT THE END
/OF TAPE AS AT THE START OF TAPE

	TAD   M144	/ABOUT TWO BLOCKS(STANDARD) WORTH
	DCA   W1	/ABOUT 100 TIMES
	JMS   INBLSY	/WRITE ONE PATTERN
	ISZ   W1	/AT END YET?
	JMP   .-2	/NO CONTINUE WRITING INTERBLOCK SYNC

/COMPLETED BLOCK WRITING
/WRITE ANOTHER 10' OF END ZONE (FORWARD)
/BEFORE LOADING BLOCK NUMBERS.
/THREE WORDS	0400
/		4004   ON TAPE AS
/		0040   2222 OCTAL

	DCA   W1	/ISZ=10 FEET
WEZF,	TAD   EZM	/LOAD ADDRESS OF DATA
	DCA I CA	/INTO CA
	TAD   M3	/NUMBER OF WORDS
	DCA I WC	/WORD COUNT

/WRITE 1 SET, CHECK END OF 10'.

	JMS I WAIT	/TILL COMPLETE
	ISZ   W1	/END OF FOOTAGE?
	JMP   WEZF	/NO, CONTINUE WITH END ZONE
	JMP I .+1	/GO AND START BLOCK NUMBER 
	MWTM		/SEQUENCING
\f/THESE ARE THE DATA CONFIGURATIONS FOR THE MARK TRACK


/REVERSE END ZONE

REZ,	.
	4044	/ON TAPE AS 5555 (OCT)
	0440
	4404

/INTERBLOCK SYNC

IBZ,	.
	0404	/ON TAPE AS 2525 (OCT)
	0404
	0404

/FORWARD BLOCK MARK AND REVERSE GUARD

FBM,	.
	0404	/ON TAPE AS 2632 (OCT)
	4004
	4040

/LOCK MARK, REVERSE CHECKSUM, REVERSE FINAL
/AND REVERSE PREFINAL

WLMRF,	.
	0040	/ON TAPE AS 10101010 (OCT)
	0000
	4000
	0040
	0000
	4000

/DATA MARK

DZ,	.
	4440	/ON TAPE AS 7070 (OCT)
	0044
	4000

/PREFINAL, FINAL, FWD CHECKSUM, AND REVERSE LOCK

FEZ,	.
	4440	/ON TAPE AS 73737373 (OCT)
	4444
	4044
	4440
	4444
	4044
\f/FORWARD GUARD AND REVERSE BLOCK NUMBER

GRZ,	.
	4040	/ON TAPE AS 5145 (OCT)
	0440
	0404

/FORWARD END ZONE

EZM,	.
	0400	/ON TAPE AS 2222 (OCT)
	4004
	0040
/SUBROUTINE TO SEE IF USER TYPED MARK 384
/TO SPECIFY STANDARD PDP-10 FORMAT
F10PAT,	0
	DCA	BLOCKS	/CLEAR LOC. BLOCKS IN CASE NOT 10-FORMAT
	TAD	TOTAL	/AND GET NUMBER TYPED BY USER
	TAD	M617	/WAS IT 384?
	SZA	CLA
	JMP I	F10PAT	/NO-RETURN
	DCA	W1	/YES-CLEAR W1 FOR WAIT LOOP
	TAD	C1101	/AND ADJUST BLOCK TOTAL FOR
	DCA	BLOCKS	/1102(OCTAL) BLOCKS.
	JMP I	.+1
F10BAK,	F10RTN
M617,	-617
C1101,	1101
\f
	*1600
/THE MARK TRACK HAS BEEN WRITTEN, AND TAPE IS
/MOVING FORWARD IN THE FORWARD END ZONE. STOP
/THE TAPE AND SEE IF THERE ARE ANY TAPES LEFT TO
/MARK--IF SO GO DO THEM, ELSE TELL OPERATOR TO THROW THE
/"NORMAL/WRTM/RDTM" SWITCH TO "NORMAL"
/HE WILL THEN CONTINUE AFTER THIS ACTION

/KILL WRITE, STOP TAPE

MWTM,	TAD   DT0070	/STOP TAPE WITH SELECT ERROR
	TAD   DTA	/LOAD DTA INTO ORDER
	DTCX		/EXECUTE THE ABOVE
	JMS	NUDTA	/ANY MORE DTAS TO MARK?
	JMP I	DOMARK	/YES: GO MARK THEM

/MESSAGE TO OPERATOR

	JMS I TYPE	/NO: BACK TO FIRST DTA AND CONTINUE
	2305  /SE
	2440  /T
	2327  /SW
	1124  /IT
	0310  /CH
	4024  / T
	1740  /O 
	1617  /NO
	2215  /RM
	0114  /AL
	0000  /END
	JMS I TYPIN	/WAIT FOR CR

/REVERSE TAPE FOR A FEW SECONDS TO GUARANTEE
/BLOCK MARK SECT WILL BE UNDER THE HEAD

PSER,	TAD   DT0600	/REVERSE, MOVE, GO
	TAD   DTA	/ADD DTA TO ORDER
	DTCX		/CLEAR TCU,GET MOVING IN REVERSE

/STALL A FEW SECONDS

	TAD   M300	/AROUND 2 SECONDS
	DCA   W2	/MAJOR STALL
MSTALL,	ISZ   W1	/MINOR STALL
	JMP   .-1	/LOOP MINOR
	DTSF
	SKP
	JMP	PSER
	ISZ   W2	/MAJOR STALL
	JMP   MSTALL	/LOOP MAJOR
\f/TAPE OUT ON MARK TRACK NOW, TURN AND GET IT
/MOVING FORWARD. AT THIS POINT, THE LAST REVERSE
/BLOCK NUMBER WILL BE WRITTEN UNTILL END ZONE IS
/REACHED. THEREFORE, WHEN THE BOUNCE OUT OF THE END
/ZONE TAKES PLACE, THE SYSTEM WILL BE ABLE TO SYNC ON
/THE REVERSE BLOCK NUMBER TO WRITE THE REST OF
/THE BLOCK NUMBERS AND KNOWN GOOD DATA IN REVERSE.
/THIS PROCESS WILL ELIMINATE A NEEDLESS REWIND AND
/KEEP THE ENTIRE PROCESS TO TWO COMPLETE PASSES

/WRITE LAST REVERSE BLOCK NUMBER  GOING FORWARD

	TAD	RZ
	DCA I	CA
	TAD   DT0210	/FORWARD, SEARCH, GO
	TAD   DTA	/ADD IN THE DTA
	DTCX		/CLEAR STATUS "A" AND RELOAD IT
	TAD   C1	/PHASE 1 ERROR
	DCA   PHASE	/FOR ERROR ROUTINE

/WAIT HERE FOR DECTAPE FLAG. CHECK ALSO FOR ERRORS
/SET BLOCK NUMBER (REVERSE) INTO FORM

	TAD   BLOCKS	/INTO AC WITH LAST BLOCK NUMBER
	JMS I MESS	/CONVERT BLOCK NUMBER FOR TAPE

/INTERRUPTED? ERROR?

	DTRB		/READ STATUS "B"
	RAR		/DECTAPE FLAG TO LINK
	SNL   CLA	/FLAG SET?
	JMP   .-3	/NO: CONTINUE WAIT

/BLOCK FOUND. SWITCH TO READ DATA WITH WC ONE LESS THAN
/NUMBER OF WORDS TO BE READ. READ TILL WC=0

	TAD   DT0130	/TO SET STATUS "A" INTO
RCYBR,	DTXA		/THE READ DATA MODE
	CLA   CMA	/SUBTRACT 1 FROM TOTAL
	TAD   TOTAL	/GIVING TOTAL-1 (HO HO)
	CMA		/INVERT FOR ISZ
	DCA I WC	/SET WC
	TAD   C4	/NOP
	DCA I CA	/JIMMIED TO DO NOTHING
	DTRB		/READ "B" REGISTER
	AND   C1000	/ISOLATE END ZONE BIT
	SZA   CLA	/END ZONE?
	JMP I GDBLK	/YES: GO AND WRITE THE BLOCK NUMBERS
	TAD I WC	/WAIT TILL WORD COUNT ZERO
	SZA   CLA	/EQUAL TO ZERO?
	JMP   .-10	/NO: LOOP AGAIN
\f/END OF BLOCK FOUND. WRITE JUNK AND REVERSE BLOCK NUMBER

	TAD   M14	/12 WORDS TO BE WRITTEN
	DCA I WC	/TO WORD COUNT REG.
	TAD   FORMB	/FORM TO CA
	DCA I CA	/OF NUMBERING FORM
	TAD   DT0070	/SWITCH TO WRITE ALL
	DTXA		/MODE.

/LOOK FOR THE DECTAPE FLAG INDICATING ANOTHER RECYCLE

	DTRB		/NO: GET "B" AGAIN
	RAR		/FLAG TO LINK
	SNL   CLA	/FLAG SET?
	JMP   .-3	/NO: BE PATIENT. HAST NOT.
	TAD   DT0070	/TO SWITCH TO READ DATA
	JMP   RCYBR
GDBLK,	DOBLK
DOMARK,	STMK	/POINTER TO START OF MARK ROUTINE

/SUBROUTINE TO GET NEXT DTA UNIT # FROM INPUT LIST OR
/RECYCLE TO FIRST UNIT IF ALL HAVE BEEN PROCESSED UP TO
/THIS POINT--CALL SEQUENCE
/	JMS NUDTA	/CALL THE ROUTINE
/	(RETN1)		/RETURNS HERE IF MORE DTAS TO PROCESS
/	(RETN2)		/RETURNS HERE IF END OF LIST
/END OF LIST MEANS RESET TO FIRST AND RETURN TO (RETN2)
/RETURN IS  WITH DTA SET TO NEW VALUE AND AC=0

NUDTA,	0
	TAD I	LSTPT	/GET CURRENT VALUE OF DTA LIST PTR
	DCA	TBUFPT	/STORE IT AS TEM. BUF. PTR.
	TAD I	TBUFPT	/GET A DTA # FROM THE LIST
	AND	C0007	/ISOLATE LOW ORDER DIGIT
	SZA	CLA	/IS IT 7777?
	JMP	LSTEND	/YES: END OF LIST
	TAD I	TBUFPT	/NO: GET IT BACK
	DCA	DTA	/AND STORE AS NEW DTA #
	ISZ I	LSTPT	/INCREMENT LIST POINTER
	JMP I	NUDTA	/RETURN
/COMES HERE AT END OF LIST TO RESET PTRS AND RETN TO CALL+2
LSTEND,	ISZ	NUDTA	/INCREMENT RETURN POINTER
	TAD I	STRTPT	/GET ADR. OF START OF LIST
	DCA I	LSTPT	/STORE TO RE-INITIALIZE LIST PTR.
	JMP	NUDTA+1	/GO GET FIRST DTA # AND RETURN

STRTPT,	DBUFAD	/POINTER TO START OF DTA LIST
TBUFPT,	0	/TEM. STORAGE FOR BUF. PTR.
LSTPT,	DBUFPT	/POINTER TO CURRENT VALUE OF DTA LIST PTR
DTABUF,	0	/START OF DTA # LIST - MAX. 9 WORDS
RZ,	.+1
	0
/SUBROUTINE TO CHECK FOR REPEATED DTA NUMBERS
/DTA # TO COMPARE TO LIST IS IN AC ON ENTRY--THIS
/ROUTINE STORES THE DTA # IF IT IS NEW AND IGNORES IT
/IF IT IS NOT-CALL BY JMS REPEAT WITH DTA # IN AC
REPEAT,	0
	DCA 	DNUM	/TEM STORAGE FOR NEW DTA #
	TAD	DBUFAD	/INITIALIZE POINTER (DBUFPT)
	DCA	DBUFPT	/TO START OF DTA LIST
	TAD	DCTR	/LOAD NUM. OF DTAS STORED
	CMA		/COMPLEMENT IT
	DCA	COMCTR	/STORE IN COMPARE COUNTER
COMCHK,	ISZ	COMCTR	/DONE WITH ALL COMPARES?
	JMP	DOCOMP	/NO: GO DO COMPARE
	TAD	DNUM	/YES: STORE NEW DTA#
	DCA I	DBUFPT	/AT END OF LIST
	ISZ	DCTR	/INCR. # OF DTAS STORED
	JMP I	REPEAT	/RETURN

/THIS SECTION DOES THE ACTUAL COMPARISON BETWEEN
/THE DTA# PASSED TO THE ROUTINE AND A NUMBER ON THE LIST

DOCOMP,	TAD I	DBUFPT	/GET NEXT DTA NUMBER FROM LIST
	CIA		/NEGATE IT
	TAD	DNUM	/ADD IN DTA NUMBER PASSED
	SNA	CLA	/ARE THEY THE SAME?
	JMP I	REPEAT	/YES: RETURN
	ISZ	DBUFPT	/NO: INCREMENT LIST POINTER
	JMP	COMCHK	/SEE IF DONE ALL COMPARES
/
/
COMCTR,	0	/COUNTER FOR # OF LIST COMPARISONS TO BE DONE
DCTR,	0	/COUNTER FOR # OF DTAS IN LIST
DBUFAD,	DTABUF	/START OF DTA NUM. LIST
DNUM,	0	/TEM STORAGE FOR DTA #
/
\f	*2000
/GO INTO SEARCH IN REVERSE MODE LOOKING FOR
/THE LAST BLOCK NUMBER. WHEN FOUND, SYNC THE SYSTEM
/AND WRITE ALL DATA AND BLOCK NUMBERS

DOBLK,	JMS I TURN	/INTO REVERSE AND SEARCH MODE
	TAD   BLOCKS	/TO SET UP
	DCA   BLOCKA	/FOR BLOCK DECREMENTING
	TAD   C2	/PHASE 2 ERROR
	DCA   PHASE	/FOR ERROR ROUTINE

/LOOK FOR INTERRUPT INDICATING BLOCK NUMBER

	JMS I WAIT	/FOR DECTAPE FLAG

/SWITCH TO WRITE ALL. SYSTEM NOW IN SYNC

	TAD   DT0140	/SWITCH TO WRITE ALL
	DTXA		/EXECUTE ORDER
NEXTBN,	TAD   ADF3	/ADDRESS OF FIRST 3 WORDS INCLUDING
	DCA I CA	/THE FORWARD CHECKSUM TO BE WRITTEN
	TAD   M3	/NUMBER OF WORDS TO BE WRITTEN
	DCA I WC	/TO WORD COUNT
	JMS   CEZN	/CHECK FOR END ZONE
	TAD I WC	/CHECK FOR WC=0
	SZA   CLA	/=0?
	JMP   .-3	/NOPE: TRY AGAIN
	DTXA		/YUP: CLEAR THE FLAG

/WRITE DATA TRACK. REMEMBER CORRECT DATA IS BEING WRITTEN

	TAD   TOTAL	/ONE FROM TOTAL NUMBER
	CIA		/OF WORDS FOR COUNTING
	DCA I WC	/DATA WORDS WRITTEN
	TAD   AD7777	/ADDRESS OF SEVENS
	DCA I CA	/DATA TO BE WRITTEN

/MONITOR WORD COUNT FOR A ZERO READING
/SOME OF THIS TIME IS USED TO SET THE NEXT
/BLOCK NUMBER INTO THE FORM.

	TAD   BLOCKA	/CURRENT BLOCK NUMBER
	JMS I MESS	/CONVERT INTO FORM
	CLA   CMA	/TO DECREMENT
	TAD   BLOCKA	/THE BLOCK COUNT
	DCA   BLOCKA	/DOWN TO ZERO
	JMP   CEZB	/BYPASS FOLLOWING ROUTINE

/CHECK FOR END ZONE
CEZN,	0
	DTRB		/READ STATUS "B"
	AND   C1000	/ISOLATE END ZONE
	SNA   CLA	/HAVE IT?
	JMP I CEZN	/NOT EZ, RETURN
	JMP I GDBN	/COMPLETED
\f/CHECK HERE ALSO TO SEE IF END ZONE, INDICATING
/THAT THE LAST BLOCK HAS BEEN WRITTEN

CEZB,	JMS   CEZN	/END ZONE?

/LOOK FOR WORD COUNT AS BEING EQUAL TO ZERO

	TAD I WC	/WC TO C(AC)
	SNA   CLA	/END OF DATA WRITE?
	JMP   WBN	/YES: GO TO WRITE BLOCK NUMBER
	TAD   AD7777	/RESET CURRENT ADDRESS COUNT
	DCA I CA	/DON'T LET THE CA ADVANCE TO
	JMP   CEZB	/MUCH

/DATA HAS BEEN WRITTEN. NOW WRITE REVERSE
/BLOCK NUMBER, FORWARD BLOCK NUMBER, AND REVERSE
/CHECKSUM. (12 WORDS)

WBN,	DTXA		/CLEAR OUT DECTAPE FLAG
	TAD   M14	/WILL WRITE 12 WORDS
	DCA I WC	/FOR THIS BIT
	TAD   FORMA	/FROM A FORM CONTAINING
	DCA I CA	/BLOCK NUMBERS

/WAIT FOR END

	JMS   CEZN	/END ZONE?
	TAD I WC	/NO: SEE IF DONE THE WRITE
	SZA   CLA	/DONE YET ?
	JMP   .-3	/NO: PATIENCE IS A VIRTUE????
	DTXA		/RESET THE CURRENT FLAG
	JMP   NEXTBN	/YES: GO RECYCLE COMPLETLY
GDBN,	DBN

/ FIRST 3 WORDS TO BE WRITTEN

ADF3,	.
	0000
	0000
	0077

/DATA TO BE WRITTEN ON TAPE (REVERSE)

AD7777,	.
	7777
	7777
	7777
	7777
/CHECK IF ALL DTAS ARE DONE BEFORE RESTARTING

SETDTA,	JMS I	GDTA	/ALL DTAS DONE?
	JMP I	CONTNU	/NO: BACK TO WRITE BLOCK #S ON NEXT
	JMP I	IT	/YES: GO ASK "DIRECT?"
GDTA,	NUDTA	/POINTER TO SUBR FOR GETTING NEXT UNIT #
CONTNU,	PSER	/POINTER TO START OF BLOCK # WRITE ROUTINE
\f

/TYPE ONE FOUR CHARACTER OCTAL WORD GIVEN TO THE 
/ROUTINE VIA C(ACC). C(ACC)=0 ON EXIT

TYCT,	0
	DCA   TW1	/STORE WORD GIVEN
	TAD   TW1	/TO C(ACC) AGAIN
	RTR
	RTR		/6 BITS GIGHT
	RTR
	DCA   TYCT1+2	/SAVE ROTATED VALUE, 1ST TWO
	TAD   TYCT1+2	/TO C(ACC) AGAIN
	AND   C0007	/ISOLATE SECOND CHARACTER
	TAD   C6060	/CONVERT TO ASCII
	DCA   TYCT1+1	/STORE AS FIRST PARTIAL 2
	TAD   TYCT1+2	/ROTATED VALUE STORED ABOVE
	RTL
	RAL		/3 BITS LEFT
	AND   C0700	/ISOLATE FIRST CHARACTER
	TAD   TYCT1+1	/CONVERT 1ST TO ASCII
	DCA   TYCT1+1	/1ST AND 2ND CHARACTERS READY
	TAD   TW1	/ORIGIONAL WORD
	AND   C0007	/ISOLATE 4TH CHARACTER
	TAD   C6060	/CONVERT 4 TH TO ASCII
	DCA   TYCT1+2	/STORE 4TH FOR A MOMENT
	TAD   TW1	/ORIGIONAL WORD
	RTL
	RAL		/POSITION IT 3RD CHARACTER
	AND   C0700	/ISOLATE 3RD CHARACTER
	TAD   TYCT1+2	/CONVERT TO ASCII
	DCA   TYCT1+2	/CONVERSION COMPLETE
TYCT1,	JMS I TYPE	/TYPE THE FOUR CHARACTERS
	0		/FIRST 2
	0		/SECOND 2
	0		/KILL KEY
	JMP I TYCT	/EXIT FROM ROUTINE

/SOME CONSTANTS FOR THE ROUTINE

TW1,	0000
C6060,	6060
\f	*2200
/VERIFY THE TAPE AS BEING WRITTEN CORRECTLY
/WITH DATA AND BLOCK NUMBERS. THE INFORMATION WRITTEN
/WAS WRITTEN IN SUCH A WAY AS TO BE CORRECT 
/UPON READING IT BACK


/TURN TAPE AND HAVE IT GOING FORWARD

DBN,	TAD   ISZV	/RESET INCREMENT
	DCA   VISZ	/BLOCK NUMBERS FORWARD
	DCA   FCON	/WILL BE ZEROS FORWARD
	DCA   W1	/FIRST BLOCK NUMBER FORWARD
	TAD   C0400	/TURN TO GO FORWARD
DBNAUX,	JMS I TURN	
	TAD   C3	/ERROR IN PHASE 3
	DCA   PHASE 	/FOR ERROR ROUTINE

/SET SOME OF THE CONTROL REGS

DAB,	DCA I WC	/WORD COUNT DON'T CARE
	TAD   ADBA	/SOME WHERE UP ABOVE
	DCA I CA	/TO GET BLOCK NUMBERS

/WAIT FOR INTERRUPT

	JMS I WAIT	/INTERRUPT
	TAD   W1	/FIRST OR NEXT BLOCK NUMBER
	CIA		/TO COMPARE
	TAD I ADBA	/GET THE BLOCK NUMBER
	SZA   CLA	/COMPARE OK?
	JMP   BLKERZ	/BLOCK ERROR FOUND

/BLOCK COMPARES, NOW CHECK DATA

	TAD   DT0030	/TO SWITCH INTO READ
	DTXA		/DATA MODE
	DCA I WC	/DON'T CARE ABOUT THE WC
CTST,	TAD   ADWA	/FOR COMPARING
	DCA I CA	/FROM TAPE

/EVERY TIME THE WORD COUNT MOVES
/A DATA TRANSFERE HAS BEEN COMPLETED.
/MAKE SURE THAT THE INFORMATION IS OK

	TAD I WC	/GET WORD COUNT
	SNA   CLA	/STILL AT ZERO?
	JMP   CEFR	/YES: SEE IF AT END
	TAD   FCON	/NO: SEE IF DATA
	CIA		/IS SAME AS WRITTEN
	TAD I ADWAB	/RECEIVED DATA
	SZA   CLA	/SAME?
	JMP DTAR	/DATA ERROR FOUND
	DCA I WC	/YES: RESET WORD COUNT
\f/CHECK FOR DECTAPE FLAG INDICATING END OF
/BLOCK OR ERROR

CEFR,	DTRB		/READ "B" REGISTER
	SPA		/ERROR?
	JMP   PARIR	/PARITY ERROR, I GUESS

/NO ERROR, END OF BLOCK?

	RAR		/FLAG TO THE LINK
	SNL   CLA	/END?
	JMP   CTST	/NO: CONTINUE CHECKING
	TAD   DT0030	/CLEAR DECTAPE FLAG
	DTXA		/AND RETURN TO SEARCH

/END OF BLOCK. SEE IF END OF TAPE

	TAD   W1	/BLOCK NUMBER JUST TESTED
VISZ,	ISZ   W1	/+1 OR -1 TO BLOCK COUNT
	SKP
	HLT		/ABSOLUTE PANIC
	CIA  		/TO BE COMPARED WITH
	TAD   BLOCKS	/TOTAL BLOCKS
	SZA   CLA	/LAST?
	JMP   DAB	/NO, DO ANOTHER BLOCK


/HERE PUT IN THE REVERSE CHECK

DDSF,	DTSF		/WAIT FOR ANY FLAG TO APPEAR
	JMP   .-1	/NOT YET
	CLA   CLL	/RID  AC OF GARBAGE
	DTRB		/READ THE "B" REGISTER
	AND   C1000	/BETTER BE END ZONE
	SNA   CLA	/IS IT?
	JMP   LNE	/LAST INTERRUPT NOT END ZONE
	DTCX		/YUP: A OK
\f/BLOCK NUMBERS AND DATA HAVE  BEEN CHECKED FORWARD
/AND ARE OK. USING THE ABOVE ROUTINE FOR CHECKING
/RESET A FEW THINGS AND CHECK IN REVERSE

/WAS COMPLETION FOUND FORWARD? IF SO GO CHECK
/IN REVERSE; IF NOT GO SEE IF ALL TAPES HAVE BEEN CHECKED.


	TAD   FCON	/IF 0'S, IT WAS FWD
	SZA   CLA	/FWD?
	JMP I	FINCHK	/N0: REVERSE-SEE IF ALL DTAS DONE

/RESET THE ABOVE ROUTINE TO READ IN REVERSE

	CMA		/DATA WILL BE AS WRITTEN
	DCA   FCON	/I.E., 7777'S
	TAD   SJMP	/INSTEAD OF INCREMENTING
	DCA   VISZ	/WE WILL DECREMENT BLOCK NUMBERS
	TAD   BLOCKS	/STARTING WITH THE HIGHEST
	DCA   W1	/AND WILL WORK TO ZERO
	JMP   DBNAUX	/ALL SET, TRAVEL ONWARD

/RETURN HERE AFTER EACH BLOCK FOR CHECKING WHEN LAST BLOCK
/HAS BEN PROCESSED????????????

SJMP,	JMP   .+1
	SNA		/IF AC = 0, WE ARE DONE
	JMP   DDSF	/AND NEXT FLAG SHOULD BE END ZONE
	CIA		/OTHERWISE, SUBTRACT ONE FROM
	CMA		/BLOCKS GIVING BLOCKS-1......?
	DCA   W1	/NOT DONE
	JMP   DAB	/GO DO ANOTHER BLOCK

ISZV,	ISZ   W1	/VARIABLE TAG
FINCHK,	SETDTA
\f/BLOCK ERROR FOUND

BLKERZ,	TAD   DTA	/TO RESET TAPE 
	DTCX		/MOTION
	TAD I ADBA	/GET BAD BLOCK NUMBER
	JMS I TYOCT	/AND TYPE IT OUT
	JMS   TYSB	/TYPE "SHOULD BE"
	TAD   W1	/GOOD BLOCK NUMBER
	JMS I TYOCT	/TYPE IT OUT
	JMS I TYPE
	4002  / B
	1413  /LK
	4005  / E
	2243  /R CR
	4500  /LF+END
DBERZ,	JMP I .+1
	ZCOM

/COMMON ROUTINE

TYSB,	0
	JMS I TYPE
	4023  / S
	1017  /HO
	2514  /UL
	0440  /D 
	0205  /BE
	4000  / 0
	JMP I TYSB

/DATA ERROR

DTAR,	TAD   DTA	/TO STOP TAPE
	DTCX		/MOTION
	TAD I ADWA	/GET THE BAD WORD
	JMS I TYOCT
	JMS TYSB	/TYPE "SHOULD BE"
	TAD   FCON	/GOOD WORD
	JMS I TYOCT	/TYPE IT OUT
	JMS I TYPE
	4004  /D
	0124  /AT
	0140  /A
	0522  /ER
	4543  /CR+LF
	0000  /END
	JMP   DBERZ
\f/PARITY ERROR FOUND

PARIR,	JMP I .+1
	ERROR		/MAIN ERROR ROUTINE

/LAST INTERRUPT WAS NOT END ZONE

LNE,	JMS I TYPE
	1401  /LA
	2324  /ST
	4011  / I
	1624  /NT
	4016  / N
	1724  /OT
	4005  / E
	1724  /OT
	4345  /LF+CR
	0000  /END
	JMP   DBERZ
\f	*2400
/ TYPE OUT THE DTA UNIT NUMBER AND THE FIRST 12 BLOCK
/NUMBERS IN EITHER DIRECTION. IF RDR, IN REVERSE
/IF RDF, TYPE THEM OUT GOING IN THE FORWARD
/DIRECTION FROM THE BEGINING OF TAPE

RDFA,	TAD	C0400	/DIRECTION FOR TURNING
	DCA	SAVEIT	/STORE DIRECTION FOR NEXT DTA UNIT
	TAD	SAVEIT	/GET DIRECTION FOR TURNING
	JMS I TURN	/AROUND
	TAD   M14	/READ 12 BLOCK
	DCA   W3	/COUNTER
	TAD   BADD	/ADDRESS OF BUFFER
	DCA   X2	/TO AUTO INDEX 2
	TAD   ADW3	/ADDRESS OF W2
	DCA I CA	/FOR DATA XFER
	JMS I WAIT	/FOR BLOCK INTERRUPT
	TAD   W2	/BLOCK NUMBER
	DCA I X2	/STORE BLOCK NUMBER
	ISZ   W3	/TOTAL = 12?
	JMP   .-4	/NO: GRAB NEXT
	TAD   DTA	/KILL TAPE MOTION
	DTCX		/HERE

/TYPE OUT BLOCK NUMBERS AND DTA UNIT #

	JMS I	TYPE	/TYPE "DTA"
	0424	/DT
	0140	/A
	0000	/END
	TAD	DTA	/GET UNIT #
	JMS I	TYOCT	/AND TYPE IT OUT
	JMS I	TYPE
	4345	/CR&LF
	0000	/END
	TAD   M14	/WILL TYPE ALL
	DCA   W1	/TWELVE WORDS
	TAD   BADD	/ADDRESS OF BLOCK
	DCA   X2	/NUMBERS TO INDEX 2
	TAD I X2	/FIRST OR NEXT BLOCK
	JMS I TYOCT	/TYPE IT OUT
	JMS I TYPE	/CR AND LINE FEED
	4345  /CR+LF
	0000
	ISZ	W1	/COMPLETE?
	JMP   .-6	/NO
	JMS I	NEWDTA	/YES: ANY MORE DTAS?
	JMP	RDFA+2	/YES: GO GET BLOCK #S
	JMP I	IT	/NO: GO ASK FOR "DIRECT?"
RDR,	JMP   RDFA+1	/OTHER DIRECTION

SAVEIT,	0	/TEM. STORAGE FOR DIRECTION
NEWDTA,	NUDTA	/POINTER TO SUBR. TO GET A NEW DTA UNIT #
\f
/INPUT BUFFER FOR THE TELETYPE.
/NOTE ,,,,,,,THIS MUST BE AT THE END OF THE PROGRAM

BUFFER,	0000

$
\f