/TD8E DECTAPE COPY, V4
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1972, 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.
/
/
/
/
/
/



/DEFINITIONS FOR PAL8 AND PAL10

BSW=7002
MQL=7421
MQA=7501
CAM=7621
SWP=7521
ACL=7701
CAF=6007
CDI=6203
KCF=6030
SDSS=6771
SDST=6772
SDSQ=6773
SDLC=6774
SDLD=6775
SDRC=6776
SDRD=6777
FIXTAB


HALT=HLT


/UNIT NUMBER DEFINITIONS FOR TD8E IOT'S

UNIT01=0770
UNIT23=0760
UNIT45=0750
UNIT67=0740



LIMIT=7600

*11

X11,	0
X12,	0

/PAGE 0 CONSTANTS AND VARIABLES

*20
INPUT,	0		/INPUT UNIT CONSTANT
OUTPUT,	0		/OUTPUT UNIT CONSTANTS
	0
	0
	0
	0
	0
	0
OCOUNT,	0		/NUMBER OF OUTPUT UNITS SPECIFIED
OPOINT,	0
LIST,	OUTPUT-1
OUTNUM,	0
IBLOCK,	0		/STARTING INPUT BLOCK
OBLOCK,	0		/STARTING OUTPUT BLOCK
NUMBER,	0		/NUMBER OF BLOCKS TO TRANSFER
FIELDS,	0		/-(HIGHEST FIELD AVAILABLE)
COUNT,	0		/TEMPORARY COUNTERS
COUNT1,	0		/  "
COUNT2,	0		/  "
COUNT3,	0		/  "
COUNT4,	0		/  "
UNIT,	0		/UNIT CONSTANT--THIS TRANSFER
VERF,	0		/VERIFY SWITCH (1=YES,0=NO)
WDCNT,	0		/-(NUMBER OF WORDS PER BLOCK)
RW,	0		/READ/WRITE BIT--THIS TRANSFER
FLD0,	0		/# OF BLOCKS IN FIELD 0 BUFFER
FLDN,	0		/# OF BLOCKS IN FIELD N BUFFER
BUF0,	0		/START OF FIELD 0 BUFFER
BUFN,	0		/START OF FIELD N BUFFER
XNUMB,	0		/# OF BLOCKS LEFT TO TRANSFER
BLOCKN,	0		/STARTING BLOCK NUMBER--THIS TRANSFER
NUMB1,	0
NUMB2,	0
VB,	0
END0,	0		/BEGINNING OF FIELD 0 VERIFY BUFFER
ENTRY,	0		/ENTRY TO TD8E HANDLER
INB,	0
OUTB,	0
OHOLD,	0

MESSG1,	TEXT @TD8E COPY V4A@
MESSG3,	TEXT @ 12-BIT WORDS PER BLOCK@

*200

START,	TLS
	JMS CRLF
	JMS I [MESSGE
	MESSG1		/@TD8E COPY@
	JMS CRLF
	DCA COUNT
	JMP I [END	/ONCE ONLY CODE FOR MULTIPLE FIELD TEST
START1,	JMS QUEST
	MESSG4		/@FROM UNIT:@
	SWP
	JMS UNITNO	/MAKE UNIT NUMBER CONSTANT
	DCA INPUT
	TAD LIST
	DCA OPOINT
	SKP
AGAIN,	JMS ERR4	/*ILLEGAL RESPONSE*
	DCA OCOUNT
	DCA COUNT
	JMS I [MESSGE
	MESSG5		/@TO UNITS:@
MORE2,	JMS I [ANSWER
	JMP AGAIN
	ACL
	JMS UNITNO	/MAKE UNIT NUMBER CONSTANT
	MQL		/STORE IN MQ
	MQA		/RESTORE TO AC
	CIA
	TAD INPUT
	SNA CLA		/IS OUTPUT UNIT = INPUT UNIT ?
	JMP MORE2+1	/YES--ERROR
	ISZ OPOINT
	ISZ OCOUNT	/COUNT ONE MORE OUTPUT UNIT
	TAD OCOUNT
	TAD [-10
	SPA CLA		/WERE MORE THAN 7 UNITS SPECIFIED?
	JMP .+3
	JMS CRLF	/YES--CARRIAGE RETURN
	JMP OALL	/IGNORE EXTRA ONE
	SWP		/NO--
	DCA I OPOINT	/STORE UNIT CONSTANT IN LIST
	TAD COUNT
	CIA
	TAD OCOUNT
	SPA SNA CLA	/ALL UNITS IN?
	JMP MORE2	/YES

OALL,	DCA COUNT
	JMS I [MESSGE
	MESSG6		/@FIRST INPUT BLOCK:@
	JMS I [ANSWER
	JMP WHOLE	/COPY WHOLE TAPE
	TAD COUNT
	SNA CLA		/WERE TOO MANY SPECIFIED?
	JMP .+5
	JMS I [MESSGE	/YES
	ERROR4		/@ILLEGAL RESPONSE@
	JMS CRLF
	JMP OALL	/REPEAT THE QUESTION
	ACL		/NO
	DCA IBLOCK	/STORE
	JMS QUEST
	MESSG7		/@FIRST OUTPUT BLOCK:@
	ACL
	DCA OBLOCK
	JMS QUEST
	MESSG8		/@NUMBER OF BLOCKS TO COPY:@
	ACL
	SNA		/WERE 0 BLOCKS SPECIFIED?
	JMP QUEST1	/YES--REPEAT QUESTION
	DCA NUMBER
	JMP .+4
WHOLE,	DCA IBLOCK
	DCA OBLOCK
	DCA NUMBER	/0 MEANS WHOLE TAPE
	JMS QUEST
	MESSG9		/@VERIFY OUTPUT (YES=1,NO=0):@
	ACL
	AND [7
	DCA VERF
	JMP I (SETUP

/OUTPUT CARRIAGE RETURN/LINE FEED

CRLF,	0
	TAD (215
	JMS I [TYPE
	TAD [212
	JMS I [TYPE
	JMP I CRLF	/--RETURN--

ERR4,	0
	JMS I [MESSGE
	ERROR4		/@ILLEGAL RESPONSE@
	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
	TAD [-4
	TAD ERR4
	DCA ERR4
	DCA COUNT
	JMP I ERR4	/--RETURN--


QUEST,	0
	TAD I QUEST
	DCA MNUM
	ISZ QUEST
	JMS I [MESSGE
MNUM,	0
	JMS I [ANSWER
QUEST1,	JMS ERR4
	TAD COUNT
	SZA CLA
	JMP QUEST1
	JMP I QUEST	/--RETURN--


/CONVERT UNIT NUMBER TO A WORD OF THE FORM
/000 XXX XXX 000 OR
/100 XXX XXX 000
/WHERE XY0 IS THE THIRD DIGIT OF THE IOT
/AND 0 OR 1 REFLECTS THE TD8E UNIT NUMBER
/ENTER WITH THE UNIT NUMBER IN THE AC
/EXIT WITH SPECIAL CODE IN AC

UNITNO,	0
	AND [7		/MASK OUT ALL EXTRANEOUS BITS
	CLL RAR		/SAVE 0/1 BIT IN LINK
	MQL		/STORE ROTATED WORD, CLEAR AC
	RAR
	SWP		/PRESERVE 0/1 BIT IN MQ
	TAD TABX	/GET DEVICE NUMBER CORRECTLY
	DCA CRLF
	TAD I CRLF
	MQA		/OR IN 0/1 BIT
	JMP I UNITNO	/--RETURN--

TABX,	UNITS

/SKIP 4 LINES AND FETCH MARK TRACK

SKIPQ,	0
IOTR5,	SDSQ
	JMP .-1
IOTR6,	SDRC
	JMP I SKIPQ	/--RETURN--

*400

/USER RESPONSE HANDLER
/USES MQ FOR TEMPORARY STORAGE
/EXIT WITH RESPONSE IN MQ
/EXIT TO CALL+1 IF JUST CARRIAGE RETURN
/OR ILLEGAL CHARACTER, CARRIAGE RETURN
/OR ;,CARRIAGE RETURN
/EXIT TO CALL+2 IF GOOD DATA, CARRIAGE RETURN
/INCREMENT COUNT AND EXIT TO CALL+2 IF GOOD DATA;
/ILLEGAL CHARACTERS CAUSE WHOLE ANSWER TO BE IGNORED
/AND EXIT TO CALL+1

ANSWER,	0
	CAM		/CLEAR AC AND MQ
	TAD CLEAR
	DCA SWITCH
MORE,	JMS LISTEN	/FETCH A CHARACTER
	TAD (-215
	SZA		/IS IT A CARRIAGE RETURN?
	JMP .+5		/NO
	TAD [212	/YES--OUTPUT LINE FEED
	JMS TYPE
SWITCH,	NOP		/SET UP EXIT ADDRESS
	JMP I ANSWER	/--RETURN--
	TAD (215-260
	SPA		/IS CHARACTER LESS THAN 260?
	JMP BAD		/YES--ILLEGAL CHARACTER
	TAD [260-270	/NO
	SMA		/IS IT MORE THAN 269?
	JMP SEMI	/YES--CHECK FOR SEMICOLON
	TAD (270	/RESTORE CHARACTER
	AND [7		/MASK OUT EXTRANEOUS BITS
	CLL
	SWP
	AND (777	/MASK OUT FIRST DIGIT IF THERE ARE 4
	RAL		/ROTATE 3 LEFT
	RTL
	MQA		/FETCH NEW CHARACTER
	MQL		/STORE RESULT IN MQ
	TAD SKIP	/SET UP TO SKIP ON RETURN
	DCA SWITCH
	JMP MORE	/FETCH ANOTHER


CLEAR,	NOP
SKIP,	ISZ ANSWER

BAD,	CLA		/ILLEGAL CHARACTER
	JMS I [CRLF
	JMP I ANSWER	/--RETURN--


/TEST FOR SEMICOLON

SEMI,	TAD (270-273
	SZA CLA		/IS CHARACTER A SEMICOLON?
	JMP BAD		/NO--ILLEGAL CHARACTER
	ISZ COUNT	/YES--INCREMENT COUNTER
	JMP SWITCH	/EXIT FROM ANSWER ROUTINE


/TELETYPE INPUT AND ECHO HANDLER

LISTEN,	0
	KSF
	JMP .-1
	JMS I	[PARITY
	TLS		/ECHO CHARACTER
	JMS CHECK	/CHECK FOR CTRL/C AND CTRL/S
	JMP I LISTEN	/--RETURN--

/CHECK FOR CTRL/C AND CTRL/S
/ENTER WITH INPUT CHARACTER IN AC
/EXIT TO HANDLER OR WITH CHARACTER IN AC

CHECK,	0
	TAD (-203
	SNA		/IS IT CTRL/C?
	JMP I CTRLC	/YES--HANDLE IT
	TAD (203-223
	SNA		/IS IT CTRL/S?
	JMP I [REPEAT	/YES--HANDLE IT
	TAD (223	/RESTORE CHARACTER
	JMP I CHECK	/--RETURN--

CTRLC,	LIMIT

/MESSAGE OUTPUT HANDLER

/EXPECTS MESSAGE ADDRESS TO BE IN LOCATION AFTER CALL
/EXITS TO CALL+2

MESSGE,	0
	TAD I MESSGE
	DCA FINDER	/SET UP POINTER
	ISZ MESSGE
	DCA LOC		/SET L/R SWITCH TO L (EVEN)
LNEXT,	TAD I FINDER	/GET WORD
	BSW
RHALF,	AND [77
	SNA		/IS CHARACTER 0 (TERMINATOR)?
	JMP I MESSGE	/YES--RETURN--
	DCA CHAR
	TAD CHAR
	AND (40
	SNA CLA		/IS IT A LETTER?
	TAD [100	/YES--301-337
	TAD [200	/NO--240-277
	TAD CHAR	/RESTORE CHARACTER
	JMS TYPE	/OUTPUT IT
	ISZ LOC
	TAD LOC
	RAR
	SZL CLA		/WHICH HALF WAS THAT?
	JMP .+3
	ISZ FINDER	/RIGHT
	JMP LNEXT
	TAD I FINDER	/LEFT
	JMP RHALF
FINDER,	0
LOC,	0
CHAR,	0


/TELETYPE OUTPUT ROUTINE


TYPE,	0
	TSF
	JMP .-1
	TLS
	CLA
	JMP I TYPE	/--RETURN--


/INSERT IOT'S ACCORDING TO TABLES
/UNIT CONTAINS APPROPRIATE UNIT CODE
/COUNT CONTAINS -(NUMBER OF IOT'S TO TRANSFER)
/COUNT1 CONTAINS ADDRESS OF ADDRESS TABLE
/UNIT CONTAINS UNIT CODE OF CURRENT UNIT

INSERT,	0
	TAD I COUNT1
	DCA COUNT3
	TAD UNIT
	MQL
	TAD I COUNT3	/MAKE NEW IOT
	AND (7007
	MQA
	CIA
	TAD I COUNT3	/COMPARE WITH IOT FROM PROGRAM
	SNA CLA		/ARE THE IOT'S THE SAME AS THE LAST UNIT?
	JMP I INSERT	/YES--RETURN--
INS1,	TAD I COUNT1
	DCA COUNT3
	TAD I COUNT3	/GET IOT FROM PROGRAM
	AND (7007	/RETAIN ONLY SIGNIFICANT BITS
	MQA		/OR IN UNIT NUMBER
	DCA I COUNT3	/PUT IT IN PROGRAM
	ISZ COUNT1	/BUMP COUNTERS
	ISZ COUNT	/DONE YET?
	JMP INS1	/NO
	JMP I INSERT	/YES--RETURN--


PAGE

/COUNT THE NUMBER OF WORDS PER BLOCK
/PLACE IT IN MWORDS
/BE SURE ALL TAPES MATCH INPUT FORMAT

SETUP,	TAD LIST
	DCA OPOINT	/SET POINTER TO I/O LIST
	DCA COUNT2	/CLEAR COUNTER
	TAD OCOUNT
	CMA
	DCA OUTNUM	/SET # OF UNITS
SET4,	TAD (TABLE1-END1-1	/SET UP COUNTERS FOR IOT FIX
	DCA COUNT
	TAD (TABLE1
	DCA COUNT1
	TAD I OPOINT
	DCA UNIT
	JMS I [INSERT	/PUT THE PROPER IOT'S IN THE FOLLOWING ROUTINE
	DCA WDCNT	/CLEAR WORD COUNT
	TAD UNIT
	AND [4000
	TAD (2000
IOTX7,	SDLC
	CLA
IOTX8,	SDRC
	RTL
	SZL		/DOES UNIT EXIST?
	JMP .+3		/YES
SELERR,	JMS I [ERR3	/@SELECT ERROR UNIT N@
	JMP SETUP
	AND (400
	SZA CLA		/TURNED ON?
	JMP SELERR	/NO
	TAD UNIT	/GET 0 OR 1 UNIT BIT (0 OR 4000)
	AND [4000
	TAD [1000	/GET GO BIT
IOTX1,	SDLC		/START READING FORWARD
	JMS SKIP4	/SKIP 8 LINES TO AVOID GARBAGE
	JMS SKIP4
IOTX3,	SDSS		/LOOK FOR FORWARD BLOCK NUMBER (26)
	JMP .-1
IOTX4,	SDRC
	AND [77
	TAD (-26
	SZA CLA		/FOUND YET?
	JMP IOTX3	/NO--KEEP LOOKING

SET2,	JMS SKIP4	/YES--START COUNTING LINES BY FOURS
	ISZ WDCNT
	NOP
	AND [77
	TAD (-51
	SZA CLA		/FOUND GUARD YET?
	JMP SET2	/NO
	TAD UNIT	/YES
	AND [4000
IOTX2,	SDLC		/STOP UNIT
	CLA
	TAD COUNT2
	SZA		/IS THIS THE INPUT UNIT?
	JMP SET5	/NO
	TAD (-11	/YES--SAVE THE COUNT
	TAD WDCNT
	CIA
	DCA COUNT2
	JMP SET3	/FIRST OUTPUT UNIT
SET5,	TAD (-11	/NOT INPUT UNIT
	TAD WDCNT
	SZA CLA		/SAME NUMBER OF WORDS AS INPUT UNIT?
	JMP ERR5	/NO*ILLEGAL FORMAT*
SET3,	ISZ OPOINT	/NEXT UNIT
	ISZ OUTNUM	/DONE YET?
	JMP SET4	/NO
	TAD COUNT2	/YES--PRINT MESSAGE
	DCA I [MWORDS	/SET UP NUMBER OF WORDS PER BLOCK
	TAD I [MWORDS
	CIA
	JMS I [PRINT	/PRINT 4 DIGIT NUMBER OF BLOCKS
	JMS I [MESSGE	/YES--PRINT REST OF MESSAGE
	MESSG3
	JMS I [CRLF

/IF WHOLE TAPE IS TO BE COPIED, IT IS NECESSARY TO
/COMPUTE THE NUMBER OF BLOCKS ON THE TAPE (NB)
/USING THE NUMBER OF WORDS PER BLOCK (WB)
/AND THE FORMULA:
/OCTAL:          NB=[63 6160/(WB+17)]+2
/DECIMAL:	 NB=[212,080/(WB+15)]+2

	TAD NUMBER
	SZA CLA		/COPY WHOLE TAPE?
	JMP VERFQ	/NO--
	DCA COUNT	/YES--COMPUTE NUMBER OF BLOCKS ON TAPE
	TAD I [MWORDS
	CIA
	TAD (17
	DCA COUNT1	/GET NUMBER OF WORDS PER BLOCK+17
	TAD (-64
	DCA COUNT2
	TAD (-6160
SUB,	CLL
	TAD COUNT1
	ISZ COUNT	/COUNT A BLOCK--TOO MANY?
	SKP		/NO
	JMP ERR5	/YES--ERROR
	SZL
	ISZ COUNT2
	JMP SUB
	CLA CLL
	TAD COUNT	/COUNT IS [63 6160/WB+17]+1
	IAC		/ADD 1 MORE
	DCA NUMBER	/STORE AS # OF BLOCKS TO TRANSFER
	JMP I .+1
	VERFQ

ERR5,	CLA
	JMS I [MESSGE
	ERROR5		/*ILLEGAL FORMAT UNIT*
	JMS I [DECODE	/PRINT UNIT NUMBER
	JMS I [CTRLR	/WAIT FOR CTRL/R
	JMS I [CRLF	/CARRIAGE RETURN/LINE FEED
	JMP SETUP	/TRY AGAIN




/READ FOUR LINES AND FETCH MARK TRACK

SKIP4,	0
IOTX5,	SDSQ
	JMP .-1
IOTX6,	SDRC
	JMP I SKIP4	/--RETURN--




PAGE

/IS TAPE TO BE VERIFIED?
/SET UP DEPENDING ON RESPONSE
VERFQ,	TAD VERF
	SZA CLA		/VERIFY?
	JMP YES		/YES--
	TAD (NOP	/NO--
	DCA I VERF1A
	TAD (OUTN
	DCA I VERF2A
	JMP CONT
YES,	TAD (RAR
	DCA I VERF1A
	TAD (VERIFY
	DCA I VERF2A
CONT,	JMP I .+1
	DOIT

VERF1A,	VERF1
VERF2A,	VERF2

/WAIT FOR CTRL/R

CTRLR,	0
	JMS I [LISTEN	/FETCH CHARACTER
	TAD [-222
	SZA CLA		/IT IT CTRL/R?
	JMP .-3		/NO--WAIT FOR ONE
	JMS I [CRLF	/CARRIAGE RETURN/LINE FEED
	JMP I CTRLR	/--RETURN--


REPEAT,	DCA COUNT
	JMS I [CRLF
	JMS I [QUEST	/@REPEAT (YES=1;NO=0):@
	MESS11
	ACL
	AND [7
	SZA CLA
	JMP I [CLEAN	/YES
	JMP I [START+4	/NO--RESTART

MESSG6,	TEXT @FIRST INPUT BLOCK:@
MESSG7,	TEXT @FIRST OUTPUT BLOCK:@
MESSG8,	TEXT @NUMBER OF BLOCKS TO COPY:@
MESSG9,	TEXT @VERIFY OUTPUT (YES=1,NO=0):@
MESS10,	TEXT @DONE@
MESS11,	TEXT @REPEAT (YES=1,NO=0):@
ERROR1,	TEXT @VERIFY ERROR BLOCK @
ERROR2,	TEXT @TAPE ERROR BLOCK @
ERROR3,	TEXT @SELECT ERROR UNIT @

PAGE

/SETUP FOR ACTUAL READ/WRITE/VERIFY OPERATION
DOIT,	TAD [LIMIT-END	/SET UP NUMBER OF BLOCKS
	JMS DIV1	/IN FIELD 0 BUFFER
	DCA FLD0
	TAD M200
	JMS DIV1	/AND IN FIELD N BUFFERS
	DCA FLDN
	TAD IBLOCK	/SET UP RUNNING COUNTERS AND POINTERS
	DCA INB		/FOR NEXT INPUT BLOCK
	TAD OBLOCK
	DCA OUTB	/FOR NEXT OUTPUT BLOCK
	TAD NUMBER
	DCA NUMB1	/FOR NUMBER OF BLOCKS LEFT TO TRANSFER
	JMP .+4
ALLDUN,	TAD XNUMB
	SNA CLA		/DONE WITH ALL BLOCKS YET?
	JMP REWIND	/YES
/READ---
READX,	TAD LIST	/NO--SET UP POINTER TO OUTPUT UNITS
	DCA OPOINT
	TAD OCOUNT
	CMA
	DCA OUTNUM
	TAD INB
	DCA BLOCKN
	TAD NUMB1	/SET POINTERS FOR TRANSFER
	DCA XNUMB
	TAD NUMB1
	DCA NUMB2	/SAVE COUNTER FOR WRITE
	TAD INPUT	/SELECT INPUT UNIT
	DCA UNIT
	DCA RW		/SET R/W BIT TO READ

	TAD [END	/SET START OF BUFFERS IN CASE
	DCA BUF0	/THEY WERE CHANGED BY VERIFY
	DCA BUFN
	JMS I [READY	/FILL THE BUFFERS
	TAD XNUMB	/SAVE THE POINTERS
	DCA NUMB1
	TAD BLOCKN
	DCA INB

OUTN,	ISZ OPOINT
	ISZ OUTNUM	/DONE WITH ALL UNITS YET?
	JMP .+4		/NO--CONTINUE WRITING
	TAD OHOLD	/YES
	DCA OUTB
	JMP ALLDUN	/READ ANOTHER BUFFER LOAD
WRITEX,	TAD OUTB
	DCA OHOLD
	TAD OHOLD	/WRITE
	DCA BLOCKN	/RESET POINTERS
	TAD OUTB
	DCA VB		/SAVE COUNTER FOR VERIFY
	TAD NUMB2
	DCA XNUMB
	TAD I OPOINT	/SELECT OUTPUT UNIT
	DCA UNIT
	CLA CLL CML RAR	/AC=4000
	DCA RW		/SET R/W BIT TO WRITE
	JMS I [READY
	TAD BLOCKN
	DCA OHOLD
	JMP I .+1
VERF2,	VERIFY



/SEE HOW MANY BLOCKS WILL FIT INTO BUFFER
/ENTER WITH BUFFER SIZE IN AC
/EXIT WITH # OF BLOCKS IN AC

DIV1,	0
	DCA COUNT1
	DCA COUNT
	TAD COUNT1	/TOTAL WORDS
DIV2,	CLL
	TAD I [MWORDS	/-NUMBER OF WORDS PER BLOCK
	SNL		/RUN OUT OF ROOM?
	JMP .+3		/YES--
	ISZ COUNT	/NO--COUNT A BLOCK
	JMP DIV2
	CLA CLL		/IGNORE LESS THAN A BLOCK LEFT
	TAD COUNT
VERF1,	RAR		/DIVIDE BY 2 IF VERIFY (NOP IF NO VERIFY)
	JMP I DIV1	/--RETURN--

/END OF OPERATION
/REWIND TAPES TO INITIAL END ZONE

REWIND,	TAD OCOUNT
	CMA
	DCA COUNT2	/SET NUMBER OF TAPES STILL SPINNING
RLIST,	CLA CMA
	TAD LIST
	DCA OPOINT	/SET POINTER TO UNIT LIST
	TAD OCOUNT
	IAC
	CMA
	DCA OUTNUM	/SET NUMBER OF UNITS IN LIST
RUNIT,	JMS I	[PARITY
	JMS I [CHECK	/CHECK TTY FOR CTRL/S OR CTRL/C
	ISZ OUTNUM	/DONE WITH WHOLE LIST YET?
	SKP CLA		/NO
	JMP RLIST	/YES--START THROUGH LIST AGAIN
	ISZ OPOINT
	TAD I OPOINT	/GET UNIT CODE
	RTL
	SZL CLA		/STILL SPINNING?
	JMP RUNIT	/NO--TRY NEXT TAPE
	TAD I OPOINT	/YES
	DCA UNIT


	TAD [-6
	DCA COUNT
	TAD [RTAB
	DCA COUNT1
	JMS I [INSERT	/PUT PROPER IOT'S IN THIS ROUTINE
	TAD I OPOINT
	AND [4000	/UNIT/READ
	TAD [3000	/REVERSE/GO
IOTR1,	SDLC
	JMS I [SKIPQ
	JMS I [SKIPQ	/WAIT FOR DRIVE TO GET UP TO SPEED
IOTR2,	SDSS
	JMP .-1
IOTR3,	SDRC		/GET MARK TRACK BITS
	AND [77
	TAD [-22
	SZA CLA		/END ZONE?
	JMP RUNIT	/NO--NEXT UNIT
	CLA CLL CML RTR	/AC=2000
	MQA		/UNIT CODE STILL IN MQ FROM INSERT
	DCA I OPOINT	/SET STOPPED BIT
	TAD I OPOINT
	AND [6000
IOTR4,	SDLC		/STOP UNIT
M200,	7600		/CLA
	ISZ COUNT2	/ALL TAPES STOPPED?
	JMP RUNIT	/NO--NEXT UNIT
	JMS I [MESSGE	/YES
	MESS10		/@DONE@
	JMP I [REPEAT



PAGE

/VERIFICATION ROUTINES

VERIFY,	TAD VB		/SET POINTERS AND COUNTERS FOR TRANSFER
	DCA BLOCKN
	TAD NUMB2
	DCA XNUMB
	DCA RW
	TAD END0	/SET BEGINNINGS OF VERIFY BUFFERS
	DCA BUF0
	TAD (3700
	DCA BUFN
	TAD CDF0
	DCA COMP2
	JMS I [READY	/READ VERIFY BUFFERS FULL
	TAD COUNT1	/GET # OF BLOCKS IN LAST BUFFER FILLED
	DCA COUNT3
	CMA		/SET AUTOINDEX POINTERS TO BUFFERS
	TAD [END
	DCA X11
	CMA CLL
	TAD END0
	DCA X12
	TAD COUNT
	CMA
	TAD FIELDS
	DCA COUNT	/SET NUMBER OF FIELDS WHICH WERE FILLED
	JMS COMP4	/GET NUMBER OF BLOCKS
	TAD FLD0
	CIA
	DCA COUNT4	/SET COUNTER
	JMS COMP	/COMPARE THE BUFFERS

COMP3,	TAD COUNT
	SNA CLA
	JMP I [OUTN
	JMS COMP4	/GET NUMBER OF BLOCKS
	TAD FLDN
	CIA
	DCA COUNT4
	TAD COMP2	/EACH FIELD------
	TAD (10
	DCA COMP2	/SET CDF INSTRUCTION PROPERLY
	CMA CLL		/SET AUTOINDEX POINTERS TO BUFFERS
	DCA X11
	TAD (3677
	DCA X12
	JMS COMP
	JMP COMP3	/DO THE NEXT FIELD


/ENTER WITH AC CLEAR
/EXIT TO CALL+1 WITH AC CLEAR IF
/NORMAL BUFFER FILL
/EXIT TO CALL+2 WITH # OF BLOCKS IN AC IF
/LAST BUFFER

COMP4,	0
	ISZ COUNT	/LAST FIELD FILLED?
	JMP I COMP4	/NO--RETURN--
	TAD XNUMB	/YES--OUT OF BLOCKS?
	SZA CLA
	JMP I COMP4	/NO--RETURN--
	TAD COUNT3	/YES--GET ACTUAL # OF BLOCKS
	ISZ COMP4	/INCREMENT RETURN ADDRESS
	JMP I COMP4	/--RETURN--


/COMPARE PORTION OF VERIFY ROUTINE

COMP,	0
	TAD I [MWORDS	/SET NUMBER OF WORDS PER BLOCK COUNTER
	DCA COUNT2
COMP2,	HALT		/SHOULD CONTAIN CDF N
	TAD I X11	/GET CORRESPONDING WORDS FROM EACH BUFFER
	CIA
	TAD I X12
CDF0,	CDF 0
	SZA CLA		/DO WORDS MATCH?
	JMP ERR1	/NO--VERIFY ERROR
TRY,	ISZ COUNT2	/DONE WITH BLOCK?
	JMP COMP2	/NO--CONTINUE
	ISZ COUNT4	/DONE WITH ALL BLOCKS?
	JMP COMP+1	/NO
	JMP I COMP	/YES--RETURN--

ERR1,	JMS I [MESSGE
	ERROR1		/*VERIFY ERROR BLOCK *
	TAD COUNT4	/GET CURRENT BLOCK NUMBER
	CIA
	TAD I (BLOCKS	/FROM BLOCK THIS OPERATION STARTED WITH
	JMS PRINT	 /PRINT 4 DIGIT BLOCK NUMBER
	JMS I [MESSGE
	ERROR6		/*UNIT *
	JMS I [DECODE	/PRINT UNIT NUMBER
WAIT,	JMS I [LISTEN	/WAIT FOR RESPONSE
	DCA PRINT
	JMS I [CRLF
	TAD PRINT
	TAD [-224
	SNA		/WAS IT CTRL/T?
	JMP I [WRITEX	/YES--TRY AGAIN
	TAD [2
	SZA CLA		/WAS IT CTRL/R?
	JMP WAIT	/NO--WAIT FOR A GOOD RESPONSE
	JMP TRY		/YES--IGNORE AND CONTINUE




/PRINT A 4 DIGIT OCTAL NUMBER
/ENTER WITH NUMBER IN AC

PRINT,	0
	DCA I [MESSGE	/TEMPORARY STORAGE
	TAD [-4
	DCA I [ANSWER	/SET DIGIT COUNTER
	TAD I [MESSGE
	RAL
	DCA I [CRLF
FOUR,	TAD I [CRLF
	RAL
	RTL
	DCA I [CRLF
	TAD I [CRLF
	AND [7
	TAD [260
	JMS I [TYPE	/PRINT ONE DIGIT
	ISZ I [ANSWER	/DONE YET?
	JMP FOUR	/NO
	JMP I PRINT	/YES--RETURN--


/CLEAN UP UNIT TABLES AFTER REWIND

CLEAN,	TAD LIST
	DCA OPOINT
	TAD OCOUNT
	CMA
	DCA OUTNUM	/SET POINTER AND COUNTER
CLEAN1,	TAD I OPOINT	/GET UNIT CODE
	AND (4770	/MASK OUT EXTRANEOUS BITS
	DCA I OPOINT	/REPLACE IT
	ISZ OPOINT
	ISZ OUTNUM	/DONE YET?
	JMP CLEAN1	/NO
	JMP I [DOIT	/YES--NEXT OPERATION




PAGE

/FILL ALL N FIELDS ONCE
/ENTER WITH AC CLEAR
/# OF BLOCKS FOR FIELD 0 IN FLD0
/# OF BLOCKS FOR OTHERS IN FLDN
/ADDRESSES OF BUFFERS IN BUF0, BUFN
/R/W BIT (0 OR 4000) IN RW



READY,	0
	TAD [IOTLOC-TABEND-1
	DCA COUNT
	TAD [IOTLOC
	DCA COUNT1
	JMS I [INSERT	/PUT PROPER IOT'S IN HANDLER
	TAD UNIT
	SPA CLA		/EVEN OR ODD UNIT NUMBER?
	CLL IAC RTL	/ODD
	TAD [ORIGIN	/EVEN
	DCA ENTRY	/SET UP ENTRY TO HANDLER
	TAD RW
	MQL		/STORE UNIT BIT FOR LATER
	CMA
	TAD FIELDS	/SET COUNTER FOR # OF FIELDS
	DCA COUNT
	CLL
	TAD FLD0	/ADJUST NUMBER OF BLOCKS TO
	JMS SUB1	/TRANSFER DEPENDING ON NUMBER
	TAD FLD0	/LEFT TO BE TRANSFERRED
	JMS SUB2	/RESET FUNCTION WORD
	TAD BUF0	/SET UP BUFFER POINTERS
	JMS SUB3
	JMS TRANS	/TRANSFER DATA--FIELD 0
ZOOM,	ISZ COUNT	/BEGINNING OF LOOP FOR EACH FIELD ABOVE 0
	SKP		/DONE YET?
	JMP I READY	/YES--RETURN--

	TAD FIELDS
	CIA CLL
	TAD COUNT
	IAC
	RAL
	RTL		/GET FIELD SETTING READY
	MQL		/STORE IN MQ
	TAD FUNCTN	/GET PREVIOUS FUNCTION WORD
	AND [4000	/GET R/W BIT
	MQA		/OR IN FIELD SETTING
	MQL		/STORE
	CLL
	TAD FLDN	/ADJUST NUMBER OF BLOCKS TO TRANSFER
	JMS SUB1
	TAD FLDN
	JMS SUB2	/AND RESET FUNCTION WORD
	TAD BUFN
	JMS SUB3	/SET UP BUFFER POINTERS
	JMS TRANS	/TRANSFER DATA--FIELDS 1-N
	JMP ZOOM	/FILL ANOTHER FIELD

SUB1,	0
	CIA
	TAD XNUMB
	CLL CML		/SET LINK=1
	SMA		/ARE THERE LESS BLOCKS LEFT THAN A FIELD FULL?
	DCA XNUMB	/NO--REDUCE COUNT OF BLOCKS LEFT
	JMP I SUB1	/YES-TRANSFER BLOCKS LEFT--RETURN--

SUB2,	0
	DCA COUNT1	/LINK=1 IF BLOCKS LEFT, 0 IF NONE
	SNL		/DONE WITH ALL BLOCKS YET?
	DCA XNUMB	/YES--BUMP SWITCH
	TAD COUNT1	/NO
	BSW
	MQA		/PUT # OF BLOCKS INTO FUNCTION WORD
	DCA FUNCTN	/START REVERSE
	JMP I SUB2	/--RETURN--


SUB3,	0
	DCA BUFADD
	TAD BLOCKN	/SET STARTING BLOCK NUMBER
	DCA BLOCKS
	TAD COUNT1
	TAD BLOCKN
	DCA BLOCKN	/RESET STARTING BLOCK FOR NEXT TIME
	JMP I SUB3	/--RETURN--


/CALL TO THE HANDLER

TRANS,	0
	JMS I	[PARITY		/CHECK TELETYPE
	JMS I [CHECK	/WAS ^C OR ^S TYPED?
	JMS I ENTRY
FUNCTN,	0		/FUNCTION WORD
BUFADD,	0		/BUFFER ADDRESS
BLOCKS,	0		/STARTING BLOCK NUMBER
	JMP ERR		/ERROR RETURN
	JMS I	[PARITY		/CHECK TELETYPE
	JMS I [CHECK	/WAS ^C OR ^S TYPED?
	CLA
	TAD XNUMB
	SZA CLA		/DONE YET?
	JMP I TRANS	/NO--RETURN--
	ISZ COUNT
	JMP I READY	/--RETURN--
	JMP I READY	/--RETURN--

/TRANSFER ERROR HANDLER

ERR,	SNA CLA		/FATAL ERROR?
	JMP SELECT	/NO
	JMS I [MESSGE	/YES
	ERROR2		/*TAPE ERROR BLOCK *
	TAD I (BLOCK
	JMS I [PRINT	/PRINT BLOCK NUMBER
	JMS I [MESSGE
	ERROR6		/*UNIT *
	JMS DECODE	/PRINT UNIT NUMBER
	JMS I [CRLF
	JMP I [REWIND
SELECT,	JMS ERR3
	ISZ FUNCTN	/TURN AROUND AND TRY AGAIN
	JMP FUNCTN-1


ERR3,	0
	JMS I [MESSGE
	ERROR3		/*SELECT ERROR UNIT *
	JMS DECODE	/PRINT UNIT NUMBER
	JMS CTRLR	/WAIT FOR CTRL/R
	JMP I ERR3	/--RETURN--


/DECODE UNIT NUMBER FOR PRINTING
/PRINT UNIT NUMBER BEFORE RETURNING

DECODE,	0
	CLL
	TAD UNIT
	RAL
	MQL		/SAVE ROTATED CODE IN MQ
	RAL
	SWP		/SAVE EVEN/ODD BIT IN MQ
	RAR		/WORK ON IOT CODE
	RTR
	IAC
	CMA
	AND [7
	MQA		/INCLUDE EVEN/ODD BIT
	TAD [260	/MAKE ASCII DIGIT
	JMS I [TYPE
	JMP I DECODE	/--RETURN--


PAGE


/TD8E DECTAPE HANDLER

/SLIGHTLY MODIFIED VERSION OF DEC-E8-UZTA-D
/COPYRIGHT 1971  DIGITAL EQUIPMENT CORPORATION
/	MAYNARD, MASSACHUSETTS 01754

/THE CALLING SEQUENCE IS:
/	JMS ENTRY
/	FUNCTION WORD
/	BUFFER ADDRESS
/	STARTING BLOCK
/	ERROR RETURN
/	NORMAL RETURN (AC CLEAR)

/FUNCTION WORD:
/	BIT 0:		0=READ, 1=WRITE
/	BITS 1-5:	# OF BLOCKS TO BE TRANSFERRED
/	BITS 6-8:	FIELD OF BUFFER AREA
/	BITS 9-10:	UNUSED
/	BIT 11:		1=START FORWARD, 0=START REVERSE

/ERRORS:
/THE HANDLER DETECTS TWO TYPES OF ERRORS:
/FATAL ERRORS:
/	PARITY ERROR
/	TIMING ERROR
/	TOO GREAT A BLOCK NUMBER
/FATAL ERRORS TAKE ERROR RETURN WITH AC=4000
/NON-FATAL ERROR:
/	SELECT ERROR (IMPROPER UNIT NUMBER OR NO UNIT NUMBER)
/NON-FATAL ERROR TAKES ERROR RETURN WITH AC=0
PAGE

MFIELD=0
ORIGIN=.

DTA0,	0		/ENTRY POINT FROM UNIT 0
	CLA CLL		/0 TO LINK
	JMP DTA1X
C1000,	1000
DTA1,	0		/UNIT 2 ENTRY
	CLA CLL CML	/1 TO LINK
	TAD DTA1
	DCA DTA0	/PICK UP ARGS AT DTA0
DTA1X,	RAR
	DCA YUNIT	/LINK TO UNIT POSITION
	RDF
	TAD C6203	/GET DATA FIELD AND SETUP RETURN
	DCA LEAVE
	TAD YUNIT	/GET FUNCTION WORD
IOT4,	SDLC		/PUT FUNCTION INTO DATA REGISTER
	TAD I	DTA0
IOT1,	SDLD
	CLA
	TAD MWORDS
	DCA WCOUNT	/STORE MASTER WORD COUNT
	ISZ DTA0	/TO BUFFER
	TAD I DTA0
	DCA BUFF
	ISZ DTA0	/TO BLOCK NUMBER
	TAD I DTA0
	DCA BLOCK
	ISZ DTA0	/POINT TO ERROR EXIT
	CIF CDF MFIELD	/TO ROUTINES DATA FIELD
IOT2,	SDRD		/GET FUNCTION INTO AC
	CLL RAL
	AND CM200	/GET # PAGES TO XFER
	DCA PGCT
IOT3,	SDRD
C374,	AND C70		/GET FIELD FOR XFER
	TAD C6201	/FORM CDF N
	DCA XFIELD	/IF=0 AND DF=N AT XFER.
	CLA CLL CMA RTL
	DCA TRYCNT	/3 ERROR TRIES
IOT5,	SDRC
	AND C100
	SZA CLA
	JMP FATAL-1

IOT6,	SDRD		/PUT FUNCT INTO XFUNCT IN SECOND PG.
	DCA I CXFUN
	TAD WCOUNT
	DCA I CXWCT
IOT7,	SDRD		/GET MOTION BIT TO LINK
	CLL RAR
	JMP GO		/AND START THE MOTION.
RWCOM,	SDST		/ANY CHECKSUM ERRORS?
	SZA CLA		/OR CHECKSUM ERRORS?
	JMP TRY3	/PLEASE NOTE THAT THE LINK IS ALWAYS
			/SET AT RWCOM. GETCHK SETS IT.
	TAD PGCT	/NO ERROR..FINISHED XFER?
	TAD CM200
	SNA
	JMP EXIT	/ALL DONE. GET OUT
	DCA PGCT	/NEW PAGE COUNT
	ISZ BLOCK	/NEXT BLOCK TO XFER
	TAD WCOUNT	/FORM NEXT BUFFER ADDRESS
	CIA
	TAD BUFF
	DCA BUFF
	CLL CML		/FORCES MOTION FORWARD
GO,	CLA CML RTR	/LINK BECOMES MOTION BIT
	TAD C1000
	TAD YUNIT	/PUT IN 'GO' AND UNIT #
IOT8,	SDLC		/LOOK FOR BLOCK NO.
	JMS I CRDQUD	/WAIT AT LEAST 6 LINES TO LOOK
	JMS I CRDQUD
CM200,	7600		/COULD HAVE SAVED A LOC. HERE
SRCH,	SDSS
	JMP .-1		/WAIT FOR SINGLE LINE FLAG
IOT9,	SDRC
	CLL RTL		/DIRECTION TO LINK. INFO BITS 
			/ARE SHIFTED.
	AND C374	/ISOLATE MARK TRACK BITS
	TAD M110	/IS IT END ZONE?
	SNA		/THE LINK STAYS SAME THRU THIS
	JMP ENDZ
	TAD M20		/CHECK FOR BLOCK MARK
	SZA CLA
	JMP SRCH
IOT10,	SDRD		/GET THE BLOCK NUMBER
	SZL		/IF WE ARE IN REVERSE, LOOK FOR 3
			/BLOCKS BEFORE TARGET BLOCK. THIS
			/ALLOWS TURNAROUND AND UP TO SPEED.
	TAD C3		/REVERSE
	CMA
	TAD BLOCK
	CMA		/IS IT RIGHT BLOCK?
	SNA
	JMP FOUND	/YES..HOORAY!
M110,	SZL SNA CLA	/NO, BUT ARE WE HEADED FOR IT?
			/ABOVE SNA IS SUPERFLUOUS.
	JMP SRCH	/YES
ENDZ,	SDRC		/WE ARE IN THE END ZONE
	CLL RTL		/DIRECTION TO LINK
	 CLA		/ARE WE IN REVERSE?
	JMP GO		/YES..TURN US AROUND
/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
TRY3,	CLL CLA
	ISZ TRYCNT
	JMP GO		/TRY 3 TIMES
	CLL CLA
	JMP FATAL		/LINK OFF MEANS AC=4000 ON RETURN
EXIT,	ISZ DTA0
	CLL CML		/AC=0 ON NORMAL RETURN
FATAL,	TAD YUNIT
	SDLC		/STOP THE UNIT
	CLA CML RAR
LEAVE,	HLT
	JMP I DTA0	/--RETURN--


C6201,	6201
C6203,	6203
CRDQUD,	RDQUAD
WCOUNT,	0
BUFF,	0
MWORDS,	0
YUNIT,	0
CXFUN,	XFUNCT
M20,	-20
PGCT,	0
CXWCT,	XWCT
C100,	100
TRYCNT,	-3
BLOCK=DTA1


	*ORIGIN+170
FOUND,	SZL CLA		/RIGHT BLOCK. HOW ABOUT DIRECTION?
	JMP GO		/WRONG..TURN AROUND
	TAD YUNIT	/PUT UNIT INTO LINK
	CLL RAL		/AC IS NOW 0
C70,	70		/********DON'T MOVE THIS!!!!******
C3,	3
	TAD BUFF	/GET BUFFER ADDRESS
XFIELD,	HLT		/INTO NEXT PAGE

	*ORIGIN+200
	XUNIT=EQUFUN

	DCA	XBUFF
IOT16,	SDRC
IOT17,	SDLC
	RAR		/NOW GET UNIT #
	DCA XUNIT
REVGRD,	SDSS
	JMP REVGRD		/LOOK FOR REVERSE GUARD
IOT11,	SDRC
	AND K77
	TAD CM32	/IS IT REVERSE GUARD?
	SZA CLA
	JMP REVGRD	/NO.KEEP LOOKING
	TAD XWCT
	DCA WORDS	/WORD COUNTER
	TAD XFUNCT	/GET FUNCTION  READ OR WRITE
K7700,	SMA CLA
	JMP READ	/NEG. IS WRITE
WRITE,	SDRC
	AND C300	/CHECK FOR WRITE LOCK AND SELECT ERROR
	CLL CML		/LOCK OUT AND SELECT ARE AC 0 ERRORS
	SZA CLA
	JMP I CFATAL	/FATAL ERROR. LINK MUST BE ON
	JMS RDQUAD	/NO ONE EVER USES THIS WORD!
C7600,	7600
	TAD C1400
	TAD XUNIT	/INITIATE WRITE MODE
IOT12,	SDLC
	CLA CMA
	JMS WRQUAD	/PUT 77 IN REVERSE CHECKSUM
	CLA CMA
	DCA CHKSUM
WRLP,	TAD I XBUFF	/GLORY BE! THE ACTUAL WRITE!
	JMS WRQUAD
	ISZ XBUFF	/BUMP CORE POINTER
K77,	77		/ABOVE MAY SKIP
	ISZ WORDS	/DONE THIS BLOCK?
	JMP WRLP	/NOT YET..LOOP A WHILE
	TAD XFUNCT	/IS THE OPERATION FOR WDSBLK PER BLOCK?
	CLL RTR		/IF NO, WRITE A 0 WORD
	SZL CLA

	JMS WRQUAD	/WRITE A WORD OF 0
	JMS GETCHK	/DO THE CHECK SUM
	JMS WRQUAD	/WRITE FORWARD CHECKSUM
	JMS WRQUAD	/ALLOW CHECKSUM TO BE WRITTEN
	JMP I CRWCOM


READ,	JMS RDQUAD
	JMS RDQUAD
	JMS RDQUAD	/SKIP CONTROL WORDS
	AND K77
	TAD K7700	/TACK 7700 ONTO CHECKSUM.
	DCA CHKSUM	/CHECKSUM ONLY LOW 6 BITS ANYWAY
RDLP,	JMS RDQUAD
	JMS EQUFUN	/COMPUT CHECKSUM AS WE GO
	DCA I XBUFF	/IT GETS CONDENSED LATER
	ISZ XBUFF
C300,	300		/PROTECTION
	ISZ WORDS	/DONE THIS OP?
	JMP RDLP	/NO SUCH LUCK
	TAD XFUNCT	/IF OP WAS FOR WDSBLK-1, READ AND
	CLL RTR		/CHECKSUM THE LAST TAPE WORD
	SNL CLA
	JMP RDLP2
	JMS RDQUAD	/NOT NEEDED FOR WDSBLK/BLOCK
	JMS EQUFUN	/CHECKSUM IT
RDLP2,	JMS RDQUAD	/READ CHECKSUM
	AND K7700
	JMS EQUFUN
	JMS GETCHK	/GET SIX BIT CHECKSUM
	JMP I CRWCOM

WRQUAD,	0		/WRITE OUT A 12 BIT WORD
	JMS EQUFUN	/ADD THIS TO CHECKSUM
IOT13,	SDSQ		/SKIP ON QUADLINE FLAG
	JMP .-1
IOT14,	SDLD		/LOAD DATA  ONTO BUS
	CLA		/SDLD DOESN'T CLEAR AC
	JMP I WRQUAD

RDQUAD,	0		/READ A 12 BIT WORD
	SDSQ
	JMP .-1
IOT15,	SDRD		/READ DATA
	JMP I RDQUAD


EQUFUN,	0		/COMPUTE EQUIVALENCE CHECKSUM
	CMA
	DCA EQUTMP	/ACTUALLY CHECKSUMS ON DECTAPE ARE
	TAD EQUTMP	/EQUIVALENCE OF ALL WORDS IN A RECORD
	AND CHKSUM	/SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
	CIA		/IS ASSOCIATIVE, WE CAN DO IT 12
	CLL RAL		/BITS AT A TIME AND CONDENSE LATER.
	TAD EQUTMP	/THIS ROUTINE USES THESE IDENTITIES:
	TAD CHKSUM	/A+B=(A.XOR.B)+2*(A.AND.B)
	DCA CHKSUM	/A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
	TAD EQUTMP	/A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
	CMA
	JMP I EQUFUN

GETCHK,	0		/FORM 6 BIT CHECKSUM
	CLA
	TAD CHKSUM	
	CMA
	CLL RTL
	RTL
	RTL
	JMS EQUFUN
	CLA CLL CML	/FORCES LINK ON AT RWCOM
	TAD CHKSUM
	AND K7700
	JMP I GETCHK

CFATAL,	FATAL
CRWCOM,	RWCOM
XFUNCT,	0
CM32,	-32
C1400,	1400
CHKSUM,	0
WORDS,	0
XBUFF,	0
XWCT,	0
EQUTMP,	0

PAGE
/
/
PARITY,	0
	KRB
	AND	[177
	TAD	[200
	JMP I	PARITY

/IOT TABLES FOR TD8E SUBROUTINE

IOTLOC,	IOT1
	IOT2
	IOT3
	IOT4
	IOT5
	IOT6
	IOT7
	RWCOM
	IOT8
	SRCH
	IOT9
	IOT10
	ENDZ
	FATAL+1
	REVGRD
	IOT11
	WRITE
	IOT12
	IOT13
	IOT14
	RDQUAD+1
	IOT15
	IOT16
TABEND,	IOT17

UNITS=.
	UNIT01
	UNIT23
	UNIT45
	UNIT67

RTAB,	IOTR1
	IOTR2
	IOTR3
	IOTR4
	IOTR5
	IOTR6


/IOT TABLES FOR WORDS PER BLOCK ROUTINE

TABLE1,	IOTX1
	IOTX2
	IOTX3
	IOTX4
	IOTX5
	IOTX6
	IOTX7
END1,	IOTX8

MESSG4,	TEXT @FROM UNIT:@
MESSG5,	TEXT @TO UNITS:@
ERROR5,	TEXT @ILLEGAL FORMAT UNIT @
ERROR6,	TEXT @ UNIT @
ERROR4,	TEXT @ILLEGAL RESPONSE@


PAGE
/ONCE ONLY CODE

END,	JMS I (QUEST
	MESSG2		/@HIGHEST FIELD AVAILABLE:@
	ACL
	AND [7
	CIA
	DCA FIELDS
	TAD (CDF
	DCA CDF00
	TAD FIELDS
	SNA		/MORE THAN 1 FIELD??
	JMP LIM		/NO--NO PROBLEM
	DCA COUNT1	/YES--ARE THEY ALL PRESENT?
NEXT,	TAD CDF00
	TAD (10
	DCA CDF00	/SET FOR DATA FIELD CHANGE
	TAD (HLT
CDF00,	CDF
	DCA I (10	/TRY LOCATION 10
	TAD I (10
	CDF 0
	CIA
	TAD (HLT
	SNA CLA		/IS FIELD THERE?
	JMP NEXT1	/YES--TRY NEXT ONE
	JMS I [MESSGE	/NO
	ERROR4		/ILLEGAL RESPONSE
	JMS I [CRLF	/CARRIAGE RETURN/LINE FEED
	DCA COUNT	/CLEAR COUNT
	JMP END		/TRY AGAIN
NEXT1,	ISZ COUNT1	/DONE YET?
	JMP NEXT	/NO

LIM,	TAD (LIMIT-END	/SET BEGINNING OF VERIFY BUFFER
	CLL RAR
	TAD [END
	DCA END0
	TAD (NOP
	DCA I (START1-1
	JMP I (START1
MESSG2,	TEXT @HIGHEST FIELD AVAILABLE:@

FIELD 0
*200

$

