home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
enterprs
/
c128
/
text
/
examples.arc
/
DA.A
< prev
next >
Wrap
Text File
|
1989-12-01
|
60KB
|
1,496 lines
;da.asm (C)1987 - Ampere Metal
;====================================================================
; ARCmodem download.Simultaneously downloads and dissolves an archive.
;====================================================================
stkptr = $0024 ;lz stack pointer
check = $0026 ;table entry to check
poker = $0016
ibuf = $0057 ;indirect pointer into RAM
fnlen = $00b7
la = $00b8
sa = $00b9
dv = $00ba
fnadr = $00bb
status = $0090
ndx = $00d0
pntr = $00ec
sclf = $00e6
scrt = $00e7
bpntr = $00fe ;buffer pointer save area (put y reg. here)
fn = $0100 ;where to put filename
keyd = $034a
txttop = $1210
basic = $4003
hexa = $b8c2
primm = $ff7d
open = $ffc0
close = $ffc3
chkin = $ffc6
chkout = $ffc9
clrchn = $ffcc
chrin = $ffcf
getin = $ffe4
chrout = $ffd2
settim = $ffdb ;set the software clock
rdtim = $ffde ;read the software clock
int01 = $1701
int04 = $1704
int05 = $1705
int09 = $1709
int0c = $170c
int0d = $170d
int0e = $170e
comout = $1306
comin = $1303
term = $1300 ;terminal main loop
flush = $1309 ;Flush RS232 recieve buffer
enable = $130c ;enable RS232
disabl = $130f ;disable RS232
ack = $06 ;ctrl - f
nak = $15 ;ctrl - u
can = $18 ;ctrl - x
cpm = $1a ;xmodem padding character
eot = $04 ;ctrl - d
soh = $01 ;ctrl - a
sstx = $02 ;ctrl - b
xon = $11
xoff = $13
syn = $16
star = $3000
.wor star
* = star
ldx #1 ;check for d:
jsr int04
bcs df
cmp #"a"
bcc df
cmp #"m"
bcs df
pha ;just save it for now
jsr int05
cmp #":" ;colon has got to be there
beq used ;its ok
pla
df jsr int01
pha
used pla
sta writdv
main lda #%00001110
sta $ff00
lda #0
sta xmoflg
sta bcount
sta ibyt
sta size+1
dec size+1
tsx
stx svstk
main0 jsr get1st ;get archive entry header
bcs skpad ;bad header...end of archive
jmp get1ok
skpad jsr xmo2 ;get padding or EOT
bcc skpad
jsr primm
.asc 13,13,"Transfer successfully completed.",13, 0
jmp abor
noteot jsr primm
.asc 13,"File is not an archive, or"
.asc " is corrupt.",13, 0
ccc lda #can
jsr comout
lda #can
jsr comout
lda #can
jsr comout
jsr clrchn
jsr primm
.asc 13,"Download aborted",13, 0
jmp abor
ex jsr primm
.asc "File Exists! ", 0
lda #$ff
sta exists
bmi g10
exists .byt 0
get1ok jsr open ;otherwise open the disk file
jsr int0c
sta exists
cmp #20
bcc g10
cmp #63
beq ex
jsr primm
.asc 13,"Error opening disk file...", 0
pds jsr int0c
jsr int0d
jmp ccc
g10 ldx #8 ;and setup CHROUT
jsr chkout
main1 jsr getnxt ;unsqueeze a byte
bcc mai1
jmp noteot ;error with huffman code...abort
mai1 bit arcst ;input past end?
bmi main2 ;yes..next file
bit exists
bmi main1
jsr chrout ;otherwise send to output
bit status
bpl main1
jsr clrchn
jsr primm
.asc 13,"Error writing to disk. ", 0
jmp pds
main2 jsr clrchn ;done with this file...close it
lda #8
jsr close
jmp skpah
skpahd jsr bytin
skpah lda bcount
bne skpahd
lda chkcrc ;check if checksum is ok
cmp crc
bne crcerr
lda chkcrc+1
cmp crc+1
bne crcerr
jsr primm
.asc "ok.", 0
jmp ggmain
crcerr jsr primm
.asc "Checksum error?", 0
ggmain jmp main0 ;next file
abor jsr clrchn ;exit...return to BASIC READY. prompt
lda #8
jsr close
lda #0
sta $ff00
ldx svstk
txs
jmp term
bcount .byt 0 ;position within CBM block
svstk .byt 0 ;save stack pointer from entry
;==============================================
; Read in archive header & initialize usq etc.
;==============================================
get1st ldx #cmsk-code ;zero a bunch of things
lda #0
g1st sta code,x
dex
bpl g1st
lda #0
sta ibit
lda writdv ; d: for filename
sta fn
lda #":"
sta fn+1
jsr bytin ;get version
cmp #2 ;must be 2
beq been ;abort if version isn't 2
eoa pla
pla
jmp skpad
been inx ;.x=0
newb1 jsr bytin ;get 1st part of header
sta sqtyp,x
inx
cpx #9
bne newb1
jsr prtyp
jsr bytin ;get fnlen
cmp #17 ;check for bad filename length
bcs eoa ;its bad ... eof
tax ;save length
clc
adc #4
sta fnlen ;save length (+4 for 0: and ,type)
lda #<unc
sta ucr+1
lda #<rl1
sta rlout+1
lda #>unc
sta ucr+2
lda #>rl1
sta rlout+2
ldy #0
lda #<fn ;setup filename pointer for OPEN
sta fnadr
lda #>fn
sta fnadr+1
gth2 jsr bytin ;continue getting filename
sta fn+2,y
jsr chrout
iny
dex
bne gth2
lda #34
jsr chrout
lda #"," ;tag on ,type
sta fn+2,y
iny
lda filtyp
sta fn+2,y
pha
tab18 lda #" "
jsr chrout
iny
cpy #18
bne tab18
pla
ldy #4
tb18 cmp spur,y
beq tb180
dey
bne tb18
tb180 lda spur,y
jsr chrout
lda spur+5,y
jsr chrout
lda spur+10,y
jsr chrout
lda #" "
jsr chrout
jsr h2a
lda #8 ;open 8,8,1
tax
ldy #1 ;sa=1 for write
sta la
stx dv
sty sa
jsr bytin ;ignore record length
jsr bytin ;and date
jsr bytin
nou jsr chkhdr ;abort to BASIC if error in header
bcc nuo
jmp eoa
spur .asc "?spur"
.asc "?erse"
.asc "?qgrl"
nuo ldy sqtyp
cpy #5 ;pass 1 crunch?
bne tpsq ;no
lda #$ff ;yes...make length non zero
sta len+2
tpsq cpy #2 ;squeezed file?
beq dousq ;yes-get encoding table
cpy #4 ;squeezed+packed?
beq dousq ;yes-get encoding table
cpy #1 ;packed?
bne gth8 ;no stored or crunched
jsr bytin ;packed...ignore control character (always $fe)
gth8 clc ;got header...return
rts
dousq ldy #0 ;get huffman encoding table
tya
gth3 sta c0,y ;zero huffman codes and lengths
sta c1,y
sta c2,y
sta l0,y
iny
bne gth3
tax
gth6 lda #0
sta tmp1
sta tmp1+1
sta tmp1+2
ldy #5
gth4 jsr bitin ;get 5 bits (code length)
ror a
dey
bne gth4
ror a ;right justify
ror a
ror a
sta ltmp ;save code length
cmp #25 ;code length > 24?
bcs badcd ;yes...bad encoding table
cmp #0 ;length=0?
beq gth7 ;yes then no code to get
tay
gth5 jsr bitin ;else get Huffman code
rol tmp
rol tmp+1
rol tmp+2
dey
bne gth5
tay
gth9 ror tmp+2 ;justify it
ror tmp+1
ror tmp
rol tmp1
rol tmp1+1
rol tmp1+2
dey
bne gth9
jsr sert ;insert in table (sorted on code length)
gth7 inx
bne gth6 ;and repeat 256 times
dec ncodsq
clc
badcd rts ;got header
;---------------------
; verify header is ok
;---------------------
abort sec
rts
chkhdr lda sqtyp ;must be 0-4
cmp #6
bcs abort
lda filtyp ;must be p,s, or u
cmp #"p"
beq chok
cmp #"s"
beq chok
cmp #"u"
bne abort
chok clc
rts
;----------------------------------------------------------------
; subroutine. add huffman code to table sorted by length of code
;----------------------------------------------------------------
sert stx srtx+1 ;save .x=ascii for this code
ldy #0
lda ltmp ;code length read from header
srt0 cpy ncodsq ;y=# of codes?
bne srt1 ;no-maybe insert it
srt00 sta l0,y ;else store it at end of table
lda tmp1 ;code
sta c0,y
lda tmp1+1
sta c1,y
lda tmp1+2
sta c2,y
inc ncodsq
srtx ldx #1
txa
sta g0,y ;save ascii
rts
srt1 cmp l0,y
bcc srt2 ;new code is smaller. insert it
iny
bne srt0 ;always
srt2 sty srt3+1
ldy #$fe
srt4 jsr srt8
dey
srt3 cpy #0
bne srt4
jsr srt8
lda ltmp
jmp srt00
srt8 lda l0,y
sta l0+1,y
lda g0,y
sta g0+1,y
lda c0,y
sta c0+1,y
lda c1,y
sta c1+1,y
lda c2,y
sta c2+1,y
rts
sqtxt .asc " stoR"
.asc " pacK"
.asc "squee", $da
.asc "cruncH"
.asc "squasH"
.asc "cruncH"
prtyp jsr primm
.asc 13,"Un-", 0
ldy #0
ldx sqtyp
pt1 dex
bmi pt9
pt0 lda sqtxt,y
bmi pt8
iny
bne pt0
pt8 iny
bne pt1
pt9 lda sqtxt,y
pha
and #$7f
jsr chrout
iny
pla
bpl pt9
jsr primm
.asc "ing ",34, 0
rts
;-----------------------------
; Unsqueeze a byte subroutine
;-----------------------------
; Use this routine to get one byte at a time from the archived file.
; The overflow flag, if set, indicates that there are no more bytes
; to get from this archive entry. The previous one was the last
; character of the squeezed file.
; The x and y registers are not affected by this routine
getnxt stx bast+1
sty basty+1
jsr dcln ;check for end of file
bit arcst
bmi bast0 ;eof...don't input past end
gxt ldx count ;on a run?
beq gnxt ;no
jsr rl33 ;yes - get repeated character
jmp usq89
gnxt ldx sqtyp ;what type of file?
beq usq88 ;stored..get byte
cpx #1
beq usq88 ;same if packed
cpx #5
beq crnch
cpx #3
bne sq
crnch jsr ucr ;uncrunch a byte
bcs bast0 ;end of file
ldx sqtyp
bcc usq80
sq jsr hufin ;else get huffman code
bcs bast ;error reading huffman code
bcc usq80
usq88 jsr bytin
usq80 cpx #0 ;was it stored?
beq usq89 ;yes then we've got a byte
cpx #2 ;was it squeezed?
beq usq89 ;yes then we've got a byte
jsr rlout ;otherwise it might need to be un-packed
usq89 jsr dcbo ;update checksum
bast0 clc
bast ldx #0
basty ldy #0
bit arcst
rts
dcln ldx len ;check for end of file
bne dl0
ldx len+1
bne dl1
ldx len+2
bne dl2
lda #$ff ;len is zero. flag eof
sta arcst
rts
dl2 dec len+2
dl1 dec len+1
dl0 dec len
rts
dcbo pha ;update checksum
inc crc2
eor crc2
clc
adc crc
sta crc
bcc dcbo1
inc crc+1
dcbo1 pla
rts
;----------------------------------
; run-length byte output for arc/x
;----------------------------------
rlout jmp rl1 ;changes
rl1 cmp #254 ;is it a control character?
beq contrl ;yes-get count,char
rts ;else send to output
contrl lda #<rl2 ;setup for count
sta rlout+1
lda #>rl2
sta rlout+2
gnx pla
pla
jmp gnxt
rl2 sta prev ;save count
lda #<rl3 ;and setup for char
sta rlout+1
lda #>rl3
sta rlout+2
jmp gnx
rl3 sty rl3y+1 ;save .y
ldy #<rl33
sty rlout+1
ldy #>rl33
sty rlout+2
ldy prev ;recall count
sty count
sta prev ;save char
rl33 dec count ;send char count times
beq rl3y ;last one. reset rlout
bne rl44
rl3y ldy #0
rl0 lda #<rl1 ;reset rlout
sta rlout+1
lda #>rl1
sta rlout+2
rl44 lda prev
rts
;----------------------------------------------
;read single byte from a file as a huffman code
;----------------------------------------------
hufin lda #0 ;reset length of code
sta clen
sta hfi1+1
sta coff
sta cmsk
inc cmsk
sta hcode
sta hcode+1
sta hcode+2
sty hfiy+1
stx hfix+1
hfilp jsr bitin ;get a bit
bcc zbit ;zero bit-just bump length
ldy coff ;else adjust code as well
lda cmsk
ora hcode,y
sta hcode,y
zbit asl cmsk ;adjust mask for next time
bcc zb2
rol cmsk
inc coff
zb2 inc clen ;check if code length >23
lda clen
cmp #24
bcc hfi1
nts sec ;code too long...bad file
jmp hfix
hfi1 ldy #0
hfi3 cmp l0,y ;check code length ok
beq hfi9 ;length the same check it
bcc hfilp ;less-get another bit
bcs nts ;length > ... must be an error
hfi9 ldx c0,y ;length ok. check if code is
cpx hcode
bne hfi2 ;no
ldx c1,y
cpx hcode+1
bne hfi2
ldx c2,y
cpx hcode+2
bne hfi2
lda g0,y ;got it
clc
hfix ldx #0
hfiy ldy #0
rts
hfi2 iny ;try again for this length
beq nts ;error.. no code
sty hfi1+1
cpy ncodsq
bcc hfi3
beq hfi3
jmp nts ;none-error
;-------
; bitin
;-------
bitin dec ibit
bpl bti1
pha
lda #7
sta ibit
jsr bytin
sta bite
pla
bti1 ror bite ;put bit in carry
rts
;-------
; bytin
;-------
bytin sty biy+1
stx bix+1
ldy ibyt ;offset into file
bne bi1 ;buffer is full
bit size+1
bpl bi1
bit xmoflg ;first time?
bmi xm1 ;no
dec xmoflg
jsr xmo1 ;start Xmodem going
jmp gotxmo
xm1 jsr xmo2 ;get subsequent blocks
gotxmo bcs xmoerr ;Xmodem error
lda #<buffer
sta bi1+1
lda #>buffer
sta bi1+2
lda size
sta size+1
ldy #0
bi1 lda buffer,y
iny
bpl dbc
pha
dec size+1
clc
lda bi1+1
adc #$80
sta bi1+1
bcc y0
inc bi1+2
y0 ldy #0
pla
dbc sty ibyt
inc bcount
ldy bcount
cpy #254
bne biy
ldy #0
sty bcount
biy ldy #0
bix ldx #0
rts
xmoerr pha
jsr clrchn
pla
asl a
asl a
asl a
asl a
tay
ldx #16
errlp lda errmsg,y
jsr chrout
iny
dex
bne errlp
cpy #16
bne gpl
lda #"e"
jsr chrout
gpl pla
pla
jmp abor
errmsg .asc "Transfer Complet"
.asc "Lost Synch. "
.asc "Remote Timed Out"
.asc "Remote Cancelled"
.asc "Too Many Errors "
;-------------------------
; lempel-zev decompressor
;-------------------------
ucr jmp unc ;first time in
unc jsr lzwrst ;reset string table
jsr resstk ;reset stack
jsr codein ;get 'code'
sta oldcod ;codein returns code in .a
sta kay ;first code is a byte
sta finchr
lda code+1 ;oldcod=code
sta oldcod+1
lda #<nxtcod
sta ucr+1
lda #>nxtcod
sta ucr+2
lda kay
clc
rts
nxtcod jsr codein ;next code
sec ;setup. test if code is defined (< ncodes)
sta incode ;incode=code
sbc ncodes
lda code+1
sta incode+1
sbc ncodes+1
bcc nxtsym ;carry clear. code was smaller.
lda finchr ;undefined code - special case.
sta kay
jsr push
lda oldcod
sta code
sta omega
lda oldcod+1
sta code+1
sta omega+1
lda ncodes
sta incode
lda ncodes+1
sta incode+1
nxtsym lda code+1 ;is it just a byte?
beq kaybyt ;yes-end of string
lda code ;else extension(code) to stack
sta poker
lda code+1
ora #>ext
sta poker+1
jsr peek
jsr push
lda poker+1 ;and code=prefix(code)
and #$0f
ora #>pfxlo
sta poker+1
jsr peek
sta code
lda poker+1
and #$0f
ora #>pfxhi
sta poker+1
jsr peek
sta code+1
bne nxtsym ;until just a byte
kaybyt lda #<eps
sta ucr+1
lda #>eps
sta ucr+2
lda code ;code is now only a single byte
sta kay
sta finchr
clc
rts
eps jsr pull ;get from top of stack
bcs sie ;stack is empty
rts
sie lda oldcod
sta omega
lda oldcod+1
sta omega+1
jsr lzadd ;add omega,kay to table
lda incode ;oldcode=incode
sta oldcod
lda incode+1
sta oldcod+1
jmp nxtcod
;--------------------------------------
; subroutine. get code from input file
;--------------------------------------
codein lda #0
sta code
ldy cdlen ;bit length of code
ci0 jsr bitin ;read in code bitwise
rol code
rol code+1
dey
bne ci0
lda code ;test eof
bne ci3 ;not 256
lda code+1
cmp #>256
bne ci3
pla ;else kill jsr & return to main loop
pla
lda #0
sta len
sta len+1
sta len+2
lda #$ff
sta arcst
lda sqtyp ;crunched in one pass?
cmp #5
bne nt5
ldy #16
gchk jsr bitin ;get checksum
rol chkcrc
rol chkcrc+1
dey
bne gchk
ldy #40
gchk2 jsr bitin ;ignore length,user
dey
bne gchk2
nt5 sec
rts
ci3 lda code ;and bump code length
jmp bcl
;------------------------------------------
; subroutine. push/pull char to/from stack
;------------------------------------------
push ldy #0
sta (stkptr),y ;stkptr must be initialized
inc stkptr
bne push0
inc stkptr+1
push0 rts
pull lda stkptr ;check for empty stack
cmp #<stack
bne pull0
lda stkptr+1
cmp #>stack
bne pull0 ;not empty
sec ;empty
rts
resstk lda #<stack ;reset stack
sta stkptr
lda #>stack
sta stkptr+1
rts
pull0 lda stkptr
bne pull1
dec stkptr+1
pull1 dec stkptr
ldx #0
lda (stkptr,x)
clc
rts
;-----------------------------------
; lempel zev table reset subroutine
;-----------------------------------
lzwrst lda #<258 ;set number of codes to 258
ldy #>258 ;(codes 256 and 257 are reserved)
sta ncodes
sty ncodes+1
;ldy #>256 ;256 of length 9 then 512 of length 10 etc.
sty wtcl1
lda #<254 ;first time only 254 due to reserved codes.
ldy #>254
sta wtcl
sty wtcl+1
lda #9 ;code length=9
sta cdlen
rts ;done
;-------------------------------------------
; lempel-zev add string to table subroutine
;-------------------------------------------
lzadd lda ncodes+1 ;don't add if table is full
cmp #$10
bcc lza1 ;its ok-add it
rts
lza1 sta poker+1 ;prefix(ncodes)=omega
lda ncodes
sta poker
ldy omega+1
lda #>pfxhi
jsr poke
ldy omega
lda #>pfxlo
jsr poke
ldy kay ;extension(ncodes)=kay
lda #>ext
jsr poke
lza3 inc ncodes ;and finally bump number of codes
bne lza4
inc ncodes+1
lza4 rts
poke sta pk1+1 ;store .y in table .a at offset in poker
lda #<poker
sta $02b9
lda poker+1
and #$0f
pk1 ora #0
sta poker+1
tya
ldy #0
ldx #1
jmp $ff77
;-------------------------------
; subroutines. get/put pointers
;-------------------------------
getexc lda check+1 ;get extension(check)
and #$0f
ora #>ext
sta poker+1
lda check
sta poker
peek ldy #0
lda #<poker
ldx #1
jmp $ff74
bcl pha
lda cdlen ;is code 12 bits?
cmp #12
bcs bclrt ;if so don't adjust length
lda wtcl ;else count down
bne bcl0
dec wtcl+1
bcl0 dec wtcl
lda wtcl
ora wtcl+1
bne bclrt
inc cdlen ;counted to zero. bump code length
asl wtcl1 ;and do twice as many next time
lda wtcl1
sta wtcl+1
bclrt pla
rts
;-------------------------------
;output a hex # in ascii decimal
;-------------------------------
; (3 byte number in 'len')
h2a lda len
pha
lda len+1
pha
lda len+2
pha
ldx #0 ;initialize indexes
ldy #0
sty h2atmp
loop lda #"0" ;initialize digit
sta ascii,x
loop2 sec
lda len
sbc table,y
pha ;increment the digit?
lda len+1
sbc table+1,y
pha
lda len+2
sbc table+2,y
bcc nxdigt ;branch if 'no'
sta len+2
pla
sta len+1
pla ;adjust the hex value
sta len ;and increment the digit
lda #$ff
sta h2atmp
inc ascii,x
bne loop2
nxdigt pla
pla
iny ;prepare for next digit
iny
iny
iny
inx
bit h2atmp
bmi nadj
lda #" "
sta ascii-1,x
nadj cpx #8
bcc loop
npr nop
ldy #0 ;prepare to send number
ldx #0
loop3 cpy #2
beq pcom
cpy #5
bne nocom
pcom lda ascii-1,y
cmp #" "
beq nocom
lda #","
ppcom pha
inx
nocom lda ascii,y
cmp #" "
beq skpsp
pha
inx
skpsp iny
cpy #8
bcc loop3
ldy #8
tp lda #" "
sta pasc,y
dey
bpl tp
ldy #8
stp pla
sta pasc,y
dey
dex
bne stp
jsr primm
pasc .asc "1,234,567 bytes. ", 0
pla
sta len+2
pla
sta len+1
pla
sta len
rts ;done, return
table .wor 38528, 152
.wor 16960, 15
.wor 34464, 1
.wor 10000, 0
.wor 1000, 0
.wor 100, 0
.wor 10, 0
.wor 1, 0
h2atmp .byt 0
;----------------------------------------------------------------------------
; Xmodem Routines for ARCmodem
;----------------------------------------------------------------------------
msg .byt 0 ;error return. 0=ok 1=lost sync 3=aborted 4=to many err
block .wor 0 ;expected block number
compl .wor 0 ;expected block complement
chk .wor 0 ;expected checksum or CRC
mychk .wor 0 ;calculated checksum or CRC
error .byt 0 ;error count
tries .byt 0 ;retry counter
cancan .byt 0 ;can counter
;---------------------------------------------------
; Initialize Xmodem download. Get the ball rolling.
;---------------------------------------------------
xmo1 ldy #1 ;block=buffer pointer=1
sty block
dey
sty error
sty mode ;mode. $ff=checksum 0=crc
jsr $130c ;turn on RS232
lda #"c" ;request CRC mode
jsr wait
bcc got1 ;got something. Go on
dec mode ;else revert to checksum mode
sendnk lda #nak ;send NAK and wait for start
jsr wait
bcc got1 ;got something
nrsp jsr primm ;else timeout
.asc 13,"No response from remote...aborting",13,0
jmp int0e
got1 pha
lda size
cmp #7
beq nt7
lda #"X"
.byt $2c
nt7 lda #"Y"
sta xmt+1
jsr primm
xmt .asc 13,"Xmodem transfer...", 0
bit mode
bmi ckmode
jsr primm
.asc "CRC mode.",13,0
jmp got11
ckmode jsr primm
.asc "Checksum mode.",13,0
got11 pla
cmp #soh
bne nrsp
ag ldx #1 ;got SOH. Get block and complement
jsr getcom
bcs short ;timeout
sta block+1
jsr getcom
bcs short
sta compl+1
ldy #0
sty mychk
sty mychk+1
lda #<buffer
sta stb+1
lda #>buffer
sta stb+2
lda size
sta size+1
rchar0 ldy #0
rchar jsr getcom
bcs short
stb sta buffer,y
bit mode
bmi updchk
jsr updcrc
jmp mr
updchk clc
adc mychk
sta mychk
mr iny
bpl rchar
dec size+1
bmi btg
clc
lda stb+1
adc #$80
sta stb+1
bcc rchar0
inc stb+2
jmp rchar0
btg jsr getcom ;get checksum
bit mode ;or is it CRC?
bmi short ;its checksum. Only one then
bcs short ;nothing there..short block
sta chk ;save CRC high
jsr getcom ;and get low
sta chk+1
lda chk
short bcs badblk ;short block
cmp chk ;checksum ok?
bne badblk ;no. retransmit
bit mode
bmi notcrc
lda chk+1
cmp mychk+1
bne badblk
notcrc lda block+1 ;block/complement ok?
clc
adc compl+1
cmp #$ff
beq next2 ;maybe
badblk inc error ;bump error count
lda error
cmp #11 ;and abort if too many
beq bad4
lda #nak ;else try again
gwait jsr wait
bcs bad2
cmp #soh
bne nag
jmp ag
nag cmp #can
beq bad3
lda #0 ;otherwise gotta be EOT
.byt $2c
bad1 lda #1 ;Error 1=lost synch
.byt $2c
bad2 lda #2 ;Error 2=time out
.byt $2c
bad3 lda #3 ;Error 3=cancel
.byt $2c
bad4 lda #4 ;Error 4=too many errors
sec
rts
next2 lda block+1 ;make sure block is correct one
cmp block
bne cant ;it is...use this block
clc
rts
cant ldx block ;is it the previous block?
dex
cpx block+1
beq blkerr ;yes. ACK musta got hit..re-ACK it
lda #can ;otherwise lost sync...gotta abort
jsr comout
jmp bad1
; Re-enter Xmodem
xmo2 inc block
lda #0
sta error
blkerr lda #ack ;re-ack block and try again
jmp gwait
xmoflg .byt 0 ;0=first, $ff=subsequent blocks
;---------------------------------------------------------------
; Subroutine: wait for char from RS232.
; .x=bcd number of seconds before timeout
; carry=0 if char is ok, or 1 if timeout has occured
;---------------------------------------------------------------
getcom lda $dc0b ;stop clock
lda #0 ;reset seconds
sta $dc09
sta $dc08 ;resumes clock
sty gcy+1
gc0 jsr comin ;get from RS232
bcc gcy ;got something. RTS
cpx $dc09 ;time out?
bne gc0 ;not yet. try again
gcy ldy #0 ;done
rts
;------------------------------------------------------
; Subroutine: wait for SOH, CAN-CAN or EOT
;------------------------------------------------------
; Carry = 1 if 3 second time out occurs (resend ACK)
; 0 if SOH was recieved
; Otherwise the transfer is aborted with CAN-CAN or EOT
wait sta acknak ;save ACK or NAK
wagin lda acknak ;send it
jsr comout
jsr flush
lda #2
sta tries
waitso ldx #1 ;reset can-can counter
stx cancan
wso0 ldx #3 ;wait 3 seconds for a response
jsr getcom
bcs tryagn ;timeout...try again maybe
cmp #can
beq wso1
cmp #eot
beq wso2
cmp #sstx
beq set7
cmp #soh
bne waitso ;ignore anything else
lda #0
.byt $2c
set7 lda #7
sta size
lda #soh
clc
rts
wso1 dec cancan ;was previous char a can?
bpl wso0 ;no
wso2 pha
lda #ack ;yes. ACK the CAN
jsr comout
pla
clc
rts
tryagn dec tries ;try up to 3 times
bpl wagin
lda #can ;tried 3 times...abort
jsr comout
sec
rts
;------------------------
; subroutine: Update CRC
;------------------------
updcrc pha ;save char
sty uc+1 ;save .y
eor mychk
tay
lda crclo,y
eor mychk+1
sta mychk
lda crchi,y
sta mychk+1
uc ldy #0
pla
rts
;CRC table. High bytes.
crchi .byt $00, $21, $42, $63, $84, $a5, $c6, $e7
.byt $08, $29, $4a, $6b, $8c, $ad, $ce, $ef
.byt $31, $10, $73, $52, $b5, $94, $f7, $d6
.byt $39, $18, $7b, $5a, $bd, $9c, $ff, $de
.byt $62, $43, $20, $01, $e6, $c7, $a4, $85
.byt $6a, $4b, $28, $09, $ee, $cf, $ac, $8d
.byt $53, $72, $11, $30, $d7, $f6, $95, $b4
.byt $5b, $7a, $19, $38, $df, $fe, $9d, $bc
.byt $c4, $e5, $86, $a7, $40, $61, $02, $23
.byt $cc, $ed, $8e, $af, $48, $69, $0a, $2b
.byt $f5, $d4, $b7, $96, $71, $50, $33, $12
.byt $fd, $dc, $bf, $9e, $79, $58, $3b, $1a
.byt $a6, $87, $e4, $c5, $22, $03, $60, $41
.byt $ae, $8f, $ec, $cd, $2a, $0b, $68, $49
.byt $97, $b6, $d5, $f4, $13, $32, $51, $70
.byt $9f, $be, $dd, $fc, $1b, $3a, $59, $78
.byt $88, $a9, $ca, $eb, $0c, $2d, $4e, $6f
.byt $80, $a1, $c2, $e3, $04, $25, $46, $67
.byt $b9, $98, $fb, $da, $3d, $1c, $7f, $5e
.byt $b1, $90, $f3, $d2, $35, $14, $77, $56
.byt $ea, $cb, $a8, $89, $6e, $4f, $2c, $0d
.byt $e2, $c3, $a0, $81, $66, $47, $24, $05
.byt $db, $fa, $99, $b8, $5f, $7e, $1d, $3c
.byt $d3, $f2, $91, $b0, $57, $76, $15, $34
.byt $4c, $6d, $0e, $2f, $c8, $e9, $8a, $ab
.byt $44, $65, $06, $27, $c0, $e1, $82, $a3
.byt $7d, $5c, $3f, $1e, $f9, $d8, $bb, $9a
.byt $75, $54, $37, $16, $f1, $d0, $b3, $92
.byt $2e, $0f, $6c, $4d, $aa, $8b, $e8, $c9
.byt $26, $07, $64, $45, $a2, $83, $e0, $c1
.byt $1f, $3e, $5d, $7c, $9b, $ba, $d9, $f8
.byt $17, $36, $55, $74, $93, $b2, $d1, $f0
;CRC table. Low bytes.
crclo .byt $00, $10, $20, $30, $40, $50, $60, $70
.byt $81, $91, $a1, $b1, $c1, $d1, $e1, $f1
.byt $12, $02, $32, $22, $52, $42, $72, $62
.byt $93, $83, $b3, $a3, $d3, $c3, $f3, $e3
.byt $24, $34, $04, $14, $64, $74, $44, $54
.byt $a5, $b5, $85, $95, $e5, $f5, $c5, $d5
.byt $36, $26, $16, $06, $76, $66, $56, $46
.byt $b7, $a7, $97, $87, $f7, $e7, $d7, $c7
.byt $48, $58, $68, $78, $08, $18, $28, $38
.byt $c9, $d9, $e9, $f9, $89, $99, $a9, $b9
.byt $5a, $4a, $7a, $6a, $1a, $0a, $3a, $2a
.byt $db, $cb, $fb, $eb, $9b, $8b, $bb, $ab
.byt $6c, $7c, $4c, $5c, $2c, $3c, $0c, $1c
.byt $ed, $fd, $cd, $dd, $ad, $bd, $8d, $9d
.byt $7e, $6e, $5e, $4e, $3e, $2e, $1e, $0e
.byt $ff, $ef, $df, $cf, $bf, $af, $9f, $8f
.byt $91, $81, $b1, $a1, $d1, $c1, $f1, $e1
.byt $10, $00, $30, $20, $50, $40, $70, $60
.byt $83, $93, $a3, $b3, $c3, $d3, $e3, $f3
.byt $02, $12, $22, $32, $42, $52, $62, $72
.byt $b5, $a5, $95, $85, $f5, $e5, $d5, $c5
.byt $34, $24, $14, $04, $74, $64, $54, $44
.byt $a7, $b7, $87, $97, $e7, $f7, $c7, $d7
.byt $26, $36, $06, $16, $66, $76, $46, $56
.byt $d9, $c9, $f9, $e9, $99, $89, $b9, $a9
.byt $58, $48, $78, $68, $18, $08, $38, $28
.byt $cb, $db, $eb, $fb, $8b, $9b, $ab, $bb
.byt $4a, $5a, $6a, $7a, $0a, $1a, $2a, $3a
.byt $fd, $ed, $dd, $cd, $bd, $ad, $9d, $8d
.byt $7c, $6c, $5c, $4c, $3c, $2c, $1c, $0c
.byt $ef, $ff, $cf, $df, $af, $bf, $8f, $9f
.byt $6e, $7e, $4e, $5e, $2e, $3e, $0e, $1e
;====================================
; Data tables for ARC modem download
;====================================
; These bytes get set to zero at each entry header
code *=*+2 ;input code
oldcod *=*+2 ;previous code
finchr *=*+1
incode *=*+2 ;2 bytes
wtcl *=*+2 ;2 bytes ... when to change code length
ncodes *=*+2 ;2 bytes ... number of codes in string table
wtcl1 *=*+1 ;copy of wtcl+1
cdlen *=*+1 ;length of lzw code in bits
omega *=*+2 ;temp ... current prefix
kay *=*+1 ;temp ... current extension
sqtyp *=*+1 ;0=store 1=pack 2=squeeze 3,5=crunch 4=squash
chkcrc *=*+2 ;checksum read from archive
len *=*+3 ;unsqueezed length in bytes (lo-high)
sqb *=*+2 ;squeezed length in 254 byte blocks
filtyp *=*+1 ;file type (p,s,u or r)
crc *=*+2 ;new calculated checksum
hcode *=*+3 ;huffman code
ncodsq *=*+1 ;number of huffman codes
tmp1 *=*+3 ;temp for hufin
tmp *=*+3 ;temp
ibit *=*+1 ;input bit
ibytx *=*+1 ;input byte
arcst *=*+1 ;eof flag
count *=*+1 ;run length coding count
crc2 *=*+1 ;temp
coff *=*+1 ;bit offset
prev *=*+1 ;rl char for output
clen *=*+1 ;hufman code length
bite *=*+1 ;bitin buffer
ltmp *=*+1
cmsk *=*+1
fnl *=*+7
ftyp *=*+1
ldad *=*+2
prtflg *=*+1
hex *=*+3 ;misc for 'dodir'
sqqb *=*+2
ascii *=*+8
*=*+2
hexx *=*+2
*=*+1
delta *=*+2
width *=*+1
acknak *=*+1
ibyt *=*+1
mode *=*+1 ;xmodem 0=CRC $ff=Checksum
writdv *=*+1 ;save destination drive
size *=*+2 ;packet size 0 or 7
* = $4000
; Lempel Zev Decompressor tables
pfxlo *=*+4096 ;lempel-zev lo byte of prefix
pfxhi *=*+4096 ;lempel-zev hi byte of prefix
ext *=*+4096 ;lempel-zev extension
;USQ stuff
l0 *=*+256
c0 *=*+256
c1 *=*+256
c2 *=*+256
g0 *=*+256
buffer *=*+1024
stack *=*+256 ;lz decompressor stack
.end
