;
; An experimental tiny-compressor
;
; SLJ 7/02
;
; written using DASM
;

	processor 6502

	org $0801		;Code at $4000

bitcount = 	$2b		;$01 initially (basic text)
dest	=	$73		;$7ae6 initially (CHRGET routine -- inc $7a)

point	= 	$fa
count	= 	$fc
temp	= 	$fe

CHROUT	=	$ffd2
CHRIN	=	$ffcf
CLRCHN	=	$ffcc
SETNAM	=	$ffbd
SETLFS	=	$ffba
OPEN	=	$ffc0
CLOSE	=	$ffc3
LOAD	=	$ffd5
SAVE	= 	$ffd8
CHKIN	=	$ffc6
CHKOUT	=	$ffc9

;--------------------
; basic header
;--------------------

	word 2059
	word 2002
	byte $9e,"2061",00,00,00


Start
	lda #00
	sta $d021
	lda #$40		;Control msg only
	sta $9d

	jsr GetFile
	jsr SetJump
	jsr Profile
	jsr PressKey
	jsr Compress
	jsr OutputFile
	lda #13
	jsr $ffd2
	jsr PressKey

;	lda #<jump
;	sta jump+1
;	lda #>jump
;	sta jump+2
;	lda #$01
;	sta $2d
;	sta $2b
;	lda #$08
;	sta $2c
;	lda #$0d
;	ldx #$0a
;	ldy #00
;	jmp entry

	lda #00
	sta $9d
	jmp $ff8a


;------------------------------
; Profile -- find most common
;   bytes and best bit count
;------------------------------

Profile	subroutine

	jsr Working

	ldx #00
	txa
.l1	sta $c000,x
	sta $c100,x
	sta $c200,x
	sta $c300,x
	sta $c400,x
	inx
	bne .l1

	jsr CountBytes

;
; Find the best choice of n=number of bits to use
;
; formula is bytes = literals + (total + (n-1)*cbytes)/8 + 2^(n-1)
; where 
;   total = total number of bytes
;   cbytes= number of compressed bytes
;   literals = total - cbytes
; and the last +2^(n-1) is for storing the lookup table
;
BestBits subroutine
	lda #$ff
	sta bestlen+1

;	lda endaddr
;	sec
;	sbc startaddr
;	sta len
;	lda endaddr+1
;	sbc startaddr+1
;	sta len+1

	jsr STROUT
	byte "BIT PERFORMANCE: BYTES IN=$",00
	lda len+1
	ldx len
	jsr HEX16
	lda #13
	jsr $ffd2


	ldx #2		;n=2..6
.loop	ldy twotab-1,x	;.y = 2^(x-1)

	jsr AddCBytes	;(total+(n-1)*cbytes)/8

	lda len
	sec
	sbc $c300,y	;total-cbytes
	pha
	lda len+1
	sbc $c400,y
	sta temp
	pla
	clc
	adc count
	sta count
	lda temp
	adc count+1
	sta count+1	;total number of bytes reduced
	tya
	clc
	adc count	;+ 2^(n-1) storage
	sta count
	bcc .c0
	inc count+1
.c0	lda count
	clc
	adc #<delen
	sta count
	bcc .c00
	inc count+1
.c00
	
	jsr .printstat

	lda count
	cmp bestlen
	lda count+1
	sbc bestlen+1
	bcs .nope
	lda count
	sta bestlen
	lda count+1
	sta bestlen+1
	stx bestn
.nope
	inx
	cpx #7
	bne .loop

	jsr STROUT
	byte "USING N=",00
	lda bestn
	jmp HEXOUT

.printstat
	lda #"N"
	jsr $ffd2
	lda #"="
	jsr $ffd2
	txa
	jsr HEXOUT
	ldy #00
.pl	lda .mesg,y
	beq .c9
	jsr $ffd2
	iny
	bne .pl
.c9	lda count+1
	jsr HEXOUT
	lda count
	jsr HEXOUT
	lda #13
	jmp $ffd2

.mesg 	byte " BYTES OUT=$",00
	
	

;
; Compute (n-1)*cbytes, add to len, and divide by 8
;
AddCBytes subroutine
	lda #00
	sta count
	sta count+1
	stx temp	;n

.l1	dec temp
	beq .div8
	lda count
	clc
	adc $c300,y	;cbytes: sum 0..2^(n-1)
	sta count
	lda count+1
	adc $c400,y
	sta count+1
	jmp .l1

.div8	lda count
	clc
	adc len
	sta count
	lda count+1
	adc len+1	;+len
	ror
	ror count
	ror temp	;any carryovers
	lsr
	ror count
	ror temp
	lsr
	ror count	;/8
	ror temp
	sta count+1

	lda temp	;round up
	beq .rts
	inc count
	bne .rts
	inc count+1
.rts	rts

;
; count and order bytes
;
CountBytes subroutine

	lda #00
	sta .l2+1
	lda #$40
	sta .l2+2		;Code at $4000

	lda endaddr+1
	ldy endaddr

.l2	ldx $4000
	inc $c000,x
	inc .l2+1
	bne .c1
	inc .l2+2
.c1	cpy .l2+1
	bne .l2
	cmp .l2+2		;endaddr
	bne .l2

; order bytes

	ldy #00
.l3	ldx #00
	lda #00
	inc $d020

.l4	cmp $c000,x
	bcs .cont
	stx temp
	lda $c000,x
.cont	inx
	bne .l4
	ldx temp		;max
	sta $c100,y		;number of occurances

	clc
	adc $c300,y		;running total in $c300/$c400
	sta $c301,y		;i.e. number of compressed bytes
	lda $c400,y
	adc #00
	sta $c401,y

	txa
	sta $c200,y		;byte value
	lda #00
	sta $c000,x
	iny
	bne .l3

; output most common bytes

	jsr STROUT
	byte 13
	byte "64 MOST COMMON BYTES - BYTE(FREQ)",13,00

	ldx #00
.out	lda $c200,x		;byte
	ldy $c100,x		;reps
	jsr .print

	lda $c210,x
	ldy $c110,x
	jsr .print

	lda $c220,x
	ldy $c120,x
	jsr .print

	lda $c230,x
	ldy $c130,x
	jsr .print

;	lda #13
;	jsr $ffd2

	inx
	cpx #16
	bne .out
	rts

.print
	jsr HEXOUT
	lda #32
	jsr $ffd2
	lda #"("
	jsr $ffd2
	tya
	jsr HEXOUT
	lda #")"
	jsr $ffd2
	lda #32
	jsr $ffd2
	jsr $ffd2
	jmp $ffd2
	
;---------------------------
; Generate the compressed bitstream
;---------------------------

Compress subroutine

	jsr STROUT
	byte 13
	byte "  COMPRESSING.",00

;	jsr CopyDecompress

	ldy bestn	;Set up table, decompressor
	ldx twotab-1,y
	stx temp
	dex
.l1	lda $c200,x
	sta lookup,x
	dex
	bpl .l1

	dey		;n-1
	sty three+1

	lda jumpaddr
	sta jump+1
	lda jumpaddr+1
	sta jump+2

	lda temp	;fix decompressor address
	clc
	adc #<lookup
	sta bitdest+1
	lda #>lookup
	adc #00
	sta bitdest+2

	lda bitdest+1
	sec
	sbc #<decompress
	sta temp	;offset from start of decompress code
	lda bitdest+2
	sbc #>decompress
	sta temp+1

	lda temp
	clc
	adc #<codedest
	sta temp	;actual location of bitstream
	lda temp+1
	adc #>codedest
	sta temp+1

	lda temp	;.X=$0a initially, starts at +1
	sec
	sbc #$0b
	sta src+1
	lda temp+1
	sbc #00
	sta src+2	;bitstream location + offset

	lda #8
	sta cbit

	lda #$40	;Code loaded to $4000
	sta point+1
	lda #00
	sta point

.loop	ldy #00
	lda (point),y
	jsr EncodeByte
	inc point
	bne .c1
	lda #"."
	jsr $ffd2
	inc point+1
.c1	lda point
	cmp endaddr
	lda point+1
	sbc endaddr+1
	bcc .loop

	jsr BitDone
	lda #13
	jmp $ffd2

;
; Encode a byte, code or literal
;
EncodeByte subroutine

	ldy bestn
	ldx twotab-1,y	;2^(n-1)
.l1	dex
	bmi .literal
	cmp lookup,x	;see if in table
	bne .l1
.code	txa		;.x = lookup number
	ldx #9
.l2	asl		;left-justify bits
	dex
	cpx bestn
	bne .l2
	clc
	bcc .out
.literal
	sec
	ldx #9
.out	jsr BitOut
	asl
	dex
	bne .out
	rts

;
; Output a single bit
;
cbit	 byte 00

BitOut	subroutine

bitdest	rol $6000
	dec cbit
	bne .rts
	pha
	lda #8
	sta cbit
	inc bitdest+1
	bne .pla
	inc bitdest+2
.pla	pla
.rts	rts

bitjsr	jsr BitOut	;C clear
BitDone
	lda cbit
	cmp #8
	bcc bitjsr
	rts


;---------------------------
; Output the final file
;---------------------------
OutputFile subroutine

	jsr STROUT
	byte 13
	byte "OUTPUT FILENAME? ",00
	jsr GetName

	ldx $b7
	ldy #00
.l0	lda .txt,y
	sta $0200,x
	inx
	iny
	cpy #4
	bne .l0
	stx $b7		;filename length

	ldx $ba
	lda #8
	ldy #8
	jsr SETLFS
	jsr OPEN
	bcs .error

	ldx #8
	jsr CHKOUT
	lda #$26	;load address
	jsr CHROUT
	lda #$03
	jsr CHROUT

	lda #<decompress
	sta point
	lda #>decompress
	sta point+1

.l1	ldy #00
	lda (point),y
	jsr CHROUT
	inc point
	bne .c1
	inc point+1
.c1	lda point
	cmp bitdest+1	;end of file
	lda point+1
	sbc bitdest+2
	bcc .l1

.error
.close	lda #8
	jsr CLOSE
	jmp CLRCHN

.txt	byte ",P,W"

;---------------------------
; Copy the decompression subroutine to its dest
;---------------------------
CopyDecompress subroutine
	ldx #<delen
.loop	lda decompress,x
	sta codedest,x
	dex
	bpl .loop
	rts

;---------------------------
; Get JMP address
;---------------------------
SetJump
	jsr STROUT
	byte 13
	byte "JMP TO (DEFAULT=$7AE7):$",00

	jsr GetVal
	cmp #00
	bne .sta
	cpy #00
	bne .sta
	lda #$e7
	ldy #$7a
.sta	sta jumpaddr
	sty jumpaddr+1

	jsr STROUT
	byte 13
	byte "USING $",00
	lda jumpaddr+1
	ldx jumpaddr
	jmp HEX16

;---------------------------
; read in a file
;---------------------------

GetFile	subroutine
	jsr STROUT
	byte 05				;man, text in dasm sUx0rz
;	byte "TEST123",13
	byte 70,73,76,69,78,65,77,69	;'filename?'
	byte "? "
	byte 00

	jsr GetName

	ldx $ba
	lda #8
	ldy #8
	jsr SETLFS
	jsr OPEN
	bcs .error

	ldx #8
	jsr CHKIN
	jsr CHRIN
	sta startaddr
	jsr CHRIN
	sta startaddr+1
	jsr .close

	jsr STROUT
	byte 13
	byte "START ADDRESS=$",00
	lda startaddr+1
	ldx startaddr
	jsr HEX16

	ldx $ba
	lda #1
	ldy #0
	jsr SETLFS
	lda #00
	ldx #00
	ldy #$40		;load to $4000
	jsr LOAD
	bcs .error
	stx endaddr
	sty endaddr+1

	stx len
	tya
	sec
	sbc #$40
	sta len+1

	jsr STROUT
	byte 13
	byte "END ADDRESS=$",00
	lda startaddr
	clc
	adc len
	tax
	lda startaddr+1
	adc len+1
	jmp HEX16

.error	pla
	pla
.close	lda #8
	jsr CLOSE
	jmp CLRCHN

GetName
	ldx #00
.l1	jsr $ffcf
	sta $0200,x
	cmp #$0d
	beq .ok
	inx
	bne .l1

.ok	txa
	ldx #00
	ldy #02		;$0200
	jmp SETNAM

;-------------------------------
;
; Utility routines
;
;-------------------------------

;
; HEX16 -- print two-byte hex
;
; Input: .X .A = lo hi
;
HEX16
         JSR HEXOUT
         TXA              ;Fall through to next routine
;
; HEXOUT
;
; Print hex byte in .A using CHROUT
;
HEXOUT	 subroutine
         PHA
         LSR
         LSR
         LSR
         LSR
         JSR .PRINT
         PLA
         AND #$0F
.PRINT   ORA #$30
         CMP #$3A
         BCC .PLOP
         ADC #$06
.PLOP    JMP $FFD2

;
; STROUT
;   Like PRINT, but the string immediately follows the
;   subroutine call; execution resumes right after the
;   null-termination byte.
;
;   On exit, A and X are thoroughly hosed.
;
STROUT	 subroutine
         PLA
         TAX              ;Lo byte
         PLA
         INX
         BNE .PRINT
         CLC
         ADC #01
.PRINT
         STA .LOOP+2
.LOOP    LDA $A000,X
         BEQ .DONE
         JSR CHROUT
         INX
         BNE .LOOP
         INC .LOOP+2
         BNE .LOOP

.DONE    LDA .LOOP+2
         PHA              ;hi byte
         TXA
         PHA              ;lo byte
         RTS

;
; Get 16-bit hex value
;
val      word 00

GetVal	 subroutine
;         ldx #24
;         ldy #00
;         clc
;         jsr $fff0
;
;         jsr Strout
;         txt 'Enter value:$    '
;         dfb 157,157,157,157
;         dfb 00

         lda #00
         sta val
         sta val+1

         jsr .getchar
         jsr .getchar
         jsr .getchar
         jsr .getchar
.done    ldy val+1
         lda val
         rts

.getchar jsr $ffcf
         cmp #$0d
         beq .exit

         cmp #$40         ;convert to hex
         bcc .c1
         sbc #7
.c1      and #$0f
	 asl val
	 rol val+1
         asl val
         rol val+1
         asl val
         rol val+1
         asl val
         rol val+1
         ora val
         sta val
         rts

.exit    pla
         pla
         jmp .done

Working
	jsr STROUT
	byte 13
	byte "WORKING...",13,00
	rts

PressKey
	jsr STROUT
	byte " (PRESS ANY KEY...)",00
.wait	jsr $ffe4
	beq .wait
	rts



;--------------------
; variables
;--------------------

startaddr word 00		;Actual start address
endaddr  word 00		;Physical end address ($4000-endaddr)
jumpaddr word 00		;jump address

len	 word 00
bestlen	 word 00
bestn	 byte 00

twotab	byte 1,2,4,8,16,32,64,128

;--------------------
; decompression code
;
; on entry, .A=0d, .X=0a, and .Y=00
;--------------------

decompress subroutine

codedest = $0326
three	 = * + .ldy - destart
src	 = * + .src - destart
jump	 = * + .jump - destart

	rorg codedest
;	org $0326

destart
	word entry		;BSOUT vector
	byte $ed,$f6		;STOP vector

.first	tay
	beq .ldy
	ldy #8
	byte $2c
.ldy	ldy #3			;ldy #n
.getbit	lsr bitcount
	bne .skip
	ror bitcount
	inx
	bne .skip
	inc .src+2
.skip
.src	asl source,x
	rol
	dey
	bmi .first
	bne .getbit
.found	bcs .lit	;bit 9 of .A
	tay
	lda endcode,y
.lit	ldy #00
	sta (dest),y
entry
.tya	tya		;.A = 0
	inc dest
	bne .getbit
	inc dest+1
	bpl .getbit
.jump	jmp $1234
endcode

	rend

lookup			;Sizeof depends on n
source

delen = endcode - destart