A large commit.

[pdp8.git] / sw / dumprest / hachti_std / READTD.PA

/ 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

        $