A large commit.

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

/ TD8E Dectape RESTORE Program
/ This program will receive a DECtape image and write it to the tape.  The
/ tape is written, then it is reread to verify.
/
/ The program (PC) sending the data should be started before this program
/
/ See dump for the format of the serial data.
/ 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
/ Should halt at label FINISH (140) with AC = 0 if it worked, AC not equal to
/ zero indicates checksum on read didn't match that of data received
/ Hitting cont will restart the program if at normal end
/
/ Number of retries is set to 1 for reading and writing.
/
/ The current block being written to will be displayed in the AC
/ while serial data is transfering.
/
/ This program only will work with the resttd8e C program since it needs
/ to hanshake transfers to prevent overrun on the serial data.
/ The C program must be started first.
/
/ 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 RETRY
        DCA TRYCNT      /3 ERROR TRIES
        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       /SAVE LOC OF BLOCK START SO
        DCA OLDBUF      /CAN RETRY ON ERROR
        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             /RESET FIELD
        TAD OLDBUF      /RESET BACK TO START OF BLOCK
        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,  7776            / RETRY UP TO 1 TIME
NUMBLK, 2702            / NUMBER OF BLOCKS
MWORDS, -WDSBLK         / WORDS PER BLOCK
WCOUNT, 0
BLKFLD, 37              / BLOCKS PER FIELD, 31 MAX FOR 129 WORDS/BLOCK
                        / 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
TEMP,   0
C17,    17
C7400,  7400
CHKSM,  0
DONEFG, 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     / Get drive
        AND (1
        RTR
        DCA DRVSEL
        CLA CLL     / Get max field
	TAD (0010
        RTR
        RAR
        AND (7
        SNA
        HLT             / Must have at least 1 field for buffer
        CIA
        DCA FIELDS
RDSZLP, TAD BLKFLD      / Multiply by number of fields available
        ISZ FIELDS
        JMP RDSZLP
        DCA RDSIZE      / NUMBER BLOCK PER READ
        DCA CBLOCK
        DCA CHKSM
        DCA DONEFG

DUMPLP, CLA
        TAD DONEFG      / If all transfered do finish stuff
        SZA
        JMP DONE
        TAD RDSIZE      / Always ask for maximum number of blocks
        DCA ARGSZ       / Will accept less
        TAD CBLOCK      / The serial read routine uses these variables
        DCA ARGBK

        DCA LOC
        TAD ARGSZ
        JMS PUN         / ASK FOR UP TO THIS MANY BLOCKS
        TAD ARGSZ
        CIA
        DCA BCNT        / Our block counter
        CDF 10
INBL1,  JMS INBLK       / Get a block
        JMP GOTALL      / If Not last block
        TAD ARGSZ       / Is last block, calculate number received
        TAD BCNT
        SNA             / If no blocks transfered must be done flag
        JMP DONE        / Do finish processing
        DCA ARGSZ       / Else write data received
        IAC
        DCA DONEFG
        JMP WRTIT

GOTALL, ISZ CBLOCK      / Go get next block
        ISZ BCNT
        JMP INBL1
WRTIT,  CDF 0           / Got all, write them out
        TAD DRVSEL
        JMS DTA0
        4010            / ONLY EVEN # WORDS/BLOCK WORKS
ARGSZ,  0
        0
ARGBK,  0
        JMP ERRRET
        JMP DUMPLP      / Go get more

DONE,   CLA             / Send a character to get checksum
        CDF 0
        JMS PUN
        JMS GETCH
        DCA TEMP
        JMS GETCH       / Convert the 2 bytes to 12 bit word
        RTL             / Shift low 4 bits to top 4
        RTL
        RTL
        RTL
        AND C7400
        TAD TEMP
        DCA TEMP
        TAD TEMP
        TAD CHKSM
        SZA             / Checksum received is - sum so should be 0
        HLT             / Give up if not, serial error
                        / Do reread check
        TAD ARGSZ       / Get size of last block written for first
        DCA ARGSZ2      / to reread
        TAD CBLOCK      / And last block number
        DCA ARGBK2
        TAD TEMP        / Store checksum received in our checksum
        DCA CHKSM       / Should give 0 at end
RDCHK,  CLA
        TAD ARGSZ2      / Decrease block number by number of blocks to
        CIA             / Read so we read starting at first block
        TAD ARGBK2      / Read routine can't read backward
        DCA ARGBK2
        TAD DRVSEL
        JMS DTA0        / REREAD AND CHECK
        10            
ARGSZ2, 0
        0
ARGBK2, 0
        JMP RDERR
        TAD ARGSZ2      / Checksum over number of blocks read
        CIA
        DCA BCNT
        DCA LOC
        CDF 10
SUMIT,  JMS SUMBLK      / Sum each block
        ISZ BCNT
        JMP SUMIT
        CDF 0
        TAD RDSIZE      / Read full blocks for rest of read
        DCA ARGSZ2
        TAD ARGBK2      / If at block 0 then we are done
        SZA
        JMP RDCHK

        TAD CHKSM       / Leave AC with checksum, should be 0
        JMP FINISH

RDERR,  HLT
ERRRET, HLT

        PAGE
INBLK,  0               / Read a block of data from serial port
        CLA             / Read block size words
        TAD MWORDS
        DCA LEN
        JMS GETCH       / Get start of block flag
        CIA
        TAD (377
        SNA
        JMP IN
        TAD (-1         / Is it end of data flag?
        SZA
        HLT             / Not it, give up, we lost sync on serial data
        ISZ INBLK       / Return end of data state
        JMP I INBLK
IN,
        JMS GETCH       / Get 3 bytes and convert to 2 words
        DCA I LOC
        JMS GETCH
        DCA TEMP
        TAD TEMP
        RTL             / Shift low 4 bits to top 4
        RTL
        RTL
        RTL
        AND C7400
        TAD I LOC
        DCA I LOC
        TAD I LOC
        TAD CHKSM       /Keep checksum of all words received
        DCA CHKSM
        ISZ LOC
        JMP STFLD3+1    /NOT AT END OF FIELD (DJG)
        RDF             /At end, inc field
        TAD (6211
        DCA STFLD3
STFLD3, NOP
        ISZ LEN         /END IF BUFFER?
        SKP             /NO
        JMP I INBLK     /YES, DONE
        TAD TEMP
        RTR
        RTR
        AND C17
        DCA TEMP
        JMS GETCH
        RTL
        RTL
        TAD TEMP
        DCA I LOC
        TAD I LOC
        TAD CHKSM
        DCA CHKSM
        ISZ LOC
        JMP STFLD4+1    /Not at end of field
        RDF             /At end, inc field
        TAD (6211
        DCA STFLD4
STFLD4, NOP
        ISZ LEN
        JMP IN
        JMP I INBLK

SUMBLK, 0               / Sum a block of memory
        CLA
        TAD MWORDS
        DCA LEN
SUMLP,  TAD I LOC
        TAD CHKSM       / Keep checksum of all words
        DCA CHKSM
        ISZ LOC
        JMP STFLD5+1    /Not at end of field
        RDF             /At end, inc field
        TAD (6211
        DCA STFLD5
STFLD5, NOP
        ISZ LEN
        JMP SUMLP
        JMP I SUMBLK

PUN,    0               / Send a character
/       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

GETCH,  0               / Get a character
        CLA CLL
        TAD CBLOCK
/       RSF
        KSF2            / Have character waiting
        JMP .-1         / No, try again
/       RRB RFC
        KRB2            / Get character
        JMP I GETCH
        $