[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape3 / CS.PA

/4 OS/8 CASSETTE HANDLER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

/	DEC-S8-UCASA-A-LA

/	COPYRIGHT 1972

/	DIGITAL EQUIPMENT CORPORATION

/	MAYNARD MASSACHUSETTS   01754

/	MOUTH/DORP

	IFNDEF CODE <CODE=0>

	KCLR=CODE^10+6700	/CLEAR ALL
	KSDR=CODE^10+6701	/SKIP ON DATA FLAG
	KSEN=CODE^10+6702	/SKIP ON ERROR
	KSBF=CODE^10+6703	/SKIP ON READY FLAG
	KLSA=CODE^10+6704	/LOAD STATUS A
	KSAF=CODE^10+6705	/SKIP ON ANY FLAG OR ERROR
	KGOA=CODE^10+6706	/ASSERT CONTENTS OF STATUS A AND XFER
	KRSB=CODE^10+6707	/READ STATUS B

	BSW=7002	/BYTE SWAP	[8/E,F ONLY]

/REWIND=10
/BACKFIL=30
/WRGAP=40
/BACKBLOCK=50
/SKPFIL=70

/SPECIAL CODES

/	0	WRITE EOF
/	1	REWIND
/	2	BACKBLOCK
/	3	SKIPFILE/BACKFILE

/	4-7	UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)

	VERSION="C&77
\f	*0

	-2		/THERE ARE TWO HANDLERS

	2401
	7001+CODE
	0323
	0160+CODE+CODE	/CSA0
	270		/DEVICE CONTROL BLOCK (TYPE 27)
	4000+7		/ENTRY POINT FOR CSA0
	ZBLOCK 2

	2401
	7001+CODE
	0323
	0161+CODE+CODE	/CSA1
	270
	4000+1		/ENTRY POINT FOR CSA1
	ZBLOCK 2
\f	*200

K3700,	3700		/MUST BE FIRST LOCATION ON PAGE
UNIT,
CSA1,	VERSION		/ENTRY POINT FOR CSA1
	CLA		/PROTECT CODE AGAINST IGNORANT USERS
	TAD CSA1	/PICK UP ARGUMENTS
	DCA CSA0	/VIA CSA0
	STL IAC RAL	/TAD (3		[8/I,L,E,F]
	JMP .+3		/JOIN PROCESSING WITH UNIT 1
CSA0,	VERSION		/ENTRY POINT FOR CSA0
	STL CLA RTL	/TAD (2
	BSW		/		[8/E,F]
	DCA UNIT	/SAVE UNIT (0 IS 200, 1 IS 300)
CS,	JMS T		/INITIALIZATION; REPLACED BY RDF
	TAD KCIF	/FORM RETURN FIELD INSTRUCTION
	DCA RETCIF	/STORE IN RETURN CODE
	TAD I CSA0	/GET FUNCTION CONTROL WORD
	DCA FUN		/SAVE IT
	TAD FUN		/GET IT BACK AGAIN
	AND K70		/ISOLATE FIELD OF BUFFER
	TAD KCDF	/FORM CDF TO FIELD OF BUFFER
	DCA BUFCDF	/STORE IN APPROPRIATE SPOT
	ISZ CSA0	/POINT TO ARGUMENT 2
	TAD I CSA0	/GET BUFFER ADDRESS
	DCA BUFFER	/SAVE IT
	ISZ CSA0	/POINT TO ARGUMENT 3
	TAD I CSA0	/GET BLOCK NUMBER
	ISZ CSA0	/POINT TO ERROR RETURN
KCIF,	CIF CDF 0	/SEEK TEMPORARY SAFETY IN CURRENT DATA FIELD
	SZA CLA
	JMP NOT1ST	/NOT BLOCK 0
	STL CLA RAR	/TAD (4000
	AND FUN		/ISOLATE READ/WRITE BIT
	TAD UNIT	/INSERT UNIT
	JMS I QCAS	/CALL CASSETTE ROUTINE
	REWIND-.	/TO PERFORM A REWIND/INITIALIZATION
NOT1ST,	TAD FUN
K200,	AND K3700	/ISOLATE NUMBER OF BLOCKS TO XFER
	SNA
	JMP SPCASE	/0 BLOCKS MEANS SPECIAL THING (EOF)
RECLP,	DCA BLKNT	/SET COUNT OF NUMBER OF BLOCKS
	STL CLA RAR	/TAD (4000
	AND FUN		/ISOLATE READ/WRITE BIT
	TAD UNIT	/INSERT UNIT
	JMS I QCAS	/CALL CASSETTE ROUTINE
	RW-.		/TO INITIATE READ OR WRITE
RETRY,	SZA		/NON-ZERO AC MEANS ERROR
	JMP RETCIF	/TOUGH LUCK BOOBIE - ERROR
	TAD K7700	/GET READY TO XFER 100 DOUBLE WORDS
	DCA DBWDCT	/SET DOUBLE WORD COUNTER
	TAD BUFFER	/GET START OF BUFFER SEGMENT
	DCA BPTR	/SET 'BPTR'
BUFCDF,	HLT		/CHANGE TO DATA FIELD OF USER'S BUFFER
	TAD FUN
K7700,	SMA CLA		/WHICH DIRECTION IS TRANSFER?
	JMP READ	/WANT TO READ
\fWRITE,	TAD I BPTR	/WANT TO WRITE, SO GET WORD FROM BUFFER
	JMS I QGPCH	/WRITE
	TAD I BPTR	/GET FIRST WORD AGAIN
	AND P7400	/ISOLATE FIRST HALF OF BYTE 3
	DCA T		/SAVE FOR FUTURE REFERENCE
	ISZ BPTR	/POINT TO NEXT LOCATION IN BUFFER
	TAD I BPTR	/GET SECOND WORD OF BUFFER PAIR
	JMS I QGPCH	/WRITE BYTE #2
	TAD I BPTR	/RETRIEVE WORD 2
	AND P7400	/ISOLATE 2ND HALF OF BYTE #3
	CLL RTR		/CREATE MYSTIC HIDDEN BYTE 3
	RTR
	TAD T		/GOOD THING I STILL HAVE THIS
	CLL RTR
	RTR
	JMS I QGPCH	/WRITE BYTE #3
	JMP COM
\fREAD,	JMS I QGPCH	/READ BYTE #1 OF TRIPLE
	DCA I BPTR	/STORE IN WORD 1 OF BUFFER PAIR
	JMS I QGPCH	/READ BYTE #2 OF TRIPLE
	DCA T		/SAVE IT FOR POSTERITY
	JMS I QGPCH	/READ BYTE #3 OF TRIPLE
	RTL
	RTL		/MYSTIC ROTATES
	DCA T2
	TAD T2
	AND P7400	/AND MYSTIC CONSTANTS
	TAD I BPTR	/FIX UP BUFFER WORD 1 OF PAIR
	DCA I BPTR
	TAD T2
	RTL
	RTL		/MORE ROTATION
	AND P7400	/AND MORE
	TAD T
	ISZ BPTR	/POINT TO SECOND WORD OF BUFFER PAIR
	DCA I BPTR	/STORE SECOND WORD
COM,	ISZ BPTR	/POINT TO BEGIN OF NEXT BUFFER PAIR
P7400,	7400		/PROTECTION AGAINST CORE WRAP AROUND
	ISZ DBWDCT	/BUMP DOUBLE WORD COUNT
	JMP BUFCDF	/REITERATE
	JMS I QCAS	/CALL CASSETTE ROUTINE
	CRC-.		/TO CHECK CRC
	TAD BUFFER	/GET BUFFER SEGMENT ADDRESS
	TAD K200	/ADD 200 TO GET TO NEXT SEGMENT
	DCA BUFFER	/REPLACE
	TAD BLKNT	/GET BLOCK COUNT
	TAD K7700	/SUBTRAT 100
	SZA		/ARE WE DONE?
	JMP RECLP	/NO, REITERATE
	ISZ CSA0	/POINT TO NORMAL GOOD RETURN
RETCIF,	HLT		/RETURN TO USER'S DATA AND INSTRUCTION FIELDS
	JMP I CSA0	/RETURN
\f/	INTIALIZATION ROUTINE - ONCE ONLY CODE
/		OVERLAID BY TEMPORARIES

T,	0		/ENTRY POINT TO INITIALIZATION
T2,	TAD KRDF	/REPLACE CALL BY RDF
FUN,	DCA CS		/SO THAT WE'LL NEVER SEE YOU HERE AGAIN
BUFFER,	TAD T		/CORRECT ADDRESS OF GPCH
DBWDCT,	TAD KQX1	/BY ADDING IN CS+1
QGPCH,	DCA .		/STORE IT HERE
BLKNT,	STL CLA RTL	/CORRECT ADDRESS OF CAS IS 2 MORE
	TAD QGPCH
QCAS,	DCA .		/THAN GPCH.  STORE IT HERE.
BPTR,	JMP CS		/RETURN TO MAIN PROGRAM
KRDF,	RDF
KQX1,	GPCH-CS-1

SPCASE,	TAD FUN
	AND L4003	/ISOLATE R/W BIT + SPECIAL CODE
	TAD UNIT
	JMS I QCAS
	SPCODE-.
	JMP RETCIF-1	/LEAVE GRACEFULLY
K70,	70
KCDF,	CDF 0
L4003,	4003
	PAGE
\fGPCH,	0		/READ OR WRITE A BYTE
	JMP AROUND	/GO TO REAL LOCATION OF THIS SUBROUTINE
CAS,	0		/MUST BE AT GPCH+2; DO CASSETTE STUFF
	DCA TEMP	/SAVE ARGUMENT IN AC
	CDF 0
	TAD I CAS	/GET UNRELOCATED RELATIVE LOCAL ENTRY POINT
	TAD CAS		/RELOCATE IT
	ISZ CAS		/POINT TO NORMAL RETURN LOCATION
	DCA GPCH	/SAVE ENTRY POINT IN TEMPORARY
	JMP I GPCH	/GO TO CORRECT ENTRY POINT

RW,	TAD CAS
	DCA RTRY	/SAVE RETRY ADDRESS
	TAD TEMP	/GET ARGUMENT PASSED VIA AC
	DCA FNUNIT	/SAVE
	CLL STA RTL	/TAD (7775
	DCA ERKNT	/SET ERROR COUNT TO -3
ERETRY,	TAD FNUNIT
	SPA
	TAD (20		/READ CODE IS 0; WRITE IS 20
	KLSA		/LOAD STATUS A
	TAD FNUNIT	/***KLSA CLEARS BIT 0
	SMA CLA		/READS HAVE TO BE INITIATED
	JMS CWAIT	/READ
	JMP I RTRY	/RETURN

AROUND,	DCA TEMP
	TAD FNUNIT
	SMA CLA
	JMP RDCHAR	/READ
	TAD TEMP	/WRITE
	JMS CWAIT
	JMP I GPCH	/RETURN

RDCHAR,	JMS CWAIT
	TAD TEMP	/GET CHAR JUST READ
	JMP I GPCH	/RETURN WITH IT IN AC
\fCRC,	TAD FNUNIT
	TAD (60
	KLSA		/INITIATE READ/WRITE CRC
	TAD FNUNIT	/***KLSA CLEARS BIT 0
	SMA CLA
	JMS CWAIT	/HAVE TO READ TWICE
	JMS CWAIT	/WRITE CRC WRITES BOTH
	KCLR		/WHY NOT?
	JMP I CAS	/RETURN

REWIND,	TAD (10
	JMS UTIL
	TAD TEMP
	SMA CLA
	JMP I CAS	/MERELY REWIND IF READING
	JMP EOF
SKIPF,	TAD (20
BACKBL,	TAD (10
EOF,	TAD (10
BACKF,	TAD (30
	JMS UTIL
	JMP I CAS	/RETURN

UTIL,	0
	TAD TEMP
	KLSA
TRYAGN,	KGOA
	JMS CTCTST
	KSBF		/WAIT FOR READY
	JMP .-2
	KRSB
	AND (10
	SZA CLA
	JMP TRYAGN	/KEEP TRYING IF ERROR CAUSED BY DRIVE EMPTY
	JMP I UTIL

TEMP,	0
ERKNT,	0
FNUNIT,	0
RTRY,	0

SPCODE,	TAD TEMP
	AND (3
	TAD (JMP TABLE
	DCA J
	TAD TEMP
	AND (4300
	DCA TEMP
J,	HLT
TABLE,	JMP EOF		/0 WRITE EOF
	JMP REWIND	/1 REWIND AND WRITE EOF IF BIT 0=1
	JMP BACKBL	/2 BACK BLOCK
	TAD TEMP	/3 SKIP/BACK FILE DEPENDING ON BIT 0
	SMA CLA
	JMP SKIPF	/FORWARD FILE
	JMP BACKF	/BACK FILE
\fCWAIT,	0
	KGOA		/ASSERT CONTENTS OF STATUS A
	DCA TEMP	/SAVE ANYTHING READ
	JMS CTCTST
	KSAF
	JMP .-2		/WAIT FOR SOMETHING TO HAPPEN
	KSEN		/WAS IT AN ERROR?
	JMP I CWAIT	/NO, SO RETURN
ERR,	DCA TEMP	/YES ... ERROR
	KRSB
	AND (30
	SNA
	JMP .+3
	AND (20
	JMP I RTRY	/END OF FILE IS SOFT ERROR
	ISZ ERKNT	/SHALL WE TRY AGAIN?
	JMP .+3		/YES
	STL CLA RAR	/TAD (4000
	JMP I RTRY	/RETURN WITH NON-ZERO AC
	TAD FNUNIT	/RETRY
	TAD (50		/BUT FIRST DO BACKSPACE BLOCK GAP
	JMS UTIL
	JMP ERETRY

CTCTST,	0		/TEST FOR CONTROL/C
L7600,	7600
	TAD L7600
	KRS
	TAD (-7603
	SNA CLA
	KSF
	JMP I CTCTST
	CIF CDF 0
	JMP I L7600	/RETURN TO OS/8
	$
\f
Commit	Line	Data
7af5ad59 PH	1	/4 OS/8 CASSETTE HANDLER
	2	/
	3	/
	4	/
	5	/
	6	/
	7	/
	8	/
	9	/
	10	/
	11	/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
	12	/
	13	/
	14	/
	15	/
	16	/
	17	/
	18	/
	19	/
	20	/
	21	/
	22	/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
	23	/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
	24	/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
	25	/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
	26	/
	27	/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
	28	/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
	29	/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
	30	/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
	31	/
	32	/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
	33	/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
	34	/DIGITAL.
	35	/
	36	/
	37	/
	38	/
	39	/
	40	/
	41	/
	42	/
	43	/
	44	/
	45
	46	/ DEC-S8-UCASA-A-LA
	47
	48	/ COPYRIGHT 1972
	49
	50	/ DIGITAL EQUIPMENT CORPORATION
	51
	52	/ MAYNARD MASSACHUSETTS 01754
	53
	54	/ MOUTH/DORP
	55
	56	IFNDEF CODE <CODE=0>
	57
	58	KCLR=CODE^10+6700 /CLEAR ALL
	59	KSDR=CODE^10+6701 /SKIP ON DATA FLAG
	60	KSEN=CODE^10+6702 /SKIP ON ERROR
	61	KSBF=CODE^10+6703 /SKIP ON READY FLAG
	62	KLSA=CODE^10+6704 /LOAD STATUS A
	63	KSAF=CODE^10+6705 /SKIP ON ANY FLAG OR ERROR
	64	KGOA=CODE^10+6706 /ASSERT CONTENTS OF STATUS A AND XFER
65	KRSB=CODE^10+6707 /READ STATUS B
66
67	BSW=7002 /BYTE SWAP [8/E,F ONLY]
68
69	/REWIND=10
70	/BACKFIL=30
71	/WRGAP=40
72	/BACKBLOCK=50
73	/SKPFIL=70
74
75	/SPECIAL CODES
76
77	/ 0 WRITE EOF
78	/ 1 REWIND
79	/ 2 BACKBLOCK
80	/ 3 SKIPFILE/BACKFILE
81
82	/ 4-7 UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
83
84	VERSION="C&77
85	\f *0
86
87	-2 /THERE ARE TWO HANDLERS
88
89	2401
90	7001+CODE
91	0323
92	0160+CODE+CODE /CSA0
93	270 /DEVICE CONTROL BLOCK (TYPE 27)
94	4000+7 /ENTRY POINT FOR CSA0
95	ZBLOCK 2
96
97	2401
98	7001+CODE
99	0323
100	0161+CODE+CODE /CSA1
101	270
102	4000+1 /ENTRY POINT FOR CSA1
103	ZBLOCK 2
104	\f *200
105
106	K3700, 3700 /MUST BE FIRST LOCATION ON PAGE
107	UNIT,
108	CSA1, VERSION /ENTRY POINT FOR CSA1
109	CLA /PROTECT CODE AGAINST IGNORANT USERS
110	TAD CSA1 /PICK UP ARGUMENTS
111	DCA CSA0 /VIA CSA0
112	STL IAC RAL /TAD (3 [8/I,L,E,F]
113	JMP .+3 /JOIN PROCESSING WITH UNIT 1
114	CSA0, VERSION /ENTRY POINT FOR CSA0
115	STL CLA RTL /TAD (2
116	BSW / [8/E,F]
117	DCA UNIT /SAVE UNIT (0 IS 200, 1 IS 300)
118	CS, JMS T /INITIALIZATION; REPLACED BY RDF
119	TAD KCIF /FORM RETURN FIELD INSTRUCTION
120	DCA RETCIF /STORE IN RETURN CODE
121	TAD I CSA0 /GET FUNCTION CONTROL WORD
122	DCA FUN /SAVE IT
123	TAD FUN /GET IT BACK AGAIN
124	AND K70 /ISOLATE FIELD OF BUFFER
125	TAD KCDF /FORM CDF TO FIELD OF BUFFER
126	DCA BUFCDF /STORE IN APPROPRIATE SPOT
127	ISZ CSA0 /POINT TO ARGUMENT 2
128	TAD I CSA0 /GET BUFFER ADDRESS
129	DCA BUFFER /SAVE IT
130	ISZ CSA0 /POINT TO ARGUMENT 3
131	TAD I CSA0 /GET BLOCK NUMBER
132	ISZ CSA0 /POINT TO ERROR RETURN
133	KCIF, CIF CDF 0 /SEEK TEMPORARY SAFETY IN CURRENT DATA FIELD
134	SZA CLA
135	JMP NOT1ST /NOT BLOCK 0
136	STL CLA RAR /TAD (4000
137	AND FUN /ISOLATE READ/WRITE BIT
138	TAD UNIT /INSERT UNIT
139	JMS I QCAS /CALL CASSETTE ROUTINE
140	REWIND-. /TO PERFORM A REWIND/INITIALIZATION
141	NOT1ST, TAD FUN
142	K200, AND K3700 /ISOLATE NUMBER OF BLOCKS TO XFER
143	SNA
144	JMP SPCASE /0 BLOCKS MEANS SPECIAL THING (EOF)
145	RECLP, DCA BLKNT /SET COUNT OF NUMBER OF BLOCKS
146	STL CLA RAR /TAD (4000
147	AND FUN /ISOLATE READ/WRITE BIT
148	TAD UNIT /INSERT UNIT
149	JMS I QCAS /CALL CASSETTE ROUTINE
150	RW-. /TO INITIATE READ OR WRITE
151	RETRY, SZA /NON-ZERO AC MEANS ERROR
152	JMP RETCIF /TOUGH LUCK BOOBIE - ERROR
153	TAD K7700 /GET READY TO XFER 100 DOUBLE WORDS
154	DCA DBWDCT /SET DOUBLE WORD COUNTER
155	TAD BUFFER /GET START OF BUFFER SEGMENT
156	DCA BPTR /SET 'BPTR'
157	BUFCDF, HLT /CHANGE TO DATA FIELD OF USER'S BUFFER
158	TAD FUN
159	K7700, SMA CLA /WHICH DIRECTION IS TRANSFER?
160	JMP READ /WANT TO READ
161	\fWRITE, TAD I BPTR /WANT TO WRITE, SO GET WORD FROM BUFFER
162	JMS I QGPCH /WRITE
163	TAD I BPTR /GET FIRST WORD AGAIN
164	AND P7400 /ISOLATE FIRST HALF OF BYTE 3
165	DCA T /SAVE FOR FUTURE REFERENCE
166	ISZ BPTR /POINT TO NEXT LOCATION IN BUFFER
167	TAD I BPTR /GET SECOND WORD OF BUFFER PAIR
168	JMS I QGPCH /WRITE BYTE #2
169	TAD I BPTR /RETRIEVE WORD 2
170	AND P7400 /ISOLATE 2ND HALF OF BYTE #3
171	CLL RTR /CREATE MYSTIC HIDDEN BYTE 3
172	RTR
173	TAD T /GOOD THING I STILL HAVE THIS
174	CLL RTR
175	RTR
176	JMS I QGPCH /WRITE BYTE #3
177	JMP COM
178	\fREAD, JMS I QGPCH /READ BYTE #1 OF TRIPLE
179	DCA I BPTR /STORE IN WORD 1 OF BUFFER PAIR
180	JMS I QGPCH /READ BYTE #2 OF TRIPLE
181	DCA T /SAVE IT FOR POSTERITY
182	JMS I QGPCH /READ BYTE #3 OF TRIPLE
183	RTL
184	RTL /MYSTIC ROTATES
185	DCA T2
186	TAD T2
187	AND P7400 /AND MYSTIC CONSTANTS
188	TAD I BPTR /FIX UP BUFFER WORD 1 OF PAIR
189	DCA I BPTR
190	TAD T2
191	RTL
192	RTL /MORE ROTATION
193	AND P7400 /AND MORE
194	TAD T
195	ISZ BPTR /POINT TO SECOND WORD OF BUFFER PAIR
196	DCA I BPTR /STORE SECOND WORD
197	COM, ISZ BPTR /POINT TO BEGIN OF NEXT BUFFER PAIR
198	P7400, 7400 /PROTECTION AGAINST CORE WRAP AROUND
199	ISZ DBWDCT /BUMP DOUBLE WORD COUNT
200	JMP BUFCDF /REITERATE
201	JMS I QCAS /CALL CASSETTE ROUTINE
202	CRC-. /TO CHECK CRC
203	TAD BUFFER /GET BUFFER SEGMENT ADDRESS
204	TAD K200 /ADD 200 TO GET TO NEXT SEGMENT
205	DCA BUFFER /REPLACE
206	TAD BLKNT /GET BLOCK COUNT
207	TAD K7700 /SUBTRAT 100
208	SZA /ARE WE DONE?
209	JMP RECLP /NO, REITERATE
210	ISZ CSA0 /POINT TO NORMAL GOOD RETURN
211	RETCIF, HLT /RETURN TO USER'S DATA AND INSTRUCTION FIELDS
212	JMP I CSA0 /RETURN
213	\f/ INTIALIZATION ROUTINE - ONCE ONLY CODE
214	/ OVERLAID BY TEMPORARIES
215
216	T, 0 /ENTRY POINT TO INITIALIZATION
217	T2, TAD KRDF /REPLACE CALL BY RDF
218	FUN, DCA CS /SO THAT WE'LL NEVER SEE YOU HERE AGAIN
219	BUFFER, TAD T /CORRECT ADDRESS OF GPCH
220	DBWDCT, TAD KQX1 /BY ADDING IN CS+1
221	QGPCH, DCA . /STORE IT HERE
222	BLKNT, STL CLA RTL /CORRECT ADDRESS OF CAS IS 2 MORE
223	TAD QGPCH
224	QCAS, DCA . /THAN GPCH. STORE IT HERE.
225	BPTR, JMP CS /RETURN TO MAIN PROGRAM
226	KRDF, RDF
227	KQX1, GPCH-CS-1
228
229	SPCASE, TAD FUN
230	AND L4003 /ISOLATE R/W BIT + SPECIAL CODE
231	TAD UNIT
232	JMS I QCAS
233	SPCODE-.
234	JMP RETCIF-1 /LEAVE GRACEFULLY
235	K70, 70
236	KCDF, CDF 0
237	L4003, 4003
238	PAGE
239	\fGPCH, 0 /READ OR WRITE A BYTE
240	JMP AROUND /GO TO REAL LOCATION OF THIS SUBROUTINE
241	CAS, 0 /MUST BE AT GPCH+2; DO CASSETTE STUFF
242	DCA TEMP /SAVE ARGUMENT IN AC
243	CDF 0
244	TAD I CAS /GET UNRELOCATED RELATIVE LOCAL ENTRY POINT
245	TAD CAS /RELOCATE IT
246	ISZ CAS /POINT TO NORMAL RETURN LOCATION
247	DCA GPCH /SAVE ENTRY POINT IN TEMPORARY
248	JMP I GPCH /GO TO CORRECT ENTRY POINT
249
250	RW, TAD CAS
251	DCA RTRY /SAVE RETRY ADDRESS
252	TAD TEMP /GET ARGUMENT PASSED VIA AC
253	DCA FNUNIT /SAVE
254	CLL STA RTL /TAD (7775
255	DCA ERKNT /SET ERROR COUNT TO -3
256	ERETRY, TAD FNUNIT
257	SPA
258	TAD (20 /READ CODE IS 0; WRITE IS 20
259	KLSA /LOAD STATUS A
260	TAD FNUNIT /***KLSA CLEARS BIT 0
261	SMA CLA /READS HAVE TO BE INITIATED
262	JMS CWAIT /READ
263	JMP I RTRY /RETURN
264
265	AROUND, DCA TEMP
266	TAD FNUNIT
267	SMA CLA
268	JMP RDCHAR /READ
269	TAD TEMP /WRITE
270	JMS CWAIT
271	JMP I GPCH /RETURN
272
273	RDCHAR, JMS CWAIT
274	TAD TEMP /GET CHAR JUST READ
275	JMP I GPCH /RETURN WITH IT IN AC
276	\fCRC, TAD FNUNIT
277	TAD (60
278	KLSA /INITIATE READ/WRITE CRC
279	TAD FNUNIT /***KLSA CLEARS BIT 0
280	SMA CLA
281	JMS CWAIT /HAVE TO READ TWICE
282	JMS CWAIT /WRITE CRC WRITES BOTH
283	KCLR /WHY NOT?
284	JMP I CAS /RETURN
285
286	REWIND, TAD (10
287	JMS UTIL
288	TAD TEMP
289	SMA CLA
290	JMP I CAS /MERELY REWIND IF READING
291	JMP EOF
292	SKIPF, TAD (20
293	BACKBL, TAD (10
294	EOF, TAD (10
295	BACKF, TAD (30
296	JMS UTIL
297	JMP I CAS /RETURN
298
299	UTIL, 0
300	TAD TEMP
301	KLSA
302	TRYAGN, KGOA
303	JMS CTCTST
304	KSBF /WAIT FOR READY
305	JMP .-2
306	KRSB
307	AND (10
308	SZA CLA
309	JMP TRYAGN /KEEP TRYING IF ERROR CAUSED BY DRIVE EMPTY
310	JMP I UTIL
311
312	TEMP, 0
313	ERKNT, 0
314	FNUNIT, 0
315	RTRY, 0
316
317	SPCODE, TAD TEMP
318	AND (3
319	TAD (JMP TABLE
320	DCA J
321	TAD TEMP
322	AND (4300
323	DCA TEMP
324	J, HLT
325	TABLE, JMP EOF /0 WRITE EOF
326	JMP REWIND /1 REWIND AND WRITE EOF IF BIT 0=1
327	JMP BACKBL /2 BACK BLOCK
328	TAD TEMP /3 SKIP/BACK FILE DEPENDING ON BIT 0
329	SMA CLA
330	JMP SKIPF /FORWARD FILE
331	JMP BACKF /BACK FILE
332	\fCWAIT, 0
333	KGOA /ASSERT CONTENTS OF STATUS A
334	DCA TEMP /SAVE ANYTHING READ
335	JMS CTCTST
336	KSAF
337	JMP .-2 /WAIT FOR SOMETHING TO HAPPEN
338	KSEN /WAS IT AN ERROR?
339	JMP I CWAIT /NO, SO RETURN
340	ERR, DCA TEMP /YES ... ERROR
341	KRSB
342	AND (30
343	SNA
344	JMP .+3
345	AND (20
346	JMP I RTRY /END OF FILE IS SOFT ERROR
347	ISZ ERKNT /SHALL WE TRY AGAIN?
348	JMP .+3 /YES
349	STL CLA RAR /TAD (4000
350	JMP I RTRY /RETURN WITH NON-ZERO AC
351	TAD FNUNIT /RETRY
352	TAD (50 /BUT FIRST DO BACKSPACE BLOCK GAP
353	JMS UTIL
354	JMP ERETRY
355
356	CTCTST, 0 /TEST FOR CONTROL/C
357	L7600, 7600
358	TAD L7600
359	KRS
360	TAD (-7603
361	SNA CLA
362	KSF
363	JMP I CTCTST
364	CIF CDF 0
365	JMP I L7600 /RETURN TO OS/8
366	$
367	\f