CP/M

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 | 58.6 KB | 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