A large commit.
[pdp8.git] / sw / dumprest / hachti_std / READTD.PA
diff --git a/sw/dumprest/hachti_std/READTD.PA b/sw/dumprest/hachti_std/READTD.PA
new file mode 100644 (file)
index 0000000..bd97500
--- /dev/null
@@ -0,0 +1,719 @@
+/ TD8E Dectape DUMP Program
+/ This program will send a Dectape image out the console port.
+/ The format of the data sent is 0xff (0377) or 0xfd if read error
+/ followed by 128 word  of data for each block.
+/ After the last block a 0xfe (0376) is sent
+/ with a two byte checksum, low 8 bits first then upper 4.
+/ The words in a block are sent as three bytes for each 2 words.
+/   1 = low 8 bits first word
+/   2 = upper 4 bits first and lower 4 bits second
+/   3 = upper 8 bits second word
+/
+/ The program (PC) receiving the data should be started before this program
+/
+/ To run start at 0200.
+/    SR 11 should be drive, only 0 and 1 supported without reassembling
+/    SR 6-8 should be maximum memory field in computer, needs 8k minimum
+/ The receiving program should be running first.
+/ At normal exit hitting cont will restart the program
+/
+/ Should halt at label finish (140) with number of recoverable errors in AC
+/ The current block being read will be displayed in the AC
+/ while running.
+/
+/ If a unrecoverable error occurs the program will halt with the error in
+/ the AC.  Hit continue to dump more or comment out hlt, search for *****.
+/ The PC program will print out the bad location if an error occurs
+/
+/ We will retry each read up to 16 times on error
+/
+/ This transfers the standard 129 word by 1474 blocks used by OS/8 etc.
+/ Other formats can be handled by changing constants below
+
+        INAD=400                / Address of serial input, 30 for console
+        KCF2=6000 INAD
+        KSF2=6001 INAD
+        KCC2=6002 INAD
+        KRS2=6004 INAD
+        KIE2=6005 INAD
+        KRB2=6006 INAD
+
+        OUTAD=410               / Address of serial output, 40 for console
+        TFL2=6000 OUTAD
+        TSF2=6001 OUTAD
+        TCF2=6002 OUTAD
+        TPC2=6004 OUTAD
+        TSK2=6005 OUTAD
+        TLS2=6006 OUTAD
+
+/2 TD8E INITIALIZER PROGRAM, V7A
+/
+/COPYRIGHT (C) 1975, 1977
+/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.
+/
+/
+/
+/
+/
+/
+\f
+/DECEMBER 21, 1973              GB/RL/EF/SR
+
+/ABSTRACT--
+/       THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
+/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
+/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
+/WHICH IS COMPATIBLE WITH OS/8 DEVICE HANDLER CALLING
+/SEQUENCES.
+
+/FIXES SINCE FIELD-TEST RELEASE:
+
+/1.     FIXED BUG RE CLA ON RETRY AFTER ERROR
+/2.     ALLOWED FINAL BOOTSTRAP TO BE INTO A WRITE-LOCKED DEVICE
+
+/OS/8 V3D CHANGES:
+
+/3.     FIXED BUG RE TD8E BUILD (V6B PATCH)
+\f
+/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
+/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
+/CONTROL:
+/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
+/B) THE ORIGIN OF THE TWO PAGE ROUTINE
+/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
+/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
+
+/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
+/DEC VERSION OF THIS ROUTINE:
+
+        DRIVE=10        /UNITS 0 AND 1 SELECTED
+        ORIGIN=600      /ENTER AT ORIGIN, ORIGIN+4
+        AFIELD=0        /INITIAL FIELD SETTING
+        MFIELD=00       /AFIELD*10=MFIELD
+        WDSBLK=201      /129 WORDS PER BLOCK
+
+/THE USE OF THE PARAMETERS IS AS FOLLOWS:
+
+/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
+/       DRIVE=10 IMPLIES UNITS 0 &1
+/       DRIVE=20 IMPLIES UNITS 2&3
+/       DRIVE=30 IMPLIES UNITS 4&5
+/       DRIVE=40 IMPLIES UNITS 6&7
+
+/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
+/       MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
+/THAT THIS IS A TWO PAGE ROUTINE.
+
+/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
+/       LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
+
+/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
+/       THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
+/       THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
+
+/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE
+/       IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
+/       128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
+/ 129 DECIMAL ??? (DJG)
+/       BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
+/       FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
+/       FORMATTED TO CONTAIN.
+
+/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
+/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
+/PER BLOCK, THE PARAMETERS WOULD BE:
+/       DRIVE=20
+/       ORIGIN=3000
+/       AFIELD=2
+/       MFIELD=20
+/       WDSBLK=400
+\f/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
+/CALLING SEQUENCE FOR OS/8 DEVICE HANDLERS.
+/THE CALLING SEQUENCE IS:
+
+/       CDF CURRENT
+/       CIF MFIELD      /MFIELD=FIELD ASSEMBLED IN
+/       JMS ENTRY       /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
+                        /AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
+/       ARG1
+/       ARG1B (DJG)
+/       ARG2
+/       ARG3
+/       ERROR RETURN
+/       NORMAL RETURN
+
+/THE ARGUMENTS ARE:
+
+/ARG1: FUNCTION WORD    BIT0: 0=READ, 1=WRITE
+/                       BITS 1-5: UNUSED, WAS # BLOCKS IN OPERATION (DJG)
+/                       BITS 6-8: FIELD OF BUFFER AREA
+/                       BIT 9: UNUSED
+/                       BIT 10: # OF WORDS/BLOCK.
+/                       0= WDSBLK, 1=WDSBLK-1
+/                       BIT 11: 1=START FORWARD, 0=REVERSE
+/ARG1A: # OF BLOCKS IN OPERATIONA (DJG)
+/ARG2: BUFFER ADDRESS FOR OPERATION
+/ARG3: STARTING BLOCK FOR OPERATION
+
+/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
+/               TOO GREAT A BLOCK NUMBER
+/       FATAL ERRORS TAKE ERROR RETURN WITH THE
+/       AC=4000.
+/B) NON-FATAL- SELECT ERROR.
+/       IF NO PROPER UNIT IS SELECTED, THE ERROR
+/       RETURN IS TAKEN WITH CLEAR AC.
+/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
+/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
+/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
+
+/THE TD8E IOT'S ARE:
+        SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
+        SDST=7002-DRIVE /SKIP ON TIMING ERROR
+        SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
+        SDLC=7004-DRIVE /LOAD COMMAND REGISTER
+        SDLD=7005-DRIVE /LOAD DATA REGISTER
+        SDRC=7006-DRIVE /READ COMMAND REGISTER
+        SDRD=7007-DRIVE /READ DATA REGISTER
+
+/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
+/THE OTHERS CONTROL UNITS 2-7.
+
+/       THIS HANDLER USES DECTAPE BLOCKS NOT OS/8 BLOCKS !
+
+        *ORIGIN
+
+/       MODIFIED SO BIT 0 ON ENTRY IS UNIT 1
+DTA0,   0
+        DCA UNIT        /SAVE UNIT POSITION
+        RDF
+        TAD C6203       /GET DATA FIELD AND SETUP RETURN
+        DCA LEAVE
+        TAD I DTA0      /GET FUNCTION WORD
+        SDLD            /PUT FUNCTION INTO DATA REGISTER
+        CLL RTR         /AC STILL HAS FUNCTION. PUT # WORDS PER
+                        /BLOCK INTO LINK
+        SZL CLA         /KNOCK ONE OFF WDSBLK?
+        IAC             /YES
+        TAD MWORDS
+        DCA WCOUNT      /STORE MASTER WORD COUNT
+        ISZ DTA0        /TO BLOCK COUNT (DJG)
+        TAD I DTA0      / (DJG)
+        CIA             / (DJG)
+        DCA PGCT        / (DJG)
+        ISZ DTA0        /TO BUFFER
+        TAD I DTA0
+        DCA XBUFF       /SAVE ADDRESS (DJG)
+/       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
+/       SDRD            /GET FUNCTION INTO AC
+/       CLL RAL
+/       AND CM200       /GET # PAGES TO XFER
+/       DCA PGCT
+        SDRD
+        AND C70         /GET FIELD FOR XFER
+        TAD C6201       /FORM CDF N
+        DCA XFIELD      /IF=0 AND DF=N AT XFER.
+        TAD UNIT        /TEST FOR SELECT ERROR
+        SDLC
+        CLA             / Moved here because my drive 1 is slow selecting
+        TAD RETRY
+        DCA TRYCNT      /3 ERROR TRIES
+        SDRC
+        AND C100
+        SZA CLA
+        JMP FATAL-1
+        SDRD            /PUT FUNCT INTO XFUNCT IN SECOND PG.
+        DCA I CXFUN
+        TAD WCOUNT
+        DCA I CXWCT
+        SDRD            /GET MOTION BIT TO LINK
+        CLL RAR
+XFIELD, HLT             /INTO NEXT PAGE
+        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
+        ISZ PGCT        / (DJG)
+        SKP             / (DJG)
+        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 XBUFF       /SAVE ADDRESS (DJG)
+/       DCA BUFF        / (DJG)
+        CLL CML         /FORCES MOTION FORWARD
+GO,     CLA CML RTR     /LINK BECOMES MOTION BIT
+        TAD C1000
+        TAD UNIT        /PUT IN 'GO' AND UNIT #
+        SDLC            /LOOK FOR BLOCK NO.
+        CLA
+        TAD XBUFF
+        DCA OLDBUF
+        RDF
+        TAD C6201
+        DCA OLDFLD
+        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
+        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
+        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,   CLA
+OLDFLD, NOP
+        TAD OLDBUF
+        DCA XBUFF
+        ISZ TRYCNT
+        JMP GO          /TRY 3 TIMES
+        JMP FATAL               /LINK OFF MEANS AC=4000 ON RETURN
+EXIT,   ISZ DTA0
+        CLL CML         /AC=0 ON NORMAL RETURN
+FATAL,  TAD UNIT
+        SDLC            /STOP THE UNIT
+        CLA CML RAR
+LEAVE,  HLT
+        JMP I DTA0
+
+\f
+C6203,  6203
+C6201,  6201
+CRDQUD, RDQUAD
+/WCOUNT,        0       (MOVED PAGE 0 DJG)
+BUFF,   0
+/MWORDS,        -WDSBLK (MOVED PAGE 0 DJG)
+UNIT,   0
+CXFUN,  XFUNCT
+M20,    -20
+PGCT,   0
+CXWCT,  XWCT
+C100,   100
+TRYCNT, -3
+C1000,  1000
+
+
+        *ORIGIN+172
+FOUND,  SZL CLA         /RIGHT BLOCK. HOW ABOUT DIRECTION?
+        JMP GO          /WRONG..TURN AROUND
+        TAD UNIT        /PUT UNIT INTO LINK
+        CLL RAL         /AC IS NOW 0
+C70,    70              /********DON'T MOVE THIS!!!!******
+C3,     3
+/       TAD BUFF        /GET BUFFER ADDRESS (DJG)
+/XFIELD, HLT         /INTO NEXT PAGE
+\f       *ORIGIN+200
+        CIF MFIELD
+/       DCA XBUFF       /SAVE ADDRESS (DJG)
+        RAR             /NOW GET UNIT #
+        DCA XUNIT
+        SDRC
+        SDLC
+REVGRD, SDSS
+        JMP .-1         /LOOK FOR REVERSE GUARD
+        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
+        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
+        JMP STFLD1+1    /NOT AT END OF FIELD (DJG)
+        RDF
+        TAD (6211
+        DCA STFLD1
+STFLD1, NOP
+        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
+K77,    77              /ABOVE MAY SKIP (NOT ANYMORE DJG)
+\fREAD,  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       /AT END OF FIELD?
+        JMP STFLD2+1    /NOT AT END OF FIELD (DJG)
+        RDF
+        TAD (6211
+        DCA STFLD2
+STFLD2, NOP
+        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
+C300,   300             /PROTECTION (NOT ANYMORE DJG)
+
+WRQUAD, 0               /WRITE OUT A 12 BIT WORD
+        JMS EQUFUN      /ADD THIS TO CHECKSUM
+        SDSQ            /SKIP ON QUADLINE FLAG
+        JMP .-1
+        SDLD            /LOAD DATA  ONTO BUS
+        CLA             /SDLD DOESN'T CLEAR AC
+        JMP I WRQUAD
+
+RDQUAD, 0               /READ A 12 BIT WORD
+        SDSQ
+        JMP .-1
+        SDRD            /READ DATA
+        JMP I RDQUAD
+
+\fXUNIT,
+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
+XWCT,   0
+EQUTMP, 0
+
+        *20
+RETRY,  7774            / RETRY UP TO 4 TIME
+NUMBLK, 2702            / NUMBER OF BLOCKS
+MWORDS, -WDSBLK         / WORDS PER BLOCK
+WCOUNT, 0
+BLKFLD, 37              / 31 129 word blocks per field
+                        / WRAPPING PAST END OF LAST FIELD DOESN'T WORK
+FIELDS, 0
+RDSIZE, 0               / NUMBER BLOCKS PER READ
+CBLOCK, 0               / CURRENT BLOCK TO XFER
+CLKSUM, 0
+DRVSEL, 0
+READST, 377
+LOC,    0
+LEN,    0
+BCNT,   0              / BLOCKS TO SEND TO PC
+TEMP,   0
+C17,    17
+C360,   360
+CHKSM,  0
+ERRCN2, 0
+OLDBUF, 0               / USED BY DTA0 ROUTINE
+XBUFF,  0               / USED BY DTA0 ROUTINE
+C374,   374             / USED BY DTA0 ROUTINE
+BLOCK,  0               / USED BY DTA0 ROUTINE
+
+       *140
+FINISH, 
+       CLA
+       TAD     BO1
+       DCA     30
+       TAD     BO2
+       DCA     31
+       CAF
+       JMP     30
+
+/      HLT             / Normal good halt
+/        JMP START       / And restart if requested
+
+                       / REBOOT FROM RK05
+BO1,   6743
+BO2,   JMP     31      
+
+        *200
+START,  CDF 0
+        CAF
+        CLA CLL / OSR     / Get drive
+        AND (1
+        RTR
+        DCA DRVSEL
+        CLA CLL / OSR     / Get max field
+      /  RTR
+      /  RAR
+     /   AND (7
+       TAD (1 /PHPH
+        SNA
+        HLT             / Must have at least 1 field for buffer
+        CIA
+        DCA FIELDS
+        DCA ERRCN2
+RDSZLP, TAD BLKFLD      / Multiply by number of fields available
+        ISZ FIELDS
+        JMP RDSZLP
+        DCA RDSIZE      / NUMBER BLOCK PER READ
+        DCA CBLOCK
+        DCA CHKSM
+
+DUMPLP, CLA
+        TAD RDSIZE
+        TAD CBLOCK
+        CIA
+        TAD NUMBLK      / MORE BLOCKS LEFT THAN READSIZE?
+        SMA             / NO, READ NUMBER LEFT
+        CLA             / YES, ONLY READ RDSIZE
+        TAD RDSIZE
+        SNA             / ANY MORE BLOCKS?
+        JMP DONE        / NO, DO FINISH STUFF
+        DCA ARGSZ
+        TAD CBLOCK
+        DCA ARGBK
+        TAD DRVSEL
+        JMS DTA0
+        0010              / READ STARTING IN FIELD 1
+ARGSZ,  0
+        0
+ARGBK,  0
+        JMP ERRRET
+        TAD (377        / All blocks good
+        DCA READST
+                        / Send data, each block starts with FF
+        CLA CLL         / then 2 12 bit words in 3 bytes
+        DCA LOC         / ERRRET DUPLICATES SOME OF THIS
+        TAD ARGSZ
+        CIA
+        DCA BCNT        / Setup loop counter with number blocks read
+        CDF 10
+OUTBL1, JMS OUTBLK      / Send a block
+        ISZ CBLOCK
+        ISZ BCNT        / Send all read?
+        JMP OUTBL1      / No
+        CDF 0
+        JMP DUMPLP      / Go read next batch
+
+
+DONE,   CLA             / Send FE and -checksum of all words
+        TAD (376
+        JMS PUN
+        CLA CLL
+        TAD CHKSM       / Send checksum in two bytes, low bits first
+        CIA
+        JMS PUN
+        CLA CLL
+        TAD CHKSM
+        CIA
+        RTR
+        RTR
+        RTR
+        RTR
+        AND C17
+        JMS PUN
+        CLA
+        TAD DRVSEL
+        JMS DTA0        / REWIND TAPE
+        0010
+        1
+        0
+        0
+        NOP
+        TAD ERRCN2      / Leave AC with # of errors
+       JMP FINISH
+
+                        /SEND GOOD BLOCKS READ WITH GOOD BLOCK FLAG
+                        /THEN BAD WITH BAD BLOCK FLAG.
+ERRRET,
+/       HLT             / ****** If we want to stop on error
+        CDF 10
+        CLA CLL
+        DCA LOC
+        TAD CBLOCK
+        CIA
+        TAD BLOCK       /Get - number good blocks read
+        CIA             /Last was bad
+       SNA
+       JMP FSTBAD      /First block is bad, no good to send
+        DCA BCNT
+        TAD (377
+        DCA READST
+OUTBL2, JMS OUTBLK      /Send good blocks
+        ISZ CBLOCK
+        ISZ BCNT
+        JMP OUTBL2
+FSTBAD,        TAD (375        /NOW SEND BAD BLOCK
+        DCA READST
+        JMS OUTBLK
+        ISZ CBLOCK
+        ISZ ERRCN2
+        CDF 0
+        JMP DUMPLP      /And read from here on
+
+        PAGE
+OUTBLK, 0               /Send a block of data out serial port
+        CLA
+        TAD WCOUNT
+        DCA LEN
+        TAD READST      /Send good/bad flag
+        JMS PUN
+OUT,    CLA CLL
+        TAD I LOC
+        TAD CHKSM       / Keep checksum of all words sent
+        DCA CHKSM
+        TAD I LOC       / Send 2 words as 3 bytes
+        JMS PUN
+        CLA CLL
+        TAD I LOC
+        RTR             / Shift top 4 bits to low 4
+        RTR
+        RTR
+        RTR
+        AND C17
+        DCA TEMP
+        ISZ LOC
+        JMP STFLD3+1    /NOT AT END OF FIELD (DJG)
+        RDF             /At end, inc to next field
+        TAD (6211      /BUILD CDF
+        DCA STFLD3
+STFLD3, NOP
+       ISZ LEN         /END IF BUFFER?
+       SKP             /NO
+       JMP ENDBK       /YES
+        TAD I LOC
+        TAD CHKSM
+        DCA CHKSM
+        TAD I LOC
+        RTL
+        RTL
+        AND C360
+        TAD TEMP
+        JMS PUN
+        CLA CLL
+        TAD I LOC
+        RTR
+        RTR
+        JMS PUN
+        ISZ LOC
+        JMP STFLD4+1    /NOT AT END OF FIELD (DJG)
+        RDF
+        TAD (6211      /BUILD CDF
+        DCA STFLD4
+STFLD4, NOP
+        ISZ LEN
+        JMP OUT
+        JMP I OUTBLK
+ENDBK, TAD TEMP        /SEND LAST PART OF WORD
+       JMS PUN
+       JMP I OUTBLK
+
+PUN,    0               / Send byte out serial port
+/       PLS             / Punch for testing with emulator
+        TLS2            / Send out console
+        CLA CLL
+        TAD CBLOCK
+/       PSF
+        TSF2            /Wait until character sent
+        JMP .-1
+        CLA
+        JMP I PUN
+
+        $