home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / c128 / archivers / sda128.sda / SDA230.SDA / SDA.ASM < prev    next >
Assembly Source File  |  1993-03-31  |  14KB  |  648 lines
  1. ;sda.asm                                       (C)1987 - Ampere Metal
  2. ;====================================================================
  3. ;
  4. cbm    = 4032         ;64,128 or 4032
  5. ;
  6. ; kernel equates
  7. ;
  8.   .ifn cbm-4032 <     ;if not PET
  9. ;
  10. ;         C=64         C=128   PET (basic 4.0)
  11. ;        -----         -----  -----
  12. fnlen  = $00b7        ;        00d1
  13. la     = $00b8        ;        00d2
  14. sa     = $00b9        ;        00d3
  15. dv     = $00ba        ;        00d4
  16. fnadr  = $00bb        ;        00da
  17. status = $0090        ;        0096
  18. open   = $ffc0        ;        F563
  19. close  = $ffc3        ;        F2E2
  20. l0     = $fa00        ;huffman code lengths   ($7b00 for PET)
  21. c0     = $fb00        ;huffman codes
  22. c1     = $fc00        ;huffman codes
  23. c2     = $fd00        ;huffman codes
  24. g0     = $fe00        ;ascii for huffman code
  25. >
  26. chkin  = $ffc6
  27. chkout = $ffc9
  28. clrchn = $ffcc
  29. chrin  = $ffcf
  30. chrout = $ffd2
  31. ibuf   = $00fd        ;indirect pointer into RAM
  32. fn     = $0100        ;where to put filename
  33. ;
  34.   .ife cbm-128 <
  35. ;
  36. ndx    = $00d0
  37. keyd   = $034a
  38. basic  = $4003
  39. star   = $1c01
  40. >
  41.   .ife cbm-64 <
  42. ;
  43. ndx    = $00c6
  44. keyd   = $0277
  45. basic  = $e37b
  46. star   = $0801
  47. >
  48.   .ife cbm-4032 <
  49. ;
  50. status = $0096
  51. fnlen  = $00d1
  52. fnadr  = $00da
  53. la     = $00d2
  54. sa     = $00d3
  55. dv     = $00d4
  56. open   = $f563
  57. close  = $f2e2
  58. ndx    = $009e
  59. keyd   = $026f
  60. basic  = $b3ff
  61. l0     = $7b00        ;huffman code lengths   ($7b00 for PET)
  62. c0     = $7c00        ;huffman codes
  63. c1     = $7d00        ;huffman codes
  64. c2     = $7e00        ;huffman codes
  65. g0     = $7f00        ;ascii for huffman code
  66. star   = $0401
  67. >
  68. ;
  69.   * = $0200
  70. ;
  71. sqtyp    *=*+1        ;0=store 1=pack 2=squeeze 3,5=crunch 4=squash
  72. chkcrc   *=*+2        ;checksum read from archive
  73. len      *=*+3        ;unsqueezed length in bytes (lo-high)
  74. sqb      *=*+2        ;squeezed length in 254 byte blocks
  75. filtyp   *=*+1        ;file type (p,s,u or r)
  76. crc      *=*+2        ;new calculated checksum
  77. hcode    *=*+3        ;huffman code
  78. ncodsq   *=*+1        ;number of huffman codes
  79. tmp1     *=*+3        ;temp for hufin
  80. tmp      *=*+3        ;temp
  81. ibit     *=*+1        ;input bit
  82. ibyt     *=*+1        ;input byte
  83. arcst    *=*+1        ;eof flag
  84. count    *=*+1        ;run length coding count
  85. crc2     *=*+1        ;temp
  86. coff     *=*+1        ;bit offset
  87. prev     *=*+1        ;rl char for output
  88. clen     *=*+1        ;hufman code length
  89. prtflg   *=*+1        ;flag output to screen or disk
  90. bite     *=*+1        ;bitin buffer
  91. ltmp     *=*+1
  92. cmsk     *=*+1
  93. ;
  94.   .wor star
  95.    * = star
  96. ;
  97.  .wor there, 10
  98.  .byt $9e
  99. ;
  100.  .ife cbm-64 <
  101.  .asc "(2063)", 0
  102. >
  103.  .ife cbm-4032 <
  104.  .asc "(1039)", 0
  105. >
  106.  .ife cbm-128 <
  107.  .asc "(7183)", 0
  108. >
  109. there .wor 0
  110. ;
  111. main lda #<eof        ;initialize buffer pointer
  112.  sta ibuf
  113.  lda #>eof
  114.  sta ibuf+1
  115.  lda #0               ;flag. 0=type this file, $ff=extract to disk
  116.  sta prtflg
  117. ;
  118. main0 jsr get1st      ;get archive entry header
  119.  bcs abor             ;error reading header
  120.  bit prtflg           ;first file?
  121.  bpl main1            ;yes..type it
  122.  jsr open             ;otherwise open the disk file
  123.  bit status           ;abort if device not present or disk error
  124.  bmi abor
  125.  ldx #8               ;and setup CHROUT
  126.  jsr chkout
  127. main1 jsr getnxt      ;unsqueeze a byte
  128.  bcs abor             ;error with huffman code...abort
  129.  bit arcst            ;input past end?
  130.  bmi main2            ;yes..next file
  131.  jsr chrout           ;otherwise send to output
  132.  bit status
  133.  bmi abor
  134.  jmp main1            ;next byte
  135. ;
  136. main2 jsr clrchn      ;done with this file...close it
  137.  lda #8
  138.  jsr close
  139.  bit prtflg           ;first file?
  140.  bmi main3            ;no
  141.  lda #0               ;yes...wait for key
  142.  sta ndx
  143. wait lda ndx
  144.  beq wait
  145.  lda keyd
  146.  cmp #3               ;abort if RUN/STOP
  147.  beq abor
  148. main3 lda #254
  149.  sta ibyt             ;force bytin to get new block
  150.  sta prtflg           ;and start sending to disk instead of screen
  151.  jsr bytin            ;adjusts buffer pointer
  152.  lda chkcrc           ;check if checksum is ok
  153.  cmp crc
  154.  bne crcerr
  155.  lda chkcrc+1
  156.  cmp crc+1
  157.  bne crcerr
  158.  lda #"o"
  159.  jsr chrout
  160.  lda #"k"
  161.  .byt $2c
  162. crcerr lda #"?"
  163.  jsr chrout
  164.  jmp main0            ;next file
  165. ;
  166. abor jsr clrchn       ;exit...return to BASIC READY. prompt
  167.  lda #8
  168.  jsr close
  169.  jmp basic
  170. ;
  171. ;==============================================
  172. ; Read in archive header & initialize usq etc.
  173. ;==============================================
  174. ;
  175. get1st ldx #16        ;zero a bunch of things
  176.  lda #0
  177. g1st sta crc,x
  178.  dex
  179.  bpl g1st
  180.  lda #"0"             ; 0: for filename
  181.  sta fn
  182.  lda #":"
  183.  sta fn+1
  184.  jsr bytin            ;get version
  185.  cmp #2               ;must be 2
  186.  bne abor             ;abort if version isn't 2
  187.  inx                  ;.x=0
  188. newb1 jsr bytin       ;get 1st part of header
  189.  sta sqtyp,x
  190.  inx
  191.  cpx #9
  192.  bne newb1
  193.  jsr bytin            ;get fnlen
  194.  cmp #17              ;check for bad filename length
  195.  bcs abor             ;its bad ... eof
  196.  tax                  ;save length
  197.  clc
  198.  adc #4
  199.  sta fnlen            ;save length (+4 for 0: and ,type)
  200.  lda #13
  201.  jsr chrout
  202.  ldy #0
  203.  lda #<fn             ;setup filename pointer for OPEN
  204.  sta fnadr
  205.  lda #>fn
  206.  sta fnadr+1
  207. gth2 jsr bytin        ;continue getting filename
  208.  sta fn+2,y
  209.  jsr chrout
  210.  iny
  211.  dex
  212.  bne gth2
  213.  lda #","             ;tag on ,type
  214.  sta fn+2,y
  215.  jsr chrout
  216.  iny
  217.  lda filtyp
  218.  sta fn+2,y
  219.  jsr chrout
  220.  lda #" "
  221.  jsr chrout
  222.  lda #8               ;open 8,8,1
  223.  tax
  224.  ldy #1               ;sa=1 for write
  225.  sta la
  226.  stx dv
  227.  sty sa
  228.  jsr bytin            ;ignore record length
  229.  jsr bytin            ;and date
  230.  jsr bytin
  231. nou jsr chkhdr        ;abort to BASIC if error in header
  232.  ldy sqtyp            ;squeezed file?
  233.  cpy #2
  234.  beq dousq            ;yes-get encoding table
  235.  cpy #4               ;squeezed+packed?
  236.  beq dousq            ;yes-get encoding table
  237.  cpy #1               ;packed?
  238.  bne gth8             ;no stored or crunched
  239.  jsr bytin            ;packed...ignore control character (always $fe)
  240. gth8 clc              ;got header...return
  241.  rts                  ;got header...return
  242. ;
  243. dousq ldy #0          ;get huffman encoding table
  244.  tya
  245. gth3 sta c0,y         ;zero huffman codes and lengths
  246.  sta c1,y
  247.  sta c2,y
  248.  sta l0,y
  249.  iny
  250.  bne gth3
  251.  tax
  252. gth6 lda #0
  253.  sta tmp1
  254.  sta tmp1+1
  255.  sta tmp1+2
  256.  ldy #5
  257. gth4 jsr bitin        ;get 5 bits (code length)
  258.  ror a
  259.  dey
  260.  bne gth4
  261.  ror a                ;right justify
  262.  ror a
  263.  ror a
  264.  sta ltmp             ;save code length
  265.  cmp #25              ;code length > 24?
  266.  bcs badcd            ;yes...bad encoding table
  267.  cmp #0               ;length=0?
  268.  beq gth7             ;yes then no code to get
  269.  tay
  270. gth5 jsr bitin        ;else get Huffman code
  271.  rol tmp
  272.  rol tmp+1
  273.  rol tmp+2
  274.  dey
  275.  bne gth5
  276.  tay
  277. gth9 ror tmp+2        ;justify it
  278.  ror tmp+1
  279.  ror tmp
  280.  rol tmp1
  281.  rol tmp1+1
  282.  rol tmp1+2
  283.  dey
  284.  bne gth9
  285.  jsr sert             ;insert in table (sorted on code length)
  286. gth7 inx
  287.  bne gth6             ;and repeat 256 times
  288.  dec ncodsq
  289.  clc
  290. badcd rts             ;got header
  291. ;
  292. ;---------------------
  293. ; verify header is ok
  294. ;---------------------
  295. ;
  296. abort pla
  297.  pla
  298.  jmp abor             ;bad header
  299. ;
  300. chkhdr lda sqtyp      ;must be 0,1,2 or 4
  301.  cmp #3               ;crunched?
  302.  beq abort            ;yes-error
  303.  cmp #5               ;1 pass or bad header
  304.  bcs abort
  305.  lda filtyp           ;must be p,s, or u
  306.  cmp #"p"
  307.  beq chok
  308.  cmp #"s"
  309.  beq chok
  310.  cmp #"u"
  311.  bne abort
  312. chok rts
  313. ;
  314. ;----------------------------------------------------------------
  315. ; subroutine. add huffman code to table sorted by length of code
  316. ;----------------------------------------------------------------
  317. ;
  318. sert stx srtx+1       ;save .x=ascii for this code
  319.  jsr ram              ;all RAM
  320.  ldy #0
  321.  lda ltmp             ;code length read from header
  322. srt0 cpy ncodsq       ;y=# of codes?
  323.  bne srt1             ;no-maybe insert it
  324. srt00 sta l0,y        ;else store it at end of table
  325.  lda tmp1             ;code
  326.  sta c0,y
  327.  lda tmp1+1
  328.  sta c1,y
  329.  lda tmp1+2
  330.  sta c2,y
  331.  inc ncodsq
  332. srtx ldx #1
  333.  txa
  334.  sta g0,y             ;save ascii
  335.  jmp rom              ;re-enable ROMs
  336. ;
  337. srt1 cmp l0,y
  338.  bcc srt2             ;new code is smaller. insert it
  339.  iny
  340.  bne srt0             ;always
  341. ;
  342. srt2 sty srt3+1
  343.  ldy #$fe
  344. srt4 jsr srt8
  345.  dey
  346. srt3 cpy #0
  347.  bne srt4
  348.  jsr srt8
  349.  lda ltmp
  350.  jmp srt00
  351. ;
  352. srt8 lda l0,y
  353.  sta l0+1,y
  354.  lda g0,y
  355.  sta g0+1,y
  356.  lda c0,y
  357.  sta c0+1,y
  358.  lda c1,y
  359.  sta c1+1,y
  360.  lda c2,y
  361.  sta c2+1,y
  362.  rts
  363. ;
  364. ;
  365.  .ife cbm-64 <
  366. ;
  367. rom pha
  368. rom0 lda #0           ;saved CR
  369.  sta $01
  370.  and #7               ;is I/O enabled?
  371.  beq nicl             ;no...don't enable interrupts
  372.  pla
  373.  cli
  374.  rts
  375. ;
  376. ram pha
  377.  lda $01              ;save CR
  378.  sta rom0+1
  379.  and #$f8             ;all RAM
  380.  sei                  ;kill interrupts
  381.  sta $01
  382. nicl pla
  383.  rts
  384. >
  385.   .ifn cbm-64 <       ;if C-128 or PET
  386. ;
  387. ram sta $ff01         ;bank 0 if 128, nothing if PET
  388.  rts
  389. rom pha               ;bank 15 if 128, nothing if PET
  390.  lda #$00
  391.  sta $ff00
  392.  pla
  393.  rts
  394. >
  395. ;-----------------------------
  396. ; Unsqueeze a byte subroutine
  397. ;-----------------------------
  398. ;
  399. ; Use this routine to get one byte at a time from the archived file.
  400. ; The overflow flag, if set, indicates that there are no more bytes
  401. ;     to get from this archive entry. The previous one was the last
  402. ;     character of the squeezed file.
  403. ; The x and y registers are not affected by this routine
  404. ;
  405. getnxt stx bast+1
  406.  sty basty+1
  407.  jsr dcln             ;check for end of file
  408.  bit arcst
  409.  bmi bast0            ;eof...don't input past end
  410. ;
  411. gxt ldx count         ;on a run?
  412.  beq gnxt             ;no
  413.  jsr rl33             ;yes - get repeated character
  414.  jmp usq89
  415. ;
  416. gnxt ldx sqtyp        ;what type of file?
  417.  beq usq88            ;stored..get byte
  418.  cpx #1
  419.  beq usq88            ;same if packed
  420.  jsr ram              ;need to access tables at $fa00
  421.  jsr hufin            ;else get huffman code
  422. ;
  423.  .ife cbm-64 <
  424. ;
  425.  pha                  ;re-enable ROMS
  426.  lda $01
  427.  ora #$07
  428.  sta $01
  429.  cli
  430.  pla
  431. >
  432.  bcs bast             ;error reading huffman code
  433.  bcc usq80
  434. usq88 jsr bytin
  435. usq80 cpx #0          ;was it stored?
  436.  beq usq89            ;yes then we've got a byte
  437.  cpx #2               ;was it squeezed?
  438.  beq usq89            ;yes then we've got a byte
  439.  jsr rlout            ;otherwise it might need to be un-packed
  440. usq89 jsr dcbo        ;update checksum
  441. bast0 clc
  442. bast ldx #0
  443. basty ldy #0
  444.  bit arcst
  445.  rts
  446. ;
  447. ;
  448. dcln ldx len          ;check for end of file
  449.  bne dl0
  450.  ldx len+1
  451.  bne dl1
  452.  ldx len+2
  453.  bne dl2
  454.  lda #$ff             ;len is zero. flag eof
  455.  sta arcst
  456.  rts
  457. ;
  458. dl2 dec len+2
  459. dl1 dec len+1
  460. dl0 dec len
  461.  rts
  462. ;
  463. dcbo pha              ;update checksum
  464.  inc crc2
  465.  eor crc2
  466.  clc
  467.  adc crc
  468.  sta crc
  469.  bcc dcbo1
  470.  inc crc+1
  471. dcbo1 pla
  472.  rts
  473. ;
  474. ;----------------------------------
  475. ; run-length byte output for arc/x
  476. ;----------------------------------
  477. ;
  478. rlout jmp rl1         ;changes
  479. ;
  480. rl1 cmp #254          ;is it a control character?
  481.  beq contrl           ;yes-get count,char
  482.  rts                  ;else send to output
  483. ;
  484. contrl lda #<rl2      ;setup for count
  485.  sta rlout+1
  486.  lda #>rl2
  487.  sta rlout+2
  488. gnx pla
  489.  pla
  490.  jmp gnxt
  491. ;
  492. rl2 sta prev          ;save count
  493.  lda #<rl3            ;and setup for char
  494.  sta rlout+1
  495.  lda #>rl3
  496.  sta rlout+2
  497.  jmp gnx
  498. ;
  499. rl3 sty rl3y+1        ;save .y
  500.  ldy #<rl33
  501.  sty rlout+1
  502.  ldy #>rl33
  503.  sty rlout+2
  504.  ldy prev             ;recall count
  505.  sty count
  506.  sta prev             ;save char
  507. rl33 dec count        ;send char count times
  508.  beq rl3y             ;last one. reset rlout
  509.  bne rl44
  510. ;
  511. rl3y ldy #0
  512. rl0 lda #<rl1         ;reset rlout
  513.  sta rlout+1
  514.  lda #>rl1
  515.  sta rlout+2
  516. rl44 lda prev
  517.  rts
  518. ;
  519. ;----------------------------------------------
  520. ;read single byte from a file as a huffman code
  521. ;----------------------------------------------
  522. ;
  523. hufin  lda #0         ;reset length of code
  524.  sta clen
  525.  sta hfi1+1
  526.  sta coff
  527.  sta cmsk
  528.  inc cmsk
  529.  sta hcode
  530.  sta hcode+1
  531.  sta hcode+2
  532.  sty hfiy+1
  533.  stx hfix+1
  534. hfilp jsr bitin       ;get a bit
  535.  .ife cbm-128 <
  536.  sta $ff01
  537. >
  538.  bcc zbit             ;zero bit-just bump length
  539.  ldy coff             ;else adjust code as well
  540.  lda cmsk
  541.  ora hcode,y
  542.  sta hcode,y
  543. zbit asl cmsk         ;adjust mask for next time
  544.  bcc zb2
  545.  rol cmsk
  546.  inc coff
  547. zb2 inc clen          ;check if code length >23
  548.  lda clen
  549.  cmp #24
  550.  bcc hfi1
  551. nts sec               ;code too long...bad file
  552.  jmp hfix
  553. ;
  554. hfi1 ldy #0
  555. hfi3 cmp l0,y         ;check code length ok
  556.  beq hfi9             ;length the same check it
  557.  bcc hfilp            ;less-get another bit
  558.  bcs nts              ;length > ... must be an error
  559. hfi9 ldx c0,y         ;length ok. check if code is
  560.  cpx hcode
  561.  bne hfi2             ;no
  562.  ldx c1,y
  563.  cpx hcode+1
  564.  bne hfi2
  565.  ldx c2,y
  566.  cpx hcode+2
  567.  bne hfi2
  568.  lda g0,y             ;got it
  569.  clc
  570. hfix ldx #0
  571. hfiy ldy #0
  572.  .ife cbm-128 <
  573.  jmp rom
  574. >
  575.  rts
  576. ;
  577. hfi2 iny              ;try again for this length
  578.  beq nts              ;error.. no code
  579.  sty hfi1+1
  580.  cpy ncodsq
  581.  bcc hfi3
  582.  beq hfi3
  583.  jmp nts              ;none-error
  584. ;
  585. ;-------
  586. ; bitin
  587. ;-------
  588. ;
  589. bits .byt 1, 2, 4, 8, 16, 32, 64, 128
  590. ;
  591. bitin sty btiy+1
  592.  sta btia+1
  593.  ldy ibit             ;offset into bit buffer
  594.  bne bti1             ;need a new byte if zero
  595.  jsr bytin
  596.  sta bite
  597. bti1 lda bite         ;put bit in carry
  598.  and bits,y
  599.  bne bti2
  600.  clc
  601.  .byt $24
  602. bti2 sec
  603.  php
  604.  iny                  ;and adjust bit pointer for next time
  605.  cpy #8
  606.  bcc bti3
  607.  ldy #0
  608. bti3 sty ibit
  609.  plp
  610. btiy ldy #0
  611. btia lda #0
  612.  rts
  613. ;
  614. ;-------
  615. ; bytin
  616. ;-------
  617. ;
  618. bytin sty biy+1
  619.  jsr ram              ;all RAM
  620.  ldy ibyt             ;offset into file
  621.  cpy #254             ;end of buffer?
  622.  bcc bi1              ;no...just get byte
  623.  clc                  ;else bump buffer pointer
  624.  tya
  625.  adc ibuf
  626.  sta ibuf
  627.  bcc bi2
  628.  inc ibuf+1
  629. bi2 ldy #0
  630. bi1 lda (ibuf),y
  631.  iny
  632.  sty ibyt
  633. biy ldy #0
  634.  jmp rom              ;re-enable ROMs
  635. ;
  636.  .ife cbm-64 <        ;pad file length to exactly 4 blocks
  637.  .asc "1234567890"
  638. >
  639.  .ife cbm-128 <
  640.  .asc " (C) 1987 - Ampere Metal  "
  641. >
  642.  .ife cbm-4032 <
  643.  .asc " (C) 1987 - Ampere Metal        "
  644. >
  645. eof      = *
  646. ;
  647.  .end
  648.