       NAM RDR 1.B
*LOADERFOR MOTOROLA FORMAT HEX TAPE
*USING DIGITRONICS 2500 READER.
*20    NOV 1975  D L KAUFMAN
        ORG $1E00
        OPT O

BASE   EQU $ACF8

PIACR1 EQU BASE+1
PIACR2 EQU BASE+3
PIADRA EQU BASE  *DATA DIR REG A  DATA CHAN.
PIADRB EQU BASE+2 *DATA DIR REG B
******************STROBEPB7,RDR RUN PB0

INIT   CLR A
        STA A PIACR1
        STA A PIACR2
        STA A PIADRA
        STA A HDFLG
        STA A FLG1
        LDS #$1FFF
        LDA A #$01
        STA A PIADRB
        LDA A #$34         *CR1 OUTPUT DATA REG SELECTED
        STA A PIACR1
        STA A PIACR2
        JSR CRLF
CHAR1  JSR GTCHR

*HEAD  OF BLOCK DISPATCH  ACC B HAS A
*CHAR  NON NUL/RUBOUT NON DEVICE CONTROL
*
HEAD   CMP B #'S
        BEQ STRTC
        CMP B #$0D    *CAR RET
        BEQ RTN
        CMP B #$0A    *LF
        BEQ RTN
        JSR FAULT     *NOT BLOCK START

RTN    JSR GTCHR
        BRA HEAD

STRTC  JSR GTCHR      *GET RECORD TYPE CHAR
        CMP B #'0
        BEQ HDR
        CMP B #'1
        BEQ DATAR
        CMP B #'9
        BEQ EOFR
        JSR FAULT         *UNKNOWN RECORD TYPE

         SPC 2
*HEADERRECORD

HDFLG  FCB $00
HDR    INC HDFLG
        JSR BYTEC
        JSR SIZE
HDR1   JSR RDFRA
        TST BYTE
        BEQ HDR2
        JSR TYPBYT
        BRA HDR1
HDR2   JMP CHAR1   *GET A NEW BLOCK

*EOF   RECORD

EOFR   CLR HDFLG
        JSR BYTEC
        JSR SIZE
        JSR RDFRA
        JMP QUIT

        SPC 2
*DATA  RECORD BLOCK

DATAR  TST HDFLG
        BEQ DATAR2
        JSR BYTEC
        JSR SIZE
DATAR1 JSR RDFRA
        TST BYTE
        BEQ DATEND
        STA B 0,X
        INX
        BRA DATAR1

DATAR2 BSR FAULT  *NEVER SAW START BLOCK

DATEND JMP CHAR1

*HALT  PROGRAM
QUIT   LDA B #$07
        BSR CRLF
        BRA FL
FAULT  LDA B #'?
FL      JSR TYPBYT
        BRA *

       SPC 2

*TYPE  CHAR IN B ON TTY
*PRESERVESA AND B
TYPBYT PSH B
TYPB1   LDA B $FCF4
        BIT B #$02
        BEQ TYPB1
        PUL B
        STA B $FCF5
        RTS

*CARRIAGERETURN LINE FEED
CRLF   PSH B
        LDA B #$0D
        BSR TYPBYT
        LDA B #$0A
        BSR TYPBYT
        PUL B
        RTS

*STORE BYTE COUNT  IN BYTE, INITIALIZE
*      PARTSU AND  CHECKSUM

BYTEC  CLR PARTSU
        CLR CKSUM
        JSR GTCHR
        JSR ASCBIN
        JSR GTCHR
        JSR ASCBIN
        STA B BYTE
        RTS
PARTSU RMB $1
CKSUM  RMB $1
BYTE   RMB $1

       SPC 2
*CONVERTASCII HEX  7BIT CHAR
*IN    ACC B TO BINARY IN B AND PARTSU
*ADD   TO CKSUM
ASCBIN CMP B #$30
        BLT FAULT
        CMP B #$40
        BLT ASC1
        CMP B #$47
        BGE FAULT
        ADD B #$09
ASC1   AND B #$0F
        TST FLG1
        BNE ASC2
        INC FLG1
        ASL B
        ASL B
        ASL B
        ASL B
        STA B PARTSU
        RTS

ASC2    ADD B PARTSU
        STA B PARTSU
        ADD B CKSUM
        STA B CKSUM
        LDA B PARTSU
        CLR FLG1
        RTS
FLG1   RMB $1   *2ND FRAME FLAG

       SPC 2
*STORE ADDRESS SIZE IN INDEX REG
*AND   SIZREG,SIZREG+1
SIZE   JSR RDFRA
        STA B SIZREG
        JSR RDFRA
        STA B SIZREG+1
        LDX SIZREG
        RTS

SIZREG RMB $2
*READ  A 2 CHAR FRAME FROM TAPE
*UPDATEBYTE COUNT & CHECKSUM
RDFRA  JSR GTCHR
        JSR ASCBIN
        JSR GTCHR
RDF11   JSR ASCBIN
        DEC BYTE
        BEQ CHEKSM   *LAST BYTE
RDFR1   RTS          *NOT LAST

CHEKSM INC CKSUM
        BNE CKER
        RTS
CKER    JSR FAULT     *PARITY ERROR

       SPC 2

*GET   ONE CHAR FROM TAPE TO ACC B
*IGNORENULLS AND RUBOUTS
*AND   XON ,XOFF,PUNON,PUNOFF
GTCHR  INC PIADRB
GTCH0    LDA A PIADRB
        BMI GTCH0       *LOOP TO FEED SPACE
GTCH1  LDA A PIADRB
        BPL GTCH1     *LOOP TIL FEED HOLE
        DEC PIADRB    *STOP READER
        LDA B PIADRA
        COM B
        AND B #$7F   *DROP PARITY
        BEQ ENDCH    *NULL TRY NEXT
        CMP B #$7F
        BEQ ENDCH    *RUBOUT
        CMP B #$11   *XON
        BEQ ENDCH
        CMP B #$12    *PUNON
        BEQ ENDCH
        CMP B #$13    *XOFF
        BEQ ENDCH
        CMP B #$14    *PUNOFF
        BEQ ENDCH
DONE    RTS
ENDCH   BRA GTCHR    *TRY FOR NEXT CHAR
PATCH  RMB 1
STAK   EQU $1FFF-PATCH
        END
