From VisualWorks®, 7.6 of February 8, 2008 on March 3, 2008 at 9:41:25 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>BOSSTransporter</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none stream storage useSource swapBytes <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSTransporter
BOSSTransporter just factors out a few variables and methods common between BOSSReader and BOSSWriter. In particular, it holds the shared ByteClasses dictionary. Instance Variables: stream <Stream> for reading or writing the objects storage <BinaryObjectStorage> holding global state useSource <Symbol> write method source and class organization if #keep, discard if #discard, just write pointers if #reference swapBytes <Boolean> if true, swap byte order of multi-byte quantities Class Variables: ByteClasses <IdentityDictionary key: Behavior value: Boolean> true means accessing methods mean the same as those of ByteArray; false means not the same, but no byte swapping required
</comment> <class> <name>BOSSReader</name> <environment>Kernel</environment> <super>Kernel.BOSSTransporter</super> <private>false</private> none readingClasses headers objects baseIndex recentClasses compiledCode deferredSends <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSReader
I read a single object structure that was stored in a rapidly-loadable binary format. Instance variables: readingClasses <Boolean> true if reading classes, false if reading ordinary objects headers <BOSSBytes> contains headers for objects being written objects <BOSSReaderMap> map indices to objects baseIndex <Integer> index of first object in structure recentClasses <OrderedCollection size: 15> recently used classes compiledCode <OrderedCollection of: Array> compiled code needing sources to be fixed up deferredSends <OrderedCollection of: MessageSend> evaluations that should not be performed until the compiledCode has been fixed up, along with any other cleanup Class Variables: XeroxMap <LargeArray> mapping from XCCS code points to Unicode code points. Because of 1-based indexing, add 1 to the XCCS value to find the right Unicode value. If a value maps to nil, the mapping is unknown--this does not mean that there is no mapping, only that the patch does not supply it. Odd-numbered imports have bit-type data, even-numbered have pointer-type.
</comment> <class> <name>BOSSRegisteredObject</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none name valueBlock writerClass value <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSRegisteredObject
I hold an object that has been registered for reverse-resolution at BOSS writing time. I hold a block for computing the value, rather than the value itself, so that BOSS doesn't need to worry about the changes in the values of global variables. Instance Variables: name <Symbol> the object name valueBlock <BlockClosure argument: Symbol> the block to compute the value writerClass <SmallInteger> the special reader index value <Object> cache the value
</comment> <class> <name>BOSSSpecialObjectLoader</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none message <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSSpecialObjectLoader
This class is used for loading objects that need some form of special treatment during loading. For example, if a Set indirectly contains a reference to itself, when loaded it may be mis-hashed, or may even drop objects completely. What is instead loaded is a BOSSSpecialObjectLoader that knows how to create a Set. When all other objects have been resolved, the object loader creates the Set, and becomes it. Because of this #become: operation, it is very important that the object which is created not be an existing object referred to elsewhere. Thus, this class is something of a loaded gun to be used at your own peril. Also, it won't solve absolutely every case of Set mis-hashing, but merely 90+% of them. For example, the BOSSSpecialObjectLoader itself may not have the same hash value as the object it represents, so if a Set contains itself, there's no hope. But didn't Bertrand Russell disallow that? Instance Variables: message <MessageSend> message which answers the object for which the instance is a proxy.
</comment> <class> <name>BOSSWriter</name> <environment>Kernel</environment> <super>Kernel.BOSSTransporter</super> <private>false</private> none headers bodies objects baseIndex currentClass recentClasses nextRecentClass bodySize nilIndex traceClasses registry <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSWriter
I write out a single object structure in a rapidly-loadable binary format. Instance variables: headers <BOSSBytes> contains headers for objects being written bodies <Array> bodies and classes of objects being written objects <IdentityDictionary of: (Object -> Integer)> map from objects to indices baseIndex <Integer> index of first object being written currentClass <ClassDescription> class for reverse-resolving Associations recentClasses <Array size: 15> ring buffer of recently used classes nextRecentClass <Integer between: 1 and: 15> next index for storing in ring buffer bodySize <Integer> total space for object bodies nilIndex <nil | Integer> object index for nil traceClasses <IdentityDictionary of: (Behavior -> Symbol)> selectors for tracing specific classes registry <OrderedCollection of: BOSSRegisteredObject> The swapBytes instance variable is only needed for the case where we are appending to a file that was written on a platform with a different byte order. See the documentation category in the class methods for more information about the file format. Non-negative values in the objects dictionary are encoded oops (header indices * 4) for objects that have been fully written. -1 is reserved. -2 means that this object is currently in the process of being written: if we encounter a -2, we assign an object index on the spot. This ensures that any object not involved in a circular reference will be written after all objects it references. Other negative indices indicate registered objects, the first being -3. Positive entries are strictly a cache for the writerMap in the BinaryObjectStorage. Individual tracing/writing methods return one of three values: - nil, meaning use the standard representation; - an Association (integer -> object), indicating that the object (in the form of either a ByteString or an Array) will be passed to a special import method with the given index; - an array of (receiver selector arg1 ... argn), indicating that the object will be constructed at read time by sending the given message. Internal methods of BOSSWriter can also return an integer, giving the object index.
</comment> <class> <name>BOSSReaderMap</name> <environment>Kernel</environment> <super>Core.Array</super> <private>false</private> objects baseIndex storage <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSReaderMap
I implement the index-to-object map when reading from a BinaryObjectStorage stream. Objects with indices in [baseIndex..baseIndex+(self size-1*4)] are stored directly; objects with other indices are looked up in the BinaryObjectStorage. Note that indices are 0-origin multiples of 4. Instance Variables: baseIndex <Integer> holds objects for this structure storage <BinaryObjectStorage> holds other objects
</comment> <class> <name>BOSSContents</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none object <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSContents
I hold an object that is normally stored by reference, and force it to write its contents instead. Instance variables: object <Class | Metaclass>
</comment> <class> <name>BinaryObjectStorage</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none stream platformDescription initialPosition readerClass writerClass sourceMode readerMap writerMap nextIndex registry versionReaders classVarLists expectCycles mapXeroxToUnicode <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BinaryObjectStorage
BinaryObjectStorage provides for writing object structures on a stream in a compact, rapidly loadable binary format, and reading them back in again. Instances of this class only hold the state that persists between successive reading or writing operations: each such operation creates a transient instance of BOSSReader or BOSSWriter to hold the temporary state of the reading or writing process. Instance Variables: stream <PositionableStream> stream for reading or writing object structures platformDescription <ByteArray> description of platform where objects were written initialPosition <Integer> position of first object structure readerClass <BOSSReader class> class to instantiate to read a structure writerClass <BOSSWriter class> class to instantiate to write a structure sourceMode <Symbol> #keep, #discard, or #reference readerMap <IdentityDictionary key: SmallInteger value: Object> map from object indices to objects writerMap <IdentityDictionary key: Object value: SmallInteger> map from objects to indices nextIndex <Integer> next object index to be assigned (a multiple of 4) registry <OrderedCollection of: BOSSRegisteredObject> versionReaders <IdentityDictionary of: (Behavior -> BlockClosure)> how to handle obsolete versions classVarLists <IdentityDictionary of: (Behavior -> (Array | nil))> lists of the names of all named instance variables for each class in the image that created the file. expectCycles <Boolean> controls policy concerning how cautious certain classes should be in storing themselves in a way that does not break due to pointer cycles mapXeroxToUnicode <Boolean | nil> nil is treated as false. If true, then a BOSSReader will attempt to transform Strings and Characters from XCCS encoding to Unicode. This may fail for strings that contain unusual characters. Class Variables: BinaryErrorSignal <Signal> comment FormatErrorSignal <Signal> comment HeaderErrorSignal <Signal> comment
</comment> <class> <name>BOSSDebugReader</name> <environment>Kernel</environment> <super>Kernel.BOSSReader</super> <private>false</private> none <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSDebugReader
I am a variant of BOSSReader that answers `next' with textual output for human consumption, not the actual object read.
</comment> <class> <name>BOSSBytes</name> <environment>Kernel</environment> <super>Core.ByteArray</super> <private>false</private> bytes <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSBytes
I add (some of) UninterpretedBytes accessing protocol to ByteArray. Unlike UninterpretedBytes, I do not attempt to recover from primitive failure: BOSS never invokes these operations with arguments needing coercion, and all the primitives are implemented. See UninterpretedBytes for the documentation of the methods copied from it.
</comment> <class> <name>BOSSCompiledCodeHolder</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none class selector category codeClass codeContents source <imports></imports> <category>System-Binary Storage</category> <attributes> <package>BOSS</package> </attributes> </class> <comment> Kernel.BOSSCompiledCodeHolder
I hold a compiled method that has been read in and is awaiting installation. Instance Variables: class <ClassDescription | nil> the class in which the method will be installed, if any selector <Symbol | nil> the selector for the method, if any category <String | nil> the category for the method, if any codeClass <CompiledCode class> the actual class of the method codeContents <Object | CompiledMethod> the instance variables of the method, as an array source <nil | Integer | String> the source code
</comment> <name>BinaryErrorSignal</name> <environment>Kernel.BinaryObjectStorage</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>BOSS</package> </attributes> <name>FormatErrorSignal</name> <environment>Kernel.BinaryObjectStorage</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>BOSS</package> </attributes> <name>HeaderErrorSignal</name> <environment>Kernel.BinaryObjectStorage</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>BOSS</package> </attributes> <name>XeroxMap</name> <environment>Kernel.BOSSReader</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>BOSS</package> </attributes> <name>ByteClasses</name> <environment>Kernel.BOSSTransporter</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>BOSS</package> </attributes> <methods> Kernel.BOSSTransporter <category>private-initialize-release</category>
storage: aBOS on: aStream storage := aBOS. stream := aStream. useSource := aBOS sourceMode. swapBytes := aBOS isBigEndian ~= UninterpretedBytes isBigEndian
</methods> <methods> Kernel.BOSSTransporter class <category>class initialization</category>
initialize "BOSSTransporter initialize" ByteClasses := IdentityDictionary new: 10. ByteClasses at: ByteArray put: true; at: ByteString put: false; at: ByteSymbol put: false
</methods> <methods> Kernel.BOSSReader <category>reading</category>
next " Read the next object from the stream. " readingClasses := false. ^self readObject
nextClassesWithSource: sourceMode "Read a collection of classes. The semantics are equivalent to fileIn, i.e., only the code is read, not the values of the class variables or class instance variables." useSource := sourceMode. readingClasses := true. ^Class commentRequestSignal handle: [:ex | ex proceedWith: useSource ~= #discard] do: [self readObject]
skipNext " Skip over one structure. Answer an Interval of the object indices it defines, or nil if this is an immediate object or a single reference. " | first prefix | first := BOSSBytes new: 12. "room for largest prefix" stream next: 4 into: first startingAt: 1. swapBytes ifTrue: [first swapBytesWidth: 4]. prefix := first longAt: 1. (prefix bitAnd: 3) = 2 ifFalse: [^nil]. "single oop" prefix >= 0 ifTrue: [stream next: 12 into: first startingAt: 1. swapBytes ifTrue: [first swapBytesWidth: 4]]. ^self skipNext: prefix first: first
</methods> <methods> Kernel.BOSSReader <category>reading-imports</category>
importAssociation: classAndSymbol " Resolve aSymbol in the context of the current class. " | cls sym assoc | cls := classAndSymbol at: 1. sym := classAndSymbol at: 2. ^(assoc := cls fullBindingFor: sym) == nil ifFalse: [assoc] ifTrue: [" Association doesn't exist in the environment. Find or create it in Undeclared" assoc := SystemUtils undeclaredName: sym. assoc]
importByteString: aByteString " Guarantee unique representation for Symbols. " storage mapXeroxToUnicode ifTrue: [self class mapStringToUnicode: aByteString]. ^aByteString
importByteSymbol: aByteString " Guarantee unique representation for Symbols. " storage mapXeroxToUnicode ifTrue: [self class mapStringToUnicode: aByteString]. ^aByteString asSymbol
importClass: info " info is a 4-element array: name, meta flag, version, and format. " | cls varList isMeta | cls := info first asQualifiedReference value. (isMeta := info at: 2) ifTrue: [cls := cls class]. "metaclass" info size < 5 ifTrue: [varList := self assumedVariableListFor: cls describedBy: info] ifFalse: [varList := info at: 5. varList == nil ifTrue: [varList := #()]]. varList = cls allInstVarNames asArray ifTrue: [varList := nil]. storage variablesForClass: cls put: varList. isMeta ifTrue: [^cls]. "Don't need to worry about type mismatch." ((info at: 3) = cls binaryRepresentationVersion and: [| mask | mask := cls formatMask. ((info at: 4) bitAnd: mask) = (cls format bitAnd: mask) and: [varList == nil]]) ifFalse: [storage readerBlockFor: cls put: (cls binaryReaderBlockForVersion: (info at: 3) format: (info at: 4))]. ^cls
importCompiledCode: info " info is a BOSSCompiledCodeHolder " | oldCode | self change: info toInstanceOf: BOSSCompiledCodeHolder. info useSource: useSource. info computeCodeForStorage: storage. readingClasses ifFalse: [info dontInstall]. oldCode := info existingCode. ^oldCode = info code ifTrue: [" The same code is already installed. Don't disturb it. " oldCode] ifFalse: [" We let the info stand in for the actual compiled method until the final commit. " compiledCode isNil ifTrue: [compiledCode := OrderedCollection new]. compiledCode addLast: info. info]
importFloat: bytes " Someday we might handle non-IEEE floats. " | bsize float | bsize := bytes size. float := bsize = 4 ifTrue: [1.0] ifFalse: [bsize = 8 ifTrue: [1.0d] ifFalse: [self error: 'Unknown float size!'. ^0.0 + 0.0]]. float := bytes changeClassToThatOf: float. swapBytes ifTrue: [float reverseByteOrder]. ^float
importGlobal: aSymbol ^aSymbol asQualifiedReference value
importNameSpace: info " info is an array with a fullName. " ^info first asQualifiedReference value
importSend: msgArray ^(msgArray at: 1) perform: (msgArray at: 2) withArguments: (msgArray copyFrom: 3 to: msgArray size)
importSendSelf: msgArray ^self perform: (msgArray at: 1) withArguments: (msgArray copyFrom: 2 to: msgArray size)
importTwoByteSymbol: aByteString " Guarantee unique representation for Symbols. " aByteString changeClassToThatOf: (TwoByteString basicNew: 0). swapBytes ifTrue: [aByteString reverseByteOrder]. storage mapXeroxToUnicode ifTrue: [self class mapStringToUnicode: aByteString]. ^aByteString asSymbol
</methods> <methods> Kernel.BOSSReader <category>private-initialize-release</category>
storage: aBOS on: aStream super storage: aBOS on: aStream. recentClasses := OrderedCollection withAll: (1 to: BinaryObjectStorage flagRecentClassMask).
</methods> <methods> Kernel.BOSSReader <category>private-reading</category>
assumedVariableListFor: cls describedBy: info "Answer the list of instance variable names that a given class had in a previous version. This only applies to objects BOSSed out before VisualWorks 2.0, and is a compatibility aid for loading in old BOSS files. Since this information will be used primarily for patching up instance variable refs in BOSSed methods, and since these methods are much more likely to be associated with ExternalInterfaces than anything else, we're focusing on that problem. Other problematic cases could be addressed here as you need them. Answering nil for a class should be taken as an indication that the class had the same instance variables in its previous version as it has now. Even if this is not true, it's acceptible if the methods being loaded don't refer to any instance variables directly. Invoking a method with bogus instance variable offsets may cause crashes (UAEs, core dumps, etc) or other errors that are hard to diagnose." | ext list | ext := #('externals' ). (cls includesBehavior: ExternalInterface) ifTrue: [list := cls allInstVarNames asArray. list size = ((info at: 4) bitAnd: 255) ifFalse: [(list includes: ext first) ifFalse: [list := ext , list]]. ^list]. ^nil
readObject | first count prefix topIndex | first := BOSSBytes new: 12. stream next: 4 into: first startingAt: 1. swapBytes ifTrue: [first swapBytesWidth: 4]. prefix := first longAt: 1. (prefix bitAnd: 3) = 2 ifFalse: [baseIndex := 0. objects := BOSSReaderMap new: 0 baseIndex: 0. "in case of back reference" objects storage: storage. ^self singleObjectFrom: first]. "single object reference" baseIndex := prefix bitAnd: 16r1ffffffc. prefix < 0 ifTrue: "single object" [topIndex := baseIndex. count := 1] ifFalse: [stream next: 12 into: first startingAt: 1. swapBytes ifTrue: [first swapBytesWidth: 4]. topIndex := first longAt: 1. count := first longAt: 5]. objects := BOSSReaderMap new: count baseIndex: baseIndex. objects storage: storage. " If we are being asked to read an already-known object, just skip over it and return the object. " (storage objectAtIndex: topIndex) notNil ifTrue: [(self skipNext: prefix first: first) do: [:i | objects at: i put: (storage objectAtIndex: i)]. first longAt: 1 put: topIndex. ^self singleObjectFrom: first]. headers := BOSSBytes new: count * 4. stream next: headers size into: headers startingAt: 1. "read headers" swapBytes ifTrue: [headers swapColumn: 2 with: 3]. "swap bytes of identity hash" ^self readObjects: first topIndex: topIndex
readObjects: first topIndex: topIndex " Read in and fix up all the objects. " | count buf deferredBodies | count := headers size // 4. deferredBodies := OrderedCollection new: (count // 10 max: 5). "estimate" compiledCode := nil. buf := BOSSBytes new: 4. 1 to: count do: [:i | | objx class size flags shortClass special inst short forward | objx := i - 1 bitShift: 2. self resolveCyclesUpTo: objx in: deferredBodies. flags := self flagsOf: objx. short := flags anyMask: BinaryObjectStorage flagHasShortOops. shortClass := flags bitAnd: BinaryObjectStorage flagRecentClassMask. forward := flags anyMask: BinaryObjectStorage flagHasForwardReferences. shortClass = 0 ifTrue: [class := short ifTrue: [stream next: 2 into: buf startingAt: 1. swapBytes ifTrue: [buf swap: 1 with: 2]. buf shortObjectAt: 1 from: objects baseIndex: baseIndex] ifFalse: [stream next: 4 into: buf startingAt: 1. swapBytes ifTrue: [buf swap: 1 with: 4. buf swap: 2 with: 3]. buf objectAt: 1 from: objects baseIndex: baseIndex]. forward ifFalse: [recentClasses removeLast; addFirst: class]] ifFalse: [class := recentClasses at: shortClass]. size := self sizeOf: objx. size = 16rff ifTrue: [stream next: 4 into: buf startingAt: 1. swapBytes ifTrue: [buf swapBytesWidth: 4]. size := buf longAt: 1]. special := class isImmediate. (flags anyMask: BinaryObjectStorage flagIsBits) ifTrue: [inst := stream next: size. forward ifTrue: "can only happen if object has dependents" [deferredBodies add: (Array with: i - 1 with: class)] ifFalse: [special ifTrue: [inst changeClassToThatOf: ''. storage mapXeroxToUnicode ifTrue: [self class mapStringToUnicode: inst]] ifFalse: [self change: inst toInstanceOf: class. (swapBytes and: [(ByteClasses at: class ifAbsent: [nil]) == nil]) ifTrue: [inst reverseByteOrder]]]] ifFalse: [inst := Array new: size // (short ifTrue: [2] ifFalse: [4]). forward ifFalse: "can resolve now" [size > buf size ifTrue: [buf := BOSSBytes new: size]. stream next: size into: buf startingAt: 1. self resolveArray: inst from: buf short: short. special ifFalse: [self change: inst toInstanceOf: class]] ifTrue: "must resolve later" [| bits | bits := BOSSBytes new: size. stream next: size into: bits startingAt: 1. self cyclicBody: (Array with: i - 1 with: class with: bits) to: deferredBodies using: short]]. (special and: [forward not]) ifTrue: [" Handle import " | sel | sel := BinaryObjectStorage importSelectors at: class. inst := self perform: sel with: inst]. objects at: (i - 1 bitShift: 2) + baseIndex put: inst. (flags anyMask: BinaryObjectStorage flagIsImmutable) ifTrue: [self deferSend: (MessageSend receiver: inst selector: #isImmutable: argument: true)]]. " Now fill in the remaining objects " [deferredBodies isEmpty] whileFalse: [| index inst hx class body | body := deferredBodies removeFirst. index := body at: 1. hx := index bitShift: 2. inst := objects at: hx + baseIndex. class := body at: 2. inst class isBits ifFalse: [self resolveArray: inst from: (body at: 3) short: ((self flagsOf: hx) anyMask: BinaryObjectStorage flagHasShortOops)]. class isImmediate ifTrue: [inst become: (self perform: (BinaryObjectStorage importSelectors at: class) with: inst)] ifFalse: [self change: inst toInstanceOf: class. (swapBytes and: [class isBits and: [(ByteClasses at: class ifAbsent: [nil]) == nil]]) ifTrue: [inst reverseByteOrder]]]. headers := stream := nil. "release references" self commitSources. "update source" self evaluateSends. "evaluate any message sends that were just for effect" ^objects at: topIndex
resolveCyclesUpTo: maxIndex in: bodies "Fix up those objects that have forward references, if all the forward references have been resolved." | i body index hx inst class | i := 1. [i <= bodies size] whileTrue: [body := bodies at: i. (body size < 4 or: [(body at: 4) > maxIndex]) ifTrue: [i := i+1] ifFalse: [bodies removeAtIndex: i. index := body at: 1. hx := index bitShift: 2. inst := objects at: hx + baseIndex. class := body at: 2. self resolveArray: inst from: (body at: 3) short: ((self flagsOf: hx) anyMask: BinaryObjectStorage flagHasShortOops). class isImmediate ifTrue: [inst become: (self perform: (BinaryObjectStorage importSelectors at: class) with: inst)] ifFalse: [self change: inst toInstanceOf: class]]].
singleObjectFrom: first " Answer a single object whose oop is the first 4 bytes of first. " ^first objectAt: 1 from: objects baseIndex: 0
</methods> <methods> Kernel.BOSSReader <category>private</category>
change: obj toInstanceOf: aClass "Only TwoByteString needs special treatment when loading XCCS strings into a Unicode environment. ByteStrings and Characters are not passed through this method." | inst readBlock | readBlock := storage readerBlockFor: aClass. readBlock == nil ifFalse: [^readBlock value: obj]. inst := aClass isVariable ifTrue: [aClass basicNew: 0] ifFalse: [aClass basicNew]. storage usesReaderBlocks ifTrue: [aClass == TwoByteString ifFalse: [storage readerBlockFor: aClass put: [:o | o changeClassToThatOf: inst]]]. obj changeClassToThatOf: inst. (storage mapXeroxToUnicode and: [aClass == TwoByteString]) ifTrue: [self class mapStringToUnicode: obj]. ^obj
commitSources " If we loaded any compiled methods, commit the changes file and update the source pointers now. " compiledCode == nil ifFalse: [| stored | stored := false. compiledCode do: [:info | info storeSource ifTrue: [stored := true]]. stored ifTrue: [SourceFileManager default commitSources]. compiledCode do: [:info | | code | code := info code. info become: code. "identities are now swapped" code commit: info]]
createSpecialObject: anObjectProxy self deferSend: (MessageSend receiver: anObjectProxy selector: #resolve). ^anObjectProxy
cyclicBody: aBody to: bodies using: short "Add a forwarding reference to an object. This will be resolved later." | max bits | max := 0. bits := (aBody at: 3) copy. swapBytes ifTrue: [bits swapBytesWidth: (short ifTrue: [2] ifFalse: [4])]. short ifTrue: [1 to: bits size by: 2 do: [:i | max := max max: (bits unsignedShortAt: i)]] ifFalse: [1 to: bits size by: 4 do: [:i | max := max max: (bits unsignedLongAt: i)]]. bodies add: (aBody copyWith: max).
deferSend: aMessageSend "This MessageSend should not be evaluated until after all other action has been taken. Record it for later evaluation" deferredSends == nil ifTrue: [deferredSends := OrderedCollection new]. deferredSends add: aMessageSend
evaluateSends "If any MessageSends were loaded that were supposed to be deferred until later, evaluate them" deferredSends == nil ifFalse: [deferredSends do: [:send | send value]]
flagsOf: objx " Answer the flags from the header. " ^headers byteAt: objx + 1
resolveArray: inst from: body short: shortFlag swapBytes ifTrue: [body swapBytesWidth: (shortFlag ifTrue: [2] ifFalse: [4])]. shortFlag ifTrue: [1 to: inst size do: [:i | inst at: i put: (body shortObjectAt: (i bitShift: 1) - 1 from: objects baseIndex: baseIndex)]] ifFalse: [1 to: inst size do: [:i | inst at: i put: (body objectAt: (i bitShift: 2) - 3 from: objects baseIndex: baseIndex)]]
sizeOf: objx " Answer the size from the header. " ^headers byteAt: objx + 2
skipNext: prefix first: first " Do the work of skipping over one structure. first is a 12-element BOSSBytes. prefix is the first 4 bytes of the structure header as an integer. If prefix is negative, the first 4 bytes of first hold prefix; is prefix is non-negative, first holds the next 12 bytes of the header; in either case, any needed byte swapping has been done. Answer the interval of object indices. " baseIndex := prefix bitAnd: 16r1ffffffc. prefix < 0 ifTrue: "single object" [| flags size | stream next: 4 into: first startingAt: 1. flags := first byteAt: 1. size := first byteAt: 2. (flags anyMask: BinaryObjectStorage flagRecentClassMask) ifFalse: "explicit class" [stream next: ((flags anyMask: BinaryObjectStorage flagHasShortOops) ifTrue: [2] ifFalse: [4])]. size = 16rff ifTrue: "large object" [stream next: 4 into: first startingAt: 1. swapBytes ifTrue: [first swapBytesWidth: 4]. size := first longAt: 1]. stream skip: size. ^baseIndex to: baseIndex by: 4] ifFalse: "multiple objects" [| count | count := (first longAt: 5) * 4. stream skip: count + (first longAt: 9). ^baseIndex to: baseIndex + count - 4 by: 4]
</methods> <methods> Kernel.BOSSReader class <category>initialize</category>
initialize "BOSSReader initialize" XeroxMap := LargeArray new: 65536. XeroxMap replaceFrom: 1 to: 256 with: #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 nil 167 nil 8216 8220 171 nil nil nil nil 176 177 180 179 215 181 182 183 247 8217 8221 187 188 189 190 191 nil 96 180 710 732 175 728 729 168 nil 176 184 nil 733 731 711 175 185 174 169 8482 nil nil nil nil nil nil nil nil nil nil nil 8486 198 208 170 nil nil nil nil nil 216 338 186 222 nil nil nil nil 230 nil 240 nil 305 nil nil nil 248 339 223 254 nil nil 160); replaceFrom: 8449 to: 8704 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 173 nil nil nil nil nil 8230 8230 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8800 nil nil 8804 8805 8734 8756 nil nil nil 8242 8243 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9674 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8465 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8476 nil nil nil nil nil nil nil nil nil nil nil nil nil 8657 8659 8472 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 8705 to: 8960 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9632 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 8961 to: 9216 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 168 nil nil nil nil 184 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 9729 to: 9984 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 913 914 nil 8710 916 917 nil nil 918 919 920 921 922 923 924 925 926 927 928 nil 929 931 982 932 933 934 935 936 937 nil 978 nil 945 946 nil 947 948 949 962 nil 950 951 952 953 954 955 181 957 958 959 960 nil 961 963 nil 964 965 966 967 968 969 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 10241 to: 10496 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9484 9488 9496 9492 9500 9516 9508 9524 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 166 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9571 9553 9559 9565 nil nil nil nil 9562 9556 9577 9574 9568 9552 9580 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 60673 to: 60928 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 63743 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 60929 to: 61184 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8218 nil nil nil nil nil nil nil nil nil nil nil nil nil 8962 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 402 nil nil nil nil nil nil nil nil nil nil nil 9617 9619 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 63726 63728 63738 63737 63739 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8592 8593 8594 8595 nil nil nil nil 8901 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9829 9830 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9632 nil 63740 63735 63741 63742 63729 63731 63730 nil nil nil nil nil nil 8992 8993 63733 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 61185 to: 61440 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8211 8212 nil nil 8222 nil 8249 8250 nil nil nil nil 8224 8225 9001 9002 nil nil nil nil nil nil nil nil nil nil nil nil nil 8240 nil nil nil nil 8260 nil nil nil 8712 8713 8717 8656 8660 8658 nil nil 8596 nil nil nil 8745 8746 8839 8838 8835 8834 nil nil nil 8836 nil 8709 8853 nil 8855 nil 8226 nil nil nil 172 166 8736 nil nil nil 8869 8733 8801 nil nil 8747 nil nil 8773 8776 8721 8719 8730 nil 9618 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 402 nil nil nil nil 8501 nil nil nil nil nil nil nil nil nil nil nil nil 8707 8704 8743 8744 nil 8711 8706 nil nil nil nil 8215 nil nil nil nil nil nil nil nil nil nil nil 9824 nil 8900 9827 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9474 9472 9532 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 61441 to: 61696 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 64257 64258 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 188 189 190 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9608 9604 nil nil 9600 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 61697 to: 61952 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 192 193 194 195 nil nil 196 197 nil nil nil nil 199 nil nil 200 201 202 nil nil 203 nil nil nil nil nil nil nil nil 204 205 206 nil nil nil 207 nil nil nil nil nil nil nil 209 nil nil 210 211 212 213 nil 214 nil nil nil nil nil nil nil 352 nil nil 217 218 219 nil nil nil 220 nil nil nil nil nil 221 nil 376 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 224 225 226 227 nil nil 228 229 nil nil nil nil 231 nil nil 232 233 234 nil nil 235 nil nil nil nil nil nil nil nil 236 237 238 nil nil nil 239 nil nil nil nil nil nil nil 241 nil nil 242 243 244 245 nil 246 nil nil nil nil nil nil nil 353 nil nil 249 250 251 nil nil nil 252 nil nil nil nil nil 253 nil 255 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); replaceFrom: 64769 to: 65024 with: #(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 981 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 977 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8260 nil 185 178 179 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 63717 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 305 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil); compress
</methods> <methods> Kernel.BOSSReader class <category>utilities</category>
mapStringToUnicode: str | ch | 1 to: str size do: [:index | ch := XeroxMap at: (str at: index) asInteger + 1. ch == nil ifTrue: [self notify: 'Character could not be mapped. Old character will be used if you proceed'. ch := str at: index]. str at: index put: ch asCharacter].
mapToUnicode: char | ch | ch := XeroxMap at: char asInteger + 1. ch == nil ifTrue: [self notify: 'Character could not be mapped. Old character will be used if you proceed'. ch := char]. ^ch
</methods> <methods> Kernel.BOSSRegisteredObject <category>initialize-release</category>
name: objName valueBlock: aBlock class: index name := objName asString. valueBlock := aBlock. writerClass := index
update " Update the value by evaluating the valueBlock. " value := valueBlock value: name
</methods> <methods> Kernel.BOSSRegisteredObject <category>accessing</category>
value ^value
</methods> <methods> Kernel.BOSSRegisteredObject <category>private-tracing</category>
traceOn: writer " This message is only for use by BOSSWriter. " | objx | objx := writer assign: value. writer record: value body: name class: writerClass flags: 0 index: objx. ^objx
</methods> <methods> Kernel.BOSSSpecialObjectLoader <category>accessing</category>
message: msgSend "Set the message that the receiver will use to create a new object. In order to work, the message MUST create and return a new object, rather than returning an existing object. The act of getting rid of the receiver uses a #become:, which would mess up badly existing references to the object returned." message := msgSend
</methods> <methods> Kernel.BOSSSpecialObjectLoader <category>resolving</category>
resolve "The system has been stabilized somewhat. It is now possible to create the actual object, who should now be able to trust information such as hash values." ^self become: message value
</methods> <methods> Kernel.BOSSSpecialObjectLoader class <category>instance creation</category>
message: msgSend "Create a new object loader, which will use the message to create an object. In order to work, the message MUST create and return a new object, rather than returning an existing object. The act of getting rid of the receiver uses a #become:, which would mess up badly existing references to the object returned." ^self new message: msgSend
</methods> <methods> Kernel.BOSSWriter <category>writing</category>
nextPut: topObject self nextPut: topObject do: []. ^topObject
nextPutClasses: classes withSource: sourceMode "Store a collection of classes. The semantics are equivalent to fileOut, i.e., only the code is written, not the values of the class variables or class instance variables." "This message can be used to write classes for a runtime environment, if sourceMode is #discard." | classSet objColl | useSource := sourceMode. classSet := IdentitySet new: classes size * 2. classes do: [:c | classSet add: c. (c class isMeta and: [c class nonTrivial]) ifTrue: [classSet add: c class]]. objColl := SystemUtils sortForLoading: classSet. objColl := objColl asArray. self nextPut: objColl do: [objColl do: [:c | currentClass := c. self trace: (BOSSContents new object: c). self trace: c. c selectorsAndMethodsDo: [:s :meth | self trace: meth]]. objColl do: [:c | | list | list := c binaryInitializationMessagesFor: useSource. list do: [:msg | | init | init := Array with: #deferSend: with: msg. self trace: init body: init class: BinaryObjectStorage indexImportSendSelf]]]
</methods> <methods> Kernel.BOSSWriter <category>tracing-policy</category>
expectCycles ^storage expectCycles
traceSelectorFor: anObject " anObject is the first object of its class encountered so far. Answer the message selector that should be sent to self to trace the object. The default is represent:, which simply asks the object for its preferred representation. " ^#represent:
</methods> <methods> Kernel.BOSSWriter <category>representation</category>
represent: anObject " This is the representation method for otherwise undistinguished objects. The default is to ask the object itself what representation to use. " ^anObject representBinaryOn: self
representCompiledMethod: aCompiledMethod " This is the representation method for compiled code objects, invoked from CompiledMethod>>representBinaryOn:. It manages the saving and restoring of the source code or source pointer. " | obj src cls sel cat | obj := aCompiledMethod shallowCopy. src := obj sourcePointer. obj sourcePointer: nil. sel := currentClass selectorAtMethod: aCompiledMethod setClass: [:c |] ifAbsent: [nil]. cls := aCompiledMethod mclass. cat := Object errorSignal handle: [:ex | ex returnWith: nil] do: [cls whichCategoryIncludesSelector: sel]. src notNil ifTrue: [useSource == #keep ifTrue: [src := aCompiledMethod getSource] ifFalse: [useSource == #reference ifFalse: [src := nil]]]. ^BinaryObjectStorage indexImportCompiledCode -> (BOSSCompiledCodeHolder new class: cls selector: sel category: cat codeClass: aCompiledMethod class codeContents: (obj changeClassToThatOf: #()) source: src)
representContext: aContext "This is the representation method for Contexts, invoked from Context>>representBinaryOn:. It manages the saving and restoring of the current class. " "Use the standard representation, but rebind currentClass (for finding the method) while tracing the contents. " | saveClass objx | self trace: aContext class. saveClass := currentClass. currentClass := aContext method mclass. objx := self trace: aContext body: aContext class: aContext class. currentClass := saveClass. ^objx
</methods> <methods> Kernel.BOSSWriter <category>private-tracing</category>
nextPut: topObject do: traceBlock " Put out an object, but evaluate traceBlock first. " | bits nextIndex count | (topObject isImmediate or: [(storage indexOf: topObject) notNil]) ifTrue: [^self writeIndexOnly: topObject]. baseIndex := storage nextIndex. traceBlock value. self trace: topObject. nextIndex := storage nextIndex. count := nextIndex - baseIndex // 4. count = 0 ifTrue: [" Top object was aliased (probably to nil). " ^self writeIndexOnly: topObject]. count = 1 ifTrue: [bits := BOSSBytes new: 4. bits longAt: 1 put: baseIndex - 16r80000000 + 2] ifFalse: [bits := BOSSBytes new: 16. bits longAt: 1 put: baseIndex + 2. bits longAt: 5 put: (storage indexOf: topObject). bits longAt: 9 put: count. bits longAt: 13 put: bodySize]. swapBytes ifTrue: [bits swapBytesWidth: 4]. stream nextPutAll: bits. swapBytes ifTrue: [headers swapColumn: 2 with: 3]. "swap bytes of identity hash" stream nextPutAll: (headers copyFrom: 1 to: nextIndex - baseIndex). 1 to: count * 2 by: 2 do: [:i | self write: (bodies at: i) class: (bodies at: i + 1) on: stream flags: (headers byteAt: i * 2 - 1)]
trace: anObject " Recursively trace anObject. Return the encoding of the object. " | objx | objx := anObject == nil ifTrue: [nilIndex] ifFalse: [objects at: anObject ifAbsent: [| ox | ox := storage indexOf: anObject. ox notNil ifTrue: [objects at: anObject put: ox] ifFalse: [-1]]]. objx >= 0 ifTrue: [^objx]. objx = -1 ifTrue: [| sel value | " Optimize represent: " sel := traceClasses at: anObject class ifAbsent: [#traceUnknown:]. sel == #represent: ifTrue: [value := self represent: anObject. value isImmediate ifTrue: [" A special representation method might have been invoked. Check whether the return value is actually a correct object index. " value isInteger ifTrue: [value = nilIndex ifTrue: [" Substitute nil for the object. " objects at: anObject put: value] ifFalse: [((value anyMask: 2) ifTrue: [value - 2 + baseIndex] ifFalse: [value]) = (objects at: anObject ifAbsent: [nil]) ifFalse: [self error: 'Immediate representation is not allowed'. value := nil]]]]] ifFalse: [value := self perform: sel with: anObject]. value == nil ifTrue: "use standard representation" [self trace: anObject class. ^self trace: anObject body: anObject class: anObject class]. value isInteger ifTrue: [^value]. "internal method returned objx" " Trace a generic object with special handling. " (value isMemberOf: Association) ifTrue: "special reader index" ["Check to make sure that the representation is minimally compatible with the index. " | index arg | index := value key. arg := value value. (arg class isBits = index odd) ifFalse: [self error: 'Incompatible representation'. ^nil]. ^self trace: anObject body: arg class: index]. ^self trace: anObject body: (Array with: value receiver with: value selector) , value arguments class: BinaryObjectStorage indexImportSend]. objx = -2 ifTrue: [" Circular / recursive reference. Assign the index now; the correct flags and body will be supplied when we return out of the recursion. " ^self assign: anObject]. " Registered object. " ^(registry at: -2 - objx) traceOn: self
trace: anObject body: body class: aClass " Record anObject in the objects dictionary, and trace its dependents and body if needed. The caller has already traced the class. " | class objx flags deps | deps := anObject isBehavior ifTrue: [nil] ifFalse: [DependentsFields at: anObject ifAbsent: [nil]]. class := body class. (class isBits and: [deps == nil]) ifTrue: [objx := self assign: anObject. self record: anObject body: body class: aClass flags: 0 index: objx. ^objx]. " Recursively trace the contents of the body. If the object has circular references, the trace may assign the object index. " anObject == nil ifFalse: [objects at: anObject put: -2]. flags := BinaryObjectStorage flagHasShortOops. deps == nil ifFalse: [self trace: (anObject -> deps) body: (Array with: anObject with: #myDependents: with: deps) class: BinaryObjectStorage indexImportSend]. class isBits ifFalse: [1 to: class instSize do: [:i | ((self trace: (body instVarAt: i)) bitAnd: -16r10000) = 0 ifFalse: [flags := 0]]. class isVariable ifTrue: [1 to: body basicSize do: [:i | ((self trace: (body basicAt: i)) bitAnd: -16r10000) = 0 ifFalse: [flags := 0]]]]. objx := self encode: anObject. objx < 0 ifTrue: [objx := self assign: anObject] ifFalse: [flags := flags + BinaryObjectStorage flagHasForwardReferences]. self record: anObject body: body class: aClass flags: flags index: objx. ^objx
traceAssociation: assoc " If the association can be reverse-resolved, represent it as its name, otherwise represent it as its contents. " ^((currentClass fullBindingFor: assoc key) == assoc or: [(Undeclared bindingFor: assoc key) == assoc]) ifTrue: [BinaryObjectStorage indexImportAssociation -> (Array with: currentClass with: assoc key)] ifFalse: [nil]
traceSkip: anObject " Encode immediate objects directly. " ^self encode: anObject
traceUnknown: anObject " anObject is the first object of its class encountered so far. Determine and record how to trace objects of this class in the future. " traceClasses at: anObject class put: (self traceSelectorFor: anObject). ^self trace: anObject
</methods> <methods> Kernel.BOSSWriter <category>private</category>
assign: anObject " Record anObject in the objects dictionary, and return its assigned index. " | objx | objx := storage assignIndexFor: anObject. objects at: anObject put: objx. "overwrite the -2" objx - baseIndex >= headers size ifTrue: [headers := headers , (BOSSBytes new: headers size). bodies := bodies , (Array new: bodies size)]. ^objx >= (baseIndex + 16r10000) ifTrue: [objx] ifFalse: [objx - baseIndex + 2]
encode: anObject | class objx | class := anObject class. class == SmallInteger ifTrue: [^(anObject bitShift: 2) + 3]. class == Character ifTrue: [^(anObject asInteger bitShift: 2) + 1]. anObject == nil ifTrue: [^nilIndex]. objx := objects at: anObject ifAbsent: [nil]. objx == nil ifTrue: [objx := storage indexOf: anObject]. objx == nil ifTrue: [^nil]. (objx >= baseIndex and: [objx < (baseIndex + 16r10000)]) ifTrue: [^objx - baseIndex + 2]. ^objx
record: anObject body: body class: aClass flags: flags index: objx " Record the header and body for anObject, and accumulate the body size. " | class fl osize localx oop cx shortClass bx | class := body class. fl := flags. oop := (flags anyMask: BinaryObjectStorage flagHasShortOops) ifTrue: [2] ifFalse: [4]. cx := self encode: aClass. shortClass := (fl anyMask: BinaryObjectStorage flagHasForwardReferences) ifTrue: [-1] ifFalse: [recentClasses indexOf: cx]. shortClass <= 0 ifTrue: [((cx bitAnd: -16r10000) ~= 0 and: [oop = 2]) ifTrue: [fl := fl - BinaryObjectStorage flagHasShortOops. oop := 4]. bodySize := bodySize + oop. shortClass = 0 ifTrue: [nextRecentClass := nextRecentClass = 1 ifTrue: [recentClasses size] ifFalse: [nextRecentClass - 1]. recentClasses at: nextRecentClass put: cx]] ifFalse: [shortClass := shortClass - nextRecentClass + 1. shortClass <= 0 ifTrue: [shortClass := shortClass + recentClasses size]. fl := fl + shortClass]. osize := class isBits ifTrue: [fl := fl + BinaryObjectStorage flagIsBits. body basicSize] ifFalse: [(class instSize + (class isVariable ifTrue: [body basicSize] ifFalse: [0])) * oop]. osize >= 16rff ifTrue: [bodySize := bodySize + 4]. localx := (objx anyMask: 2) ifTrue: [objx - 2] ifFalse: [objx - baseIndex]. anObject isImmutable ifTrue: [fl := fl + BinaryObjectStorage flagIsImmutable]. fl ~= 0 ifTrue: [headers byteAt: localx + 1 put: fl]. headers byteAt: localx + 2 put: (osize min: 16rff). headers unsignedShortAt: localx + 3 put: (anObject identityHash bitAnd: 16rffff). bx := localx bitShift: -1. bodies at: bx + 1 put: body. shortClass <= 0 ifTrue: [bodies at: bx + 2 put: cx]. bodySize := bodySize + osize
write: body class: cx on: aStream flags: flags | oop class osize bits | oop := (flags anyMask: BinaryObjectStorage flagHasShortOops) ifTrue: [2] ifFalse: [4]. (flags noMask: BinaryObjectStorage flagRecentClassMask) ifTrue: [bits := BOSSBytes new: oop. oop = 2 ifTrue: [bits unsignedShortAt: 1 put: cx] ifFalse: [bits unsignedLongAt: 1 put: cx]. swapBytes ifTrue: [bits swapBytesWidth: oop]. aStream nextPutAll: bits]. class := body class. class isBits ifTrue: [| byteType | osize := body basicSize. osize >= 16rff ifTrue: [bits := BOSSBytes new: 4. bits longAt: 1 put: osize. swapBytes ifTrue: [bits swapBytesWidth: 4]. aStream nextPutAll: bits]. byteType := ByteClasses at: class ifAbsent: [nil]. byteType == true ifTrue: [aStream nextPutAll: body] ifFalse: [(byteType == nil and: [swapBytes]) ifTrue: [bits := body shallowCopy. bits reverseByteOrder. bits changeClassToThatOf: (BOSSBytes new: 0)] ifFalse: [bits := BOSSBytes new: osize. bits replaceBytesFrom: 1 with: body]. aStream nextPutAll: bits]] ifFalse: [| pos | osize := (class instSize + (class isVariable ifTrue: [body basicSize] ifFalse: [0])) * oop. osize >= 16rff ifTrue: [bits := BOSSBytes new: 4. bits longAt: 1 put: osize. swapBytes ifTrue: [bits swapBytesWidth: 4]. aStream nextPutAll: bits]. bits := BOSSBytes new: osize. pos := 1. 1 to: osize // oop do: [:i | | enc | enc := self encode: (body instVarAt: i). oop = 4 ifTrue: [bits longAt: pos put: enc] ifFalse: [bits unsignedShortAt: pos put: enc]. pos := pos + oop]. swapBytes ifTrue: [bits swapBytesWidth: oop]. aStream nextPutAll: bits]
writeIndexOnly: topObject " Write out the representation of a top object that already has an index assigned. " | bits | bits := BOSSBytes new: 4. baseIndex := SmallInteger maxVal. "prevent local encoding" bits longAt: 1 put: (self encode: topObject). swapBytes ifTrue: [bits swapBytesWidth: 4]. stream nextPutAll: bits
</methods> <methods> Kernel.BOSSWriter <category>private-initialize-release</category>
storage: aBOS on: aStream registry: reg super storage: aBOS on: aStream. registry := reg. objects := IdentityDictionary new: 20. nilIndex := 0. "we know this" traceClasses := IdentityDictionary new: 20. " We must preload every immediate class, and any other class whose stored representation shouldn't be affected by policy or individual implementation of representBinaryOn:. " traceClasses at: Character put: #traceSkip:; at: SmallInteger put: #traceSkip:; at: VariableBinding put: #traceAssociation:. 1 to: registry size do: [:i | | obj | obj := (registry at: i) update; value. objects at: obj put: -2 - i]. headers := BOSSBytes new: 40. "any multiple of 4 will do" bodies := Array new: headers size // 2. currentClass := Object. recentClasses := (1 to: BinaryObjectStorage flagRecentClassMask) collect: [:i | self encode: i]. nextRecentClass := 1. bodySize := 0
</methods> <methods> Kernel.BOSSReaderMap <category>initialize-release</category>
baseIndex: base baseIndex := (base bitShift: -2) - 1 "-1 because indexing is 0-based"
storage: aBOS storage := aBOS
</methods> <methods> Kernel.BOSSReaderMap <category>accessing</category>
at: index " This handles out-of-range indices by trying an access to the array0. " ^self primitiveAt: (index bitShift: -2) - baseIndex
at: index put: value " This only works for in-range indices. " storage atIndex: index put: value. ^super at: (index bitShift: -2) - baseIndex put: value
mapXeroxToUnicode "Answer whether the reader should map characters from Xerox encoding to Unicode encoding. Note that only Characters, ByteStrings, and TwoByteStrings need to be mapped. Other kinds of strings use a non-standard encoding table, and are insulated from this change." ^storage mapXeroxToUnicode
size ^super size + baseIndex + 1
</methods> <methods> Kernel.BOSSReaderMap <category>private</category>
primitiveAt: index <primitive: 60> ^storage objectAtIndex: (index + baseIndex bitShift: 2)
</methods> <methods> Kernel.BOSSReaderMap class <category>instance creation</category>
new: count baseIndex: baseIndex ^(self basicNew: count) baseIndex: baseIndex
</methods> <methods> Kernel.BOSSContents <category>initialize</category>
object: anObject object := anObject
</methods> <methods> Kernel.BOSSContents <category>binary storage</category>
representBinaryOn: binWriter ^object representContentsBinaryOn: binWriter
</methods> <methods> Kernel.BinaryObjectStorage <category>initialize-release</category>
close "Close the stream that the receiver is accessing." stream close
on: aStream "Create a new instance of the receiver on aStream, making sure that this stream can handle binary reading and writing." (aStream class canUnderstand: #binary) ifTrue: [aStream binary]. stream := aStream. self initialize
readerClass: aClass " Set the class for instantiating readers. " readerClass := aClass
registerGlobal: globalName " Register a global object whose value should be reverse-resolved. (This is needed for writing, but not for reading.) " registry addLast: (BOSSRegisteredObject new name: globalName valueBlock: [:varName | varName asQualifiedReference value] class: BinaryObjectStorage indexImportGlobal)
sourceMode: aSymbol " Set the mode for handling method sources and class organizations to #keep, #discard, or #reference (just store the pointer, on the assumption that the external source files will still be there). " sourceMode := aSymbol
writerClass: aClass " Set the class for instantiating writers. " writerClass := aClass
</methods> <methods> Kernel.BinaryObjectStorage <category>accessing</category>
expectCycles "Answer whether the receiver should, on writing, expect to see cycles, especially cycles where a Set or Dictionary refers back to itself. If the receiver expects to see cycles, it may use a deferred mechanism for creating the collection. This will solve the loading problem, but if other objects want to send messages to the Set or Dictionary while being BOSSed in, the messages they send may not be understood by the object acting as proxy to the Set. Thus, this attribute should be set to true only when needed." ^expectCycles
expectCycles: aBoolean "Set whether the receiver should, on writing, expect to see cycles, especially cycles where a Set or Dictionary refers back to itself. If the receiver expects to see cycles, it may use a deferred mechanism for creating the collection. This will solve the loading problem, but if other objects want to send messages to the Set or Dictionary while being BOSSed in, the messages they send may not be understood by the object acting as proxy to the Set. Thus, this attribute should be set to true only when needed." expectCycles := aBoolean
indexOf: anObject " Answer the index of anObject. If no index has been assigned, answer nil. " ^anObject == nil ifTrue: [0 "nil is known to have an index of 0"] ifFalse: [writerMap at: anObject ifAbsent: [nil]]
mapXeroxToUnicode "Answer whether the reader should map characters from Xerox encoding to Unicode encoding. nil is the same as false, so we do that mapping here. Note that only Characters, ByteStrings, and TwoByteStrings need to be mapped. Other kinds of strings use a non-standard encoding table, and are insulated from this change." ^mapXeroxToUnicode == nil ifTrue: [false] ifFalse: [mapXeroxToUnicode]
mapXeroxToUnicode: boole "Declare whether the reader should map characters from Xerox encoding to Unicode encoding. This must be done before reading any affected object from the stream. Note that only Characters, ByteStrings, and TwoByteStrings need to be mapped. Other kinds of strings use a non-standard encoding table, and are insulated from this change." mapXeroxToUnicode := boole
nextIndex " Answer the next object index to be assigned. " ^nextIndex
nextIndex: objx " Set the next object index to be assigned. This should only be used when appending to an existing stream containing mixed BOSS and non-BOSS information, where the client has saved the next object index in some other way. " " Since this is such a dangerous operation, do a little extra checking. " (objx < self firstIndex or: [(objx bitAnd: 3) ~= 0]) ifTrue: [self error: 'Invalid nextIndex value'] ifFalse: [nextIndex := objx]
sourceMode " Answer the mode that describes how method and class sources are being handled. " ^sourceMode
</methods> <methods> Kernel.BinaryObjectStorage <category>reading</category>
atEnd "Answer whether the receiver's input stream reached its end." ^stream atEnd
contents "Answer the current contents of the receiver's input stream." | cont | cont := (Array new: 20) writeStream. [self atEnd] whileFalse: [cont nextPut: self next]. ^cont contents
next ^self reader next
nextClasses ^self reader nextClassesWithSource: sourceMode
skipNext ^self reader skipNext
</methods> <methods> Kernel.BinaryObjectStorage <category>writing</category>
nextPut: anObject self writer nextPut: anObject. ^anObject
nextPutAll: aCollection "Put each of the elements of aCollection on the stream. Answer aCollection." aCollection do: [:v | self nextPut: v]. ^aCollection
nextPutClasses: classes self writer nextPutClasses: classes withSource: sourceMode
</methods> <methods> Kernel.BinaryObjectStorage <category>positioning</category>
position " Answer the position of the underlying stream. " ^stream position
position: newPos " Set the position of the underlying stream. " ^stream position: newPos
reset self position: initialPosition
scanToEnd " Scan to the end of the stream, noting the next available object index. " | reader | reader := self reader. [stream atEnd] whileFalse: [| range | range := reader skipNext. range notNil ifTrue: [nextIndex := nextIndex max: range last + 4]]
setToEnd " Set the underlying stream to its end. " stream setToEnd
</methods> <methods> Kernel.BinaryObjectStorage <category>forgetting</category>
forgetInterval: anInterval " Discard any remembered objects whose indices fall in anInterval. " self forgetInterval: anInterval excluding: -1
forgetInterval: anInterval excluding: anIndex "Discard any remembered objects whose indices fall in anInterval, except for the one with index anIndex." | min max | min := anInterval first max: self firstIndex. max := anInterval last. readerMap == nil ifFalse: [readerMap keysAndValuesDo: [:i :obj | | index | index := i bitShift: 2. (index >= min and: [index <= max and: [index ~= anIndex]]) ifTrue: [readerMap at: i put: nil. writerMap == nil ifFalse: [writerMap removeKey: obj]]]] ifTrue: [| killList | killList := OrderedCollection new. writerMap keysAndValuesDo: [:obj :index | (index >= min and: [index <= max and: [index ~= anIndex]]) ifTrue: [killList add: obj]]. killList do: [:obj | writerMap removeKey: obj]]
</methods> <methods> Kernel.BinaryObjectStorage <category>private-initialize-release</category>
checkHeader | str format char | str := 'BOSS '. 1 to: str size do: [:i | stream next = (str at: i) asInteger ifFalse: [HeaderErrorSignal raise]]. format := 0. [(char := Character value: stream next) isDigit] whileTrue: [format := format * 10 + char digitValue]. char = Character space ifFalse: [HeaderErrorSignal raise]. format = self streamFormatNumber ifFalse: [FormatErrorSignal raiseWith: format]. platformDescription := stream next: stream next. initialPosition := stream position
firstIndex " Answer the first index that can be assigned to an object other than the predefined ones. " ^self class predefinedObjects size * 4
initialize | pre | platformDescription := #[]. "in case client wants to live dangerously, i.e., not use checkHeader" initialPosition := 0. readerClass := BOSSReader. writerClass := BOSSWriter. sourceMode := self class defaultSourceMode. stream isReadable ifTrue: [readerMap := List new: 10000. classVarLists := IdentityDictionary new: 40] ifFalse: [readerMap := classVarLists := nil]. stream isWritable ifTrue: [writerMap := IdentityDictionary new: 10000] ifFalse: [writerMap := nil]. pre := self class predefinedObjects. nextIndex := 0. (0 to: pre size - 1 * 4 by: 4) with: pre do: [:objx :obj | objx > 0 ifTrue: [self atIndex: objx put: obj]]. registry := OrderedCollection new. self registerGlobal: #Smalltalk; registerGlobal: #Processor. expectCycles := false
writeHeader stream nextPutAll: (('BOSS ' , self streamFormatNumber printString , ' ') changeClassToThatOf: #[]). platformDescription := ByteArray with: (UninterpretedBytes isBigEndian ifTrue: [16r80] ifFalse: [0]). stream nextPut: platformDescription size; nextPutAll: platformDescription. initialPosition := stream position
</methods> <methods> Kernel.BinaryObjectStorage <category>private</category>
reader " Answer a reader that will read one object structure from the receiver's stream. " ^readerClass new storage: self on: stream
streamFormatNumber " Answer the format number supported by this version of this class. " ^7
writer " Answer a writer that will write one object structure on the receiver's stream. " ^writerClass new storage: self on: stream registry: registry
</methods> <methods> Kernel.BinaryObjectStorage <category>private-reading</category>
atIndex: anIndex put: anObject " Register an object at a given index. " | i | nextIndex := nextIndex max: anIndex+4. readerMap == nil ifFalse: [i := anIndex bitShift: -2. i > readerMap size ifTrue: [readerMap changeSizeTo: i]. readerMap at: i put: anObject]. writerMap == nil ifFalse: [writerMap at: anObject put: anIndex]
isBigEndian " Answer whether the information stored on the stream is stored in big-endian format. " ^platformDescription size > 0 ifTrue: [(platformDescription at: 1) anyMask: 16r80] ifFalse: [UninterpretedBytes isBigEndian]
objectAtIndex: anIndex " Answer the object at the given index. If there is no object at that index, answer nil. " | obj index | index := anIndex bitShift: -2. (index < 1 or: [index > readerMap size]) ifTrue: [obj := nil] ifFalse: [obj := readerMap at: index]. ^(obj == nil and: [anIndex < self firstIndex ]) ifTrue: [self class predefinedObjects at: anIndex / 4 + 1] ifFalse: [obj]
readerBlockFor: aClass ^versionReaders == nil ifTrue: [nil] ifFalse: [versionReaders at: aClass ifAbsent: [nil]]
readerBlockFor: aClass put: aBlock versionReaders == nil ifTrue: [versionReaders := IdentityDictionary new]. versionReaders at: aClass put: aBlock
usesReaderBlocks ^versionReaders notNil
variablesForClass: cls ^classVarLists at: cls
variablesForClass: cls put: list classVarLists at: cls put: list
</methods> <methods> Kernel.BinaryObjectStorage <category>private-writing</category>
assignIndexFor: anObject " Assign the next object index, and return it. " | index | index := nextIndex. self atIndex: index put: anObject. ^index
</methods> <methods> Kernel.BinaryObjectStorage class <category>class initialization</category>
initialize "BinaryObjectStorage initialize" self initializeSignals
initializeSignals "BinaryObjectStorage initializeSignals" BinaryErrorSignal := Object errorSignal newSignalMayProceed: false. BinaryErrorSignal nameClass: self message: #errorSignal; notifierString: 'BOSS error'. HeaderErrorSignal := BinaryErrorSignal newSignal. HeaderErrorSignal nameClass: self message: #headerErrorSignal; notifierString: 'Invalid BOSS file'. FormatErrorSignal := BinaryErrorSignal newSignal. FormatErrorSignal nameClass: self message: #formatErrorSignal; notifierString: 'Incompatible BOSS file format'.
</methods> <methods> Kernel.BinaryObjectStorage class <category>instance creation</category>
onNew: aStream "Answer an instance of the receiver for writing object structures on aStream. Any previous contents of aStream are lost." ^self basicNew on: aStream; writeHeader
onOld: aStream "Answer an instance of the receiver for reading object structures from aStream. The contents of aStream must have been written by a BinaryObjectStorage." ^self basicNew on: aStream; checkHeader; scanToEnd; reset
onOldNoScan: aStream "Answer an instance of the receiver for reading object structures from aStream. Do not scan to the end of the stream to find the next assignable object index. The contents of aStream must have been written by a BinaryObjectStorage." ^self basicNew on: aStream; checkHeader
</methods> <methods> Kernel.BinaryObjectStorage class <category>Signal constants</category>
errorSignal ^BinaryErrorSignal
formatErrorSignal ^FormatErrorSignal
headerErrorSignal ^HeaderErrorSignal
</methods> <methods> Kernel.BinaryObjectStorage class <category>constants</category>
defaultSourceMode "What should the default source code policy be if the user doesn't specify it?" ^#keep
flagHasForwardReferences " Answer the flag indicating that an object contains forward references. " ^16r40
flagHasShortOops " Answer the flag indicating that an object contains 2-byte rather than 4-byte oops. " ^16r80
flagIsBits " Answer the flag indicating that an object contains bits as opposed to object references. " ^16r20
flagIsImmutable "Answer the flag indicating that an object is immutable." ^16r10
flagRecentClassMask " Answer the mask for the recent class index in the flags. " ^15
importSelectors ^#(#importByteSymbol: #importSendSelf: #importTwoByteSymbol: #importSend: #importFloat: #importCompiledCode: #importByteString: #importClass: nil #importGlobal: nil #importAssociation: nil #importNameSpace:)
indexImportAssociation ^12
indexImportByteString ^7
indexImportByteSymbol ^1
indexImportClass ^8
indexImportCompiledCode ^6
indexImportFloat ^5
indexImportGlobal ^10
indexImportNameSpace ^14
indexImportSend ^4
indexImportSendSelf ^2
indexImportTwoByteSymbol ^3
predefinedObjects " Answer the objects that are assigned the first few object indices. If you ever change this list, you will break every stored structure, so don't do it! " ^#(nil true false)
</methods> <methods> Kernel.BinaryObjectStorage class <category>documentation</category>
fileFormat "Each file starts with an identifying header consisting of the 5 characters 'BOSS ', a decimal integer to identify the BOSS version number, and another space. This is the only part of the header guaranteed to stay the same from one version of BOSS to the next. Ow\ST release 2.5 BOSS was version 5; release 4, APOK beta was version 6; release 4, APOK product is version 7. The latter two differ only in that the product version has byte ordering information immediately following the file header." "Immediately following the file header is a single byte giving the number of bytes of platform description, and then that many additional bytes of description. Currently, only one bit of the platform description is used: bit 7 (the high-order bit) of the first byte, which is 0 if multi-byte quantities are stored low order byte first, 1 if they are stored high order byte first." "Objects within a single stream or file are numbered with unique indices that are multiples of 4 starting at 0. Objects 0, 4, and 8 are nil, true, and false; the first object written on the file or stream is numbered 12."
specialWriters "Objects of a given class may write themselves out in a special way. There are two ways to do this. - BOSSReader may have a special reading mechanism for that class built into it. This is the most efficient in both space and time, but it requires that the reader and writer be compatible in their assignment of special reader codes, which are integers. We attempt to keep the number of such codes down to an absolute minimum. - An object may write itself out as <receiver, selector, arguments>. The reader will send the message to reconstruct the object. Note that in either of these cases, if the object is involved in a circular structure, it is possible that the receiver or an argument may not be fully instantiated when the special reader or the message is invoked. We haven't yet been able to think of an uncontrived case where this could cause a problem." " If an object wants to write itself out specially, it must implement the method representBinaryOn: binWriter This message must return one of the following four things: - 0, meaning write out nil instead of the object; - nil, meaning use the standard representation after all; - a MessageSend, which will be executed at reading time; - an Association consisting of (aSpecialReaderIndex -> anObject), which indicates that a special reader action is required. "
structureFormat "If a structure consists of a single immediate quantity, or a single reference to an already encoded object, the structure just consists of a single 4-byte word containing the encoded oop (see below). Otherwise, the structure consists of a prefix, a sequence of headers, and object data. The prefix always starts with a 4-byte word where bits [30:0] are the object index of the first object that follows, +2 (i.e., bits [1:0] are 10). Bit 31 (the sign bit) selects one of two different formats: - If the structure consists of a single object, bit 31=1. This is followed by exactly one header and then the object data. (This is just an optimization to remove 12 bytes of overhead from single-object structures.) - If the structure consists of more than one object, bit 31=0. In this case the prefix is followed by: - The index of the top object in the structure (4 bytes) -- note that this will almost never be the first object; - The number of objects in the sequence (4 bytes); - The number of bytes of object data (4 bytes)." "Each header consists of: - The object's class (an encoded oop, see below: 4 bytes); - Flags, 1 byte consisting of: bit 7: 1 if the object is a pointer-type object with 2-byte oops, 0 otherwise. bit 6: 1 if the object is a pointer-type object containing forward references, 0 otherwise. bit 5: 1 if the object is byte-type, 0 if the object is pointer-type. bit 4: 1 if the object is immutable. bits [3:0] - 0 or a recent class number (see below). - The object's data size in bytes (1 byte, set to 16rff if the object is 255 bytes or larger); - The object's identityHash (2 bytes). The object reader keeps a buffer of the last 15 classes encountered. If the recent class number field in the flags is non-zero, it refers to an entry in this buffer: 1 is the most recent, 2 is the next most recent, and so on. If the recent class number field in the flags is 0, the object's class is an encoded oop (2 or 4 bytes) preceding the object's data; this class becomes entry 1 in the recent class buffer, former entries 1-14 become 2-15, and entry 15 is discarded. (Objects containing forward references are an exception: they always include an explicit class, and do not affect the recent class buffer.) When the reader starts reading an object structure, the buffer is initialized to contain the integers 1 (most recent) through 15. Object data is in the same order as the object headers." "The data for pointer-type objects consist of encoded oops. An encoded oop is a 2- or 4-byte quantity. The low-order 2 bits serve as a tag. The tag values are: - 00: the 16 or 32 bits are an object index within the entire file. - 10: the 16 or 32 bits are an index relative to the base index of this object structure, +2. - 01: top 14 or 30 bits are a Character value. - 11: top 14 or 30 bits are a non-negative SmallInteger. If the 'class' of an object is a SmallInteger, this object is interpreted specially. The data for the object are bytes if the 'class' is odd, pointers (encoded oops) if the 'class' is even. After collecting the data, the reader uses the 'class' as an index in a table of selectors: it then performs this selector with the reader itself as the receiver and the object data as the argument. The result of the perform is then used as the object."
</methods> <methods> Kernel.BOSSDebugReader <category>private-reading</category>
readObjects: first topIndex: topIndex " Read in and fix up all the objects. " | count buf outs | count := headers size // 4. compiledCode := nil. buf := BOSSBytes new: 4. outs := (String new: count * 50) writeStream. ((first longAt: 5) = 0 ifTrue: [first copyFrom: 1 to: 4] ifFalse: [first]) printOn: outs. outs cr. 1 to: count do: [:i | | objx class size flags inst short | objx := i - 1 bitShift: 2. flags := self flagsOf: objx. outs print: objx + baseIndex; nextPutAll: ': '; print: flags; space. short := flags anyMask: BinaryObjectStorage flagHasShortOops. class := flags bitAnd: BinaryObjectStorage flagRecentClassMask. class = 0 ifTrue: [class := short ifTrue: [stream next: 2 into: buf startingAt: 1. buf unsignedShortAt: 1] ifFalse: [stream next: 4 into: buf startingAt: 1. buf unsignedLongAt: 1]. outs print: class] ifFalse: [outs nextPut: $^; print: class]. size := self sizeOf: objx. outs nextPut: $,; print: size. size = 16rff ifTrue: [stream next: 4 into: buf startingAt: 1. size := buf longAt: 1. outs nextPutAll: '=>'; print: size]. outs space; print: (headers unsignedShortAt: objx + 3). (flags anyMask: BinaryObjectStorage flagIsBits) ifTrue: [| bytes | inst := stream next: size. bytes := ((1 to: inst size) detect: [:j | | c | c := inst at: j. c < 9 or: [c > 126]] ifNone: [nil]) notNil. bytes ifFalse: [inst changeClassToThatOf: '']. outs space; print: inst] ifFalse: [size > buf size ifTrue: [buf := BOSSBytes new: size]. stream next: size into: buf startingAt: 1. short ifTrue: [1 to: size by: 2 do: [:j | self nextOop: buf at: j short: true on: outs]] ifFalse: [1 to: size by: 4 do: [:j | self nextOop: buf at: j short: false on: outs]]]. outs cr. (flags anyMask: BinaryObjectStorage flagIsImmutable) ifTrue: [self deferSend: (MessageSend receiver: inst selector: #isImmutable: argument: true)]]. headers := stream := nil. "release references" ^outs contents
singleObjectFrom: first ^(first copyFrom: 1 to: 4) printString
</methods> <methods> Kernel.BOSSDebugReader <category>private</category>
nextOop: body at: index short: shortFlag on: aStream | obj imm | aStream space. shortFlag ifTrue: [(obj := body shortAt: index) odd ifTrue: [imm := body shortObjectAt: index from: #() baseIndex: 0] ifFalse: [^aStream nextPut: $#; print: obj]] ifFalse: [(obj := body longAt: index) odd ifTrue: [imm := body objectAt: index from: #() baseIndex: 0] ifFalse: [^aStream nextPut: $#; print: obj]]. ((imm isMemberOf: Character) and: [imm asInteger < 32 or: [imm asInteger > 127]]) ifTrue: [aStream nextPut: $$; print: imm asInteger] ifFalse: [aStream print: imm]
</methods> <methods> Kernel.BOSSBytes <category>accessing</category>
objectAt: datax from: objMap baseIndex: baseIndex " Decode the encoded oop at byte index datax in the receiver. table is the table of decoded objects. baseIndex is the object index of the first element of the table. " | tag vx value | " Ordinarily we would just get the oop by self unsignedLongAt: datax. However, if the oop is a SmallInteger of more than 27 bits, this would cause an unnecessary LargeInteger to be created. As it happens, this is precisely the case for two of the instance variables of short CompiledMethods. The time penalty for this is so large that we make an explicit byte ordering check and extract the oop in two shorts. " UninterpretedBytes isBigEndian ifTrue: [tag := self unsignedShortAt: datax + 2. vx := datax] ifFalse: [tag := self unsignedShortAt: datax. vx := datax + 2]. ^(tag bitAnd: 1) = 0 ifFalse: [value := ((self shortAt: vx) bitShift: 14) + (tag bitShift: -2). (tag bitAnd: 2) = 0 ifTrue: [objMap mapXeroxToUnicode ifTrue: [Character value: (BOSSReader mapToUnicode: value)] ifFalse: [Character value: value]] ifFalse: [value]] ifTrue: [value := self unsignedLongAt: datax. (tag bitAnd: 2) = 0 ifTrue: [objMap at: value] ifFalse: [objMap at: value - 2 + baseIndex]]
replaceBytesFrom: startIndex with: src | si | si := startIndex - 1. 1 to: src basicSize do: [:i | self basicAt: si + i put: (src basicAt: i)]
shortObjectAt: datax from: table baseIndex: baseIndex " Decode the encoded oop at byte index datax in the receiver. table is the table of decoded objects. baseIndex is the object index of the first element of the table. " | int value | int := self unsignedShortAt: datax. ^(int bitAnd: 1) = 0 ifFalse: [value := int bitShift: -2. (int bitAnd: 2) = 0 ifTrue: [table mapXeroxToUnicode ifTrue: [Character value: (BOSSReader mapToUnicode: value)] ifFalse: [Character value: value]] ifFalse: [value]] ifTrue: [(int bitAnd: 2) = 0 ifTrue: [table at: int] ifFalse: [table at: int - 2 + baseIndex]]
swapBytesWidth: w " Reverse the byte order of the w-byte quantities in the receiver. w is 2 or 4, and a divisor of the receiver's size. " w = 2 ifTrue: [self swapColumn: 0 with: 1. self swapColumn: 2 with: 3. (self size anyMask: 2) ifTrue: "swap 2 trailing bytes" [self swap: self size - 1 with: self size]] ifFalse: "w = 4" [self swapColumn: 0 with: 3. self swapColumn: 1 with: 2]
swapColumn: c0 with: c1 " Swap bytes at indices 4N+c0+1 with those at indices 4N+c1+1. " | height | height := self size bitShift: -2. height <= 5 ifTrue: [" Just do it with at: and at:put:. " 1 to: (height bitShift: 2) by: 4 do: [:i | | t | t := self at: i + c0. self at: i + c0 put: (self at: i + c1). self at: i + c1 put: t]] ifFalse: [" Do it with RasterOp. " | x0 x1 t | x0 := c0 bitShift: 3. x1 := c1 bitShift: 3. 3 timesRepeat: [self copyBitsStride: 1 width: 32 atX: x1 y: 0 from: self stride: 1 width: 32 atX: x0 y: 0 width: 8 height: height rule: RasterOp reverse. t := x0. x0 := x1. x1 := t]]
</methods> <methods> Kernel.BOSSBytes <category>UninterpretedBytes accessing</category>
longAt: byteIndex <primitive: 546> ^self primitiveFailed
longAt: byteIndex put: aLong <primitive: 547> ^self primitiveFailed
shortAt: byteIndex <primitive: 542> | word | word := self unsignedShortAt: byteIndex. ^(word bitAnd: 16r7FFF) - (word bitAnd: 16r8000)
unsignedLongAt: byteIndex <primitive: 544> ^self primitiveFailed
unsignedLongAt: byteIndex put: anUnsignedLong <primitive: 545> ^self primitiveFailed
unsignedShortAt: byteIndex <primitive: 540> ^self primitiveFailed
unsignedShortAt: byteIndex put: anUnsignedShort <primitive: 541> ^self primitiveFailed
</methods> <methods> Kernel.BOSSCompiledCodeHolder <category>initialize-release</category>
class: aClass selector: aSymbol category: aString codeClass: aCodeClass codeContents: codeObject source: sourceObject class := aClass. selector := aSymbol. category := aString. codeClass := aCodeClass. codeContents := codeObject. source := sourceObject
dontInstall " Prevent this method from being installed in the method dictionary. " class := nil
useSource: aSymbol " Selectively discard source information according to the retention mode defined by aSymbol. See BOSSWriter for more detail. " aSymbol == #discard ifTrue: [source := category := nil] ifFalse: [(aSymbol == #reference and: [source isString]) ifTrue: [source := nil]]
</methods> <methods> Kernel.BOSSCompiledCodeHolder <category>accessing</category>
code ^codeContents
codeClass ^codeClass
computeCodeForStorage: storage | list1 list2 map list1CodeOnly list2CodeOnly | codeContents class == codeClass ifFalse: [| aBlockOrNil vars newMeth | aBlockOrNil := storage readerBlockFor: codeClass. aBlockOrNil == nil ifTrue: [codeContents changeClassToThatOf: (codeClass basicNew: 0)] ifFalse: [aBlockOrNil value: codeContents. class == nil ifFalse: [codeContents mclass: class]]. vars := storage variablesForClass: codeContents mclass. vars == nil ifFalse: [newMeth := codeContents mclass rebindMethod: codeContents oldVariableNames: vars. list1 := self enumerate: codeContents into: OrderedCollection new. list2 := self enumerate: newMeth into: OrderedCollection new. list1CodeOnly := self filterOutBlocksFrom: list1 copy. list2CodeOnly := self filterOutBlocksFrom: list2 copy. list1CodeOnly size = list2CodeOnly size ifFalse: [self error: 'Unexplained mismatch between source and translated methods']. map := IdentityDictionary new. 1 to: list1CodeOnly size do: [:i | (list1CodeOnly at: i) become: (list2CodeOnly at: i). map at: (list1CodeOnly at: i) put: (list2CodeOnly at: i). map at: (list2CodeOnly at: i) put: (list1CodeOnly at: i)]. map at: newMeth put: self. list1 do: [:obj | self map: obj using: map]. "Not strictly necessary, but for safety...." list2 do: [:obj | self map: obj using: map]. ]]. ^codeContents
existingCode " If a compiled method with this class and selector already exists, answer it, otherwise answer nil. " ^class notNil ifTrue: [class compiledMethodAt: selector ifAbsent: [nil]] ifFalse: [nil]
</methods> <methods> Kernel.BOSSCompiledCodeHolder <category>installing</category>
commit: code " Install in the method dictionary, and set the source pointer. " class notNil ifTrue: [category notNil ifTrue: [class addSelectorUnsafe: selector withMethod: code category: category] ifFalse: [class addSelectorUnsafe: selector withMethod: code]]. source isString ifFalse: [code sourcePointer: source]
storeSource " Store the source on the changes file if appropriate. Answer whether this was done. " ^(source isString and: [class notNil and: [category notNil]]) ifTrue: [source := SourceFileManager default storeMethodSource: source class: class category: category safely: false. true] ifFalse: [false]
</methods> <methods> Kernel.BOSSCompiledCodeHolder <category>private</category>
enumerate: compiledCode into: collection "This can be seen as a superset of CompiledMethod>>withAllBlockMethods. It answers an ordered list of all CompiledCode and BlockClosure objects reachable from the method." collection add: compiledCode. (compiledCode isKindOf: BlockClosure) ifTrue: [^self enumerate: compiledCode method into: collection]. 1 to: compiledCode numLiterals do: [:n | | lit | lit := compiledCode literalAt: n. (lit isKindOf: BlockClosure) ifTrue: [collection add: lit. self enumerate: lit method into: collection]. (lit isKindOf: CompiledCode) ifTrue: [self enumerate: lit into: collection]]. ^collection
filterOutBlocksFrom: list | i lit | i := 0. [i < list size] whileTrue: [i := i+1. lit := list at: i. (lit isKindOf: BlockClosure) ifTrue: [list removeAtIndex: i+1]]. ^list
map: object using: map | x | 1 to: object class instSize do: [:i | x := object instVarAt: i. object instVarAt: i put: (map at: x ifAbsent: [x])]. 1 to: object basicSize do: [:n | x := object basicAt: n. object basicAt: n put: (map at: x ifAbsent: [x])].
</methods> <methods> Core.Metaclass <category>binary storage</category>
representBinaryOn: binWriter " Classes are represented by their names, under the assumption that they are all present in the Smalltalk dictionary. We also include a class/metaclass flag, the version number, and the instance format and variable names for checking. " | args | args := Array new: 5. args at: 1 put: self soleInstance fullName. args at: 2 put: true. args at: 3 put: self binaryRepresentationVersion. args at: 4 put: self format. args at: 5 put: (self instSize = 0 ifTrue: [nil] ifFalse: [self allInstVarNames asArray]). ^BinaryObjectStorage indexImportClass -> args
representContentsBinaryOn: binWriter " Store the methods and organization. " ^MessageSend receiver: self soleInstance selector: #classSideInstanceVariableNames: argument: self instanceVariablesString
</methods> <methods> Core.SortedCollection class <category>instance creation</category>
fromSortedArray: aCollection sortBlock: aBlock "Answer a new SortedCollection with the given elements and sortBlock. Since this is used by BOSS, and aBlock may not really be an instance of BlockClosure, assume that the collection is sorted and do not resort it." | newCollection | newCollection := self new: aCollection size. newCollection sortBlock: aBlock. newCollection addAllWithoutSorting: aCollection. ^newCollection
</methods> <methods> Core.SortedCollection <category>binary storage</category>
representBinaryOn: binWriter " Represent a SortedCollection by its contents (elements) and its sortBlock. " ^sortBlock == DefaultSortBlock ifTrue: [super representBinaryOn: binWriter] ifFalse: [MessageSend receiver: self class selector: #fromSortedArray:sortBlock: arguments: (Array with: self asArray with: sortBlock)]
</methods> <methods> Core.OrderedCollection <category>binary storage</category>
representBinaryOn: binWriter " Represent an OrderedCollection by its contents (elements). " ^MessageSend receiver: self class selector: #withAll: argument: (self isEmpty ifTrue: [#()] ifFalse: [self asArray])
</methods> <methods> OS.OSHandle <category>binary storage</category>
representBinaryOn: bosWriter self notify: 'OSHandles cannot be stored by BOSS.'. ^0
</methods> <methods> UI.Label class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+1. new replaceFrom: 1 to: 5 with: oldObj startingAt: 1. new replaceFrom: 7 to: new size with: oldObj startingAt: 6. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> Core.Object <category>binary storage</category>
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:. (The version identification need not be an integer, or even a number.) The default version identification for the initial BOSS representation is nil. " ^nil
representBinaryOn: binWriter " By default, objects do nothing special to represent themselves in binary form. " ^nil
</methods> <methods> External.CScanner class <category>binary storage</category>
binaryInitializationMessagesFor: sourceMode "Answer a list of message sends used to initialize the receiver." | list | list := super binaryInitializationMessagesFor: sourceMode. "We make a direct reference to CScanner to avoid subclasses also initializing methodInfo." name == #CScanner ifTrue: [list add: (MessageSend receiver: self selector: #methodInfo: argument: self methodInfo)]. ^list
bossOut: fileNameString "Write a BOSS format version of the receiver in the file indicated by the argument. The argument must be a String indicating the BOSS file's path. Answers the receiver. If the file indicated by the argument could not be created for writing or the receiver could not be properly BOSS'ed out, an exception is raised. This method is typically used to generate the file read by the method ExternalInterface class>>bossIn:." "CScanner bossOut: 'CScanner.bos'" | bos | bos := BinaryObjectStorage onNew: fileNameString asFilename writeStream. [bos nextPutClasses: self withAllSubclasses] ensure: [bos close]
</methods> <methods> External.CScanner class <category>private-parser compiler</category>
methodInfo: aDictionary methodInfo := aDictionary
</methods> <methods> Core.LimitedPrecisionReal <category>binary storage</category>
representBinaryOn: binWriter " This is where we would do the right thing in the unlikely event that this machine doesn't use IEEE representation. The only machine in common use with this bug is the VAX, which we don't support. (Regardless of representation, we need a special representation to get the correct byte ordering at reading time.) " ^BinaryObjectStorage indexImportFloat -> self
</methods> <methods> Core.WeakDictionary class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+1. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. "Add access lock" new at: 4 put: RecursionLock new. new replaceFrom: 5 to: new size with: oldObj startingAt: 4. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> Kernel.CompiledCode class <category>binary storage</category>
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:. (The version identification need not be an integer, or even a number.)" ^'Release 4.1'
</methods> <methods> External.CEnumerationType class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new oldDict | new := Array new: 2. new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. new changeClassToThatOf: inst. oldDict := oldObj at: 3. (oldObj at: 4) do: [:memberName | new at: memberName put: (oldDict at: memberName)]. oldObj become: new. oldObj]]. oldVersion = 'Release 2.0' ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | oldDict new | "Flatten memberDictionary and memberIdentifiers." new := Array new: 2. new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. new changeClassToThatOf: inst. oldDict := oldObj at: 3. (oldObj at: 4) do: [:memberName | new at: memberName put: (oldDict at: memberName)]. oldObj become: new. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.5'
</methods> <methods> UI.ScheduledWindow class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+3. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. new replaceFrom: 4 to: 7 with: oldObj startingAt: 5. "Add isIconic" new at: 8 put: false. new replaceFrom: 9 to: 14 with: oldObj startingAt: 9. new replaceFrom: 17 to: 18 with: oldObj startingAt: 15. new replaceFrom: 20 to: new size with: oldObj startingAt: 17. oldObj become: new. oldObj changeClassToThatOf: inst]]. oldVersion = 'Release 4.1' ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | "Add damageRepairPolicy" new := Array new: oldObj size + 1. new replaceFrom: 1 to: 18 with: oldObj startingAt: 1. new replaceFrom: 20 to: new size with: oldObj startingAt: 19. new at: oldObj size put: nil. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'VisualWorks Release 2.0'
</methods> <methods> Kernel.LocalScope class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+1. new replaceFrom: 1 to: 4 with: oldObj startingAt: 1. new replaceFrom: 6 to: new size with: oldObj startingAt: 5. oldObj become: new. oldObj changeClassToThatOf: inst. oldObj permitDuplicateNames: false]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> Lens.LensRegistry <category>binary storage</category>
representBinaryOn: binWriter " Since a LensRegistry doesn't actually store Associations, represent it more efficiently as a sequence of keys and values. " | cont creator | cont := (Array new: self size * 2) writeStream. self keysAndValuesDo: [:key :value | cont nextPut: key; nextPut: value]. creator := (MessageSend receiver: self class selector: #withKeysAndValues: argument: cont contents). ^binWriter expectCycles ifTrue: [BinaryObjectStorage indexImportSendSelf -> (Array with: #createSpecialObject: with: (BOSSSpecialObjectLoader message: creator))] ifFalse: [creator]
</methods> <methods> Kernel.MethodDictionary class <category>instance creation</category>
withKeysAndValues: keyAndValueArray " Answer an instance whose keys and values are obtained from alternate elements of the keyAndValueArray. " | dict | dict := self new: keyAndValueArray size. 1 to: keyAndValueArray size by: 2 do: [:i | dict at: (keyAndValueArray at: i) put: (keyAndValueArray at: i + 1)]. ^dict
</methods> <methods> Kernel.MethodDictionary <category>binary storage</category>
representBinaryOn: binWriter "Since a MethodDictionary doesn't actually store Associations, represent it more efficiently as a sequence of keys and values. " ^MessageSend receiver: self class selector: #withKeysAndValues: argument: (self shallowCopy changeClassToThatOf: #())
</methods> <methods> Tools.NamedChangeSet class <category>private</category>
currentTag ^-666
</methods> <methods> Tools.NamedChangeSet <category>private</category>
currentTag ^self class currentTag
</methods> <methods> Tools.NamedChangeSet <category>binary storage</category>
methodListForPackage ^self messageListForPackage collect: [:assoc | assoc key compiledMethodAt: assoc value]
</methods> <methods> External.CCompositeType class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self new. ^[:oldObj | | new oldDict i | "Remove metaType, datumClass, pointerClass" "Flatten memberDictionary and memberIdentifiers." oldDict := oldObj at: 3. new := Array new: 4 + (oldDict size * self slotsPerMember). new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. new replaceFrom: 3 to: 4 with: oldObj startingAt: 5. i := 4. (oldObj at: 4) do: [:memberName | | assoc | assoc := oldDict at: memberName. new at: (i := i + 1) put: memberName; at: (i := i + 1) put: assoc key; at: (i := i + 1) put: assoc value; at: (i := i + 1) put: 0; at: (i := i + 1) put: nil]. new changeClassToThatOf: inst. (oldObj at: 7) == #struct ifTrue: [new beStructure] ifFalse: [new beUnion]. oldObj become: new. oldObj]]. oldVersion = 'Release 2.0' ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | oldDict new i | "Flatten memberDictionary and memberIdentifiers." oldDict := oldObj at: 3. new := Array new: 4 + (oldDict size * self slotsPerMember). new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. new replaceFrom: 3 to: 4 with: oldObj startingAt: 5. i := 4. (oldObj at: 4) do: [:memberName | | assoc | assoc := oldDict at: memberName. new at: (i := i + 1) put: memberName; at: (i := i + 1) put: assoc key; at: (i := i + 1) put: assoc value; at: (i := i + 1) put: 0; at: (i := i + 1) put: nil]. new changeClassToThatOf: inst. oldObj become: new. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.5'
</methods> <methods> External.ExternalInterface class <category>binary storage</category>
binaryInitializationMessagesFor: sourceMode "Answer a list of message sends used to initialize the receiver." "This method places the initialization of the receiver's externals before the initialization of the remainder of the class so that the receiver can use the externals during class initialization (for example, in the #initialize method)." | list | list := OrderedCollection with: (MessageSend receiver: self selector: #ownExternalAssociations: argument: self ownExternalAssociations). list addAll: (super binaryInitializationMessagesFor: sourceMode). ^list
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self new. ^[:oldObj | | new | new := Array new: oldObj size - 1. new replaceFrom: 1 to: oldObj size - 1 with: oldObj startingAt: 2. oldObj become: new. oldObj changeClassToThatOf: inst. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.0'
</methods> <methods> External.ExternalInterface class <category>private boss</category>
bossDefinitionMessage "Answer a MessageSend that defines the receiver and the receiver's externalDictionary." ^MessageSend receiver: superclass selector: #subclass:includeFiles:includeDirectories:libraryFiles:libraryDirectories:generateMethods:beVirtual:optimizationLevel:instanceVariableNames:classVariableNames:poolDictionaries:category:externalKeys: arguments: (self definitionMessageArguments, (Array with: self externals ownKeys asArray))
</methods> <methods> External.ExternalInterface class <category>public boss</category>
bossIn: fileNameString "BOSS in the ExternalInterface class contained in the file specified by the argument. The argument must be a String indicating the BOSS file's path. Answers the receiver. If the file indicated by the argument could not be found or the file is not in a valid BOSS format, an exception is raised. This method is typically used on files generated by the ExternalInterface class methods bossOutHierarchy: or bossOutSubclasses:." "ExternalInterface bossIn: 'SomeInterfaceClasses.bos'" | bos classes | bos := BinaryObjectStorage onOld: (fileNameString asFilename withEncoding: #binary) readStream. [classes := bos nextClasses. bos atEnd ifTrue: [self compatibilityBossIn: classes version: nil] ifFalse: [self compatibilityBossIn: classes version: bos next]] ensure: [bos close]
bossOut: fileNameString sourceMode: sourceMode "Write a BOSS format version of the receiver in the file indicated by the argument. The argument must be a String indicating the BOSS file's path. Answers the receiver. If the file indicated by the argument could not be created for writing or the receiver could not be properly BOSS'ed out, an exception is raised. This method is typically used to generate the file read by the method ExternalInterface class>>bossIn:. The argument, sourceMode, can be one of #keep, #reference, or #discard and indicates whether the method's source code is written to the BOSS file, source code references are written to the BOSS file (assuming the same changes file will be available), or source code is simply discarded." "SomeExternalInterface bossOut: 'SomeExternalInterface.bos' sourceMode: #keep" | bos | bos := BinaryObjectStorage onNew: (fileNameString asFilename withEncoding: #binary) writeStream. [self flushAllCaches. bos sourceMode: sourceMode. bos nextPutClasses: (Array with: self). bos nextPut: self version] ensure: [bos close]
</methods> <methods> External.ExternalInterface class <category>private boss</category>
bossOutClasses: aClassCollection onFile: aFile sourceMode: sourceMode "Place the class collection onto aFile. In addition, append the current interface version identifier." | bos | bos := BinaryObjectStorage onNew: (aFile asFilename withEncoding: #binary) writeStream. [aClassCollection do: [:aClass | (aClass isKindOf: ExternalInterface class) ifTrue: [aClass flushAllCaches]]. bos sourceMode: sourceMode. bos nextPutClasses: aClassCollection. bos nextPut: self version] ensure: [bos close]
</methods> <methods> External.ExternalInterface class <category>public boss</category>
bossOutHierarchy: fileNameString sourceMode: sourceMode "Write a BOSS format version of the receiver and all it's subclasses in the file indicated by the argument. The argument must be a String indicating the BOSS file's path. Answers the receiver. If the file indicated by the argument could not be created for writing or the receiver and its subclasses could not be properly BOSS'ed out, an exception is raised. This method is typically used to generate the file read by the method ExternalInterface class>>bossIn:. The argument, sourceMode, can be one of #keep, #reference, or #discard and indicates whether the method's source code is written to the BOSS file, source code references are written to the BOSS file (assuming the same changes file will be available), or source code is simply discarded." "SomeExternalInterface bossOutHierarchy: 'SomeExternalInterfaceHierarchy.bos' sourceMode: #keep" ^self bossOutClasses: self withAllSubclasses onFile: fileNameString sourceMode: sourceMode
bossOutSubclasses: fileNameString sourceMode: sourceMode "Write a BOSS format version of the receiver's subclasses in the file indicated by the argument. The argument must be a String indicating the BOSS file's path. Answers the receiver. If the file indicated by the argument could not be created for writing or the receiver and its subclasses could not be properly BOSS'ed out, an exception is raised. This method is typically used to generate the file read by the method ExternalInterface class>>bossIn:. The argument, sourceMode, can be one of #keep, #reference, or #discard and indicates whether the method's source code is written to the BOSS file, source code references are written to the BOSS file (assuming the same changes file will be available), or source code is simply discarded." "SomeInterface bossOutSubclasses: 'ExternalInterfaceSubclasses.bos' sourceMode: #keep" "ExternalInterface bossIn: 'ExternalInterfaceSubclasses.bos'" ^self bossOutClasses: self allSubclasses onFile: fileNameString sourceMode: sourceMode
</methods> <methods> External.ExternalInterface class <category>private boss</category>
compatibilityBossIn: classCollection version: versionID "Perform any necessary operations on the classes contained in the argument, classCollection. The versionID argument is a string indicating which version of BOSS file loaded the classes." versionID isNil ifTrue: [classCollection do: [:aClass | (aClass isKindOf: ExternalInterface class) ifTrue: [aClass libraryFiles do: [:aFile | aFile owner: aClass]]]]. versionID = 'ExternalInterface Release 2.0' ifTrue: [classCollection do: [:aClass | (aClass isKindOf: ExternalInterface class) ifTrue: [aClass externals do: [:ext | (ext isKindOf: CType) ifTrue: [ ext transDo: [:aType | (aType isKindOf: CCompositeType) ifTrue: [aType updateKindsCache]]]]]]]
</methods> <methods> External.ExternalInterface class <category>private</category>
ownExternalAssociations "Answer an Array of the associations contained in the receiver's externals dictionary. Only answer those actually contained in the receiver's external dictionary and not any in its superclass." "We add a copy of the association so BOSS readers don't map the original association to the values answered by this method." | associations | associations := OrderedCollection new. self externals ownAssociationsDo: [:anAssoc | associations add: anAssoc copy]. ^associations asArray
ownExternalAssociations: keyValueArray "The argument consists of the keys and values of the receiver's own externals. Set the value in the current external dictionary based on the given key. This message is typically sent by BOSS readers during a Class fix-up mode. It is currently intended as a work-around for the Class cycle introduced by external objects." "Perform the necessary fix-up of the new associations (i.e. weaken them) and inform the system of possible structure realignment." | myExternals | myExternals := self externals. keyValueArray do: [:aKeyValue | myExternals at: aKeyValue key put: aKeyValue value]. myExternals ownKeysDo: [:key | | external | external := (myExternals associationAt: key) value. myExternals weakenAt: key. (external isKindOf: ExternalObject) ifTrue: [external releaseHandle]]. CCompositeType realign
</methods> <methods> External.ExternalInterface class <category>binary storage</category>
representContentsBinaryOn: binWriter "Represent the receiver in a binary form on the argument." "If the receiver is a subclass of ExternalInterface, use the correct definition message, otherwise use the default." self == ExternalInterface ifTrue: [^super representContentsBinaryOn: binWriter] ifFalse: [^self bossDefinitionMessage]
</methods> <methods> External.ExternalInterface class <category>creating subclasses</category>
subclass: t includeFiles: df includeDirectories: id libraryFiles: lf libraryDirectories: ld generateMethods: gm beVirtual: bv optimizationLevel: optLevel instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat externalKeys: externalKeys "This is the enhanced initialization message for creating a new class as a subclass of the receiver. Answer the new subclass. This method is invoked by BOSSReaders." "The last argument, externalKeys, is an array of keys used to create the proper associations in the new subclass's externals dictionary. This class definition message will create dummy associations using these keys. These associations are used by the subclass's compiled methods. When the subclass is completely BOSS'ed in, the final operation is to replace the value's of the association with the correct value -- this has been done to avoid circular references between the association values and the new subclass; we consider this only a temporary work-around." | subclass subclassExternals | subclass := self subclass: t includeFiles: df includeDirectories: id libraryFiles: lf libraryDirectories: ld generateMethods: gm beVirtual: bv optimizationLevel: optLevel instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat. subclassExternals := subclass externals. externalKeys do: [:aKey | subclassExternals ownAt: aKey ifAbsent: [subclassExternals at: aKey put: nil]]. ^subclass
</methods> <methods> Kernel.CompiledMethod class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion = nil ifTrue: [^[:oldObj | | new oldInstSize | oldInstSize := oldFormat bitAnd: 255. new := self new: oldObj size - oldInstSize. new instVarAt: 1 put: (oldObj at: 1). new mclass: Object. "We can't find out what the mclass ought to be yet" "Everything after the bytes needs to be shifted to make room for mclass" 2 to: oldObj size do: [:i | new instVarAt: i+1 put: (oldObj at: i)]. new become: oldObj ]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> Kernel.CompiledMethod <category>binary storage</category>
representBinaryOn: bosWriter " The stored representation of CompiledMethods is special. " ^bosWriter representCompiledMethod: self
</methods> <methods> Lens.LensCommandVariable <category>binary storage</category>
representBinaryOn: binWriter " By default, objects do nothing special to represent themselves in binary form. " ^nil
</methods> <methods> Kernel.CompiledBlock class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion = nil ifTrue: [^[:oldObj | | new oldInstSize | oldInstSize := oldFormat bitAnd: 255. new := self new: oldObj size - oldInstSize. new instVarAt: 1 put: (oldObj at: 1). new instVarAt: 2 put: (oldObj at: 3). "Copy the indexed instance variables" 4 to: oldObj size do: [:i | new instVarAt: i-1 put: (oldObj at: i)]. new become: oldObj ]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> External.ExternalDictionary <category>binary storage</category>
representBinaryOn: binWriter self fillDefineCaches. ^super representBinaryOn: binWriter
</methods> <methods> Kernel.GeneralBindingReference class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | oldObj size = self instSize ifFalse: [oldObj size + 1 = self instSize ifFalse: [self error: 'not enough information to describe the old object']. new := Array new: self instSize. new at: 1 put: (oldObj at: 1). new replaceFrom: 3 to: self instSize with: oldObj startingAt: 2. oldObj become: new]. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'VisualWorks 7.2.1'
</methods> <methods> Core.Behavior <category>constants</category>
formatMask " Answer a mask of all the significant bits in the format instance variable." ^16r1D0FF
</methods> <methods> External.CQualifiedType class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new specifiers | "Remove segment" new := Array new: oldObj size. new at: 1 put: 0. new replaceFrom: 2 to: new size with: oldObj startingAt: 2. specifiers := oldObj at: 1. oldObj become: new. oldObj changeClassToThatOf: inst. (specifiers bitAnd: 128) ~~ 0 ifTrue: [oldObj bePascal]. (specifiers bitAnd: 256) ~~ 0 ifTrue: [oldObj beConstant]. (specifiers bitAnd: 512) ~~ 0 ifTrue: [oldObj beVolatile]. (specifiers bitAnd: 1024) ~~ 0 ifTrue: [oldObj beSeg16]. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.0'
</methods> <methods> Tools.ChangeList class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size-1. new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. "Remove isLocked" new replaceFrom: 3 to: new size with: oldObj startingAt: 4. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> External.CProcedureType class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new specifiers argTypes | argTypes := oldObj at: 3. "argumentTypes" new := Array new: argTypes size + 3. new at: 1 put: 0. "specifierFlags" new at: 2 put: (oldObj at: 5). "argumentNames" new at: 3 put: (oldObj at: 2). "resultType" new replaceFrom: 4 to: new size with: argTypes. specifiers := oldObj at: 1. oldObj become: new. oldObj changeClassToThatOf: inst. (new at: 8) == #far ifTrue: [oldObj beFar]. (new at: 7) == #pascal ifTrue: [oldObj bePascal]. (new at: 7) == #c ifTrue: [oldObj beCdecl]. (specifiers bitAnd: 16) ~~ 0 ifTrue: [oldObj beVarArg]. (specifiers bitAnd: 32) ~~ 0 ifTrue: [oldObj beNoCallback]. (specifiers bitAnd: 64) ~~ 0 ifTrue: [oldObj beLongcomp]. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.0'
</methods> <methods> Core.IdentityDictionary <category>binary storage</category>
representBinaryOn: binWriter " Since an IdentityDictionary doesn't actually store Associations, represent it more efficiently as a sequence of keys and values. " | cont creator | cont := (Array new: self size * 2) writeStream. self keysAndValuesDo: [:key :value | cont nextPut: key; nextPut: value]. creator := (MessageSend receiver: self class selector: #withKeysAndValues: argument: cont contents). ^binWriter expectCycles ifTrue: [BinaryObjectStorage indexImportSendSelf -> (Array with: #createSpecialObject: with: (BOSSSpecialObjectLoader message: creator))] ifFalse: [creator]
</methods> <methods> External.CArrayType class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new segment | new := Array new: oldObj size - 4. "Remove pointerKind, pointerClass, segment" new at: 1 put: 0. new at: 2 put: (oldObj at: 3). "Remove datumClass" new at: 3 put: (oldObj at: 6). 4 to: new size do: [:i | new at: i put: (oldObj at: i + 4)]. segment := oldObj at: 5. oldObj become: new. oldObj changeClassToThatOf: inst. segment == #far ifTrue: [oldObj beFar]. segment == #huge ifTrue: [oldObj beFar]. segment == #near ifTrue: [oldObj beNear]. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> Graphics.BoundedWrapper class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | t | "Swap extent and layout" t := oldObj at: 4. oldObj at: 4 put: (oldObj at: 5). oldObj at: 5 put: t. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> UI.ValueHolder class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size-2. new at: 1 put: (oldObj at: 1). new at: 2 put: (oldObj at: 3). new replaceFrom: 3 to: new size with: oldObj startingAt: 5. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> Graphics.GraphicsHandle <category>binary storage</category>
representBinaryOn: bosWriter self notify: (#notifyGraphicsBoss << #dialogs >> 'GraphicsHandles cannot be stored by BOSS.'). ^0
</methods> <methods> External.CScalarType <category>binary storage</category>
representBinaryOn: binWriter ^MessageSend receiver: self class selector: storeSelector
</methods> <methods> OS.HandleRegistry class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> External.ExternalLibrary class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [^[:oldObj | nil]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.0'
</methods> <methods> Tools.ChangeSetManager class <category>utilities</category>
currentTag ^-666
</methods> <methods> UI.TextCollector class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size-1. new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. "Remove isLocked" new replaceFrom: 3 to: new size with: oldObj startingAt: 4. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> Core.Dictionary class <category>instance creation</category>
withKeysAndValues: keyAndValueArray " Answer an instance whose keys and values are obtained from alternate elements of the keyAndValueArray. " | dict | dict := self new: keyAndValueArray size. 1 to: keyAndValueArray size by: 2 do: [:i | dict at: (keyAndValueArray at: i) put: (keyAndValueArray at: i + 1)]. ^dict
</methods> <methods> Core.Dictionary <category>binary storage</category>
representBinaryOn: binWriter " Represent a Dictionary by its elements (Associations). " | creator | creator := MessageSend receiver: self class selector: #withAll: argument: self associations asArray. ^binWriter expectCycles ifTrue: [BinaryObjectStorage indexImportSendSelf -> (Array with: #createSpecialObject: with: (BOSSSpecialObjectLoader message: creator))] ifFalse: [creator]
</methods> <methods> Core.ByteString <category>binary storage</category>
representBinaryOn: binWriter " Symbols must be re-interned when they are read in. " ^BinaryObjectStorage indexImportByteString -> self
</methods> <methods> UI.ProtocolAdaptor class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+1. new replaceFrom: 1 to: 4 with: oldObj startingAt: 1. new at: 5 put: nil. new replaceFrom: 6 to: new size with: oldObj startingAt: 5. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'VisualWorks Release 2.0'
</methods> <methods> Core.TwoByteSymbol <category>binary storage</category>
representBinaryOn: binWriter " Symbols must be re-interned when they are read in. " ^BinaryObjectStorage indexImportTwoByteSymbol -> self
</methods> <methods> Graphics.MappedPalette class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new size bits | new := Array new: oldObj size+2. new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. new replaceFrom: 6 to: new size with: oldObj startingAt: 4. (bits := new at: 2) changeClassToThatOf: (WordArray new: 0). UninterpretedBytes isBigEndian ifFalse: [bits reverseByteOrder]. size := 0. 1 to: bits size by: 3 do: [:i | (bits at: i) = UnallocatedEntryValue ifFalse: [size := size+1]]. new at: 4 put: self defaultMapResolution. new at: 5 put: size. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> Graphics.MappedPalette <category>binary storage</category>
representBinaryOn: binWriter "If a Palette has a name as a constant, use the name to represent it." | const | const := super representBinaryOn: binWriter. ^const isNil ifTrue: [MessageSend receiver: self class selector: #withColors: arguments: (Array with: self colors)] ifFalse: [const]
</methods> <methods> Core.Set <category>binary storage</category>
representBinaryOn: binWriter " Represent a Set by its elements. " | creator | creator := MessageSend receiver: self class selector: #withAll: argument: (self isEmpty ifTrue: [#()] ifFalse: [self asArray]). ^binWriter expectCycles ifTrue: [BinaryObjectStorage indexImportSendSelf -> (Array with: #createSpecialObject: with: (BOSSSpecialObjectLoader message: creator))] ifFalse: [creator]
</methods> <methods> Graphics.VariableSizeTextAttributes class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size + 1. new replaceFrom: 1 to: 11 with: oldObj startingAt: 1. new at: 12 put: 0. new replaceFrom: 13 to: new size with: oldObj startingAt: 12. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.2'
</methods> <methods> Kernel.ClassOrganizer <category>categories</category>
categories: anArray "Reorder the receiver's categories to be in the order of anArray. If the resulting organization does not include all elements, then give an error." | newCategories newStops newElements catName list runningTotal | newCategories := Array new: anArray size. newStops := Array new: anArray size. newElements := Array new: 0. runningTotal := 0. 1 to: anArray size do: [:i | catName := (anArray at: i) asSymbol. list := self listAtCategoryNamed: catName. newElements := newElements, list. newCategories at: i put: catName. newStops at: i put: (runningTotal := runningTotal + list size)]. elementArray do: [:element | "check to be sure all elements are included" (newElements includes: element) ifFalse: [^self error: 'New categories must match old ones']]. "Everything is good, now update my three arrays." categoryArray := newCategories. categoryStops := newStops. elementArray := newElements
</methods> <methods> Graphics.LayoutFrame class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | t | t := oldObj at: 2. "Shuffle the instance variables" oldObj at: 2 put: (oldObj at: 5). oldObj at: 5 put: t. t := oldObj at: 3. oldObj at: 3 put: (oldObj at: 4). oldObj at: 4 put: (oldObj at: 8). oldObj at: 8 put: (oldObj at: 7). oldObj at: 7 put: t. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> External.CVoidType <category>binary storage</category>
representBinaryOn: binWriter ^MessageSend receiver: self class selector: #void
</methods> <methods> Core.ByteSymbol <category>binary storage</category>
representBinaryOn: binWriter " Symbols must be re-interned when they are read in. " ^BinaryObjectStorage indexImportByteSymbol -> self
</methods> <methods> UI.ValueModel class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size-1. new at: 1 put: (oldObj at: 1). new replaceFrom: 2 to: new size with: oldObj startingAt: 3. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> Kernel.Context <category>binary storage</category>
representBinaryOn: bosWriter " The stored representation of Contexts is special. " ^bosWriter representContext: self
</methods> <methods> Graphics.CachedImage <category>binary storage</category>
representBinaryOn: binWriter ^MessageSend receiver: self class selector: #on: argument: image
</methods> <methods> Graphics.ComposedText class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+1. new replaceFrom: 1 to: 7 with: oldObj startingAt: 1. new at: 8 put: true. new replaceFrom: 9 to: new size with: oldObj startingAt: 8. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'VisualWorks Release 2.0'
</methods> <methods> Kernel.NameSpace <category>binary storage</category>
representBinaryOn: binWriter " Classes are represented by their names, under the assumption that they are all present in the Smalltalk dictionary. We also include a class/metaclass flag, the version number, and the instance format and variable names for checking. " ^BinaryObjectStorage indexImportNameSpace -> (Array with: self fullName)
</methods> <methods> Core.ClassDescription <category>method dictionary</category>
addSelectorUnsafe: s withMethod: m category: c "Add the message selector s associated with the method m under category c." self addSelectorUnsafe: s withMethod: m. self organization classify: s under: c
</methods> <methods> Core.ClassDescription <category>binary storage</category>
binaryInitializationMessagesFor: sourceMode "Answer a list of MessageSends that should be evaluated in order to initialize this class when BOSSed in. These include setting the class's comment, specifying the order of message categories for the Browser, and other actions that subclasses may want to take. For example, Class checks to see if the metaclass defines #initialize, and if so, it adds that message to the list." | list categories | list := OrderedCollection new. sourceMode == #discard ifFalse: [sourceMode == #keep ifTrue: [list add: (MessageSend receiver: self selector: #comment: argument: self comment)] ifFalse: [sourceMode == #discard ifFalse: [list add: (MessageSend receiver: self selector: #commentReferent: argument: self organization classCommentReferent)]]. categories := self organization categories. categories isEmpty ifFalse: [list add: (MessageSend receiver: self selector: #orderedCategories: argument: categories)]]. ^list
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones. The block's return value will be ignored. The block should use some means like #become: or #changeClassToThatOf: to change the identity of the block's argument to an instance of the class" " By default, classes do not know how to do this. " self error: 'Attempt to read incompatible version ', oldVersion printString, ' with format = ', oldFormat printString, ' of ', self printString. ^[:oldObj | self error: 'Attempt to create instance of old version!'. self new]
</methods> <methods> Core.ClassDescription <category>organization</category>
orderedCategories: aList "Set the list of categories known by the class's organization. If the organization knows categories not on this list, add them at the end. If the system does not support the development environment (organization is nil), do nothing." | list2 | organization == nil ifTrue: [^self]. list2 := aList copy asOrderedCollection. self organization categories do: [:cat | (list2 includes: cat) ifFalse: [list2 add: cat]]. self organization categories: list2
</methods> <methods> Core.MessageSend class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size-2. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. new replaceFrom: 4 to: new size with: oldObj startingAt: 6. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> Core.Class <category>binary storage</category>
binaryInitializationMessagesFor: sourceMode | list | list := super binaryInitializationMessagesFor: sourceMode. (self class includesSelector: #initialize) ifTrue: [list add: (MessageSend receiver: self selector: #initialize)]. ^list
</methods> <methods> Core.Class <category>instance variables</category>
classSideInstanceVariableNames: instVarString "For BOSS, declare new instance variables for myself and my subclasses" ^self class instanceVariableNames: instVarString
</methods> <methods> Core.Class <category>binary storage</category>
representBinaryOn: binWriter " Classes are represented by their names, under the assumption that they are all present in the Smalltalk dictionary. We also include a class/metaclass flag, the version number, and the instance format and variable names for checking. " | args | args := Array new: 5. args at: 1 put: self fullName. args at: 2 put: false. args at: 3 put: self binaryRepresentationVersion. args at: 4 put: self format. args at: 5 put: (self instSize = 0 ifTrue: [nil] "This prevents the difficulties associated with storing Array itself." ifFalse: [self allInstVarNames asArray]). ^BinaryObjectStorage indexImportClass -> args
representContentsBinaryOn: binWriter " Store the methods and organization. " ^self definitionMessage
</methods> <methods> UI.BooleanWidgetView class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+1. new replaceFrom: 1 to: 4 with: oldObj startingAt: 1. new replaceFrom: 6 to: new size with: oldObj startingAt: 5. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> External.CPointerType class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new segment | "Remove pointerKind, pointerClass, segment" new := Array new: oldObj size - 3. new at: 1 put: 0. new at: 2 put: (oldObj at: 3). 3 to: new size do: [:i | new at: i put: (oldObj at: i + 3)]. segment := oldObj at: 5. oldObj become: new. oldObj changeClassToThatOf: inst. segment == #far ifTrue: [oldObj beFar]. segment == #huge ifTrue: [oldObj beFar]. segment == #near ifTrue: [oldObj beNear]. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.0'
</methods> <methods> Graphics.CharacterAttributes class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size + 2. new replaceFrom: 1 to: 2 with: oldObj startingAt: 1. new replaceFrom: 5 to: new size with: oldObj startingAt: 3. oldObj become: new. oldObj changeClassToThatOf: inst. oldObj invalidateQueryCache. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'VisualWorks Release 2.0'
</methods> <methods> Graphics.Window class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. new replaceFrom: 4 to: 7 with: oldObj startingAt: 5. "Add isIconic" new at: 8 put: false. new replaceFrom: 9 to: new size with: oldObj startingAt: 9. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> UI.ParagraphEditor class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+1. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. "Add menuChannel, textHasChanged, and performer, and remove paragraph and initialText" new replaceFrom: 6 to: 7 with: oldObj startingAt: 5. new replaceFrom: 8 to: 9 with: oldObj startingAt: 8. new replaceFrom: 11 to: new size with: oldObj startingAt: 10. oldObj become: new. oldObj changeClassToThatOf: inst. oldObj textHasChanged: false. "Choose a legal value"]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
</methods> <methods> Tools.ExternalInterfaceFinder <category>actions</category>
bossOutClass "Open a dialog to confirm or collect the basic information required to BOSS-out an external interface." | dialog fileName db bossOutHierarchy className class | (className := self className) isNil ifTrue: [^self]. class := Smalltalk at: className asSymbol ifAbsent: [^self]. (class isKindOf: ExternalInterface class) ifFalse: [^self]. dialog := SimpleDialog new. db := dialog builder. db aspectAt: #fileName put: (fileName := '' asValue). db aspectAt: #hierarchy put: (bossOutHierarchy := false asValue). db aspectAt: #doCancel put: [dialog close. ^self]. db aspectAt: #doOK put: [fileName value isEmpty ifTrue: [(dialog builder componentAt: #fileName) flash] ifFalse: [dialog close]]. dialog allButOpenFrom: (self class interfaceSpecFor: #bossOutDialog). "Make CR behave like tab in name field" db openDialog. fileName := fileName value. Cursor execute showWhile: [ bossOutHierarchy value ifTrue: [class bossOutHierarchy: fileName sourceMode: #keep] ifFalse: [class bossOut: fileName sourceMode: #keep]].
</methods> <methods> Core.Signal <category>binary storage</category>
representBinaryOn: binWriter " If a Signal has a symbolic name, use it as the representation. " ^self hasName ifTrue: [MessageSend receiver: nameClass selector: nameMessage] ifFalse: [nil]
</methods> <methods> External.ExternalLibraryHolder class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self new. ^[:oldObj | | new | new := Array new: oldObj size + 1. new replaceFrom: 1 to: oldObj size with: oldObj startingAt: 1. new at: oldObj size + 1 put: nil. oldObj become: new. oldObj changeClassToThatOf: inst. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.0'
</methods> <methods> External.LinkedWeakAssociationDictionary <category>binary storage</category>
representBinaryOn: binWriter " Since an IdentityDictionary doesn't actually store Associations, represent it more efficiently as a sequence of keys and values. " | cont creator | cont := (Array new: self size * 2) writeStream. self ownKeysAndValuesDo: [:key :value | cont nextPut: key; nextPut: value]. creator := (MessageSend receiver: self class selector: #withKeysAndValues: argument: cont contents). ^binWriter expectCycles ifTrue: [BinaryObjectStorage indexImportSendSelf -> (Array with: #createSpecialObject: with: (BOSSSpecialObjectLoader message: creator))] ifFalse: [creator]
</methods> <methods> UI.ControllerWithMenu class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size+2. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. "Add menuChannel and performer" new replaceFrom: 6 to: new size with: oldObj startingAt: 4. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> Core.SortedCollectionWithPolicy class <category>instance creation</category>
fromSortedArray: aCollection sortBlock: aBlock sortPolicy: aPolicy "Answer a new SortedCollection with the given elements and sortBlock. Since this is used by BOSS, and aBlock may not really be an instance of BlockClosure, assume that the collection is sorted and do not resort it." | newCollection | newCollection := self new: aCollection size. newCollection sortBlock: aBlock. newCollection sortPolicy: aPolicy. newCollection addAllWithoutSorting: aCollection. ^newCollection
</methods> <methods> Core.SortedCollectionWithPolicy <category>binary storage</category>
representBinaryOn: binWriter " Represent a SortedCollection by its contents (elements) and its sorting information. " ^MessageSend receiver: self class selector: #fromSortedArray:sortBlock:sortPolicy: arguments: (Array with: self asArray with: sortBlock with: sortPolicy)
</methods> <methods> Kernel.BinaryStorageBytes <category>accessing</category>
objectAt: datax from: objMap baseIndex: baseIndex " Decode the encoded oop at byte index datax in the receiver. table is the table of decoded objects. baseIndex is the object index of the first element of the table. " | tag vx value | " Ordinarily we would just get the oop by self unsignedLongAt: datax. However, if the oop is a SmallInteger of more than 27 bits, this would cause an unnecessary LargeInteger to be created. As it happens, this is precisely the case for two of the instance variables of short CompiledMethods. The time penalty for this is so large that we make an explicit byte ordering check and extract the oop in two shorts. " UninterpretedBytes isBigEndian ifTrue: [tag := self unsignedShortAt: datax + 2. vx := datax] ifFalse: [tag := self unsignedShortAt: datax. vx := datax + 2]. ^(tag bitAnd: 1) = 0 ifFalse: [value := ((self shortAt: vx) bitShift: 14) + (tag bitShift: -2). (tag bitAnd: 2) = 0 ifTrue: [Character value: value] ifFalse: [value]] ifTrue: [value := self unsignedLongAt: datax. (tag bitAnd: 2) = 0 ifTrue: [objMap at: value] ifFalse: [objMap at: value - 2 + baseIndex]]
replaceBytesFrom: startIndex with: src | si | si := startIndex - 1. 1 to: src basicSize do: [:i | self basicAt: si + i put: (src basicAt: i)]
shortObjectAt: datax from: table baseIndex: baseIndex " Decode the encoded oop at byte index datax in the receiver. table is the table of decoded objects. baseIndex is the object index of the first element of the table. " | int value | int := self unsignedShortAt: datax. ^(int bitAnd: 1) = 0 ifFalse: [value := int bitShift: -2. (int bitAnd: 2) = 0 ifTrue: [Character value: value] ifFalse: [value]] ifTrue: [(int bitAnd: 2) = 0 ifTrue: [table at: int] ifFalse: [table at: int - 2 + baseIndex]]
swapBytesWidth: w " Reverse the byte order of the w-byte quantities in the receiver. w is 2 or 4, and a divisor of the receiver's size. " w = 2 ifTrue: [self swapColumn: 0 with: 1. self swapColumn: 2 with: 3. (self size anyMask: 2) ifTrue: "swap 2 trailing bytes" [self swap: self size - 1 with: self size]] ifFalse: "w = 4" [self swapColumn: 0 with: 3. self swapColumn: 1 with: 2]
swapColumn: c0 with: c1 " Swap bytes at indices 4N+c0+1 with those at indices 4N+c1+1. " | height | height := self size bitShift: -2. height <= 5 ifTrue: [" Just do it with at: and at:put:. " 1 to: (height bitShift: 2) by: 4 do: [:i | | t | t := self at: i + c0. self at: i + c0 put: (self at: i + c1). self at: i + c1 put: t]] ifFalse: [" Do it with RasterOp. " | x0 x1 t | x0 := c0 bitShift: 3. x1 := c1 bitShift: 3. 3 timesRepeat: [self copyBitsStride: 1 width: 32 atX: x1 y: 0 from: self stride: 1 width: 32 atX: x0 y: 0 width: 8 height: height rule: RasterOp reverse. t := x0. x0 := x1. x1 := t]]
</methods> <methods> Graphics.DisplaySurface class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size-1. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. new replaceFrom: 4 to: new size with: oldObj startingAt: 5. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> UI.DependentList <category>binary storage</category>
representBinaryOn: binWriter " Represent a DependentList by its contents (elements). " ^MessageSend receiver: self class selector: #withAll: argument: (self isEmpty ifTrue: [#()] ifFalse: [self asArray])
</methods> <methods> Tools.DictionaryInspector class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat " An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self basicNew. ^[:oldObj | | new | new := Array new: oldObj size-1. new replaceFrom: 1 to: 3 with: oldObj startingAt: 1. new replaceFrom: 4 to: new size with: oldObj startingAt: 5. oldObj become: new. oldObj changeClassToThatOf: inst]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion " Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 4.1'
</methods> <methods> External.ExternalObject class <category>binary storage</category>
binaryReaderBlockForVersion: oldVersion format: oldFormat "An attempt is being made to read instances of an obsolete version of this class. Answer a block that converts old instances (represented as an array or string of instance variable values) to new ones." oldVersion == nil ifTrue: [| inst | inst := self new. ^[:oldObj | | new | new := Array new: 6. new replaceFrom: 1 to: 4 with: oldObj startingAt: 1. (oldObj at: 6) isNil ifTrue: [new at: 5 put: nil] ifFalse: [new at: 5 put: #()]. new at: 6 put: nil. oldObj become: new. oldObj changeClassToThatOf: inst. oldObj]]. ^super binaryReaderBlockForVersion: oldVersion format: oldFormat
binaryRepresentationVersion "Answer a version identification for the particular representation that the receiver uses for representBinaryOn:." ^'Release 2.0'
</methods> <methods> Graphics.Palette <category>binary storage</category>
representBinaryOn: binWriter "If a Palette has a name as a constant, use the name to represent it." | const | const := self class constantNameFor: self. ^const isNil ifTrue: [nil] ifFalse: [MessageSend receiver: self class selector: const]
</methods> <methods> Tools.ExternalInterfaceFinder class <category>interface specs</category>
bossOutDialog "UIPainter new openOnClass: self andSelector: #bossOutDialog" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: 'BOSS Out As' #min: #(#Point 231 147 ) #max: #(#Point 640 147 ) #bounds: #(#Rectangle 63 221 320 368 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#Point 10 32 ) #label: 'File Name:' ) #(#LabelSpec #layout: #(#AlignmentOrigin 0 0.5 8 0 0.5 0 ) #label: 'BOSS Out As' ) #(#InputFieldSpec #layout: #(#LayoutFrame 16 0 56 0 -10 1 80 0 ) #name: #fileName #model: #fileName ) #(#CheckBoxSpec #layout: #(#Point 10 85 ) #model: #hierarchy #label: 'Hierarchy' ) #(#ActionButtonSpec #layout: #(#LayoutFrame -82 0.5 -35 1 -16 0.5 -5 1 ) #model: #doOK #label: 'OK' #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 16 0.5 -35 1 82 0.5 -5 1 ) #model: #doCancel #label: 'Cancel' #defaultable: true ) ) ) )
</methods> <initialize> Kernel.BOSSTransporter </initialize> <initialize> Kernel.BOSSReader </initialize> <initialize> Kernel.BinaryObjectStorage </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>CachedImage</name> <environment>Graphics</environment> <super>Graphics.PixelArray</super> <private>false</private> none image retainedMedium conversionMessage <imports></imports> <category>Graphics-Images</category> <attributes> <package>Graphics-Images</package> </attributes> </class> <class> <name>ByteString</name> <environment>Core</environment> <super>Core.ByteEncodedString</super> <private>false</private> bytes <imports></imports> <category>Collections-String Support</category> <attributes> <package>Collections-String Support</package> </attributes> </class> <class> <name>Array</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> objects <imports></imports> <category>Collections-Arrayed</category> <attributes> <package>Collections-Arrayed</package> </attributes> </class> <class> <name>GraphicsHandle</name> <environment>Graphics</environment> <super>Core.UninterpretedBytes</super> <private>false</private> bytes <imports></imports> <category>OS-Window System</category> <attributes> <package>OS-Window System</package> </attributes> </class> <class> <name>CScalarType</name> <environment>External</environment> <super>External.CType</super> <private>false</private> none kind numBits printName storeSelector atSelector atPutSelector <imports></imports> <category>External-Types</category> <attributes> <package>External-Types</package> </attributes> </class> <class> <name>ByteSymbol</name> <environment>Core</environment> <super>Core.Symbol</super> <private>false</private> bytes <imports></imports> <category>Collections-String Support</category> <attributes> <package>Collections-String Support</package> </attributes> </class> <class> <name>Behavior</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none superclass methodDict format subclasses <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>ClassDescription</name> <environment>Core</environment> <super>Core.Behavior</super> <private>false</private> none instanceVariables organization <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Metaclass</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none thisClass <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Class</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none name classPool environment <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>LimitedPrecisionReal</name> <environment>Core</environment> <super>Core.Number</super> <private>false</private> none powersOfTwo <imports></imports> <category>Magnitude-Numbers</category> <attributes> <package>Magnitude-Numbers</package> </attributes> </class> <class> <name>Set</name> <environment>Core</environment> <super>Core.Collection</super> <private>false</private> objects tally <imports></imports> <category>Collections-Unordered</category> <attributes> <package>Collections-Unordered</package> </attributes> </class> <class> <name>Dictionary</name> <environment>Core</environment> <super>Core.Set</super> <private>false</private> objects <imports></imports> <category>Collections-Unordered</category> <attributes> <package>Collections-Unordered</package> </attributes> </class> <class> <name>OSHandle</name> <environment>OS</environment> <super>OS.OSErrorHolder</super> <private>false</private> none handle <imports></imports> <category>OS-Support</category> <attributes> <package>OS-Support</package> </attributes> </class> <class> <name>IdentityDictionary</name> <environment>Core</environment> <super>Core.Dictionary</super> <private>false</private> objects valueArray <imports></imports> <category>Collections-Unordered</category> <attributes> <package>Collections-Unordered</package> </attributes> </class> <class> <name>ClassOrganizer</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none globalComment categoryArray categoryStops elementArray <imports></imports> <category>Kernel-Support</category> <attributes> <package>Kernel-Support</package> </attributes> </class> <class> <name>OrderedCollection</name> <environment>Core</environment> <super>Core.SequenceableCollection</super> <private>false</private> objects firstIndex lastIndex <imports></imports> <category>Collections-Sequenceable</category> <attributes> <package>Collections-Sequenceable</package> </attributes> </class> <class> <name>SortedCollection</name> <environment>Core</environment> <super>Core.OrderedCollection</super> <private>false</private> objects sortBlock <imports></imports> <category>Collections-Sequenceable</category> <attributes> <package>Collections-Sequenceable</package> </attributes> </class> <class> <name>SortedCollectionWithPolicy</name> <environment>Core</environment> <super>Core.SortedCollection</super> <private>false</private> objects sortPolicy <imports></imports> <category>Collections-Sequenceable</category> <attributes> <package>Collections-Sequenceable</package> </attributes> </class> <class> <name>Context</name> <environment>Kernel</environment> <super>Kernel.InstructionStream</super> <private>false</private> none sender receiver stackp stack <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>ExternalInterfaceFinder</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none externalList categoryList classNameList externalInterfaceHolder filter <imports></imports> <category>DLLCC-Interface</category> <attributes> <package>DLLCC</package> </attributes> </class> <class> <name>MethodDictionary</name> <environment>Kernel</environment> <super>Core.KeyedCollection</super> <private>false</private> objects <imports></imports> <category>Kernel-Support</category> <attributes> <package>Kernel-Support</package> </attributes> </class> <class> <name>NamedChangeSet</name> <environment>Tools</environment> <super>Kernel.ChangeSet</super> <private>false</private> none changeSetName lastChange lastFileOut lastFileOutName dirty comment <imports></imports> <category>System-Changes</category> <attributes> <package>System-Changes</package> </attributes> </class> <class> <name>ByteArray</name> <environment>Core</environment> <super>Core.IntegerArray</super> <private>false</private> bytes <imports></imports> <category>Collections-Arrayed</category> <attributes> <package>Collections-Arrayed</package> </attributes> </class> <class> <name>CompiledMethod</name> <environment>Kernel</environment> <super>Kernel.CompiledMainBlock</super> <private>false</private> objects mclass sourceCode <imports> private Kernel.OpcodePool.* </imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>LinkedWeakAssociationDictionary</name> <environment>External</environment> <super>External.WeakAssociationDictionary</super> <private>false</private> objects backup <imports></imports> <category>External-Collections</category> <attributes> <package>External-Collections</package> </attributes> </class> <class> <name>Palette</name> <environment>Graphics</environment> <super>Core.KeyedCollection</super> <private>false</private> none <imports></imports> <category>Graphics-Palettes</category> <attributes> <package>Graphics-Palettes</package> </attributes> </class> <class> <name>BinaryStorageBytes</name> <environment>Kernel</environment> <super>Core.ByteArray</super> <private>false</private> bytes <imports></imports> <category>System-Code Storage</category> <attributes> <package>System-Code Storage</package> </attributes> </class> <class> <name>NameSpace</name> <environment>Kernel</environment> <super>Kernel.GeneralNameSpace</super> <private>false</private> none parent name <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>MappedPalette</name> <environment>Graphics</environment> <super>Graphics.ColorPalette</super> <private>false</private> none hasColor palette inverseMap mapResolution size <imports></imports> <category>Graphics-Palettes</category> <attributes> <package>Graphics-Palettes</package> </attributes> </class> <class> <name>Signal</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none parent mayProceed notifierString nameClass nameMessage exceptionClass <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class> <class> <name>CVoidType</name> <environment>External</environment> <super>External.CType</super> <private>false</private> none <imports></imports> <category>External-Types</category> <attributes> <package>External-Types</package> </attributes> </class> <class> <name>DependentList</name> <environment>UI</environment> <super>Core.List</super> <private>false</private> none <imports></imports> <category>UIBasics-Collections</category> <attributes> <package>UIBasics-Collections</package> </attributes> </class> <class> <name>LensCommandVariable</name> <environment>Lens</environment> <super>Lens.LensExpressionSurrogate</super> <private>false</private> none name variable <imports></imports> <category>Lens-Private-Transporter</category> <attributes> <package>Lens-Runtime</package> </attributes> </class> <class> <name>ExternalDictionary</name> <environment>External</environment> <super>External.LinkedWeakAssociationDictionary</super> <private>false</private> objects <imports></imports> <category>External-Collections</category> <attributes> <package>External-Collections</package> </attributes> </class> <class> <name>TwoByteSymbol</name> <environment>Core</environment> <super>Core.Symbol</super> <private>false</private> bytes <imports></imports> <category>Collections-String Support</category> <attributes> <package>Collections-String Support</package> </attributes> </class> <class> <name>LensRegistry</name> <environment>Lens</environment> <super>Core.Dictionary</super> <private>false</private> objects keyArray <imports></imports> <category>Lens-Private-Support</category> <attributes> <package>Lens-Runtime</package> </attributes> </class>