[Vm-dev] VM Maker: VMMaker.oscog-eem.1478.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Sep 29 01:53:42 UTC 2015


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

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

Name: VMMaker.oscog-eem.1478
Author: eem
Time: 28 September 2015, 6:52:02.984 pm
UUID: 4a4c879d-a0f7-426c-a63a-a573dac30c7f
Ancestors: VMMaker.oscog-eem.1477

Fux a spleen errorre

=============== Diff against VMMaker.oscog-eem.1477 ===============

Item was changed:
  ----- Method: CCodeGenerator>>inferTypesForImplicitlyTypedVariablesAndMethods (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesAndMethods
  	"Infer the return tupe and the types of untyped variables.
  	 As far as variables go, for now we try only to infer variables
  	 assigned the result of #longLongAt:, but much more could be
  	 done here."
  
  	"Iterate over all methods, inferring #void return types, until we reach a fixed point."
  	| allMethods |
  	allMethods := apiMethods
  					ifNil: [methods]
  					ifNotNil: [(Set withAll: methods)
  								addAll: apiMethods;
  								yourself].
  	"Make an initial pass to assign the return types of all simple methods that return constants,
  	 or those that have explicit return types."						
  	allMethods do:
  		[:m|
+ 		m removeFinalSelfReturnIn: self. "must precede recordDeclarationsIn: because it may set returnType"
- 		m removeFinalSelfReturnIn: self. "must preceed recordDeclarationsIn: because it may set returnType"
  		m recordDeclarationsIn: self.
  		(m returnType isNil
  		 and: [m isReturnConstant]) ifTrue:
  			[m inferReturnTypeIn: self]].
  
  	"now iterate until we reach a fixed point"
  	[| changedReturnType |
  	 changedReturnType := false.
  	 allMethods do:
  		[:m|
  		 m inferTypesForImplicitlyTypedVariablesIn: self.
  		 (m inferReturnTypeIn: self) ifTrue:
  			[changedReturnType := true]].
  	 changedReturnType] whileTrue.
  
  	"Type all as-yet-untyped methods as the default"
  	methods do:
  		[:m|
  		m returnType ifNil:
  			[m returnType: (self implicitReturnTypeFor: m selector)]].
  
  	"Make a final pass to type anything assigned from the default type"
  	allMethods do:
  		[:m|
  		 m inferTypesForImplicitlyTypedVariablesIn: self]!

Item was changed:
  ----- Method: CoInterpreter>>attemptToSwitchToMachineCode: (in category 'jump bytecodes') -----
  attemptToSwitchToMachineCode: bcpc
  	"Attempt to convert the current interpreted activation into a machine code
  	 activation, and if this is popssible, jump into machine code.  bcpc is the
+ 	 0-relative pc of the backward branch bytecode (not any preceding extension)."
- 	 0-relative pc of the backward branch bytecode (not any preceeding extension)."
  	| cogMethod pc |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	(self methodHasCogMethod: method) ifFalse:
  		[cogit cog: method selector: objectMemory nilObject].
  	(self methodHasCogMethod: method) ifTrue:
  		[cogMethod := self cogMethodOf: method.
  		 pc := self convertToMachineCodeFrame: cogMethod bcpc: bcpc.
  		 self assertValidMachineCodeFrame: pc.
  		 self push: pc.
  		 self push: objectMemory nilObject.
  		 cogit ceEnterCogCodePopReceiverReg]!

Item was changed:
  ----- Method: CoInterpreter>>divorceMachineCodeFramesWithMethod: (in category 'frame access') -----
  divorceMachineCodeFramesWithMethod: methodObj
  	| cogMethod divorcedSome |
  	<var: #cogMethod type: #'CogMethod *'>
  	cogMethod := self cogMethodOf: methodObj.
  	[stackPage ~= 0 ifTrue: "This is needed for the assert in externalDivorceFrame:andContext:"
  		[stackPages markStackPageMostRecentlyUsed: stackPage].
  	 "Slang can't currently cope with the lack of the variable here.
+ 	  Something to do with the preceding statement.  Take it out
- 	  Something to do with the preceeding statement.  Take it out
  	  and the code is good.  leave it in and we get do { ... } while(l1:)"
  	 divorcedSome := self divorceSomeMachineCodeFramesWithMethod: cogMethod.
  	 divorcedSome] whileTrue!

Item was changed:
  ----- Method: CogARMCompiler>>callFullTargetFromReturnAddress: (in category 'inline cacheing') -----
  callFullTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address that the call immediately preceding callSiteReturnAddress will jump to."
- 	"Answer the address that the call immediately preceeding callSiteReturnAddress will jump to."
  	"this is also used by #jumpLongTargetBeforeFollowingAddress: and so we check for both call and jump related instructions; later on we can use simpler tests once it feels safe to assume we get here always with a call/jump in the proper place"
  	^self subclassResponsibility!

Item was changed:
  ----- Method: CogARMCompiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
  callTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address that the call immediately preceding callSiteReturnAddress will jump to."
- 	"Answer the address that the call immediately preceeding callSiteReturnAddress will jump to."
  	"this is also used by #jumpLongTargetBeforeFollowingAddress:."
  	| callDistance call |
  	call := self instructionBeforeAddress: callSiteReturnAddress.
  	self assert: ((self instructionIsB: call) or: [self instructionIsBL: call]).
  	callDistance := self extractOffsetFromBL: call.
  	^callSiteReturnAddress + 4 + callDistance signedIntFromLong!

Item was changed:
  ----- Method: CogARMCompiler>>instructionBeforeAddress: (in category 'inline cacheing') -----
  instructionBeforeAddress: followingAddress
+ 	"Answer the instruction immediately preceding followingAddress."
- 	"Answer the instruction immediately preceeding followingAddress."
  	<inline: true>
  	^objectMemory longAt: followingAddress -4!

Item was changed:
  ----- Method: CogARMCompiler>>jumpLongTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
  jumpLongTargetBeforeFollowingAddress: mcpc 
+ 	"Answer the target address for the long jump immediately preceding mcpc"
- 	"Answer the target address for the long jump immediately preceeding mcpc"
  	^self callTargetFromReturnAddress: mcpc!

Item was changed:
  ----- Method: CogAbstractInstruction>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
  sizePCDependentInstructionAt: eventualAbsoluteAddress
  	"Size a jump and set its address.  The target may be another instruction
  	 or an absolute address.  On entry the address inst var holds our virtual
  	 address. On exit address is set to eventualAbsoluteAddress, which is
  	 where this instruction will be output.  The span of a jump to a following
  	 instruction is therefore between that instruction's address and this
  	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceding instruction or to an absolute address is
- 	 span of a jump to a preceeding instruction or to an absolute address is
  	 between that instruction's address (which by now is its eventual absolute
  	 address) or absolute address and eventualAbsoluteAddress."
  
  	self subclassResponsibility!

Item was changed:
  ----- Method: CogIA32Compiler>>callFullTargetFromReturnAddress: (in category 'inline cacheing') -----
  callFullTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address the call immediately preceding callSiteReturnAddress will jump to."
- 	"Answer the address the call immediately preceeding callSiteReturnAddress will jump to."
  	^self callTargetFromReturnAddress: callSiteReturnAddress!

Item was changed:
  ----- Method: CogIA32Compiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
  callTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address the call immediately preceding callSiteReturnAddress will jump to."
- 	"Answer the address the call immediately preceeding callSiteReturnAddress will jump to."
  	| callDistance |
  	callDistance := self literalBeforeFollowingAddress: callSiteReturnAddress.
  	^callSiteReturnAddress + callDistance signedIntFromLong!

Item was changed:
  ----- Method: CogIA32Compiler>>jumpLongTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
  jumpLongTargetBeforeFollowingAddress: mcpc 
+ 	"Answer the target address for the long jump immediately preceding mcpc"
- 	"Answer the target address for the long jump immediately preceeding mcpc"
  	^self callTargetFromReturnAddress: mcpc!

Item was changed:
  ----- Method: CogIA32Compiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
  literalBeforeFollowingAddress: followingAddress
+ 	"Answer the literal embedded in the instruction immediately preceding followingAddress."
- 	"Answer the literal embedded in the instruction immediately preceeding followingAddress."
  	^  ((objectMemory byteAt: followingAddress - 1) << 24)
  	+  ((objectMemory byteAt: followingAddress - 2) << 16)
  	+  ((objectMemory byteAt: followingAddress - 3) << 8)
  	+   (objectMemory byteAt: followingAddress - 4)!

Item was changed:
  ----- Method: CogIA32Compiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
  sizePCDependentInstructionAt: eventualAbsoluteAddress
  	"Size a jump and set its address.  The target may be another instruction
  	 or an absolute address.  On entry the address inst var holds our virtual
  	 address. On exit address is set to eventualAbsoluteAddress, which is
  	 where this instruction will be output.  The span of a jump to a following
  	 instruction is therefore between that instruction's address and this
  	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceding instruction or to an absolute address is
- 	 span of a jump to a preceeding instruction or to an absolute address is
  	 between that instruction's address (which by now is its eventual absolute
  	 address) or absolute address and eventualAbsoluteAddress."
  
  	| target maximumSpan abstractInstruction |
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	opcode = AlignmentNops ifTrue:
  		[| alignment |
  		 address := eventualAbsoluteAddress.
  		 alignment := operands at: 0.
  		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
  							   - eventualAbsoluteAddress].
  	self assert: self isJump.
  	target := operands at: 0.
  	abstractInstruction := cogit cCoerceSimple: target to: #'AbstractInstruction *'.
  	(self isAnInstruction: abstractInstruction)
  		ifTrue:
  			[maximumSpan := abstractInstruction address
  							- (((cogit abstractInstruction: self follows: abstractInstruction)
  								ifTrue: [eventualAbsoluteAddress]
  								ifFalse: [address]) + 2)]
  		ifFalse:
  			[maximumSpan := target - (eventualAbsoluteAddress + 2)].
  	address := eventualAbsoluteAddress.
  	^machineCodeSize := opcode >= FirstShortJump
  							ifTrue:
  								[(self isQuick: maximumSpan)
  									ifTrue: [2]
  									ifFalse: [opcode = Jump
  												ifTrue: [5]
  												ifFalse: [6]]]
  							ifFalse:
  								[(opcode = JumpLong or: [opcode = JumpFull])
  									ifTrue: [5]
  									ifFalse: [6]]!

Item was changed:
  ----- Method: CogIA32Compiler>>storeLiteral:beforeFollowingAddress: (in category 'inline cacheing') -----
  storeLiteral: literal beforeFollowingAddress: followingAddress
+ 	"Rewrite the literal in the instruction immediately preceding followingAddress."
- 	"Rewrite the literal in the instruction immediately preceeding followingAddress."
  	objectMemory
  		byteAt: followingAddress - 1 put: (literal >> 24 bitAnd: 16rFF);
  		byteAt: followingAddress - 2 put: (literal >> 16 bitAnd: 16rFF);
  		byteAt: followingAddress - 3 put: (literal >>   8 bitAnd: 16rFF);
  		byteAt: followingAddress - 4 put: (literal            bitAnd: 16rFF)!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>callFullTargetFromReturnAddress: (in category 'inline cacheing') -----
  callFullTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address that the call immediately preceding callSiteReturnAddress will jump to."
- 	"Answer the address that the call immediately preceeding callSiteReturnAddress will jump to."
  	"this is also used by #jumpLongTargetBeforeFollowingAddress: and so we check for both call and jump related instructions; later on we can use simpler tests once it feels safe to assume we get here always with a call/jump in the proper place"
  	| call |
  	call := self instructionBeforeAddress: callSiteReturnAddress.
  	self assert: ((self instructionIsBX: call) or: [self instructionIsBLX: call]).
  	"A Long Call/Jump. Extract the value saved to RISCTempReg from all the instructions before."
+ 	^self extract32BitOperandFrom4Instructionspreceding: callSiteReturnAddress - 4!
- 	^self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4!

Item was changed:
  ----- Method: CogInLineLiteralsARMCompiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
  sizePCDependentInstructionAt: eventualAbsoluteAddress
  	"Size a jump and set its address.  The target may be another instruction
  	 or an absolute address.  On entry the address inst var holds our virtual
  	 address. On exit address is set to eventualAbsoluteAddress, which is
  	 where this instruction will be output.  The span of a jump to a following
  	 instruction is therefore between that instruction's address and this
  	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceding instruction or to an absolute address is
- 	 span of a jump to a preceeding instruction or to an absolute address is
  	 between that instruction's address (which by now is its eventual absolute
  	 address) or absolute address and eventualAbsoluteAddress.
  
  	 ARM is simple; the 26-bit call/jump range means no short jumps.  This routine
  	 only has to determine the targets of jumps, not determine sizes."
  
  	opcode = AlignmentNops ifTrue:
  		[| alignment |
  		 address := eventualAbsoluteAddress.
  		 alignment := operands at: 0.
  		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
  							   - eventualAbsoluteAddress].
  	self assert: (self isJump or: [opcode = Call or: [opcode = CallFull]]).
  	self isJump ifTrue: [self resolveJumpTarget].
  	address := eventualAbsoluteAddress.
  	^machineCodeSize := maxSize!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
  sizePCDependentInstructionAt: eventualAbsoluteAddress
  	"Size a jump and set its address.  The target may be another instruction
  	 or an absolute address.  On entry the address inst var holds our virtual
  	 address. On exit address is set to eventualAbsoluteAddress, which is
  	 where this instruction will be output.  The span of a jump to a following
  	 instruction is therefore between that instruction's address and this
  	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceding instruction or to an absolute address is
- 	 span of a jump to a preceeding instruction or to an absolute address is
  	 between that instruction's address (which by now is its eventual absolute
  	 address) or absolute address and eventualAbsoluteAddress."
  
  	| target maximumSpan abstractInstruction |
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	opcode = AlignmentNops ifTrue:
  		[| alignment |
  		 address := eventualAbsoluteAddress.
  		 alignment := operands at: 0.
  		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
  							   - eventualAbsoluteAddress].
  	self assert: self isJump.
  	target := operands at: 0.
  	abstractInstruction := cogit cCoerceSimple: target to: #'AbstractInstruction *'.
  	(self isAnInstruction: abstractInstruction)
  		ifTrue:
  			[maximumSpan := abstractInstruction address
  							- (((cogit abstractInstruction: self follows: abstractInstruction)
  								ifTrue: [eventualAbsoluteAddress]
  								ifFalse: [address]) + 2)]
  		ifFalse:
  			[maximumSpan := target - (eventualAbsoluteAddress + 2)].
  	address := eventualAbsoluteAddress.
  	^machineCodeSize := opcode >= FirstShortJump
  							ifTrue:
  								[(self isQuick: maximumSpan)
  									ifTrue: [2]
  									ifFalse: [opcode = Jump
  												ifTrue: [5]
  												ifFalse: [6]]]
  							ifFalse:
  								[opcode caseOf:
  									{	[JumpLong]				->	[5].
  										[JumpFull]				->	[12].
  										[JumpLongZero]		->	[6].
  										[JumpLongNonZero]	->	[6] }]!

Item was changed:
  ----- Method: CogObjectRepresentation>>markAndTraceCacheTagLiteral:in:atpc: (in category 'garbage collection') -----
  markAndTraceCacheTagLiteral: literal in: cogMethodOrNil atpc: address
+ 	"Mark and trace a literal in an inline cache preceding address in cogMethodOrNil.
- 	"Mark and trace a literal in an inline cache preceeding address in cogMethodOrNil.
  	 Answer if code was modified."
  	<var: #cogMethodOrNil type: #'CogMethod *'>
  	<var: #address type: #usqInt>
  	self subclassResponsibility!

Item was changed:
  ----- Method: CogObjectRepresentation>>markAndTraceLiteral:in:atpc: (in category 'garbage collection') -----
  markAndTraceLiteral: literal in: cogMethodOrNil atpc: address
+ 	"Mark and trace a literal in a machine code instruction preceding address in cogMethodOrNil.
- 	"Mark and trace a literal in a machine code instruction preceeding address in cogMethodOrNil.
  	 Answer if code was modified."
  	<var: #cogMethodOrNil type: #'CogMethod *'>
  	<var: #address type: #usqInt>
  	self subclassResponsibility!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>markAndTraceCacheTagLiteral:in:atpc: (in category 'garbage collection') -----
  markAndTraceCacheTagLiteral: literal in: cogMethodOrNil atpc: address
+ 	"Mark and trace a literal in an inline cache preceding address in cogMethodOrNil.
- 	"Mark and trace a literal in an inline cache preceeding address in cogMethodOrNil.
  	 Answer if code was modified."
  	<var: #cogMethodOrNil type: #'CogMethod *'>
  	<var: #address type: #usqInt>
  	| objOop |
  	(self couldBeObject: literal) ifFalse:
  		[^false].
  	self assert: (objectMemory addressCouldBeObj: literal).
  	(objectMemory isForwarded: literal) ifFalse:
  		[objectMemory markAndTrace: literal.
  		 ^false].
  	objOop := objectMemory followForwarded: literal.
  	cogit backEnd rewriteInlineCacheTag: objOop at: address.
  	self markAndTraceUpdatedLiteral: objOop in: cogMethodOrNil.
  	^true!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>markAndTraceLiteral:in:atpc: (in category 'garbage collection') -----
  markAndTraceLiteral: literal in: cogMethodOrNil atpc: address
+ 	"Mark and trace a literal in a machine code instruction preceding address in cogMethodOrNil.
- 	"Mark and trace a literal in a machine code instruction preceeding address in cogMethodOrNil.
  	 Answer if code was modified."
  	<var: #cogMethodOrNil type: #'CogMethod *'>
  	<var: #address type: #usqInt>
  	| objOop |
  	(self couldBeObject: literal) ifFalse:
  		[^false].
  	self assert: (objectMemory addressCouldBeObj: literal).
  	(objectMemory isForwarded: literal) ifFalse:
  		[objectMemory markAndTrace: literal.
  		 ^false].
  	objOop := objectMemory followForwarded: literal.
  	cogit backEnd storeLiteral: objOop beforeFollowingAddress: address.
  	self markAndTraceUpdatedLiteral: objOop in: cogMethodOrNil.
  	^true!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>markAndTraceCacheTagLiteral:in:atpc: (in category 'garbage collection') -----
  markAndTraceCacheTagLiteral: literal in: cogMethodOrNil atpc: address
+ 	"Mark and trace a literal in an inline cache preceding address in cogMethodOrNil.
- 	"Mark and trace a literal in an inline cache preceeding address in cogMethodOrNil.
  	 Answer if code was modified."
  	<var: #cogMethodOrNil type: #'CogMethod *'>
  	<var: #address type: #usqInt>
  	<inline: true>
  	self markAndTraceLiteral: literal.
  	^false!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>markAndTraceLiteral:in:atpc: (in category 'garbage collection') -----
  markAndTraceLiteral: literal in: cogMethodOrNil atpc: address
+ 	"Mark and trace a literal in a machine code instruction preceding address in cogMethodOrNil.
- 	"Mark and trace a literal in a machine code instruction preceeding address in cogMethodOrNil.
  	 Answer if code was modified."
  	<var: #cogMethodOrNil type: #'CogMethod *'>
  	<var: #address type: #usqInt>
  	<inline: true>
  	self markAndTraceLiteral: literal.
  	^false!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
  sizePCDependentInstructionAt: eventualAbsoluteAddress
  	"Size a jump and set its address.  The target may be another instruction
  	 or an absolute address.  On entry the address inst var holds our virtual
  	 address. On exit address is set to eventualAbsoluteAddress, which is
  	 where this instruction will be output.  The span of a jump to a following
  	 instruction is therefore between that instruction's address and this
  	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceding instruction or to an absolute address is
- 	 span of a jump to a preceeding instruction or to an absolute address is
  	 between that instruction's address (which by now is its eventual absolute
  	 address) or absolute address and eventualAbsoluteAddress.
  
  	 ARM is simple; the 26-bit call/jump range means no short jumps.  This
  	 routine only has to determine the targets of jumps, not determine sizes.
  
  	 This version also deals with out-of-line literals.  If this is the real literal,
  	 update the stand-in in literalsManager with the address (because instructions
  	 referring to the literal are referring to the stand-in).  If this is annotated with
  	 IsObjectReference transfer the annotation to the stand-in, whence it will be
  	 transferred to the real literal, simplifying update of literals."
  
  	opcode = AlignmentNops ifTrue:
  		[| alignment |
  		 address := eventualAbsoluteAddress.
  		 alignment := operands at: 0.
  		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
  							   - eventualAbsoluteAddress].
  	self assert: (self isJump or: [opcode = Call or: [opcode = CallFull
  				or: [dependent notNil and: [dependent opcode = Literal]]]]).
  	self isJump ifTrue: [self resolveJumpTarget].
  	address := eventualAbsoluteAddress.
  	(dependent notNil and: [dependent opcode = Literal]) ifTrue:
  		[opcode = Literal ifTrue:
  			[dependent address: address].
  		 annotation = cogit getIsObjectReference ifTrue:
  			[dependent annotation: annotation.
  			 annotation := nil]].
  	^machineCodeSize := maxSize!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>storeLiteral:beforeFollowingAddress: (in category 'inline cacheing') -----
  storeLiteral: literal beforeFollowingAddress: followingAddress
+ 	"Rewrite the literal in the instruction immediately preceding followingAddress."
- 	"Rewrite the literal in the instruction immediately preceeding followingAddress."
  	objectMemory longAt: (self pcRelativeAddressAt: followingAddress - 4) put: literal!

Item was changed:
  ----- Method: CogX64Compiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
  callTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address the call immediately preceding callSiteReturnAddress will jump to."
- 	"Answer the address the call immediately preceeding callSiteReturnAddress will jump to."
  	| callDistance |
  	callDistance := self thirtyTwoBitLiteralBefore: callSiteReturnAddress.
  	^callSiteReturnAddress + callDistance signedIntFromLong!

Item was changed:
  ----- Method: CogX64Compiler>>jumpLongTargetBeforeFollowingAddress: (in category 'inline cacheing') -----
  jumpLongTargetBeforeFollowingAddress: mcpc 
+ 	"Answer the target address for the long jump immediately preceding mcpc"
- 	"Answer the target address for the long jump immediately preceeding mcpc"
  	^self callTargetFromReturnAddress: mcpc!

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'selfSendTrampolines' 'dynamicSuperSendTrampolines'
  			'implicitReceiverSendTrampolines' 'outerSendTrampolines'
  			'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  		addHeaderFile:'"sqCogStackAlignment.h"';
+ 		addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
- 		addHeaderFile:'"dispdbg.h"'; "must preceed cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator
  		var: #ceGetSP
  			declareC: 'unsigned long (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #ceFlushICache
  			declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
  		var: #ceCheckFeaturesFunction
  			declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
  		var: #ceTryLockVMOwner
  			declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
  		var: #ceUnlockVMOwner
  			declareC: 'void (*ceUnlockVMOwner)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *'.
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss
  					entry noCheckEntry selfSendEntry dynSuperEntry
  					picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *'.
  	aCCodeGenerator
  		var: #ordinarySendTrampolines
  			declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
  		var: #directedSuperSendTrampolines
  			declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  		var: #selfSendTrampolines
  			declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  		var: #dynamicSuperSendTrampolines
  			declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  		var: #implicitReceiverSendTrampolines
  			declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  		var: #outerSendTrampolines
  			declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]';
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #CFramePointer type: #'void *';
  		declareVar: #CStackPointer type: #'void *';
  		declareVar: #minValidCallAddress type: #'unsigned long';
  		declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator);
  			var: #primitiveGeneratorTable
  				declareC: 'static PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
  							(self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

Item was changed:
  ----- Method: Cogit class>>initializeWithOptions: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionary
  	{ self. CogMethod. CogMethodSurrogate. CogObjectRepresentation } do:
  		[:aSuperclass|
  		 aSuperclass withAllSubclasses do:
  			[:class| class initializationOptions: optionsDictionary]].
  	super initializeWithOptions: optionsDictionary.
+ 	self initializeMiscConstants. "must precede other initialization."
- 	self initializeMiscConstants. "must preceed other initialization."
  	self initializeErrorCodes.
  	self initializeCogMethodConstants.
  	self initializeAnnotationConstants.
  	self initializeBytecodeTable.
  	self initializeNumTrampolines.
  	self initializePrimitiveTable!

Item was changed:
  ----- Method: Cogit>>isSendReturnPC: (in category 'jit - api') -----
  isSendReturnPC: retpc
  	<api>
+ 	"Answer if the instruction preceding retpc is a call instruction."
- 	"Answer if the instruction preceeding retpc is a call instruction."
  	| target |
+ 	(backEnd isCallprecedingReturnPC: retpc) ifFalse:
- 	(backEnd isCallPreceedingReturnPC: retpc) ifFalse:
  		[^false].
  	target := backEnd callTargetFromReturnAddress: retpc.
  	^(target between: firstSend and: lastSend)
  	   or: [target between: methodZoneBase and: methodZone freeStart]!

Item was changed:
  ----- Method: Interpreter class>>initializeWithOptions: (in category 'initialization') -----
  initializeWithOptions: optionsDictionary
  	"Interpreter initializeWithOptions: Dictionary new"
  
  	super initializeWithOptions: optionsDictionary.  "initialize ObjectMemory constants"
+ 	self initializeMiscConstants. "must precede other initialization."
- 	self initializeMiscConstants. "must preceed other initialization."
  	self initializeAssociationIndex.
  	self initializeBytecodeTable.
  	self initializeCaches.
  	self initializeCharacterIndex.
  	self initializeCharacterScannerIndices.
  	self initializeClassIndices.
  	self initializeCompilerHooks.
  	self initializeContextIndices.
  	self initializeDirectoryLookupResultCodes.
  	self initializeMessageIndices.
  	self initializeMethodIndices.
  	self initializePointIndices.
  	self initializePrimitiveTable.
  	self initializeSchedulerIndices.
  	self initializeSmallIntegers.
  	self initializeStreamIndices!

Item was changed:
  ----- Method: Interpreter>>imageFormatCompatibilityVersion (in category 'image save/restore') -----
  imageFormatCompatibilityVersion
+ 	"This VM is backward-compatible with the immediately preceding non-closure version."
- 	"This VM is backward-compatible with the immediately preceeding non-closure version."
  
  	self wordSize == 4
  		ifTrue: [^6502]
  		ifFalse: [^68000]!

Item was changed:
  ----- Method: Interpreter>>primitiveBytesLeft (in category 'memory space primitives') -----
  primitiveBytesLeft
  	"Reports bytes available at this moment. For more meaningful 
+ 	results, calls to this primitive should be precedeed by a full 
- 	results, calls to this primitive should be preceeded by a full 
  	or incremental garbage collection."
  	| aBool |
  	self methodArgumentCount = 0
  		ifTrue: ["old behavior - just return the size of the free block"
  			^self pop: 1 thenPushInteger: (self sizeOfFree: freeBlock)].
  	self methodArgumentCount = 1
  		ifTrue: ["new behaviour -including or excluding swap space depending on aBool"
  			aBool := self booleanValueOf: self stackTop.
  			successFlag ifFalse: [^ nil].
  			^self pop: 2 thenPushInteger: (self bytesLeft: aBool)].
  	^ self primitiveFail!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveBytesLeft (in category 'memory space primitives') -----
  primitiveBytesLeft
  	"Reports bytes available at this moment. For more meaningful 
+ 	results, calls to this primitive should be precedeed by a full 
- 	results, calls to this primitive should be preceeded by a full 
  	or incremental garbage collection."
  	| aBool |
  	self methodArgumentCount = 0
  		ifTrue: ["old behavior - just return the size of free memory"
  			^self pop: 1 thenPushInteger: objectMemory freeSize].
  	self methodArgumentCount = 1
  		ifTrue: ["new behaviour -including or excluding swap space depending on aBool"
  			aBool := self booleanValueOf: self stackTop.
  			self successful ifTrue:
  				[^self pop: 2 thenPushInteger: (objectMemory bytesLeft: aBool)]].
  	^ self primitiveFail!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
  primitiveSlotAt
  	"Answer a slot in an object.  This numbers all slots from 1, ignoring the distinction between
  	 named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ 	 inst vars precede the indexed ones.  In non-object indexed objects (objects that contain
- 	 inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
  	 bits, not object references) this primitive answers the raw integral value at each slot. 
  	 e.g. for Strings it answers the character code, not the Character object at each slot."
  	| index rcvr fmt numSlots |
  	index := self stackTop.
  	rcvr := self stackValue: 1.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	fmt := objectMemory formatOf: rcvr.
  	index := (objectMemory integerValueOf: index) - 1.
  
  	fmt <= objectMemory lastPointerFormat ifTrue:
  		[numSlots := objectMemory numSlotsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1 thenPush: (objectMemory fetchPointer: index ofObject: rcvr).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt >= objectMemory firstByteFormat ifTrue:
  		[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
  			[^self primitiveFailFor: PrimErrUnsupported].
  		 numSlots := objectMemory numBytesOfBytes: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
  		[numSlots := objectMemory num16BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchShort16: index ofObject: rcvr).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
  		[numSlots := objectMemory num64BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1
  				thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt >= objectMemory firstLongFormat ifTrue:
  		[numSlots := objectMemory num32BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1
  				thenPush: (objectMemory bytesPerOop = 8
  							ifTrue: [objectMemory integerObjectOf: (objectMemory fetchLong32: index ofObject: rcvr)]
  							ifFalse: [self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)]).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	^self primitiveFailFor: PrimErrBadReceiver!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') -----
  primitiveSlotAtPut
  	"Assign a slot in an object.  This numbers all slots from 1, ignoring the distinction between
  	 named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ 	 inst vars precede the indexed ones.  In non-object indexed objects (objects that contain
- 	 inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
  	 bits, not object references) this primitive assigns a raw integral value at each slot."
  	| newValue index rcvr fmt numSlots value |
  	newValue := self stackTop.
  	index := self stackValue: 1.
  	rcvr := self stackValue: 2.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	fmt := objectMemory formatOf: rcvr.
  	index := (objectMemory integerValueOf: index) - 1.
  
  	fmt <= objectMemory lastPointerFormat ifTrue:
  		[numSlots := objectMemory numSlotsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storePointer: index ofObject: rcvr withValue: newValue.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	value := self positiveMachineIntegerValueOf: newValue.
  	self failed ifTrue:
  		[primFailCode := PrimErrBadArgument.
  		^0].
  
  	fmt >= objectMemory firstByteFormat ifTrue:
  		[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
  			[^self primitiveFailFor: PrimErrUnsupported].
  		 (self asUnsigned: value) > 16rFF ifTrue:
  			[^self primitiveFailFor: PrimErrBadArgument].
  		 numSlots := objectMemory numBytesOfBytes: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeByte: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
  		[(self asUnsigned: value) > 16rFFFF ifTrue:
  			[^self primitiveFailFor: PrimErrBadArgument].
  		 numSlots := objectMemory num16BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeShort16: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	(objectMemory bytesPerOop = 8
  	 and: [fmt = objectMemory sixtyFourBitIndexableFormat]) ifTrue:
  		[numSlots := objectMemory num64BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeLong64: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt >= objectMemory firstLongFormat ifTrue:
  		[(objectMemory wordSize > 4
  		  and: [(self asUnsigned: value) > 16rFFFFFFFF]) ifTrue:
  			[^self primitiveFailFor: PrimErrBadArgument].
  		 numSlots := objectMemory num32BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeLong32: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	^self primitiveFailFor: PrimErrBadReceiver!

Item was changed:
  ----- Method: NewspeakInterpreter class>>initializeWithOptions: (in category 'initialization') -----
  initializeWithOptions: optionsDictionary
  	"NewspeakInterpreter initializeWithOptions: Dictionary new"
  
  	super initializeWithOptions: optionsDictionary.  "initialize ObjectMemory constants"
+ 	self initializeMiscConstants. "must precede other initialization."
- 	self initializeMiscConstants. "must preceed other initialization."
  	self initializeAssociationIndex.
  	self initializeBytecodeTable.
  	self initializeCaches.
  	self initializeCharacterIndex.
  	self initializeCharacterScannerIndices.
  	self initializeClassIndices.
  	self initializeContextIndices.
  	self initializeDirectoryLookupResultCodes.
  	self initializeMessageIndices.
  	self initializeMethodIndices.
  	self initializePointIndices.
  	self initializePrimitiveTable.
  	self initializePrimitiveErrorCodes.
  	self initializeSchedulerIndices.
  	self initializeSmallIntegers.
  	self initializeStreamIndices!

Item was changed:
  ----- Method: NewspeakInterpreter>>imageFormatCompatibilityVersion (in category 'image save/restore') -----
  imageFormatCompatibilityVersion
+ 	"This VM is backward-compatible with the immediately preceding non-closure version."
- 	"This VM is backward-compatible with the immediately preceeding non-closure version."
  
  	self wordSize == 4
  		ifTrue: [^6502]
  		ifFalse: [^68000]!

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveBytesLeft (in category 'memory space primitives') -----
  primitiveBytesLeft
  	"Reports bytes available at this moment. For more meaningful 
+ 	results, calls to this primitive should be precedeed by a full 
- 	results, calls to this primitive should be preceeded by a full 
  	or incremental garbage collection."
  	| aBool |
  	self methodArgumentCount = 0
  		ifTrue: ["old behavior - just return the size of the free block"
  			^self pop: 1 thenPushInteger: (self sizeOfFree: freeBlock)].
  	self methodArgumentCount = 1
  		ifTrue: ["new behaviour -including or excluding swap space depending on aBool"
  			aBool := self booleanValueOf: self stackTop.
  			self successful ifFalse: [^ nil].
  			^self pop: 2 thenPushInteger: (self bytesLeft: aBool)].
  	^ self primitiveFail!

Item was changed:
  ----- Method: ObjectMemory>>objectBefore: (in category 'object enumeration') -----
  objectBefore: address 
+ 	"Return the object or start of free space immediately preceding the given
- 	"Return the object or start of free space immediately preceeding the given
  	 address, object or free chunk in memory. If none, return 0.  This is for debugging only."
  	| obj nextObj sz |
  	<api>
  	obj := self oopFromChunk: ((self oop: address isGreaterThan: youngStart)
  								ifTrue: [youngStart]
  								ifFalse: [self startOfMemory]).
  	[self oop: obj isLessThan: address] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue: [sz := self sizeOfFree: obj]
  			ifFalse: [sz := self sizeBitsOf: obj].
  		 nextObj := self oopFromChunk: obj + sz.
  		 (self oop: nextObj isGreaterThanOrEqualTo: address) ifTrue:
  			[^obj].
  		 obj := nextObj].
  	^0!

Item was changed:
  ----- Method: ObjectMemory>>objectExactlyBefore: (in category 'object enumeration') -----
  objectExactlyBefore: oop 
+ 	"Return the object or start of free space immediately preceding the given
- 	"Return the object or start of free space immediately preceeding the given
  	 object or free chunk in memory. If none, return 0.  This is for debugging only."
  	| obj nextObj sz |
  	<api>
  	obj := self oopFromChunk: ((self oop: oop isGreaterThan: youngStart)
  								ifTrue: [youngStart]
  								ifFalse: [self startOfMemory]).
  	[self oop: obj isLessThan: obj] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue: [sz := self sizeOfFree: obj]
  			ifFalse: [sz := self sizeBitsOf: obj].
  		 nextObj := self oopFromChunk: obj + sz.
  		 nextObj = oop ifTrue:
  			[^obj].
  		 obj := nextObj].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genExtPushClosureBytecode (in category 'bytecode generators') -----
  genExtPushClosureBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
+ 	 and defer generating code for it until after the method and any other preceding
- 	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"253		11111101 eei i i kkk	jjjjjjjj		Push Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A \\ 16 * 8) BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions"
  	| numArgs numCopied |
  	self assert: needsFrame.
  	self addBlockStartAt: bytecodePC + 3 "0 relative"
  		numArgs: (numArgs := (byte1 bitAnd: 16r7) + (extA \\ 16 * 8))
  		numCopied: (numCopied := ((byte1 >> 3) bitAnd: 7) + (extA // 16 * 8))
  		span: byte2 + (extB << 8).
  	extA := extB := 0.
  	objectRepresentation
  		genCreateClosureAt: bytecodePC + 4 "1 relative"
  		numArgs: numArgs
  		numCopied: numCopied
  		contextNumArgs: methodOrBlockNumArgs
  		large: (coInterpreter methodNeedsLargeContext: methodObj)
  		inBlock: inBlock.
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPushClosureCopyCopiedValuesBytecode (in category 'bytecode generators') -----
  genPushClosureCopyCopiedValuesBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
+ 	 and defer generating code for it until after the method and any other preceding
- 	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"143   10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii"
  	| numArgs numCopied |
  	self assert: needsFrame.
  	self addBlockStartAt: bytecodePC + 4 "0 relative"
  		numArgs: (numArgs := byte1 bitAnd: 16rF)
  		numCopied: (numCopied := byte1 >> 4)
  		span: (byte2 << 8) + byte3.
  	objectRepresentation
  		genCreateClosureAt: bytecodePC + 5 "1 relative"
  		numArgs: numArgs
  		numCopied: numCopied
  		contextNumArgs: methodOrBlockNumArgs
  		large: (coInterpreter methodNeedsLargeContext: methodObj)
  		inBlock: inBlock.
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	"Allocate an object with numSlots space.  If there is room beneath scavengeThreshold
  	 allocate in newSpace, otherwise alocate in oldSpace.  If there is not room in newSpace
  	 and a scavenge is not already scheduled, schedule a scavenge."
  	<inline: true>
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 	 16 bytes otherwise (num slots in preceding word).
- 	 16 bytes otherwise (num slots in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self numSlotsMask
  		ifTrue:
  			[newObj := freeStart + self baseHeaderSize.
  			 numBytes := self largeObjectBytesForSlots: numSlots]
  		ifFalse:
  			[newObj := freeStart.
  			 numBytes := self smallObjectBytesForSlots: numSlots].
  	
  	freeStart + numBytes > scavengeThreshold ifTrue:
  		[needGCFlag ifFalse: [self scheduleScavenge].
  		 ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
  	numSlots >= self numSlotsMask
  		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  			[self flag: #endianness.
  			 self longAt: freeStart put: numSlots.
  			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
  			 self long64At: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self long64At: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  	self assert: numBytes \\ self allocationUnit = 0.
  	self assert: newObj \\ self allocationUnit = 0.
  	freeStart := freeStart + numBytes.
  	^newObj!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	"Allocate an object with numSlots space.  If there is room beneath scavengeThreshold
  	 allocate in newSpace, otherwise alocate in oldSpace.  If there is not room in newSpace
  	 and a scavenge is not already scheduled, schedule a scavenge."
  	<inline: true>
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 	 16 bytes otherwise (num slots in preceding word).
- 	 16 bytes otherwise (num slots in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self numSlotsMask
  		ifTrue:
  			[numSlots >> 56 > 0 ifTrue:
  				[^nil]. "overflow size must fit in 56-bits"
  			 newObj := freeStart + self baseHeaderSize.
  			 numBytes := self largeObjectBytesForSlots: numSlots]
  		ifFalse:
  			[newObj := freeStart.
  			 numBytes := self smallObjectBytesForSlots: numSlots].
  	
  	freeStart + numBytes > scavengeThreshold ifTrue:
  		[needGCFlag ifFalse: [self scheduleScavenge].
  		 ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
  	numSlots >= self numSlotsMask
  		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  			[self flag: #endianness.
  			 self longAt: freeStart put: self numSlotsMask << self numSlotsFullShift + numSlots.
  			 self longAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self longAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  	self assert: numBytes \\ self allocationUnit = 0.
  	self assert: newObj \\ self allocationUnit = 0.
  	freeStart := freeStart + numBytes.
  	^newObj!

Item was changed:
  ----- Method: SpurGenerationScavenger>>newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
  newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
  	| actualEdenBytes survivorBytes |
  
  	actualEdenBytes := requestedEdenBytes.
  	survivorBytes := totalBytes - actualEdenBytes // 2 truncateTo: manager allocationUnit.
  	actualEdenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
  	self assert: totalBytes - actualEdenBytes - survivorBytes - survivorBytes < manager allocationUnit.
  
  	"for tenuring we require older objects below younger objects.  since allocation
+ 	 grows up this means that the survivor spaces must precede eden."
- 	 grows up this means that the survivor spaces must preceed eden."
  
  	pastSpace start: startAddress; limit: startAddress + survivorBytes.
  	futureSpace start: pastSpace limit; limit: pastSpace limit + survivorBytes.
  	eden start: futureSpace limit; limit: futureSpace limit + actualEdenBytes.
  
  	self assert: futureSpace limit <= (startAddress + totalBytes).
  	self assert: eden start \\ manager allocationUnit
  				+ (eden limit \\ manager allocationUnit) = 0.
  	self assert: pastSpace start \\ manager allocationUnit
  				+ (pastSpace limit \\ manager allocationUnit) = 0.
  	self assert: futureSpace start \\ manager allocationUnit
  				+ (futureSpace limit \\ manager allocationUnit) = 0.
  
  	self initFutureSpaceStart.
  	manager initSpaceForAllocationCheck: (self addressOf: eden) limit: eden limit.
  
  	tenuringProportion := 0.9!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
  allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
  	"Allocate an object with numSlots in newSpace.  This is for the `ee' execution engine allocations,
  	 and must be satisfied.  If no memory is available, abort.  If the allocation pushes freeStart past
  	 scavengeThreshold and a scavenge is not already scheduled, schedule a scavenge."
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 	 16 bytes otherwise (num slots in preceding word).
- 	 16 bytes otherwise (num slots in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self numSlotsMask
  		ifTrue:
  			[(self wordSize >= 8 and: [numSlots > 16rffffffff]) ifTrue:
  				[^nil]. "overflow size must fit in 32-bits"
  			 newObj := freeStart + self baseHeaderSize.
  			 numBytes := self largeObjectBytesForSlots: numSlots]
  		ifFalse:
  			[newObj := freeStart.
  			 numBytes := self smallObjectBytesForSlots: numSlots].
  	
  	freeStart + numBytes > scavengeThreshold ifTrue:
  		[needGCFlag ifFalse: [self scheduleScavenge].
  		 freeStart + numBytes > scavenger eden limit ifTrue:
  			[self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:'.
  			 ^0]].
  	numSlots >= self numSlotsMask
  		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  			[self flag: #endianness.
  			 self longAt: freeStart put: numSlots.
  			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
  			 self long64At: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self long64At: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  	self assert: numBytes \\ self allocationUnit = 0.
  	self assert: newObj \\ self allocationUnit = 0.
  	freeStart := freeStart + numBytes.
  	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>baseHeaderSize (in category 'header format') -----
  baseHeaderSize
  	"Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
+ 	 16 bytes otherwise (slot size in preceding word)."
- 	 16 bytes otherwise (slot size in preceeding word)."
  	^8!

Item was changed:
  ----- Method: SpurMemoryManager>>markAccessibleObjectsAndFireEphemerons (in category 'gc - global') -----
  markAccessibleObjectsAndFireEphemerons
  	self assert: self validClassTableRootPages.
  	self assert: segmentManager allBridgesMarked.
  	self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
  		inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]].
  
  	marking := true.
  	"This must come first to enable stack page reclamation.  It clears
+ 	  the trace flags on stack pages and so must precede any marking.
- 	  the trace flags on stack pages and so must preceed any marking.
  	  Otherwise it will clear the trace flags of reached pages."
  	coInterpreter initStackPageGC.
  	self markAndTraceHiddenRoots.
  	self markAndTraceExtraRoots.
  	self assert: self validClassTableRootPages.
  	coInterpreter markAndTraceInterpreterOops: true.
  	self assert: self validObjStacks.
  	self markWeaklingsAndMarkAndFireEphemerons.
  	self assert: self validObjStacks.
  	marking := false!

Item was changed:
  ----- Method: StackInterpreter class>>initializeWithOptions: (in category 'initialization') -----
  initializeWithOptions: optionsDictionary
  	"StackInterpreter initializeWithOptions: Dictionary new"
  
  	super initializeWithOptions: optionsDictionary.
+ 	self initializeMiscConstants. "must precede other initialization."
- 	self initializeMiscConstants. "must preceed other initialization."
  	self initializeAssociationIndex.
  	self initializeBytecodeTable.
  	self initializeCaches.
  	self initializeCharacterIndex.
  	self initializeCharacterScannerIndices.
  	self initializeClassIndices.
  	self initializeContextIndices.
  	self initializeDirectoryLookupResultCodes.
  	self initializeFrameIndices.
  	self initializeMessageIndices.
  	self initializeMethodIndices.
  	self initializePointIndices.
  	self initializePrimitiveTable.
  	self initializeSchedulerIndices.
  	self initializeSmallIntegers.
  	self initializeStreamIndices!

Item was changed:
  ----- Method: StackInterpreter>>imageFormatCompatibilityVersion (in category 'image save/restore') -----
  imageFormatCompatibilityVersion
+ 	"This VM is backward-compatible with the immediately preceding version."
- 	"This VM is backward-compatible with the immediately preceeding version."
  
  	^objectMemory wordSize == 4 ifTrue: [6504] ifFalse: [68002]!

Item was changed:
  ----- Method: StackInterpreter>>initialize (in category 'initialization') -----
  initialize
  	"Here we can initialize the variables C initializes to zero.  #initialize methods do /not/ get translated."
+ 	checkAllocFiller := false. "must precede initializeObjectMemory:"
- 	checkAllocFiller := false. "must preceed initializeObjectMemory:"
  	primFailCode := 0.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := 0.
  	extraFramesToMoveOnOverflow := 0.
  	bytecodeSetSelector := 0.
  	highestRunnableProcessPriority := 0.
  	nextProfileTick := 0.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
  	tempOop := tempOop2 := theUnknownShort := 0.
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	fullScreenFlag := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	jmpDepth := 0.
  	longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
  	statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
  	statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0!

Item was changed:
  ----- Method: StackInterpreter>>spurPostBecomeAction: (in category 'object memory support') -----
  spurPostBecomeAction: theBecomeEffectsFlags
  	"Insulate the stack zone from the effects of a become.
  	 All receivers must be unfollowed for two reasons:
  		1. inst var access is direct with no read barrier
  		2. super sends (always to the receiver) have no class check and so don't trap
  		   for forwarded receivers.  This is an issue for primitives that assume their receiver
  		   is valid and don't validate.
  	 Super sends require an explicit check to ensure receivers in super sends are unforwarded.
  	 e.g. super doSomethingWith: (self become: other) forwards the receiver self pushed on the
  	 stack.  So we could avoid following non-pointer receivers.  But this is too tricky,  Instead, we
  	 always follow receivers.
  	 Methods must be unfollowed since bytecode access is direct with no read barrier.
  	 But this only needs to be done if the becomeEffectsFlags indicate that a
  	 CompiledMethod was becommed.
  	 The scheduler state must be followed, but only if the becomeEffectsFlags indicate
  	 that a pointer object was becommed."
  	<option: #SpurObjectMemory>
  	<inline: false> "For VM profiling"
  	self flushAtCache.
  	theBecomeEffectsFlags ~= 0 ifTrue:
  		[(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  			[self followForwardedMethodsInMethodCache.
+ 			 self followForwardedMethodsInMethodZone]. "for CoInterpreter; must precede followForwardingPointersInStackZone:"
- 			 self followForwardedMethodsInMethodZone]. "for CoInterpreter; must preceed followForwardingPointersInStackZone:"
  		 (theBecomeEffectsFlags anyMask: BecameActiveClassFlag) ifTrue:
  			[self flushBecommedClassesInMethodCache.
  			 self flushBecommedClassesInMethodZone]. "for CoInterpreter"
  		 (theBecomeEffectsFlags anyMask: BecamePointerObjectFlag) ifTrue:
  			[self followForwardingPointersInScheduler.
  			 self followForwardingPointersInSpecialObjectsArray].
  		 (theBecomeEffectsFlags anyMask: BecamePointerObjectFlag + BecameCompiledMethodFlag) ifTrue:
  			[self followForwardingPointersInProfileState]].
  	self followForwardingPointersInStackZone: theBecomeEffectsFlags!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
  primitiveSlotAt
  	"Answer a slot in an object.  This numbers all slots from 1, ignoring the distinction between
  	 named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ 	 inst vars precede the indexed ones.  In non-object indexed objects (objects that contain
- 	 inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
  	 bits, not object references) this primitive answers the raw integral value at each slot. 
  	 e.g. for Strings it answers the character code, not the Character object at each slot."
  	| index rcvr fmt numSlots |
  	index := self stackTop.
  	rcvr := self stackValue: 1.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	fmt := objectMemory formatOf: rcvr.
  	index := (objectMemory integerValueOf: index) - 1.
  
  	fmt <= objectMemory lastPointerFormat ifTrue:
  		[numSlots := objectMemory numSlotsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[| value numLiveSlots |
  			 (objectMemory isContextNonImm: rcvr)
  				ifTrue:
  					[self externalWriteBackHeadFramePointers.
  					 numLiveSlots := (self stackPointerForMaybeMarriedContext: rcvr) + CtxtTempFrameStart.
  					 value := (self asUnsigned: index) < numLiveSlots
  								ifTrue: [self externalInstVar: index ofContext: rcvr]
  								ifFalse: [objectMemory nilObject]]
  				ifFalse:
  					[value := objectMemory fetchPointer: index ofObject: rcvr].
  			 self pop: argumentCount + 1 thenPush: value.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt >= objectMemory firstByteFormat ifTrue:
  		[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
  			[^self primitiveFailFor: PrimErrUnsupported].
  		 numSlots := objectMemory numBytesOfBytes: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
  		[numSlots := objectMemory num16BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchShort16: index ofObject: rcvr).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
  		[numSlots := objectMemory num64BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1
  				thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt >= objectMemory firstLongFormat ifTrue:
  		[numSlots := objectMemory num32BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[self pop: argumentCount + 1
  				thenPush: (self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)).
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	^self primitiveFailFor: PrimErrBadReceiver!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') -----
  primitiveSlotAtPut
  	"Assign a slot in an object.  This numbers all slots from 1, ignoring the distinction between
  	 named and indexed inst vars.  In objects with both named and indexed inst vars, the named
+ 	 inst vars precede the indexed ones.  In non-object indexed objects (objects that contain
- 	 inst vars preceed the indexed ones.  In non-object indexed objects (objects that contain
  	 bits, not object references) this primitive assigns a raw integral value at each slot."
  	| newValue index rcvr fmt numSlots value |
  	newValue := self stackTop.
  	index := self stackValue: 1.
  	rcvr := self stackValue: 2.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	fmt := objectMemory formatOf: rcvr.
  	index := (objectMemory integerValueOf: index) - 1.
  
  	fmt <= objectMemory lastPointerFormat ifTrue:
  		[numSlots := objectMemory numSlotsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[(objectMemory isContextNonImm: rcvr)
  				ifTrue: [self externalInstVar: index ofContext: rcvr put: newValue]
  				ifFalse: [objectMemory storePointer: index ofObject: rcvr withValue: newValue].
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	value := self positiveMachineIntegerValueOf: newValue.
  	self failed ifTrue:
  		[primFailCode := PrimErrBadArgument.
  		^0].
  
  	fmt >= objectMemory firstByteFormat ifTrue:
  		[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
  			[^self primitiveFailFor: PrimErrUnsupported].
  		 (self asUnsigned: value) > 16rFF ifTrue:
  			[^self primitiveFailFor: PrimErrBadArgument].
  		 numSlots := objectMemory numBytesOfBytes: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeByte: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
  		[(self asUnsigned: value) > 16rFFFF ifTrue:
  			[^self primitiveFailFor: PrimErrBadArgument].
  		 numSlots := objectMemory num16BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeShort16: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	(objectMemory bytesPerOop = 8
  	 and: [fmt = objectMemory sixtyFourBitIndexableFormat]) ifTrue:
  		[numSlots := objectMemory num64BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeLong64: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	fmt >= objectMemory firstLongFormat ifTrue:
  		[(objectMemory wordSize > 4
  		  and: [(self asUnsigned: value) > 16rFFFFFFFF]) ifTrue:
  			[^self primitiveFailFor: PrimErrBadArgument].
  		 numSlots := objectMemory num32BitUnitsOf: rcvr.
  		 (self asUnsigned: index) < numSlots ifTrue:
  			[objectMemory storeLong32: index ofObject: rcvr withValue: value.
  			 self pop: argumentCount + 1 thenPush: newValue.
  			 ^0].
  		 ^self primitiveFailFor: PrimErrBadIndex].
  
  	^self primitiveFailFor: PrimErrBadReceiver!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>callingConvention (in category 'documentation') -----
  callingConvention
  	"The Smalltalk-to-Smalltalk calling convention aims to trade simplicity of compilation against
  	 effectiveness of optimization.  Most Smalltalk methods, and certainly most performance-
  	 critical primitives have two or less arguments.  So arranging that the receiver and up to two
  	 args args are in registers arranges that performance-critical primitives can access their
  	 arguments in registers.  So if the argument count is <= numRegArgs nothing is passed on
  	 the stack and everything is passed in ReceiverResultReg, Arg0Reg et al.  Above numRegArgs
  	 everything is passed on the stack.
  
  	 To save the CoInterpreter from change we shuffle the retpc and push the register args in
  	 the prolog so that the frame format is unchanged by register args.  Also, the trampolines for
+ 	 unlinked sends do the same, as does the code preceding an interpreter primitive.  It turns
- 	 unlinked sends do the same, as does the code preceeding an interpreter primitive.  It turns
  	 out that this protocol is faster than always pushing arguments.  Comparing benchFib with the
  	 shuffling protocol against an always-push protocol on a 2.66 GHz Core i7 (MacBook Pro) , the
  	 shuffling protocol is 6.3% faster than the always push protocol.
  
  	 Not shuffling the stack and pushing register arguments after frame build is faster yet again,
  	 5.8% faster that the stack shuffle.  So it might be worth-while to change the CoInterpreter's
  	 frame management to allow numArgs <= numRegArgs frames to push receiver and arguments
  	 after saving the return pc.  This implies changes in stack-to-context mapping, GC,
  	 interpreter-to-machine code frame conversion and no doubt else where.
  
  	 Hence the calling convention is
  
  		- if the number of arguments is less than or equal to numRegArgs then the receiver and arguments
  		  are passed in registers.  numRegArgs is currently 1, but will become 2 once the code generator
  		  generates machine code primitives which take 2 arguments (i.e. once the object representation
  		  makes it feasible to implement at:put: in machine code numRegArgs will be raised to 2).  The receiver
  		  is passed in ReceiverResultReg, the first argument in Arg0Reg (esi on x86) and the second argument
  		  (if numRegArgs = 2) in Arg1Reg (edi on x86).
  
  		- if the number of arguments is greater than numRegArgs then the calling convention is as for
  		  SimpleStackBasedCogIt; ReceiverResultReg contains the receiver, and the receiver and arguments
  		  are all on the stack, receiver furthest from top-of-stack.  If the argument count is > 2 then argument
  		  count is passed in SendNumArgsReg (for the benefit of the run-time linking routines; it is ignored in
  		  linked sends).
  
  		On return the result is in ReceiverResultReg.  The callee removes arguments from the stack.
  
  		Note that if a machine code method contains a call to an interpreter primitive it will push any register
  		arguments on the stack before calling the primitive so that to the primitive the stack looks the same
  		as it does in the interpreter.
  
  		Within all machine code primitives except primitiveClosureValue all arguments are taken form registers
  	 	since no machine code primitiver has more than numRegArgs arguments.  primitiveClosureValue pushes
  		its register arguments immedately only for laziness to be able to reuse SimpleStackBasedCogit's code.
  
  		Within machine code methods with interpreter primtiives the register arguments are pushed before calling
  		the interpreter primitive.  In normal methods and if not already done so in [primitive code, the register
  		arguments are pushed during frame build.  If a method is compiled frameless it will access its arguments
  		 in registers."!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>stackToRegisterMapping (in category 'documentation') -----
  stackToRegisterMapping
  	"Stack to register mapping is enabled via a simulation stack { simStack. simStackPtr, simSpillBase } of
  	 operand descriptors (CogSimStackEntry) which serve
  		- to avoid pushing operands to the actual stack by deferring operand manipulation until an
  		  operand-consuming operation (send, store, run-time call)
  		- to record operand type information for constants to avoid unnecessary type checks (e.g. tag checks)
  		- as a simple register allocator since any live registers are recorded in descriptors on the stack.
  
  	The operand types are
  		SSBaseOffset - a value in memory at an offset relative to some register.  For method receiver args
  						 and temps the base register is  FPReg (in a frameful method).  For indirect temps
  						 the register could be any unassigned register.
  		SSConstant - a method literal, hence a Smalltalk object
  		SSRegister - the result of an expression assigned to a register
  		SSSpill - a value spilled to the actual stack
  	The special descriptor simSelf defines self in the current method, relative to FPReg in frameful
  	 methods and  in a register in frameless methods.
  
  	The register allocator aspect allocates registers by searching for SSBaseOffset and SSRegister
  	 descriptors, computing the set of live registers, and then enumerating to find unused ones.
  	 Simulation stack contents must be spilled to the actual stack
  		- at a send (since at a suspension point the actual stack must be valid),
  		- to make a register available if the code generator needs it
  		- at a control flow join (since the two control flows could compute different stack contents and
  		  we choose to avoid the complexity of saving stack contents to allow merging at join points).
  
  	At a control-flow join we must discard type information for values pushed to the stack in either
  	arm of the control-flow, but need /not/ for items pushed before the control flow diverged.  e.g. in
  		self at: 1 put: (expr ifTrue: [v1] ifFalse: [v2]).
  	the 1 is still valid after the control flow join for (expr ifTrue: [v1] ifFalse: [v2]).  So at a conditional
  	branch we record simStackPtr in the target fixup and only void types between it and the
  	simStackPtr at the join point.  This type voiding operation is called merge:.  For now we simply throw
  	away all type info but would like to implement the baove scheme soon.
  
  	 We can determine the stack depth at a conditional branch (if), but how do we determine the stack
  	 depth following an unconditional jump (else)?  There are essentially three cases
  		e ifTrue: [u] ifFalse: [v],
  		e ifTrue: [^u] ifFalse: [v],
  		e ifTrue: [u] ifFalse: [^v]
  
  		1		expr
  		2		jumpCond L1
  		3		push
  		4		jump L2
  		5	L1:
  		6		push
  		7	L2:
  
  		1		expr
  		2		jumpCond L1
  		3		ret
  		4	L1:
  		5		push
  
  		1		expr
  		2		jumpCond L1
  		3		push
  		4		jump L2
  		5	L1:
  		6		ret
  		7	L2:
  
  	In the first case we can know the merge base at L2 by propagating the merge base from 4 jump L2, which
+ 	precedes the target of 2 jumpCond L1.  i.e. the merge base at 7 L2 is the stack pointer at 4 jump L2, which
+ 	precedes the target of 2 jumpCond L1.  So at 2 jumpCond L1 we copy the stack pointer to the merge base
+ 	at 5 L1, /and/ to the preceding 4 jump L2, and when we reach 4 jump L2, propagate the merge base to 7 L2.
- 	preceeds the target of 2 jumpCond L1.  i.e. the merge base at 7 L2 is the stack pointer at 4 jump L2, which
- 	preceeds the target of 2 jumpCond L1.  So at 2 jumpCond L1 we copy the stack pointer to the merge base
- 	at 5 L1, /and/ to the preceeding 4 jump L2, and when we reach 4 jump L2, propagate the merge base to 7 L2.
  
  	 Since we're conscious of JIT performance we restrict the live register search range by maintaining
  	 simSpillBase, which is the index of the unspilled entry furthest from the end of simulation stack.
  	 Only entries from simSpillBase to simStackPtr can contain unspilled, and hence live and volatile
  	 registers (the FPReg is not volatile).
  
  	 We further optimize by maintaining a simple optimization status for register contents.
  	 We record whether ReceiverResultReg contains the receiver or an indirect temp vector
  	 and merge this status at control-flow joins."!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genExtPushClosureBytecode (in category 'bytecode generators') -----
  genExtPushClosureBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
+ 	 and defer generating code for it until after the method and any other preceding
- 	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"253		11111101 eei i i kkk	jjjjjjjj		Push Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A \\ 16 * 8) BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions"
  	| startpc numArgs numCopied |
  	self assert: needsFrame.
  	startpc := bytecodePC + (self generatorAt: byte0) numBytes.
  	self addBlockStartAt: startpc "0 relative"
  		numArgs: (numArgs := (byte1 bitAnd: 16r7) + (extA \\ 16 * 8))
  		numCopied: (numCopied := ((byte1 >> 3) bitAnd: 7) + (extA // 16 * 8))
  		span: byte2 + (extB << 8).
  	extA := extB := 0.
  
  	objectRepresentation createsClosuresInline
  		ifTrue: [ self genInlineClosure: startpc numArgs: numArgs numCopied: numCopied ]
  		ifFalse: [ self genOutlineClosure: startpc numArgs: numArgs numCopied: numCopied ].
  		
  	^ 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushClosureCopyCopiedValuesBytecode (in category 'bytecode generators') -----
  genPushClosureCopyCopiedValuesBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
+ 	 and defer generating code for it until after the method and any other preceding
- 	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"143   10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii"
  	| startpc numArgs numCopied |
  	self assert: needsFrame.
  	startpc := bytecodePC + (self generatorAt: byte0) numBytes.
  	self addBlockStartAt: startpc "0 relative"
  		numArgs: (numArgs := byte1 bitAnd: 16rF)
  		numCopied: (numCopied := byte1 >> 4)
  		span: (byte2 << 8) + byte3.
  
  	objectRepresentation createsClosuresInline 
  		ifTrue: [ self genInlineClosure: startpc numArgs: numArgs numCopied: numCopied ]
  		ifFalse: [ self genOutlineClosure: startpc numArgs: numArgs numCopied: numCopied ].
  		
  	^ 0
  
  	!

Item was changed:
  ----- Method: ThreadedFFIPlugin class>>preambleCCode (in category 'translation') -----
  preambleCCode
  	"For a source of builtin defines grep for builtin_define in a gcc release config directory."
  	^'
  #include "sqAssert.h" /* for assert */
  
  #ifdef _MSC_VER
  # define alloca _alloca
  #endif
  #if defined(__GNUC__) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__))
  # define setsp(sp) asm volatile ("movl %0,%%esp" : : "m"(sp))
  # define getsp() ({ void *esp; asm volatile ("movl %%esp,%0" : "=r"(esp) : ); esp;})
  # elif defined(__GNUC__) && (defined(__arm__))
  # define setsp(sp) asm volatile ("ldr %%sp, %0" : : "m"(sp))
  # define getsp() ({ void *sp; asm volatile ("mov %0, %%sp" : "=r"(sp) : ); sp;})
  #endif
  #if !!defined(getsp)
  # define getsp() 0
  #endif 
  #if !!defined(setsp)
  # define setsp(ignored) 0
  #endif 
  
  #if !!defined(STACK_ALIGN_BYTES)
  # if __APPLE__ && __MACH__ && __i386__
  #  define STACK_ALIGN_BYTES 16
  # elif __linux__ && __i386__
  #  define STACK_ALIGN_BYTES 16
  # elif defined(__amd64__) || defined(__x86_64__) ||  defined(__amd64) || defined(__x86_64)
  #  define STACK_ALIGN_BYTES 16
  # elif defined(powerpc) || defined(__powerpc__) || defined(_POWER) || defined(__POWERPC__) || defined(__PPC__)
  #  define STACK_ALIGN_BYTES 16
+ # elif defined(__sparc64__) || defined(__sparcv9__) || defined(__sparc_v9__) /* must precede 32-bit sparc defs */
- # elif defined(__sparc64__) || defined(__sparcv9__) || defined(__sparc_v9__) /* must preceed 32-bit sparc defs */
  #  define STACK_ALIGN_BYTES 16
  # elif defined(sparc) || defined(__sparc__) || defined(__sparclite__)
  #  define STACK_ALIGN_BYTES 8
  # elif defined(__arm__) 
  #  define STACK_ALIGN_BYTES 8
  # else
  #  define STACK_ALIGN_BYTES 0
  # endif
  #endif /* !!defined(STACK_ALIGN_BYTES) */
  
  #if !!defined(STACK_OFFSET_BYTES)
  # define STACK_OFFSET_BYTES 0
  #endif
  
  #if defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)
  /* Both Mac OS X x86 and Win32 x86 return structs of a power of two in size
   * less than or equal to eight bytes in length in registers. Linux never does so.
   */
  # if __linux__
  #	define WIN32_X86_STRUCT_RETURN 0
  # else
  #	define WIN32_X86_STRUCT_RETURN 1
  # endif
  # if WIN32
  #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1
  # else
  #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0
  # endif
  #endif /* defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) */
  
  #if defined(__arm__)
  #	define WIN32_X86_STRUCT_RETURN 0
  #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0
  #endif /* defined(__arm__) */
  
  #if !!defined(ALLOCA_LIES_SO_USE_GETSP)
  # if defined(__MINGW32__) && (__GNUC__ >= 3)
      /*
       * cygwin -mno-cygwin (MinGW) gcc 3.4.x''s alloca is a library routine that answers
       * %esp + 4, so the outgoing stack is offset by one word if uncorrected.
       * Grab the actual stack pointer to correct.
       */
  #	define ALLOCA_LIES_SO_USE_GETSP 1
  # else
  #	define ALLOCA_LIES_SO_USE_GETSP 0
  # endif
  #endif /* !!defined(ALLOCA_LIES_SO_USE_GETSP) */
  
  /* The dispatchOn:in:with:with: generates an unwanted call on error.  Just squash it. */
  #define error(foo) 0
  
  /* but print assert failures. */
  void
  warning(char *s) { /* Print an error message but don''t exit. */
  	printf("\n%s\n", s);
  }
  '!

Item was changed:
  ----- Method: VMMaker>>generateMainVM (in category 'generate sources') -----
  generateMainVM
  	"Generate the interp (and optionally the cogit), internal plugins and exports.
+ 	 N.B. generateInterpreterFile *must* precede generateCogitFile so that
- 	 N.B. generateInterpreterFile *must* preceed generateCogitFile so that
  	 the objectMemory and interpreter classes are initialized before the Cogit
  	 code is generated."
  
  	self generateInterpreterFile;
  		generateCogitFiles;
  		processFilesForCoreVM;
  		generateInternalPlugins;
  		generateExportsFile!



More information about the Vm-dev mailing list