[Vm-dev] VM Maker: Cog-eem.338.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Apr 3 16:49:49 UTC 2017
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.338.mcz
==================== Summary ====================
Name: Cog-eem.338
Author: eem
Time: 3 April 2017, 9:49:41.714544 am
UUID: f996ae42-acb4-475e-b2f9-670019c3a702
Ancestors: Cog-eem.337
Cog minus the contents of CogAttic-eem.2
=============== Diff against Cog-eem.337 ===============
Item was removed:
- ----- Method: Behavior>>BehaviorPROTOTYPEinstSize (in category '*Cog-method prototypes') -----
- BehaviorPROTOTYPEinstSize
- "Answer the number of named instance variables
- (as opposed to indexed variables) of the receiver.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>"
- ^format bitAnd: 16rFFFF!
Item was removed:
- ----- Method: Behavior>>BehaviorPROTOTYPEinstSpec (in category '*Cog-method prototypes') -----
- BehaviorPROTOTYPEinstSpec
- "Answer the instance specification part of the format that defines what kind of object
- an instance of the receiver is. The formats are
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^(format bitShift: -16) bitAnd: 16r1F!
Item was removed:
- ----- Method: BlockClosure>>BlockClosurePHAROPROTOTYPEsimulateValueWithArguments:caller: (in category '*Cog-method prototypes') -----
- BlockClosurePHAROPROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
- | newContext sz |
- newContext := (Context newForMethod: outerContext method)
- setSender: aContext
- receiver: outerContext receiver
- method: outerContext method
- closure: self
- startpc: startpc.
- ((newContext objectClass: anArray) ~~ Array
- or: [numArgs ~= anArray size]) ifTrue:
- [^Context primitiveFailTokenFor: nil].
- sz := self basicSize.
- newContext stackp: sz + numArgs.
- 1 to: numArgs do:
- [:i| newContext at: i put: (anArray at: i)].
- 1 to: sz do:
- [:i| newContext at: i + numArgs put: (self at: i)].
- ^newContext!
Item was removed:
- ----- Method: BlockClosure>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category '*Cog-method prototypes') -----
- BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
- | newContext sz |
- newContext := (MethodContext newForMethod: outerContext method)
- setSender: aContext
- receiver: outerContext receiver
- method: outerContext method
- closure: self
- startpc: startpc.
- ((newContext objectClass: anArray) ~~ Array
- or: [numArgs ~= anArray size]) ifTrue:
- [^ContextPart primitiveFailTokenFor: nil].
- sz := self basicSize.
- newContext stackp: sz + numArgs.
- 1 to: numArgs do:
- [:i| newContext at: i put: (anArray at: i)].
- 1 to: sz do:
- [:i| newContext at: i + numArgs put: (self at: i)].
- ^newContext!
Item was removed:
- ----- Method: ClassDescription>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category '*Cog-method prototypes squeak') -----
- ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
- "ClassBuilder support for maintaining valid method bindings."
- methodDict do: [:method| method methodClassAssociation: aBinding]!
Item was removed:
- ----- Method: CogScripts class>>bootstrapClosures (in category 'closure scripts') -----
- bootstrapClosures
- "CogScripts bootstrapClosures"
- | rep |
- Transcript clear.
- rep := false
- ifTrue: [MCCacheRepository default]
- ifFalse:
- [MCHttpRepository
- location: 'http://dev.qwaq.com/ss/Oinq'
- user: 'qwaq'
- password: ''].
- "This changes load order in Monticello such that additions come in before modifications."
- (rep loadVersionFromFileNamed: 'Monticello-eem.302.mcz') load.
- "This adds some prereqs the compiler uses that are loaded in later packages:
- Fix the ClassBuilder so redefining CompiledMethod can add and remove class variables.
- Add Object/Array>>isArray.
- Add new interface for accessing inst vars & fields on initializing the compiler (Encoder)."
- self bootstrapClosuresCompilerPreloadCode readStream fileIn.
- "This temporarily stops Monticello from unloading code on load and warning about overwriting changes.
- Since changes span multiple packages need all additions in before any deletions occur.
- Can't warn about anything until the new debugger api is installed."
- ChangeSet
- newChangesFromStream: self bootstrapClosuresNeuterMonticelloCode readStream
- named: 'neuterMonticello'.
- Smalltalk at: #DoNotUnload put: true.
- 1 to: 2 do:
- [:i|
- #( 'Compiler-eem.30.mcz'
- 'Files-eem.21.mcz'
- 'Exceptions-eem.14.mcz'
- 'Collections-eem.55.mcz'
- 'Tools-eem.45.mcz'
- 'Kernel-eem.82.mcz'
- 'System-eem.53.mcz'
- 'Brad-eem.51.mcz'
- 'Morphic-eem.38.mcz'
- 'Tweak-Compiler-eem.36.mcz'
- 'Tweak-Hacks-eem.30.mcz'
- 'Tweak-Basic-eem.151.mcz'
- 'Tweak-Core-Proto-eem.56.mcz') do:
- [:pn|
- Transcript clear; nextPutAll: pn; space; nextPut: $(; print: i; nextPut: $); endEntry.
- (rep loadVersionFromFileNamed: pn) load].
- Smalltalk at: #DoNotUnload put: false].
- "Now remove the temporary hacks to Monticello"
- (ChangeSet named: 'neuterMonticello') changedMessageList do:
- [:mr| | changeRecords |
- changeRecords := mr actualClass changeRecordsAt: mr methodSymbol.
- changeRecords second fileIn].
- "Install BlockClosure in the specialObjectsArray"
- Smalltalk recreateSpecialObjectsArray.
- "Throw the switch to compile to closures"
- self bootstrapClosuresClosureCompilerSwitchCode readStream fileIn.
- "Recompile the system except the one method we can't yet deal with in GeniePlugin (1 too many literals)"
- (Smalltalk forgetDoIts allClasses reject: [:c| c name == #GeniePlugin]) do:
- [:c|
- { c. c class } do:
- [:b|
- Transcript cr; print: b; endEntry.
- b selectors asSortedCollection do:
- [:s|
- b recompile: s from: b]]].
- UsefulScripts postRecompileCleanup.
- self inform: 'Save and quit and then run UsefulScripts postRecompileCleanup.\Rinse and repeat' withCRs!
Item was removed:
- ----- Method: CogScripts class>>createSVMTree (in category 'separate vm scripts') -----
- createSVMTree
- "Create the parallel StackInterpreterS, CoInterpreterS tree in which
- objectMemory is an inst var rather than ObjectMemory et al being a superclass"
- "CogScripts createSVMTree"
-
- | changes map |
- changes := Cursor execute showWhile: [self changedMethodsForObjectMemorySends].
-
- map := Cursor execute showWhile: [self createStackInterpreterSHierarchy].
-
- (ChangeSet superclassOrder: (StackInterpreter withAllSubclasses select: [:c| map includesKey: c]) asArray) do:
- [:sourceClass|
- sourceClass selectors do:
- [:sel| | destClass source stamp |
- destClass := map
- at: (((sel beginsWith: 'primitive')
- and: [sel last ~~ $:
- and: [sel ~~ #primitiveFail]])
- ifTrue: [{sourceClass. #primitives}]
- ifFalse: [sourceClass])
- ifAbsent: [map at: sourceClass].
- (changes detect: [:c| c changeClass == sourceClass and: [c selector = sel]] ifNone: [])
- ifNotNil:
- [:change|
- source := change source.
- stamp := Utilities changeStamp copyReplaceAll: Utilities authorInitials with: Utilities authorInitials, ' (objmem refactor)']
- ifNil:
- [source := sourceClass sourceCodeAt: sel.
- stamp := (sourceClass >> sel) timeStamp].
- [destClass
- compile: source
- classified: (sourceClass whichCategoryIncludesSelector: sel)
- withStamp: stamp
- notifying: nil]
- on: SyntaxErrorNotification
- do: [:ex| | newBrowser |
- newBrowser := Browser new setClass: destClass selector: nil.
- newBrowser selectMessageCategoryNamed: (sourceClass whichCategoryIncludesSelector: sel).
- Browser
- openBrowserView: (newBrowser openMessageCatEditString: source)
- label: 'category "', (sourceClass whichCategoryIncludesSelector: sel), '" in ', destClass name]]].
-
- self readWriteVars, self readOnlyVars do:
- [:sym|
- (NewObjectMemory whichClassIncludesSelector: sym) ifNil:
- [(NewObjectMemory whichClassDefinesInstVar: sym asString)
- compile: sym, (String with: Character cr with: Character tab with: $^), sym
- classified: #accessing]].
- self readWriteVars do:
- [:sym| | setter | setter := (sym, ':') asSymbol.
- (NewObjectMemory whichClassIncludesSelector: setter) ifNil:
- [(NewObjectMemory whichClassDefinesInstVar: sym asString)
- compile: setter, ' aValue', (String with: Character cr with: Character tab with: $^), sym, ' := aValue'
- classified: #accessing]].!
Item was removed:
- ----- Method: CogScripts class>>createStackInterpreterSHierarchy (in category 'separate vm scripts') -----
- createStackInterpreterSHierarchy
- "Create the parallel StackInterpreterS, CoInterpreterS tree (without methods).
- Answer a Dictionary maping source class to dest class with {source. #primitives} -> dest
- for the added primitives classes."
-
- | map |
- (Smalltalk classNamed: #StackInterpreterS) ifNotNil:
- [:sis|
- (Object confirm: 'StackInterpreterS exists, nuke?') ifTrue:
- [(ChangeSet superclassOrder: sis withAllSubclasses asArray) reverseDo:
- [:sissc| sissc removeFromSystemUnlogged]]].
-
- map := Dictionary new.
- (ChangeSet superclassOrder: (StackInterpreter withAllSubclasses
- remove: SchizophrenicClosureFormatStackInterpreter;
- yourself) asArray) do:
- [:sisc| | def |
- def := sisc definition.
- def := sisc == StackInterpreter
- ifTrue: [((def copyReplaceAll: sisc superclass name, ' ' with: ObjectMemory superclass name, ' ')
- copyReplaceAll: 'instanceVariableNames: ''' with: 'instanceVariableNames: ''objectMemory ')
- copyReplaceAll: 'poolDictionaries: ''' with: 'poolDictionaries: ''', (ObjectMemory poolDictionaryNames fold: [:a :b| a, ' ', b]), ' ']
- ifFalse: [def copyReplaceAll: sisc superclass name, ' ' with: sisc superclass name, 'S '].
- def := def copyReplaceAll: sisc name printString with: sisc name printString, 'S'.
- map at: sisc put: (Compiler evaluate: def)].
-
- map at: {StackInterpreter. #primitives}
- put: (Compiler
- evaluate: 'StackInterpreterS subclass: #StackInterpreterSPrimitives
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''VMMaker-Interpreter''');
- at: {CoInterpreter. #primitives}
- put: (Compiler
- evaluate: 'CoInterpreterS subclass: #CoInterpreterSPrimitives
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''VMMaker-Interpreter''');
- at: {StackInterpreter. #objmem}
- put: (Compiler
- evaluate: 'NewObjectMemory subclass: #NewObjectMemoryS
- instanceVariableNames: ''coInterpreter''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''VMMaker-Interpreter''');
- at: {CoInterpreter. #objmem}
- put: (Compiler
- evaluate: 'NewObjectMemoryS subclass: #NewCoObjectMemoryS
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''VMMaker-Interpreter''').
-
- "reparent subclasses underneath StackInterpreterSPrimitives & CoInterpreterSPrimitives"
- #(StackInterpreterS CoInterpreterS) do:
- [:cn|
- ((Smalltalk classNamed: cn) subclasses reject: [:c| c name endsWith: 'Primitives']) do:
- [:sisc| | def |
- def := sisc definition.
- def := def copyReplaceAll: cn, ' ' with: cn, 'Primitives '.
- Compiler evaluate: def]].
- ^map!
Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category '*Cog-method prototypes') -----
- CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
- anEncoder class == PrimaryBytecodeSetEncoderClass ifTrue:
- [^0].
- anEncoder class == SecondaryBytecodeSetEncoderClass ifTrue:
- [^SmallInteger minVal].
- self error: 'The encoder is not one of the two installed bytecode sets'!
Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinitialize (in category '*Cog-method prototypes') -----
- CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize"
- "Initialize class variables specifying the size of the temporary frame
- needed to run instances of me."
-
- SmallFrame := 16. "Context range for temps+stack"
- LargeFrame := 56.
- PrimaryBytecodeSetEncoderClass ifNil:
- [PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures].
- SecondaryBytecodeSetEncoderClass ifNil:
- [SecondaryBytecodeSetEncoderClass := EncoderForV3PlusClosures]!
Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category '*Cog-method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
- PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
- [^self].
- (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
- [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
- (self allSubInstances
- detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
- ifNone: []) ifNotNil:
- [Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
- PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!
Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category '*Cog-method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
- PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
- [^self].
- (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
- [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
- (self allSubInstances
- detect: [:m| m header < 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
- ifNone: []) ifNotNil:
- [Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
- SecondaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!
Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category '*Cog-method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
- "Answer an instance of me. The header is specified by the message
- arguments. The remaining parts are not as yet determined."
- | method pc |
- nArgs > 15 ifTrue:
- [^self error: 'Cannot compile -- too many arguments'].
- nTemps > 63 ifTrue:
- [^self error: 'Cannot compile -- too many temporary variables'].
- nLits > 32768 ifTrue:
- [^self error: 'Cannot compile -- too many literals'].
-
- method := trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24)
- + (nTemps bitShift: 18)
- + ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- + nLits
- + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]).
- primitiveIndex > 0 ifTrue:
- [pc := method initialPC.
- method
- at: pc + 0 put: method encoderClass callPrimitiveCode;
- at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
- at: pc + 2 put: (primitiveIndex bitShift: -8)].
- ^method!
Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category '*Cog-method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
- "Answer an instance of me. The header is specified by the message
- arguments. The remaining parts are not as yet determined."
- | method pc |
- nArgs > 15 ifTrue:
- [^self error: 'Cannot compile -- too many arguments'].
- nTemps > 63 ifTrue:
- [^self error: 'Cannot compile -- too many temporary variables'].
- nLits > 32768 ifTrue:
- [^self error: 'Cannot compile -- too many literals'].
-
- method := trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24)
- + (nTemps bitShift: 18)
- + ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- + nLits
- + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- + (flag ifTrue: [1 bitShift: 29] ifFalse: [0]).
- primitiveIndex > 0 ifTrue:
- [pc := method initialPC.
- method
- at: pc + 0 put: method encoderClass callPrimitiveCode;
- at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
- at: pc + 2 put: (primitiveIndex bitShift: -8)].
- ^method!
Item was removed:
- ----- Method: CompiledMethod>>CompiledMethodPROTOTYPEencoderClass (in category '*Cog-method prototypes') -----
- CompiledMethodPROTOTYPEencoderClass
- "Answer the encoder class that encoded the bytecodes in this method.
- The sign flag bit is used by the VM to select a bytecode set. This formulation
- may seem odd but this has to be fast, so no property probe unless needed."
-
- ^self header >= 0
- ifTrue:
- [PrimaryBytecodeSetEncoderClass]
- ifFalse:
- [PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass
- ifTrue: "Support for testing prior to installing another set"
- [(self propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]]
- ifFalse:
- [SecondaryBytecodeSetEncoderClass]]!
Item was removed:
- ----- Method: Context>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') -----
- ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments
- "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
- arguments are given as arguments to this message. If successful, push result and return
- resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
- execution needs to be intercepted and simulated to avoid execution running away."
-
- | value |
- "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- the debugger from entering various run-away activities such as spawning a new
- process, etc. Injudicious use results in the debugger not being able to debug
- interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
- "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- primitiveIndex = 19 ifTrue:
- [ Smalltalk tools debugger
- openContext: self
- label:'Code simulation error'
- contents: nil].
-
- ((primitiveIndex between: 201 and: 222)
- and: [(self objectClass: aReceiver) includesBehavior: BlockClosure]) ifTrue:
- [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
- or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^aReceiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^aReceiver simulateValueWithArguments: arguments first caller: self]].
-
- primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- [^self send: arguments first to: aReceiver with: arguments allButFirst super: false].
- primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- [^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (self objectClass: aReceiver)].
- primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- [^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
-
- "Mutex>>primitiveEnterCriticalSection
- Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
- (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
- [| active effective |
- active := Processor activeProcess.
- effective := active effectiveProcess.
- "active == effective"
- value := primitiveIndex = 186
- ifTrue: [aReceiver primitiveEnterCriticalSectionOnBehalfOf: effective]
- ifFalse: [aReceiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
- ^(self isPrimFailToken: value)
- ifTrue: [value]
- ifFalse: [self push: value]].
-
- primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
- [^Context
- sender: self
- receiver: aReceiver
- method: (arguments at: 2)
- arguments: (arguments at: 1)].
-
- "Closure primitives"
- (primitiveIndex = 200 and: [self == aReceiver]) ifTrue:
- "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
- [^self push: (BlockClosure
- outerContext: aReceiver
- startpc: pc + 2
- numArgs: arguments first
- copiedValues: arguments last)].
-
- primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
- [(arguments size = 2
- and: [arguments first isInteger
- and: [(self objectClass: arguments last) == Array]]) ifFalse:
- [^Context primitiveFailTokenFor: nil].
- ^self doPrimitive: arguments first method: meth receiver: aReceiver args: arguments last].
-
- value := primitiveIndex = 120 "FFI method"
- ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
- ifFalse:
- [primitiveIndex = 117 "named primitives"
- ifTrue: [self tryNamedPrimitiveIn: meth for: aReceiver withArgs: arguments]
- ifFalse: [aReceiver tryPrimitive: primitiveIndex withArgs: arguments]].
-
- ^(self isPrimFailToken: value)
- ifTrue: [value]
- ifFalse: [self push: value]!
Item was removed:
- ----- Method: Context>>ContextPROTOTYPEfailPrimitiveWith: (in category '*Cog-method prototypes') -----
- ContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
- bytecode and store the primitive fail code if there is one and the method consumes it."
- self skipCallPrimitive.
- ((self isPrimFailToken: maybePrimFailToken)
- and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
- [self at: stackp put: maybePrimFailToken last]!
Item was removed:
- ----- Method: Context>>ContextPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') -----
- ContextPROTOTYPEisPrimFailToken: anObject
- ^ anObject class == Array
- and: [anObject size = 2
- and: [anObject first == PrimitiveFailToken]]!
Item was removed:
- ----- Method: Context>>ContextPROTOTYPEobjectClass: (in category '*Cog-method prototypes') -----
- ContextPROTOTYPEobjectClass: aReceiver
- <primitive: 111>
- self primitiveFailed!
Item was changed:
----- Method: Context>>xray (in category '*Cog-Tests-xrays') -----
xray
"Lift the veil from a context and answer an integer describing its interior state.
Used for e.g. VM tests so they can verify they're testing what they think they're testing.
0 implies a vanilla heap context.
Bit 0 = is or was married to a frame
Bit 1 = is still married to a frame
Bit 2 = frame is executing machine code
Bit 3 = has machine code pc (as opposed to nil or a bytecode pc)
Bit 4 = method is currently compiled to machine code"
<primitive: 213>
^0 "Can only fail if unimplemented; therefore simply answer 0"!
Item was changed:
----- Method: Context>>xrayIsDivorced (in category '*Cog-Tests-xrays') -----
xrayIsDivorced
^(self xray bitAnd: 3) = 1!
Item was changed:
----- Method: Context>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') -----
xrayIsExecutingMachineCode
^self xray anyMask: 4!
Item was changed:
----- Method: Context>>xrayIsMarried (in category '*Cog-Tests-xrays') -----
xrayIsMarried
^self xray anyMask: 2!
Item was changed:
----- Method: Context>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') -----
xrayLastExecutedMachineCode
^self xray anyMask: 8!
Item was changed:
----- Method: Context>>xrayMethodIsCompiledToMachineCode (in category '*Cog-Tests-xrays') -----
xrayMethodIsCompiledToMachineCode
^self xray anyMask: 16!
Item was removed:
- ----- Method: ContextPart>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') -----
- ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
- "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
- arguments are given as arguments to this message. If successful, push result and return
- resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
- execution needs to be intercepted and simulated to avoid execution running away."
-
- | value |
- "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- the debugger from entering various run-away activities such as spawning a new
- process, etc. Injudicious use results in the debugger not being able to debug
- interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
- "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- primitiveIndex = 19 ifTrue:
- [ToolSet
- debugContext: self
- label:'Code simulation error'
- contents: nil].
-
- ((primitiveIndex between: 201 and: 222)
- and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
- [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
- or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^receiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^receiver simulateValueWithArguments: arguments first caller: self]].
-
- primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- [^self send: arguments first to: receiver with: arguments allButFirst super: false].
- primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
- primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
-
- "Mutex>>primitiveEnterCriticalSection
- Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
- (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
- [| active effective |
- active := Processor activeProcess.
- effective := active effectiveProcess.
- "active == effective"
- value := primitiveIndex = 186
- ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
- ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
- ^(self isPrimFailToken: value)
- ifTrue: [value]
- ifFalse: [self push: value]].
-
- primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
- [^MethodContext
- sender: self
- receiver: receiver
- method: (arguments at: 2)
- arguments: (arguments at: 1)].
-
- "Closure primitives"
- (primitiveIndex = 200 and: [self == receiver]) ifTrue:
- "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
- [^self push: (BlockClosure
- outerContext: receiver
- startpc: pc + 2
- numArgs: arguments first
- copiedValues: arguments last)].
-
- primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
- [(arguments size = 2
- and: [arguments first isInteger
- and: [(self objectClass: arguments last) == Array]]) ifFalse:
- [^ContextPart primitiveFailTokenFor: nil].
- ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
-
- value := primitiveIndex = 120 "FFI method"
- ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
- ifFalse:
- [primitiveIndex = 117 "named primitives"
- ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
- ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
-
- ^(self isPrimFailToken: value)
- ifTrue: [value]
- ifFalse: [self push: value]!
Item was removed:
- ----- Method: ContextPart>>ContextPartPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') -----
- ContextPartPROTOTYPEisPrimFailToken: anObject
- ^(self objectClass: anObject) == Array
- and: [anObject size = 2
- and: [anObject first == PrimitiveFailToken]]!
Item was removed:
- ----- Method: Decompiler>>DecompilerPROTOTYPEdecompile:in:method:using: (in category '*Cog-method prototypes squeak 4.3') -----
- DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
-
- | block node |
- constructor := aConstructor.
- method := aMethod.
- self initSymbols: aClass. "create symbol tables"
- method isQuick
- ifTrue: [block := self quickMethod]
- ifFalse:
- [stack := OrderedCollection new: method frameSize.
- lastJumpIfPcStack := OrderedCollection new.
- caseExits := OrderedCollection new.
- statements := OrderedCollection new: 20.
- numLocalTemps := 0.
- super method: method pc: method initialPC.
- "skip primitive error code store if necessary"
- (method primitive ~= 0 and: [self skipCallPrimitive; willStore]) ifTrue:
- [pc := pc + (method encoderClass bytecodeSize: self firstByte).
- tempVars := tempVars asOrderedCollection].
- block := self blockTo: method endPC + 1.
- stack isEmpty ifFalse: [self error: 'stack not empty']].
- node := constructor
- codeMethod: aSelector
- block: block
- tempVars: tempVars
- primitive: method primitive
- class: aClass.
- method primitive > 0 ifTrue:
- [node removeAndRenameLastTempIfErrorCode].
- ^node preen!
Item was changed:
----- Method: ETC>>setMethod: (in category 'initialize-release') -----
setMethod: aCompiledMethod
scanner := InstructionStream new method: aCompiledMethod pc: aCompiledMethod initialPC.
contextStack := OrderedCollection new.
+ currentContext := Context
- currentContext := MethodContext
sender: nil
receiver: nil
method: aCompiledMethod
arguments: ((1 to: aCompiledMethod numArgs) collect:
[:i| 'arg', i printString]).
aCompiledMethod numArgs + 1 to: aCompiledMethod numTemps do:
[:i| currentContext at: i put: 'tmp', (i - aCompiledMethod numArgs) printString].
sends := Dictionary new.
joinOffsets := Dictionary new.
blockEndStack := OrderedCollection new.
blockEnd := aCompiledMethod endPC.
topIsVector := false!
Item was removed:
- ----- Method: EncoderForV3PlusClosures>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category '*Cog-method prototypes') -----
- EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex
- "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
- (primitiveIndex < 1 or: [primitiveIndex > 65535]) ifTrue:
- [self outOfRangeError: 'primitive index' index: primitiveIndex range: 1 to: 65535].
- stream
- nextPut: 139;
- nextPut: (primitiveIndex bitAnd: 255);
- nextPut: (primitiveIndex bitShift: -8)!
Item was removed:
- ----- Method: InstructionStream>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category '*Cog-method prototypes') -----
- InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
- | type offset2 byte2 byte3 byte4 |
- offset <= 6 ifTrue:
- ["Extended op codes 128-134"
- byte2 := method at: pc. pc := pc + 1.
- offset <= 2 ifTrue:
- ["128-130: extended pushes and pops"
- type := byte2 // 64.
- offset2 := byte2 \\ 64.
- offset = 0 ifTrue:
- [type = 0 ifTrue: [^client pushReceiverVariable: offset2].
- type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
- type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
- type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
- offset = 1 ifTrue:
- [type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
- type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
- type = 2 ifTrue: [self error: 'illegalStore'].
- type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
- offset = 2 ifTrue:
- [type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
- type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
- type = 2 ifTrue: [self error: 'illegalStore'].
- type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
- "131-134: extended sends"
- offset = 3 ifTrue: "Single extended send"
- [^client send: (method literalAt: byte2 \\ 32 + 1)
- super: false numArgs: byte2 // 32].
- offset = 4 ifTrue: "Double extended do-anything"
- [byte3 := method at: pc. pc := pc + 1.
- type := byte2 // 32.
- type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
- super: false numArgs: byte2 \\ 32].
- type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
- super: true numArgs: byte2 \\ 32].
- type = 2 ifTrue: [^client pushReceiverVariable: byte3].
- type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
- type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
- type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
- type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
- type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
- offset = 5 ifTrue: "Single extended send to super"
- [^client send: (method literalAt: byte2 \\ 32 + 1)
- super: true
- numArgs: byte2 // 32].
- offset = 6 ifTrue: "Second extended send"
- [^client send: (method literalAt: byte2 \\ 64 + 1)
- super: false
- numArgs: byte2 // 64]].
- offset = 7 ifTrue: [^client doPop].
- offset = 8 ifTrue: [^client doDup].
- offset = 9 ifTrue: [^client pushActiveContext].
- byte2 := method at: pc. pc := pc + 1.
- offset = 10 ifTrue:
- [^byte2 < 128
- ifTrue: [client pushNewArrayOfSize: byte2]
- ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
- byte3 := method at: pc. pc := pc + 1.
- offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
- offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
- offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
- offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
- "offset = 15"
- byte4 := method at: pc. pc := pc + 1.
- ^client
- pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
- numArgs: (byte2 bitAnd: 16rF)
- blockSize: (byte3 * 256) + byte4!
Item was removed:
- ----- Method: InstructionStream>>InstructionStreamPROTOTYPEnextPc: (in category '*Cog-method prototypes') -----
- InstructionStreamPROTOTYPEnextPc: currentByte
- "Answer the pc of the next bytecode following the current one, given the current bytecode.."
-
- ^pc + (self method encoderClass bytecodeSize: currentByte)!
Item was removed:
- ----- Method: InstructionStream>>InstructionStreamPROTOTYPEskipCallPrimitive (in category '*Cog-method prototypes') -----
- InstructionStreamPROTOTYPEskipCallPrimitive
- "If the receiver's method starts with a callPrimitive: bytecode, skip it."
- | method encoderClass callPrimitiveCode |
- method := self method.
- encoderClass := method encoderClass.
- callPrimitiveCode := encoderClass callPrimitiveCode.
- (method byteAt: pc) = callPrimitiveCode ifTrue:
- [pc := pc + (encoderClass bytecodeSize: callPrimitiveCode)]!
Item was removed:
- ----- Method: MCClassDefinition>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category '*Cog-method prototypes squeak 4.3') -----
- MCClassDefinitionPROTOTYPEkindOfSubclass
- type = #normal ifTrue: [^' subclass: '].
- type = #variable ifTrue: [^' variableSubclass: '].
- type = #bytes ifTrue: [^' variableByteSubclass: '].
- type = #compiledMethod ifTrue: [^' variableByteSubclass: ' ].
- type = #words ifTrue: [^' variableWordSubclass: '].
- type = #weak ifTrue: [^' weakSubclass: ' ].
- type = #ephemeron ifTrue: [^' ephemeronSubclass: ' ].
- type = #immediate ifTrue: [^' immediateSubclass: ' ].
- self error: 'Unrecognized class type'!
Item was removed:
- ----- Method: MCMethodDefinition>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category '*Cog-method prototypes squeak 4.3') -----
- MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString
- classIsMeta: metaBoolean
- selector: selectorString
- category: catString
- timeStamp: timeString
- source: sourceString
- className := classString asSymbol.
- selector := selectorString asSymbol.
- category := catString ifNil: [Categorizer default] ifNotNil: [catString asSymbol].
- timeStamp := timeString.
- classIsMeta := metaBoolean.
- source := sourceString withSqueakLineEndings!
Item was removed:
- ----- Method: MethodContext>>MethodContextPROTOTYPEfailPrimitiveWith: (in category '*Cog-method prototypes') -----
- MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
- bytecode and store the primitive fail code if there is one and the method consumes it."
- self skipCallPrimitive.
- ((self isPrimFailToken: maybePrimFailToken)
- and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
- [self at: stackp put: maybePrimFailToken last]!
Item was removed:
- ----- Method: MethodContext>>xray (in category '*Cog-Tests-xrays') -----
- xray
- "Lift the veil from a context and answer an integer describing its interior state.
- Used for e.g. VM tests so they can verify they're testing what they think they're testing.
- 0 implies a vanilla heap context.
- Bit 0 = is or was married to a frame
- Bit 1 = is still married to a frame
- Bit 2 = frame is executing machine code
- Bit 3 = has machine code pc (as opposed to nil or a bytecode pc)
- Bit 4 = method is currently compiled to machine code"
- <primitive: 213>
- ^0 "Can only fail if unimplemented; therefore simply answer 0"!
Item was removed:
- ----- Method: MethodContext>>xrayIsDivorced (in category '*Cog-Tests-xrays') -----
- xrayIsDivorced
- ^(self xray bitAnd: 3) = 1!
Item was removed:
- ----- Method: MethodContext>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') -----
- xrayIsExecutingMachineCode
- ^self xray anyMask: 4!
Item was removed:
- ----- Method: MethodContext>>xrayIsMarried (in category '*Cog-Tests-xrays') -----
- xrayIsMarried
- ^self xray anyMask: 2!
Item was removed:
- ----- Method: MethodContext>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') -----
- xrayLastExecutedMachineCode
- ^self xray anyMask: 8!
Item was removed:
- ----- Method: MethodContext>>xrayMethodIsCompiledToMachineCode (in category '*Cog-Tests-xrays') -----
- xrayMethodIsCompiledToMachineCode
- ^self xray anyMask: 16!
Item was removed:
- ----- Method: MethodNode>>MethodNodePROTOTYPEgenerate:using: (in category '*Cog-method prototypes') -----
- MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
- "The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
- The argument, trailer, is arbitrary but is typically either the reference to the source code
- that is stored with every CompiledMethod, or an encoding of the method's temporary names."
-
- | primErrNode blkSize nLits locals literals stack header method |
- self generate: trailer
- using: aCompiledMethodClass
- ifQuick:
- [:m |
- encoder noteBlockExtent: (0 to: 2) hasLocals: arguments.
- m literalAt: 2 put: encoder associationForClass;
- properties: properties.
- ^m].
- primErrNode := self primitiveErrorVariableName ifNotNil:
- [encoder fixTemp: self primitiveErrorVariableName].
- self ensureClosureAnalysisDone.
- encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:"
- blkSize := (block sizeCodeForEvaluatedValue: encoder)
- + (primitive > 0
- ifTrue: [encoder sizeCallPrimitive: primitive]
- ifFalse: [0])
- + (primErrNode
- ifNil: [0]
- ifNotNil:
- [primErrNode
- index: arguments size + temporaries size;
- sizeCodeForStore: encoder "The VM relies on storeIntoTemp: (129)"]).
- locals := arguments, temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]).
- encoder noteBlockExtent: block blockExtent hasLocals: locals.
- header := encoder computeMethodHeaderForNumArgs: arguments size
- numTemps: locals size
- numLits: (nLits := (literals := encoder allLiterals) size)
- primitive: primitive.
- method := trailer
- createMethod: blkSize
- class: aCompiledMethodClass
- header: header.
- 1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
- encoder streamToMethod: method.
- stack := ParseStack new init.
- primitive > 0 ifTrue:
- [encoder genCallPrimitive: primitive.
- primErrNode ifNotNil:
- [primErrNode emitCodeForStore: stack encoder: encoder]].
- stack position: method numTemps.
- [block emitCodeForEvaluatedValue: stack encoder: encoder]
- on: Error "If an attempt is made to write too much code the method will be asked"
- do: [:ex| "to grow, and the grow attempt will fail in CompiledMethod class>>#new:"
- ex signalerContext sender method = (CompiledMethod class>>#new:)
- ifTrue: [^self error: 'Compiler code size discrepancy']
- ifFalse: [ex pass]].
- stack position ~= (method numTemps + 1) ifTrue:
- [^self error: 'Compiler stack discrepancy'].
- encoder methodStreamPosition ~= (method size - trailer size) ifTrue:
- [^self error: 'Compiler code size discrepancy'].
- method needsFrameSize: stack size - method numTemps.
- method properties: properties.
- ^method!
Item was removed:
- ----- Method: MethodNode>>MethodNodePROTOTYPEgenerate:using:ifQuick: (in category '*Cog-method prototypes') -----
- MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass ifQuick: methodBlock
- | v |
- (primitive = 0 and: [arguments size = 0 and: [block isQuick]]) ifFalse:
- [^self].
- v := block code.
- v < 0 ifTrue:
- [^self].
- v = LdSelf ifTrue:
- [^methodBlock value: (aCompiledMethodClass toReturnSelfTrailerBytes: trailer)].
- (v between: LdTrue and: LdMinus1 + 3) ifTrue:
- [^methodBlock value: (aCompiledMethodClass toReturnConstant: v - LdSelf trailerBytes: trailer)].
- v < ((CodeBases at: LdInstType) + (CodeLimits at: LdInstType)) ifTrue:
- [^methodBlock value: (aCompiledMethodClass toReturnField: v trailerBytes: trailer)].
- v // 256 = 1 ifTrue:
- [^methodBlock value: (aCompiledMethodClass toReturnField: v \\ 256 trailerBytes: trailer)]!
Item was removed:
- ----- Method: MethodNode>>MethodNodePROTOTYPEprintPropertiesOn: (in category '*Cog-method prototypes') -----
- MethodNodePROTOTYPEprintPropertiesOn: aStream
- properties ifNil: [^self].
- properties propertyKeysAndValuesDo:
- [:prop :val|
- aStream crtab; nextPut: $<.
- prop = #on:in:
- ifTrue:
- [prop keywords with: val do:
- [:k :v | aStream nextPutAll: k; space; nextPutAll: v; space]]
- ifFalse:
- [prop = #on
- ifTrue: [aStream nextPutAll: prop; nextPutAll:': '; nextPutAll: val]
- ifFalse: [aStream nextPutAll: prop; nextPutAll:': '; print: val]].
- aStream nextPut: $>]!
Item was removed:
- SimulatorHarness subclass: #SpurBootstrap
- instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes installedMethodOops classMetaclass imageTypes classMethodContextIndex classBlockClosureIndex toBeInitialized'
- classVariableNames: 'ImageHeaderFlags ImageName ImageScreenSize TransformedImage'
- poolDictionaries: 'VMObjectIndices'
- category: 'Cog-Bootstrapping'!
-
- !SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0!
- SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format.
-
- e.g.
- (SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image')
- transform;
- launch
-
- Bootstrap issues:
- - should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time
- based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load.
- - should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)?
-
- Instance Variables
- classToIndex: <Dictionary>
- lastClassTablePage: <Integer>
- map: <Dictionary>
- methodClasses: <Set>
- newHeap: <SpurMemoryManager>
- oldHeap: <NewObjectMemory>
- oldInterpreter: <StackInterpreterSimulator>
- reverseMap: <Dictionary>
- symbolMap: <Dictionary>
-
- classToIndex
- - oldClass to new classIndex map
-
- lastClassTablePage
- - oop in newHeap of last classTable page. U<sed in validation to filter-out class table.
-
- methodClasses
- - cache of methodClassAssociations for classes in which modified methods are installed
-
- map
- - oldObject to newObject map
-
- newHeap
- - the output, bootstrapped image
-
- oldHeap
- - the input, image
-
- oldInterpreter
- - the interpreter associated with oldHeap, needed for a hack to grab WeakArray
-
- reverseMap
- - newObject to oldObject map
-
- symbolMap
- - symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap!
Item was removed:
- ----- Method: SpurBootstrap class>>bootstrapCuisImage: (in category 'utilities') -----
- bootstrapCuisImage: imageFileBaseName
- self bootstrapImage: imageFileBaseName type: #('squeak' 'cuis')!
Item was removed:
- ----- Method: SpurBootstrap class>>bootstrapImage:type: (in category 'utilities') -----
- bootstrapImage: imageFileNameOrBaseName type: typeName
- "SpurBootstrap bootstrapImage: '/Users/eliot/Squeak/Squeak4.5/Squeak4.5-13680'"
- | imageFileBaseName imageFormat |
- imageFileBaseName := (imageFileNameOrBaseName endsWith: '.image')
- ifTrue: [imageFileNameOrBaseName allButLast: 6]
- ifFalse: [imageFileNameOrBaseName].
- imageFormat := ImageFormat fromFile: imageFileBaseName, '.image'.
- imageFormat requiresClosureSupport ifFalse:
- [self error: 'Can''t bootstrap this image since Spur assumes closure support.'].
- imageFormat requiresSpurSupport ifTrue:
- [self error: 'This image is already in Spur format.'].
- imageFormat is32Bit ifTrue:
- [^SpurBootstrap32 new bootstrapImage: imageFileBaseName type: typeName].
- self error: '64-bit support and 64-bit generation as-yet-unimplemented'!
Item was removed:
- ----- Method: SpurBootstrap class>>bootstrapOldSqueakImage: (in category 'utilities') -----
- bootstrapOldSqueakImage: imageFileBaseName
- "Try asnd bootstrap a pre-CompiledMethodTrailer Squeak image."
- self bootstrapImage: imageFileBaseName type: #('squeak' 'old squeak')!
Item was removed:
- ----- Method: SpurBootstrap class>>bootstrapPharoImage: (in category 'utilities') -----
- bootstrapPharoImage: imageFileBaseName
- | oldCompilerClass oldBytecodeBackend |
-
- oldCompilerClass := SmalltalkImage compilerClass.
- oldBytecodeBackend := CompilationContext bytecodeBackend.
- [
- SmalltalkImage compilerClass: Compiler.
- CompilationContext bytecodeBackend: IRSpurSqueakV3PlusClosuresBytecodeGenerator.
- self bootstrapImage: imageFileBaseName type: 'pharo' ]
- ensure: [
- SmalltalkImage compilerClass: oldCompilerClass.
- CompilationContext bytecodeBackend: oldBytecodeBackend ]!
Item was removed:
- ----- Method: SpurBootstrap class>>bootstrapSqueakImage: (in category 'utilities') -----
- bootstrapSqueakImage: imageFileBaseName
- self bootstrapImage: imageFileBaseName type: 'squeak'!
Item was removed:
- ----- Method: SpurBootstrap class>>categoryForClass:meta:selector: (in category 'method prototype categorization') -----
- categoryForClass: className meta: isMeta selector: selector
- ^(isMeta
- ifTrue: [{ className. #class. selector }]
- ifFalse: [{ className. selector }])
- caseOf: {
- [#(Behavior allInstancesOrNil)] -> [#enumerating].
- [#(Behavior byteSizeOfInstance)] -> [#'accessing instances and variables'].
- [#(Behavior byteSizeOfInstanceOfSize:)] -> [#'accessing instances and variables'].
- [#(Behavior elementSize)] -> [#'accessing instances and variables'].
- [#(Behavior handleFailingBasicNew)] -> [#private].
- [#(Behavior handleFailingBasicNew:)] -> [#private].
- [#(Behavior handleFailingFailingBasicNew)] -> [#private].
- [#(Behavior handleFailingFailingBasicNew:)] -> [#private].
- [#(Behavior identityHash)] -> [#comparing].
- [#(Behavior isCompiledMethodClass)] -> [#testing].
- [#(Behavior isEphemeronClass)] -> [#testing].
- [#(Behavior isImmediateClass)] -> [#testing].
- [#(BoxedFloat64 class basicNew)] -> [#'instance creation'].
- [#(BoxedFloat64 class basicNew:)] -> [#'instance creation'].
- [#(Character identityHash)] -> [#comparing].
- [#(Character setValue:)] -> [#accessing].
- [#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
- -> [#'subclass creation'].
- [#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
- -> [#public].
- [#(CompiledMethod bytecodeSetName)] -> [#accessing].
- [#(CompiledMethod class handleFailingFailingNewMethod:header:)]
- -> [#private].
- [#(CompiledMethod class handleFailingNewMethod:header:)]
- -> [#private].
- [#(CompiledMethod class headerFlagForEncoder:)]
- -> [#'method encoding'].
- [#(CompiledMethod class installPrimaryBytecodeSet:)]
- -> [#'class initialization'].
- [#(CompiledMethod class installSecondaryBytecodeSet:)]
- -> [#'class initialization'].
- [#(Context class allInstances)] -> [#enumerating].
- [#(Context class allInstancesDo:)] -> [#enumerating].
- [#(Context failPrimitiveWith:)] -> [#'system simulation'].
- [#(Context isPrimFailToken:)] -> [#private].
- [#(Context send:to:with:lookupIn:)] -> [#controlling].
- [#(ContextPart isPrimFailToken:)] -> [#private].
- [#(ContextPart send:to:with:lookupIn:)] -> [#controlling].
- [#(EncoderForV3 computeMethodHeaderForNumArgs:numTemps:numLits:primitive:)]
- -> [#'method encoding'].
- [#(EncoderForV3PlusClosures genCallPrimitive:)]
- -> [#'bytecode generation'].
- [#(EncoderForV3PlusClosures class callPrimitiveCode)]
- -> [#'bytecode decoding'].
- [#(InstructionClient callPrimitive:)] -> [#'instruction decoding'].
- [#(MethodContext failPrimitiveWith:)] -> [#'system simulation'].
- [#(MethodContext class allInstances)] -> [#enumerating].
- [#(MethodContext class allInstancesDo:)] -> [#enumerating].
- [#(Object isPinned)] -> [#'system primitives'].
- [#(Object pin)] -> [#'system primitives'].
- [#(Object setPinned:)] -> [#'system primitives'].
- [#(Object unpin)] -> [#'system primitives'].
- [#(SmallFloat64 class basicNew)] -> [#'instance creation'].
- [#(SmallFloat64 class basicNew:)] -> [#'instance creation'].
- [#(SmallFloat64 clone)] -> [#copying].
- [#(SmallFloat64 copy)] -> [#copying].
- [#(SmallFloat64 deepCopy)] -> [#copying].
- [#(SmallFloat64 identityHash)] -> [#comparing].
- [#(SmallFloat64 shallowCopy)] -> [#copying].
- [#(SmallFloat64 veryDeepCopyWith:)] -> [#copying].
- [#(SmallInteger asCharacter)] -> [#converting].
- [#(SmalltalkImage growMemoryByAtLeast:)] -> [#'memory space'].
- [#(SmalltalkImage maxIdentityHash)] -> [#'system attributes'].
- [#(SystemDictionary growMemoryByAtLeast:)] -> [#'memory space'].
- [#(SystemDictionary maxIdentityHash)] -> [#'system attributes'].
- [#(SystemDictionary setGCParameters)] -> [#'snapshot and quit'].
- [#(SystemNavigation allObjects)] -> [#query].
- [#(SystemNavigation allObjectsOrNil)] -> [#query].
- }
- otherwise:
- [Transcript nextPutAll: className.
- isMeta ifTrue: [Transcript nextPutAll: ' class'].
- Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush.
- ^Categorizer default]!
Item was removed:
- ----- Method: SpurBootstrap class>>defaultIntegerBaseInDebugger (in category 'debugger') -----
- defaultIntegerBaseInDebugger
- ^16!
Item was removed:
- ----- Method: SpurBootstrap class>>isolatedPrototypes (in category 'utilities') -----
- isolatedPrototypes
- "SpurBootstrap isolatedPrototypes"
- | prototypes |
- prototypes := (self systemNavigation allMethodsSelect:
- [:m| m selector includesSubString: 'PROTOTYPE'])
- collect: [:mr| mr compiledMethod].
- ^prototypes select:
- [:m|
- (m methodClass includesBehavior: SpurBootstrapPrototypes)
- ifTrue:
- [(m pragmaAt: #indirect) notNil
- and: [prototypes noneSatisfy:
- [:p|
- p selector == m selector
- and: [p methodClass ~~ m methodClass]]]]
- ifFalse:
- [prototypes noneSatisfy:
- [:p|
- p selector == m selector
- and: [(p methodClass includesBehavior: SpurBootstrapPrototypes)
- and: [(p pragmaAt: #indirect) notNil]]]]]!
Item was removed:
- ----- Method: SpurBootstrap class>>testComputeFormat (in category 'tests') -----
- testComputeFormat
- "self testComputeFormat"
- #( (normal 0)
- (bytes 16)
- (words 12)
- (variable 2)
- (weak 4)
- (ephemeron 5)
- (immediate 7)
- (compiledMethod 24)) do:
- [:tuple|
- [:type :instSpec| | fmt |
- fmt := [self ClassBuilderPROTOTYPEcomputeFormat: type instSize: 0 forSuper: Object ccIndex: 0]
- on: MessageNotUnderstood
- do: [:ex|
- ex message selector ~~ #format:variable:words:pointers:weak: ifTrue:
- [ex pass].
- self perform: #ClassBuilderPROTOTYPEformat:variable:words:pointers:weak:
- withArguments: ex message arguments].
- self assert: (fmt >> 16 = instSpec
- or: [type = #compiledMethod and: [fmt = CompiledMethod format]]).
- ] valueWithArguments: tuple]!
Item was removed:
- ----- Method: SpurBootstrap>>addMissingClassVars: (in category 'bootstrap image') -----
- addMissingClassVars: classVars
- "Add any missing class vars given classVars, a Dictionary from nonMetaClass to binding.
- Initialize any classes that get inst vars added."
- | addClassVarNameSym bindingOfSym |
- classVars isEmpty ifTrue:
- [^self].
- addClassVarNameSym := self findSymbol: #addClassVarName:.
- addClassVarNameSym ifNil:
- [addClassVarNameSym := self findSymbol: #addClassVarNamed:].
- bindingOfSym := self findSymbol: #bindingOf:.
- classVars keysAndValuesDo:
- [:binding :class|
- Transcript cr; nextPutAll: 'ADDING CLASS VAR '; store: binding key; nextPutAll: ' TO '; print: class; flush.
- self interpreter: oldInterpreter
- object: (self oldClassOopFor: class)
- perform: addClassVarNameSym
- withArguments: {oldHeap stringForCString: binding key}.
- literalMap
- at: binding
- put: (self interpreter: oldInterpreter
- object: (self oldClassOopFor: class)
- perform: bindingOfSym
- withArguments: {self findSymbol: binding key})].
- toBeInitialized := classVars asSet!
Item was removed:
- ----- Method: SpurBootstrap>>addNewMethods (in category 'bootstrap methods') -----
- addNewMethods
- "Get the simulator to add any and all missing methods immediately."
- | cmaiaSym basSym |
- cmaiaSym := self findSymbol: #compiledMethodAt:ifAbsent:.
- basSym := self findSymbol: #basicAddSelector:withMethod:.
- basSym ifNil:
- [basSym := self findSymbol: #addSelectorSilently:withMethod:].
- self allPrototypeClassNamesDo:
- [:sym :symIsMeta|
- (self findClassNamed: (literalMap at: sym))
- ifNil: [Transcript
- cr;
- nextPutAll: 'not installing any methods for ';
- nextPutAll: sym;
- nextPutAll: '; class not found in image';
- flush.]
- ifNotNil:
- [:theClass| | class |
- class := symIsMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
- self prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method| | methodOrNil |
- (className = sym
- and: [symIsMeta = isMeta
- and: [(method pragmaAt: #remove) isNil]]) ifTrue:
- ["probe method dictionary of the class for each method, installing a dummy if not found."
- "Transcript cr; nextPutAll: 'checking for '; nextPutAll: selector; flush."
- methodOrNil := self interpreter: oldInterpreter
- object: class
- perform: cmaiaSym
- withArguments: {literalMap at: selector. oldHeap nilObject}.
- methodOrNil = oldHeap nilObject
- ifTrue: "no method. install the real thing now"
- [Transcript
- cr;
- nextPutAll: 'installing ';
- nextPutAll: className;
- nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
- store: selector;
- flush.
- self interpreter: oldInterpreter
- object: class
- perform: basSym
- withArguments: { literalMap at: selector.
- self installableMethodFor: method
- selector: selector
- className: className
- isMeta: isMeta}.
- installedPrototypes add: method selector]
- ifFalse: "existing method; collect the methodClassAssociation; its needed later"
- [methodClasses add: (oldInterpreter methodClassAssociationOf: methodOrNil)]]]]]!
Item was removed:
- ----- Method: SpurBootstrap>>allInstancesOf: (in category 'bootstrap methods') -----
- allInstancesOf: classOop
- | instances |
- instances := OrderedCollection new.
- oldHeap allObjectsDo:
- [:o|
- ((oldHeap isPointersNonImm: o)
- and: [(oldHeap fetchClassOf: o) = classOop]) ifTrue:
- [instances addLast: o]].
- ^instances!
Item was removed:
- ----- Method: SpurBootstrap>>allMethodPrototypes (in category 'method prototypes') -----
- allMethodPrototypes
- "Answer all prototype selectors, including those marked <remove>"
- ^(imageTypes
- inject: (IdentitySet withAll: SpurBootstrapPrototypes allMethodPrototypes)
- into: [:allPrototypes :type | | prototypes |
- prototypes := (SpurBootstrapPrototypes prototypeClassFor: type) allMethodPrototypes.
- allPrototypes
- removeAllSuchThat: [:existing| prototypes anySatisfy: [:new| existing selector == new selector]];
- addAll: (prototypes reject: [:prototype| (prototype pragmaAt: #ignore) notNil]);
- yourself])
- asArray sort: [:ma :mb| ma selector <= mb selector]!
Item was removed:
- ----- Method: SpurBootstrap>>allPrototypeClassNamesDo: (in category 'method prototypes') -----
- allPrototypeClassNamesDo: aBlock
- "self basicNew allPrototypeClassNames"
- | pairs |
- pairs := Set new.
- self prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method |
- pairs add: {className. isMeta}].
- pairs do: [:pair| aBlock value: pair first value: pair last]!
Item was removed:
- ----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') -----
- allPrototypeMethodSymbols
- "self basicNew allPrototypeMethodSymbols"
- | symbols |
- self assert: SpurBootstrap isolatedPrototypes isEmpty.
- symbols := Set new.
- self prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method | | adder |
- symbols
- add: className;
- add: selector.
- adder := [:lit|
- (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
- lit isArray ifTrue: [lit do: adder]].
- method literals do: adder].
- ^symbols!
Item was removed:
- ----- Method: SpurBootstrap>>allocateClassTable (in category 'bootstrap image') -----
- allocateClassTable
- "Allocate the root of the classTable plus enough pages to accomodate all classes in
- the classToIndex map. Don't fill in the entries yet; the classes have yet to be cloned."
- | tableRoot page maxSize numPages |
- tableRoot := newHeap
- allocateSlots: newHeap classTableRootSlots + newHeap hiddenRootSlots
- format: newHeap arrayFormat
- classIndex: newHeap arrayClassIndexPun.
- self assert: (newHeap numSlotsOf: tableRoot) = (newHeap classTableRootSlots + newHeap hiddenRootSlots).
- self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat.
- self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun.
- newHeap nilFieldsOf: tableRoot.
- "first page is strong"
- page := newHeap
- allocateSlots: newHeap classTablePageSize
- format: newHeap arrayFormat
- classIndex: newHeap arrayClassIndexPun.
- self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize.
- self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat.
- self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun.
- self assert: (newHeap objectAfter: tableRoot limit: newHeap freeStart) = page.
- lastClassTablePage := page.
- newHeap nilFieldsOf: page.
- newHeap storePointer: 0 ofObject: tableRoot withValue: page.
- newHeap setHiddenRootsObj: tableRoot.
- maxSize := classToIndex inject: 0 into: [:a :b| a max: b].
- numPages := (maxSize + newHeap classTableMinorIndexMask / newHeap classTablePageSize) truncated.
- 2 to: numPages do:
- [:i|
- page := newHeap
- allocateSlots: newHeap classTablePageSize
- format: newHeap arrayFormat
- classIndex: newHeap arrayClassIndexPun.
- self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize.
- self assert: (newHeap formatOf: page) = newHeap arrayFormat.
- self assert: (newHeap classIndexOf: page) = newHeap arrayClassIndexPun.
- newHeap fillObj: page numSlots: newHeap classTablePageSize with: newHeap nilObject.
- newHeap storePointer: i - 1 ofObject: tableRoot withValue: page.
- self assert: (newHeap objectAfter: (newHeap fetchPointer: i - 2 ofObject: tableRoot) limit: newHeap freeStart) = page.
- lastClassTablePage := page].
- "and once again to recompute numClassTablePages post building the class table."
- newHeap instVarNamed: 'numClassTablePages' put: nil.
- newHeap setHiddenRootsObj: tableRoot!
Item was removed:
- ----- Method: SpurBootstrap>>allocateFreeLists (in category 'bootstrap image') -----
- allocateFreeLists
- "Allocate the freeLists array."
- | freeListsOop |
- freeListsOop := newHeap
- allocateSlots: newHeap numFreeLists
- format: newHeap wordIndexableFormat
- classIndex: newHeap wordSizeClassIndexPun.
- self assert: (newHeap objectAfter: newHeap trueObject) = freeListsOop.
- 0 to: newHeap numFreeLists - 1 do:
- [:i|
- newHeap
- storePointerUnchecked: i
- ofObject: freeListsOop
- withValue: 0]!
Item was removed:
- ----- Method: SpurBootstrap>>bootstrapImage (in category 'bootstrap image') -----
- bootstrapImage
- oldHeap fullGC.
- self measureOldHeapPostGC.
- self initMaps.
- Transcript cr; nextPutAll: 'transforming image...'; flush.
- self cloneNilTrueAndFalse.
- self allocateFreeLists.
- self buildClassMap.
- self allocateClassTable.
- self cloneObjects.
- self fillInObjects.
- self fillInClassTable.
- newHeapSize := newHeap freeStart.
- newHeap initializePostBootstrap.
- self measureNewHeapPostInitPostBootstrap!
Item was removed:
- ----- Method: SpurBootstrap>>bootstrapImage: (in category 'public access') -----
- bootstrapImage: imageName
- (Smalltalk classNamed: #FileReference) ifNotNil:
- [^self bootstrapImageUsingFileReference: imageName].
- (Smalltalk classNamed: #FileDirectory) ifNotNil:
- [^self bootstrapImageUsingFileDirectory: imageName].
- self error: 'at a loss as to what file system support to use'!
Item was removed:
- ----- Method: SpurBootstrap>>bootstrapImage:type: (in category 'public access') -----
- bootstrapImage: imageName type: typeNameOrArrayOfTypeNames
- "type can be:
- - 'squeak'
- - {'old squeak' 'squeak' }
- - { 'cuis' 'squeak' }
- - 'pharo'
- - it might be 'newspeak', if needed (but is not implemented)"
- imageTypes := typeNameOrArrayOfTypeNames isArray
- ifTrue: [typeNameOrArrayOfTypeNames]
- ifFalse: [{typeNameOrArrayOfTypeNames}].
- self bootstrapImage: imageName
- !
Item was removed:
- ----- Method: SpurBootstrap>>bootstrapImageUsingFileDirectory: (in category 'public access') -----
- bootstrapImageUsingFileDirectory: imageName
- | dirName baseName dir |
- dirName := FileDirectory dirPathFor: imageName.
- baseName := (imageName endsWith: '.image')
- ifTrue: [FileDirectory baseNameFor: imageName]
- ifFalse: [FileDirectory localNameFor: imageName].
- dir := dirName isEmpty ifTrue: [FileDirectory default] ifFalse: [FileDirectory default on: dirName].
- self on: (dir fullNameFor: baseName, '.image').
- [self transform]
- on: Halt
- do: [:ex|
- "suppress halts from the usual suspects (development time halts)"
- (#(fullGC compactImage) includes: ex signalerContext sender selector)
- ifTrue: [ex resume]
- ifFalse: [ex pass]].
- self writeSnapshot: (dir fullNameFor: baseName, '-spur.image')
- ofTransformedImage: newHeap
- headerFlags: oldInterpreter getImageHeaderFlags
- screenSize: oldInterpreter savedWindowSize.
- dir deleteFileNamed: baseName, '-spur.changes';
- copyFileNamed: baseName, '.changes' toFileNamed: baseName, '-spur.changes'!
Item was removed:
- ----- Method: SpurBootstrap>>bootstrapImageUsingFileReference: (in category 'public access') -----
- bootstrapImageUsingFileReference: imageName
- | dirName baseName dir |
- dirName := imageName asFileReference parent fullName.
- baseName := (imageName endsWith: '.image')
- ifTrue: [ imageName asFileReference base ]
- ifFalse: [ (imageName, '.image') asFileReference base ].
- dir := dirName asFileReference.
- self on: (dir / (baseName, '.image')) fullName.
- [self transform]
- on: Halt
- do: [:ex|
- "suppress halts from the usual suspects (development time halts)"
- (#(fullGC compactImage) includes: ex signalerContext sender selector)
- ifTrue: [ex resume]
- ifFalse: [ex pass]].
- self writeSnapshot: (dir / (baseName, '-spur.image')) fullName
- ofTransformedImage: newHeap
- headerFlags: oldInterpreter getImageHeaderFlags
- screenSize: oldInterpreter savedWindowSize.
- (dir / (baseName, '.changes')) copyTo: (dir / (baseName, '-spur.changes'))!
Item was removed:
- ----- Method: SpurBootstrap>>buildClassMap (in category 'bootstrap image') -----
- buildClassMap
- "enumerate all objects asking isBehavior:? (class == Metaclass or class class == Metaclass) doesn't work for Newspeak"
- "Build a map from all classes in oldHeap to a class index.
- ONLY DEALS WITH CLASSES THAT HAVE INSTANCES!!!! (can walk superclass chain? Can walk subclasses set? Can ask class == Metaclass or class class == Metaclass class?)"
- | classes classTableIndex |
- self defineKnownClassIndices.
- classes := classToIndex keys asSet.
- classTableIndex := classToIndex inject: 0 into: [:a :b| a max: b].
- oldHeap allObjectsDo:
- [:oldObj| | oldClass |
- oldClass := oldHeap fetchClassOfNonImm: oldObj.
- self assert: (oldHeap isPointersNonImm: oldClass).
- (classes includes: oldClass) ifFalse:
- [classes add: oldClass.
- classToIndex at: oldClass put: (classTableIndex := classTableIndex + 1)]]!
Item was removed:
- ----- Method: SpurBootstrap>>checkReshapeOf: (in category 'bootstrap image') -----
- checkReshapeOf: ourMethodClasses
- "Check the shape of all our method classes match the shape of those in the image to be bootstrapped.
- Use the simulator to redefine any that need it. Does /not/ reshape metaclasses; these we assume are ok."
- | toReshape |
- toReshape := Set new.
- ourMethodClasses do:
- [:mc|
- (literalMap at: mc binding ifAbsent: []) ifNotNil:
- [:binding|
- (mc ~~ Character "Character will reshape anyway"
- and: [mc instSize ~= (oldHeap instanceSizeOf: (oldHeap fetchPointer: ValueIndex ofObject: binding))]) ifTrue:
- [toReshape add: mc]]].
- toReshape isEmpty ifTrue:
- [^self].
- self interpreter: oldInterpreter
- object: (self oldClassOopFor: ClassBuilder)
- perform: (self findSymbol: #beSilent:)
- withArguments: {oldHeap trueObject}.
- "Assume only one class in any subtree needs reshaping. Fast and loose but gets us there for now."
- toReshape copy do:
- [:class|
- toReshape removeAll: (toReshape select: [:ea| ea inheritsFrom: class])].
- toReshape do:
- [:class|
- Transcript cr; nextPutAll: 'RESHAPING '; print: class; flush.
- self interpreter: oldInterpreter
- object: (self oldClassOopFor: Compiler)
- perform: (self findSymbol: #evaluate:)
- withArguments: {oldHeap stringForCString: class definition}]!
Item was removed:
- ----- Method: SpurBootstrap>>classMetaclass (in category 'bootstrap image') -----
- classMetaclass
- ^classMetaclass ifNil:
- [classMetaclass := oldHeap fetchClassOfNonImm: (oldHeap fetchClassOfNonImm: oldHeap classArray)]!
Item was removed:
- ----- Method: SpurBootstrap>>classNameForPrototypeMethod: (in category 'method prototypes') -----
- classNameForPrototypeMethod: protoMethod
- | protoSelector |
- protoSelector := protoMethod selector.
- #('OLDSQUEAKPROTOTYPE' 'SQUEAKPROTOTYPE' 'PHAROPROTOTYPE' 'PROTOTYPE') do:
- [:prototype| | index |
- (index := protoSelector indexOfSubCollection: prototype) ~= 0 ifTrue:
- [^(protoSelector first: index - 1) asSymbol]].
- self error: 'really??'!
Item was removed:
- ----- Method: SpurBootstrap>>classTableSize (in category 'class indices') -----
- classTableSize
- ^newHeap classIndexMask + 1!
Item was removed:
- ----- Method: SpurBootstrap>>clone:classIndex: (in category 'bootstrap image') -----
- clone: oldObj classIndex: classIndex
- | newObj format numBytes |
- ((format := oldHeap formatOf: oldObj) >= oldHeap firstLongFormat
- and: [numBytes := oldHeap numBytesOf: oldObj.
- format >= oldHeap firstCompiledMethodFormat
- and: [(oldInterpreter primitiveIndexOf: oldObj) > 0]]) ifTrue:
- [numBytes := numBytes + 3].
- newObj := newHeap
- allocateSlots: (format >= oldHeap firstLongFormat
- ifTrue: [newHeap numSlotsForBytes: numBytes]
- ifFalse: [oldHeap numSlotsOf: oldObj])
- format: (self newFormatFor: oldObj numBytes: numBytes)
- classIndex: classIndex.
- reverseMap at: newObj put: oldObj.
- ^map at: oldObj put: newObj!
Item was removed:
- ----- Method: SpurBootstrap>>cloneArrayLiteral: (in category 'bootstrap methods') -----
- cloneArrayLiteral: anArray
- "Currently serves only to clone the #(0 0) literal in SpaceTallyPROTOTYPEspaceForInstancesOf:"
- | array |
- array := oldHeap instantiateClass: (oldHeap splObj: ClassArray) indexableSize: anArray size.
- 1 to: anArray size do:
- [:i| | lit |
- lit := anArray at: i.
- lit class caseOf: {
- [SmallInteger] -> [oldHeap
- storePointerUnchecked: i - 1
- ofObject: array
- withValue: (oldHeap integerObjectOf: lit)].
- [ByteSymbol] -> [oldHeap
- storePointer: i - 1
- ofObject: array
- withValue: (self findSymbol: lit)].
- [UndefinedObject] -> [oldHeap
- storePointerUnchecked: i - 1
- ofObject: array
- withValue: oldHeap nilObject] }].
- ^array
- !
Item was removed:
- ----- Method: SpurBootstrap>>cloneMethodProxy: (in category 'bootstrap methods') -----
- cloneMethodProxy: proxy "<VMCompiledMethodProxy>"
- | bytes newMethod delta |
- bytes := proxy size - proxy initialPC + 1.
- delta := proxy primitive > 0
- ifTrue: [3]
- ifFalse: [0].
- newMethod := CompiledMethod
- newMethod: bytes + delta
- header: (self headerForOldMethodHeader: (oldHeap integerObjectOf: proxy header)).
- 1 to: proxy numLiterals - 1 do:
- [:i| newMethod literalAt: i put: (proxy literalAt: i)].
- newMethod
- literalAt: proxy numLiterals
- put: (Smalltalk bindingOf: #Character).
- delta > 0 ifTrue:
- [newMethod
- at: newMethod initialPC + 0 put: 139;
- at: newMethod initialPC + 1 put: (proxy primitive bitAnd: 16rFF);
- at: newMethod initialPC + 2 put: (proxy primitive bitShift: -8)].
- proxy initialPC to: proxy size do:
- [:i| newMethod at: i + delta put: (proxy at: i)].
- ^newMethod!
Item was removed:
- ----- Method: SpurBootstrap>>cloneNilTrueAndFalse (in category 'bootstrap image') -----
- cloneNilTrueAndFalse
- { oldHeap nilObject.
- oldHeap falseObject.
- oldHeap trueObject. }
- with: (self firstOrdinaryClassIndex to: self firstOrdinaryClassIndex + 2)
- do: [:obj :classIndex|
- classToIndex at: (oldHeap fetchClassOfNonImm: obj) put: classIndex.
- self clone: obj classIndex: classIndex].
- newHeap
- nilObject: (map at: oldHeap nilObject); "needed for nilling objects etc"
- falseObject: (map at: oldHeap falseObject);
- trueObject: (map at: oldHeap trueObject)!
Item was removed:
- ----- Method: SpurBootstrap>>cloneObjects (in category 'bootstrap image') -----
- cloneObjects
- | specialObjectsArray characterClass characterTable compactClasses oldObj oldClass |
- specialObjectsArray := oldHeap specialObjectsOop.
- characterClass := oldHeap classCharacter.
- characterTable := oldHeap characterTable.
- compactClasses := oldHeap splObj: CompactClasses.
- self clone: specialObjectsArray
- classIndex: (classToIndex at: (oldHeap fetchClassOfNonImm: specialObjectsArray)).
- oldObj := oldHeap objectAfter: oldHeap trueObject.
- [oldObj < oldHeap freeStart] whileTrue:
- [oldClass := oldHeap fetchClassOfNonImm: oldObj.
- (oldObj ~= characterTable
- and: [oldObj ~= specialObjectsArray
- and: [oldObj ~= compactClasses
- and: [oldClass ~= characterClass]]]) ifTrue:
- [self clone: oldObj classIndex: (classToIndex at: oldClass)].
- oldObj := oldHeap objectAfter: oldObj].
- newHeap
- specialObjectsOop: (map at: oldHeap specialObjectsOop);
- lastHash: oldHeap lastHash!
Item was removed:
- ----- Method: SpurBootstrap>>coHeapFrom: (in category 'testing') -----
- coHeapFrom: aSpur32BitMMLESimulator
- | coHeap |
- coHeap := Spur32BitMMLECoSimulator new.
- aSpur32BitMMLESimulator class allInstVarNames do:
- [:ivn|
- coHeap instVarNamed: ivn put: (aSpur32BitMMLESimulator instVarNamed: ivn)].
- coHeap scavenger instVarNamed: 'manager' put: coHeap.
- ^coHeap!
Item was removed:
- ----- Method: SpurBootstrap>>compactImage (in category 'bootstrap image') -----
- compactImage
- | firstFree lastUsed |
- newHeap allHeapEntitiesDo:
- [:o|
- (newHeap isFreeObject: o)
- ifTrue: [firstFree ifNil: [firstFree := o]]
- ifFalse: [lastUsed := o]].
- lastUsed < firstFree ifTrue: "nothing to do"
- [^self].
- self halt!
Item was removed:
- ----- Method: SpurBootstrap>>convertOldMethodHeader: (in category 'bootstrap image') -----
- convertOldMethodHeader: methodHeader
- ^((oldInterpreter argumentCountOfMethodHeader: methodHeader) << 24)
- + ((oldInterpreter temporaryCountOfMethodHeader: methodHeader) << 18)
- + ((oldInterpreter methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [1 << 17] ifFalse: [0])
- + ((oldInterpreter methodHeaderHasPrimitive: methodHeader) ifTrue: [1 << 16] ifFalse: [0])
- + (oldHeap literalCountOfMethodHeader: methodHeader)!
Item was removed:
- ----- Method: SpurBootstrap>>defineKnownClassIndices (in category 'class indices') -----
- defineKnownClassIndices
- "The classTable is laid out
- - to make it easy to map immediates to classes; the tag pattern of an immediate is its class index.
- hence there are two entries for SmallInteger
- - to assign small indices to well-known classes such as Array, Message et al
- - to leave plenty of room for new known classes; hence the first page contains only well-known classes
- - to enable overlaps and avoid conflicts with indices in the specialObjectsArray (?really? eem)
- - to provide a WeakArray pun for the pages of the table itself so that these do not show up as instances of WeakArray"
- | classMethodContext classBlockClosure classMessage "no api method for these" |
- classMessage := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMessage) value.
- classMethodContext := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMethodContext) value.
- classBlockClosure := oldHeap splObj: (VMObjectIndices bindingOf: #ClassBlockClosure) value.
- "c.f. SpurMemoryManager class>>intializeCompactClassIndices".
- classToIndex keysDo:
- [:oldClass|
- self assert: (oldInterpreter addressCouldBeClassObj: oldClass)].
- classToIndex
- at: oldHeap classSmallInteger put: 1; "N.B. must fill-in index 3 manually"
- at: oldHeap classCharacter put: 2;
- "at: oldHeap classSmallInteger put: 3" "N.B. must fill-in index 3 manually"
- "leave room for up to 15 tagged classes"
- "leave room for up to 16 puns"
- at: oldHeap classLargeNegativeInteger put: 32;
- at: oldHeap classLargePositiveInteger put: 33;
- at: oldHeap classFloat put: 34;
-
- at: "oldHeap" classMessage put: 35;
- at: "oldHeap" classMethodContext put: (classMethodContextIndex := 36);
- at: "oldHeap" classBlockClosure put: (classBlockClosureIndex := 37);
-
- at: oldHeap classSemaphore put: 48;
- "at: oldHeap classMutex put: 49; see below"
-
- at: oldHeap classByteArray put: 50;
- at: oldHeap classArray put: 51;
- at: oldHeap classString put: 52;
- at: oldHeap classBitmap put: 53;
- at: oldHeap classPoint put: 54.
-
- {{oldHeap classMutex. 49}.
- {oldHeap classExternalAddress. 128}.
- {oldHeap classExternalData. 129}.
- {oldHeap classExternalFunction. 130}.
- {oldHeap classExternalLibrary. 131}.
- {oldHeap classExternalStructure. 132}.
- {oldHeap classAlien. 133}.
- {oldHeap classUnsafeAlien. 134}}
- do: [:pair|
- [:oop :index|
- oop ~= oldHeap nilObject ifTrue:
- [classToIndex at: oop put: index]] valueWithArguments: pair].
-
- classToIndex keysDo:
- [:oldClass|
- self assert: (oldInterpreter addressCouldBeClassObj: oldClass)]!
Item was removed:
- ----- Method: SpurBootstrap>>fileOutPrototypesFor: (in category 'public access') -----
- fileOutPrototypesFor: imageTypeOrArrayOfTypes
- "SpurBootstrap new fileOutPrototypesFor: 'squeak'"
- | internalStream |
- imageTypes := imageTypeOrArrayOfTypes isString
- ifTrue: [{imageTypeOrArrayOfTypes}]
- ifFalse: [imageTypeOrArrayOfTypes asArray].
- internalStream := WriteStream on: (String new: 1000).
- internalStream header; timeStamp.
- self prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method| | classNameString class category preamble source |
- class := Smalltalk classNamed: className.
- isMeta
- ifTrue: [class := class class. classNameString := className, ' class']
- ifFalse: [classNameString := className].
- (method pragmaAt: #remove)
- ifNil:
- [category := class ifNotNil: [class organization categoryOfElement: selector].
- (category notNil and: [category first = $*]) ifTrue:
- [category := nil].
- category ifNil:
- [category := self class categoryForClass: className meta: isMeta selector: selector].
- preamble := classNameString, ' methodsFor: ' , category asString printString, ' stamp: ''', method timeStamp, ''''.
- internalStream nextPut: $!!; nextChunkPut: preamble; cr.
- source := method getSourceFromFile asString.
- source := source copyFrom: (source indexOfSubCollection: 'PROTOTYPE') + 9 to: source size.
- (self selectorForPrototypeMethod: method) isBinary ifTrue:
- [source := (self selectorForPrototypeMethod: method), (source copyFrom: (source indexOf: Character space) to: source size)].
- internalStream nextChunkPut: source; space; nextPut: $!!; cr; cr]
- ifNotNil:
- [source := classNameString, ' removeSelector: ', selector storeString.
- internalStream nextChunkPut: source; cr; cr]].
- internalStream trailer.
-
- FileStream
- writeSourceCodeFrom: internalStream
- baseName: ('SpurBootstrapPrototypes-', (imageTypes fold: [:a :b| a, '-', b]) replaceAll: Character space with: $_)
- isSt: true
- useHtml: false!
Item was removed:
- ----- Method: SpurBootstrap>>fillInClassTable (in category 'bootstrap image') -----
- fillInClassTable
- | firstPage maxIndex |
- maxIndex := 0.
- classToIndex keysAndValuesDo:
- [:oldClass :index| | newClass page |
- maxIndex := maxIndex max: index.
- newClass := map at: oldClass.
- self assert: (newHeap isPointersNonImm: newClass).
- newHeap setHashBitsOf: newClass to: index.
- page := newHeap
- fetchPointer: index >> newHeap classTableMajorIndexShift
- ofObject: newHeap classTableRootObj.
- newHeap
- storePointer: (index bitAnd: newHeap classTableMinorIndexMask)
- ofObject: page
- withValue: newClass.
- self assert: (newHeap classAtIndex: index) = newClass].
- firstPage := newHeap
- fetchPointer: 0
- ofObject: newHeap classTableRootObj.
- newHeap
- storePointer: 1
- ofObject: firstPage
- withValue: (map at: oldHeap classSmallInteger);
- storePointer: 2
- ofObject: firstPage
- withValue: (map at: oldHeap classCharacter);
- storePointer: 3
- ofObject: firstPage
- withValue: (map at: oldHeap classSmallInteger);
- storePointer: newHeap arrayClassIndexPun
- ofObject: firstPage
- withValue: (map at: oldHeap classArray);
- storePointer: newHeap arrayClassIndexPun
- ofObject: firstPage
- withValue: (map at: oldHeap classArray).
-
- newHeap classTableIndex: maxIndex!
Item was removed:
- ----- Method: SpurBootstrap>>fillInCompiledMethod:from: (in category 'bootstrap image') -----
- fillInCompiledMethod: newObj from: oldObj
- | firstByteIndex primIndex |
- self fillInPointerObject: newObj from: oldObj.
- "Now convert the CompiledMethod's format. First write the header in the new format"
- newHeap
- storePointerUnchecked: 0
- ofObject: newObj
- withValue: (newHeap integerObjectOf: (self convertOldMethodHeader: (oldHeap fetchPointer: 0 ofObject: oldObj))).
- "Then if necessary prepend the callPrimitive: bytecode"
- (primIndex := oldInterpreter primitiveIndexOf: oldObj) > 0
- ifTrue:
- [firstByteIndex := oldHeap lastPointerOf: oldObj.
- newHeap
- storeByte: firstByteIndex + 0 ofObject: newObj withValue: 139;
- storeByte: firstByteIndex + 1 ofObject: newObj withValue: (primIndex bitAnd: 255);
- storeByte: firstByteIndex + 2 ofObject: newObj withValue: (primIndex bitShift: -8).
- firstByteIndex to: (oldHeap numBytesOfBytes: oldObj) - 1 do:
- [:i|
- newHeap storeByte: i + 3 ofObject: newObj withValue: (oldHeap fetchByte: i ofObject: oldObj)]]
- ifFalse:
- [(oldHeap lastPointerOf: oldObj) / oldHeap wordSize to: (oldHeap numSlotsOf: oldObj) - 1 do:
- [:i|
- newHeap storeLong32: i ofObject: newObj withValue: (oldHeap fetchLong32: i ofObject: oldObj)]]!
Item was removed:
- ----- Method: SpurBootstrap>>fillInObjects (in category 'bootstrap image') -----
- fillInObjects
- oldHeap allObjectsDo:
- [:oldObj|
- (map at: oldObj ifAbsent: nil) ifNotNil:
- [:newObj| | format classIndex |
- format := newHeap formatOf: newObj.
- (newHeap isPointersFormat: format)
- ifTrue:
- [((newHeap isIndexableFormat: format)
- and: [(classIndex := newHeap classIndexOf: newObj) <= classBlockClosureIndex
- and: [classIndex >= classMethodContextIndex]])
- ifTrue: [self fillInPointerObjectWithPC: newObj from: oldObj]
- ifFalse: [self fillInPointerObject: newObj from: oldObj]]
- ifFalse:
- [(newHeap isCompiledMethodFormat: format)
- ifTrue: [self fillInCompiledMethod: newObj from: oldObj]
- ifFalse: [self fillInBitsObject: newObj from: oldObj]]]]!
Item was removed:
- ----- Method: SpurBootstrap>>fillInPointerObject:from: (in category 'bootstrap image') -----
- fillInPointerObject: newObj from: oldObj
- "Fill-in a newObj with appropriately mapped contents from oldObj.
- Filter-out the character table and the compact classes array.
- Map character objects to immediate characters."
- 0 to: (oldHeap lastPointerOf: oldObj) / oldHeap wordSize - 1 do:
- [:i| | oldValue newValue |
- oldValue := oldHeap fetchPointer: i ofObject: oldObj.
- newValue := (oldHeap isIntegerObject: oldValue)
- ifTrue: [oldValue]
- ifFalse:
- [map at: oldValue ifAbsent:
- [(oldValue = oldHeap characterTable
- or: [oldValue = (oldHeap splObj: CompactClasses)])
- ifTrue: [newHeap nilObject]
- ifFalse:
- [self assert: (oldHeap fetchClassOfNonImm: oldValue) = oldHeap classCharacter.
- newHeap characterObjectOf:
- (oldHeap integerValueOf:
- (oldHeap fetchPointer: CharacterValueIndex ofObject: oldValue))]]].
- newHeap
- storePointerUnchecked: i
- ofObject: newObj
- withValue: newValue].
- (self isOldObjABehavior: oldObj) ifTrue:
- [self mapOldBehavior: oldObj toNewBehavior: newObj]!
Item was removed:
- ----- Method: SpurBootstrap>>fillInPointerObjectWithPC:from: (in category 'bootstrap image') -----
- fillInPointerObjectWithPC: newObj from: oldObj
- "Fill-in a newObj with appropriately mapped contents from oldObj.
- If the object has a pc and its method has a primitive, increment the
- pc by the size of the callPrimitive: bytecode."
- | method |
- self fillInPointerObject: newObj from: oldObj.
- (newHeap classIndexOf: newObj) = classBlockClosureIndex ifTrue:
- [method := oldHeap
- fetchPointer: MethodIndex
- ofObject: (oldHeap
- fetchPointer: ClosureOuterContextIndex
- ofObject: oldObj).
- (oldInterpreter primitiveIndexOf: method) > 0 ifTrue:
- [self incrementPCField: ClosureStartPCIndex ofObject: newObj by: 3]].
- (newHeap classIndexOf: newObj) = classMethodContextIndex ifTrue:
- [method := oldHeap
- fetchPointer: MethodIndex
- ofObject: oldObj.
- (method ~= oldHeap nilObject
- and: [(oldInterpreter primitiveIndexOf: method) > 0]) ifTrue:
- [self incrementPCField: InstructionPointerIndex ofObject: newObj by: 3]].!
Item was removed:
- ----- Method: SpurBootstrap>>findClassNamed: (in category 'bootstrap methods') -----
- findClassNamed: symbolOop
- oldHeap allObjectsDo:
- [:o|
- ((oldHeap isPointersNonImm: o)
- and: [(oldInterpreter addressCouldBeClassObj: o)
- and: [(oldHeap fetchPointer: oldInterpreter classNameIndex ofObject: o) = symbolOop]]) ifTrue:
- [^o]].
- ^nil!
Item was removed:
- ----- Method: SpurBootstrap>>findLiteral:inClass: (in category 'bootstrap methods') -----
- findLiteral: aLiteral inClass: classOop
- | bindingOrNil |
- aLiteral isString ifTrue:
- [^self stringFor: aLiteral].
- aLiteral isFloat ifTrue:
- [^oldHeap floatObjectOf: aLiteral].
- aLiteral isArray ifTrue:
- [^self cloneArrayLiteral: aLiteral].
- aLiteral isCharacter ifTrue:
- [^oldHeap characterObjectOf: aLiteral asciiValue].
- self assert: aLiteral isVariableBinding.
- bindingOrNil := self interpreter: oldInterpreter
- object: classOop
- perform: (self findSymbol: #bindingOf:)
- withArguments: {self findSymbol: aLiteral key}.
- bindingOrNil ~= oldHeap nilObject ifTrue:
- [^bindingOrNil].
- self error: 'couldn''t find literal ', aLiteral printString!
Item was removed:
- ----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
- findRequiredGlobals
- "Look for the necessary gobal bindings in the prototype methods in the old image.
- This has to be done early by sending bindingOf: to Smalltalk. Collect the class
- hierarchy of all prototypes that access inst vars (non-local prototypes) to check
- their shapes. Also find out Metaclass, needed for identifying classes."
- | globals ourMethodClasses classVars bindingOfSym |
- globals := Set new.
- ourMethodClasses := Set new.
- classVars := Dictionary new.
- self prototypeClassNameMetaSelectorMethodDo:
- [:c :m :s :method| | allNonMetaSupers |
- (Smalltalk classNamed: c) ifNotNil:
- [:nonMetaClass|
- allNonMetaSupers := nonMetaClass withAllSuperclasses.
- (method methodClass includesBehavior: SpurBootstrapPrototypes) ifFalse:
- [ourMethodClasses addAll: allNonMetaSupers.
- globals addAll: (allNonMetaSupers collect: [:sc| sc binding])].
- method literals do:
- [:l|
- (l isVariableBinding
- and: [l key isSymbol
- and: [SpurBootstrapPrototypes withAllSubclasses noneSatisfy: [:sbpc| sbpc name == l key]]]) ifTrue:
- [((Smalltalk bindingOf: l key) == l
- or: [(Undeclared bindingOf: l key) == l])
- ifTrue: [globals add: l]
- ifFalse:
- [self assert: (nonMetaClass bindingOf: l key) == l.
- classVars at: l put: nonMetaClass]]]]].
- globals add: Compiler binding. "For potential reshaping in checkReshapeOf:"
- bindingOfSym := self findSymbol: #bindingOf:.
- self withExecutableInterpreter: oldInterpreter
- do: [| toBeAdded |
- globals do:
- [:global| | bindingOop |
- (self findSymbol: global key) ifNotNil:
- [:symbolOop|
- bindingOop := self interpreter: oldInterpreter
- object: (oldHeap splObj: 8) "Smalltalk"
- perform: bindingOfSym
- withArguments: {self findSymbol: global key}.
- bindingOop ~= oldHeap nilObject ifTrue:
- [literalMap at: global put: bindingOop]]].
- toBeAdded := Dictionary new.
- classVars keysAndValuesDo:
- [:var :class| | val |
- (self findSymbol: var key) "New class inst vars may not yet be interned."
- ifNil: [toBeAdded at: var put: class]
- ifNotNil:
- [:varName|
- val := self interpreter: oldInterpreter
- object: (self oldClassOopFor: class)
- perform: bindingOfSym
- withArguments: {varName}.
- val ~= oldHeap nilObject
- ifTrue: [literalMap at: var put: val]
- ifFalse: [toBeAdded at: var put: class]]].
- "May have to redefine to add missing inst vars and/or add any missing class vars."
- self checkReshapeOf: ourMethodClasses.
- self addMissingClassVars: toBeAdded]!
Item was removed:
- ----- Method: SpurBootstrap>>findSymbol: (in category 'bootstrap methods') -----
- findSymbol: aString
- "Find the Symbol equal to aString in oldHeap."
- | symbolClass |
- (literalMap at: aString ifAbsent: nil) ifNotNil:
- [:oop| ^oop].
- symbolClass := self symbolClass.
- oldHeap allObjectsDo:
- [:obj|
- (symbolClass = (oldHeap fetchClassOfNonImm: obj)
- and: [(oldHeap numBytesOf: obj) = aString size
- and: [aString = (oldHeap stringOf: obj)]]) ifTrue:
- [aString isSymbol ifTrue:
- [literalMap at: aString asSymbol put: obj].
- ^obj]].
- Transcript cr; nextPutAll: 'Warning, could not find '; store: aString; flush.
- ^nil!
Item was removed:
- ----- Method: SpurBootstrap>>firstOrdinaryClassIndex (in category 'class indices') -----
- firstOrdinaryClassIndex
- ^newHeap classTablePageSize!
Item was removed:
- ----- Method: SpurBootstrap>>followForwardingPointers (in category 'bootstrap image') -----
- followForwardingPointers
- newHeap allObjectsDo:
- [:o|
- (newHeap isForwarded: o) ifFalse:
- [0 to: (newHeap numPointerSlotsOf: o) - 1 do:
- [:i| | field |
- field := newHeap fetchPointer: i ofObject: o.
- (newHeap isOopForwarded: field) ifTrue:
- [newHeap
- storePointer: i
- ofObject: o
- withValue: (newHeap followForwarded: field)]]]]!
Item was removed:
- ----- Method: SpurBootstrap>>freeForwarders (in category 'bootstrap image') -----
- freeForwarders
- "Check that all forwarders have been followed. Then free them."
- | numForwarders numFreed |
- numForwarders := numFreed := 0.
- newHeap allObjectsDo:
- [:o|
- (newHeap isForwarded: o)
- ifTrue: [numForwarders := numForwarders + 1]
- ifFalse:
- [0 to: (newHeap numPointerSlotsOf: o) - 1 do:
- [:i|
- self assert: (newHeap isOopForwarded: (newHeap fetchPointer: i ofObject: o)) not]]].
- Transcript ensureCr; nextPutAll: 'freeing '; print: numForwarders; nextPutAll: ' forwarders'; cr; flush.
- newHeap allObjectsDo:
- [:o|
- (newHeap isForwarded: o) ifTrue:
- [numFreed := numFreed + 1.
- newHeap freeObject: o]].
- self assert: numFreed = numForwarders!
Item was removed:
- ----- Method: SpurBootstrap>>headerForOldMethodHeader: (in category 'bootstrap image') -----
- headerForOldMethodHeader: methodHeaderOop
- ^self isOnSpur
- ifTrue: [self convertOldMethodHeader: methodHeaderOop]
- ifFalse: [oldHeap integerValueOf: methodHeaderOop]!
Item was removed:
- ----- Method: SpurBootstrap>>imageTypes: (in category 'bootstrap image') -----
- imageTypes: anArray
- imageTypes := anArray!
Item was removed:
- ----- Method: SpurBootstrap>>incrementPCField:ofObject:by: (in category 'bootstrap image') -----
- incrementPCField: fieldIndex ofObject: newObj by: n
- | value |
- value := newHeap fetchPointer: fieldIndex ofObject: newObj.
- (newHeap isIntegerObject: value)
- ifTrue:
- [newHeap
- storePointerUnchecked: fieldIndex
- ofObject: newObj
- withValue: (newHeap integerObjectOf: n + (newHeap integerValueOf: value))]
- ifFalse:
- [self assert: value = newHeap nilObject]!
Item was removed:
- ----- Method: SpurBootstrap>>indexOfSelector:in: (in category 'bootstrap methods') -----
- indexOfSelector: selectorOop in: methodDict
- SelectorStart to: (oldHeap numSlotsOf: methodDict) - 1 do:
- [:i|
- (oldHeap fetchPointer: i ofObject: methodDict) = selectorOop ifTrue:
- [^i]].
- self error: 'could not find selector in method dict'!
Item was removed:
- ----- Method: SpurBootstrap>>initMaps (in category 'initialize-release') -----
- initMaps
- map := Dictionary new: oldHeap memory size // 4.
- reverseMap := Dictionary new: oldHeap memory size // 4.
- classToIndex := Dictionary new: 1024.
- literalMap := IdentityDictionary new.
- methodClasses := Set new.
- installedPrototypes := Set new.
- installedMethodOops := Set new.
- classMetaclass := nil!
Item was removed:
- ----- Method: SpurBootstrap>>initialize (in category 'initialize-release') -----
- initialize
- super initialize.
- imageTypes := {'squeak'}. "By default, image is Squeak (so Eliot does not kick me :P)"!
Item was removed:
- ----- Method: SpurBootstrap>>initializeClasses (in category 'bootstrap image') -----
- initializeClasses
- toBeInitialized ifNil: [^self].
- self withExecutableInterpreter: oldInterpreter
- do: [toBeInitialized do:
- [:class|
- self interpreter: oldInterpreter
- object: (self oldClassOopFor: class)
- perform: (self findSymbol: #initialize)
- withArguments: #()]]!
Item was removed:
- ----- Method: SpurBootstrap>>installModifiedMethods (in category 'bootstrap methods') -----
- installModifiedMethods
- "Install all the methods in the class-side method prototypes protocol in the relevant classes
- in the new image. First use the simulator to get the image to intern all symbols and add
- dummy methods under new selectors. With that done we can manually replace the relevant
- methods with the prototypes, mapping selectors and global variables as required."
- self withExecutableInterpreter: oldInterpreter
- do: [self internAllSymbols.
- self addNewMethods.
- self removeMethods.
- self replaceMethods.
- self modifyCharacterMethods]!
Item was removed:
- ----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') -----
- installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta
- "Create a sourceless method to install in the bootstrapped image. It will allow the
- bootstrap to limp along until the relevant transformed Monticello package is loaded."
- | compiledMethodClass methodClassBinding methodClass sourcelessMethod bytes newMethod delta initialPC |
- compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod).
- methodClassBinding := self methodClassBindingForClassName: className isMeta: isMeta.
- methodClass := oldHeap fetchPointer: ValueIndex ofObject: methodClassBinding.
- "the prototypes have source pointers. the Character methods to be replaced don't."
- sourcelessMethod := aCompiledMethod trailer hasSourcePointer
- ifTrue: [aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode]
- ifFalse: [aCompiledMethod].
- initialPC := sourcelessMethod initialPC.
- bytes := sourcelessMethod size - initialPC + 1.
- "Ugh, this is complicated. We could be running on Spur with the new method format
- or on non-Spur with the old format. Make both work."
- delta := (sourcelessMethod primitive > 0
- and: [(sourcelessMethod at: initialPC) = sourcelessMethod encoderClass callPrimitiveCode])
- ifTrue: [3]
- ifFalse: [0].
- newMethod := self
- interpreter: oldInterpreter
- object: compiledMethodClass
- perform: (self findSymbol: #newMethod:header:)
- withArguments: { oldHeap integerObjectOf: bytes - delta.
- oldHeap integerObjectOf: (self oldFormatHeaderFor: sourcelessMethod) }.
- 1 to: sourcelessMethod numLiterals - 2 do:
- [:i| | literal oop |
- literal := sourcelessMethod literalAt: i.
- oop := (literal isLiteral or: [literal isVariableBinding])
- ifTrue:
- [literal isInteger
- ifTrue: [oldInterpreter signed64BitIntegerFor: literal]
- ifFalse: [literalMap
- at: literal
- ifAbsent: [self findLiteral: literal
- inClass: methodClass]]]
- ifFalse: "should be a VMObjectProxy"
- [literal oop].
- oldHeap storePointer: i ofObject: newMethod withValue: oop].
- oldHeap
- storePointer: sourcelessMethod numLiterals - 1
- ofObject: newMethod
- withValue: (selector isSymbol
- ifTrue: [self findSymbol: selector]
- ifFalse: [selector oop]);
- storePointer: sourcelessMethod numLiterals
- ofObject: newMethod
- withValue: methodClassBinding.
- initialPC to: sourcelessMethod size - delta do:
- [:i|
- oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i + delta)].
- installedMethodOops add: newMethod.
- ^newMethod!
Item was removed:
- ----- Method: SpurBootstrap>>internAllSymbols (in category 'bootstrap methods') -----
- internAllSymbols
- "Ensure that all symbols in the method prototypes are interned so that later we can install them.
- Enter them into the map, this system's symbol -> oldHeap's version.
- Do this by interpreting Symbol intern: 'aSymbol' for each symbol."
- | internSym all symbolClass |
- internSym := self findSymbol: #intern:.
- symbolClass := self symbolClass.
- all := self allPrototypeMethodSymbols.
- oldHeap allObjectsDo:
- [:objOop| | sz |
- symbolClass = (oldHeap fetchClassOfNonImm: objOop) ifTrue:
- [sz := oldHeap numBytesOf: objOop.
- (all detect: [:sym| sym size = sz and: [sym = (oldHeap stringOf: objOop)]]
- ifNone: nil) ifNotNil:
- [:sym|
- literalMap at: sym put: objOop.
- all remove: sym]]].
- all do: [:sym|
- (self findSymbol: sym)
- ifNotNil: [:imageSym| literalMap at: sym put: imageSym]
- ifNil:[Transcript cr; nextPutAll: 'interning '; nextPutAll: sym; flush.
- "Interpret Symbol intern: sym to ... intern it :-)"
- literalMap
- at: sym
- put: (self interpreter: oldInterpreter
- object: self symbolClass
- perform: internSym
- withArguments: {self stringFor: sym})]].
- literalMap keysAndValuesDo:
- [:symOrGlobal :imageSymOrGlobal|
- symOrGlobal isSymbol ifTrue:
- [self assert: symOrGlobal = (oldHeap stringOf: imageSymOrGlobal)]]!
Item was removed:
- ----- Method: SpurBootstrap>>isOldObjABehavior: (in category 'bootstrap image') -----
- isOldObjABehavior: oldObj
- | oldObjClass |
- ^(classToIndex includesKey: oldObj)
- or: [(oldObjClass := oldHeap fetchClassOfNonImm: oldObj) = self classMetaclass
- or: [(oldHeap fetchClassOfNonImm: oldObjClass) = classMetaclass]]!
Item was removed:
- ----- Method: SpurBootstrap>>isOnSpur (in category 'testing') -----
- isOnSpur
- ^$c class instSize = 0!
Item was removed:
- ----- Method: SpurBootstrap>>launch (in category 'testing') -----
- launch
- self launch: newHeap
- simulatorClass: StackInterpreterSimulator
- headerFlags: oldInterpreter getImageHeaderFlags!
Item was removed:
- ----- Method: SpurBootstrap>>launch:simulatorClass:headerFlags: (in category 'testing') -----
- launch: heap simulatorClass: simulatorClass headerFlags: headerFlags
- | sim methodCacheSize |
- sim := simulatorClass onObjectMemory: heap.
- heap coInterpreter: sim.
- (sim class allInstVarNames includes: 'cogCodeSize')
- ifTrue:
- [sim initializeInterpreter: 0.
- methodCacheSize := sim methodCache size * heap wordSize.
- sim instVarNamed: 'heapBase' put: heap startOfMemory;
- instVarNamed: 'numStackPages' put: 8;
- instVarNamed: 'cogCodeSize' put: 1024*1024;
- moveMethodCacheToMemoryAt: sim cogCodeSize + sim computeStackZoneSize;
- movePrimTraceLogToMemoryAt: sim cogCodeSize + sim computeStackZoneSize + methodCacheSize;
- "sendTrace: 1+ 2 + 8 + 16;"
- initializeCodeGenerator]
- ifFalse:
- [sim initializeInterpreter: 0].
- heap
- initializeNewSpaceVariables;
- bootstrapping: false;
- assimilateNewSegment: (heap segmentManager segments at: 0).
- sim
- setImageHeaderFlagsFrom: headerFlags;
- imageName: ImageName;
- flushExternalPrimitives;
- openAsMorph;
- transcript: Transcript. "deep copy copies this"
- "sim
- instVarNamed: 'printSends' put: true;
- instVarNamed: 'printReturns' put: true;
- instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal." "for now"
- heap
- setCheckForLeaks: 0;
- runLeakCheckerForFullGC.
-
- sim halt; run!
Item was removed:
- ----- Method: SpurBootstrap>>launchSaved (in category 'testing') -----
- launchSaved
- self launch: TransformedImage veryDeepCopy
- simulatorClass: StackInterpreterSimulator
- headerFlags: ImageHeaderFlags!
Item was removed:
- ----- Method: SpurBootstrap>>launchSavedWithJIT (in category 'testing') -----
- launchSavedWithJIT
- self launch: (self coHeapFrom: TransformedImage veryDeepCopy)
- simulatorClass: CogVMSimulator
- headerFlags: ImageHeaderFlags!
Item was removed:
- ----- Method: SpurBootstrap>>mapOldBehavior:toNewBehavior: (in category 'bootstrap image') -----
- mapOldBehavior: oldObj toNewBehavior: newObj
- "Map the old format inst var's value to the new value.
- In addition, for Character, make it immediate and remove its instance variable."
- newHeap
- storePointerUnchecked: InstanceSpecificationIndex
- ofObject: newObj
- withValue: (self newClassFormatFor: oldObj).
- oldObj = oldHeap classCharacter ifTrue:
- [InstanceSpecificationIndex + 1 to: (oldHeap numSlotsOf: oldObj) do:
- [:i| | var field |
- var := oldHeap fetchPointer: i ofObject: oldObj.
- ((oldHeap fetchClassOf: var) = oldHeap classArray
- and: [(oldHeap numSlotsOf: var) = 1
- and: [field := oldHeap fetchPointer: 0 ofObject: var.
- (oldHeap fetchClassOf: field) = oldHeap classString
- and: [(oldHeap lengthOf: field) = 5
- and: [(oldHeap str: 'value' n: (oldHeap firstIndexableField: field) cmp: 5) = 0]]]]) ifTrue:
- [newHeap
- storePointerUnchecked: i
- ofObject: newObj
- withValue: newHeap nilObject.
- ^self]]]!
Item was removed:
- ----- Method: SpurBootstrap>>measureNewHeapPostInitPostBootstrap (in category 'stats') -----
- measureNewHeapPostInitPostBootstrap
- | savedEndOfMemory |
- "need to hack around the fact that newHeap isn't all there yet.
- In particular, it has no freeList so can't free space from
- freeOldSpaceStart to endOfMemory to make oldSpace enumerable."
- newHeapNumObjs := 0.
- savedEndOfMemory := newHeap endOfMemory.
- newHeap setEndOfMemory: newHeap freeOldSpaceStart.
- newHeap allObjectsDo: [:o| newHeapNumObjs := newHeapNumObjs + 1].
- newHeap setEndOfMemory: savedEndOfMemory!
Item was removed:
- ----- Method: SpurBootstrap>>measureOldHeapPostGC (in category 'stats') -----
- measureOldHeapPostGC
- oldHeapSize := oldHeap freeStart.
- oldHeapNumObjs := 0.
- oldHeap allObjectsDo: [:o| oldHeapNumObjs := oldHeapNumObjs + 1]!
Item was removed:
- ----- Method: SpurBootstrap>>methodClassBindingForClassName:isMeta: (in category 'bootstrap methods') -----
- methodClassBindingForClassName: classNameSymbol isMeta: isMeta
- | class |
- class := self findClassNamed: (literalMap at: classNameSymbol).
- isMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
- ^self interpreter: oldInterpreter
- object: class
- perform: (self findSymbol: #binding)
- withArguments: #()!
Item was removed:
- ----- Method: SpurBootstrap>>modifyCharacterMethods (in category 'bootstrap methods') -----
- modifyCharacterMethods
- | cc md mda |
- cc := oldHeap classCharacter.
- md := oldHeap fetchPointer: MethodDictionaryIndex ofObject: cc.
- mda := oldHeap fetchPointer: MethodArrayIndex ofObject: md..
- 0 to: (oldHeap numSlotsOf: mda) - 1 do:
- [:i| | method |
- method := oldHeap fetchPointer: i ofObject: mda.
- method ~= oldHeap nilObject ifTrue:
- [(self replacementForCharacterMethod: method) ifNotNil:
- [:replacement|
- Transcript
- cr;
- nextPutAll: 'replacing Character>>#';
- nextPutAll: (oldHeap stringOf: (oldHeap fetchPointer: i + SelectorStart ofObject: md));
- flush.
- oldHeap
- storePointer: i
- ofObject: mda
- withValue: replacement]]]!
Item was removed:
- ----- Method: SpurBootstrap>>newClassFormatFor: (in category 'bootstrap image') -----
- newClassFormatFor: oldClassObj
- "OLD: <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0>
- NEW: <5 bits inst spec><16 bits inst size>"
- | oldFormat instSize newInstSpec |
- ((oldInterpreter classNameOf: oldClassObj Is: 'SmallInteger')
- or: [(oldInterpreter classNameOf: oldClassObj Is: 'Character')
- or: [oldInterpreter classNameOf: oldClassObj Is: 'SmallFloat64']]) ifTrue:
- [^newHeap integerObjectOf: newHeap instSpecForImmediateClasses << 16].
- oldFormat := oldHeap formatOfClass: oldClassObj. "N.B. SmallInteger with tag bit cleared"
- oldFormat := oldFormat >> 1.
- instSize := ((oldFormat bitShift: -10) bitAnd: 16rC0) + ((oldFormat bitShift: -1) bitAnd: 16r3F) - 1.
- newInstSpec := #(0 1 2 3 4 nil 10 9 16 16 16 16 24 24 24 24) at: ((oldFormat bitShift: -7) bitAnd: 16rF) + 1.
- ^newHeap integerObjectOf: newInstSpec << 16 + instSize!
Item was removed:
- ----- Method: SpurBootstrap>>newFormatFor:numBytes: (in category 'bootstrap image') -----
- newFormatFor: oldObj numBytes: numBytesIfBits
- "OLD:
- 0 no fields
- 1 fixed fields only (all containing pointers)
- 2 indexable fields only (all containing pointers)
- 3 both fixed and indexable fields (all containing pointers)
- 4 both fixed and indexable weak fields (all containing pointers).
-
- 5 unused
- 6 indexable word fields only (no pointers)
- 7 indexable long (64-bit) fields (only in 64-bit images)
-
- 8-11 indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
- 12-15 compiled methods:
- # of literal oops specified in method header,
- followed by indexable bytes (same interpretation of low 2 bits as above)"
-
- "NEW:
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = reserved
- 7 = forwarder format (also immediate class format)
- 9 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
- | oldFormat |
- oldFormat := oldHeap formatOf: oldObj.
- oldFormat <= 4 ifTrue:
- [^oldFormat].
- oldFormat >= 12 ifTrue: "CompiledMethod"
- [^24 + (self wordSize - numBytesIfBits bitAnd: self wordSizeMask)].
- oldFormat >= 8 ifTrue: "ByteArray et al"
- [^16 + (self wordSize - numBytesIfBits bitAnd: self wordSizeMask)].
- oldFormat = 6 ifTrue: "32-bit indexable"
- [^10 + (numBytesIfBits bitAnd: self wordSizeMask) sign].
- oldFormat = 7 ifTrue: "64-bit indexable"
- [^9].
- self error: 'illegal old format'!
Item was removed:
- ----- Method: SpurBootstrap>>oldClassOopFor: (in category 'bootstrap image') -----
- oldClassOopFor: aClass
- ^oldHeap fetchPointer: ValueIndex ofObject: (literalMap at: aClass binding).!
Item was removed:
- ----- Method: SpurBootstrap>>oldFormatHeaderFor: (in category 'bootstrap methods') -----
- oldFormatHeaderFor: method
- | primBits primitive |
- primitive := method primitive.
- primBits := primitive <= 16r1FF
- ifTrue: [primitive]
- ifFalse: [(primitive bitAnd: 16r1FF) + ((primitive bitAnd: 16r200) bitShift: 19)].
- ^(method numArgs bitShift: 24)
- + (method numTemps bitShift: 18)
- + (method frameSize > method class smallFrameSize ifTrue: [1 << 17] ifFalse: [0])
- + (method numLiterals bitShift: 9)
- + primBits!
Item was removed:
- ----- Method: SpurBootstrap>>on: (in category 'initialize-release') -----
- on: imageName
- StackInterpreter initializeWithOptions: Dictionary new.
- (oldInterpreter := StackInterpreterSimulator new)
- openOn: imageName extraMemory: 0;
- assertValidExecutionPointersAtEachStep: false.
- oldHeap := oldInterpreter objectMemory.
- newHeap := Spur32BitMMLESimulator new.
- newHeap
- allocateMemoryOfSize: (oldHeap youngStart * 3 / 2 roundUpTo: 1024 * 1024)
- newSpaceSize: 4 * 1024 * 1024
- stackSize: 16 * 1024
- codeSize: 0.
- newHeap setCheckForLeaks: 15 - 6. "don't check become; or newSpace; soooo many rehashes in bootstrap"
- newHeap bootstrapping: true.
- self initMaps!
Item was removed:
- ----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') -----
- prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
- "Evaluate aBlock with class name, class is meta, method and selector.
- For now find methods in class-side category #'method prototypes'.
- Scheme could be extended to have different protocols for different
- Squeak/Pharo versions."
- self allMethodPrototypes do:
- [:methodArg| | method className isMeta |
- className := self classNameForPrototypeMethod: (method := methodArg).
- (isMeta := className endsWith: 'class') ifTrue:
- [className := (className allButLast: 5) asSymbol].
- (method pragmaAt: #indirect) ifNotNil:
- [method := (isMeta
- ifTrue: [(Smalltalk classNamed: className) class]
- ifFalse: [Smalltalk classNamed: className]) >> method selector].
- quaternaryBlock
- value: className
- value: isMeta
- value: (self selectorForPrototypeMethod: method)
- value: method]!
Item was removed:
- ----- Method: SpurBootstrap>>recreateSpecialObjectsArray (in category 'bootstrap image') -----
- recreateSpecialObjectsArray
- "This is tricky. We want to recreate the specialObjectsArray according to
- the class side SmalltalkImagePROTOTYPErecreateSpecialObjectsArray.
- But that version destroys the CompactClassesArray upon which the V3
- image depends. The bootstrap will get rid of it later. So save it before
- the recreation and restore it."
- self withExecutableInterpreter: oldInterpreter
- do: [| compactClassesArray |
- compactClassesArray := oldHeap splObj: CompactClasses.
- self
- interpreter: oldInterpreter
- object: (oldHeap splObj: 8)
- perform: (self findSymbol: #recreateSpecialObjectsArray)
- withArguments: #().
- oldHeap splObj: CompactClasses put: compactClassesArray]!
Item was removed:
- ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
- rehashImage
- "Rehash all collections in newHeap.
- Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
- Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
- | n sim rehashFlags dotDate rehashSym sizeSym |
- rehashSym := map at: (self findSymbol: #rehash).
- sizeSym := map at: (self findSymbol: #size).
- sim := StackInterpreterSimulator
- onObjectMemory: newHeap
- options: #(ObjectMemory #Spur32BitMemoryManager).
- sim
- setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
- imageName: 'spur image';
- assertValidExecutionPointersAtEachStep: false..
- newHeap coInterpreter: sim.
- sim bootstrapping: true.
- sim initializeInterpreter: 0.
- sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
- (imageTypes includes: 'cuis') ifTrue:
- [newHeap scavenger growRememberedSet]. "Rehashing a 4.2 Cuis image overflows the 768 element high tide."
-
- sim redirectTranscriptToHost.
-
- newHeap
- setHashBitsOf: newHeap nilObject to: 1;
- setHashBitsOf: newHeap falseObject to: 2;
- setHashBitsOf: newHeap trueObject to: 3.
-
- rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
- n := 0.
- newHeap classTableObjectsDo:
- [:class| | classIndex |
- sim messageSelector: rehashSym.
- "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
- ((sim lookupOrdinaryNoMNUEtcInClass: class) = 0
- and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
- [n := n + 1.
- classIndex := newHeap rawHashBitsOf: class.
- rehashFlags
- at: classIndex >> 3 + 1
- put: ((rehashFlags at: classIndex >> 3 + 1)
- bitOr: (1 << (classIndex bitAnd: 7)))]].
- Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
- dotDate := Time now asSeconds.
- n := 0.
- self withExecutableInterpreter: sim
- do: [sim setBreakSelector: 'error:'.
- "don't rehash twice (actually without limit), so don't rehash any new objects created."
- newHeap allExistingOldSpaceObjectsDo:
- [:o| | classIndex |
- classIndex := newHeap classIndexOf: o.
- ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
- [Time now asSeconds > dotDate ifTrue:
- [Transcript nextPut: $.; flush.
- dotDate := Time now asSeconds].
- "2845 = n ifTrue: [self halt]."
- "Rehash an object if its size is > 0.
- Symbol implements rehash, but let's not waste time rehashing it; in Squeak
- up to 2013 symbols are kept in a set which will get reashed anyway..
- Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
- ((sim addressCouldBeClassObj: o)
- or: [(self interpreter: sim
- object: o
- perform: sizeSym
- withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
- [self interpreter: sim
- object: o
- perform: rehashSym
- withArguments: #()]]]]!
Item was removed:
- ----- Method: SpurBootstrap>>removeMethods (in category 'bootstrap methods') -----
- removeMethods
- "Get the simulator to remove any methods marked with <remove>."
- | removeSym |
- removeSym := self findSymbol: #removeSelectorSilently:.
- removeSym ifNil:
- [removeSym := self findSymbol: #removeSelector:].
- self prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method| | class |
- (method pragmaAt: #remove) ifNotNil:
- [(self findClassNamed: (literalMap at: className)) ifNotNil:
- [:theClass|
- class := isMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
- Transcript
- cr;
- nextPutAll: 'removing ';
- nextPutAll: className;
- nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
- store: selector;
- flush.
- self interpreter: oldInterpreter
- object: class
- perform: removeSym
- withArguments: {literalMap at: selector}]]]!
Item was removed:
- ----- Method: SpurBootstrap>>replaceMethods (in category 'bootstrap methods') -----
- replaceMethods
- "Replace all the modified method prototypes."
- self allPrototypeClassNamesDo:
- [:sym :symIsMeta|
- (self findClassNamed: (literalMap at: sym))
- ifNil: [Transcript
- cr;
- nextPutAll: 'not replacing any methods for ';
- nextPutAll: sym;
- nextPutAll: '; class not found in image';
- flush.]
- ifNotNil:
- [:theClass| | class |
- class := symIsMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
- self prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method| | replacement methodDict index |
- (className = sym
- and: [symIsMeta = isMeta
- and: [(method pragmaAt: #remove) isNil]]) ifTrue:
- [(installedPrototypes includes: method selector) ifFalse:
- ["probe method dictionary of the class for each method, installing a dummy if not found."
- Transcript
- cr;
- nextPutAll: 'replacing ';
- nextPutAll: className;
- nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
- store: selector;
- flush.
- replacement := self installableMethodFor: method
- selector: selector
- className: className
- isMeta: isMeta.
- methodDict := oldHeap fetchPointer: MethodDictionaryIndex ofObject: class.
- index := self indexOfSelector: (literalMap at: selector) in: methodDict.
- oldHeap
- storePointer: index - SelectorStart
- ofObject: (oldHeap fetchPointer: MethodArrayIndex ofObject: methodDict)
- withValue: replacement.
- installedPrototypes add: method selector]]]]]!
Item was removed:
- ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') -----
- replacementForCharacterMethod: characterMethodOop
- "Answer a replacement method for the argument if it refers
- to Character's old inst var value. Otherwise answer nil."
- | proxy asIntegerProxy clone assembly newInsts newMethod |
- "(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue:
- [self halt]."
- "Don't replace something already installed."
- (installedMethodOops includes: characterMethodOop) ifTrue:
- [^nil].
- proxy := VMCompiledMethodProxy new
- for: characterMethodOop
- coInterpreter: oldInterpreter
- objectMemory: oldHeap.
- self assert: (oldHeap literalCountOf: characterMethodOop) = proxy numLiterals.
- clone := self cloneMethodProxy: proxy.
- self assert: proxy numLiterals = clone numLiterals.
- clone isReturnSpecial ifTrue:
- [^nil].
- "Quick methods accessing value should have been replaced. The halt will fire if there
- is a missing prototype for such a method on the class side of SpurBootstrap. The
- relevant Character prototypes there so far are Character>>asInteger, Character>>
- asciiValue, Character>>hash & Character>>identityHash. Conceivably the bootstrap
- could be applied to an image that has others; hence the halt."
- clone isReturnField ifTrue: [self halt].
- clone hasInstVarRef ifFalse:
- [^nil].
- clone setSourcePointer: 0.
- asIntegerProxy := VMObjectProxy new
- for: (literalMap at: #asInteger)
- coInterpreter: oldInterpreter
- objectMemory: oldHeap.
- assembly := BytecodeDisassembler new disassemble: clone.
- assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2).
- "Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger"
- newInsts := (assembly instructions piecesCutWhere:
- [:msgOrLabelAssoc :nextInst|
- msgOrLabelAssoc isVariableBinding not
- and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold:
- [:a :b|
- a allButLast,
- { Message selector: #pushReceiver.
- Message
- selector: #send:super:numArgs:
- arguments: {asIntegerProxy. false. 0}},
- b].
- assembly instructions: newInsts.
- newMethod := assembly assemble.
- self assert: clone numLiterals + 1 = newMethod numLiterals.
- ^self
- installableMethodFor: newMethod
- selector: clone selector
- className: #Character
- isMeta: false!
Item was removed:
- ----- Method: SpurBootstrap>>reportSizes (in category 'bootstrap image') -----
- reportSizes
- | change oldAvgBytes newAvgBytes |
- change := newHeapSize - oldHeapSize / oldHeapSize.
- oldAvgBytes := oldHeapSize asFloat / oldHeapNumObjs.
- Transcript
- nextPutAll: 'done.'; cr;
- nextPutAll: 'old heap size: '; nextPutAll: oldHeapSize asStringWithCommas; tab;
- nextPutAll: ' (avg obj bytes '; print: oldAvgBytes maxDecimalPlaces: 2; nextPutAll: ' words '; print: oldAvgBytes / self wordSize maxDecimalPlaces: 2; nextPut: $); cr;
- nextPutAll: 'initial new heap size: '; nextPutAll: newHeapSize asStringWithCommas; cr;
- nextPutAll: 'change: '; print: change * 100.0 maxDecimalPlaces: 2; nextPut: $%; cr;
- flush.
- newHeapSize := newHeap endOfMemory
- - newHeap scavenger eden limit
- - newHeap totalFreeListBytes.
- change := newHeapSize - oldHeapSize / oldHeapSize.
- newAvgBytes := newHeapSize asFloat / newHeapNumObjs.
- Transcript
- nextPutAll: 'final new heap size: '; nextPutAll: newHeapSize asStringWithCommas; tab;
- nextPutAll: ' (avg obj bytes '; print: newAvgBytes maxDecimalPlaces: 2; nextPutAll: ' words '; print: newAvgBytes / self wordSize maxDecimalPlaces: 2; nextPut: $); cr;
- nextPutAll: 'change: '; print: change * 100.0 maxDecimalPlaces: 2; nextPut: $%; cr;
- flush!
Item was removed:
- ----- Method: SpurBootstrap>>saveTransformedImage (in category 'development support') -----
- saveTransformedImage
- ImageHeaderFlags := oldInterpreter getImageHeaderFlags.
- ImageScreenSize := oldInterpreter savedWindowSize.
- ImageName := oldInterpreter imageName.
- newHeap coInterpreter: nil.
- (newHeap class allInstVarNames select: [:ivn| ivn beginsWith: 'stat']) do:
- [:ivn| newHeap instVarNamed: ivn put: 0].
- TransformedImage := newHeap veryDeepCopy!
Item was removed:
- ----- Method: SpurBootstrap>>scavengeImage (in category 'bootstrap image') -----
- scavengeImage
- "Scavenge the image to get it into a simpler state."
- newHeap coInterpreter voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
- newHeap flushNewSpace!
Item was removed:
- ----- Method: SpurBootstrap>>selectorForPrototypeMethod: (in category 'method prototypes') -----
- selectorForPrototypeMethod: protoMethod
- | protoSelector |
- protoSelector := protoMethod selector.
- protoSelector := protoSelector last: protoSelector size
- - (protoSelector indexOfSubCollection: 'PROTOTYPE')
- - 'PROTOTYPE' size
- + 1.
- (protoSelector beginsWith: 'Dollar') ifTrue:
- [protoSelector := (Dictionary newFromPairs: #('DollarEquals:' #=))
- at: protoSelector].
- ^protoSelector asSymbol!
Item was removed:
- ----- Method: SpurBootstrap>>silenceImage (in category 'bootstrap image') -----
- silenceImage
- "Turn off change notifications via SystemChangeNotifier"
- (self allInstancesOf: (self findClassNamed: (self findSymbol: #SystemChangeNotifier))) do:
- [:obj | oldHeap storePointer: 1 ofObject: obj withValue: (oldHeap integerObjectOf: 1)]!
Item was removed:
- ----- Method: SpurBootstrap>>stringFor: (in category 'bootstrap methods') -----
- stringFor: aString
- | string |
- string := oldHeap instantiateClass: (oldHeap splObj: ClassByteString) indexableSize: aString size.
- 1 to: aString size do:
- [:i| oldHeap storeByte: i - 1 ofObject: string withValue: (aString at: i) asInteger].
- ^string
- !
Item was removed:
- ----- Method: SpurBootstrap>>symbolClass (in category 'bootstrap methods') -----
- symbolClass
- ^oldHeap fetchClassOfNonImm: (oldHeap splObj: SelectorDoesNotUnderstand)!
Item was removed:
- ----- Method: SpurBootstrap>>transform (in category 'bootstrap image') -----
- transform
- self silenceImage.
- self findRequiredGlobals.
- self installModifiedMethods.
- self recreateSpecialObjectsArray.
- self initializeClasses.
- self bootstrapImage.
- self validate.
- self rehashImage.
- self followForwardingPointers.
- self scavengeImage.
- self freeForwarders.
- self compactImage.
- self reportSizes!
Item was removed:
- ----- Method: SpurBootstrap>>validate (in category 'bootstrap image') -----
- validate
- | p n duplicates maxClassIndex savedEndOfMemory |
- self assert: (reverseMap at: newHeap specialObjectsOop) = oldHeap specialObjectsOop.
- self assert: (map at: oldHeap specialObjectsOop) = newHeap specialObjectsOop.
- self assert: (reverseMap at: newHeap classTableRootObj ifAbsent: []) isNil.
-
- duplicates := { 3. newHeap arrayClassIndexPun. newHeap weakArrayClassIndexPun }.
- maxClassIndex := classToIndex inject: 0 into: [:a :b| a max: b].
- self assert: ((newHeap arrayClassIndexPun to: maxClassIndex) select:
- [:idx| | classObj |
- (classObj := newHeap classOrNilAtIndex: idx) ~= newHeap nilObject
- and: [(newHeap classIndexOf: classObj) = (newHeap rawHashBitsOf: classObj)]]) isEmpty.
- 0 to: maxClassIndex do:
- [:index| | classObj |
- (index <= newHeap tagMask
- and: [index > newHeap isForwardedObjectClassIndexPun]) ifTrue:
- [(classObj := newHeap classOrNilAtIndex: index) = newHeap nilObject
- ifTrue:
- [self assert: (classToIndex keyAtValue: index ifAbsent: []) isNil]
- ifFalse:
- [self assert: (newHeap classIndexOf: classObj) ~= (newHeap rawHashBitsOf: classObj).
- (duplicates includes: index) ifFalse:
- [self assert: (newHeap rawHashBitsOf: classObj) = index]]]].
- classToIndex keysAndValuesDo:
- [:oldClass :idx|
- self assert: (newHeap rawHashBitsOf: (map at: oldClass)) = idx.
- self assert: oldClass = (reverseMap at: (newHeap classAtIndex: idx))].
- n := 0.
- savedEndOfMemory := newHeap endOfMemory.
- newHeap setEndOfMemory: newHeap freeOldSpaceStart.
- newHeap allObjectsDo:
- [:o|
- (o <= newHeap trueObject
- or: [o > lastClassTablePage]) ifTrue:
- [self assert: (reverseMap includesKey: o).
- self assert: (newHeap fetchClassOfNonImm: o) = (map at: (oldHeap fetchClassOfNonImm: (reverseMap at: o)))].
- n := n + 1.
- p := o].
- newHeap setEndOfMemory: savedEndOfMemory.
- self touch: p.
- self assert: (n between: map size and: map size + ((imageTypes includes: 'squeak')
- ifTrue: [6]
- ifFalse: [10])). "+ 6 or 10 is room for freelists & classTable"
-
- "check some class properties to ensure the format changes are correct"
- self assert: (newHeap fixedFieldsOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = 0.
- self assert: (newHeap instSpecOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = newHeap arrayFormat!
Item was removed:
- ----- Method: SpurBootstrap>>wordSize (in category 'word size') -----
- wordSize
- ^self subclassResponsibility!
Item was removed:
- ----- Method: SpurBootstrap>>wordSizeMask (in category 'word size') -----
- wordSizeMask
- ^self subclassResponsibility!
Item was removed:
- ----- Method: SpurBootstrap>>writeSnapshot:ofTransformedImage:headerFlags:screenSize: (in category 'testing') -----
- writeSnapshot: imageFileName ofTransformedImage: spurHeap headerFlags: headerFlags screenSize: screenSizeInteger
- "The bootstrapped image typically contains a few big free chunks and one huge free chunk.
- Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
- and saving."
- | penultimate ultimate sim |
- sim := StackInterpreterSimulator onObjectMemory: spurHeap.
- sim bootstrapping: true.
- spurHeap
- coInterpreter: sim;
- setEndOfMemory: spurHeap endOfMemory + spurHeap bridgeSize. "hack; initializeInterpreter: cuts it back by bridgeSize"
- sim initializeInterpreter: 0;
- setImageHeaderFlagsFrom: headerFlags;
- setSavedWindowSize: screenSizeInteger;
- setDisplayForm: nil.
- spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
- "Check that we've left behind the old, pre-pigCompact segmented save"
- self assert: (spurHeap isFreeObject: penultimate) not.
- spurHeap checkFreeSpace.
- spurHeap runLeakCheckerForFullGC.
- sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
- sim imageName: imageFileName.
- sim writeImageFileIO.
- Transcript cr; show: 'Done!!'!
Item was removed:
- SpurBootstrap subclass: #SpurBootstrap32
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrap32>>fillInBitsObject:from: (in category 'bootstrap') -----
- fillInBitsObject: newObj from: oldObj
- 0 to: (oldHeap numSlotsOf: oldObj) - 1 do:
- [:i|
- newHeap
- storeLong32: i
- ofObject: newObj
- withValue: (oldHeap fetchLong32: i ofObject: oldObj)]!
Item was removed:
- ----- Method: SpurBootstrap32>>wordSize (in category 'word size') -----
- wordSize
- ^4!
Item was removed:
- ----- Method: SpurBootstrap32>>wordSizeMask (in category 'word size') -----
- wordSizeMask
- ^3!
Item was removed:
- SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapCuisPrototypes
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes class>>imageType (in category 'accessing') -----
- imageType
- ^ 'cuis'!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ArrayPROTOTYPEcreateMethod:class:header: (in category 'method prototypes') -----
- ArrayPROTOTYPEcreateMethod: numberOfBytesForAllButTrailer class: aCompiledMethodClass header: headerWord
- | meth delta |
- meth := aCompiledMethodClass newMethod: numberOfBytesForAllButTrailer + self size header: headerWord.
- "copy the trailer data"
- delta := meth size - self size.
- 1 to: self size do:
- [:i | meth at: delta + i put: (self at: i)].
- ^meth!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes') -----
- BehaviorPROTOTYPEidentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- Behavior implements identityHash to allow the VM to use an object representation which
- does not include a direct reference to an object's class in an object. If the VM is using
- this implementation then classes are held in a class table and instances contain the index
- of their class in the table. A class's class table index is its identityHash so that an instance
- can be created without searching the table for a class's index. The VM uses this primitive
- to enter the class into the class table, assigning its identityHash with an as yet unused
- class table index. If this primitive fails it means that the class table is full. In Spur as of
- 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
-
- Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
-
- <primitive: 175>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
- BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
- CharacterPROTOTYPEclone
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
- CharacterPROTOTYPEsetValue: v
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>CharacterPROTOTYPEvalue (in category 'method prototypes') -----
- CharacterPROTOTYPEvalue
- "Answer the value of the receiver that represents its ISO 8859-15 (Latin-9) encoding."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
- CharacterclassPROTOTYPEinitialize
- <ignore>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ClassDescriptionPROTOTYPEupdateInstancesFrom: (in category 'method prototypes') -----
- ClassDescriptionPROTOTYPEupdateInstancesFrom: oldClass
- "Recreate any existing instances of the argument, oldClass, as instances of
- the receiver, which is a newly changed class. Permute variables as necessary,
- and forward old instances to new instances.. Answer nil to defeat any clients
- that expected the old behaviour of answering the array of old instances."
- "ar 7/15/1999: The updating below is possibly dangerous. If there are any
- contexts having an old instance as receiver it might crash the system if
- the new receiver in which the context is executed has a different layout.
- See bottom below for a simple example:"
- self updateInstances: oldClass allInstances asArray from: oldClass isMeta: self isMeta.
- ^nil
-
- "This attempts to crash the VM by stepping off the end of an instance.
- As the doctor says, do not do this."
- " | crashingBlock class |
- class := Object subclass: #CrashTestDummy
- instanceVariableNames: 'instVar'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Crash-Test'.
- class compile:'instVar: value instVar := value'.
- class compile:'crashingBlock ^[instVar]'.
- crashingBlock := (class new) instVar: 42; crashingBlock.
- Object subclass: #CrashTestDummy
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Crash-Test'.
- crashingBlock value"!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes') -----
- ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
- ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
- "This is the standard initialization message for creating a new
- immediate class as a subclass of an existing class (the receiver)."
- ^ClassBuilder new
- superclass: self
- immediateSubclass: t
- instanceVariableNames: f
- classVariableNames: d
- poolDictionaries: s
- category: cat!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>CompiledMethodPROTOTYPEbytecodeSetName (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEbytecodeSetName
- ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>CompiledMethodPROTOTYPEheaderDescription (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEheaderDescription
- "Answer a description containing the information about the form of the
- receiver and the form of the context needed to run the receiver."
-
- ^(String new: 128) writeStream
- print: self header; cr;
- nextPutAll: '"primitive: '; print: self primitive; cr;
- nextPutAll: ' numArgs: '; print: self numArgs; cr;
- nextPutAll: ' numTemps: '; print: self numTemps; cr;
- nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
- nextPutAll: ' frameSize: '; print: self frameSize; cr;
- nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
- nextPut: $"; cr;
- contents!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
- ContextPartPROTOTYPEactivateReturn: aContext value: value
- "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
-
- ^MethodContext
- sender: self
- receiver: aContext
- method: MethodContext theReturnMethod
- arguments: {value}!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
- ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
- "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
- arguments are given as arguments to this message. If successful, push result and return
- resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
- execution needs to be intercepted and simulated to avoid execution running away."
-
- | value |
- "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- the debugger from entering various run-away activities such as spawning a new
- process, etc. Injudicious use results in the debugger not being able to debug
- interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
- "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- primitiveIndex = 19 ifTrue:
- [Debugger
- openContext: self
- label:'Code simulation error'
- contents: nil].
-
- ((primitiveIndex between: 201 and: 222)
- and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
- [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
- or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^receiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^receiver simulateValueWithArguments: arguments first caller: self]].
-
- primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- [^self send: arguments first to: receiver with: arguments allButFirst super: false].
- primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
- primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
-
- "Mutex>>primitiveEnterCriticalSection
- Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
- (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
- [| active effective |
- active := Processor activeProcess.
- effective := active effectiveProcess.
- "active == effective"
- value := primitiveIndex = 186
- ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
- ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
- ^(self isPrimFailToken: value)
- ifTrue: [value]
- ifFalse: [self push: value]].
-
- primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
- [^MethodContext
- sender: self
- receiver: receiver
- method: (arguments at: 2)
- arguments: (arguments at: 1)].
-
- "Closure primitives"
- (primitiveIndex = 200 and: [self == receiver]) ifTrue:
- "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
- [^self push: (BlockClosure
- outerContext: receiver
- startpc: self pc + 2
- numArgs: arguments first
- copiedValues: arguments last)].
-
- primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
- [(arguments size = 2
- and: [arguments first isInteger
- and: [(self objectClass: arguments last) == Array]]) ifFalse:
- [^ContextPart primitiveFailTokenFor: nil].
- ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
-
- value := primitiveIndex = 120 "FFI method"
- ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
- ifFalse:
- [primitiveIndex = 117 "named primitives"
- ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
- ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
-
- ^(self isPrimFailToken: value)
- ifTrue: [value]
- ifFalse: [self push: value]!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
- ContextPartPROTOTYPEisPrimFailToken: anObject
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
- "Simulate the action of sending a message with selector and arguments
- to rcvr. The argument, lookupClass, is the class in which to lookup the
- message. This is the receiver's class for normal messages, but for super
- messages it will be some specific class related to the source method."
-
- | meth primIndex val ctxt |
- (meth := lookupClass lookupSelector: selector) ifNil:
- [^self send: #doesNotUnderstand:
- to: rcvr
- with: {Message selector: selector arguments: arguments}
- lookupIn: lookupClass].
- (primIndex := meth primitive) > 0 ifTrue:
- [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
- (self isPrimFailToken: val) ifFalse:
- [^val]].
- (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ', arguments first selector, ' not understood'].
- ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
- primIndex > 0 ifTrue:
- [ctxt failPrimitiveWith: val].
- ^ctxt!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag
- "Simulate the action of sending a message with selector arguments
- to rcvr. The argument, superFlag, tells whether the receiver of the
- message was specified with 'super' in the source method."
-
- ^self send: selector
- to: rcvr
- with: arguments
- lookupIn: (superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr])!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
- ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
- "Invoke the named primitive for aCompiledMethod, answering its result, or,
- if the primiitve fails, answering the error code."
- <primitive: 218 error: ec>
- ec ifNotNil:
- ["If ec is an integer other than -1 there was a problem with primitive 218,
- not with the external primitive itself. -1 indicates a generic failure (where
- ec should be nil) but ec = nil means primitive 218 is not implemented. So
- interpret -1 to mean the external primitive failed with a nil error code."
- ec isInteger ifTrue:
- [ec = -1
- ifTrue: [ec := nil]
- ifFalse: [self primitiveFailed]]].
- ^self class primitiveFailTokenFor: ec!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
- IntegerclassPROTOTYPEinitialize
- "Integer initialize"
- self initializeLowBitPerByteTable!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
- MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
- MethodContextclassPROTOTYPEallInstances
- "Answer all instances of the receiver."
- <primitive: 177>
- "The primitive can fail because memory is low. If so, fall back on the old
- enumeration code, which gives the system a chance to GC and/or grow.
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst.
- Only count until thisContext since this context has been created only to
- compute the existing instances."
- | inst insts next |
- insts := WriteStream on: (Array new: 64).
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- insts nextPut: inst.
- inst := next].
- ^insts contents!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
- MethodContextclassPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- | instances inst next |
- instances := self allInstancesOrNil.
- instances ifNotNil:
- [instances do: aBlock.
- ^self].
- "allInstancesOrNil can fail because memory is low. If so, fall back on the old
- enumeration code. Because aBlock might change the class of inst (for example,
- using become:), it is essential to compute next before aBlock value: inst.
- Only count until thisContext since evaluation of aBlock will create new contexts."
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>MethodNodePROTOTYPEgenerate:using:ifQuick: (in category 'method prototypes') -----
- MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass ifQuick: methodBlock
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') -----
- ProtoObjectPROTOTYPEscaledIdentityHash
- "For identityHash values returned by primitive 75, answer
- such values times 2^8. Otherwise, match the existing
- identityHash implementation"
-
- ^self identityHash * 256 "bitShift: 8"!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>SmallIntegerPROTOTYPEclone (in category 'method prototypes') -----
- SmallIntegerPROTOTYPEclone
- "Answer the receiver, because SmallIntegers are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>SystemDictionaryPROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPErecreateSpecialObjectsArray
- "Smalltalk recreateSpecialObjectsArray"
-
- "To external package developers:
- **** DO NOT OVERRIDE THIS METHOD. *****
- If you are writing a plugin and need additional special object(s) for your own use,
- use addGCRoot() function and use own, separate special objects registry "
-
- "The Special Objects Array is an array of objects used by the Squeak virtual machine.
- Its contents are critical and accesses to it by the VM are unchecked, so don't even
- think of playing here unless you know what you are doing."
- | newArray |
- newArray := Array new: 60.
- "Nil false and true get used throughout the interpreter"
- newArray at: 1 put: nil.
- newArray at: 2 put: false.
- newArray at: 3 put: true.
- "This association holds the active process (a ProcessScheduler)"
- newArray at: 4 put: (self associationAt: #Processor).
- "Numerous classes below used for type checking and instantiation"
- newArray at: 5 put: Bitmap.
- newArray at: 6 put: SmallInteger.
- newArray at: 7 put: String.
- newArray at: 8 put: Array.
- newArray at: 9 put: Smalltalk.
- newArray at: 10 put: BoxedFloat64.
- newArray at: 11 put: MethodContext.
- newArray at: 12 put: nil. "was BlockContext."
- newArray at: 13 put: Point.
- newArray at: 14 put: LargePositiveInteger.
- newArray at: 15 put: Display.
- newArray at: 16 put: Message.
- newArray at: 17 put: CompiledMethod.
- newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 19 put: Semaphore.
- newArray at: 20 put: Character.
- newArray at: 21 put: #doesNotUnderstand:.
- newArray at: 22 put: #cannotReturn:.
- newArray at: 23 put: nil. "This is the process signalling low space."
- "An array of the 32 selectors that are compiled as special bytecodes,
- paired alternately with the number of arguments each takes."
- newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
- #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
- #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
- #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
- "An array of the 255 Characters in ascii order.
- Cog inlines table into machine code at: prim so do not regenerate it.
- This is nil in Spur, which has immediate Characters."
- newArray at: 25 put: (self specialObjectsArray at: 25).
- newArray at: 26 put: #mustBeBoolean.
- newArray at: 27 put: ByteArray.
- newArray at: 28 put: Process.
- "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- newArray at: 29 put: self compactClassesArray.
- newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
- newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
- newArray at: 32 put: nil. "was the prototype Float"
- newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
- newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 35 put: #cannotInterpret:.
- newArray at: 36 put: nil. "was the prototype MethodContext"
- newArray at: 37 put: BlockClosure.
- newArray at: 38 put: nil. "was the prototype BlockContext"
- "array of objects referred to by external code"
- newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
- newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
- newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 43 put: LargeNegativeInteger.
- "External objects for callout.
- Note: Written so that one can actually completely remove the FFI."
- newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
- newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
- newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
- newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
- newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
- newArray at: 49 put: #aboutToReturn:through:.
- newArray at: 50 put: #run:with:in:.
- "51 reserved for immutability message"
- newArray at: 51 put: #attemptToAssign:withIndex:.
- newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
- #'bad argument' #'bad index'
- #'bad number of arguments'
- #'inappropriate operation' #'unsupported operation'
- #'no modification' #'insufficient object memory'
- #'insufficient C memory' #'not found' #'bad method'
- #'internal error in named primitive machinery'
- #'object may move' #'resource limit exceeded'
- #'object is pinned' #'primitive write beyond end of object').
- "53 to 55 are for Alien"
- newArray at: 53 put: (self at: #Alien ifAbsent: []).
- newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
-
- "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
- newArray at: 56 put: nil.
-
- "reserved for foreign callback process"
- newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
-
- newArray at: 58 put: #unusedBytecode.
- "59 reserved for Sista counter tripped message"
- newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
- "60 reserved for Sista class trap message"
- newArray at: 60 put: #classTrapFor:.
-
- "Now replace the interpreter's reference in one atomic operation"
- self specialObjectsArray becomeForward: newArray!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
-
- | proportion edenSize survivorSize averageObjectSize numObjects |
- proportion := 0.9. "tenure when 90% of pastSpace is full"
- edenSize := Smalltalk vmParameterAt: 44.
- survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- averageObjectSize := 8 * self wordSize. "a good approximation"
- numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- Smalltalk vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- ----- Method: SpurBootstrapCuisPrototypes>>SystemDictionaryPROTOTYPEwordSize (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEwordSize
- "Answer the size in bytes of an object pointer or word in the object memory.
- The value does not change for a given image, but may be modified by a SystemTracer
- when converting the image to another format."
-
- "Smalltalk wordSize"
-
- ^self vmParameterAt: 40!
Item was removed:
- Object subclass: #SpurBootstrapMonticelloPackagePatcher
- instanceVariableNames: 'sourceDir destDir packagesAndPatches imageTypes'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
-
- !SpurBootstrapMonticelloPackagePatcher commentStamp: 'eem 1/15/2014 17:59' prior: 0!
- A SpurBootstrapMonticelloPackagePatcher is used to construct a new set of patched Monticello packages for Spur. The use case is some bootstrap process loads a set of Monticello packages. To repeat the bootstrap with a Spur image the bootstrap must use suitably patched Monticello packages containing the new method versions on the class side of SpurBootstrap.
-
- Instance Variables
- destDir: <FileDirectory>
- sourceDir: <FileDirectory>
-
- destDir
- - directory to which patched packages are to be written
-
- sourceDir
- - directory from which packages to be patched are to be read!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher class>>squeak45baseline (in category 'baselines') -----
- squeak45baseline
- "The base Squeak-4.5-13680 package set."
- ^#( name 'base-Squeak45-eem'
- repository ('http://source.squeak.org/squeak45')
- dependency ('Squeak-Version' 'Squeak-Version-ar.4662' '6bfece28-65a4-b147-9462-417b2e86acd0')
- dependency ('311Deprecated' '311Deprecated-nice.2' '6df45c33-740a-fc4f-b3d0-45412ad7d284')
- dependency ('39Deprecated' '39Deprecated-ar.19' '8da20c38-7d28-3241-9f29-da261d6f9bfe')
- dependency ('45Deprecated' '45Deprecated-fbs.24' '4033c169-94c6-7741-9aee-5a7570a7ec7a')
- dependency ('Balloon' 'Balloon-nice.24' '97e2ed51-707d-4da1-ab4f-35add3deee5e')
- dependency ('Network' 'Network-nice.150' 'c844e5ea-c919-44fc-905e-69487b035947')
- dependency ('Compression' 'Compression-fbs.40' '82b0d6e4-0239-1241-968c-461a785fb6a7')
- dependency ('Graphics' 'Graphics-nice.289' 'e809bcbf-53e1-420b-846a-9e86e0dd1f06')
- dependency ('Multilingual' 'Multilingual-fbs.194' '07f4a7b5-7169-3345-85fc-5a8ba04e5323')
- dependency ('CollectionsTests' 'CollectionsTests-dtl.214' 'cf157d3a-2d71-46f3-86ce-450ee24e8d27')
- dependency ('PackageInfo-Base' 'PackageInfo-Base-nice.68' 'b6669527-9a35-4783-a64f-8f2af97e330b')
- dependency ('Compiler' 'Compiler-nice.279' '94b1b5f8-f71b-4425-b035-461d3dc94e3f')
- dependency ('Environments' 'Environments-ul.46' 'cfd9e7f7-6a4b-400e-b9c7-9c6239da4752')
- dependency ('Kernel' 'Kernel-dtl.836' '410e695f-7f23-43e4-9dc2-d292b9954f0d')
- dependency ('MonticelloConfigurations' 'MonticelloConfigurations-fbs.123' 'b9735d10-7cf4-a746-8a64-b50fa9cf273f')
- dependency ('Tools' 'Tools-cmm.519' 'dae6bdb9-8b54-491a-a2a4-0b114f02e10d')
- dependency ('MorphicExtras' 'MorphicExtras-tpr.147' 'e76a71a5-6be9-4420-b71a-2c92d900c476')
- dependency ('Files' 'Files-dtl.130' '8ee82071-69f7-446d-8ed7-77eafc838f03')
- dependency ('System' 'System-dtl.666' '098b856a-ecc5-498a-bceb-ef3457d3511e')
- dependency ('Collections' 'Collections-ul.564' '4b9a37ef-df86-40a0-a0dd-8e8b2c04d4ed')
- dependency ('Monticello' 'Monticello-cmm.586' 'a4dbd656-e50a-47ba-8661-44f8c87bb3e0')
- dependency ('EToys' 'EToys-cmm.117' 'c3e71dbe-17af-4b71-ad9c-c0bb2a2bc193')
- dependency ('Exceptions' 'Exceptions-cmm.49' '6cede9fe-b13d-481a-b8de-bb004ece1145')
- dependency ('FlexibleVocabularies' 'FlexibleVocabularies-bf.13' '55c72a72-619e-4a81-831f-303600bbd792')
- dependency ('GraphicsTests' 'GraphicsTests-fbs.38' '081189cc-a44f-fa4e-965e-25438280ea93')
- dependency ('Installer-Core' 'Installer-Core-cmm.392' '7cb5c040-6f68-479d-bc9e-0b264b172443')
- dependency ('KernelTests' 'KernelTests-nice.259' '0f7301b0-612c-49d8-936f-775995b35e0f')
- dependency ('GetText' 'GetText-nice.34' '4d432f8e-55be-428a-9138-63dd1738035e')
- dependency ('Sound' 'Sound-nice.38' 'b626daf0-be23-4fb8-b2d5-04b9cd370539')
- dependency ('ToolBuilder-Tests' 'ToolBuilder-Tests-cmm.1' 'e77685b9-ca09-40c0-b84e-6caee75f4075')
- dependency ('Morphic' 'Morphic-cmm.720' 'e5e81c18-990b-4e35-b325-adb032b8418d')
- dependency ('MorphicTests' 'MorphicTests-nice.24' 'e33a9ad3-2f39-4c19-a3a7-dc87f18177fc')
- dependency ('MorphicExtrasTests' 'MorphicExtrasTests-fbs.3' '1c039763-bc92-834c-943e-d96d8820cbd7')
- dependency ('MultilingualTests' 'MultilingualTests-fbs.18' '07e26018-8455-3349-9b44-9ecb4aaeefb2')
- dependency ('Nebraska' 'Nebraska-nice.36' 'cc80dca4-ed72-4c39-952c-3b37886100de')
- dependency ('NetworkTests' 'NetworkTests-fbs.37' '97699685-5826-fe47-af98-356971abf2fb')
- dependency ('PreferenceBrowser' 'PreferenceBrowser-fbs.49' '72d30dfa-0ff5-4347-9823-eb77ae236f8f')
- dependency ('Protocols' 'Protocols-nice.46' '15b63671-d541-4c1d-9ff5-72da4fc5bfe9')
- dependency ('SMBase' 'SMBase-nice.132' 'a70c8bd2-3eee-4e21-b9c6-113f6b194527')
- dependency ('SMLoader' 'SMLoader-fbs.79' '9f7d983e-d958-4115-94aa-21302f89ad8b')
- dependency ('ST80' 'ST80-cmm.172' '47b2f84a-6951-480b-88f2-b2726dba08bd')
- dependency ('ST80Tests' 'ST80Tests-nice.2' '7ee5426b-73f1-48ac-8ec4-3943dc452cb6')
- dependency ('ST80Tools' 'ST80Tools-fbs.1' '108ec7bc-d1f5-dd4b-9511-e7a653a71e9f')
- dependency ('SUnit' 'SUnit-fbs.99' 'a5be81dd-6e9f-8d41-a091-3c6c27a28abe')
- dependency ('SUnitGUI' 'SUnitGUI-fbs.59' '0bfcf308-0d02-a749-9930-6229492cca48')
- dependency ('ScriptLoader' 'ScriptLoader-cmm.338' 'adb79117-0915-40a5-a5ee-c766e4b50d42')
- dependency ('Services-Base' 'Services-Base-topa.51' '94328e86-1643-4090-8f18-bc4467119161')
- dependency ('SmallLand-ColorTheme' 'SmallLand-ColorTheme-fbs.6' 'a78b81e3-3b11-c24e-9c84-3bb5319e0858')
- dependency ('SystemChangeNotification-Tests' 'SystemChangeNotification-Tests-nice.23' '3eed6d26-4aef-4095-a604-d9f914240281')
- dependency ('Tests' 'Tests-cmm.290' 'f3fccfae-6baf-4093-ba62-e15ef110a687')
- dependency ('ToolBuilder-Kernel' 'ToolBuilder-Kernel-nice.60' '86949a07-725b-4a27-a7cd-a827c74f48be')
- dependency ('ToolBuilder-MVC' 'ToolBuilder-MVC-fbs.34' 'aded987d-5cd5-6f41-9635-1d38da947ddf')
- dependency ('ToolBuilder-Morphic' 'ToolBuilder-Morphic-fbs.91' 'abaa076b-af43-af42-8c98-7a71482c6a30')
- dependency ('ToolBuilder-SUnit' 'ToolBuilder-SUnit-fbs.19' '3e30756c-2af8-0741-836f-0d42a9d5af32')
- dependency ('ToolsTests' 'ToolsTests-cmm.68' '98c1608a-6cb3-4a03-a28a-dd101e6c876b')
- dependency ('MonticelloForTraits' 'MonticelloForTraits-fbs.1' '160be615-5ab7-4148-a7cb-60dd629ab085')
- dependency ('Traits' 'Traits-topa.302' '58712f55-3f3f-467e-ac0e-e118c9737c53')
- dependency ('TraitsTests' 'TraitsTests-fbs.13' '0429146f-6767-4a4f-8fce-37571625920a')
- dependency ('TrueType' 'TrueType-nice.28' '42a74f04-e193-455b-a2c1-14ec51724234')
- dependency ('Universes' 'Universes-nice.46' '805eb73f-391b-4e3f-aef9-64add79e4e8c')
- dependency ('VersionNumber' 'VersionNumber-cmm.4' '68fb1f05-d3e2-4c9b-9234-20a9bed166dc')
- dependency ('XML-Parser' 'XML-Parser-fbs.36' 'a2d9791a-c341-564b-9b57-a0fe9f42b66f')
- dependency ('ReleaseBuilder' 'ReleaseBuilder-cmm.114' 'ea773780-69e1-48dd-a16c-e167acb9de04')
- dependency ('ShoutCore' 'ShoutCore-cwp.40' '81b3e230-2e8a-42c5-9521-e54338fadb6f')
- dependency ('VersionNumberTests' 'VersionNumberTests-fbs.4' '953a944c-9648-dd4b-898e-9e10e0507b91')
- dependency ('HelpSystem-Core' 'HelpSystem-Core-ul.56' '6d8a0d54-5f60-da45-8c3c-d42ea8abd999')
- dependency ('HelpSystem-Tests' 'HelpSystem-Tests-fbs.15' '8927a848-29a0-f54c-8c79-efb8070c4702')
- dependency ('Help-Squeak-Project' 'Help-Squeak-Project-kfr.10' 'b86eb622-cc53-634d-aa65-aed2c86263f9')
- dependency ('Help-Squeak-TerseGuide' 'Help-Squeak-TerseGuide-dtl.2' '8b18cab9-7183-4c5e-8cac-f79c4400da43')
- dependency ('SystemReporter' 'SystemReporter-ul.21' '34c5c48c-e7cc-4dfe-8133-6dec3bc63ff7')
- dependency ('BalloonTests' 'BalloonTests-egp.2' 'a8206c39-12ee-4222-a29a-caa537e037c4')
- dependency ('CommandLine' 'CommandLine-fbs.2' '414e59b8-4f4a-814d-9dac-b7b9886e92a0')
- dependency ('UpdateStream' 'UpdateStream-nice.4' '5fcdedce-88aa-469a-bf8b-32820f051c4f')
- )!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>cachedNonDiffyVersionNamed:from: (in category 'patching') -----
- cachedNonDiffyVersionNamed: versionName from: repo
- "Make sure that the cache contains a non-diffy version of versionName and answer it."
- | cacheRepo nonDiffyVersion |
- self assert: (versionName endsWith: '.mcz').
- cacheRepo := MCCacheRepository default.
- "Make sure that at least the diffy (.mcd) version is present"
- (cacheRepo directory includesKey: versionName) ifFalse:
- [cacheRepo storeVersion: (repo versionNamed: versionName)].
- "if after storeVersion there's still no .mcz we need to create one; sigh..."
- (cacheRepo directory includesKey: versionName) ifFalse:
- [| baseName diffyVersionName diffyVersion file delete |
- baseName := versionName allButLast: 4. "strip .mcz"
- diffyVersionName := cacheRepo directory fileNames detect: [:fn| (fn endsWith: '.mcd') and: [(fn copyUpTo: $() = baseName]].
- diffyVersion := cacheRepo versionNamed: diffyVersionName.
- file := cacheRepo directory newFileNamed: versionName.
- delete := false.
- [file binary.
- [MCMczWriter fileOut: diffyVersion on: file]
- on: Error
- do: [:ex|
- delete := true. "don't leave half-formed .mcz files around to screw things up later on..."
- ex pass]]
- ensure:
- [file close.
- delete ifTrue:
- [cacheRepo directory deleteFileNamed: versionName]].
- "now delete the damn diffy version that caused all the pain in the first place"
- delete ifFalse:
- [cacheRepo directory deleteFileNamed: diffyVersionName].
- cacheRepo flushCache; cacheAllFilenames].
- nonDiffyVersion := cacheRepo versionNamed: versionName.
- self assert: (nonDiffyVersion fileName endsWith: '.mcz').
- ^nonDiffyVersion!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>classDefinitionFor:type:from:comment:stamp: (in category 'private-accessing') -----
- classDefinitionFor: className type: typeSymbol from: definitions comment: commentString stamp: stampString
- | classDef |
- classDef := definitions
- detect: [:d| d isClassDefinition and: [d className = className]]
- ifNone:
- [self assert: (#(BoxedFloat64 SmallFloat64) includes: className).
- MCClassDefinition new
- initializeWithName: className
- superclassName: #Float
- traitComposition: '{}'
- classTraitComposition: '{}'
- category: 'Kernel-Numbers'
- instVarNames: #()
- classVarNames: #()
- poolDictionaryNames: #()
- classInstVarNames: #()
- type: typeSymbol
- comment: commentString asString
- commentStamp: stampString].
- className == #Character ifTrue:
- [classDef variables removeAllSuchThat:
- [:varDef|
- varDef isInstanceVariable and: [varDef name = 'value']]].
- classDef instVarNamed: 'type' put: typeSymbol.
- commentString ifNotNil:
- [classDef
- instVarNamed: 'comment' put: commentString;
- instVarNamed: 'commentStamp' put: stampString].
- ^MCAddition of: classDef!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>compiledMethodClassDefinition (in category 'private-accessing') -----
- compiledMethodClassDefinition
- ^MCAddition of:
- (MCClassDefinition new
- initializeWithName: #CompiledMethod
- superclassName: #ByteArray
- category: #'Kernel-Methods'
- instVarNames: #()
- classVarNames: #(LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame)
- poolDictionaryNames: #()
- classInstVarNames: #()
- type: #compiledMethod
- comment:
- 'CompiledMethod instances are methods suitable for interpretation by the virtual machine. Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray''s methods, not because a CompiledMethod is-a ByteArray.
-
- Class variables:
- SmallFrame - the number of stack slots in a small frame Context
- LargeFrame - the number of stack slots in a large frame Context
- PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set
- SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set
-
- The current format of a CompiledMethod is as follows:
-
- header (4 or 8 bytes, SmallInteger)
- literals (4 or 8 bytes each, Object, see "The last literal..." below)
- bytecodes (variable, bytes)
- trailer (variable, bytes)
-
- The header is a SmallInteger (which in the 32-bit system has 31 bits, and in the 64-bit system, 61 bits) in the following format:
-
- (index 0) 15 bits: number of literals (#numLiterals)
- (index 15) 1 bit: is optimized - reserved for methods that have been optimized by Sista
- (index 16) 1 bit: has primitive
- (index 17) 1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
- (index 18) 6 bits: number of temporary variables (#numTemps)
- (index 24) 4 bits: number of arguments to the method (#numArgs)
- (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
- sign bit: 1 bit: selects the instruction set, >= 0 Primary, < 0 Secondary (#signFlag)
-
- If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.
-
- The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method''s source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.
-
- The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in. The methodClassAssociation is used to implement super sends. If a method contains no super send then its methodClassAssociation may be nil (as would be the case for example of methods providing a pool of inst var accessors). By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState. AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method''s AdditionalMethodState. Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.'
- commentStamp: 'eem 1/22/2015 15:47')!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>directoryFrom: (in category 'initialization') -----
- directoryFrom: dirName
- ^FileDirectory on: (dirName first = $/
- ifTrue: [dirName]
- ifFalse: [(FileDirectory default directoryNamed: dirName) fullName])!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>download:from: (in category 'repository population') -----
- download: baseConfigurationOrArray "<MCConfiguration|Array>" from: repo
- | base |
- base := baseConfigurationOrArray isArray
- ifTrue: [MCConfiguration fromArray: baseConfigurationOrArray]
- ifFalse: [baseConfigurationOrArray].
- self packagesAndPatches keysAndValuesDo:
- [:package :patches| | dependency |
- dependency := base dependencies detect: [:dep| dep package name = package name].
- self downloadToSourceDirAllPackageVersionsStartingWith: dependency versionInfo
- from: repo].!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>downloadToSourceDirAllPackageVersionsStartingWith:from: (in category 'repository population') -----
- downloadToSourceDirAllPackageVersionsStartingWith: aMCVersionInfo from: repo
- | localRepo priorName |
- priorName := MCVersionName on: (aMCVersionInfo versionName
- copyReplaceAll: aMCVersionInfo versionNumber asString
- with: (aMCVersionInfo versionNumber - 1) asString).
- localRepo := MCDirectoryRepository directory: sourceDir.
- (repo possiblyNewerVersionsOfAnyOf: {priorName asMCVersionName}) do:
- [:newerVersion |
- (localRepo includesVersionNamed: newerVersion) ifFalse:
- [localRepo storeVersion: (repo versionNamed: newerVersion)]]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>filesForPackage:in: (in category 'private-accessing') -----
- filesForPackage: package in: aDirectory
- "Names sorted from lowest version to highest"
- ^((aDirectory fileNames
- select:
- [:fileName|
- (fileName beginsWith: package name)
- and: [(fileName at: package name size + 1) isLetter not
- and: [(fileName copyFrom: package name size + 2 to: package name size + 5) ~= 'spur']]]
- thenCollect: [:fn| {fn asMCVersionName versionNumber. fn}])
- sort: [:tuple :tupolev|
- tuple first < tupolev first
- or: [tuple first = tupolev first
- and: [tuple last < tupolev last]]])
- collect: [:tuple| tuple last]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>filteredDefinitionsAsPatches:patches: (in category 'private-accessing') -----
- filteredDefinitionsAsPatches: modifiedDefinitions patches: existingPatches
- ^modifiedDefinitions
- select:
- [:def|
- existingPatches noneSatisfy:
- [:addition|
- def isMethodDefinition
- and: [addition definition isMethodDefinition
- and: [addition definition selector = def selector
- and: [addition definition className = def className
- and: [addition definition classIsMeta = def classIsMeta]]]]]]
- thenCollect:
- [:def|
- ((def source includesSubString: 'DELETEME')
- ifTrue: [MCRemoval]
- ifFalse: [MCAddition]) of: def]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>findOldestConfigurationFor:inVersionNames:repository: (in category 'configurations') -----
- findOldestConfigurationFor: packageVersions inVersionNames: configurationVersionNames repository: repo
- | oldest |
- oldest := configurationVersionNames first.
- configurationVersionNames do:
- [:cfgver| | config |
- config := repo versionNamed: cfgver.
- (packageVersions noneSatisfy:
- [:pkgver| | configVersion |
- configVersion := config dependencies detect:
- [:dep|
- pkgver packageName = dep package name].
- configVersion versionInfo versionNumber >= pkgver versionNumber]) ifTrue:
- [^oldest].
- oldest := cfgver].
- self error: 'couldn''t find configuration newer than supplied versions'!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>from:to: (in category 'initialization') -----
- from: sourceDirName to: destDirName
- sourceDir := self directoryFrom: sourceDirName.
- destDir := self directoryFrom: destDirName!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>imageTypes: (in category 'initialization') -----
- imageTypes: typeArray
- imageTypes := typeArray!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedCharacterDefinitionsIn: (in category 'private-accessing') -----
- modifiedCharacterDefinitionsIn: definitions
- | rewriter |
- rewriter := RBParseTreeRewriter new.
- rewriter
- replace: 'value' with: 'self asInteger';
- replace: 'value := ``@args' with: 'DELETEME'.
- ^(((definitions select: [:d| d isMethodDefinition and: [d fullClassName = #Character]])
- collect: [:d| { d. self patchDefinition: d withRewriter: rewriter} ]
- thenSelect: [:pair| pair first source ~= pair second source])
- collect: [:pair| pair second])!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedFloatDefinitionsIn: (in category 'private-accessing') -----
- modifiedFloatDefinitionsIn: definitions
- "Delete the non-accessing primitives in Float (prims 41 through 59),
- and copy them to BoxedFloat64,
- and create corresponding ones in SmallFloat64 with primtiive numbers + 500."
- | floatPrims |
- floatPrims := definitions select:
- [:d| | index |
- d isMethodDefinition
- and: [d fullClassName = #Float
- and: [(index := d source indexOfSubCollection: '<primitive: ') > 0
- and: [(Integer readFrom: (ReadStream on: d source from: index + '<primitive: ' size to: index + '<primitive: ' size + 4))
- between: 41
- and: 59]]]].
- ^(floatPrims collect:
- [:d|
- MCMethodDefinition new
- initializeWithClassName: d className
- classIsMeta: false
- selector: d selector
- category: d category
- timeStamp: d timeStamp
- source: d source, 'DELETEME']),
- (floatPrims collect:
- [:d|
- MCMethodDefinition new
- initializeWithClassName: #BoxedFloat64
- classIsMeta: false
- selector: d selector
- category: d category
- timeStamp: d timeStamp
- source: d source]),
- (floatPrims collect:
- [:d|
- MCMethodDefinition new
- initializeWithClassName: #SmallFloat64
- classIsMeta: false
- selector: d selector
- category: d category
- timeStamp: 'eem 11/25/2014 07:54'
- source: (d source copyReplaceAll: '<primitive: ' with: '<primitive: 5')])!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>packageForMissingClassNamed: (in category 'accessing') -----
- packageForMissingClassNamed: className
- (className = #BoxedFloat64
- or: [className = #SmallFloat64]) ifTrue:
- [^PackageInfo named: 'Kernel'].
- self error: 'unknown missing class'!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>packages (in category 'private-accessing') -----
- packages
- "Answer the packages Spur modifies."
- ^self packagesAndPatches keys!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>packagesAndPatches (in category 'private-accessing') -----
- packagesAndPatches
- "SpurBootstrapMonticelloPackagePatcher new packagesAndPatches"
- | spurBootstrap |
- packagesAndPatches ifNotNil:
- [^packagesAndPatches].
- packagesAndPatches := Dictionary new.
- spurBootstrap := SpurBootstrap new.
- imageTypes ifNotNil:
- [spurBootstrap imageTypes: imageTypes].
- spurBootstrap prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method| | package category source definition |
- (Smalltalk classNamed: className)
- ifNil: [package := self packageForMissingClassNamed: className]
- ifNotNil:
- [:behavior| | class methodReference |
- class := isMeta ifTrue: [behavior class] ifFalse: [behavior].
- (class includesSelector: selector) ifTrue:
- [methodReference := (class >> selector) methodReference.
- category := methodReference category.
- category first = $* ifTrue:
- [category := nil]].
- package := (methodReference isNil
- or: [methodReference category = Categorizer default
- or: [methodReference category first = $*]]) "This for Scorch's override of InstructionClient>>classPrimitive:"
- ifTrue: [PackageOrganizer default packageOfClass: class]
- ifFalse: [PackageOrganizer default packageOfMethod: methodReference]].
- source := method getSourceFromFile asString allButFirst: method selector size - selector size.
- source first ~= selector first ifTrue:
- [source replaceFrom: 1 to: selector size with: selector startingAt: 1].
- definition := MCAddition of: (MCMethodDefinition new
- initializeWithClassName: className
- classIsMeta: isMeta
- selector: selector
- category: (category ifNil: [SpurBootstrap
- categoryForClass: className
- meta: isMeta
- selector: selector])
- timeStamp: method timeStamp
- source: source).
- (method pragmaAt: #remove) ifNotNil:
- [definition := definition inverse].
- (packagesAndPatches at: package ifAbsentPut: [OrderedCollection new])
- add: definition].
- ^packagesAndPatches!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patch (in category 'patching') -----
- patch
- "(SpurBootstrapMonticelloPackagePatcher new
- from: 'trunkpackages'
- to: 'spurpackages')
- patch"
- "(SpurBootstrapMonticelloPackagePatcher new
- from: '/Users/eliot/Squeak/Squeak4.5-spur/squeakv3-package-cache'
- to: '/Users/eliot/Squeak/Squeak4.5-spur/package-cache')
- patch"
- "(SpurBootstrapMonticelloPackagePatcher new
- from: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/squeak-package-cache'
- to: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/package-cache')
- patch"
-
- sourceDir exists ifFalse:
- [self error: 'source directory doest not exist'].
- destDir assureExistence.
- self packagesAndPatches keysAndValuesDo:
- [:package :patches|
- (self filesForPackage: package in: sourceDir) do:
- [:packageFile|
- self patchPackage: packageFile with: patches for: package]]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadAllInTrunk (in category 'patching') -----
- patchAndUploadAllInTrunk
- "Look for all versions in the default repository that have patched versions there-in.
- Download and patch them and upload the patched versions (overwriting the older ones)."
- "(SpurBootstrapMonticelloPackagePatcher new
- from: 'trunkpackages'
- to: 'spurpackages')
- patchAndUploadAllInTrunk"
- | seed trunk sourceRepo cacheRepo |
- seed := 'Are you really sure you want to do this?\It should happen only once!!' withCRs.
- 3 timesRepeat:
- [(UIManager confirm: seed) ifFalse: [^self].
- seed := seed copyReplaceAll: 'really ' with: 'really, really '].
- sourceDir assureExistence; deleteLocalFiles.
- destDir assureExistence; deleteLocalFiles.
- sourceRepo := MCDirectoryRepository directory: sourceDir.
- cacheRepo := MCCacheRepository default.
- (trunk := self trunk) cacheAllFileNamesDuring:
- [| latestBranches latestUnbranched |
- latestBranches := self packages collect:
- [:package|
- (trunk versionNamesForPackageNamed: package name, '.spur') detectMin: [:vn | vn asMCVersionName versionNumber]].
- latestUnbranched := latestBranches collect:
- [:verName|
- (trunk versionNamed: (verName copyReplaceAll: '.spur' with: '') asMCVersionName) info ancestors first versionName].
- ((trunk possiblyNewerVersionsOfAnyOf: latestUnbranched)
- reject: [:unpatched| unpatched includesSubString: '.spur'])
- do: [:unpatched|
- "it is claimed that whether a repository contains a .mcz or a .mcd is irrelevant. At least for the cache repository that's not true."
- sourceRepo storeVersion: (self cachedNonDiffyVersionNamed: unpatched from: trunk)].
- self patchAsNeeded.
- self uploadFrom: (MCDirectoryRepository directory: destDir) to: trunk]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadNewer (in category 'patching') -----
- patchAndUploadNewer
- "Look for unbranched versions on the default repository that are newer than the
- image''s versions. Download and patch them and upload the patched versions."
- "(SpurBootstrapMonticelloPackagePatcher new
- from: 'trunkpackages'
- to: 'spurpackages')
- patchAndUploadNewer"
- | repo sourceRepo |
- sourceDir deleteLocalFiles.
- destDir deleteLocalFiles.
- repo := self repositoryForUrl: MCMcmUpdater defaultUpdateURL.
- sourceRepo := MCDirectoryRepository directory: sourceDir.
- repo cacheAllFileNamesDuring:
- [self packages do:
- [:package| | workingCopy |
- workingCopy := MCWorkingCopy allManagers detect: [:pkg| pkg packageName = package packageName].
- (workingCopy possiblyNewerVersionsIn: repo) do:
- [:newerVersion|
- newerVersion packageAndBranchName = package packageName ifTrue: "Don't patch already patched packages!!!!"
- [(sourceRepo includesVersionNamed: newerVersion) ifFalse:
- [sourceRepo storeVersion: (repo versionNamed: newerVersion)]]]].
- self patchAsNeeded.
- self uploadFrom: (MCDirectoryRepository directory: destDir) to: repo]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadUnpatchedInTrunk (in category 'patching') -----
- patchAndUploadUnpatchedInTrunk
- "Look for unbranched versions in the default repository that are newer than the
- latest patched versions there-in. Download and patch them and upload the patched
- versions."
- "(SpurBootstrapMonticelloPackagePatcher new
- from: 'trunkpackages'
- to: 'spurpackages')
- patchAndUploadUnpatchedInTrunk"
- | trunk sourceRepo cacheRepo |
- sourceDir assureExistence; deleteLocalFiles.
- destDir assureExistence; deleteLocalFiles.
- sourceRepo := MCDirectoryRepository directory: sourceDir.
- cacheRepo := MCCacheRepository default.
- (trunk := self trunk) cacheAllFileNamesDuring:
- [| latestBranches latestUnbranched |
- latestBranches := self packages collect:
- [:package|
- (trunk versionNamesForPackageNamed: package name, '.spur') detectMax: [:vn | vn asMCVersionName versionNumber]]
- thenSelect: [:branch| branch notNil].
- latestUnbranched := latestBranches collect: [:verName| (verName copyReplaceAll: '.spur' with: '') asMCVersionName].
- ((trunk possiblyNewerVersionsOfAnyOf: latestUnbranched)
- reject: [:unpatched| unpatched includesSubString: '.spur'])
- do: [:unpatched|
- "it is claimed that whether a repository contains a .mcz or a .mcd is irrelevant. At least for the cache repositoriy that's not true."
- sourceRepo storeVersion: (self cachedNonDiffyVersionNamed: unpatched from: trunk)].
- self patchAsNeeded.
- self uploadFrom: (MCDirectoryRepository directory: destDir) to: trunk]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAsNeeded (in category 'patching') -----
- patchAsNeeded
- (sourceDir exists and: [destDir exists]) ifFalse:
- [self error: 'one or both of the directories don''t exist'].
- self packagesAndPatches keysAndValuesDo:
- [:package :patches|
- (self filesForPackage: package in: sourceDir) do:
- [:packageFile| | spurPackageFile |
- spurPackageFile := self spurBranchNameForInfo: packageFile package: package.
- ((destDir includesKey: packageFile) or: [destDir includesKey: spurPackageFile])
- ifTrue:
- [Transcript
- cr; nextPutAll: destDir fullName; nextPutAll: ' contains either ';
- nextPutAll: packageFile; nextPutAll: ' or '; nextPutAll: spurPackageFile;
- nextPutAll: '; not saving'; flush]
- ifFalse:
- [self patchPackage: packageFile with: patches for: package]]]
-
- "| patcher |
- patcher := SpurBootstrapMonticelloPackagePatcher new
- from: 'trunkpackages'
- to: 'spurpackages'.
- patcher trunk cacheAllFileNamesDuring:
- [patcher patchAsNeeded]"!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchDefinition:withRewriter: (in category 'patching') -----
- patchDefinition: aMCMethodDefinition withRewriter: aRBParseTreeRewriter
- | parseTree |
- parseTree := RBParser
- parseMethod: aMCMethodDefinition source
- onError: [:str :pos | self halt].
- aRBParseTreeRewriter executeTree: parseTree.
- ^MCMethodDefinition new
- initializeWithClassName: aMCMethodDefinition className
- classIsMeta:aMCMethodDefinition classIsMeta
- selector: aMCMethodDefinition selector
- category: aMCMethodDefinition category
- timeStamp: aMCMethodDefinition timeStamp
- source: aRBParseTreeRewriter tree newSource!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchFile: (in category 'patching') -----
- patchFile: packageFile
- "(SpurBootstrapMonticelloPackagePatcher new
- from: '/Users/eliot/oscogvm/image/package-cache'
- to: '/Users/eliot/oscogvm/image/spurpackages')
- patchFile: 'Collections-ul.573(nice.572).mcd'"
-
- sourceDir exists ifFalse:
- [self error: 'source directory doest not exist'].
- destDir assureExistence.
- self packagesAndPatches keysAndValuesDo:
- [:package :patches|
- ((packageFile beginsWith: package name)
- and: [(packageFile at: package name size + 1) isLetter not]) ifTrue:
- [self patchPackage: packageFile with: patches for: package]]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchPackage:with:for: (in category 'patching') -----
- patchPackage: packageFileName with: patches for: package
- | version newVersion |
- version := self versionFor: packageFileName in: sourceDir.
- newVersion := self version: version withPatches: patches for: package.
- self storeVersion: newVersion!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>patches:forSnapshot: (in category 'patching') -----
- patches: basePatches forSnapshot: snapshot
- "Add modified class defs for Character, SmallInteger, Float, BoxedFloat64, SmallFloat64 and COmpiledMethod.
- Remove ObjectHistory and ObjectHistoryMark (which Spur does not support)."
- | patches defs |
- patches := basePatches copy.
- defs := snapshot definitions.
- (defs anySatisfy: [:d| d isClassDefinition and: [d className == #Character]]) ifTrue:
- [patches
- addAll: (self filteredDefinitionsAsPatches: (self modifiedCharacterDefinitionsIn: snapshot definitions)
- patches: patches);
- add: (self
- classDefinitionFor: #Character
- type: #immediate
- from: snapshot definitions
- comment: 'I represent a character by storing its associated Unicode as an unsigned 30-bit value. Characters are created uniquely, so that all instances of a particular Unicode are identical. My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values.
-
- The code point is based on Unicode. Since Unicode is 21-bit wide character set, we have several bits available for other information. As the Unicode Standard states, a Unicode code point doesn''t carry the language information. This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean. Or often CJKV including Vietnamese). Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools. To utilize the extra available bits, we use them for identifying the languages. Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages.
-
- The other languages can have the language tag if you like. This will help to break the large default font (font set) into separately loadable chunk of fonts. However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.'
- stamp: 'eem 8/12/2014 14:53')].
- (defs anySatisfy: [:def| def isClassDefinition and: [def className == #SmallInteger]]) ifTrue:
- [patches
- add: (self
- classDefinitionFor: #SmallInteger
- type: #immediate
- from: snapshot definitions
- comment: 'My instances are at least 31-bit numbers, stored in twos complement form. The allowable range in 32-bits is approximately +- 10^9 (+- 1billion). In 64-bits my instances are 61-bit numbers, stored in twos complement form. The allowable range is approximately +- 10^18 (+- 1 quintillion). The actual values are computed at start-up. See SmallInteger class startUp:, minVal, maxVal.'
- stamp: 'eem 11/20/2014 08:41')].
- (defs anySatisfy: [:def| def isClassDefinition and: [def className == #Float]]) ifTrue:
- [patches
- add: (self
- classDefinitionFor: #Float
- type: #normal
- from: snapshot definitions
- comment: nil
- stamp: nil);
- add: (self
- classDefinitionFor: #BoxedFloat64
- type: #words
- from: snapshot definitions
- comment: 'My instances hold 64-bit Floats in heap objects. This is the only representation on 32-bit systems. But on 64-bit systems SmallFloat64 holds a subset of the full 64-bit double-precision range in immediate objects.'
- stamp: 'eem 11/25/2014 07:54');
- add: (self
- classDefinitionFor: #SmallFloat64
- type: #immediate
- from: snapshot definitions
- comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as immediate objects. This representation is only available on 64-bit systems, not 32-bit systems.'
- stamp: 'eem 11/25/2014 07:54');
- addAll: (self filteredDefinitionsAsPatches: (self modifiedFloatDefinitionsIn: snapshot definitions)
- patches: patches)].
- (defs anySatisfy: [:def| def isClassDefinition and: [def className == #CompiledMethod]]) ifTrue:
- [patches
- add: self compiledMethodClassDefinition].
- (defs anySatisfy: [:def| def isClassDefinition and: [def className == #ObjectHistory]]) ifTrue:
- [patches addAll:
- (defs
- select: [:def| #(ObjectHistory ObjectHistoryMark) includes: def className]
- thenCollect: [:def| MCRemoval of: def])].
- ^MCPatch operations: patches!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>repositoryForUrl: (in category 'repository population') -----
- repositoryForUrl: url
- ^MCRepositoryGroup default repositories
- detect: [:r| r description = url]
- ifNone: [MCHttpRepository
- location: url
- user: 'squeak'
- password: 'squeak']!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>spurBranchNameForInfo:package: (in category 'patching') -----
- spurBranchNameForInfo: versionInfoOrString package: package
- ^(versionInfoOrString isString
- ifTrue: [versionInfoOrString]
- ifFalse: [versionInfoOrString name]) copyReplaceAll: package name with: package name, '.spur'!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>spurConfigurationOf:forRepository: (in category 'configurations') -----
- spurConfigurationOf: anMCConfiguration forRepository: repo
- "Answer a copy of anMCConfiguration containing the matching Spur dependencies.
- If no replacements could be made (because no Spur versions exist) then answer nil."
- | found clone |
- found := false.
- clone := Array streamContents:
- [:s|
- s nextPut: #name; nextPut: (anMCConfiguration name copyReplaceAll: 'update-' with: 'update.spur-');
- "no location accessor!!!!"
- nextPut: #repository; nextPut: {anMCConfiguration repositories first locationWithTrailingSlash allButLast}.
- anMCConfiguration dependencies do:
- [:dep| | info pkg ver spurVersionName |
- info := dep versionInfo.
- ((pkg := self packages
- detect: [:package| package name = dep package name]
- ifNone: []) notNil
- and: [spurVersionName := (info name
- copyReplaceAll: pkg name
- with: pkg name, '.spur'), '.mcz'.
- (ver := MCCacheRepository default versionNamed: spurVersionName asMCVersionName) ifNil:
- [ver := repo versionNamed: spurVersionName asMCVersionName].
- ver notNil])
- ifTrue: [found := true. info := ver info].
- (ver isNil and: [spurVersionName notNil]) ifTrue:
- [Transcript nextPutAll: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name; cr; flush.
- self error: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name].
- s nextPut: #dependency; nextPut: (MCConfiguration dependencyToArray: (MCVersionDependency package: dep package info: info))]].
- ^found ifTrue:
- [MCConfiguration fromArray: clone]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>storeVersion: (in category 'patching') -----
- storeVersion: newVersion
- [(MCDirectoryRepository new directory: destDir) storeVersion: newVersion]
- on: FileExistsException
- do: [:ex| ex resume: (ex fileClass forceNewFileNamed: ex fileName)]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>trunk (in category 'repository population') -----
- trunk
- ^self repositoryForUrl: 'http://source.squeak.org/trunk'!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>uploadFrom:to: (in category 'repository population') -----
- uploadFrom: localRepo to: uploadRepository
- localRepo allVersionsDo:
- [:version|
- (uploadRepository includesVersionNamed: version info name) ifFalse:
- [uploadRepository storeVersion: version]]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>uploadNewerSpurConfigurationsInTrunk (in category 'configurations') -----
- uploadNewerSpurConfigurationsInTrunk
- "Make sure that update.spur configurations exist for all relevant update.* configurations."
- "SpurBootstrapMonticelloPackagePatcher new uploadNewerSpurConfigurationsInTrunk"
- | trunk |
- trunk := self trunk.
- trunk cacheAllFileNamesDuring:
- [| configurations spurConfigurations oldestUpdate |
- spurConfigurations := (trunk versionNamesForPackageNamed: 'update.spur') sort: [:a :b| a versionNumber > b versionNumber].
- configurations := ((trunk versionNamesForPackageNamed: 'update') select: [:n| n beginsWith: 'update-']) sort: [:a :b| a versionNumber > b versionNumber].
- oldestUpdate := spurConfigurations isEmpty
- ifTrue:
- [| earliestBranches earliestUnbranched |
- earliestBranches := self packages collect:
- [:package|
- (trunk versionNamesForPackageNamed: package name, '.spur') detectMin:
- [:vn | vn asMCVersionName versionNumber]].
- earliestUnbranched := earliestBranches collect:
- [:verName| (verName copyReplaceAll: '.spur' with: '') asMCVersionName].
- self
- findOldestConfigurationFor: earliestUnbranched
- inVersionNames: configurations
- repository: trunk]
- ifFalse:
- [spurConfigurations first copyReplaceAll: '.spur' with: ''].
- Transcript nextPutAll: 'Oldest: ', oldestUpdate; cr; flush.
- (configurations copyFrom: 1 to: (configurations indexOf: oldestUpdate) - 1) reverseDo:
- [:configName|
- "((configName beginsWith: 'update-eem.29') and: ['34' includes: (configName at: 14)]) ifTrue:
- [self halt]."
- (self spurConfigurationOf: (trunk versionNamed: configName) forRepository: trunk) ifNotNil:
- [:edition| trunk storeVersion: edition]]]!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>version:withPatches:for: (in category 'patching') -----
- version: version withPatches: patches for: package
- | snapshot ancestry possibleSpurAncestor actualAncestor |
- snapshot := MCPatcher
- apply: (self patches: patches forSnapshot: version snapshot)
- to: version snapshot.
- ancestry := MCWorkingAncestry new addAncestor: version info.
- "this is a hack; we may not be patching w.r.t. a directory or trunk"
- possibleSpurAncestor := (self spurBranchNameForInfo: version info ancestors first package: package) , '.mcz'.
- (destDir includesKey: possibleSpurAncestor)
- ifTrue:
- [actualAncestor := self versionFor: possibleSpurAncestor in: destDir]
- ifFalse:
- [((self trunk versionNamesForPackageNamed: package name) includes: possibleSpurAncestor) ifTrue:
- [actualAncestor := self trunk versionNamed: possibleSpurAncestor]].
- actualAncestor ifNotNil:
- [ancestry addAncestor: actualAncestor info].
- ^MCVersion
- package: version package
- info: (ancestry
- infoWithName: (self spurBranchNameForInfo: version info package: package)
- message: version info name,
- ' patched for Spur by ',
- (CCodeGenerator shortMonticelloDescriptionForClass: self class),
- '\\' withCRs,
- version info message)
- snapshot: snapshot
- dependencies: {} "punt on computing dependencies; there are't any so far"!
Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>versionFor:in: (in category 'patching') -----
- versionFor: packageFileName in: directory
- ^directory
- readOnlyFileNamed: packageFileName
- do: [:fs|
- ((MCVersionReader readerClassForFileNamed: fs fullName)
- on: fs fileName: fs fullName)
- version]!
Item was removed:
- Object subclass: #SpurBootstrapNewspeakFilePatcher
- instanceVariableNames: 'source substitutions'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>editTo: (in category 'patching') -----
- editTo: dest "<FileStream>"
- source reopen.
- [substitutions do:
- [:tuple|
- [:start :end :substitution|
- [source position + 1 < start] whileTrue:
- [dest nextPut: source next].
- dest nextPutAll: (substitution
- copyReplaceAll: (String with: Character cr)
- with: (String with: Character lf)).
- source skip: end - start + 1] valueWithArguments: tuple].
- dest nextPutAll: source upToEnd]
- ensure: [source close]!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>findClassDeclarationFor:in: (in category 'parsing') -----
- findClassDeclarationFor: className in: ast "<ClassDeclarationAST>" "^(ClassDeclarationAST|nil)"
- ^ast instanceSide nestedClasses
- detect: [:classDecl| classDecl name = className]
- ifNone: []!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>findMethodDeclarationFor:in: (in category 'parsing') -----
- findMethodDeclarationFor: selector "<Symbol>" in: ast "<ClassDeclarationAST>" "^(MethodAST|nil)"
- ast instanceSide categories do:
- [:categoryAST|
- categoryAST methods do:
- [:methodAST|
- methodAST pattern selector = selector ifTrue:
- [^methodAST]]].
- ^nil!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>initialize (in category 'initialize-release') -----
- initialize
- substitutions := SortedCollection sortBlock: [:tupleA :tupleB | tupleA first <= tupleB first]!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>newspeakSourceFor:selector: (in category 'patching') -----
- newspeakSourceFor: method "<CompiledMethod>" selector: selector "<Symbol>"
- | source startIndex nextIndex |
- source := method getSourceFromFile asString allButFirst: method selector size - selector size.
- source first ~= selector first ifTrue:
- [source replaceFrom: 1 to: selector size with: selector startingAt: 1].
-
- "map comments to Newspeak format..."
- startIndex := 1.
- [(startIndex := source indexOf: $" startingAt: startIndex) > 0] whileTrue:
- [nextIndex := source indexOf: $" startingAt: startIndex + 1.
- nextIndex < startIndex ifTrue:
- [self error: 'matching close comment not found'].
- source := source copyReplaceFrom: nextIndex to: nextIndex with: ' *)'.
- source := source copyReplaceFrom: startIndex to: startIndex with: '(* '.
- startIndex := nextIndex + 5].
-
- "map assignments to Newspeak format"
- startIndex := 1.
- [(startIndex := source indexOfSubCollection: ':=' startingAt: startIndex) > 0] whileTrue:
- [nextIndex := startIndex.
- [(source at: nextIndex - 1) isSeparator] whileTrue:
- [nextIndex := nextIndex - 1].
- source := source copyReplaceFrom: nextIndex to: startIndex + 1 with: '::'.
- startIndex := nextIndex + 1].
-
- "add the horror-show parentheses"
- startIndex := source indexOf: Character cr.
- source := source copyReplaceFrom: startIndex to: startIndex - 1 with: ' = ('.
- source := source, (String with: Character cr with: $) ).
- ^source!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>parse (in category 'parsing') -----
- parse
- | platform |
- platform := BlackMarket platform.
- ^[(NewspeakParsing
- usingPlatform: platform
- grammar: (NewspeakGrammar parserLib: (CombinatorialParsing usingPlatform: platform))
- asts: (NewspeakASTs usingLib: platform)) Parser new compilationUnit parse: source]
- ensure: [source close]!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>patch:inDirectory: (in category 'patching') -----
- patch: className inDirectory: dir
- "SpurBootstrapNewspeakFilePatcher new
- patch: 'KernelForSqueak'
- inDirectory: '../newspeak'"
- | directory |
- directory := FileDirectory default directoryNamed: dir.
- source := directory oldFileNamed: className, '.ns3'.
- self substitute: self parse.
- self editTo: (directory forceNewFileNamed: className, '.ns3.patched')!
Item was removed:
- ----- Method: SpurBootstrapNewspeakFilePatcher>>substitute: (in category 'patching') -----
- substitute: ast "<ClassDeclarationAST>"
-
- SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method| | source |
- method primitive = 0 ifTrue: "all primitives are in the VMMirror package"
- [(self findClassDeclarationFor: className in: ast) ifNotNil:
- [:classDecl|
- (self findMethodDeclarationFor: selector in: classDecl) ifNotNil:
- [:methodDecl|
- source := self newspeakSourceFor: method selector: selector.
- substitutions add: {methodDecl start. methodDecl end. source}]]]]!
Item was removed:
- SpurBootstrapPrototypes subclass: #SpurBootstrapPharoPrototypes
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes class>>imageType (in category 'accessing') -----
- imageType
- ^ 'pharo'!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPEbasicIdentityHash (in category 'method prototypes') -----
- BehaviorPROTOTYPEbasicIdentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- Behavior implements identityHash to allow the VM to use an object representation which
- does not include a direct reference to an object's class in an object. If the VM is using
- this implementation then classes are held in a class table and instances contain the index
- of their class in the table. A class's class table index is its identityHash so that an instance
- can be created without searching the table for a class's index. The VM uses this primitive
- to enter the class into the class table, assigning its identityHash with an as yet unused
- class table index. If this primitive fails it means that the class table is full. In Spur as of
- 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
-
- Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
-
- <primitive: 175>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes') -----
- BehaviorPROTOTYPElargeIdentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- Behavior implements identityHash to allow the VM to use an object representation which
- does not include a direct reference to an object's class in an object. If the VM is using
- this implementation then classes are held in a class table and instances contain the index
- of their class in the table. A class's class table index is its identityHash so that an instance
- can be created without searching the table for a class's index. The VM uses this primitive
- to enter the class into the class table, assigning its identityHash with an as yet unused
- class table index. If this primitive fails it means that the class table is full. In Spur as of
- 2014 there are 22 bits of classTable index and 22 bits of identityHash per object."
-
- <primitive: 175>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>BlockClosurePHAROPROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
- BlockClosurePHAROPROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEcodePoint (in category 'method prototypes') -----
- CharacterPROTOTYPEcodePoint
- "Just for ANSI Compliance"
- ^self asciiValue!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
- CharacterPROTOTYPEsetValue: newValue
- self error: 'Characters are immutable'!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
- CharacterPROTOTYPEshallowCopy
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
- ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
- ContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
- ContextPROTOTYPEisPrimFailToken: anObject
- <indirect>
- !
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEobjectClass: (in category 'method prototypes') -----
- ContextPROTOTYPEobjectClass: aReceiver
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
- ContextPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
- "Simulate the action of sending a message with selector and arguments
- to rcvr. The argument, lookupClass, is the class in which to lookup the
- message. This is the receiver's class for normal messages, but for super
- messages it will be some specific class related to the source method."
-
- | meth primIndex val ctxt |
- (meth := lookupClass lookupSelector: selector) ifNil:
- [^self send: #doesNotUnderstand:
- to: rcvr
- with: {Message selector: selector arguments: arguments}
- lookupIn: lookupClass].
- (primIndex := meth primitive) > 0 ifTrue:
- [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
- (self isPrimFailToken: val) ifFalse:
- [^val]].
- (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ', arguments first selector, ' not understood'].
- ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments.
- primIndex > 0 ifTrue:
- [ctxt failPrimitiveWith: val].
- ^ctxt!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
- ContextclassPROTOTYPEallInstances
- "Answer all instances of the receiver."
- <primitive: 177>
- "The primitive can fail because memory is low. If so, fall back on the old
- enumeration code, which gives the system a chance to GC and/or grow.
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst.
- Only count until thisContext since this context has been created only to
- compute the existing instances."
- | inst insts next |
- insts := WriteStream on: (Array new: 64).
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- insts nextPut: inst.
- inst := next].
- ^insts contents!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
- ContextclassPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- | instances inst next |
- instances := self allInstancesOrNil.
- instances ifNotNil:
- [instances do: aBlock.
- ^self].
- "allInstancesOrNil can fail because memory is low. If so, fall back on the old
- enumeration code. Because aBlock might change the class of inst (for example,
- using become:), it is essential to compute next before aBlock value: inst.
- Only count until thisContext since evaluation of aBlock will create new contexts."
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes') -----
- ProtoObjectPROTOTYPEidentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- This method must not be overridden, except by SmallInteger. As of
- 2014, the 32-bit Spur VM has 22 bits of hash and 31-bit SmallIntegers
- (30 bits + 1 sign bit). Shifting by 8 will not create large integers.
-
- Do not override."
-
- ^self basicIdentityHash bitShift: 8!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
- SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
- "Compute the new format for making oldClass a subclass of newSuper.
- Answer the format or nil if there is any problem."
- | instSize isVar isWords isPointers isWeak |
- type == #compiledMethod ifTrue:
- [newInstSize > 0 ifTrue:
- [self error: 'A compiled method class cannot have named instance variables'.
- ^nil].
- ^CompiledMethod format].
- instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- instSize > 65535 ifTrue:
- [self error: 'Class has too many instance variables (', instSize printString,')'.
- ^nil].
- type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
- type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
- type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
- type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
- type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
- type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
- type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
- (isPointers not and: [instSize > 0]) ifTrue:
- [self error: 'A non-pointer class cannot have named instance variables'.
- ^nil].
- ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
- SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = reserved for 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := isWeak
- ifTrue:
- [isVar
- ifTrue: [4]
- ifFalse: [5]]
- ifFalse:
- [isPointers
- ifTrue:
- [isVar
- ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
- ifFalse:
- [isVar
- ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
- ifFalse: [7]]].
- ^(instSpec bitShift: 16) + nInstVars!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
- SlotClassBuilderPROTOTYPEsuperclass: aClass
- immediateSubclass: t instanceVariableNames: f
- classVariableNames: d poolDictionaries: s category: cat
- "This is the standard initialization message for creating a
- new immediate class as a subclass of an existing class."
- | env |
- aClass instSize > 0
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
- aClass isVariable
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
- aClass isPointers
- ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
- "Cope with pre-environment and environment versions. Simplify asap."
- env := (Smalltalk classNamed: #EnvironmentRequest)
- ifNil: [aClass environment]
- ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
- ^self
- name: t
- inEnvironment: env
- subclassOf: aClass
- type: #immediate
- instanceVariableNames: f
- classVariableNames: d
- poolDictionaries: s
- category: cat!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
- SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass
- "Convert oldClass, all its instances and possibly its meta class into newClass,
- instances of newClass and possibly its meta class. The process is surprisingly
- simple in its implementation and surprisingly complex in its nuances and potentially
- bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to
- 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
- a become of the old vs. the new instances and therefore it will not create
- pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that
- nobody can get a hold by 'other means' (such as process interruption and
- reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointers
- to any old instances. After the forwarding become there will be no pointers to the old
- class or meta class either.
- Andreas Raab, 2/27/2003 23:42"
- | meta |
- meta := oldClass isMeta.
- "Note: Everything from here on will run without the ability to get interrupted
- to prevent any other process to create new instances of the old class."
- ["Note: The following removal may look somewhat obscure and needs an explanation.
- When we mutate the class hierarchy we create new classes for any existing subclass.
- So it may look as if we don't have to remove the old class from its superclass. However,
- at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
- created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
- subclasses. Since the #become: below will transparently replace the pointers to oldClass
- with newClass the superclass would have newClass in its subclasses TWICE. With rather
- unclear effects if we consider that we may convert the meta-class hierarchy itself (which
- is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting
- them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
- effectively remove the oldClass (becomeForward:) just a few lines below."
-
- oldClass superclass removeSubclass: oldClass.
- oldClass superclass removeObsoleteSubclass: oldClass.
-
- "make sure that the VM cache is clean"
- oldClass methodDict do: [:cm | cm flushCache].
-
- "Convert the instances of oldClass into instances of newClass"
- newClass updateInstancesFrom: oldClass.
-
- meta
- ifTrue:
- [oldClass becomeForward: newClass.
- oldClass updateMethodBindingsTo: oldClass binding]
- ifFalse:
- [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
- oldClass updateMethodBindingsTo: oldClass binding.
- oldClass class updateMethodBindingsTo: oldClass class binding].
-
- "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
- to ensure no old instances existed after the becomeForward:. Without the GC it was possible
- to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
- updated references from the old objects to new objects but didn't destroy the old objects.
- But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
- valueUnpreemptively!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>SmalltalkImagePROTOTYPEnewSpecialObjectsArray (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEnewSpecialObjectsArray
- "Smalltalk recreateSpecialObjectsArray"
-
- "To external package developers:
- **** DO NOT OVERRIDE THIS METHOD. *****
- If you are writing a plugin and need additional special object(s) for your own use,
- use addGCRoot() function and use own, separate special objects registry "
-
- "The Special Objects Array is an array of objects used by the Squeak virtual machine.
- Its contents are critical and accesses to it by the VM are unchecked, so don't even
- think of playing here unless you know what you are doing."
- | newArray |
- newArray := Array new: 60.
- "Nil false and true get used throughout the interpreter"
- newArray at: 1 put: nil.
- newArray at: 2 put: false.
- newArray at: 3 put: true.
- "This association holds the active process (a ProcessScheduler)"
- newArray at: 4 put: (self globals associationAt: #Processor).
- "Numerous classes below used for type checking and instantiation"
- newArray at: 5 put: Bitmap.
- newArray at: 6 put: SmallInteger.
- newArray at: 7 put: ByteString.
- newArray at: 8 put: Array.
- newArray at: 9 put: Smalltalk.
- newArray at: 10 put: Float.
- newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
- newArray at: 12 put: nil. "was BlockContext."
- newArray at: 13 put: Point.
- newArray at: 14 put: LargePositiveInteger.
- newArray at: 15 put: Display.
- newArray at: 16 put: Message.
- newArray at: 17 put: CompiledMethod.
- newArray at: 18 put: ((self primitiveGetSpecialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 19 put: Semaphore.
- newArray at: 20 put: Character.
- newArray at: 21 put: #doesNotUnderstand:.
- newArray at: 22 put: #cannotReturn:.
- newArray at: 23 put: nil. "This is the process signalling low space."
- "An array of the 32 selectors that are compiled as special bytecodes,
- paired alternately with the number of arguments each takes."
- newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
- #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
- #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
- #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
- "An array of the 255 Characters in ascii order.
- Cog inlines table into machine code at: prim so do not regenerate it.
- This is nil in Spur, which has immediate Characters."
- newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25).
- newArray at: 26 put: #mustBeBoolean.
- newArray at: 27 put: ByteArray.
- newArray at: 28 put: Process.
- "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- newArray at: 29 put: self compactClassesArray.
- newArray at: 30 put: ((self primitiveGetSpecialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
- newArray at: 31 put: ((self primitiveGetSpecialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
- newArray at: 32 put: nil. "was the prototype Float"
- newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
- newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 35 put: #cannotInterpret:.
- newArray at: 36 put: nil. "was the prototype MethodContext"
- newArray at: 37 put: BlockClosure.
- newArray at: 38 put: nil. "was the prototype BlockContext"
- "array of objects referred to by external code"
- newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39). "external semaphores"
- newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
- newArray at: 41 put: ((self primitiveGetSpecialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
- newArray at: 42 put: ((self primitiveGetSpecialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 43 put: LargeNegativeInteger.
- "External objects for callout.
- Note: Written so that one can actually completely remove the FFI."
- newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
- newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
- newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
- newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
- newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
- newArray at: 49 put: #aboutToReturn:through:.
- newArray at: 50 put: #run:with:in:.
- "51 reserved for immutability message"
- newArray at: 51 put: #attemptToAssign:withIndex:.
- newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
- #'bad argument' #'bad index'
- #'bad number of arguments'
- #'inappropriate operation' #'unsupported operation'
- #'no modification' #'insufficient object memory'
- #'insufficient C memory' #'not found' #'bad method'
- #'internal error in named primitive machinery'
- #'object may move' #'resource limit exceeded'
- #'object is pinned' #'primitive write beyond end of object').
- "53 to 55 are for Alien"
- newArray at: 53 put: (self at: #Alien ifAbsent: []).
- newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
-
- "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
- newArray at: 56 put: nil.
-
- "reserved for foreign callback process"
- newArray at: 57 put: (self primitiveGetSpecialObjectsArray at: 57 ifAbsent: []).
-
- newArray at: 58 put: #unusedBytecode.
- "59 reserved for Sista counter tripped message"
- newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
- "60 reserved for Sista class trap message"
- newArray at: 60 put: #classTrapFor:.
-
- ^newArray!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEallInstances
- "Answer all instances of the receiver."
- self error: 'Traits does not have instances.'!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- self error: 'Traits does not have instances.'!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEinstSpec
- "Answer the instance specification part of the format that defines what kind of object
- an instance of the receiver is. The formats are
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^(self format bitShift: -16) bitAnd: 16r1F!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEisBits
- "Answer whether the receiver contains just bits (not pointers).
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 7!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEisBytes
- "Answer whether the receiver has 8-bit instance variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 16!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEisEphemeronClass
- "Answer whether the receiver has ephemeral instance variables. The garbage collector will
- fire (queue for finalization) any ephemeron whose first instance variable is not referenced
- other than from the transitive closure of references from ephemerons. Hence referring to
- an object from the first inst var of an ephemeron will cause the ephemeron to fire when
- the rest of the system does not refer to the object and that object is ready to be collected.
- Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
- from firing, ephemerons may act as the associations in weak dictionaries such that the value
- (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
- other than from ephemerons. Ephemerons can therefore be used to implement instance-based
- pre-mortem finalization."
- ^self instSpec = 5!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEisImmediateClass
- "Answer whether the receiver has immediate instances. Immediate instances
- store their value in their object pointer, not in an object body. Hence immediates
- take no space and are immutable. The immediates are distinguished by tag bits
- in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
- system SmallIntegers are 31-bit signed integers and Characters are 30-bit
- unsigned character codes."
- ^self instSpec = 7!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEisVariable
- "Answer whether the receiver has indexable variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := self instSpec.
- ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
- TraitBehaviorPROTOTYPEkindOfSubclass
- "Answer a String that is the keyword that describes the receiver's kind of subclass,
- either a regular subclass, a variableSubclass, a variableByteSubclass,
- a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
- c.f. typeOfClass"
- ^self isVariable
- ifTrue:
- [self isBits
- ifTrue:
- [self isBytes
- ifTrue: [' variableByteSubclass: ']
- ifFalse: [' variableWordSubclass: ']]
- ifFalse:
- [self isWeak
- ifTrue: [' weakSubclass: ']
- ifFalse: [' variableSubclass: ']]]
- ifFalse:
- [self isImmediateClass
- ifTrue: [' immediateSubclass: ']
- ifFalse:
- [self isEphemeronClass
- ifTrue: [' ephemeronSubclass: ']
- ifFalse: [' subclass: ']]]!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEisSpur (in category 'method prototypes') -----
- VirtualMachinePROTOTYPEisSpur
- "this value is always true but is here for backward compatibility (non Spur images should return false)"
- ^ true!
Item was removed:
- ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes') -----
- VirtualMachinePROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
-
- | proportion edenSize survivorSize averageObjectSize numObjects |
- proportion := 0.9. "tenure when 90% of pastSpace is full"
- edenSize := self parameterAt: 44.
- survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- averageObjectSize := 8 * self wordSize. "a good approximation"
- numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- self tenuringThreshold: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- Object subclass: #SpurBootstrapPrototypes
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrapPrototypes class>>allMethodPrototypes (in category 'accessing method dictionary') -----
- allMethodPrototypes
- ^(self canUnderstand: #allMethods)
- ifTrue: "Pharo"
- [self allMethods select:
- [:each| each category = 'method prototypes']]
- ifFalse: "Squeak" "%$#@*!! collect: on IdentitySet answers a *Set*, not an IdentitySet %$#@*!!"
- [(self allSelectors collect: [:s| self lookupSelector: s] as: IdentitySet)
- select: [:m| m protocol = 'method prototypes']]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes class>>imageType (in category 'accessing') -----
- imageType
- ^ self subclassResponsibility!
Item was removed:
- ----- Method: SpurBootstrapPrototypes class>>prototypeClassFor: (in category 'instance creation') -----
- prototypeClassFor: type
- | deepest |
- deepest := nil.
- self allSubclassesDo:
- [:aClass | aClass imageType = type ifTrue: [deepest := aClass]].
- ^deepest!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ArrayPROTOTYPEelementsExchangeIdentityWith: (in category 'method prototypes') -----
- ArrayPROTOTYPEelementsExchangeIdentityWith: otherArray
- "This primitive performs a bulk mutation, causing all pointers to the elements of the
- receiver to be replaced by pointers to the corresponding elements of otherArray.
- At the same time, all pointers to the elements of otherArray are replaced by
- pointers to the corresponding elements of this array. The identityHashes remain
- with the pointers rather than with the objects so that objects in hashed structures
- should still be properly indexed after the mutation."
-
- <primitive: 128 error: ec>
- ec == #'bad receiver' ifTrue:
- [^self error: 'receiver must be of class Array'].
- ec == #'bad argument' ifTrue:
- [^self error: (otherArray class == Array
- ifTrue: ['arg must be of class Array']
- ifFalse: ['receiver and argument must have the same size'])].
- ec == #'inappropriate operation' ifTrue:
- [^self error: 'can''t become immediates such as SmallIntegers or Characters'].
- ec == #'no modification' ifTrue:
- [^self error: 'can''t become immutable objects'].
- ec == #'object is pinned' ifTrue:
- [^self error: 'can''t become pinned objects'].
- ec == #'insufficient object memory' ifTrue:
- [Smalltalk garbageCollect < 1048576 ifTrue:
- [Smalltalk growMemoryByAtLeast: 1048576].
- ^self elementsExchangeIdentityWith: otherArray].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ArrayPROTOTYPEelementsForwardIdentityTo: (in category 'method prototypes') -----
- ArrayPROTOTYPEelementsForwardIdentityTo: otherArray
- "This primitive performs a bulk mutation, causing all pointers to the elements of the
- receiver to be replaced by pointers to the corresponding elements of otherArray.
- The identityHashes remain with the pointers rather than with the objects so that
- the objects in this array should still be properly indexed in any existing hashed
- structures after the mutation."
- <primitive: 72 error: ec>
- ec == #'bad receiver' ifTrue:
- [^self error: 'receiver must be of class Array'].
- ec == #'bad argument' ifTrue:
- [^self error: (otherArray class == Array
- ifTrue: ['arg must be of class Array']
- ifFalse: ['receiver and argument must have the same size'])].
- ec == #'inappropriate operation' ifTrue:
- [^self error: 'can''t become immediates such as SmallIntegers or Characters'].
- ec == #'no modification' ifTrue:
- [^self error: 'can''t become immutable objects'].
- ec == #'object is pinned' ifTrue:
- [^self error: 'can''t become pinned objects'].
- ec == #'insufficient object memory' ifTrue:
- [Smalltalk garbageCollect < 1048576 ifTrue:
- [Smalltalk growMemoryByAtLeast: 1048576].
- ^self elementsForwardIdentityTo: otherArray].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ArrayPROTOTYPEelementsForwardIdentityTo:copyHash: (in category 'method prototypes') -----
- ArrayPROTOTYPEelementsForwardIdentityTo: otherArray copyHash: copyHash
- "This primitive performs a bulk mutation, causing all pointers to the elements of the
- receiver to be replaced by pointers to the corresponding elements of otherArray.
- If copyHash is true, the identityHashes remain with the pointers rather than with the
- objects so that the objects in the receiver should still be properly indexed in any
- existing hashed structures after the mutation. If copyHash is false, then the hashes
- of the objects in otherArray remain unchanged. If you know what you're doing this
- may indeed be what you want."
- <primitive: 249 error: ec>
- ec == #'bad receiver' ifTrue:
- [^self error: 'receiver must be of class Array'].
- ec == #'bad argument' ifTrue:
- [^self error: (otherArray class == Array
- ifTrue: ['arg must be of class Array']
- ifFalse: ['receiver and argument must have the same size'])].
- ec == #'inappropriate operation' ifTrue:
- [^self error: 'can''t become immediates such as SmallIntegers or Characters'].
- ec == #'no modification' ifTrue:
- [^self error: 'can''t become immutable objects'].
- ec == #'object is pinned' ifTrue:
- [^self error: 'can''t become pinned objects'].
- ec == #'insufficient object memory' ifTrue:
- [Smalltalk garbageCollect < 1048576 ifTrue:
- [Smalltalk growMemoryByAtLeast: 1048576].
- ^self elementsForwardIdentityTo: otherArray copyHash: copyHash].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstances
- "Answer all instances of the receiver."
- <primitive: 177>
- "The primitive can fail because memory is low. If so, fall back on the old
- enumeration code, which gives the system a chance to GC and/or grow.
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst."
- | inst insts next |
- insts := WriteStream on: (Array new: 64).
- inst := self someInstance.
- [inst == nil] whileFalse:
- [next := inst nextInstance.
- (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
- inst := next].
- ^insts contents!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- | instances inst next |
- instances := self allInstancesOrNil.
- instances ifNotNil:
- [instances do: aBlock.
- ^self].
- "allInstancesOrNil can fail because memory is low. If so, fall back on the old
- enumeration code. Because aBlock might change the class of inst (for example,
- using become:), it is essential to compute next before aBlock value: inst."
- inst := self someInstance.
- [inst == nil] whileFalse:
- [next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesOrNil (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstancesOrNil
- "Answer all instances of the receiver, or nil if the primitive
- fails, which it may be due to being out of memory."
- <primitive: 177>
- ^nil!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEbasicNew
- "Primitive. Answer an instance of the receiver (which is a class) with no
- indexable variables. Fail if the class is indexable. Essential. See Object
- documentation whatIsAPrimitive.
-
- If the primitive fails because space is low then the scavenger will run
- before the method is activated. Check that space was low and retry
- via handleFailingBasicNew if so."
-
- <primitive: 70 error: ec>
- ec == #'insufficient object memory' ifTrue:
- [^self handleFailingBasicNew].
- self isVariable ifTrue: [^self basicNew: 0].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEbasicNew: sizeRequested
- "Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive.
-
- If the primitive fails because space is low then the scavenger will run before the
- method is activated. Check args and retry via handleFailingBasicNew: if they're OK."
-
- <primitive: 71 error: ec>
- ec == #'insufficient object memory' ifTrue:
- [^self handleFailingBasicNew: sizeRequested].
- self isVariable ifFalse:
- [self error: self printString, ' cannot have variable sized instances'].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstance (in category 'method prototypes') -----
- BehaviorPROTOTYPEbyteSizeOfInstance
- "Answer the total memory size of an instance of the receiver."
-
- <primitive: 181 error: ec>
- self isVariable ifTrue:
- [^self byteSizeOfInstanceOfSize: 0].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: (in category 'method prototypes') -----
- BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: basicSize
- "Answer the total memory size of an instance of the receiver
- with the given number of indexable instance variables."
-
- <primitive: 181 error: ec>
- self isVariable
- ifTrue: "If the primitive overflowed answer a close approximation"
- [(basicSize isInteger
- and: [basicSize >= 16r1000000]) ifTrue:
- [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
- - (self byteSizeOfInstanceOfSize: 0)]]
- ifFalse:
- [basicSize = 0 ifTrue:
- [^self byteSizeOfInstance]].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') -----
- BehaviorPROTOTYPEelementSize
- "Answer the size in bytes of an element in the receiver. The formats are
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := self instSpec.
- instSpec < 9 ifTrue: [^Smalltalk wordSize].
- instSpec >= 16 ifTrue: [^1].
- instSpec >= 12 ifTrue: [^2].
- instSpec >= 10 ifTrue: [^4].
- ^8!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingBasicNew
- "handleFailingBasicNew gets sent after basicNew has failed and allowed
- a scavenging garbage collection to occur. The scavenging collection
- will have happened as the VM is activating the (failing) basicNew. If
- handleFailingBasicNew fails then the scavenge failed to reclaim sufficient
- space and a global garbage collection is required. Retry after garbage
- collecting and growing memory if necessary.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 70>
- Smalltalk garbageCollect < 1048576 ifTrue:
- [Smalltalk growMemoryByAtLeast: 1048576].
- ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingBasicNew: sizeRequested
- "handleFailingBasicNew: gets sent after basicNew: has failed and allowed
- a scavenging garbage collection to occur. The scavenging collection
- will have happened as the VM is activating the (failing) basicNew:. If
- handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- space and a global garbage collection is required. Retry after garbage
- collecting and growing memory if necessary.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 71>
- | bytesRequested |
- bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
- Smalltalk garbageCollect < bytesRequested ifTrue:
- [Smalltalk growMemoryByAtLeast: bytesRequested].
- "retry after global garbage collect and possible grow"
- ^self handleFailingFailingBasicNew: sizeRequested!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingFailingBasicNew
- "This basicNew gets sent after handleFailingBasicNew: has done a full
- garbage collection and possibly grown memory. If this basicNew fails
- then the system really is low on space, so raise the OutOfMemory signal.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 70>
- "space must be low"
- OutOfMemory signal.
- ^self basicNew "retry if user proceeds"!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingFailingBasicNew: sizeRequested
- "This basicNew: gets sent after handleFailingBasicNew: has done a full
- garbage collection and possibly grown memory. If this basicNew: fails
- then the system really is low on space, so raise the OutOfMemory signal.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 71>
- "space must be low."
- OutOfMemory signal.
- ^self basicNew: sizeRequested "retry if user proceeds"!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEindexIfCompact (in category 'method prototypes') -----
- BehaviorPROTOTYPEindexIfCompact
- "Backward compatibility with the Squeak V3 object format.
- Spur does not have a distinction between compact and non-compact classes."
- ^0!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSize (in category 'method prototypes') -----
- BehaviorPROTOTYPEinstSize
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
- BehaviorPROTOTYPEinstSpec
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBits (in category 'method prototypes') -----
- BehaviorPROTOTYPEisBits
- "Answer whether the receiver contains just bits (not pointers).
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 7!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
- BehaviorPROTOTYPEisBytes
- "Answer whether the receiver has 8-bit instance variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 16!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisCompiledMethodClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEisCompiledMethodClass
- "Answer whether the receiver has compiled method instances that mix pointers and bytes."
- ^self instSpec >= 24!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEisEphemeronClass
- "Answer whether the receiver has ephemeral instance variables. The garbage collector will
- fire (queue for finalization) any ephemeron whose first instance variable is not referenced
- other than from the transitive closure of references from ephemerons. Hence referring to
- an object from the first inst var of an ephemeron will cause the ephemeron to fire when
- the rest of the system does not refer to the object and that object is ready to be collected.
- Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
- from firing, ephemerons may act as the associations in weak dictionaries such that the value
- (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
- other than from ephemerons. Ephemerons can therefore be used to implement instance-based
- pre-mortem finalization."
- ^self instSpec = 5!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEisImmediateClass
- "Answer whether the receiver has immediate instances. Immediate instances
- store their value in their object pointer, not in an object body. Hence immediates
- take no space and are immutable. The immediates are distinguished by tag bits
- in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
- system SmallIntegers are 31-bit signed integers and Characters are 30-bit
- unsigned character codes."
- ^self instSpec = 7!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
- BehaviorPROTOTYPEisVariable
- "Answer whether the receiver has indexable variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := self instSpec.
- ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
- BehaviorPROTOTYPEkindOfSubclass
- "Answer a String that is the keyword that describes the receiver's kind of subclass,
- either a regular subclass, a variableSubclass, a variableByteSubclass,
- a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
- c.f. typeOfClass"
- ^self isVariable
- ifTrue:
- [self isBits
- ifTrue:
- [self isBytes
- ifTrue: [' variableByteSubclass: ']
- ifFalse: [' variableWordSubclass: ']]
- ifFalse:
- [self isWeak
- ifTrue: [' weakSubclass: ']
- ifFalse: [' variableSubclass: ']]]
- ifFalse:
- [self isImmediateClass
- ifTrue: [' immediateSubclass: ']
- ifFalse:
- [self isEphemeronClass
- ifTrue: [' ephemeronSubclass: ']
- ifFalse: [' subclass: ']]]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEshouldNotBeRedefined (in category 'method prototypes') -----
- BehaviorPROTOTYPEshouldNotBeRedefined
- "Answer if the receiver should not be redefined.
- The assumption is that classes in Smalltalk specialObjects and
- instance-specific Behaviors should not be redefined"
-
- ^(Smalltalk specialObjectsArray
- identityIndexOf: self
- ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEtypeOfClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEtypeOfClass
- "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
- self isBytes ifTrue:
- [^self instSpec = CompiledMethod instSpec
- ifTrue: [#compiledMethod] "Very special!!"
- ifFalse: [#bytes]].
- (self isWords and: [self isPointers not]) ifTrue:
- [^self instSpec = SmallInteger instSpec
- ifTrue: [#immediate] "Very special!!"
- ifFalse: [#words]].
- self isWeak ifTrue: [^#weak].
- self isVariable ifTrue: [^#variable].
- self isEphemeronClass ifTrue: [^#ephemeron].
- ^#normal!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BoxedFloat64classPROTOTYPEbasicNew (in category 'method prototypes') -----
- BoxedFloat64classPROTOTYPEbasicNew
- ^self basicNew: 2!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BoxedFloat64classPROTOTYPEbasicNew: (in category 'method prototypes') -----
- BoxedFloat64classPROTOTYPEbasicNew: sizeRequested
- "Primitive. Answer an instance of this class with the number
- of indexable variables specified by the argument, sizeRequested.
- Fail if this class is not indexable or if the argument is not a
- positive Integer, or if there is not enough memory available.
- Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 71>
- sizeRequested isInteger ifTrue:
- [^sizeRequested = 2
- ifTrue: "arg okay; space must be low."
- [OutOfMemory signal.
- self basicNew: sizeRequested] "retry if user proceeds"
- ifFalse:
- [self error: 'a Float shall always have two slots']].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
- BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
- numArgs > 15 ifTrue:
- [^self error: 'Cannot compile -- too many arguments'].
- numTemps > 63 ifTrue:
- [^self error: 'Cannot compile -- too many temporary variables'].
- numLits > 65535 ifTrue:
- [^self error: 'Cannot compile -- too many literals'].
- ^(CompiledMethod headerFlagForEncoder: self)
- + (numArgs bitShift: 24)
- + (numTemps bitShift: 18)
- "+ (largeBit bitShift: 17)" "largeBit gets filled in later"
- + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- + numLits!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
- BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
- ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEDollarEquals: (in category 'method prototypes') -----
- CharacterPROTOTYPEDollarEquals: aCharacter
- "Primitive. Answer if the receiver and the argument are the
- same object (have the same object pointer). Optional. See
- Object documentation whatIsAPrimitive."
- <primitive: 110>
- ^self == aCharacter!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
- CharacterPROTOTYPEasInteger
- "Answer the receiver's character code."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') -----
- CharacterPROTOTYPEasciiValue
- "Answer the receiver's character code.
- This will be ascii for characters with value <= 127,
- and Unicode for those with higher values."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcomeFullyUpOnReload: (in category 'method prototypes') -----
- CharacterPROTOTYPEcomeFullyUpOnReload: smartRefStream
- "Now Characters are immediates, this can be deleted."
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
- CharacterPROTOTYPEcopy
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
- CharacterPROTOTYPEdeepCopy
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEhash (in category 'method prototypes') -----
- CharacterPROTOTYPEhash
- "Hash is reimplemented because = is implemented.
- Answer the receiver's character code."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
- CharacterPROTOTYPEidentityHash
- "Answer the receiver's character code."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
- CharacterPROTOTYPEshallowCopy
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
- CharacterPROTOTYPEveryDeepCopyWith: deepCopier
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') -----
- CharacterclassPROTOTYPEdigitValue: x
- "Answer the Character whose digit value is x. For example,
- answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35."
-
- | n |
- n := x asInteger.
- ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
- CharacterclassPROTOTYPEinitialize
- "Create the DigitsValues table."
- "Character initialize"
- self initializeDigitValues!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') -----
- CharacterclassPROTOTYPEvalue: anInteger
- "Answer the Character whose value is anInteger."
- <primitive: 170>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ClassDescriptionPROTOTYPEupdateInstances:from:isMeta: (in category 'method prototypes') -----
- ClassDescriptionPROTOTYPEupdateInstances: oldInstances from: oldClass isMeta: isMeta
- "Recreate any existing instances of the argument, oldClass, as instances of the receiver,
- which is a newly changed class. Permute variables as necessary, and forward old instances
- to new instances. Answer nil to defeat old clients that expect an array of old instances.
- The old behaviour, which necessitated a global GC, exchanged identities and answered
- the old instances. But no clients used the result. This way we avoid the unnecessary GC,"
- | map variable instSize newInstances |
-
- oldInstances isEmpty ifTrue:
- [^nil]. "no instances to convert"
- isMeta ifTrue:
- [(oldInstances size = 1
- and: [self soleInstance class == self
- or: [self soleInstance class == oldClass]]) ifFalse:
- [^self error: 'Metaclasses can only have one instance']].
- map := self instVarMappingFrom: oldClass.
- variable := self isVariable.
- instSize := self instSize.
- newInstances := Array new: oldInstances size.
- 1 to: oldInstances size do:
- [:i|
- newInstances
- at: i
- put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize map: map)].
- "Now perform a bulk mutation of old instances into new ones"
- oldInstances elementsForwardIdentityTo: newInstances.
- ^nil!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ClassDescriptionPROTOTYPEupdateInstancesFrom: (in category 'method prototypes') -----
- ClassDescriptionPROTOTYPEupdateInstancesFrom: oldClass
- "Recreate any existing instances of the argument, oldClass, as instances of
- the receiver, which is a newly changed class. Permute variables as necessary,
- and forward old instances to new instances.. Answer nil to defeat any clients
- that expected the old behaviour of answering the array of old instances."
- "ar 7/15/1999: The updating below is possibly dangerous. If there are any
- contexts having an old instance as receiver it might crash the system if
- the new receiver in which the context is executed has a different layout.
- See bottom below for a simple example:"
- self updateInstances: oldClass allInstances asArray from: oldClass isMeta: self isMeta.
- "Now fix up instances in segments that are out on the disk."
- ImageSegment allSubInstancesDo:
- [:seg |
- seg segUpdateInstancesOf: oldClass toBe: self isMeta: self isMeta].
- ^nil
-
- "This attempts to crash the VM by stepping off the end of an instance.
- As the doctor says, do not do this."
- " | crashingBlock class |
- class := Object subclass: #CrashTestDummy
- instanceVariableNames: 'instVar'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Crash-Test'.
- class compile:'instVar: value instVar := value'.
- class compile:'crashingBlock ^[instVar]'.
- crashingBlock := (class new) instVar: 42; crashingBlock.
- Object subclass: #CrashTestDummy
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Crash-Test'.
- crashingBlock value"!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEnumLiterals
- "Answer the number of literals used by the receiver."
- ^self header bitAnd: 16r7FFF!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEprimitive (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEprimitive
- "Answer the primitive index associated with the receiver.
- Zero indicates that this is not a primitive method."
- | initialPC |
- ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
- ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- ifFalse: [0]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod: numberOfBytes header: headerWord
- "This newMethod:header: gets sent after handleFailingBasicNew: has done a full
- garbage collection and possibly grown memory. If this basicNew: fails then the
- system really is low on space, so raise the OutOfMemory signal.
-
- Primitive. Answer an instance of this class with the number of indexable variables
- specified by the argument, headerWord, and the number of bytecodes specified
- by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes
- is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 79>
- "space must be low."
- OutOfMemory signal.
- "retry if user proceeds"
- ^self newMethod: numberOfBytes header: headerWord!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingNewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEhandleFailingNewMethod: numberOfBytes header: headerWord
- "This newMethod:header: gets sent after newMethod:header: has failed
- and allowed a scavenging garbage collection to occur. The scavenging
- collection will have happened as the VM is activating the (failing) basicNew:.
- If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- space and a global garbage collection is required. Retry after garbage
- collecting and growing memory if necessary.
-
- Primitive. Answer an instance of this class with the number of indexable variables
- specified by the argument, headerWord, and the number of bytecodes specified
- by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes
- is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 79>
- | bytesRequested |
- bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
- Smalltalk garbageCollect < bytesRequested ifTrue:
- [Smalltalk growMemoryByAtLeast: bytesRequested].
- "retry after global garbage collect and possible grow"
- ^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize"
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
- "Since this method refers to ClassVariables things are easier if it lives in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
- "Since this method refers to ClassVariables things are easier if it lives in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewMethod: numberOfBytes header: headerWord
- "Primitive. Answer an instance of me. The number of literals (and other
- information) is specified by the headerWord (see my class comment).
- The first argument specifies the number of fields for bytecodes in the
- method. Fail if either argument is not a SmallInteger, or if numberOfBytes
- is negative, or if memory is low. Once the header of a method is set by
- this primitive, it cannot be changed to change the number of literals.
- Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 79 error: ec>
- ec == #'insufficient object memory' ifTrue:
- [^self handleFailingNewMethod: numberOfBytes header: headerWord].
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnConstant:trailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnConstant: index trailerBytes: trailer
- "Answer an instance of me that is a quick return of the constant
- indexed in (true false nil -1 0 1 2)."
-
- ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnField:trailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnField: field trailerBytes: trailer
- "Answer an instance of me that is a quick return of the instance variable
- indexed by the argument, field."
-
- ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: trailer
- "Answer an instance of me that is a quick return of the instance (^self)."
-
- ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
- EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category 'method prototypes') -----
- EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex
- "Since this method has inst var refs the prototype must live in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: (in category 'method prototypes') -----
- EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: bytecode
- "Answer the number of bytes in the bytecode."
- bytecode <= 125 ifTrue:
- [^1].
- bytecode >= 176 ifTrue:
- [^1].
- bytecode >= 160 ifTrue: "long jumps"
- [^2].
- bytecode >= 144 ifTrue: "short jumps"
- [^1].
- "extensions"
- bytecode >= 128 ifTrue:
- [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127].
- ^nil!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
- EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
- "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
- ^139!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew (in category 'method prototypes') -----
- FloatclassPROTOTYPEbasicNew
- ^BoxedFloat64 basicNew: 2!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew: (in category 'method prototypes') -----
- FloatclassPROTOTYPEbasicNew: anInteger
- ^BoxedFloat64 basicNew: 2!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEfromIEEE32Bit: (in category 'method prototypes') -----
- FloatclassPROTOTYPEfromIEEE32Bit: word
- "Convert the given 32 bit word (which is supposed to be a positive 32-bit value) from
- a 32 bit IEEE floating point representation into an actual Squeak float object (being
- 64 bits wide). Should only be used for conversion in FloatArrays or likewise objects."
-
- | sign mantissa exponent delta |
- word <= 0 ifTrue:
- [^word negative
- ifTrue: [self error: 'Cannot deal with negative numbers']
- ifFalse: [self zero]].
- sign := word bitAnd: 16r80000000.
- word = sign ifTrue:
- [^self negativeZero].
-
- exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127.
- mantissa := word bitAnd: 16r7FFFFF.
-
- exponent = 128 ifTrue: "Either NAN or INF"
- [^mantissa = 0
- ifTrue:
- [sign = 0
- ifTrue: [self infinity]
- ifFalse: [self negativeInfinity]]
- ifFalse: [self nan]].
-
- exponent = -127 ifTrue:
- "gradual underflow (denormalized number)
- Remove first bit of mantissa and adjust exponent"
- [delta := mantissa highBit.
- mantissa := (mantissa bitAnd: (1 bitShift: delta - 1) - 1) bitShift: 24 - delta.
- exponent := exponent + delta - 23].
-
- "Create new float"
- ^(self basicNew: 2)
- basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3));
- basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29);
- * 1.0 "reduce to SmallFloat64 if possible"!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>InstructionClientPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
- InstructionClientPROTOTYPEcallPrimitive: pimIndex
- "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256)
- m=1 means inlined primitive, no hard return after execution."!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes') -----
- InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
- "Since this method has inst var refs the prototype must live in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>LargeNegativeIntegerPROTOTYPEnormalize (in category 'method prototypes') -----
- LargeNegativeIntegerPROTOTYPEnormalize
- "Check for leading zeroes and return shortened copy if so"
- | sLen val len oldLen minVal |
- <primitive: 'primNormalizeNegative' module: 'LargeIntegers'>
- "First establish len = significant length"
- len := oldLen := self digitLength.
- [len = 0 ifTrue: [^0].
- (self digitAt: len) = 0]
- whileTrue: [len := len - 1].
-
- "Now check if in SmallInteger range.
- Fast compute SmallInteger minVal digitLength"
- sLen := SmallInteger minVal < -16r40000000
- ifTrue: [8]
- ifFalse: [4].
- len <= sLen ifTrue:
- [minVal := SmallInteger minVal.
- (len < sLen
- or: [(self digitAt: sLen) < minVal lastDigit])
- ifTrue: ["If high digit less, then can be small"
- val := 0.
- len to: 1 by: -1 do:
- [:i | val := (val *256) - (self digitAt: i)].
- ^ val].
- 1 to: sLen do: "If all digits same, then = minVal"
- [:i | (self digitAt: i) = (minVal digitAt: i)
- ifFalse: ["Not so; return self shortened"
- len < oldLen
- ifTrue: [^ self growto: len]
- ifFalse: [^ self]]].
- ^ minVal].
-
- "Return self, or a shortened copy"
- len < oldLen
- ifTrue: [^ self growto: len]
- ifFalse: [^ self]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>LargePositiveIntegerPROTOTYPEnormalize (in category 'method prototypes') -----
- LargePositiveIntegerPROTOTYPEnormalize
- "Check for leading zeroes and return shortened copy if so"
- | sLen val len oldLen |
- <primitive: 'primNormalizePositive' module:'LargeIntegers'>
- "First establish len = significant length"
- len := oldLen := self digitLength.
- [len = 0 ifTrue: [^0].
- (self digitAt: len) = 0]
- whileTrue: [len := len - 1].
-
- "Now check if in SmallInteger range. Fast compute SmallInteger maxVal digitLength"
- sLen := SmallInteger maxVal > 16r3FFFFFFF
- ifTrue: [8]
- ifFalse: [4].
- (len <= sLen
- and: [(self digitAt: sLen) <= (SmallInteger maxVal digitAt: sLen)])
- ifTrue: ["If so, return its SmallInt value"
- val := 0.
- len to: 1 by: -1 do:
- [:i | val := (val *256) + (self digitAt: i)].
- ^ val].
-
- "Return self, or a shortened copy"
- len < oldLen
- ifTrue: [^ self growto: len]
- ifFalse: [^ self]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes') -----
- MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer
- "The receiver is the root of a parse tree. Answer a CompiledMethod.
- The argument, trailer, is arbitrary but is typically either the reference
- to the source code that is stored with every CompiledMethod, or an
- encoding of the method's temporary names."
-
- ^self generate: trailer using: CompiledMethod!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>MethodNodePROTOTYPEgenerate:using: (in category 'method prototypes') -----
- MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
- "Since this method has inst var refs the prototype must live in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEclone (in category 'method prototypes') -----
- ObjectPROTOTYPEclone
- "Answer a shallow copy of the receiver."
- <primitive: 148 error: ec>
- | class newObject |
- ec == #'insufficient object memory' ifFalse:
- [^self primitiveFailed].
- "If the primitive fails due to insufficient memory, instantiate via basicNew: to invoke
- the garbage collector before retrying, and use copyFrom: to copy state."
- newObject := (class := self class) isVariable
- ifTrue:
- [class isCompiledMethodClass
- ifTrue:
- [class newMethod: self basicSize - self initialPC + 1 header: self header]
- ifFalse:
- [class basicNew: self basicSize]]
- ifFalse:
- [class basicNew].
- ^newObject copyFrom: self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEinstVarAt: (in category 'method prototypes') -----
- ObjectPROTOTYPEinstVarAt: index
- "Primitive. Answer a fixed variable in an object. The numbering of the variables
- corresponds to the named instance variables, followed by the indexed instance
- variables. Fail if the index is not an Integer or is not the index of a fixed variable.
- Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 173 error: ec>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEinstVarAt:put: (in category 'method prototypes') -----
- ObjectPROTOTYPEinstVarAt: index put: anObject
- "Primitive. Store a value into a fixed variable in an object. The numbering of the
- variables corresponds to the named instance variables, followed by the indexed
- instance variables. Fail if the index is not an Integer or is not the index of a fixed
- variable. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 174 error: ec>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEisPinned (in category 'method prototypes') -----
- ObjectPROTOTYPEisPinned
- "Answer if the receiver is pinned. The VM's garbage collector routinely moves
- objects as it reclaims and compacts memory. But it can also pin an object so
- that it will not be moved, which can make it easier to pass objects out through
- the FFI."
- <primitive: 183 error: ec>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEoopAge (in category 'method prototypes') -----
- ObjectPROTOTYPEoopAge
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEoopTimestamp (in category 'method prototypes') -----
- ObjectPROTOTYPEoopTimestamp
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEpin (in category 'method prototypes') -----
- ObjectPROTOTYPEpin
- "The VM's garbage collector routinely moves objects as it reclaims and compacts
- memory. But it can also pin an object so that it will not be moved, which can make
- it easier to pass objects out through the FFI. Objects are unpinnned when created.
- This method ensures an object is pinned, and answers whether it was already pinned."
- ^self setPinned: true!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEsetPinned: (in category 'method prototypes') -----
- ObjectPROTOTYPEsetPinned: aBoolean
- "The VM's garbage collector routinely moves objects as it reclaims and compacts
- memory. But it can also pin an object so that it will not be moved, which can make
- it easier to pass objects out through the FFI. Objects are unpinnned when created.
- This primitive either pins or unpins an object, and answers if it was already pinned."
- <primitive: 184 error: ec>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEunpin (in category 'method prototypes') -----
- ObjectPROTOTYPEunpin
- "The VM's garbage collector routinely moves objects as it reclaims and compacts
- memory. But it can also pin an object so that it will not be moved, which can make
- it easier to pass objects out through the FFI. Objects are unpinnned when created.
- This method ensures an object is unpinned, and answers whether it was pinned."
- ^self setPinned: false!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEclone (in category 'method prototypes') -----
- SmallFloat64PROTOTYPEclone
- "Answer the receiver, because SmallFloat64s are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEcopy (in category 'method prototypes') -----
- SmallFloat64PROTOTYPEcopy
- "Answer the receiver, because SmallFloat64s are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEdeepCopy (in category 'method prototypes') -----
- SmallFloat64PROTOTYPEdeepCopy
- "Answer the receiver, because SmallFloat64s are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEidentityHash (in category 'method prototypes') -----
- SmallFloat64PROTOTYPEidentityHash
- "Answer an integer unique to the receiver."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEshallowCopy (in category 'method prototypes') -----
- SmallFloat64PROTOTYPEshallowCopy
- "Answer the receiver, because SmallFloat64s are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
- SmallFloat64PROTOTYPEveryDeepCopyWith: deepCopier
- "Answer the receiver, because SmallFloat64s are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64classPROTOTYPEbasicNew (in category 'method prototypes') -----
- SmallFloat64classPROTOTYPEbasicNew
- self error: 'SmallFloat64s can only be created by performing arithmetic'!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallFloat64classPROTOTYPEbasicNew: (in category 'method prototypes') -----
- SmallFloat64classPROTOTYPEbasicNew: anInteger
- ^self basicNew!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
- SmallIntegerPROTOTYPEasCharacter
- <primitive: 170>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEdecimalDigitLength (in category 'method prototypes') -----
- SmallIntegerPROTOTYPEdecimalDigitLength
- "Answer the number of digits printed out in base 10.
- Note that this only works for positive SmallIntegers up to 64-bits."
-
- ^self < 10000
- ifTrue:
- [self < 100
- ifTrue:
- [self < 10 ifTrue: [1] ifFalse: [2]]
- ifFalse:
- [self < 1000 ifTrue: [3] ifFalse: [4]]]
- ifFalse:
- [self < 100000000
- ifTrue:
- [self < 1000000
- ifTrue: [self < 100000 ifTrue: [5] ifFalse: [6]]
- ifFalse: [self < 10000000 ifTrue: [7] ifFalse: [8]]]
- ifFalse:
- [self < 1000000000000
- ifTrue:
- [self < 10000000000
- ifTrue: [self < 1000000000 ifTrue: [9] ifFalse: [10]]
- ifFalse: [self < 100000000000 ifTrue: [11] ifFalse: [12]]]
- ifFalse:
- [self < 10000000000000000
- ifTrue:
- [self < 100000000000000
- ifTrue: [self < 10000000000000 ifTrue: [13] ifFalse: [14]]
- ifFalse: [self < 1000000000000000 ifTrue: [15] ifFalse: [16]]]
- ifFalse:
- [self < 1000000000000000000
- ifTrue: [self < 100000000000000000 ifTrue: [17] ifFalse: [18]]
- ifFalse: [self < 10000000000000000000 ifTrue: [19] ifFalse: [20]]]]]]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEdigitLength (in category 'method prototypes') -----
- SmallIntegerPROTOTYPEdigitLength
- "Answer the number of indexable fields in the receiver. This value is the
- same as the largest legal subscript. Included so that a SmallInteger can
- behave like a LargePositiveInteger or LargeNegativeInteger."
-
- | value length |
- length := 1.
- value := self.
- value >= 0
- ifTrue:
- [[value > 255] whileTrue:
- [value := value bitShift: -8.
- length := length + 1]]
- ifFalse:
- [[value < -255] whileTrue:
- [value := value bitShift: -8.
- length := length + 1]].
- ^length!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEcompactClassesArray
- "Smalltalk compactClassesArray"
- "Backward-compatibility support. Spur does not have compact classes."
- ^{}!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: numBytes
- "Grow memory by at least the requested number of bytes.
- Primitive. Essential. Fail if no memory is available."
- <primitive: 180>
- (numBytes isInteger and: [numBytes > 0]) ifTrue:
- [OutOfMemory signal].
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEmaxIdentityHash
- "Answer the maximum identityHash value supported by the VM."
- <primitive: 176>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEprimBytesLeft (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEprimBytesLeft
- "Primitive. Answer the number of free bytes available in old space.
- Not accurate unless preceded by
- Smalltalk garbageCollectMost (for reasonable accuracy), or
- Smalltalk garbageCollect (for real accuracy).
- See Object documentation whatIsAPrimitive."
-
- <primitive: 112>
- ^0!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEprimitiveGarbageCollect (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEprimitiveGarbageCollect
- "Primitive. Reclaims all garbage and answers the size of the largest free chunk in old space.."
-
- <primitive: 130>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SpaceTallyPROTOTYPEspaceForInstancesOf: (in category 'method prototypes') -----
- SpaceTallyPROTOTYPEspaceForInstancesOf: aClass
- "Answer a pair of the number of bytes consumed by all instances of the
- given class, including their object headers, and the number of instances."
-
- | instances total |
- instances := aClass allInstances.
- instances isEmpty ifTrue: [^#(0 0)].
- total := 0.
- aClass isVariable
- ifTrue:
- [instances do:
- [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
- ifFalse:
- [total := instances size * aClass byteSizeOfInstance].
- ^{ total. instances size }!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: numBytes
- "Grow memory by at least the requested number of bytes.
- Primitive. Fail if no memory is available. Essential."
- <primitive: 180>
- ^(numBytes isInteger and: [numBytes > 0])
- ifTrue: [OutOfMemory signal]
- ifFalse: [self primitiveFailed]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEmaxIdentityHash
- "Answer the maximum identityHash value supported by the VM."
- <primitive: 176>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjects (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjects
- "Answer an Array of all objects in the system. Fail if
- there isn't enough memory to instantiate the result."
- <primitive: 178>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsDo: (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjectsDo: aBlock
- "Evaluate the argument, aBlock, for each object in the system, excluding immediates
- such as SmallInteger and Character."
- self allObjectsOrNil
- ifNotNil: [:allObjects| allObjects do: aBlock]
- ifNil:
- ["Fall back on the old single object primitive code. With closures, this needs
- to use an end marker (lastObject) since activation of the block will create
- new contexts and cause an infinite loop. The lastObject must be created
- before calling someObject, so that the VM can settle the enumeration (e.g.
- by flushing new space) as a side effect of someObject"
- | object lastObject |
- lastObject := Object new.
- object := self someObject.
- [lastObject == object or: [0 == object]] whileFalse:
- [aBlock value: object.
- object := object nextObject]]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsOrNil (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjectsOrNil
- "Answer an Array of all objects in the system. Fail if there isn't
- enough memory to instantiate the result and answer nil."
- <primitive: 178>
- ^nil!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat: (in category 'method prototypes') -----
- WideStringPROTOTYPEat: index
- "Answer the Character stored in the field of the receiver indexed by the
- argument. Primitive. Fail if the index argument is not an Integer or is out
- of bounds. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 63>
- ^index isInteger
- ifTrue:
- [self errorSubscriptBounds: index]
- ifFalse:
- [index isNumber
- ifTrue: [self at: index asInteger]
- ifFalse: [self errorNonIntegerIndex]]!
Item was removed:
- ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat:put: (in category 'method prototypes') -----
- WideStringPROTOTYPEat: index put: aCharacter
- "Store the Character into the field of the receiver indicated by the index.
- Primitive. Fail if the index is not an Integer or is out of bounds, or if the
- argument is not a Character. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 64>
- ^aCharacter isCharacter
- ifTrue:
- [index isInteger
- ifTrue: [self errorSubscriptBounds: index]
- ifFalse: [self errorNonIntegerIndex]]
- ifFalse:
- [self errorImproperStore]!
Item was removed:
- SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapSqueak43Prototypes
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes class>>imageType (in category 'accessing') -----
- imageType
- ^ 'squeak 4.3'!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
- BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>CharacterPROTOTYPEshouldBePrintedAsLiteral (in category 'method prototypes') -----
- CharacterPROTOTYPEshouldBePrintedAsLiteral
-
- ^(self asInteger between: 33 and: 255) and: [self asInteger ~= 127]!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>CompiledMethodPROTOTYPEencoderClass (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEencoderClass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>DecompilerPROTOTYPEdecompile:in:method:using: (in category 'method prototypes') -----
- DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes') -----
- InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
- ^self interpretV3ClosuresExtension: offset in: method for: client!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEnextPc: (in category 'method prototypes') -----
- InstructionStreamPROTOTYPEnextPc: currentByte
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEskipCallPrimitive (in category 'method prototypes') -----
- InstructionStreamPROTOTYPEskipCallPrimitive
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
- MCClassDefinitionPROTOTYPEkindOfSubclass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'method prototypes') -----
- MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString
- classIsMeta: metaBoolean
- selector: selectorString
- category: catString
- timeStamp: timeString
- source: sourceString
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueak43Prototypes>>MethodNodePROTOTYPEprintPropertiesOn: (in category 'method prototypes') -----
- MethodNodePROTOTYPEprintPropertiesOn: aStream
- <indirect>!
Item was removed:
- SpurBootstrapPrototypes subclass: #SpurBootstrapSqueakFamilyPrototypes
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrapSqueakFamilyPrototypes class>>imageType (in category 'accessing') -----
- imageType
- ^'squeak'!
Item was removed:
- ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
- "Compute the new format for making oldClass a subclass of newSuper.
- Answer the format or nil if there is any problem."
- | instSize isVar isWords isPointers isWeak |
- type == #compiledMethod ifTrue:
- [newInstSize > 0 ifTrue:
- [self error: 'A compiled method class cannot have named instance variables'.
- ^nil].
- ^CompiledMethod format].
- instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- instSize > 65535 ifTrue:
- [self error: 'Class has too many instance variables (', instSize printString,')'.
- ^nil].
- type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
- type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
- type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
- type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
- type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
- type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
- type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
- (isPointers not and: [instSize > 0]) ifTrue:
- [self error: 'A non-pointer class cannot have named instance variables'.
- ^nil].
- ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
Item was removed:
- ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = reserved for 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := isWeak
- ifTrue:
- [isVar
- ifTrue: [4]
- ifFalse: [5]]
- ifFalse:
- [isPointers
- ifTrue:
- [isVar
- ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
- ifFalse:
- [isVar
- ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]]
- ifFalse: [7]]].
- ^(instSpec bitShift: 16) + nInstVars!
Item was removed:
- ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEsuperclass: aClass
- immediateSubclass: t instanceVariableNames: f
- classVariableNames: d poolDictionaries: s category: cat
- "This is the standard initialization message for creating a
- new immediate class as a subclass of an existing class."
- | env |
- aClass instSize > 0
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
- aClass isVariable
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
- aClass isPointers
- ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
- "Cope with pre-environment and environment versions. Simplify asap."
- env := (Smalltalk classNamed: #EnvironmentRequest)
- ifNil: [aClass environment]
- ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
- ^self
- name: t
- inEnvironment: env
- subclassOf: aClass
- type: #immediate
- instanceVariableNames: f
- classVariableNames: d
- poolDictionaries: s
- category: cat!
Item was removed:
- ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEupdate: oldClass to: newClass
- "Convert oldClass, all its instances and possibly its meta class into newClass,
- instances of newClass and possibly its meta class. The process is surprisingly
- simple in its implementation and surprisingly complex in its nuances and potentially
- bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to
- 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
- a become of the old vs. the new instances and therefore it will not create
- pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that
- nobody can get a hold by 'other means' (such as process interruption and
- reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointers
- to any old instances. After the forwarding become there will be no pointers to the old
- class or meta class either.
- Andreas Raab, 2/27/2003 23:42"
- | meta |
- meta := oldClass isMeta.
- "Note: Everything from here on will run without the ability to get interrupted
- to prevent any other process to create new instances of the old class."
- ["Note: The following removal may look somewhat obscure and needs an explanation.
- When we mutate the class hierarchy we create new classes for any existing subclass.
- So it may look as if we don't have to remove the old class from its superclass. However,
- at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
- created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
- subclasses. Since the #become: below will transparently replace the pointers to oldClass
- with newClass the superclass would have newClass in its subclasses TWICE. With rather
- unclear effects if we consider that we may convert the meta-class hierarchy itself (which
- is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting
- them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
- effectively remove the oldClass (becomeForward:) just a few lines below."
-
- oldClass superclass removeSubclass: oldClass.
- oldClass superclass removeObsoleteSubclass: oldClass.
-
- "make sure that the VM cache is clean"
- oldClass methodDict do: [:cm | cm flushCache].
-
- "Convert the instances of oldClass into instances of newClass"
- newClass updateInstancesFrom: oldClass.
-
- meta
- ifTrue:
- [oldClass becomeForward: newClass.
- oldClass updateMethodBindingsTo: oldClass binding]
- ifFalse:
- [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
- oldClass updateMethodBindingsTo: oldClass binding.
- oldClass class updateMethodBindingsTo: oldClass class binding].
-
- "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
- to ensure no old instances existed after the becomeForward:. Without the GC it was possible
- to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
- updated references from the old objects to new objects but didn't destroy the old objects.
- But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
- valueUnpreemptively!
Item was removed:
- ----- Method: SpurBootstrapSqueakFamilyPrototypes>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
- InstructionPrinterPROTOTYPEcallPrimitive: index
- "Print the callPrimitive bytecode."
-
- self print: 'callPrimitive: ' , index printString!
Item was removed:
- SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapSqueakPrototypes
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes class>>imageType (in category 'accessing') -----
- imageType
- ^ 'squeak'!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes') -----
- BehaviorPROTOTYPEidentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- Behavior implements identityHash to allow the VM to use an object representation which
- does not include a direct reference to an object's class in an object. If the VM is using
- this implementation then classes are held in a class table and instances contain the index
- of their class in the table. A class's class table index is its identityHash so that an instance
- can be created without searching the table for a class's index. The VM uses this primitive
- to enter the class into the class table, assigning its identityHash with an as yet unused
- class table index. If this primitive fails it means that the class table is full. In Spur as of
- 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
-
- Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
-
- <primitive: 175>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
- BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
- CharacterPROTOTYPEclone
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
- CharacterPROTOTYPEsetValue: v
- <remove>!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes') -----
- ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
- ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
- "This is the standard initialization message for creating a new
- immediate class as a subclass of an existing class (the receiver)."
- ^ClassBuilder new
- superclass: self
- immediateSubclass: t
- instanceVariableNames: f
- classVariableNames: d
- poolDictionaries: s
- category: cat!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>CompiledMethodPROTOTYPEbytecodeSetName (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEbytecodeSetName
- ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>CompiledMethodPROTOTYPEheaderDescription (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEheaderDescription
- "Answer a description containing the information about the form of the
- receiver and the form of the context needed to run the receiver."
-
- ^(ByteString new: 128) writeStream
- print: self header; cr;
- nextPutAll: '"primitive: '; print: self primitive; cr;
- nextPutAll: ' numArgs: '; print: self numArgs; cr;
- nextPutAll: ' numTemps: '; print: self numTemps; cr;
- nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
- nextPutAll: ' frameSize: '; print: self frameSize; cr;
- nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
- nextPut: $"; cr;
- contents!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
- ContextPartPROTOTYPEactivateReturn: aContext value: value
- "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
-
- ^MethodContext
- sender: self
- receiver: aContext
- method: MethodContext theReturnMethod
- arguments: {value}!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
- ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
- ContextPartPROTOTYPEisPrimFailToken: anObject
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
- "Simulate the action of sending a message with selector and arguments
- to rcvr. The argument, lookupClass, is the class in which to lookup the
- message. This is the receiver's class for normal messages, but for super
- messages it will be some specific class related to the source method."
-
- | meth primIndex val ctxt |
- (meth := lookupClass lookupSelector: selector) ifNil:
- [^self send: #doesNotUnderstand:
- to: rcvr
- with: {Message selector: selector arguments: arguments}
- lookupIn: lookupClass].
- (primIndex := meth primitive) > 0 ifTrue:
- [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
- (self isPrimFailToken: val) ifFalse:
- [^val]].
- (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ', arguments first selector, ' not understood'].
- ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
- primIndex > 0 ifTrue:
- [ctxt failPrimitiveWith: val].
- ^ctxt!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag
- "Simulate the action of sending a message with selector arguments
- to rcvr. The argument, superFlag, tells whether the receiver of the
- message was specified with 'super' in the source method."
-
- ^self send: selector
- to: rcvr
- with: arguments
- lookupIn: (superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr])!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
- ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
- "Invoke the named primitive for aCompiledMethod, answering its result, or,
- if the primiitve fails, answering the error code."
- <primitive: 218 error: ec>
- ec ifNotNil:
- ["If ec is an integer other than -1 there was a problem with primitive 218,
- not with the external primitive itself. -1 indicates a generic failure (where
- ec should be nil) but ec = nil means primitive 218 is not implemented. So
- interpret -1 to mean the external primitive failed with a nil error code."
- ec isInteger ifTrue:
- [ec = -1
- ifTrue: [ec := nil]
- ifFalse: [self primitiveFailed]]].
- ^self class primitiveFailTokenFor: ec!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
- IntegerclassPROTOTYPEinitialize
- "Integer initialize"
- self initializeLowBitPerByteTable!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
- MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
- MethodContextclassPROTOTYPEallInstances
- "Answer all instances of the receiver."
- <primitive: 177>
- "The primitive can fail because memory is low. If so, fall back on the old
- enumeration code, which gives the system a chance to GC and/or grow.
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst.
- Only count until thisContext since this context has been created only to
- compute the existing instances."
- | inst insts next |
- insts := WriteStream on: (Array new: 64).
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- insts nextPut: inst.
- inst := next].
- ^insts contents!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
- MethodContextclassPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- | instances inst next |
- instances := self allInstancesOrNil.
- instances ifNotNil:
- [instances do: aBlock.
- ^self].
- "allInstancesOrNil can fail because memory is low. If so, fall back on the old
- enumeration code. Because aBlock might change the class of inst (for example,
- using become:), it is essential to compute next before aBlock value: inst.
- Only count until thisContext since evaluation of aBlock will create new contexts."
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') -----
- ProtoObjectPROTOTYPEscaledIdentityHash
- "For identityHash values returned by primitive 75, answer
- such values times 2^8. Otherwise, match the existing
- identityHash implementation"
-
- ^self identityHash * 256 "bitShift: 8"!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>SmallIntegerPROTOTYPEclone (in category 'method prototypes') -----
- SmallIntegerPROTOTYPEclone
- "Answer the receiver, because SmallIntegers are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
- "Smalltalk recreateSpecialObjectsArray"
-
- "To external package developers:
- **** DO NOT OVERRIDE THIS METHOD. *****
- If you are writing a plugin and need additional special object(s) for your own use,
- use addGCRoot() function and use own, separate special objects registry "
-
- "The Special Objects Array is an array of objects used by the Squeak virtual machine.
- Its contents are critical and accesses to it by the VM are unchecked, so don't even
- think of playing here unless you know what you are doing."
- | newArray |
- newArray := Array new: 60.
- "Nil false and true get used throughout the interpreter"
- newArray at: 1 put: nil.
- newArray at: 2 put: false.
- newArray at: 3 put: true.
- "This association holds the active process (a ProcessScheduler)"
- newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
- "Numerous classes below used for type checking and instantiation"
- newArray at: 5 put: Bitmap.
- newArray at: 6 put: SmallInteger.
- newArray at: 7 put: ByteString.
- newArray at: 8 put: Array.
- newArray at: 9 put: Smalltalk.
- newArray at: 10 put: BoxedFloat64.
- newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
- newArray at: 12 put: nil. "was BlockContext."
- newArray at: 13 put: Point.
- newArray at: 14 put: LargePositiveInteger.
- newArray at: 15 put: Display.
- newArray at: 16 put: Message.
- newArray at: 17 put: CompiledMethod.
- newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 19 put: Semaphore.
- newArray at: 20 put: Character.
- newArray at: 21 put: #doesNotUnderstand:.
- newArray at: 22 put: #cannotReturn:.
- newArray at: 23 put: nil. "This is the process signalling low space."
- "An array of the 32 selectors that are compiled as special bytecodes,
- paired alternately with the number of arguments each takes."
- newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
- #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
- #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
- #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
- "An array of the 255 Characters in ascii order.
- Cog inlines table into machine code at: prim so do not regenerate it.
- This is nil in Spur, which has immediate Characters."
- newArray at: 25 put: (self specialObjectsArray at: 25).
- newArray at: 26 put: #mustBeBoolean.
- newArray at: 27 put: ByteArray.
- newArray at: 28 put: Process.
- "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- newArray at: 29 put: self compactClassesArray.
- newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
- newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
- newArray at: 32 put: nil. "was the prototype Float"
- newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
- newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 35 put: #cannotInterpret:.
- newArray at: 36 put: nil. "was the prototype MethodContext"
- newArray at: 37 put: BlockClosure.
- newArray at: 38 put: nil. "was the prototype BlockContext"
- "array of objects referred to by external code"
- newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
- newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
- newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 43 put: LargeNegativeInteger.
- "External objects for callout.
- Note: Written so that one can actually completely remove the FFI."
- newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
- newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
- newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
- newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
- newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
- newArray at: 49 put: #aboutToReturn:through:.
- newArray at: 50 put: #run:with:in:.
- "51 reserved for immutability message"
- newArray at: 51 put: #attemptToAssign:withIndex:.
- newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
- #'bad argument' #'bad index'
- #'bad number of arguments'
- #'inappropriate operation' #'unsupported operation'
- #'no modification' #'insufficient object memory'
- #'insufficient C memory' #'not found' #'bad method'
- #'internal error in named primitive machinery'
- #'object may move' #'resource limit exceeded'
- #'object is pinned' #'primitive write beyond end of object').
- "53 to 55 are for Alien"
- newArray at: 53 put: (self at: #Alien ifAbsent: []).
- newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
-
- "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
- newArray at: 56 put: nil.
-
- "reserved for foreign callback process"
- newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
-
- newArray at: 58 put: #unusedBytecode.
- "59 reserved for Sista counter tripped message"
- newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
- "60 reserved for Sista class trap message"
- newArray at: 60 put: #classTrapFor:.
-
- "Now replace the interpreter's reference in one atomic operation"
- self specialObjectsArray becomeForward: newArray!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
-
- | proportion edenSize survivorSize averageObjectSize numObjects |
- proportion := 0.9. "tenure when 90% of pastSpace is full"
- edenSize := SmalltalkImage current vmParameterAt: 44.
- survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- averageObjectSize := 8 * self wordSize. "a good approximation"
- numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- ----- Method: SpurBootstrapSqueakPrototypes>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
-
- | proportion edenSize survivorSize averageObjectSize numObjects |
- proportion := 0.9. "tenure when 90% of pastSpace is full"
- edenSize := SmalltalkImage current vmParameterAt: 44.
- survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- averageObjectSize := 8 * self wordSize. "a good approximation"
- numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- Spur32BitMMLESimulator subclass: #SpurOldFormat32BitMMLESimulator
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Bootstrapping'!
Item was removed:
- ----- Method: SpurOldFormat32BitMMLESimulator>>literalCountOfMethodHeader: (in category 'method access') -----
- literalCountOfMethodHeader: header
- self assert: (self isIntegerObject: header).
- ^header >> 10 bitAnd: 16rFF!
Item was removed:
- ----- Method: SpurOldFormat32BitMMLESimulator>>primitiveIndexOfMethodHeader: (in category 'method access') -----
- primitiveIndexOfMethodHeader: methodHeader
- | primBits |
- primBits := (self integerValueOf: methodHeader) bitAnd: 16r100001FF.
- ^(primBits bitAnd: 16r1FF) + (primBits >> 19)!
Item was removed:
- SimulatorHarness subclass: #SpurOldToNewMethodFormatMunger
- instanceVariableNames: 'interpreter heap prototypes replacements symbolOops'
- classVariableNames: ''
- poolDictionaries: 'VMObjectIndices'
- category: 'Cog-Bootstrapping'!
-
- !SpurOldToNewMethodFormatMunger commentStamp: 'eem 11/17/2014 10:36' prior: 0!
- A SpurOldToNewMethodFormatMunger is a one-off for mirating a Spur image prior to the two formats to single format CompiledMethod header putsch.
- !
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>cloneArrayLiteral: (in category 'munging') -----
- cloneArrayLiteral: anArray
- "Currently serves only to clone the #(0 0) literal in SpaceTallyPROTOTYPEspaceForInstancesOf:"
- | array |
- array := heap instantiateClass: (heap splObj: ClassArray) indexableSize: anArray size.
- 1 to: anArray size do:
- [:i| | lit |
- lit := anArray at: i.
- lit class caseOf: {
- [SmallInteger] -> [heap
- storePointerUnchecked: i - 1
- ofObject: array
- withValue: (heap integerObjectOf: lit)].
- [ByteSymbol] -> [heap
- storePointer: i - 1
- ofObject: array
- withValue: (symbolOops at: lit)].
- [UndefinedObject] -> [heap
- storePointerUnchecked: i - 1
- ofObject: array
- withValue: heap nilObject] }].
- ^array
- !
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>convertOldMethodHeader: (in category 'munging') -----
- convertOldMethodHeader: methodHeader
- ^heap integerObjectOf:
- ((interpreter argumentCountOfMethodHeader: methodHeader) << 24)
- + ((interpreter temporaryCountOfMethodHeader: methodHeader) << 18)
- + ((interpreter methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [1 << 17] ifFalse: [0])
- + ((heap primitiveIndexOfMethodHeader: methodHeader) > 0 ifTrue: [1 << 16] ifFalse: [0])
- + (heap literalCountOfMethodHeader: methodHeader)!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>incrementPCField:ofObject:by: (in category 'munging') -----
- incrementPCField: fieldIndex ofObject: newObj by: n
- | value |
- value := heap fetchPointer: fieldIndex ofObject: newObj.
- (heap isIntegerObject: value)
- ifTrue:
- [heap
- storePointerUnchecked: fieldIndex
- ofObject: newObj
- withValue: (heap integerObjectOf: n + (heap integerValueOf: value))]
- ifFalse:
- [self assert: value = heap nilObject]!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>indexOfSelector:in: (in category 'munging') -----
- indexOfSelector: selectorOop in: methodDict
- SelectorStart to: (heap numSlotsOf: methodDict) - 1 do:
- [:i|
- (heap fetchPointer: i ofObject: methodDict) = selectorOop ifTrue:
- [^i]].
- self error: 'could not find selector in method dict'!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>installableMethodFor:selector:siblingMethod: (in category 'munging') -----
- installableMethodFor: methodWithSource selector: selectorOop siblingMethod: sibling
- | method classOop clone delta numBytes |
- method := methodWithSource copyWithTempsFromMethodNode: methodWithSource methodNode.
- delta := (method primitive > 0
- and: [(method at: method initialPC) ~= method methodClass callPrimitiveCode])
- ifTrue: [3]
- ifFalse: [0].
- clone := heap
- allocateSlots: (heap numSlotsForBytes: (numBytes := method size) + delta)
- format: (heap compiledMethodFormatForNumBytes: numBytes + delta)
- classIndex: (heap classIndexOf: sibling).
- classOop := interpreter methodClassOf: sibling.
- method methodClass isMeta ifTrue:
- [classOop := heap fetchPointer: interpreter thisClassIndex ofObject: classOop].
- heap storePointer: 0
- ofObject: clone
- withValue: (self methodHeaderForMethod: method).
- 1 to: method numLiterals - 2 do:
- [:i|
- heap storePointer: i
- ofObject: clone
- withValue: (self literalFor: (method literalAt: i) inClass: classOop)].
- heap
- storePointer: method numLiterals - 1
- ofObject: clone
- withValue: selectorOop;
- storePointer: method numLiterals
- ofObject: clone
- withValue: (interpreter methodClassAssociationOf: sibling).
-
- delta > 0 ifTrue:
- [heap
- storeByte: method initialPC - 1 ofObject: clone withValue: 139;
- storeByte: method initialPC + 0 ofObject: clone withValue: (method primitive bitAnd: 255);
- storeByte: method initialPC + 1 ofObject: clone withValue: (method primitive bitShift: -8)].
- method initialPC to: method size do:
- [:i|
- heap storeByte: i - 1 + delta ofObject: clone withValue: (method at: i)].
-
- ^clone!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>literalFor:inClass: (in category 'munging') -----
- literalFor: aLiteral inClass: classOop
- | bindingOrNil |
- aLiteral isSymbol ifTrue:
- [^symbolOops at: aLiteral].
- aLiteral isString ifTrue:
- [^heap stringForCString: aLiteral].
- (aLiteral isInteger and: [aLiteral class == SmallInteger]) ifTrue:
- [^heap integerObjectOf: aLiteral].
- aLiteral isFloat ifTrue:
- [^heap floatObjectOf: aLiteral].
- aLiteral isArray ifTrue:
- [^self cloneArrayLiteral: aLiteral].
- self assert: aLiteral isVariableBinding.
- "interpreter
- ensureDebugAtEachStepBlock;
- instVarNamed: 'printBytecodeAtEachStep' put: true;
- instVarNamed: 'printFrameAtEachStep' put: true."
- bindingOrNil := self interpreter: interpreter
- object: classOop
- perform: (symbolOops at: #bindingOf:)
- withArguments: {symbolOops at: aLiteral key}.
- bindingOrNil ~= heap nilObject ifTrue:
- [^bindingOrNil].
- self error: 'couldn''t find literal ', aLiteral printString!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>mapPCs (in category 'munging') -----
- mapPCs
- | cbc cmc |
- cmc := 36.
- cbc := 37.
- heap allObjectsDo:
- [:obj| | ci |
- ci := heap classIndexOf: obj.
- (ci <= 37 and: [ci >= 36]) ifTrue:
- [ci = 37 ifTrue: [self mungeClosure: obj].
- ci = 36 ifTrue: [self mungeContext: obj]]]!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>methodHeaderForMethod: (in category 'munging') -----
- methodHeaderForMethod: method
- ^heap integerObjectOf:
- (method numArgs << 24)
- + (method numTemps << 18)
- + (method frameSize > method class smallFrameSize ifTrue: [1 << 17] ifFalse: [0])
- + (method primitive > 0 ifTrue: [1 << 16] ifFalse: [0])
- + method numLiterals!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>munge: (in category 'public access') -----
- munge: imageName
- interpreter := StackInterpreterSimulator newWithOptions: #(ObjectMemory Spur32BitMemoryManager).
- interpreter desiredNumStackPages: 4; initStackPages.
- heap := interpreter objectMemory.
- self assert: heap class == Spur32BitMMLESimulator.
- SpurOldFormat32BitMMLESimulator adoptInstance: heap.
- interpreter openOn: imageName extraMemory: 0.
- self mapPCs.
- self preparePrototypes.
- self updateAndForwardMethods.
- self snapshot!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>mungeClosure: (in category 'munging') -----
- mungeClosure: obj
- | method |
- method := heap
- fetchPointer: MethodIndex
- ofObject: (heap
- fetchPointer: ClosureOuterContextIndex
- ofObject: obj).
- (heap primitiveIndexOfMethodHeader: (heap methodHeaderOf: method)) > 0 ifTrue:
- [self incrementPCField: ClosureStartPCIndex ofObject: obj by: 3]!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>mungeContext: (in category 'munging') -----
- mungeContext: obj
- | method |
- method := heap fetchPointer: MethodIndex ofObject: obj.
- (heap primitiveIndexOfMethodHeader: (heap methodHeaderOf: method)) > 0 ifTrue:
- [self incrementPCField: InstructionPointerIndex ofObject: obj by: 3]!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>mungePrimitiveMethod: (in category 'munging') -----
- mungePrimitiveMethod: obj
- | numBytes copy firstByteIndex primIndex numPointerSlots header |
- numBytes := heap byteSizeOf: obj.
- copy := heap allocateSlotsInOldSpace: (heap numSlotsForBytes: numBytes + 3)
- format: (heap compiledMethodFormatForNumBytes: numBytes + 3)
- classIndex: (heap classIndexOf: obj).
- header := heap methodHeaderOf: obj.
- numPointerSlots := (heap literalCountOfMethodHeader: header) + LiteralStart.
- heap
- storePointerUnchecked: 0
- ofObject: copy
- withValue: (self convertOldMethodHeader: header).
- 1 to: numPointerSlots - 1 do:
- [:i|
- heap storePointer: i
- ofObject: copy
- withValue: (heap fetchPointer: i ofObject: obj)].
- primIndex := heap primitiveIndexOfMethodHeader: header.
- firstByteIndex := numPointerSlots * heap bytesPerOop.
- heap
- storeByte: firstByteIndex + 0 ofObject: copy withValue: 139;
- storeByte: firstByteIndex + 1 ofObject: copy withValue: (primIndex bitAnd: 255);
- storeByte: firstByteIndex + 2 ofObject: copy withValue: (primIndex bitShift: -8).
- firstByteIndex to: numBytes - 1 do:
- [:i|
- heap storeByte: i + 3 ofObject: copy withValue: (heap fetchByte: i ofObject: obj)].
- heap forward: obj to: copy.
- ^copy!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>preparePrototypes (in category 'munging') -----
- preparePrototypes
- replacements := OrderedCollection new.
- heap classTableObjectsDo:
- [:class| | name isMeta |
- name := heap
- fetchPointer: interpreter classNameIndex
- ofObject: ((isMeta := (heap numSlotsOf: class) = interpreter metaclassNumSlots)
- ifTrue: [heap fetchPointer: interpreter thisClassIndex ofObject: class]
- ifFalse: [class]).
- name := interpreter stringOf: name.
- self prototypeClassNameMetaSelectorMethodDo:
- [:protoClassName :protoIsMeta :selector :method|
- (protoClassName = name
- and: [protoIsMeta = isMeta]) ifTrue:
- [replacements addLast: {class. selector. method}]]]!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>prototypeClassNameMetaSelectorMethodDo: (in category 'munging') -----
- prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
- prototypes ifNil:
- [prototypes := OrderedCollection new.
- SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
- [:className :isMeta :selector :method|
- (#(BytecodeEncoder CompiledMethod EncoderForSqueakV4PlusClosures
- InstructionClient InstructionStream MethodNode) includes: className) ifTrue:
- [prototypes addLast: {className. isMeta. selector. method}]]].
- prototypes do: [:tuple| quaternaryBlock valueWithArguments: tuple]!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>replaceMethods (in category 'munging') -----
- replaceMethods
- | byteSymbolClassIndex symbols symbolSizes |
- byteSymbolClassIndex := heap classIndexOf: (heap splObj: SelectorDoesNotUnderstand).
- symbols := Set with: #bindingOf:.
- replacements do:
- [:tuple| | method adder |
- symbols add: tuple second.
- method := tuple last.
- adder := [:lit|
- (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
- (lit isVariableBinding and: [lit key isSymbol]) ifTrue: [symbols add: lit key].
- lit isArray ifTrue: [lit do: adder]].
- method literals do: adder].
- symbolSizes := symbols collect: [:ea| ea size].
- symbolOops := Dictionary new.
- heap allObjectsDo:
- [:obj| | sz |
- ((heap classIndexOf: obj) = byteSymbolClassIndex
- and: [symbolSizes includes: (sz := heap numBytesOf: obj)]) ifTrue:
- [symbols do:
- [:s|
- (sz = s size
- and: [(interpreter stringOf: obj) = s]) ifTrue:
- [symbolOops at: s put: obj]]]].
- replacements do:
- [:tuple|
- [:classOop :selector :method| | replacement methodDict methodArray index |
- methodDict := heap fetchPointer: MethodDictionaryIndex ofObject: classOop.
- methodArray := heap fetchPointer: MethodArrayIndex ofObject: methodDict.
- index := (0 to: (heap numSlotsOf: methodArray) - 1) detect: [:i| (heap fetchPointer: i ofObject: methodArray) ~= heap nilObject].
- replacement := self installableMethodFor: method
- selector: (symbolOops at: selector)
- siblingMethod: (heap fetchPointer: index ofObject: methodArray).
- index := self indexOfSelector: (symbolOops at: selector) in: methodDict.
- heap
- storePointer: index - SelectorStart
- ofObject: methodArray
- withValue: replacement] valueWithArguments: tuple]!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>snapshot (in category 'saving') -----
- snapshot
- Spur32BitMMLESimulator adoptInstance: heap.
- interpreter imageName: 'munged-', (FileDirectory default localNameFor: interpreter imageName).
- [heap parent: heap; setCheckForLeaks: 15; garbageCollectForSnapshot]
- on: Halt
- do: [:ex|
- "suppress halts from the usual suspects (development time halts)"
- (#(fullGC globalGarbageCollect) includes: ex signalerContext sender selector)
- ifTrue: [ex resume]
- ifFalse: [ex pass]].
- interpreter
- setDisplayForm: nil; "gets it to use savedWindowSize"
- writeImageFileIO.
- Transcript cr; show: 'Done!!'!
Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>updateAndForwardMethods (in category 'munging') -----
- updateAndForwardMethods
- | new now lastDotTime |
- new := Set new: 1000.
- lastDotTime := Time now asSeconds.
- heap allObjectsDo:
- [:obj|
- ((heap isCompiledMethod: obj)
- and: [(new includes: obj) not]) ifTrue:
- [| header |
- (heap primitiveIndexOfMethodHeader: (header := heap methodHeaderOf: obj)) > 0
- ifTrue:
- [new add: (self mungePrimitiveMethod: obj).
- (now := Time now asSeconds) > lastDotTime ifTrue:
- [Transcript nextPut: $.; flush.
- lastDotTime := now]]
- ifFalse:
- [heap
- storePointerUnchecked: 0
- ofObject: obj
- withValue: (self convertOldMethodHeader: header)]]].
- Spur32BitMMLESimulator adoptInstance: interpreter objectMemory.
- self withExecutableInterpreter: interpreter
- do: [self replaceMethods]!
More information about the Vm-dev
mailing list