--- /dev/null
+/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
projects / pdp8.git / blobdiff