File: DMPTD8.PA of Disk: Disks/Build-2007/Make-11-03-07
(Source file text)
/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.
/ Like this: (WvdM)
/ +--------------------+
/ ! byte1 ! byte2h !
/ +--------------------+
/ ! byte2l ! byte 3 !
/ +--------------------+
/
/ 1 = low 8 bits first word (was like this WvdM)
/ 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=030 / 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=040 / 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.
/
/
/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.
/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
/ 129 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
/ 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
/
/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 /AC ON ENTRY=4000 IS UNIT 1
/ ARG1
/ ARG2
/ ARG3
/ ARG4
/ ERROR RETURN
/ NORMAL RETURN
/THE ARGUMENTS ARE:
/ARG1: FUNCTION WORD BIT0: 0=READ, 1=WRITE
/ BITS 1-5: UNUSED, WAS # BLOCKS IN OPERATION
/ 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
/ARG2: # OF BLOCKS IN OPERATION
/ARG3: BUFFER ADDRESS FOR OPERATION
/ARG4: 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 WCT /STORE MASTER WORD COUNT
ISZ DTA0 /TO BLOCK COUNT
TAD I DTA0
CIA
DCA PGCT
ISZ DTA0 /TO BUFFER
TAD I DTA0
DCA BUFF /SAVE ADDRESS
ISZ DTA0 /TO BLOCK NUMBER
TAD I DTA0
DCA BLOCK /INITIAL BLOCK
ISZ DTA0 /POINT TO ERROR EXIT
CIF CDF MFIELD /TO ROUTINES DATA FIELD
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 /WAIT FOR SLOW SELECT
TAD RETRY
DCA TRYCNT /3 ERROR TRIES
SDRC
AND C100
SZA CLA
JMP FATAL-1
SDRD /PUT FUNCT INTO PG 0
DCA FUNCT
SDRD /GET INITIAL MOTION BIT TO LINK
CLL RAR
XFIELD, HLT /SET DATA FIELD FOR NEXT PAGE
JMP GO /AND START THE MOTION.
RWCOM, SDST /ANY CHECKSUM ERRORS?
SZA /OR CHECKSUM ERRORS?
JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS
/SET AT RWCOM. GETCHK SETS IT.
DCA CHKFTL /CLEAR LAST CHECKSUM ERROR
ISZ PGCT /ALL REQUESTED PAGES DONE?
SKP / (DJG)
JMP EXIT /ALL DONE. GET OUT
ISZ BLOCK /NEXT BLOCK TO XFER
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 BUFF
DCA OLDBUF /SAVE BUFFER ADDR FOR ERROR RETRY
RDF
TAD C6201
DCA OLDFLD
JMS RDQUAD /WAIT AT LEAST 6 LINES TO LOOK
JMS RDQUAD
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 10
/BLOCKS BEFORE TARGET BLOCK. THIS
/ALLOWS TURNAROUND AND UP TO SPEED.
TAD C10 /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?
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
FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION?
JMP GO /WRONG..TURN AROUND
JMP I CXGO /OK GO READ/WRITE
TRY3, BSW
DCA CHKFTL /KEEP LAST CHECKSUM ERROR
OLDFLD, NOP
TAD OLDBUF
DCA BUFF
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
TAD CHKFTL
LEAVE, HLT /GETS CIF CDF RETURN
JMP I DTA0
RDQUAD, 0 /READ A 12 BIT WORD
SDSQ
JMP .-1
SDRD /READ DATA
JMP I RDQUAD
CXGO, GOON /HERE WE REALLY GO
PGCT, 0 /TOTAL PAGES TO TRANSFER
TRYCNT, -3 /COUNTER FOR TRIES
*ORIGIN+200
GOON, CIF MFIELD
SDRC
SDLC
REVGRD, SDSS
JMP .-1 /LOOK FOR REVERSE GUARD
SDRC
AND K77
TAD M32 /IS IT REVERSE GUARD?
SZA CLA
JMP REVGRD /NO.KEEP LOOKING
TAD WCT
DCA WORDS /WORD COUNTER
TAD FUNCT /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 I XQUAD /NO ONE EVER USES THIS WORD!
C7600, 7600
TAD C1400
TAD UNIT /INITIATE WRITE MODE
SDLC
CLA CMA
JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM
CLA CMA
DCA CHKSUM
WRLP, TAD I BUFF /GLORY BE! THE ACTUAL WRITE!
JMS WRQUAD
ISZ BUFF /BUMP CORE POINTER
TAD BUFF
TAD C200
SZA CLA /ARE WE AT OS/8 BOUNDARY?
JMP STFLD1+1 /NOT AT END OF FIELD (DJG)
DCA BUFF /OK, TO NEXT FIELD
RDF
TAD C6211
DCA STFLD1
STFLD1, NOP
ISZ WORDS /DONE THIS BLOCK?
JMP WRLP /NOT YET..LOOP A WHILE
TAD FUNCT /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)
READ, JMS I XQUAD
JMS I XQUAD
JMS I XQUAD /SKIP CONTROL WORDS
AND K77
TAD K7700 /TACK 7700 ONTO CHECKSUM.
DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY
RDLP, JMS I XQUAD
JMS EQUFUN /COMPUT CHECKSUM AS WE GO
DCA I BUFF /IT GETS CONDENSED LATER
TAD I BUFF /CHECK FOR MEMORY ERRORS
TAD EQUTMP
IAC
SZA CLA
JMP MEMERR
ISZ BUFF /AT END OF FIELD?
TAD BUFF
TAD C200
SZA CLA /ARE WE AT OS/8 BOUNDARY?
JMP STFLD2+1 /NOT AT END OF FIELD (DJG)
DCA BUFF /OK, TO NEXT FIELD
RDF
TAD C6211
DCA STFLD2
STFLD2, NOP
ISZ WORDS /DONE THIS OP?
JMP RDLP /NO SUCH LUCK
TAD FUNCT /IF OP WAS FOR WDSBLK-1, READ AND
CLL RTR /CHECKSUM THE LAST TAPE WORD
SNL CLA
JMP RDLP2
JMS I XQUAD /NOT NEEDED FOR WDSBLK/BLOCK
JMS EQUFUN /CHECKSUM IT
RDLP2, JMS I XQUAD /READ CHECKSUM
AND K7700
JMS EQUFUN
JMS GETCHK /GET SIX BIT CHECKSUM
JMP I CRWCOM
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
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
XQUAD, RDQUAD
CFATAL, FATAL
CRWCOM, RWCOM /BLOCK DONE, BACK TO FIRST PAGE
WORDS, 0
*100
RETRY, 7775 /RETRY UP TO 3 TIMES
NUMBLK, 2702 /TOTAL NUMBER OF BLOCKS ON DECTAPE
MWORDS, -WDSBLK /WORDS PER BLOCK FOR SETUP
BLKFLD, 36 /30 129 WORD BLOCKS PRESERVES OS8
/WRAPPING PAST END OF LAST FIELD DOESN'T WORK
DRVSEL, 0 /SELECTED DRIVE
FIELDS, 0 /MINUS NUMBER OF FIELDS TO USE
ERRCN2, 0 /COUNTING ERRORS
RDSIZE, 0 /NUMBER BLOCKS PER READ
CBLOCK, 0 /CURRENT DECTAPE BLOCK TO XFER
CHKSM, 0
READST, 0
LOC, 0
LEN, 0
BCNT, 0 /BLOCKS TO SEND TO PC
REASON, 0
TEMP, 0
C10, 10
C17, 17
C70, 70
C100, 100
C200, 200
C300, 300
C360, 360
C1000, 1000
C1400, 1400
C6201, 6201
C6203, 6203
C6211, 6211
M20, -20
M32, -32
OLDBUF, 0 /USED BY DTA0 ROUTINE - RETRY BUFFER
BUFF, 0 /USED BY DTA0 ROUTINE
C374, 374 /USED BY DTA0 ROUTINE
BLOCK, 0 /USED BY DTA0 ROUTINE
WCT, 0 /USED BY DTA0 ROUTINE - MASTER WORDCOUNT
FUNCT, 0 /USED BY DTA0 ROUTINE - FUNCTION
EQUTMP, 0 /USED BY DTA0 ROUTINE
CHKSUM, 0 /USED BY DTA0 ROUTINE
UNIT, 0 /USED BY DTA0 ROUTINE
CHKFTL, 0 /USED BY DTA0 ROUTINE
*176
MEMERR, RDF /SIGNAL MEMORY ERROR!!!
FINISH, HLT /NORMAL GOOD HALT OR SELERR
START, CDF 0
CAF
CLA CLL OSR /GET DRIVE
AND (1
RTR
DCA DRVSEL
CLA CLL OSR /GET MAX FIELD TO USE
RTR
RAR
AND (7
SNA
HLT /MUST HAVE AT LEAST 1 FIELD FOR BUFFER
CIA
DCA FIELDS
DCA ERRCN2
RDSZLP, TAD BLKFLD /MULTIPLY BY NUMER OF FIELDS AVAILABLE
ISZ FIELDS
JMP RDSZLP
DCA RDSIZE /TOTAL NUMBER OF BLOCKS IN ONE GO = BATCH
DCA CBLOCK /START WITH BLOCK 0
DCA CHKSM
DUMPLP, CLA
TAD RDSIZE
TAD CBLOCK /(TOTAL - BATCH) - CURRENT
CIA
TAD NUMBLK /MORE BLOCKS LEFT THAN BATCH?
SMA /NO, NUMBER OF BLOCKS LEFT
CLA /YES, ONLY BATCH SIZE
TAD RDSIZE
SNA /ANY MORE BLOCKS?
JMP DONE /NO, DO FINISH STUFF
DCA ARGSZ /TO NUMBER OF BLOCKS REQUEST
TAD CBLOCK /TO CURRENT BLOCK TO START WITH
DCA ARGBK
TAD DRVSEL
JMS I (DTA0
0010 /READ STARTING IN FIELD 1
ARGSZ, 0
0
ARGBK, 0
JMP ERRRET /SOME DUST ON THE TAPE?
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 /SET UP COUNTER OF NUMBER OF BLOCKS XFERRED
CDF 10 /START IN FIELD 1
OUTBL1, JMS I (OUTBLK /SEND A BLOCK
ISZ CBLOCK /NEXT BLOCK
ISZ BCNT /BATCH XFERRED?
JMP OUTBL1 /NO
CDF 0
JMP DUMPLP /GO READ NEXT BATCH
DONE, CLA / Send FE and -checksum of all words
TAD (376
JMS I (PUN
TAD CHKSM / Send checksum in two bytes, low bits first
CIA
JMS I (PUN
TAD CHKSM
CIA
RTR
RTR
RTR
RTR
AND C17
JMS I (PUN
TAD DRVSEL
JMS I (DTA0 / REWIND TAPE
0010
1
0
0
NOP
TAD ERRCN2 / Leave AC with # of errors
JMP FINISH
ERRRET, SZA
JMP NOSEL
CLA CMA
JMP FINISH /SELECT ERROR WITH AC = 7777
NOSEL, DCA REASON /ERROR CODE
CDF 10 /SEND GOOD BLOCKS READ WITH GOOD BLOCK FLAG
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 I (OUTBLK /Send good blocks
ISZ CBLOCK
ISZ BCNT
JMP OUTBL2
FSTBAD, TAD REASON
RAL
SZA CLA /WAS IT CHECKSUM ERROR?
CLA CMA /SEND 374 FOR CHECKSUM ERROR
TAD (375 /NOW SEND BAD BLOCK (TIMING ERROR)
DCA READST
JMS I (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 WCT
DCA LEN /COUNT FOR ONE BLOCK
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
CLL RTR / WvdM: Left 8 Bits first
RTR / WvdM:
JMS PUN
CLA CLL
TAD I LOC
AND C17
CLL RTL / WvdM: Low 4 Bits to high byte 2
RTL / WvdM
DCA TEMP
ISZ LOC
TAD LOC
TAD C200
SZA CLA /ARE WE AT OS/8 BOUNDARY?
JMP STFLD3+1 /NOT AT END OF FIELD (DJG)
DCA LOC /OK, TO NEXT FIELD
RDF /
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
CLL RTL
RTL
RAL / New: High 4 bits to low byte 2
AND C17 / (WvdM) was AND C360
TAD TEMP
JMS PUN
CLA CLL
TAD I LOC
JMS PUN
ISZ LOC
TAD LOC
TAD C200
SZA CLA /ARE WE AT OS/8 BOUNDARY?
JMP STFLD4+1 /NOT AT END OF FIELD (DJG)
DCA LOC /OK, TO NEXT FIELD
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
$