CP/M/CPM_CDROM.iso/enterprs/c128/util/sfxsrc.arc/RECONST.A

Text File | 1990-02-12 | 9.9 KB | 426 lines

; reconst.a
;──────────────────────────────────────────────────────────────────────────────
; LHARChive self extraction module for C64/C128 - Copyright 1990 - Chris Smeets
;──────────────────────────────────────────────────────────────────────────────
; Reconstruct the frequency table when a frequency count overflows. This is
; a rare occurrence. Its called only when a given character appears more than
; 32768 times in a file.
;
; Since the size of a self extract module is limited, its not inconcievable
; that this code would never get called.


            INSTXT "sfx.i"

            EXT freq
            EXT son
            EXT prnt

;───────────────────────────────────────────────────────────
; void reconst()
; {
;     static  int i, j, k;
;     static  unsigned f, l;
;     j = 0;
;     for (i = 0; i < T; i++) {
;         if (son[i] >= T) {
;             freq[j] = (freq[i] + 1) / 2;
;             son[j] = son[i];
;             j++;
;         }
;     }
;     for (i = 0, j = N_CHAR; j < T; i += 2, j++) {
;         k = i + 1;
;         f = freq[j] = freq[i] + freq[k];
;         for (k=j-1; f<freq[k]; k--)
;             ;
;         k++;
;         l = (j-k)*2;
;         memmove(&freq[k+1], &freq[k], l);
;         freq[k] = f;
;         memmove(&son[k+1], &son[k], l);
;         son[k] = i;
;     }
;     for (i = 0; i < T; i++) {
;         if ((k = son[i]) >= T)
;             prnt[k] = i;
;         else
;             prnt[k] = prnt[k + 1] = i;
;     }
; }
;──────────────────────────────────────────────────────────

            PUBLIC Reconst

I           EQU T0
J           EQU I+2
K           EQU I+4
EF          EQU I+6
L           EQU I+8
SON_I       EQU I+10
P1          EQU I+12
P2          EQU I+14

Reconst     ldy #1
            ldx #0                  ; j=0
            stx J
            stx J+1
            stx I                   ; for(i=0;
            stx I+1

for1        lda I                   ;         i<T;
            cmp #<Tstar2
            lda I+1
            sbc #>Tstar2
            bcc if1
            jmp endfor1

if1         clc                     ; if(son[i] >= T)
            lda #<son
            adc I
            sta SON_I
            lda #>son
            adc I+1
            sta SON_I+1

            lda (SON_I,x)
            cmp #<T
            lda (SON_I),y
            sbc #>T
            bcc endif1              ; Its not

            clc                     ;     freq[j] = (freq[i]+1)/2;
            lda #<freq
            adc I
            sta P1                  ; P1 = &freq[i]
            lda #>freq
            adc I+1
            sta P1+1
            clc
            lda #<freq
            adc J
            sta P2                  ; P2 = &freq[j]
            lda #>freq
            adc J+1
            sta P2+1

            lda (P1,x)
            sta EF
            lda (P1),y
            sta EF+1
            inc EF
            bne f1b
            inc EF+1
f1b         lsr EF+1
            ror EF

            lda EF
            sta (P2,x)
            lda EF+1
            sta (P2),y

            clc                     ; son[j] = son[i];
            lda #<son
            adc J
            sta P1
            lda #>son
            adc J+1
            sta P1+1
            lda (SON_I,x)
            sta (P1,x)
            lda (SON_I),y
            sta (P1),y

            clc                     ; j++
            lda J
            adc #2
            sta J
            bcc endif1
            inc J+1

endif1      clc                     ; i++
            lda I
            adc #2
            sta I
            bcc f1c
            inc I+1
f1c         jmp for1

endfor1     stx I                   ; for (i=0,j=N_CHAR;
            stx I+1
            lda #<N_CHAR
            sta J
            lda #>N_CHAR
            sta J+1
            asl J
            rol J+1

for2        lda J                   ;    j<T;
            cmp #<Tstar2
            lda J+1
            sbc #>Tstar2
            bcc f2a
            jmp endfor2

f2a         clc                     ; P1 = &freq[i]
            lda #<freq
            adc I
            sta P1
            lda #>freq
            adc I+1
            sta P1+1
            clc                     ; P2 = &freq[j]
            lda J
            adc #<freq
            sta P2
            lda J+1
            adc #>freq
            sta P2+1

            ldy #2                  ; f = freq[j] = freq[i]+freq[i+1];
            lda (P1),y
            adc (P1,x)
            sta EF
            sta (P2,x)
            ldy #3
            lda (P1),y
            ldy #1
            adc (P1),y
            sta EF+1
            sta (P2),y

            sec                     ; for(k=j-1;
            lda J
            sbc #2
            sta K
            lda J+1
            sbc #0
            sta K+1
            clc
            lda K                   ; Make K an address for this loop
            adc #<freq
            sta K
            lda K+1
            adc #>freq
            sta K+1

for3        lda EF                   ;    f<freq[K];
            cmp (K,x)
            lda EF+1
            sbc (K),y
            bcc f3a
            jmp endfor3

f3a         sec                     ;                 k--)
            lda K
            sbc #2
            sta K
            lda K+1
            sbc #0
            sta K+1
            jmp for3

endfor3     clc                     ; k++
            lda K
            adc #2
            sta K
            bcc f2b
            inc K+1
f2b         sec                     ; Convert K back into an offset
            lda K
            sbc #<freq
            sta K
            lda K+1
            sbc #>freq
            sta K+1
            sec                     ; l=(j-k)*2 (# of bytes to move)
            lda J
            sbc K
            sta L
            lda J+1
            sbc K+1
            sta L+1

            ldx #<freq             ; memmove(&freq[k+1], &freq[k], l)
            ldy #>freq
            jsr moveit
            lda EF                   ; freq[k] = f;
            sta (P1,x)
            lda EF+1
            sta (P1),y
            ldx #<son              ; memmove(&son[k+1], &son[k], l)
            ldy #>son
            jsr moveit
            lda I+1                 ; son[k] = i;
            lsr a
            sta (P1),y
            lda I
            ror a
            sta (P1,x)

            clc                     ; i+=2; j++
            lda I
            adc #4
            sta I
            bcc f2c
            inc I+1
f2c         clc
            lda J
            adc #2
            sta J
            bcc f2d
            inc J+1
f2d         jmp for2

endfor2     stx I                   ; for(i=0;
            stx I+1

for4        lda I                   ;         i<T;
            cmp #<Tstar2
            lda I+1
            sbc #>Tstar2
            bcc f4a
            jmp endfor4

f4a         clc                     ; k=son[i]
            lda #<son
            adc I
            sta P1
            lda #>son
            adc I+1
            sta P1+1
            lda (P1,x)
            asl a
            sta K
            lda (P1),y
            rol a
            sta K+1

            clc                     ; prnt[k] = i
            lda K
            adc #<prnt
            sta P1
            lda K+1
            adc #>prnt
            sta P1+1
            lda I+1
            lsr a
            sta (P1),y
            lda I
            ror a
            sta (P1,x)

            lda K                   ; if( k >= T )
            cmp #<Tstar2
            lda K+1
            sbc #>Tstar2
            bcs f4endif

            lda I+1                 ; prnt[k+1] = i
            ldy #3
            lsr a
            sta (P1),y
            dey
            lda I
            ror a
            sta (P1),y
            dey
f4endif     clc                     ; i++
            lda I
            adc #2
            sta I
            bcc jfor4
            inc I+1
jfor4       jmp for4

endfor4     rts

;───────────────────────────────
; Local subroutine. Call memcpy
;───────────────────────────────

DST         equ T9
SRC         equ T8
LEN         equ T10

moveit      clc                     ; dest=src=P1 = &array[k]
            txa
            adc K
            sta DST
            sta SRC
            sta P1
            tya
            adc K+1
            sta DST+1
            sta SRC+1
            sta P1+1
            clc                     ; dest=src+2
            lda DST
            adc #2
            sta DST
            lda DST+1
            adc #0
            sta DST+1
            lda L
            sta LEN
            lda L+1
            sta LEN+1
            jsr memcpy
            ldx #0
            ldy #1
            rts


memcpy      ldy #0
            lda SRC
            cmp DST
            lda SRC+1
            sbc DST+1
            bcs forw                ;if src >= dst copy from beginning

            clc
            lda SRC
            adc LEN
            sta SRC
            lda SRC+1
            adc LEN+1
            sta SRC+1
            clc
            lda DST
            adc LEN
            sta DST
            lda DST+1
            adc LEN+1
            sta DST+1
            ldx LEN
            beq rvrs3
rvrs1       tya
            bne rvrs2
            dec SRC+1
            dec DST+1
rvrs2       dey
            lda (SRC),Y
            sta (DST),Y
            dex
            bne rvrs1
rvrs3       dec LEN+1
            bpl rvrs1
            rts

forw        ldx LEN
            beq forw3
forw1       lda (SRC),Y
            sta (DST),Y
            iny
            bne forw2
            inc SRC+1
            inc DST+1
forw2       dex
            bne forw1
forw3       dec LEN+1
            bpl forw1
            rts

            END