Accessing byte arrays...

Michael S. Klein mklein at alumni.caltech.edu
Mon Apr 12 08:03:23 UTC 1999


Not really what you asked, but this adds support for literal Byte Arrays.

I.E.  #[1 2 3] = #(1 2 3) asByteArray

Methods such as  InterpreterSupportCode class >># macArchiveBinaryFile
can save quite a bit of space using this.

-- Mike Klein

P.S.  Is this a VW-only thing, or do other Smalltalks use this syntax?


Content-Type: TEXT/PLAIN; name="LiteralByteArrays.cs"
Content-ID: <Pine.SOL.3.91.990412010323.15600C at alumnus>
Content-Description: Literal Byte Arrays

'From Squeak 2.3 of January 14, 1999 on 12 April 1999 at 12:30:50 am'!

!Object methodsFor: 'testing' stamp: 'msk 10/30/1998 20:16'!
isByte
	^false! !


!Collection methodsFor: 'enumerating' stamp: 'msk 10/30/1998 19:59'!
do: elementBlock separatedBy: separatorBlock
	"Evaluate elementBlock for each element in the collection.
	Between each pair of elements, but not before the first or
	after the last, evaluate the separatorBlock."

	| first |
	first := true.
	self do:
		[:each |
		first ifTrue: [first := false]
			ifFalse: [separatorBlock value].
		elementBlock value: each] ! !


!ByteArray methodsFor: 'printing' stamp: 'msk 10/30/1998 19:57'!
printOn: output 
	| printSize |
	printSize := self size min: 1000.

	output nextPutAll: '#['.
	(1 to: printSize)
		do: [:index | (self at: index) printOn: output]
		separatedBy: [output space].
	printSize < self size ifTrue: [output nextPutAll: '...(more)...'].
	output nextPut: $].
! !

!ByteArray methodsFor: 'printing' stamp: 'msk 10/30/1998 19:57'!
storeOn: output 

	output nextPutAll: '#['.
		self do: [:element | element storeOn: output]
			separatedBy: [output space].
		output nextPut: $].
! !


!Scanner methodsFor: 'expression types' stamp: 'msk 10/30/1998 20:24'!
scanLitByteArray
	"This method is re-implemented in Parser to allow for interaction with requestor"
	| s |
	s _ WriteStream on: (Array new: 16).
	[tokenType = #rightBracket or: [tokenType = #doIt]]
		whileFalse:  [

			tokenType = #leftBracket
				ifTrue: 
					[self scanToken; scanLitVec]
				ifFalse: 
					[tokenType = #word | (tokenType = #keyword)
						ifTrue: 
							[self scanLitWord. ] ].
			token isByte ifFalse: [ self error: 'Byte or right bracket <Im not quite pointing right>' ].
			s nextPut: token.
			self scanToken].
	token _ ByteArray newFrom: s contents.
! !

!Scanner methodsFor: 'multi-character scans' stamp: 'msk 10/30/1998 19:47'!
xLitQuote
	"UniqueStrings and vectors: #(1 (4 5) 2 3) #ifTrue:ifFalse:.
	 For ##x answer #x->nil.  For ###x answer nil->#x."

	| start |
	self step. "litQuote"
	self scanToken.
	tokenType = #leftBracket ifTrue: [
			start _ mark.
			self scanToken; scanLitByteArray.
			tokenType == #doIt
				ifTrue: [mark _ start.
						self offEnd: 'Unmatched parenthesis'].

		tokenType _ #literal.
		^self
	].

	tokenType = #leftParenthesis
		ifTrue: 
			[start _ mark.
			self scanToken; scanLitVec.
			tokenType == #doIt
				ifTrue: [mark _ start.
						self offEnd: 'Unmatched parenthesis']]
		ifFalse: 
			[(#(word keyword colon ) includes: tokenType) 
				ifTrue:
					[self scanLitWord]
				ifFalse:
					[(tokenType==#literal)
						ifTrue:
							[(token isMemberOf: Association)
								ifTrue: "###word"
									[token _ nil->token key].
							(token isMemberOf: Symbol)
								ifTrue: "##word"
									[token _ token->nil]]]].
	tokenType _ #literal

"	#(Pen)
	#Pen
	##Pen
	###Pen
"! !


!Parser methodsFor: 'expression types' stamp: 'msk 4/12/1999 00:30'!
scanLitByteArray

	| s |
	s _ WriteStream on: (Array new: 16).
	[tokenType = #rightBracket or: [tokenType = #doIt]]
		whileFalse:  [
			hereMark _ mark. requestorOffset _ 0.
			tokenType = #leftBracket
				ifTrue: 
					[self scanToken; scanLitVec]
				ifFalse: 
					[tokenType = #word | (tokenType = #keyword)
						ifTrue: 
							[self scanLitWord. ] ].
			token isByte ifFalse: [ self expected: 'Byte or right bracket' ].
			s nextPut: token.
			self scanToken].
	token _ ByteArray newFrom: s contents.
! !


!SmallInteger methodsFor: 'testing' stamp: 'msk 10/30/1998 20:17'!
isByte
	^self between: 0 and: 255! !


ÿ





More information about the Squeak-dev mailing list