Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/afs/cats.ucsc.edu/courses/cmps112-wm/usr/smalltalk/bin/gst -f
- "$Id: tree.st,v 1.10 2012-02-23 18:57:51-08 - - $"
- nl := Character nl.
- FileStream extend [
- |bitIndex currentChar|
- nextBit [
- |bit|
- bitIndex isNil ifTrue: [bitIndex := 0].
- bitIndex = 0 ifTrue: [
- bitIndex := 8.
- currentChar := self next.
- ].
- bit := currentChar value bitAt: bitIndex.
- bitIndex := bitIndex - 1.
- ^ bit
- ]
- atBitEnd [
- ^ (bitIndex isNil | (bitIndex = 0)) & self atEnd
- ]
- ]
- "------------------------------------------------------------"
- Object subclass: OutBits [
- |bitIndex currentByte myStream|
- OutBits class >> new [
- self shouldNotImplement.
- ]
- OutBits class >> new: fileStream [
- |result|
- result := super new.
- result init: fileStream.
- ^result
- ]
- clearByte [
- bitIndex := 8.
- currentByte := 0.
- ]
- init: fileStream [
- myStream := fileStream.
- self clearByte.
- ]
- flushByte [
- bitIndex = 8 ifFalse: [
- myStream nextPutByte: currentByte.
- self clearByte.
- ]
- ]
- writeBit: bit [
- currentByte := currentByte bitAt: bitIndex put: bit.
- bitIndex := bitIndex - 1.
- bitIndex = 0 ifTrue: [self flushByte].
- ]
- ]
- "----------------------------------------------------------"
- Object subclass: Leaf [
- |char count|
- char [ ^ char ]
- count [ ^ count ]
- Leaf class >> new [
- self shouldNotImplement
- ]
- Leaf class >> new: aChar count: aCount [
- |result|
- result := super new.
- result setChar: aChar andCount: aCount.
- ^result
- ]
- setChar: aChar andCount: aCount [
- char := aChar.
- count := aCount.
- ]
- <= other [
- ^ (count < other count)
- | ((count = other count) & (char <= other char))
- ]
- printBase: aStream [
- ^ aStream << self class << '(' << char << ',' << count
- ]
- printOn: aStream [
- (self printBase: aStream) << ')'.
- ]
- inorder: visitor prefix: string [
- visitor value: char value: string.
- ]
- treeAsBit: visitor sum: qlength queue: stackq [
- stackq nextPut: 1.
- stackq nextPut: ((char asInteger) bitAt: 8).
- stackq nextPut: ((char asInteger) bitAt: 7).
- stackq nextPut: ((char asInteger) bitAt: 6).
- stackq nextPut: ((char asInteger) bitAt: 5).
- stackq nextPut: ((char asInteger) bitAt: 4).
- stackq nextPut: ((char asInteger) bitAt: 3).
- stackq nextPut: ((char asInteger) bitAt: 2).
- stackq nextPut: ((char asInteger) bitAt: 1).
- ^ 9.
- ]
- isLeaf [
- ^1
- ]
- ]
- Leaf subclass: Tree [
- |left right|
- Tree class >> new: aChar count: aCount [
- self shouldNotImplement
- ]
- Tree class >> new: aChar count: aCount left: aLeft right: aRight [
- |result|
- result := super new: aChar count: aCount.
- result setLeft: aLeft andRight: aRight.
- ^ result
- ]
- setLeft: aLeft andRight: aRight [
- left := aLeft.
- right := aRight.
- ]
- left [
- ^ left
- ]
- right [
- ^ right
- ]
- printOn: aStream [
- (self printBase: aStream) << ',' << left << ',' << right << ')'.
- ]
- inorder: visitor prefix: string [
- left inorder: visitor prefix: string, '0'.
- right inorder: visitor prefix: string, '1'.
- ]
- treeAsBit: visitor sum: qlength queue: stackq[
- |sum1 sum2 sum |
- sum1 := left treeAsBit: visitor sum: qlength queue: stackq.
- sum2 := right treeAsBit: visitor sum: qlength queue: stackq.
- sum := sum1 + sum2.
- sum := sum + 1.
- stackq nextPut: 0.
- ^ sum
- ]
- isLeaf [
- ^0
- ]
- ]
- "----------------------------------------------------------------------"
- Character extend [
- isPrint [
- ^ (Character space <= self) & (self <= $~)
- ]
- visible [
- self isPrint ifTrue: [^ '$', self asString]
- ifFalse: [^ self asInteger printStringRadix: 8]
- ]
- ]
- Object subclass: ZeroArray [
- |theArray|
- ZeroArray class >> new [
- self shouldNotImplement.
- ]
- ZeroArray class >> new: size [
- |result|
- result := super new.
- result init: size.
- ^ result
- ]
- init: size [
- theArray := Array new: size.
- ]
- size [
- ^ theArray size.
- ]
- at: index [
- ^ theArray at: index + 1.
- ]
- at: index put: value [
- ^ theArray at: index + 1 put: value.
- ]
- incr: index [
- (self at: index) isNil
- ifTrue: [ self at: index put: 0].
- self at: index put: (self at: index) + 1.
- ]
- keysAndValuesDo: aBlock [
- (0 to: (self size) - 1) do: [:index |
- aBlock value: index value: (self at: index).
- ]
- ]
- ]
- "-------------------------------------------------------------------"
- d := 0.
- t := 0.
- c := 0.
- u := 0.
- Smalltalk arguments: '-d -t -c -u'
- do: [:opt :arg |
- opt = $d ifTrue: [ d :=1. ].
- opt = $t ifTrue: [ t :=1. ].
- opt = $c ifTrue: [ c :=1. ].
- opt = $u ifTrue: [ u :=1. ].
- ]
- ifError: [
- 'Error: invalid option' displayNl.
- ].
- freqtable := ZeroArray new: 257.
- c = 1 ifTrue: [ "compressing"
- infile := FileStream open: (Smalltalk arguments at: 2)
- mode: FileStream read.
- [infile atEnd not] whileTrue: [
- |ordChar|
- ordChar := infile next asInteger.
- freqtable incr: ordChar.
- ].
- freqtable at: 256 put: 1.
- infile close.
- sortcol := SortedCollection new.
- chars_in_file := SortedCollection new.
- freqtable keysAndValuesDo: [:key :value |
- (value notNil and: [value > 0]) ifTrue: [
- val := Leaf new: key asCharacter count: value.
- sortcol add: val.
- chars_in_file add: key
- ]
- ].
- [sortcol size > 1] whileTrue: [
- |first second t|
- first := sortcol removeFirst.
- second := sortcol removeFirst.
- t := Tree new: (second char) count: (first count + second count) left: first right: second.
- sortcol add: t.
- ].
- root := sortcol removeFirst.
- encode_table := ZeroArray new: 257.
- root inorder: [:char :string |
- encode_table at: char asInteger put: string.
- ] prefix: ''.
- formatOutput := [:let :freq :bits|
- let asString size to: 3 do: [:skip| stdout << ' '].
- stdout << let.
- freq asString size to: 5 do: [:skip| stdout << ' '].
- stdout << freq << ' ' << bits << nl.
- ].
- arraylen := 0.
- encode_table keysAndValuesDo: [:key :value |
- (value notNil and: [value > 0]) ifTrue: [
- arraylen := arraylen + ((freqtable at: key)*(value size)).
- ]
- ].
- stackq := SharedQueue new.
- qlength := 0.
- qlength := root treeAsBit: [:char :string ] sum: qlength queue: stackq.
- qlength := qlength + 1.
- stackq nextPut: 0.
- bitArray := Array new: (arraylen+qlength).
- index := 1.
- [stackq isEmpty not] whileTrue: [
- |bit|
- bit := stackq next.
- bitArray at: index put: bit.
- index := index + 1.
- ].
- infile := FileStream open: (Smalltalk arguments at: 2)
- mode: FileStream read.
- [infile atEnd not] whileTrue: [
- |ordChar|
- ordChar := infile next asInteger.
- index to: (index+((encode_table at: ordChar) size))-1 do:
- [ :x |
- bit := 0.
- (((encode_table at: ordChar) at: ((x-index)+1)) = $1) ifTrue: [bit:= 1.].
- bitArray at: x put: bit.
- ].
- index := (index+((encode_table at: ordChar) size)).
- ].
- "so at this point we want to add our EOF character to our BitArray"
- index to: (index+((encode_table at: 256) size))-1 do:
- [ :x |
- bit := 0.
- (((encode_table at: 256) at: ((x-index)+1)) = $1) ifTrue: [bit:= 1.].
- bitArray at: x put: bit.
- ].
- "filling up our bit array"
- writeEncodedOutFile := [:outfile|
- |outBytes|
- outBytes := OutBits new: outfile.
- bitArray do: [:bit| outBytes writeBit: bit.].
- outBytes flushByte.
- ].
- Smalltalk arguments size = 2
- ifTrue: [writeEncodedOutFile value: stdout]
- ifFalse: [
- |outfilename|
- outfilename := Smalltalk arguments at: 3.
- [ |outfile|
- outfile := FileStream open: outfilename mode: FileStream write.
- writeEncodedOutFile value: outfile.
- outfile close.
- ] on: SystemExceptions.FileError do: [:signal |
- |errno|
- errno := File errno.
- stdout flush.
- stderr << execname << ': ' << filename << ': '
- << signal messageText << nl.
- stderr flush.
- ]
- ].
- d = 1 ifTrue: [
- stdout << 'DEBUG STMTS: '<<nl.
- root inspect.
- bitArray do: [:bit| stdout <<bit.].
- stdout << nl. ].
- ].
- "-----------------------------------------------------------------"
- "decompression----------------------------------------------------"
- u = 1
- ifTrue: [
- infile := FileStream open: (Smalltalk arguments at: 2)
- mode: FileStream read.
- treeq := OrderedCollection new.
- priority := 1000.
- endOfTree := 1.
- [infile atBitEnd not and: [endOfTree = 1]] whileTrue: [
- | bit |
- bit := infile nextBit.
- bit = 1 ifTrue: [ "if we see a one"
- | char count |
- char := 255.
- count := 8.
- [count > 0 ] whileTrue: [
- count := count - 1.
- infile nextBit = 0 ifTrue: [
- num := 2 raisedTo: count.
- char := char - num.
- ]
- ].
- val := Leaf new: char asCharacter count: priority.
- priority := priority - 10.
- treeq addFirst: val.
- ]
- ifFalse: [ "for when we see a zero"
- treeq size = 1
- ifTrue: [
- endOfTree := 0. ]
- ifFalse: [
- |first second t|
- first := treeq removeFirst.
- second := treeq removeFirst.
- t := Tree new: (first char) count: priority left: second right: first.
- priority := priority - 10.
- treeq addFirst: t.
- ].
- ].
- ].
- root := treeq removeFirst.
- encode_table := ZeroArray new: 256.
- "creating an encoding table based of tree we created above ^"
- root inorder: [:char :string |
- encode_table at: char asInteger put: string.
- ] prefix: ''.
- t_current := root.
- result := OrderedCollection new.
- [infile atBitEnd not] whileTrue: [
- | bit |
- t_current isLeaf = 1
- ifTrue: [
- t_current char asInteger = 0
- ifFalse:[
- freqtable incr: (t_current char asInteger).
- result addLast: ((t_current char asInteger) bitAt: 8).
- result addLast: ((t_current char asInteger) bitAt: 7).
- result addLast: ((t_current char asInteger) bitAt: 6).
- result addLast: ((t_current char asInteger) bitAt: 5).
- result addLast: ((t_current char asInteger) bitAt: 4).
- result addLast: ((t_current char asInteger) bitAt: 3).
- result addLast: ((t_current char asInteger) bitAt: 2).
- result addLast: ((t_current char asInteger) bitAt: 1).
- ].
- t_current := root.
- ]
- ifFalse: [
- bit := infile nextBit.
- bit = 1 ifTrue: [
- t_current := t_current right.
- ]
- ifFalse: [
- t_current := t_current left.
- ].
- ].
- ].
- infile close.
- d = 1 ifTrue: [
- infile := FileStream open: (Smalltalk arguments at: 2)
- mode: FileStream read.
- [infile atBitEnd not] whileTrue: [
- bit := infile nextBit.
- stdout << bit.
- ].
- stdout <<nl.
- infile close.
- ].
- writeDecodedOutFile := [:outfile|
- |outBytes|
- outBytes := OutBits new: outfile.
- [result size > 8] whileTrue: [ outBytes writeBit: result removeFirst.].
- outBytes flushByte.
- ].
- Smalltalk arguments size = 2
- ifTrue: [writeDecodedOutFile value: stdout]
- ifFalse: [
- |outfilename|
- outfilename := Smalltalk arguments at: 3.
- [ |outfile|
- outfile := FileStream open: outfilename mode: FileStream write.
- writeDecodedOutFile value: outfile.
- outfile close.
- ] on: SystemExceptions.FileError do: [:signal |
- |errno|
- errno := File errno.
- stdout flush.
- stderr << execname << ': ' << filename << ': '
- << signal messageText << nl.
- stderr flush.
- ]
- ].
- ].
- "-----------------------------------------------------------------"
- "table writing----------------------------------------------------"
- t = 1
- ifTrue: [
- formatOutput := [:let :freq :bits| "if let < 128"
- let asString size to: 3 do: [:skip| stdout << ' '].
- stdout << let.
- freq asString size to: 5 do: [:skip| stdout << ' '].
- stdout << freq << ' ' << bits << nl.
- ].
- encode_table keysAndValuesDo: [:key :value |
- (value notNil and: [value > 0]) ifTrue: [
- formatOutput value: (key asCharacter visible) value: (freqtable at: key) value: value.
- ]
- ].
- ].
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement