'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6643] on 10 April 2005 at 7:48:26 pm'! "Change Set: MarkByteString Date: 10 April 2005 Author: Andreas Raab Mark those places that need to be changed to ByteString."! !Behavior methodsFor: 'private' stamp: 'ar 4/10/2005 19:13'! spaceUsed "Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables." | space method | space _ 0. self selectorsDo: [:sel | space _ space + 16. "dict and org'n space" method _ self compiledMethodAt: sel. space _ space + (method size + 6 "hdr + avg pad"). method literals do: [:lit | (lit isMemberOf: Array) ifTrue: [space _ space + ((lit size + 1) * 4)]. (lit isMemberOf: Float) ifTrue: [space _ space + 12]. self flag: #ByteString. (lit isMemberOf: String) ifTrue: [space _ space + (lit size + 6)]. (lit isMemberOf: LargeNegativeInteger) ifTrue: [space _ space + ((lit size + 1) * 4)]. (lit isMemberOf: LargePositiveInteger) ifTrue: [space _ space + ((lit size + 1) * 4)]]]. ^ space! ! !AbstractString class methodsFor: 'instance creation' stamp: 'ar 4/10/2005 19:47'! new: sizeRequested "Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested." self flag: #ByteString. ^String new: sizeRequested! ! !AbstractString class methodsFor: 'instance creation' stamp: 'ar 4/10/2005 19:47'! with: aCharacter | newCollection | self flag: #ByteString. aCharacter asInteger < 256 ifTrue:[newCollection _ String new: 1] ifFalse:[newCollection _ MultiString new: 1]. newCollection at: 1 put: aCharacter. ^newCollection! ! !DataStream class methodsFor: 'as yet unclassified' stamp: 'ar 4/10/2005 19:13'! initialize "TypeMap maps Smalltalk classes to type ID numbers which identify the data stream primitive formats. nextPut: writes these IDs to the data stream. NOTE: Changing these type ID numbers will invalidate all extant data stream files. Adding new ones is OK. Classes named here have special formats in the file. If such a class has a subclass, it will use type 9 and write correctly. It will just be slow. (Later write the class name in the special format, then subclasses can use the type also.) See nextPut:, next, typeIDFor:, & ReferenceStream>>isAReferenceType:" "DataStream initialize" | refTypes t | refTypes _ OrderedCollection new. t _ TypeMap _ Dictionary new: 80. "sparse for fast hashing" t at: UndefinedObject put: 1. refTypes add: 0. t at: True put: 2. refTypes add: 0. t at: False put: 3. refTypes add: 0. t at: SmallInteger put: 4. refTypes add: 0. self flag: #ByteString. t at: String put: 5. refTypes add: 1. t at: Symbol put: 6. refTypes add: 1. t at: ByteArray put: 7. refTypes add: 1. t at: Array put: 8. refTypes add: 1. "(type ID 9 is for arbitrary instances of any class, cf. typeIDFor:)" refTypes add: 1. "(type ID 10 is for references, cf. ReferenceStream>>tryToPutReference:)" refTypes add: 0. t at: Bitmap put: 11. refTypes add: 1. t at: Metaclass put: 12. refTypes add: 0. "Type ID 13 is used for HyperSqueak User classes that must be reconstructed." refTypes add: 1. t at: Float put: 14. refTypes add: 1. t at: Rectangle put: 15. refTypes add: 1. "Allow compact Rects." "type ID 16 is an instance with short header. See beginInstance:size:" refTypes add: 1. self flag: #ByteArray. t at: String put: 17. refTypes add: 1. "new String format, 1 or 4 bytes of length" t at: WordArray put: 18. refTypes add: 1. "bitmap-like" t at: WordArrayForSegment put: 19. refTypes add: 1. "bitmap-like" t at: SoundBuffer put: 20. refTypes add: 1. "And all other word arrays, both 16-bit and 32-bit. See methods in ArrayedCollection. Overridden in SoundBuffer." t at: CompiledMethod put: 21. refTypes add: 1. "special creation method" "t at: put: 22. refTypes add: 0." ReferenceStream refTypes: refTypes. "save it" "For all classes that are like WordArrays, store them the way ColorArray is stored. As bits, and able to change endianness." Smalltalk do: [:cls | cls isInMemory ifTrue: [ cls isBehavior ifTrue: [ cls isPointers not & cls isVariable & cls isWords ifTrue: [ (t includesKey: cls) ifFalse: [t at: cls put: 20]]]]].! ! !MultiString class methodsFor: 'instance creation' stamp: 'ar 4/10/2005 19:13'! fromByteArray: aByteArray | inst | self flag: #ByteString. aByteArray size \\ 4 = 0 ifFalse: [^ String fromByteArray: aByteArray ]. inst _ self new: aByteArray size // 4. 4 to: aByteArray size by: 4 do: [:i | inst basicAt: i // 4 put: ((aByteArray at: i - 3) << 24) + ((aByteArray at: i - 2) << 16) + ((aByteArray at: i - 1) << 8) + (aByteArray at: i) ]. ^ inst ! ! !SmartRefStream methodsFor: 'read write' stamp: 'ar 4/10/2005 19:13'! initShapeDicts "Initialize me. " self flag: #bobconv. "These must stay constant. When structures read in, then things can change." self flag: #ByteString. steady _ {Array. Dictionary. Association. String. SmallInteger} asSet. renamed ifNil: [ renamed _ Dictionary new. "(old class name symbol -> new class name)" renamedConv _ Dictionary new "(oldClassNameSymbol -> conversionSelectorInNewClass)" ]. self initKnownRenames! ! !SocketStream methodsFor: 'private' stamp: 'ar 4/10/2005 19:13'! streamBuffer self flag: #ByteString. ^(self isBinary ifTrue: [String] ifFalse: [ByteArray]) new: self bufferSize! ! !SocketStream methodsFor: 'private' stamp: 'ar 4/10/2005 19:13'! streamBuffer: size self flag: #ByteString. ^(self isBinary ifTrue: [ByteArray] ifFalse: [String]) new: size! ! !Symbol methodsFor: 'private' stamp: 'ar 4/10/2005 19:13'! species self flag: #ByteString. ^String! ! !SystemDictionary methodsFor: 'special objects' stamp: 'ar 4/10/2005 19:13'! recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "The Special Objects Array is an array of object pointers used by the Squeak virtual machine. Its contents are critical and unchecked, so don't even think of playing here unless you know what you are doing." | newArray | newArray := Array new: 50. "Nil false and true get used throughout the interpreter" newArray at: 1 put: nil. newArray at: 2 put: false. newArray at: 3 put: true. "This association holds the active process (a ProcessScheduler)" newArray at: 4 put: (self associationAt: #Processor). "Numerous classes below used for type checking and instantiation" newArray at: 5 put: Bitmap. newArray at: 6 put: SmallInteger. newArray at: 7 put: String. self flag: #ByteString. newArray at: 8 put: Array. newArray at: 9 put: Smalltalk. newArray at: 10 put: Float. newArray at: 11 put: MethodContext. newArray at: 12 put: BlockContext. newArray at: 13 put: Point. newArray at: 14 put: LargePositiveInteger. newArray at: 15 put: Display. newArray at: 16 put: Message. newArray at: 17 put: CompiledMethod. newArray at: 18 put: (self specialObjectsArray at: 18). "(low space Semaphore)" newArray at: 19 put: Semaphore. newArray at: 20 put: Character. newArray at: 21 put: #doesNotUnderstand:. newArray at: 22 put: #cannotReturn:. newArray at: 23 put: nil. "*unused*" "An array of the 32 selectors that are compiled as special bytecodes, paired alternately with the number of arguments each takes." newArray at: 24 put: #(#+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1 #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1 #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0 #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ). "An array of the 255 Characters in ascii order." newArray at: 25 put: ((0 to: 255) collect: [:ascii | Character value: ascii]). newArray at: 26 put: #mustBeBoolean. newArray at: 27 put: ByteArray. newArray at: 28 put: Process. "An array of up to 31 classes whose instances will have compact headers" newArray at: 29 put: self compactClassesArray. newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)" newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)" "Prototype instances that can be copied for fast initialization" newArray at: 32 put: (Float new: 2). newArray at: 33 put: (LargePositiveInteger new: 4). newArray at: 34 put: Point new. newArray at: 35 put: #cannotInterpret:. "Note: This must be fixed once we start using context prototypes" newArray at: 36 put: (self specialObjectsArray at: 36). "(MethodContext new: CompiledMethod fullFrameSize)." newArray at: 37 put: nil. newArray at: 38 put: (self specialObjectsArray at: 38). "(BlockContext new: CompiledMethod fullFrameSize)." newArray at: 39 put: Array new. "array of objects referred to by external code" newArray at: 40 put: PseudoContext. newArray at: 41 put: TranslatedMethod. "finalization Semaphore" newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). newArray at: 43 put: LargeNegativeInteger. "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []). newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []). newArray at: 46 put: (self at: #ExternalData ifAbsent: []). newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []). newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []). newArray at: 49 put: #aboutToReturn:through:. newArray at: 50 put: #run:with:in:. "Now replace the interpreter's reference in one atomic operation" self specialObjectsArray become: newArray! ! !WriteStream methodsFor: 'accessing' stamp: 'ar 4/10/2005 19:13'! nextPut: anObject "Primitive. Insert the argument at the next position in the Stream represented by the receiver. Fail if the collection of this stream is not an Array or a String. Fail if the stream is positioned at its end, or if the position is out of bounds in the collection. Fail if the argument is not of the right type for the collection. Optional. See Object documentation whatIsAPrimitive." self flag: #ByteString. ((collection class == String) and: [ anObject isCharacter and:[anObject isOctetCharacter not]]) ifTrue: [ collection _ (MultiString from: collection). ^self nextPut: anObject. ]. position >= writeLimit ifTrue: [^ self pastEndPut: anObject] ifFalse: [position _ position + 1. ^collection at: position put: anObject]! ! !RWBinaryOrTextStream methodsFor: 'as yet unclassified' stamp: 'ar 4/10/2005 19:13'! next: anInteger "Answer the next anInteger elements of my collection. Must override to get class right." | newArray | self flag: #ByteString. newArray _ (isBinary ifTrue: [ByteArray] ifFalse: [String]) new: anInteger. ^ self nextInto: newArray! ! !RWBinaryOrTextStream methodsFor: 'as yet unclassified' stamp: 'ar 4/10/2005 19:13'! upToEnd "Must override to get class right." | newArray | self flag: #ByteString. newArray _ (isBinary ifTrue: [ByteArray] ifFalse: [String]) new: self size - self position. ^ self nextInto: newArray! ! DataStream initialize!