software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape1 / TD8EA.PA
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EA.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EA.PA
new file mode 100644 (file)
index 0000000..5ef0b4a
--- /dev/null
@@ -0,0 +1,364 @@
+/4 TD8E HANDLER FOR BUILD..TD8E-A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1974,1975,1977 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+       *0
+       -2
+DEVICE TD8A;DEVICE DTA0;4210;4010;ZBLOCK 2
+DEVICE TD8A;DEVICE DTA1;4210;4014;ZBLOCK 2
+
+       SDSS=6771       /SKIP ON SINGLE LINE FLAG
+       SDST=6772       /SKIP ON TIME ERROR
+       SDSQ=6773       /SKIP ON QUAD LINE FLAG
+       SDLC=6774       /LOAD TAPE COMMAND REGISTER
+       SDLD=6775       /LOAD DATA REGISTER
+       SDRC=6776       /READ COMMAND REGISTER
+       SDRD=6777       /READ DATA REGISTER
+
+       TDVERSION="D&77
+
+/V3 CHANGES:
+
+/1.    VERSION # IS NOW 1
+/2.    PARITY ^C IS NOW LEGAL
+/3.    ^C CHECK NO LONGER WILL ADVANCE READER
+
+/MAINTENANCE RELEASE CHANGES:
+
+/4.    FIXED ^C BUG
+/5.    MADE CODE IMPROVEMENTS
+/6.    FIXED RETRY BUG
+
+
+       *200
+
+NXINIT,        7600    /CLEAR AC HERE!!!
+       JMS I CINIT2    /PART OF INITIALIZATION..DO THE PART
+BASE2, DCA JINIT       /ON SECOND PAGE AND THEN TO JINIT
+       JMP JINIT
+
+BUFF,  0
+PGCT,  0
+FUNCT, 0
+C1000, 1000
+
+DTA0,  TDVERSION       /ENTRY FOR UNIT 0
+       CLA CLL
+       JMP DTA1X
+UNIT,  0               /FILLER WORD
+DTA1,  TDVERSION       /ENTRY FOR UNIT 1
+       CLA CLL CML
+       TAD DTA1
+       DCA DTA0        /PICK UP ARGS AT DTA0
+DTA1X, RAR
+       DCA UNIT        /UNIT # FROM LINK
+       RDF
+       TAD C6203
+       DCA LEAVE       /SET UP EXIT FROM HANDLER
+       TAD I DTA0
+       DCA FUNCT       /SAVE FUNCTION WORD
+       TAD FUNCT
+       CLL RAL
+C200,  AND CM200       /GET A PAGE COUNT
+       DCA PGCT
+       TAD FUNCT
+C374,  AND C70         /ISOLATE FIELD OF TRANSFER
+       TAD C6203
+       DCA XFIELD
+       ISZ DTA0        /POINT TO BUFFER
+       TAD I DTA0
+       DCA BUFF
+       ISZ DTA0        /POINT TO RECORD
+       TAD I DTA0
+       CLL RAL         /CONVERT TO DECTAPE BLOCKS
+       DCA TBLOCK
+       ISZ DTA0        /POINT TO ERROR RET.
+C6203, CIF CDF 0
+\f
+JINIT, JMP INIT        /FIRST TIME THRU IT GETS EXECUTED
+                       /THE RETURN FROM INIT ZEROES IT
+       CLA CLL CMA RTL
+       DCA ERCNT       /3 ERROR TRIES
+       TAD UNIT
+       DCA I CXUNIT
+       JMS I CSELCT    /CHECK FOR SELEC ERROR
+       JMP .-1         /LOOPS IF NO ^C AND SELECT ERROR
+       TAD FUNCT
+       CLL RAR
+       JMP GO          /OK.. START THE SEARCH
+TRWCOM,        SDST            /TIME OR CHECK SUM ERROR?
+       SZA CLA
+       JMP TRY3        /YES TRY UP TO 3 TIMES
+       TAD PGCT        /NO.. IS PAGE COUNT EXHAUSTED?
+       TAD CM200
+       SNA
+       JMP EXIT        /YES.. DONE THIS TRANSFER
+       DCA PGCT        /NEW PAGE COUNT
+       ISZ TBLOCK
+       TAD BUFF
+       TAD C200        /GET NEW BUFFER ADDRESS
+       DCA BUFF
+       CLL CML         /FORCE FORWARD MOTION
+GO,    CLA CML RTR     /PUT IN DIRECTION BIT
+       TAD C1000
+       TAD UNIT
+       SDLC            /INITIATE THE MOTION
+       JMS I CRDQAD    /WAIT FOR 8 LINES TO PASS
+       JMS I CRDQAD
+M20,   7760            /DON'T CARE IF IT DOES SKIP!!!
+TSRCH, SDSS            /WAIT\ f FOR BLOCK MARK OR END ZONE
+       JMP .-1
+       SDRC
+       CLL RTL         /DIRECTION TO LINK, DATA TO AC 4-9
+       AND C374        /ISOLATE M.T BITS
+       TAD M110        /IS IT END ZONE?
+       SNA
+       JMP ENDZ        /YES..DO SOMETHING REASONABLE
+       TAD M20         /HOW ABOUT BLOCK MARK?
+       SZA CLA
+       JMP TSRCH       /NEITHER..KEEP LOOKING
+       SDRD            /WHAT IS THIS BLOCK'S #?
+       SZL             /IF IN REVERSE, LOOK FOR 3 BEFORE
+       TAD TC3         /THE ACTUAL TARGET BLOCK
+       CMA
+       TAD TBLOCK
+       CMA 
+       SNA             /IS THIS THE BLOCK?
+       JMP TFOUND      /YES..HAVE CORRECT ONE
+M110,  SZL SNA CLA     /ARE WE HEADED PROPERLY?
+       JMP TSRCH       /YES.. KEEP LOOKING
+ENDZ,  SDRC            /IF WE ARE IN END ZONE FORWARD, WE LOSE
+       CLL RTL
+       JMP GO          /EXECUTE TURN AROUND AND SEARCH
+\fTRY3, CLA CLL         /V3C
+       ISZ ERCNT       /TRIED 3 TIMES?
+       JMP GO
+       JMP FATAL
+EXIT,  ISZ DTA0        /NORMAL RETURN
+       CLL CML
+FATAL, TAD UNIT        /STOP TAPE FIRST
+       SDLC
+       CLA CML RAR     /EITHER 0 OR 4000 IN AC
+LEAVE, HLT     /GETS CIF CDF N
+       JMP I DTA0
+
+INIT,  JMS .           /FIND OUT WHERE WE GOT LOADED
+BASE,  TAD CRDQAD
+       SPA             /NEGATIVE ENDS LIST
+       JMP NXINIT
+       TAD INIT
+       DCA CRDQAD
+       ISZ .-1
+       ISZ BASE
+       JMP BASE
+
+CRDQAD,        R4LINE-BASE
+CINIT2,        INIT2-BASE
+CSELCT,        SELECT-BASE
+CXUNIT,        XUNIT-BASE
+
+       *367
+TFOUND,        SZL CLA         /ARE WE IN RIGHT DIRECTION
+       JMP GO          /NOT YET
+       TAD FUNCT
+       CLL RAL         /R/W TO LINK
+       CLA
+C70,   70
+TC3,   3
+       TAD BUFF
+XFIELD,        HLT             /CONTROL 'TRICKLES THROUGH
+
+TBLOCK=DTA1
+ERCNT=INIT+1
+CM200=NXINIT
+DTA2=DTA0
+DTA3=DTA1
+DTA4=DTA0
+DTA5=DTA1
+DTA6=DTA0
+DTA7=DTA1
+\f      *400
+       CIF 0           /WE ARE IN FIELD 0
+       DCA XBUFF
+       RAR
+       DCA XFUNCT      /READ/WRITE TO FUNCTION
+RGRD,  SDSS
+       JMP .-1         /LOOK FOR REVERSE GUARD PATTERN
+       SDRC
+       AND K77
+       TAD CM32
+       SZA CLA         /IF NOT REV. GUARD, KEEP LOOKING
+       JMP RGRD
+       TAD C7600
+       DCA WORDS       /128 WORDS/BLOCK
+       TAD XFUNCT
+K7700, SMA CLA         /IS IT READ OR WRITE?
+       JMP TREAD
+       SDRC            /CHECK FOR WRITE LOCKOUT
+       AND TC300
+       CLL             /SETUP TO RETRY IF WRITE LOCK
+       SZA CLA
+       JMP I CTRY3     /IF LOCKED OUT, ERROR
+       JMS R4LINE      /SKIP A WORD
+C7600, 7600            /CLA
+       TAD C1400
+       TAD XUNIT
+       SDLC            /TURN ON WRITE HEAD
+       CLA CMA
+       JMS W4LINE      /7777 IN REV. CHECKSUM
+       CLA CMA
+       DCA CSUM        /AND ALSO TAPE CHECKSUM
+WRTLP, TAD I XBUFF
+       JMS W4LINE
+       ISZ XBUFF       /INCREMENT BUFF. ADD.
+K77,   77
+       ISZ WORDS       /DONE A BLOCK?
+       JMP WRTLP
+       JMS W4LINE      /A 129 TH WORD OF 0
+       JMS GCHK        /GET 6 BIT CHECKSUM
+       JMS W4LINE      /WRITE IT TO TAPE
+       JMS W4LINE      /LET CHECK SUM FINISH
+       JMP I CRWCOM    /SEE IF WE ARE FINISHED
+\f
+TREAD, JMS R4LINE
+       JMS R4LINE      /SKIP CONTROL WORDS
+       JMS R4LINE
+       AND K77         /CHECKSUM
+       TAD K7700
+       DCA CSUM
+RDLP,  JMS R4LINE
+       JMS EFUN        /ADD WORD TO CHECKSUM
+       DCA I XBUFF
+       ISZ XBUFF
+TC300, 300
+       ISZ WORDS       /DONE BLOCK?
+       JMP RDLP
+       JMS R4LINE
+       JMS EFUN        /CHECK SUM 129 TH WORD
+       JMS R4LINE
+       AND K7700       /READ CHECKSUM
+       JMS EFUN
+       JMS GCHK        /COMPARE TAPE AND OUR CHECKSUM
+       JMP I CRWCOM
+
+W4LINE,        0               /ADD TO CHECKSUM AND WRITE A 12 BIT
+       JMS EFUN        /WORD
+       SDSQ
+       JMP .-1         /SKIP ON QUAD LINE FLAG
+       SDLD
+       CLA             /AC IS NOT CLEARED AFTER SDLD
+       JMP I W4LINE
+
+R4LINE,        0               /WAIT FOR QUAD FLAG AND READ
+       SDSQ
+       JMP .-1
+       SDRD
+       JMP I R4LINE
+
+EFUN,  0               /COMPUTE EQUIVALENCE CHECKSUM
+       CMA
+       DCA ETMP        /ACTUALLY CHECKSUMS ON DECTAPE ARE
+       TAD ETMP        /EQUIVALENCE OF ALL WORDS IN A RCORD
+       AND CSUM        /6 BITS AT A TIME. SINCE EQUIVALENCE
+       CIA             /IS ASSOCIATIVE WE DO IT 12 AT A TIME
+       CLL RAL         /AND CONDENSE LATER.
+       TAD ETMP        /IDENTITIES USED ARE:
+       TAD CSUM        /A+B=(A.XOR.B)+2*(A.AND.B)
+       DCA CSUM        /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+       TAD ETMP        /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+       CMA
+       JMP I EFUN
+
+\fGCHK, 0               /FORM 6 BIT CHECKSUM
+       CLA 
+       TAD CSUM
+       CLL CMA RTL
+       RTL
+       RTL
+       JMS EFUN
+       CLA CLL CML
+       TAD CSUM
+       AND K7700
+       JMP I GCHK
+
+INIT2, 0               /TIS INITIALIZES LOCS IN PAGE 2
+INIT3, TAD CTRY3
+       SNA
+       JMP I INIT2     /0 ENDS LIST
+       TAD INIT2
+       DCA CTRY3       /UPDATE THE LIST
+       ISZ .-1
+       ISZ INIT3
+       JMP INIT3
+
+CTRY3, TRY3-BASE2
+CRWCOM,        TRWCOM-BASE2
+XBUFF, 0               /0 MUST TERMINATE IT!!
+CM32,  -32
+C1400, 1400
+
+SELECT,        0               /THIS ROUTINE CHECKS FOR SELECT
+       TAD XUNIT       /AND ^C TYPED
+       SDLC
+       SDRC            /GET STATUS AND SEE IF SELECT ERROR ON
+       AND C100
+       SNA CLA
+       ISZ SELECT      /NOPE .TAKE NORMAL OUT
+       KSF             /SEE IF FLAG IS UP
+       JMP I SELECT    /NO..EXIT
+       TAD C7600
+       KRS
+       TAD (-7603      /IS IT A ^C?
+       SZA CLA
+       JMP I SELECT    /NO..EXIT
+       JMP I C7600
+
+C100,  100
+
+XFUNCT=INIT2
+CSUM=XFUNCT+1
+WORDS=CSUM+1
+ETMP=WORDS+1
+XUNIT=ETMP+1
+$$$$$$$
+\f