VM Maker: Cog.pharo-EstebanLorenzano.221.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: Cog.pharo-EstebanLorenzano.221.mcz

commits-2
 
Esteban Lorenzano uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog.pharo-EstebanLorenzano.221.mcz

==================== Summary ====================

Name: Cog.pharo-EstebanLorenzano.221
Author: EstebanLorenzano
Time: 12 November 2014, 2:21:45.767004 pm
UUID: 59c525b1-1452-41a2-ad4f-7d495b3a410d
Ancestors: Cog-EstebanLorenzano.220

empty log message

=============== Diff against Cog-eem.212 ===============

Item was changed:
+ SystemOrganization addCategory: #Cog!
+ SystemOrganization addCategory: 'Cog-Bootstrapping'!
+ SystemOrganization addCategory: 'Cog-Morphing Bytecode Set'!
+ SystemOrganization addCategory: 'Cog-ProcessorPlugins'!
+ SystemOrganization addCategory: 'Cog-Processors'!
+ SystemOrganization addCategory: 'Cog-Processors-Tests'!
+ SystemOrganization addCategory: 'Cog-Scripting'!
+ SystemOrganization addCategory: 'Cog-Scripts'!
+ SystemOrganization addCategory: 'Cog-Tests'!
- SystemOrganization addCategory: #'Cog-Bootstrapping'!
- SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'!
- SystemOrganization addCategory: #'Cog-ProcessorPlugins'!
- SystemOrganization addCategory: #'Cog-Processors'!
- SystemOrganization addCategory: #'Cog-Processors-Tests'!
- SystemOrganization addCategory: #'Cog-Scripting'!
- SystemOrganization addCategory: #'Cog-Scripts'!
- SystemOrganization addCategory: #'Cog-Tests'!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 := (Context newForMethod: outerContext method)
- 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:
+ [^Context primitiveFailTokenFor: nil].
- [^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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 added:
+ ----- Method: Context>>ContextPROTOTYPEobjectClass: (in category '*Cog-method prototypes') -----
+ ContextPROTOTYPEobjectClass: aReceiver
+ <primitive: 111>
+ self primitiveFailed!

Item was added:
+ ----- 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 added:
+ ----- Method: Context>>xrayIsDivorced (in category '*Cog-Tests-xrays') -----
+ xrayIsDivorced
+ ^(self xray bitAnd: 3) = 1!

Item was added:
+ ----- Method: Context>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') -----
+ xrayIsExecutingMachineCode
+ ^self xray anyMask: 4!

Item was added:
+ ----- Method: Context>>xrayIsMarried (in category '*Cog-Tests-xrays') -----
+ xrayIsMarried
+ ^self xray anyMask: 2!

Item was added:
+ ----- Method: Context>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') -----
+ xrayLastExecutedMachineCode
+ ^self xray anyMask: 8!

Item was added:
+ ----- 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 changed:
  ----- 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: 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SimulatorHarness>>withExecutableInterpreter:do: (in category 'bootstrap methods') -----
  withExecutableInterpreter: sim do: aBlock
  "With the oldInterpreter ready to execute code, evaluate aBlock,
  then return the interpreter (and the heap) to the ``just snapshotted'' state."
  | savedpc savedfp initialContext finalContext |
  sim
  initStackPages;
  loadInitialContext;
  internalizeIPandSP.
  savedpc := sim localIP.
  savedfp := sim localFP.
  "sim printHeadFrame."
  aBlock value.
  "sim printHeadFrame."
  sim
  internalPush: sim localIP;
  externalizeIPandSP.
  "now undo the execution state"
  self assert: sim localFP = savedfp.
  initialContext := sim frameContext: savedfp.
  finalContext := sim voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
  self assert: initialContext = finalContext.
  self assert: sim localIP = savedpc.
  sim objectMemory
  storePointer: SuspendedContextIndex
  ofObject: sim activeProcess
  withValue: finalContext!

Item was changed:
  ----- Method: SpurBootstrap class>>bootstrapPharoImage: (in category 'utilities') -----
  bootstrapPharoImage: imageFileBaseName
+ | oldCompilerClass oldBytecodeBackend |
- | oldCompilerClass |
 
  oldCompilerClass := SmalltalkImage compilerClass.
+ oldBytecodeBackend := CompilationContext bytecodeBackend.
  [
  SmalltalkImage compilerClass: Compiler.
+ CompilationContext bytecodeBackend: IRSpurSqueakV3PlusClosuresBytecodeGenerator.
  self bootstrapImage: imageFileBaseName type: 'pharo' ]
+ ensure: [
+ SmalltalkImage compilerClass: oldCompilerClass.
+ CompilationContext bytecodeBackend: oldBytecodeBackend ]!
- ensure: [ SmalltalkImage compilerClass: oldCompilerClass ].
- !

Item was changed:
  ----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') -----
  allPrototypeMethodSymbols
  "self basicNew allPrototypeMethodSymbols"
  | symbols |
+ "self assert: SpurBootstrap isolatedPrototypes isEmpty."
- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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:
+ [:eachMethod| | method className isMeta |
+ method := eachMethod.
- [:method| | className isMeta |
  className := self classNameForPrototypeMethod: method.
  (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 added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>updateTrunkRepository (in category 'repository population') -----
+ updateTrunkRepository
+ "Download all the Collections, Kernel and System packages from trunk into srcDir,
+ patch them into destDir,
+ upload the patched and branched files that aren't already in trunk to trunk."
+ "self new from: 'trunkpackages' to: 'spurpackages'; updateTrunkRepository"
+ "AndreasSystemProfiler spyOn: [self new from: 'trunkpackages' to: 'spurpackages'; updateSpurRepository]"
+ sourceDir assureExistence.
+ self download: self class squeak45baseline from: self trunk.
+ destDir assureExistence.
+ self patchAsNeeded.
+ self uploadFrom: (MCDirectoryRepository directory: destDir) to: self trunk!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>versionFor: (in category 'patching') -----
+ versionFor: packageFileName
+ ^sourceDir
+ readOnlyFileNamed: packageFileName
+ do: [:fs|
+ ((MCVersionReader readerClassForFileNamed: fs fullName)
+ on: fs fileName: fs fullName)
+ version]!

Item was added:
+ SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapOldSqueakPrototypes
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurBootstrapOldSqueakPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ ^ 'old squeak'!

Item was added:
+ ----- Method: SpurBootstrapOldSqueakPrototypes>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category '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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEcodePoint (in category 'method prototypes') -----
  CharacterPROTOTYPEcodePoint
  "Just for ANSI Compliance"
+ ^self asciiValue!
- ^self!

Item was changed:
  ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
  CharacterPROTOTYPEsetValue: newValue
  self error: 'Characters are immutable'!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
+ CharacterPROTOTYPEshallowCopy
+ "Answer the receiver, because Characters are unique."
+ ^self!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEobjectClass: (in category 'method prototypes') -----
+ ContextPROTOTYPEobjectClass: aReceiver
+ <indirect>!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
  TraitBehaviorPROTOTYPEallInstances
  "Answer all instances of the receiver."
  self error: 'Traits does not have instances.'!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 added:
+ ----- Method: SpurBootstrapPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
+ BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ <indirect>!

Item was changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
  BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
  ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!

Item was changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
  CharacterPROTOTYPEasInteger
  "Answer the receiver's character code."
  <primitive: 171>
  ^self primitiveFailed!

Item was changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
  CharacterPROTOTYPEcopy
  "Answer the receiver, because Characters are unique."
  ^self!

Item was changed:
  ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
  CharacterPROTOTYPEdeepCopy
  "Answer the receiver, because Characters are unique."
  ^self!

Item was changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
  CharacterPROTOTYPEidentityHash
  "Answer the receiver's character code."
  <primitive: 171>
  ^self primitiveFailed!

Item was changed:
  ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
  CharacterPROTOTYPEveryDeepCopyWith: deepCopier
  "Answer the receiver, because Characters are unique."
  ^self!

Item was changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
  CharacterclassPROTOTYPEinitialize
  "Create the DigitsValues table."
  "Character initialize"
  self initializeDigitValues!

Item was changed:
  ----- 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>>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: SpurBootstrapPrototypes>>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: SpurBootstrapPrototypes>>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: SpurBootstrapPrototypes>>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 changed:
  ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') -----
  CompiledMethodPROTOTYPEnumLiterals
  "Answer the number of literals used by the receiver."
  ^self header bitAnd: 65535!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
  CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
  <indirect>!

Item was changed:
  ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
  CompiledMethodclassPROTOTYPEinitialize    "CompiledMethod initialize"
  <indirect>!

Item was changed:
  ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
  CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
  <indirect>!

Item was changed:
  ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
  CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
  <indirect>!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
  EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
  <remove>!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
  EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
  "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
  ^139!

Item was changed:
  ----- 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>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
- InstructionPrinterPROTOTYPEcallPrimitive: index
- "Print the callPrimitive."
-
- self print: 'callPrimtive: ' , index printString!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
  SmallIntegerPROTOTYPEasCharacter
  <primitive: 170>
  ^self primitiveFailed!

Item was changed:
  ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
  SmalltalkImagePROTOTYPEcompactClassesArray
  "Smalltalk compactClassesArray"
  "Backward-compatibility support.  Spur does not have compact classes."
  ^{}!

Item was changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
  SmalltalkImagePROTOTYPEmaxIdentityHash
  "Answer the maximum identityHash value supported by the VM."
  <primitive: 176>
  ^self primitiveFailed!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
  SystemDictionaryPROTOTYPEmaxIdentityHash
  "Answer the maximum identityHash value supported by the VM."
  <primitive: 176>
  ^self primitiveFailed!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 added:
+ ----- Method: SpurBootstrapPrototypes>>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 isEphemeronClass)] -> [#testing].
+ [#(Behavior isImmediateClass)] -> [#testing].
+ [#(Character identityHash)] -> [#comparing].
+ [#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
+ -> [#'subclass creation'].
+ [#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
+ -> [#public].
+ [#(CompiledMethod class handleFailingFailingNewMethod:header:)]
+ -> [#private].
+ [#(CompiledMethod class handleFailingNewMethod:header:)]
+ -> [#private].
+ [#(Context class allInstances)] -> [#enumerating].
+ [#(Context class allInstancesDo:)] -> [#enumerating].
+ [#(Context failPrimitiveWith:)] -> [#'system simulation'].
+ [#(Context isPrimFailToken:)] -> [#private].
+ [#(Context send:to:with:lookupIn:)] -> [#controlling].
+ [#(Context isPrimFailToken:)] -> [#private].
+ [#(Context send:to:with:lookupIn:)] -> [#controlling].
+ [#(CompiledMethod class headerFlagForEncoder:)]
+ -> [#'method encoding'].
+ [#(CompiledMethod class installPrimaryBytecodeSet:)]
+ -> [#'class initialization'].
+ [#(CompiledMethod class installSecondaryBytecodeSet:)]
+ -> [#'class initialization'].
+ [#(EncoderForV3PlusClosures genCallPrimitive:)]
+ -> [#'bytecode generation'].
+ [#(EncoderForV3PlusClosures class callPrimitiveCode)]
+ -> [#'bytecode decoding'].
+ [#(Context failPrimitiveWith:)] -> [#'system simulation'].
+ [#(Context class allInstances)] -> [#enumerating].
+ [#(Context class allInstancesDo:)] -> [#enumerating].
+ [#(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 changed:
+ SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapSqueak43Prototypes
- SpurBootstrapPrototypes subclass: #SpurBootstrapSqueak43Prototypes
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Cog-Bootstrapping'!

Item was changed:
  ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes') -----
  InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
  ^self interpretV3ClosuresExtension: offset in: method for: client!

Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapSqueakFamilyPrototypes
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: SpurBootstrapSqueakFamilyPrototypes>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
+ InstructionPrinterPROTOTYPEcallPrimitive: index
+ "Print the callPrimitive."
+
+ self print: 'callPrimtive: ' , index printString!

Item was changed:
+ SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapSqueakPrototypes
- SpurBootstrapPrototypes subclass: #SpurBootstrapSqueakPrototypes
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Cog-Bootstrapping'!

Item was changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
  CharacterPROTOTYPEclone
  "Answer the receiver, because Characters are unique."
  ^self!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: SpurBootstrapSqueakPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
  IntegerclassPROTOTYPEinitialize
  "Integer initialize"
  self initializeLowBitPerByteTable!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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"!