/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
	*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
	*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
WRITE,	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
READ,	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
/	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
GPCH,	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
CRC,	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
CWAIT,	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
	$

