[Vm-dev] VM Maker: Cog-eem.187.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Aug 12 22:20:41 UTC 2014


Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.187.mcz

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

Name: Cog-eem.187
Author: eem
Time: 12 August 2014, 3:20:24.659 pm
UUID: 5c9bfcc4-ed6c-4d00-bf03-30aeef45dc29
Ancestors: Cog-eem.186

Update Spur bootstrap to transform image to new
CompiledMethod header format (65536 literals, primitive,
if any, in a leading callPrimitive: bytecode).
Hence methods may need to be extended by 3 bytes and
need a different header.
Add a lot more methods so that there is a functional
compiler.
Allow the bootstrap to reshape classes, add class vars, and
initialize classes, so that installed prototypes function.

Update monticello package patcher to add class comments
for SmallInteger, Character and CompiledMethod, and add
the encoder class class vars to CompiledMethod.

=============== Diff against Cog-eem.186 ===============

Item was added:
+ ----- Method: BlockClosure>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category '*Cog-method prototypes') -----
+ BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ 	"Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
+ 	| newContext sz |
+ 	newContext := (MethodContext newForMethod: outerContext method)
+ 						setSender: aContext
+ 						receiver: outerContext receiver
+ 						method: outerContext method
+ 						closure: self
+ 						startpc: startpc.
+ 	((newContext objectClass: anArray) ~~ Array
+ 	 or: [numArgs ~= anArray size]) ifTrue:
+ 		[^ContextPart primitiveFailTokenFor: nil].
+ 	sz := self basicSize.
+ 	newContext stackp: sz + numArgs.
+ 	1 to: numArgs do:
+ 		[:i| newContext at: i put: (anArray at: i)].
+ 	1 to: sz do:
+ 		[:i| newContext at: i + numArgs put: (self at: i)].
+ 	^newContext!

Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category '*Cog-method prototypes') -----
- CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
- 	"Answer an instance of me. The header is specified by the message 
- 	 arguments. The remaining parts are not as yet determined."
- 	| method |
- 	nTemps > 63 ifTrue:
- 		[^self error: 'Cannot compile -- too many temporary variables'].	
- 	nLits > 65535 ifTrue:
- 		[^self error: 'Cannot compile -- too many literals'].
- 
- 	 method := self newMethod: numberOfBytes + trailer size
- 					header:    (nArgs bitShift: 24)
- 							+ (nTemps bitShift: 18)
- 							+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 							+ nLits
- 							+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]).
- 	1 to: trailer size do:  "Copy the source code trailer to the end"
- 		[:i | method at: method size - trailer size + i put: (trailer at: i)].
- 	^method!

Item was removed:
- ----- Method: CompiledMethod class>>CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category '*Cog-method prototypes') -----
- CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
- 	"Answer an instance of me. The header is specified by the message 
- 	 arguments. The remaining parts are not as yet determined."
- 	| method |
- 	nTemps > 63 ifTrue:
- 		[^self error: 'Cannot compile -- too many temporary variables'].	
- 	nLits > 65535 ifTrue:
- 		[^self error: 'Cannot compile -- too many literals'].
- 
- 	 method := self newMethod: numberOfBytes + trailer size
- 					header:    (nArgs bitShift: 24)
- 							+ (nTemps bitShift: 18)
- 							+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 							+ nLits
- 							+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- 							+ (flag ifTrue: [1 bitShift: 29] ifFalse: [0]).
- 	1 to: trailer size do:  "Copy the source code trailer to the end"
- 		[:i | method at: method size - trailer size + i put: (trailer at: i)].
- 	^method!

Item was added:
+ ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category '*Cog-method prototypes') -----
+ CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
+ 	anEncoder class == PrimaryBytecodeSetEncoderClass ifTrue:
+ 		[^0].
+ 	anEncoder class == SecondaryBytecodeSetEncoderClass ifTrue:
+ 		[^SmallInteger minVal].
+ 	self error: 'The encoder is not one of the two installed bytecode sets'!

Item was added:
+ ----- 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>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category '*Cog-method prototypes') -----
  CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
  	"Answer an instance of me. The header is specified by the message 
  	 arguments. The remaining parts are not as yet determined."
+ 	| method pc |
+ 	nArgs > 15 ifTrue:
+ 		[^self error: 'Cannot compile -- too many arguments'].
  	nTemps > 63 ifTrue:
  		[^self error: 'Cannot compile -- too many temporary variables'].	
  	nLits > 65535 ifTrue:
  		[^self error: 'Cannot compile -- too many literals'].
  
+ 	method := trailer
+ 				createMethod: numberOfBytes
+ 				class: self
+ 				header:    (nArgs bitShift: 24)
+ 						+ (nTemps bitShift: 18)
+ 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
+ 						+ nLits
+ 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]).
+ 	primitiveIndex > 0 ifTrue:
+ 		[pc := method initialPC.
+ 		 method
+ 			at: pc + 0 put: method encoderClass callPrimitiveCode;
+ 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
+ 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
+ 	^method!
- 	^trailer
- 		createMethod: numberOfBytes
- 		class: self
- 		header:    (nArgs bitShift: 24)
- 				+ (nTemps bitShift: 18)
- 				+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 				+ nLits
- 				+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])!

Item was changed:
  ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category '*Cog-method prototypes') -----
  CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
  	"Answer an instance of me. The header is specified by the message 
  	 arguments. The remaining parts are not as yet determined."
+ 	| method pc |
+ 	nArgs > 15 ifTrue:
+ 		[^self error: 'Cannot compile -- too many arguments'].
  	nTemps > 63 ifTrue:
  		[^self error: 'Cannot compile -- too many temporary variables'].	
  	nLits > 65535 ifTrue:
  		[^self error: 'Cannot compile -- too many literals'].
  
+ 	method := trailer
+ 				createMethod: numberOfBytes
+ 				class: self
+ 				header:    (nArgs bitShift: 24)
+ 						+ (nTemps bitShift: 18)
+ 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
+ 						+ nLits
+ 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
+ 						+ (flag ifTrue: [1 bitShift: 29] ifFalse: [0]).
+ 	primitiveIndex > 0 ifTrue:
+ 		[pc := method initialPC.
+ 		 method
+ 			at: pc + 0 put: method encoderClass callPrimitiveCode;
+ 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
+ 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
+ 	^method!
- 	^trailer
- 		createMethod: numberOfBytes
- 		class: self
- 		header:    (nArgs bitShift: 24)
- 				+ (nTemps bitShift: 18)
- 				+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 				+ nLits
- 				+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- 				+ (flag ifTrue: [1 bitShift: 29] ifFalse: [0])!

Item was added:
+ ----- 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: 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 added:
+ ----- Method: ContextPart>>ContextPartPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') -----
+ ContextPartPROTOTYPEisPrimFailToken: anObject
+ 	^(self objectClass: anObject) == Array
+ 	  and: [anObject size = 2
+ 	  and: [anObject first == PrimitiveFailToken]]!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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: MethodNode>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category '*Cog-method prototypes') -----
- MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer
- 	"The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
- 	 The argument, trailer, is arbitrary but is typically either the reference to the source code
- 	 that is stored with every CompiledMethod, or an encoding of the method's temporary names."
- 
- 	| primErrNode blkSize nLits literals stack method |
- 	self generate: trailer
- 		ifQuick:
- 			[:m |
- 			  m	literalAt: 2 put: encoder associationForClass;
- 				properties: properties.
- 			^m].
- 	primErrNode := self primitiveErrorVariableName ifNotNil:
- 						[encoder fixTemp: self primitiveErrorVariableName].
- 	encoder supportsClosureOpcodes ifTrue:
- 		[self ensureClosureAnalysisDone.
- 		 encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:"].
- 	blkSize := (block sizeCodeForEvaluatedValue: encoder)
- 				+ (primitive > 0
- 					ifTrue: [encoder sizeCallPrimitive: primitive]
- 					ifFalse: [0])
- 				+ (primErrNode
- 					ifNil: [0]
- 					ifNotNil:
- 						[primErrNode
- 							index: arguments size + temporaries size;
- 							sizeCodeForStore: encoder "The VM relies on storeIntoTemp: (129)"]).
- 	method := CompiledMethod
- 				newBytes: blkSize
- 				trailerBytes: trailer 
- 				nArgs: arguments size
- 				nTemps: (encoder supportsClosureOpcodes
- 							ifTrue: [| locals |
- 									locals := arguments,
- 											  temporaries,
- 											  (primErrNode
- 												ifNil: [#()]
- 												ifNotNil: [{primErrNode}]).
- 									encoder
- 										noteBlockExtent: block blockExtent
- 										hasLocals: locals.
- 									locals size]
- 							ifFalse: [encoder maxTemp])
- 				nStack: 0
- 				nLits: (nLits := (literals := encoder allLiterals) size)
- 				primitive: primitive.
- 	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
- 	encoder streamToMethod: method.
- 	stack := ParseStack new init.
- 	primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: encoder].
- 	stack position: method numTemps.
- 	primitive > 0 ifTrue:
- 		[encoder genCallPrimitive: primitive].
- 	[block emitCodeForEvaluatedValue: stack encoder: encoder]
- 		on: Error "If an attempt is made to write too much code the method will be asked"
- 		do: [:ex|  "to grow, and the grow attempt will fail in CompiledMethod class>>#new:"
- 			ex signalerContext sender method = (CompiledMethod class>>#new:)
- 				ifTrue: [^self error: 'Compiler code size discrepancy']
- 				ifFalse: [ex pass]].
- 	stack position ~= (method numTemps + 1) ifTrue:
- 		[^self error: 'Compiler stack discrepancy'].
- 	encoder methodStreamPosition ~= (method size - trailer size) ifTrue:
- 		[^self error: 'Compiler code size discrepancy'].
- 	method needsFrameSize: stack size - method numTemps.
- 	method properties: properties.
- 	^method!

Item was changed:
  ----- Method: MethodNode>>MethodNodePROTOTYPEgenerate:using: (in category '*Cog-method prototypes') -----
  MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
  	"The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
  	 The argument, trailer, is arbitrary but is typically either the reference to the source code
  	 that is stored with every CompiledMethod, or an encoding of the method's temporary names."
  
+ 	| primErrNode blkSize nLits locals literals stack header method |
- 	| primErrNode blkSize nLits locals literals stack method |
  	self generate: trailer
  		using: aCompiledMethodClass
  		ifQuick:
  			[:m |
+ 			 encoder noteBlockExtent: (0 to: 2) hasLocals: arguments.
+ 			 m	literalAt: 2 put: encoder associationForClass;
- 			  m	literalAt: 2 put: encoder associationForClass;
  				properties: properties.
+ 			 ^m].
- 			^m].
  	primErrNode := self primitiveErrorVariableName ifNotNil:
  						[encoder fixTemp: self primitiveErrorVariableName].
  	self ensureClosureAnalysisDone.
  	encoder rootNode: self. "this is for BlockNode>>sizeCodeForClosureValue:"
  	blkSize := (block sizeCodeForEvaluatedValue: encoder)
  				+ (primitive > 0
  					ifTrue: [encoder sizeCallPrimitive: primitive]
  					ifFalse: [0])
  				+ (primErrNode
  					ifNil: [0]
  					ifNotNil:
  						[primErrNode
  							index: arguments size + temporaries size;
  							sizeCodeForStore: encoder "The VM relies on storeIntoTemp: (129)"]).
  	locals := arguments, temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]).
  	encoder noteBlockExtent: block blockExtent hasLocals: locals.
+ 	header := encoder computeMethodHeaderForNumArgs: arguments size
+ 					numTemps: locals size
+ 					numLits: (nLits := (literals := encoder allLiterals) size)
+ 					primitive: primitive.
+ 	method := trailer
+ 					createMethod: blkSize
+ 					class: aCompiledMethodClass
+ 					header: header.
- 	method := aCompiledMethodClass
- 				newBytes: blkSize
- 				trailerBytes: trailer 
- 				nArgs: arguments size
- 				nTemps: locals size
- 				nStack: 0
- 				nLits: (nLits := (literals := encoder allLiterals) size)
- 				primitive: primitive.
  	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
  	encoder streamToMethod: method.
  	stack := ParseStack new init.
- 	primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: encoder].
- 	stack position: method numTemps.
  	primitive > 0 ifTrue:
+ 		[encoder genCallPrimitive: primitive.
+ 		 primErrNode ifNotNil:
+ 			[primErrNode emitCodeForStore: stack encoder: encoder]].
+ 	stack position: method numTemps.
- 		[encoder genCallPrimitive: primitive].
  	[block emitCodeForEvaluatedValue: stack encoder: encoder]
  		on: Error "If an attempt is made to write too much code the method will be asked"
  		do: [:ex|  "to grow, and the grow attempt will fail in CompiledMethod class>>#new:"
  			ex signalerContext sender method = (CompiledMethod class>>#new:)
  				ifTrue: [^self error: 'Compiler code size discrepancy']
  				ifFalse: [ex pass]].
  	stack position ~= (method numTemps + 1) ifTrue:
  		[^self error: 'Compiler stack discrepancy'].
  	encoder methodStreamPosition ~= (method size - trailer size) ifTrue:
  		[^self error: 'Compiler code size discrepancy'].
  	method needsFrameSize: stack size - method numTemps.
  	method properties: properties.
  	^method!

Item was 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 initialContext finalContext |
  	sim
  		initStackPages;
  		loadInitialContext;
  		internalizeIPandSP.
  	initialContext := sim frameContext: sim localFP.
  	savedpc := sim localIP.
+ 	sim objectMemory hasSpurMemoryManagerAPI ifFalse:
+ 		[sim objectMemory pushRemappableOop: initialContext].
  	"sim printHeadFrame."
  	aBlock value.
  	"sim printHeadFrame."
  	sim
  		internalPush: sim localIP;
  		externalizeIPandSP.
  	"now undo the execution state"
  	finalContext := sim voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
+ 	sim objectMemory hasSpurMemoryManagerAPI ifFalse:
+ 		[initialContext := sim objectMemory popRemappableOop].
  	self assert: initialContext = finalContext.
  	self assert: sim localIP = savedpc.
  	sim objectMemory
  		storePointer: SuspendedContextIndex
  		ofObject: sim activeProcess
  		withValue: finalContext!

Item was changed:
  SimulatorHarness subclass: #SpurBootstrap
+ 	instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes classMetaclass imageTypes classMethodContextIndex classBlockClosureIndex toBeInitialized'
- 	instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym classMetaclass imageTypes classMethodContextIndex classBlockClosureIndex'
  	classVariableNames: 'ImageHeaderFlags ImageName ImageScreenSize TransformedImage'
  	poolDictionaries: 'VMObjectIndices'
  	category: 'Cog-Bootstrapping'!
  
  !SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0!
  SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format.
  
  e.g.
  	(SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image')
  		transform;
  		launch
  
  Bootstrap issues:
  - should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time
    based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load.
  - should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)?
  
  Instance Variables
  	classToIndex:			<Dictionary>
  	lastClassTablePage:	<Integer>
  	map:					<Dictionary>
  	methodClasses:		<Set>
  	newHeap:				<SpurMemoryManager>
  	oldHeap:				<NewObjectMemory>
  	oldInterpreter:			<StackInterpreterSimulator>
  	reverseMap:			<Dictionary>
  	symbolMap:				<Dictionary>
  
  classToIndex
  	- oldClass to new classIndex map
  
  lastClassTablePage
  	- oop in newHeap of last classTable page.  U<sed in validation to filter-out class table.
  
  methodClasses
  	- cache of methodClassAssociations for classes in which modified methods are installed
  
  map
  	- oldObject to newObject map
  
  newHeap
  	- the output, bootstrapped image
  
  oldHeap
  	- the input, image
  
  oldInterpreter
  	- the interpreter associated with oldHeap, needed for a hack to grab WeakArray
  
  reverseMap
  	- newObject to oldObject map
  
  symbolMap
  	- symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap!

Item was added:
+ ----- Method: SpurBootstrap class>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
+ BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>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 added:
+ ----- Method: SpurBootstrap class>>CompiledMethodPROTOTYPEencoderClass (in category 'method prototypes squeak 4.3') -----
+ CompiledMethodPROTOTYPEencoderClass
+ 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes old squeak') -----
- CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
- 	"Since this method refers to ClassVariables things are easier if it lives in the actual class."
- 
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes old squeak') -----
- CompiledMethodclassOLDSQUEAKPROTOTYPEnewBytes: 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 added:
+ ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEinitialize    "CompiledMethod initialize"
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>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 added:
+ ----- Method: SpurBootstrap class>>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 added:
+ ----- Method: SpurBootstrap class>>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 added:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEactivateReturn: aContext value: value
+ 	"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
+ 
+ 	^MethodContext 
+ 		sender: self
+ 		receiver: aContext
+ 		method: MethodContext theReturnMethod
+ 		arguments: {value}!

Item was added:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments 
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEisPrimFailToken: anObject
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
+ 	"Simulate the action of sending a message with selector and arguments
+ 	 to rcvr. The argument, lookupClass, is the class in which to lookup the
+ 	 message.  This is the receiver's class for normal messages, but for super
+ 	 messages it will be some specific class related to the source method."
+ 
+ 	| meth primIndex val ctxt |
+ 	(meth := lookupClass lookupSelector: selector) ifNil:
+ 		[^self send: #doesNotUnderstand:
+ 				to: rcvr
+ 				with: {Message selector: selector arguments: arguments}
+ 				lookupIn: lookupClass].
+ 	(primIndex := meth primitive) > 0 ifTrue:
+ 		[val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ 		 (self isPrimFailToken: val) ifFalse:
+ 			[^val]].
+ 	(selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ 		[^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ 	ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
+ 	primIndex > 0 ifTrue:
+ 		[ctxt failPrimitiveWith: val].
+ 	^ctxt!

Item was added:
+ ----- Method: SpurBootstrap class>>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 added:
+ ----- Method: SpurBootstrap class>>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 added:
+ ----- Method: SpurBootstrap class>>DecompilerPROTOTYPEdecompile:in:method:using: (in category 'method prototypes squeak 4.3') -----
+ DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
+ InstructionPrinterPROTOTYPEcallPrimitive: index
+ 	"Print the callPrimitive."
+ 
+ 	self print: 'callPrimtive: ' , index printString!

Item was added:
+ ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes squeak 4.3') -----
+ InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
+ 	^self interpretV3ClosuresExtension: offset in: method for: client!

Item was added:
+ ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEnextPc: (in category 'method prototypes squeak 4.3') -----
+ InstructionStreamPROTOTYPEnextPc: currentByte
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEskipCallPrimitive (in category 'method prototypes squeak 4.3') -----
+ InstructionStreamPROTOTYPEskipCallPrimitive
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category 'method prototypes squeak 4.3') -----
+ MCClassDefinitionPROTOTYPEkindOfSubclass
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'method prototypes squeak 4.3') -----
+ MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString classIsMeta: metaBoolean selector: selectorString category: catString timeStamp: timeString source: sourceString
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
+ MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
+ 	<indirect>!

Item was changed:
+ ----- Method: SpurBootstrap class>>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."
- ----- Method: SpurBootstrap class>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes old squeak') -----
- MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailerBytes
- 	"Since this method has inst var refs the prototype must live in the actual class."
  
+ 	^self generate: trailer using: CompiledMethod!
- 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrap class>>isolatedPrototypes (in category 'utilities') -----
+ isolatedPrototypes
+ 	"SpurBootstrap isolatedPrototypes"
+ 	| prototypes |
+ 	prototypes := (self systemNavigation allMethodsSelect:
+ 						[:m| m selector includesSubString: 'PROTOTYPE'])
+ 							collect: [:mr| mr compiledMethod].
+ 	^prototypes select:
+ 		[:m|
+ 		m methodClass == self class
+ 			ifTrue:
+ 				[(m pragmaAt: #indirect) notNil
+ 				  and: [prototypes noneSatisfy:
+ 						[:p|
+ 						p selector == m selector
+ 						and: [p methodClass ~~ m methodClass]]]]
+ 			ifFalse:
+ 				[prototypes noneSatisfy:
+ 					[:p|
+ 					p selector == m selector
+ 					and: [p methodClass == self class
+ 					and: [(p pragmaAt: #indirect) notNil]]]]]!

Item was added:
+ ----- Method: SpurBootstrap>>addMissingClassVars: (in category 'bootstrap image') -----
+ addMissingClassVars: classVars
+ 	"Add any missing class vars given classVars, a Dictionary from nonMetaClass to binding.
+ 	 Initialize any classes that get inst vars added."
+ 	| addClassVarNameSym bindingOfSym |
+ 	classVars isEmpty ifTrue:
+ 		[^self].
+ 	addClassVarNameSym := self findSymbol: #addClassVarName:.
+ 	bindingOfSym := self findSymbol: #bindingOf:.
+ 	classVars keysAndValuesDo:
+ 		[:binding :class| 
+ 		Transcript cr;  nextPutAll: 'ADDING CLASS VAR '; store: binding key; nextPutAll: ' TO '; print: class; flush.
+ 		self interpreter: oldInterpreter
+ 			object: (self oldClassOopFor: class)
+ 			perform: addClassVarNameSym
+ 			withArguments: {oldHeap stringForCString: binding key}.
+ 		literalMap
+ 			at: binding
+ 			put: (self interpreter: oldInterpreter
+ 					object: (self oldClassOopFor: class)
+ 					perform: bindingOfSym
+ 					withArguments: {self findSymbol: binding key})].
+ 	toBeInitialized := classVars asSet!

Item was changed:
  ----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') -----
  allPrototypeMethodSymbols
  	"self basicNew allPrototypeMethodSymbols"
  	| symbols |
+ 	self assert: SpurBootstrap isolatedPrototypes isEmpty.
  	symbols := Set new.
  	self prototypeClassNameMetaSelectorMethodDo:
  		[:className :isMeta :selector :method | | adder |
  		symbols
  			add: className;
  			add: selector.	
  		adder := [:lit|
  				   (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
  				   lit isArray ifTrue: [lit do: adder]].
  		method literals do: adder].
  	^symbols!

Item was changed:
  ----- Method: SpurBootstrap>>bootstrapImageUsingFileDirectory: (in category 'public access') -----
  bootstrapImageUsingFileDirectory: imageName
  	| dirName baseName dir |
  	dirName := FileDirectory dirPathFor: imageName.
  	baseName := (imageName endsWith: '.image')
  					ifTrue: [FileDirectory baseNameFor: imageName]
  					ifFalse: [FileDirectory localNameFor: imageName].
  	dir := dirName isEmpty ifTrue: [FileDirectory default] ifFalse: [FileDirectory on: dirName].
  	self on: (dir fullNameFor: baseName, '.image').
  	[self transform]
  		on: Halt
  		do: [:ex|
  			"suppress halts from the usual suspects (development time halts)"
  			(#(fullGC compactImage) includes: ex signalerContext sender selector)
  				ifTrue: [ex resume]
  				ifFalse: [ex pass]].
  	self writeSnapshot: (dir fullNameFor: baseName, '-spur.image')
  		ofTransformedImage: newHeap
  		headerFlags: oldInterpreter getImageHeaderFlags
  		screenSize: oldInterpreter savedWindowSize.
+ 	dir deleteFileNamed: baseName, '-spur.changes';
+ 		copyFileNamed: baseName, '.changes' toFileNamed: baseName, '-spur.changes'!
- 	dir copyFileNamed: (dir fullNameFor: baseName, '.changes')
- 		toFileNamed: (dir fullNameFor: baseName, '-spur.changes')!

Item was added:
+ ----- Method: SpurBootstrap>>checkReshapeOf: (in category 'bootstrap image') -----
+ checkReshapeOf: ourMethodClasses
+ 	"Check the shape of all our method classes match the shape of those in the image to be bootstrapped.
+ 	 Use the simulator to redefine any that need it.  Does /not/ reshape metaclasses; these we assume are ok."
+ 	| toReshape |
+ 	toReshape := Set new.
+ 	ourMethodClasses do:
+ 		[:mc| | binding |
+ 		binding := literalMap at: mc binding.
+ 		(mc ~~ Character "Character will reshape anyway"
+ 		 and: [mc instSize ~= (oldHeap instanceSizeOf: (oldHeap fetchPointer: ValueIndex ofObject: binding))]) ifTrue:
+ 			[toReshape add: mc]].
+ 	toReshape isEmpty ifTrue:
+ 		[^self].
+ 	"Assume only one class in any subtree needs reshaping.  Fast and loose but gets us there for now."
+ 	toReshape copy do:
+ 		[:class|
+ 		toReshape removeAll: (toReshape select: [:ea| ea inheritsFrom: class])].
+ 	toReshape do:
+ 		[:class|
+ 		Transcript cr;  nextPutAll: 'RESHAPING '; print: class; flush.
+ 		self interpreter: oldInterpreter
+ 			object: (self oldClassOopFor: Compiler)
+ 			perform: (self findSymbol: #evaluate:)
+ 			withArguments: {oldHeap stringForCString: class definition}]!

Item was changed:
  ----- Method: SpurBootstrap>>clone:classIndex: (in category 'bootstrap image') -----
  clone: oldObj classIndex: classIndex
+ 	| newObj format numBytes |
+ 	((format := oldHeap formatOf: oldObj) >= oldHeap firstLongFormat
+ 	 and: [numBytes := oldHeap numBytesOf: oldObj.
+ 		format >= oldHeap firstCompiledMethodFormat
+ 		and: [(oldInterpreter primitiveIndexOf: oldObj) > 0]]) ifTrue:
+ 			[numBytes := numBytes + 3].
- 	| newObj |
  	newObj := newHeap
+ 				allocateSlots: (format >= oldHeap firstLongFormat
+ 								ifTrue: [newHeap numSlotsForBytes: numBytes]
- 				allocateSlots: (((oldHeap isCompiledMethod: oldObj) and: [(oldInterpreter primitiveIndexOf: oldObj) > 0])
- 								ifTrue: [(oldHeap byteSizeOf: oldObj) + 3 + self wordSize - 1 // self wordSize]
  								ifFalse: [oldHeap numSlotsOf: oldObj])
+ 				format: (self newFormatFor: oldObj numBytes: numBytes)
- 				format: (self newFormatFor: oldObj)
  				classIndex: classIndex.
  	reverseMap at: newObj put: oldObj.
  	^map at: oldObj put: newObj!

Item was changed:
  ----- Method: SpurBootstrap>>cloneMethodProxy: (in category 'bootstrap methods') -----
  cloneMethodProxy: proxy "<VMCompiledMethodProxy>"
+ 	| bytes newMethod delta |
- 	| bytes newMethod |
  	bytes := proxy size - proxy initialPC + 1.
+ 	delta := proxy primitive > 0
+ 				ifTrue: [3]
+ 				ifFalse: [0].
  	newMethod := CompiledMethod
+ 						newMethod: bytes + delta
+ 						header: (self convertOldMethodHeader: (oldHeap integerObjectOf: proxy header)).
- 						newMethod: bytes
- 						header: proxy header.
  	1 to: proxy numLiterals - 1 do:
  		[:i| newMethod literalAt: i put: (proxy literalAt: i)].
  	newMethod
  		literalAt: proxy numLiterals
  		put: (Smalltalk bindingOf: #Character).
+ 	delta > 0 ifTrue:
+ 		[newMethod
+ 			at: newMethod initialPC + 0 put: 139;
+ 			at: newMethod initialPC + 1 put: (proxy primitive bitAnd: 16rFF);
+ 			at: newMethod initialPC + 2 put: (proxy primitive bitShift: -8)].
  	proxy initialPC to: proxy size do:
+ 		[:i| newMethod at: i + delta put: (proxy at: i)].
- 		[:i| newMethod at: i put: (proxy at: i)].
  	^newMethod!

Item was changed:
  ----- Method: SpurBootstrap>>convertOldMethodHeader: (in category 'bootstrap image') -----
  convertOldMethodHeader: methodHeader
+ 	^((oldInterpreter argumentCountOfMethodHeader: methodHeader) << 24)
+ 	 + ((oldInterpreter temporaryCountOfMethodHeader: methodHeader) << 18)
+ 	 + ((oldInterpreter methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [1 << 17] ifFalse: [0])
+ 	 + ((oldInterpreter methodHeaderHasPrimitive: methodHeader) ifTrue: [1 << 16] ifFalse: [0])
+ 	 + (oldHeap literalCountOfMethodHeader: methodHeader)!
- 	^newHeap integerObjectOf:
- 		   ((oldInterpreter argumentCountOfMethodHeader: methodHeader) << 24)
- 		+ ((oldInterpreter temporaryCountOfMethodHeader: methodHeader) << 18)
- 		+ ((oldInterpreter methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [1 << 17] ifFalse: [0])
- 		+ ((oldInterpreter methodHeaderHasPrimitive: methodHeader) ifTrue: [1 << 16] ifFalse: [0])
- 		+ (oldHeap literalCountOfMethodHeader: methodHeader)!

Item was changed:
  ----- Method: SpurBootstrap>>fileOutPrototypesFor: (in category 'public access') -----
  fileOutPrototypesFor: imageTypeOrArrayOfTypes
  	"SpurBootstrap new fileOutPrototypesFor: 'squeak'"
  	| internalStream |
  	imageTypes := imageTypeOrArrayOfTypes isString
  						ifTrue: [{imageTypeOrArrayOfTypes}]
  						ifFalse: [imageTypeOrArrayOfTypes asArray].
  	internalStream := WriteStream on: (String new: 1000).
  	internalStream header; timeStamp.
  	self prototypeClassNameMetaSelectorMethodDo:
  		[:className :isMeta :selector :method| | class category preamble source |
  		class := Smalltalk classNamed: className.
  		isMeta ifTrue: [class := class class].
  		category := (class organization categoryOfElement: selector) ifNil:
  						[self class categoryForClass: className meta: isMeta selector: selector].
  		preamble := class name, ' methodsFor: ' , category asString printString, ' stamp: ''', method timeStamp, ''''.
  		internalStream nextPut: $!!; nextChunkPut: preamble; cr.
  		source := method getSourceFromFile asString.
  		source := source copyFrom: (source indexOfSubCollection: 'PROTOTYPE') + 9 to: source size.
+ 		(self selectorForPrototypeMethod: method) isBinary ifTrue:
+ 			[source := (self selectorForPrototypeMethod: method), (source copyFrom: (source indexOf: Character space) to: source size)].
  		internalStream nextChunkPut: source; space; nextPut: $!!; cr; cr].
  	internalStream trailer.
  
  	FileStream
  		writeSourceCodeFrom: internalStream
  		baseName: 'SpurBootstrapPrototypes'
  		isSt: true
  		useHtml: false!

Item was changed:
  ----- Method: SpurBootstrap>>fillInCompiledMethod:from: (in category 'bootstrap image') -----
  fillInCompiledMethod: newObj from: oldObj
  	| firstByteIndex primIndex |
  	self fillInPointerObject: newObj from: oldObj.
  	"Now convert the CompiledMethod's format.  First write the header in the new format"
  	newHeap
  		storePointerUnchecked: 0
  		ofObject: newObj
+ 		withValue: (newHeap integerObjectOf: (self convertOldMethodHeader: (oldHeap fetchPointer: 0 ofObject: oldObj))).
- 		withValue: (self convertOldMethodHeader: (oldHeap fetchPointer: 0 ofObject: oldObj)).
  	"Then if necessary prepend the callPrimitive: bytecode"
  	(primIndex := oldInterpreter primitiveIndexOf: oldObj) > 0
  		ifTrue:
  			[firstByteIndex := oldHeap lastPointerOf: oldObj.
  			 newHeap
  				storeByte: firstByteIndex + 0 ofObject: newObj withValue: 139;
  				storeByte: firstByteIndex + 1 ofObject: newObj withValue: (primIndex bitAnd: 255);
  				storeByte: firstByteIndex + 2 ofObject: newObj withValue: (primIndex bitShift: -8).
  			 firstByteIndex to: (oldHeap numBytesOf: oldObj) - 1 do:
  				[:i|
  				newHeap storeByte: i + 3 ofObject: newObj withValue: (oldHeap fetchByte: i ofObject: oldObj)]]
  		ifFalse:
  			[(oldHeap lastPointerOf: oldObj) / oldHeap wordSize to: (oldHeap numSlotsOf: oldObj) - 1 do:
  				[:i|
  				newHeap storeLong32: i ofObject: newObj withValue: (oldHeap fetchLong32: i ofObject: oldObj)]]!

Item was changed:
  ----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
  findRequiredGlobals
  	"Look for the necessary gobal bindings in the prototype methods in the old image.
+ 	 This has to be done early by sending bindingOf: to Smalltalk.  Collect the class
+ 	 hierarchy of all prototypes that access inst vars (non-local prototypes) to check
+ 	 their shapes.  Also find out Metaclass, needed for identifying classes."
+ 	| globals ourMethodClasses classVars bindingOfSym |
- 	 This has to be done early by sending bindingOf: to Smalltalk.  Also find out
- 	 Metaclass, needed for identofying classes."
- 	| globals bindingOf |
  	globals := Set new.
+ 	ourMethodClasses := Set new.
+ 	classVars := Dictionary new.
  	self prototypeClassNameMetaSelectorMethodDo:
+ 		[:c :m :s :method| | nonMetaClass allNonMetaSupers |
+ 		allNonMetaSupers := (nonMetaClass := Smalltalk classNamed: c) withAllSuperclasses.
+ 		method methodClass ~= SpurBootstrap class ifTrue:
+ 			[ourMethodClasses addAll: allNonMetaSupers].
+ 		globals addAll: (allNonMetaSupers collect: [:sc| sc binding]).
+ 		method literals do:
+ 			[:l|
+ 			(l isVariableBinding and: [l key isSymbol]) ifTrue:
+ 				[(Smalltalk bindingOf: l key) == l
+ 					ifTrue: [globals add: l]
+ 					ifFalse:
+ 						[self assert: (nonMetaClass bindingOf: l key) == l.
+ 						classVars at: l put: nonMetaClass]]]].
+ 	globals add: Compiler binding. "For potential reshaping in checkReshapeOf:"
+ 	bindingOfSym := self findSymbol: #bindingOf:.
- 		[:c :m :s :method|
- 		globals addAll: (method literals select: [:l|
- 										l isVariableBinding
- 										and: [l key isSymbol
- 										and: [(Smalltalk bindingOf: l key) == l]]])].
- 	bindingOf := self findSymbol: #bindingOf:.
  	self withExecutableInterpreter: oldInterpreter
+ 		do:	[| toBeAdded |
+ 			globals do:
- 		do:	[globals do:
  				[:global|
  				literalMap
  					at: global
  					put: (self interpreter: oldInterpreter
  							object: (oldHeap splObj: 8) "Smalltalk"
+ 							perform: bindingOfSym
+ 							withArguments: {self findSymbol: global key})].
+ 			 toBeAdded := Dictionary new.
+ 			 classVars keysAndValuesDo:
+ 				[:var :class| | val |
+ 				(self findSymbol: var key) "New class inst vars may not yet be interned."
+ 					ifNil: [toBeAdded at: var put: class]
+ 					ifNotNil:
+ 						[:varName|
+ 						val := self interpreter: oldInterpreter
+ 									object: (self oldClassOopFor: class)
+ 									perform: bindingOfSym
+ 									withArguments: {varName}.
+ 						val ~= oldHeap nilObject
+ 							ifTrue: [literalMap at: var put: val]
+ 							ifFalse: [toBeAdded at: var put: class]]].
+ 			"May have to redefine to add missing inst vars and/or add any missing class vars."
+ 			self checkReshapeOf: ourMethodClasses.
+ 			self addMissingClassVars: toBeAdded].
- 							perform: bindingOf
- 							withArguments: {self findSymbol: global key})]].
- 
  	classMetaclass := oldHeap fetchClassOfNonImm: (oldHeap fetchClassOfNonImm: oldHeap classArray)!

Item was changed:
  ----- Method: SpurBootstrap>>findSymbol: (in category 'bootstrap methods') -----
  findSymbol: aString
  	"Find the Symbol equal to aString in oldHeap."
  	| symbolClass |
  	(literalMap at: aString ifAbsent: nil) ifNotNil:
  		[:oop| ^oop].
  	symbolClass := self symbolClass.
  	oldHeap allObjectsDo:
  		[:obj|
  		(symbolClass = (oldHeap fetchClassOfNonImm: obj)
  		 and: [(oldHeap numBytesOf: obj) = aString size
  		 and: [aString = (oldHeap stringOf: obj)]]) ifTrue:
+ 			[aString isSymbol ifTrue:
+ 				[literalMap at: aString asSymbol put: obj].
+ 			 ^obj]].
+ 	Transcript cr; nextPutAll: 'Warning, could not find '; store: aString; flush.
- 			[^obj]].
  	^nil!

Item was added:
+ ----- Method: SpurBootstrap>>imageTypes: (in category 'bootstrap image') -----
+ imageTypes: anArray
+ 	imageTypes := anArray!

Item was changed:
  ----- Method: SpurBootstrap>>initMaps (in category 'initialize-release') -----
  initMaps
  	map := Dictionary new: oldHeap memory size // 4.
  	reverseMap := Dictionary new: oldHeap memory size // 4.
  	classToIndex := Dictionary new: 1024.
  	literalMap := IdentityDictionary new.
  	methodClasses := Set new.
  	installedPrototypes := Set new.
+ 	classMetaclass := nil!
- 	sizeSym := rehashSym := classMetaclass := nil!

Item was added:
+ ----- Method: SpurBootstrap>>initializeClasses (in category 'bootstrap image') -----
+ initializeClasses
+ 	self withExecutableInterpreter: oldInterpreter
+ 		do: [toBeInitialized do:
+ 				[:class|
+ 				self interpreter: oldInterpreter
+ 					object: (self oldClassOopFor: class)
+ 					perform: (self findSymbol: #initialize)
+ 					withArguments: #()]]!

Item was changed:
  ----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') -----
  installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta
  	"Create a sourceless method to install in the bootstrapped image.  It will allow the
  	 bootstrap to limp along until the relevant transformed Monticello package is loaded."
+ 	| compiledMethodClass methodClassBinding methodClass sourcelessMethod bytes newMethod delta initialPC |
- 	| compiledMethodClass methodClassBinding methodClass sourcelessMethod bytes newMethod |
  	compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod).
  	methodClassBinding := self methodClassBindingForClassName: className isMeta: isMeta.
  	methodClass := oldHeap fetchPointer: ValueIndex ofObject: methodClassBinding.
  	"the prototypes have source pointers.  the Character methods to be replaced don't."
  	sourcelessMethod := aCompiledMethod trailer hasSourcePointer
  							ifTrue: [aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode]
  							ifFalse: [aCompiledMethod].
+ 	initialPC := sourcelessMethod initialPC.
+ 	bytes := sourcelessMethod size - initialPC + 1.
+ 	"Ugh, this is complicated.  We could be running on Spur with the new method format
+ 	 or on non-Spur with the old format.  Make both work."
+ 	delta := (sourcelessMethod primitive > 0
+ 			 and: [(sourcelessMethod at: initialPC) = sourcelessMethod encoderClass callPrimitiveCode])
+ 				ifTrue: [3]
+ 				ifFalse: [0].
- 	bytes := sourcelessMethod size - sourcelessMethod initialPC + 1.
  	newMethod := self
  					interpreter: oldInterpreter
  					object: compiledMethodClass
  					perform: (self findSymbol: #newMethod:header:)
+ 					withArguments: { oldHeap integerObjectOf: bytes - delta.
+ 									   oldHeap integerObjectOf: (self oldFormatHeaderFor: sourcelessMethod) }.
- 					withArguments: { oldHeap integerObjectOf: bytes.
- 									   oldHeap integerObjectOf: sourcelessMethod header }.
  	1 to: sourcelessMethod numLiterals - 2 do:
  		[:i| | literal oop |
  		literal := sourcelessMethod literalAt: i.
  		oop := (literal isLiteral or: [literal isVariableBinding])
  					ifTrue:
  						[literal isInteger
  							ifTrue: [oldHeap integerObjectOf: literal]
  							ifFalse: [literalMap
  										at: literal
  										ifAbsent: [self findLiteral: literal
  														inClass: methodClass]]]
  					ifFalse: "should be a VMObjectProxy"
  						[literal oop].
  		oldHeap storePointer: i ofObject: newMethod withValue: oop].
  	oldHeap
  		storePointer: sourcelessMethod numLiterals - 1
  		ofObject: newMethod
  		withValue: (selector isSymbol
  						ifTrue: [self findSymbol: selector]
  						ifFalse: [selector oop]);
  		storePointer: sourcelessMethod numLiterals
  		ofObject: newMethod
+ 		withValue: methodClassBinding.
+ 	initialPC to: sourcelessMethod size - delta do:
- 		withValue: methodClass.
- 	sourcelessMethod initialPC to: sourcelessMethod size do:
  		[:i|
+ 		oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i + delta)].
- 		oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i)].
  	^newMethod!

Item was changed:
  ----- Method: SpurBootstrap>>internAllSymbols (in category 'bootstrap methods') -----
  internAllSymbols
  	"Ensure that all symbols in the method prototypes are interned so that later we can install them.
  	 Enter them into the map, this system's symbol -> oldHeap's version.
  	 Do this by interpreting Symbol intern: 'aSymbol' for each symbol."
+ 	| internSym all symbolClass |
- 	| internSym |
  	internSym := self findSymbol: #intern:.
+ 	symbolClass := self symbolClass.
+ 	all := self allPrototypeMethodSymbols.
+ 	oldHeap allObjectsDo:
+ 		[:objOop| | sz |
+ 		symbolClass = (oldHeap fetchClassOfNonImm: objOop) ifTrue:
+ 			[sz := oldHeap numBytesOf: objOop.
+ 			 (all detect: [:sym| sym size = sz and: [sym = (oldHeap stringOf: objOop)]]
+ 				ifNone: nil) ifNotNil:
+ 					[:sym|
+ 					literalMap at: sym put: objOop.
+ 					all remove: sym]]].
+ 	all do: [:sym|
- 	self allPrototypeMethodSymbols do:
- 		[:sym|
  		(self findSymbol: sym)
  			ifNotNil: [:imageSym| literalMap at: sym put: imageSym]
  			ifNil:[Transcript cr; nextPutAll: 'interning '; nextPutAll: sym; flush.
  				"Interpret Symbol intern: sym to ... intern it :-)"
  				literalMap
  					at: sym
  					put: (self interpreter: oldInterpreter
  							object: self symbolClass
  							perform: internSym
  							withArguments: {self stringFor: sym})]].
  	literalMap keysAndValuesDo:
  		[:symOrGlobal :imageSymOrGlobal|
  		symOrGlobal isSymbol ifTrue:
  			[self assert: symOrGlobal = (oldHeap stringOf: imageSymOrGlobal)]]!

Item was removed:
- ----- Method: SpurBootstrap>>newFormatFor: (in category 'bootstrap image') -----
- newFormatFor: oldObj
- 	"OLD:
- 	 0	no fields
- 	 1	fixed fields only (all containing pointers)
- 	 2	indexable fields only (all containing pointers)
- 	 3	both fixed and indexable fields (all containing pointers)
- 	 4	both fixed and indexable weak fields (all containing pointers).
- 
- 	 5	unused
- 	 6	indexable word fields only (no pointers)
- 	 7	indexable long (64-bit) fields (only in 64-bit images)
-  
- 	 8-11	indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
- 	 12-15	compiled methods:
- 	 	    # of literal oops specified in method header,
- 	 	    followed by indexable bytes (same interpretation of low 2 bits as above)"
- 
- 	"NEW:
- 	 0 = 0 sized objects (UndefinedObject True False et al)
- 	 1 = non-indexable objects with inst vars (Point et al)
- 	 2 = indexable objects with no inst vars (Array et al)
- 	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 	 4 = weak indexable objects with inst vars (WeakArray et al)
- 	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 
- 	 and here it gets messy, we need 8 CompiledMethod values, 8 byte values, 4 16-bit values, 2 32-bit values and a 64-bit value, = 23 values, 23 + 5 = 30, so there may be room.
- 
- 	 9 (?) 64-bit indexable
- 	 10 - 11 32-bit indexable
- 	 12 - 15 16-bit indexable
- 	 16 - 23 byte indexable
- 	 24 - 31 compiled method"
- 	| oldFormat |
- 	oldFormat := oldHeap formatOf: oldObj.
- 	oldFormat <= 4 ifTrue:
- 		[^oldFormat].
- 	oldFormat >= 12 ifTrue: "CompiledMethod"
- 		[^24 + (self wordSize - (oldHeap numBytesOf: oldObj) bitAnd: self wordSizeMask)].
- 	oldFormat >= 8 ifTrue: "ByteArray et al"
- 		[^16 + (self wordSize - (oldHeap numBytesOf: oldObj) bitAnd: self wordSizeMask)].
- 	oldFormat = 6 ifTrue: "32-bit indexable"
- 		[^10 + ((oldHeap numBytesOf: oldObj) bitAnd: self wordSizeMask) sign].
- 	oldFormat = 7 ifTrue: "64-bit indexable"
- 		[^9].
- 	self error: 'illegal old format'!

Item was added:
+ ----- Method: SpurBootstrap>>newFormatFor:numBytes: (in category 'bootstrap image') -----
+ newFormatFor: oldObj numBytes: numBytesIfBits
+ 	"OLD:
+ 	 0	no fields
+ 	 1	fixed fields only (all containing pointers)
+ 	 2	indexable fields only (all containing pointers)
+ 	 3	both fixed and indexable fields (all containing pointers)
+ 	 4	both fixed and indexable weak fields (all containing pointers).
+ 
+ 	 5	unused
+ 	 6	indexable word fields only (no pointers)
+ 	 7	indexable long (64-bit) fields (only in 64-bit images)
+  
+ 	 8-11	indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
+ 	 12-15	compiled methods:
+ 	 	    # of literal oops specified in method header,
+ 	 	    followed by indexable bytes (same interpretation of low 2 bits as above)"
+ 
+ 	"NEW:
+ 	 0 = 0 sized objects (UndefinedObject True False et al)
+ 	 1 = non-indexable objects with inst vars (Point et al)
+ 	 2 = indexable objects with no inst vars (Array et al)
+ 	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 	 4 = weak indexable objects with inst vars (WeakArray et al)
+ 	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6 = reserved
+ 	 7 = forwarder format (also immediate class format)
+ 	 9          64-bit indexable
+ 	 10 - 11 32-bit indexable
+ 	 12 - 15 16-bit indexable
+ 	 16 - 23 byte indexable
+ 	 24 - 31 compiled method"
+ 	| oldFormat |
+ 	oldFormat := oldHeap formatOf: oldObj.
+ 	oldFormat <= 4 ifTrue:
+ 		[^oldFormat].
+ 	oldFormat >= 12 ifTrue: "CompiledMethod"
+ 		[^24 + (self wordSize - numBytesIfBits bitAnd: self wordSizeMask)].
+ 	oldFormat >= 8 ifTrue: "ByteArray et al"
+ 		[^16 + (self wordSize - numBytesIfBits bitAnd: self wordSizeMask)].
+ 	oldFormat = 6 ifTrue: "32-bit indexable"
+ 		[^10 + (numBytesIfBits bitAnd: self wordSizeMask) sign].
+ 	oldFormat = 7 ifTrue: "64-bit indexable"
+ 		[^9].
+ 	self error: 'illegal old format'!

Item was added:
+ ----- Method: SpurBootstrap>>oldClassOopFor: (in category 'bootstrap image') -----
+ oldClassOopFor: aClass
+ 	^oldHeap fetchPointer: ValueIndex ofObject: (literalMap at: aClass binding).!

Item was added:
+ ----- Method: SpurBootstrap>>oldFormatHeaderFor: (in category 'bootstrap methods') -----
+ oldFormatHeaderFor: method
+ 	| primBits primitive |
+ 	primitive := method primitive.
+ 	primBits := primitive <= 16r1FF
+ 					ifTrue: [primitive]
+ 					ifFalse: [(primitive bitAnd: 16r1FF) + ((primitive bitAnd: 16r200) bitShift: 19)].
+ 	^(method numArgs bitShift: 24)
+ 	+ (method numTemps bitShift: 18)
+ 	+ (method frameSize > method class smallFrameSize ifTrue: [1 << 17] ifFalse: [0])
+ 	+ (method numLiterals bitShift: 9)
+ 	+ primBits!

Item was changed:
  ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
  rehashImage
  	"Rehash all collections in newHeap.
  	 Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
  	 Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
+ 	| n sim rehashFlags dotDate rehashSym sizeSym |
+ 	rehashSym := map at: (self findSymbol: #rehash).
+ 	sizeSym := map at: (self findSymbol: #size).
- 	| n sim rehashFlags dotDate |
  	sim := StackInterpreterSimulator onObjectMemory: newHeap.
  	sim 
  		setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
  		imageName: 'spur image';
  		assertValidExecutionPointersAtEachStep: false..
  	newHeap coInterpreter: sim.
  	sim bootstrapping: true.
  	sim initializeInterpreter: 0.
  	sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
  
  	newHeap
  		setHashBitsOf: newHeap nilObject to: 1;
  		setHashBitsOf: newHeap falseObject to: 2;
  		setHashBitsOf: newHeap trueObject to: 3.
  
  	rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
  	n := 0.
  	newHeap classTableObjectsDo:
  		[:class| | classIndex |
+ 		sim messageSelector: rehashSym.
- 		sim messageSelector: (map at: rehashSym).
  		"Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
  		((sim lookupMethodNoMNUEtcInClass: class) = 0
  		 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
  			[n := n + 1.
  			 classIndex := newHeap rawHashBitsOf: class.
  			 rehashFlags
  				at: classIndex >> 3 + 1
  				put: ((rehashFlags at: classIndex >> 3 + 1)
  						bitOr: (1 << (classIndex bitAnd: 7)))]].
  	Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
  	dotDate := Time now asSeconds.
  	n := 0.
  	self withExecutableInterpreter: sim
  		do: [sim setBreakSelector: 'error:'.
  			 "don't rehash twice (actually without limit), so don't rehash any new objects created."
  			 newHeap allExistingOldSpaceObjectsDo:
  				[:o| | classIndex |
  				classIndex := newHeap classIndexOf: o.
  				((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
  					[Time now asSeconds > dotDate ifTrue:
  					 	[Transcript nextPut: $.; flush.
  						 dotDate := Time now asSeconds].
  					 "2845 = n ifTrue: [self halt]."
  					 "Rehash an object if its size is > 0.
  					  Symbol implements rehash, but let's not waste time rehashing it; in Squeak
  					  up to 2013 symbols are kept in a set which will get reashed anyway..
  					  Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
  					 ((sim addressCouldBeClassObj: o)
  					   or: [(self interpreter: sim
  							object: o
+ 							perform: sizeSym
- 							perform: (map at: sizeSym)
  							withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
  						[self interpreter: sim
  							object: o
+ 							perform: rehashSym
- 							perform: (map at: rehashSym)
  							withArguments: #()]]]]!

Item was removed:
- ----- Method: SpurBootstrap>>rememberRehashSymbol (in category 'bootstrap image') -----
- rememberRehashSymbol
- 	rehashSym := self findSymbol: #rehash.
- 	sizeSym := self findSymbol: #size!

Item was changed:
  ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') -----
  replacementForCharacterMethod: characterMethodOop
  	"Answer a replacement method for the argument if it refers
  	 to Character's old inst var value.  Otherwise answer nil."
  	| proxy asIntegerProxy clone assembly newInsts newMethod |
  	"(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue:
  		[self halt]."
  	proxy := VMCompiledMethodProxy new
  				for: characterMethodOop
  				coInterpreter: oldInterpreter
  				objectMemory: oldHeap.
+ 	self assert: (oldHeap literalCountOf: characterMethodOop) = proxy numLiterals.
  	clone := self cloneMethodProxy: proxy.
+ 	self assert: proxy numLiterals = clone numLiterals.
  	"Quick methods accessing value should have been replaced.  The halt will fire if there
  	 is a missing prototype for such a method on the class side of SpurBootstrap.  The
  	 relevant Character prototypes there so far are Character>>asInteger, Character>>
  	 asciiValue, Character>>hash & Character>>identityHash.  Conceivably the bootstrap
  	 could be applied to an image that has others; hence the halt."
  	clone isReturnField ifTrue: [self halt].
  	clone hasInstVarRef ifFalse:
  		[^nil].
  	clone setSourcePointer: 0.
  	asIntegerProxy := VMObjectProxy new
  							for: (literalMap at: #asInteger)
  							coInterpreter: oldInterpreter
  							objectMemory: oldHeap.
  	assembly := BytecodeDisassembler new disassemble: clone.
  	assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2).
  		"Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger"
  	newInsts := (assembly instructions piecesCutWhere:
  					[:msgOrLabelAssoc :nextInst|
  					 msgOrLabelAssoc isVariableBinding not
  					 and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold:
  				[:a :b|
  				 a allButLast,
  				 {	Message selector: #pushReceiver.
  					Message
  						selector: #send:super:numArgs:
  						arguments: {asIntegerProxy. false. 0}},
  				 b].
  	assembly instructions: newInsts.
  	newMethod := assembly assemble.
+ 	self assert: clone numLiterals + 1 = newMethod numLiterals.
  	^self
  		installableMethodFor: newMethod
  		selector: clone selector
  		className: #Character
  		isMeta: false!

Item was changed:
  ----- Method: SpurBootstrap>>transform (in category 'bootstrap image') -----
  transform
- 	self rememberRehashSymbol.
  	self findRequiredGlobals.
  	self installModifiedMethods.
  	self recreateSpecialObjectsArray.
+ 	self initializeClasses.
  	self bootstrapImage.
  	self validate.
- 	self rememberRehashSymbol.
  	self rehashImage.
  	self followForwardingPointers.
  	self scavengeImage.
  	self freeForwarders.
  	self compactImage.
  	self reportSizes!

Item was changed:
  ----- Method: SpurBootstrap>>writeSnapshot:ofTransformedImage:headerFlags:screenSize: (in category 'testing') -----
  writeSnapshot: imageFileName ofTransformedImage: spurHeap headerFlags: headerFlags screenSize: screenSizeInteger
  	"The bootstrapped image typically contains a few big free chunks and one huge free chunk.
  	 Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
  	 and saving."
  	| penultimate ultimate sizes counts barriers sim |
  	sim := StackInterpreterSimulator onObjectMemory: spurHeap.
  	sim bootstrapping: true.
  	spurHeap
  		coInterpreter: sim;
  		setEndOfMemory: spurHeap endOfMemory + spurHeap bridgeSize. "hack; initializeInterpreter: cuts it back by bridgeSize"
  	sim initializeInterpreter: 0;
  		setImageHeaderFlagsFrom: headerFlags;
  		setDisplayForm: nil.
  	spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
  	(spurHeap isFreeObject: penultimate) ifTrue: "old, pre-pigCompact segmented save"
  		[self assert: (spurHeap isSegmentBridge: ultimate).
  		 sizes := Bag new.
  		 spurHeap allObjectsInFreeTree: (spurHeap freeLists at: 0) do:
  			[:f|
  			sizes add: (spurHeap bytesInObject: f)].
  		 counts := sizes sortedCounts.
  		 self assert: counts last key = 1. "1 huge chunk"
  		 counts size > 1
  			ifTrue:
  				[self assert: ((counts at: counts size - 1) key > 2
  							and: [(counts at: counts size - 1) value > 1024]).
  				barriers := (1 to: (counts at: counts size - 1) key) collect:
  								[:ign| spurHeap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value].
  				barriers := barriers, {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}]
  			ifFalse:
  				[barriers := {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}].
  		 barriers last ifNotNil:
  			[:end|
  			spurHeap setEndOfMemory: end.
  			spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
  			self assert: (spurHeap addressAfter: ultimate) = end]].
  	spurHeap checkFreeSpace.
  	spurHeap runLeakCheckerForFullGC: true.
  	barriers ifNotNil: "old, pre-pigCompact segmented save"
  		[spurHeap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| spurHeap objectStartingAt: b])].
  	spurHeap checkFreeSpace.
  	spurHeap runLeakCheckerForFullGC: true.
  	sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
  	sim imageName: imageFileName.
+ 	sim writeImageFileIO.
+ 	Transcript cr; show: 'Done!!'!
- 	sim writeImageFileIO!

Item was changed:
  Object subclass: #SpurBootstrapMonticelloPackagePatcher
+ 	instanceVariableNames: 'sourceDir destDir packagesAndPatches imageTypes'
- 	instanceVariableNames: 'sourceDir destDir packagesAndPatches'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Cog-Bootstrapping'!
  
  !SpurBootstrapMonticelloPackagePatcher commentStamp: 'eem 1/15/2014 17:59' prior: 0!
  A SpurBootstrapMonticelloPackagePatcher is used to construct a new set of patched Monticello packages for Spur.  The use case is some bootstrap process loads a set of Monticello packages.  To repeat the bootstrap with a Spur image the bootstrap must use suitably patched Monticello packages containing the new method versions on the class side of SpurBootstrap.
  
  Instance Variables
  	destDir:			<FileDirectory>
  	sourceDir:		<FileDirectory>
  
  destDir
  	- directory to which patched packages are to be written
  
  sourceDir
  	- directory from which packages to be patched are to be read!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>compiledMethodClassDefinition (in category 'private-accessing') -----
+ compiledMethodClassDefinition
+ 	^MCAddition of: 
+ 		(MCClassDefinition name: #CompiledMethod
+ 			superclassName: #ByteArray
+ 			category: #'Kernel-Methods'
+ 			instVarNames: #()
+ 			classVarNames: #(LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame)
+ 			poolDictionaryNames: #()
+ 			classInstVarNames: #()
+ 			type: #compiledMethod
+ 			comment:
+ 'CompiledMethod instances are methods suitable for interpretation by the virtual machine.  Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields.  The first part of a CompiledMethod is pointers, the second part is bytes.  CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray''s methods, not because a CompiledMethod is-a ByteArray.
+ 
+ Class variables:
+ SmallFrame								- the number of stack slots in a small frame Context
+ LargeFrame							- the number of stack slots in a large frame Context
+ PrimaryBytecodeSetEncoderClass		- the encoder class that defines the primary instruction set
+ SecondaryBytecodeSetEncoderClass	- the encoder class that defines the secondary instruction set
+ 
+ The current format of a CompiledMethod is as follows:
+ 
+ 	header (4 or 8 bytes, SmallInteger)
+ 	literals (4 or 8 bytes each, Object, see "The last literal..." below)
+ 	bytecodes  (variable, bytes)
+ 	trailer (variable, bytes)
+ 
+ The header is a 31-bit signed integer (a SmallInteger) in the following format:
+ 
+ 	(index 0)		16 bits:	number of literals (#numLiterals)
+ 	(index 16)		  1 bit:	has primitive
+ 	(index 17)		  1 bit:	whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
+ 	(index 18)		  6 bits:	number of temporary variables (#numTemps)
+ 	(index 24)		  4 bits:	number of arguments to the method (#numArgs)
+ 	(index 28)		  2 bits:	reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
+ 	(index 30/63)	sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4, 0 selects the primary instruction set, e.g. SqueakV3PlusClosures) (#signFlag)
+ 
+ If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.
+ 
+ The trailer is an encoding of an instance of CompiledMethodTrailer.  It is typically used to encode the index into the source files array of the method''s source, but may be used to encode other values, e.g. tempNames, source as a string, etc.  See the class CompiledMethodTrailer.
+ 
+ The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in.  The methodClassAssociation is used to implement super sends.  If a method contains no super send then its methodClassAssociation may be left nil (as would be the case for example of methods providing a pool of inst var accessors).  By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState.  AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method''s AdditionalMethodState.  Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.'
+ 			commentStamp: 'eem 8/12/2014 14:45')!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>filesForPackage:in: (in category 'private-accessing') -----
  filesForPackage: package in: aDirectory
  	^aDirectory fileNames select:
  		[:fileName|
  		(fileName beginsWith: package name)
+ 		 and: [(fileName at: package name size + 1) isLetter not
+ 		 and: [(fileName copyFrom: package name size + 2 to: package name size + 5) ~= 'spur']]]!
- 		 and: [(fileName at: package name size + 1) isLetter not]]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>imageTypes: (in category 'initialization') -----
+ imageTypes: typeArray
+ 	imageTypes := typeArray!

Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>immediateClassDefinitionFor:from: (in category 'private-accessing') -----
- immediateClassDefinitionFor: className from: definitions
- 	| classDef |
- 	classDef := definitions detect: [:d| d isClassDefinition and: [d className = className]].
- 	classDef variables removeAllSuchThat:
- 		[:varDef|
- 		 varDef isInstanceVariable and: [varDef name = 'value']].
- 	classDef instVarNamed: 'type' put: #immediate.
- 	^MCAddition of: classDef!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>immediateClassDefinitionFor:from:comment:stamp: (in category 'private-accessing') -----
+ immediateClassDefinitionFor: className from: definitions comment: commentString stamp: stampString
+ 	| classDef |
+ 	classDef := definitions detect: [:d| d isClassDefinition and: [d className = className]].
+ 	classDef variables removeAllSuchThat:
+ 		[:varDef|
+ 		 varDef isInstanceVariable and: [varDef name = 'value']].
+ 	classDef
+ 		instVarNamed: 'type' put: #immediate;
+ 		instVarNamed: 'comment' put: commentString;
+ 		instVarNamed: 'commentStamp' put: stampString.
+ 	^MCAddition of: classDef!

Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>packages (in category 'private-accessing') -----
- packages
- 	"SpurBootstrapMonticelloPackagePatcher new packages"
- 	| packages |
- 	packages := Set new.
- 	SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
- 		[:className :isMeta :selector :method| | class |
- 		 class := Smalltalk classNamed: className.
- 		 isMeta ifTrue:
- 			[class := class class].
- 		 packages add: ((class includesSelector: selector)
- 							ifTrue: [PackageOrganizer default packageOfMethod: (class >> selector) methodReference]
- 							ifFalse: [PackageOrganizer default  packageOfClass: class])].
- 	^packages!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>packagesAndPatches (in category 'private-accessing') -----
  packagesAndPatches
  	"SpurBootstrapMonticelloPackagePatcher new packagesAndPatches"
+ 	| spurBootstrap |
  	packagesAndPatches ifNotNil:
  		[^packagesAndPatches].
  	packagesAndPatches := Dictionary new.
+ 	spurBootstrap := SpurBootstrap new.
+ 	imageTypes ifNotNil:
+ 		[spurBootstrap imageTypes: imageTypes].
+ 	spurBootstrap prototypeClassNameMetaSelectorMethodDo:
- 	SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
  		[:className :isMeta :selector :method| | class methodReference source |
  		 class := Smalltalk classNamed: className.
  		 isMeta ifTrue:
  			[class := class class].
  		 methodReference := (class includesSelector: selector) ifTrue:
  								[(class >> selector) methodReference].
  		 (methodReference notNil
  		  and: [methodReference category = Categorizer default]) ifTrue:
  			[methodReference := nil].
  		 source := method getSourceFromFile asString allButFirst: method selector size - selector size.
  		 source first ~= selector first ifTrue:
  			[source replaceFrom: 1 to: selector size with: selector startingAt: 1].
  		 (packagesAndPatches
  				at: (methodReference
  						ifNotNil: [PackageOrganizer default packageOfMethod: methodReference]
  						ifNil: [PackageOrganizer default packageOfClass: class])
  				ifAbsentPut: [OrderedCollection new])
  			add: (MCAddition of: (MCMethodDefinition
  									className: className
  									classIsMeta: isMeta
  									selector: selector
  									category: (methodReference
  												ifNotNil: [methodReference category]
  												ifNil: [SpurBootstrap
  														categoryForClass: className
  														meta: isMeta
  														selector: selector])
  									timeStamp: method timeStamp
  									source: source))].
  	^packagesAndPatches!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchForPackage:withPatches:snapshot: (in category 'patching') -----
  patchForPackage: package withPatches: patches snapshot: snapshot
  	(package includesClass: Character) ifTrue:
  		[patches
  			addAll: ((self modifiedCharacterDefinitionsIn: snapshot definitions)
  						select:
  							[:def|
  							 patches noneSatisfy:
  								[:addition|
  								def isMethodDefinition
  								and: [addition definition selector = def selector
  								and: [addition definition className = def className
  								and: [addition definition classIsMeta = def classIsMeta]]]]]
  						thenCollect:
  							[:def|
  							 ((def source includesSubString: 'DELETEME')
  								ifTrue: [MCRemoval]
  								ifFalse: [MCAddition]) of: def]);
+ 			add: (self immediateClassDefinitionFor: #Character
+ 					from: snapshot definitions
+ 					comment: 'I represent a character by storing its associated Unicode as an unsigned 30-bit value.  Characters are created uniquely, so that all instances of a particular Unicode are identical.  My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values.
+ 
+ 	The code point is based on Unicode.  Since Unicode is 21-bit wide character set, we have several bits available for other information.  As the Unicode Standard  states, a Unicode code point doesn''t carry the language information.  This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean.  Or often CJKV including Vietnamese).  Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools.  To utilize the extra available bits, we use them for identifying the languages.  Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages.
+ 
+ 	The other languages can have the language tag if you like.  This will help to break the large default font (font set) into separately loadable chunk of fonts.  However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.'
+ 					stamp: 'eem 8/12/2014 14:53')].
- 			add: (self immediateClassDefinitionFor: #Character from: snapshot definitions)].
  	(package includesClass: SmallInteger) ifTrue:
  		[patches
+ 			add: (self
+ 					immediateClassDefinitionFor: #SmallInteger
+ 					from: snapshot definitions
+ 					comment: 'My instances are 31-bit numbers, stored in twos complement form. The allowable range is approximately +- 1 billion (see SmallInteger minVal, maxVal).  My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values.'
+ 					stamp: 'eem 8/12/2014 14:54')].
+ 	(package includesClass: CompiledMethod) ifTrue:
+ 		[patches
+ 			add: (self compiledMethodClassDefinition)].
- 			add: (self immediateClassDefinitionFor: #SmallInteger from: snapshot definitions)].
  	^MCPatch operations: patches!

Item was changed:
  ----- Method: SpurOldToNewMethodFormatMunger>>snapshot (in category 'saving') -----
  snapshot
  	Spur32BitMMLESimulator adoptInstance: heap.
  	interpreter imageName: 'munged-', (FileDirectory default localNameFor: interpreter imageName).
  	[heap parent: heap; setCheckForLeaks: 15; garbageCollectForSnapshot]
  		on: Halt
  		do: [:ex|
  			"suppress halts from the usual suspects (development time halts)"
  			(#(fullGC globalGarbageCollect) includes: ex signalerContext sender selector)
  				ifTrue: [ex resume]
  				ifFalse: [ex pass]].
  	interpreter
  		setDisplayForm: nil; "gets it to use savedWindowSize"
+ 		writeImageFileIO.
+ 	Transcript cr; show: 'Done!!'!
- 		writeImageFileIO!



More information about the Vm-dev mailing list