[Vm-dev] VM Maker: VMMaker.oscog-nice.1982.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Nov 6 20:20:52 UTC 2016


Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1982.mcz

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

Name: VMMaker.oscog-nice.1982
Author: nice
Time: 6 November 2016, 9:19:35.492542 pm
UUID: ed988fdd-7019-41f8-9051-e08afa837953
Ancestors: VMMaker.oscog-nice.1981

Replace remaining long/unsigned long with sqIntptr_t/usqIntptr_t.
Replace asLong/asUnsignedLong senders with asIntegerPtr/asUnsignedIntegerPtr.
This should be essentially for those int containing a target machine pointer/address.

For some printf cCode (used for debugging), the %ld does not work in LLP64.
We use the standard C way for compatible 32 & 64bits code:
use PRI_format_Type macros as the format (mainly PRIxSQPTR).

This way, VMMaker is now LLP64 friendly.
For other conventions (ILP32 and LP64), this does not change anything since sqIntptr_t is equivalent to long.

=============== Diff against VMMaker.oscog-nice.1981 ===============

Item was changed:
  ----- Method: BitBltSimulation>>rgbComponentAlpha32 (in category 'combination rules') -----
  rgbComponentAlpha32
  	"This version assumes 
  		combinationRule = 41
  		sourcePixSize = destPixSize = 32
  		sourceForm ~= destForm.
  	Note: The inner loop has been optimized for dealing
  		with the special case of aR = aG = aB = 0 
  	"
  	| srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY srcY dstY |
  
  	<inline: false> "This particular method should be optimized in itself"
  
  	"Give the compile a couple of hints"
+ 	<var: #deltaX type: 'register sqInt'>
- 	<var: #deltaX type: 'register long'>
  	<var: #sourceWord type: #'unsigned int'>
  	<var: #destWord type: #'unsigned int'>
  
  	"The following should be declared as pointers so the compiler will
  	notice that they're used for accessing memory locations 
  	(good to know on an Intel architecture) but then the increments
  	would be different between ST code and C code so must hope the
  	compiler notices what happens (MS Visual C does)"
+ 	<var: #srcIndex type: 'register sqIntptr_t'>
+ 	<var: #dstIndex type: 'register sqIntptr_t'>
- 	<var: #srcIndex type: 'register long'>
- 	<var: #dstIndex type: 'register long'>
  	
  	deltaY := bbH + 1. "So we can pre-decrement"
  	srcY := sy.
  	dstY := dy.
  
  	"This is the outer loop"
  	[(deltaY := deltaY - 1) ~= 0] whileTrue:[
  		srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
  		dstIndex := destBits + (dstY * destPitch) + (dx * 4).
  		deltaX := bbW + 1. "So we can pre-decrement"
  
  		"This is the inner loop"
  		[(deltaX := deltaX - 1) ~= 0] whileTrue:[
  			sourceWord := self srcLongAt: srcIndex.
  			srcAlpha := sourceWord bitAnd:16rFFFFFF.
  				srcAlpha = 0 ifTrue:[
  					srcIndex := srcIndex + 4.
  					dstIndex := dstIndex + 4.
  					"Now skip as many words as possible,"
  					[(deltaX := deltaX - 1) ~= 0 and:[
  						((sourceWord := self srcLongAt: srcIndex) bitAnd:16rFFFFFF) = 0]]
  						whileTrue:[
  							srcIndex := srcIndex + 4.
  							dstIndex := dstIndex + 4.
  						].
  					"Adjust deltaX"
  					deltaX := deltaX + 1.
  				] ifFalse:[ "0 < srcAlpha"
  					"If we have to mix colors then just copy a single word"
  					destWord := self dstLongAt: dstIndex.
  					destWord := self rgbComponentAlpha32: sourceWord with: destWord.
  					self dstLongAt: dstIndex put: destWord.
  					srcIndex := srcIndex + 4.
  					dstIndex := dstIndex + 4.
  				].
  		].
  		srcY := srcY + 1.
  		dstY := dstY + 1.
  	].!

Item was changed:
  ----- Method: CCodeGenerator>>returnTypeForSend:in:ifNil: (in category 'type inference') -----
  returnTypeForSend: sendNode in: aTMethod ifNil: typeIfNil
  	"Answer the return type for a send.  Unbound sends default to typeIfNil.
  	 Methods with types as yet unknown have a type determined either by the
  	 kernelReturnTypes or the table below, or, if they are in neither set, then nil.
  	 The inferred type should match as closely as possible the C type of
  	 generated expessions so that inlining would not change the expression.
  	 If there is a method for sel but its return type is as yet unknown it mustn't
  	 be defaulted, since on a subsequent pass its type may be computable."
  	| sel methodOrNil |
  	methodOrNil := self anyMethodNamed: (sel := sendNode selector).
  	(methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue:
  		[^self baseTypeForType: methodOrNil returnType].
  	^kernelReturnTypes
  		at: sel
  		ifAbsent:
  			[sel
  				caseOf: {
  				[#integerValueOf:]		->	[#sqInt].
  				[#isIntegerObject:]		->	[#int].
  				[#negated]				->	[self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
  				[#+]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#-]						->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#*]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#/]						->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#//]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#\\]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#rem:]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#quo:]					->	[self typeForArithmetic: sendNode in: aTMethod].
  				"C99 Sec Bitwise shift operators ... 3 Sematics ...
  				 The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..."
  				[#>>]					->	[self typeFor: sendNode receiver in: aTMethod].
  				[#<<]					->	[self typeFor: sendNode receiver in: aTMethod].
  				[#addressOf:]			->	[(self typeFor: sendNode receiver in: aTMethod)
  												ifNil: [#sqInt]
  												ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
  				[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
  				[#bitAnd:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitOr:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitXor:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitClear:]				->	[self typeForArithmetic: sendNode in: aTMethod].
  				[#bitInvert32]			->	[#'unsigned int'].
  				[#bitInvert64]			->	[self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
  				[#byteSwap32]			->	[#'unsigned int'].
  				[#byteSwap64]			->	[#'unsigned long long'].
  				[#byteSwapped32IfBigEndian:]	->	[#'unsigned int'].
  				[#byteSwapped64IfBigEndian:]	->	[#'unsigned long long'].
  				[#=]					->	[#int].
  				[#~=]					->	[#int].
  				[#==]					->	[#int].
  				[#~~]					->	[#int].
  				[#<]					->	[#int].
  				[#<=]					->	[#int].
  				[#>]					->	[#int].
  				[#>=]					->	[#int].
  				[#between:and:]		->	[#int].
  				[#anyMask:]				->	[#int].
  				[#allMask:]				->	[#int].
  				[#noMask:]				->	[#int].
  				[#isNil]					->	[#int].
  				[#notNil]				->	[#int].
  				[#&]					->	[#int].
  				[#|]						->	[#int].
  				[#not]					->	[#int].
  				[#asFloat]				->	[#double].
  				[#atan]					->	[#double].
  				[#exp]					->	[#double].
  				[#log]					->	[#double].
  				[#sin]					->	[#double].
  				[#sqrt]					->	[#double].
  				[#asLong]				->	[#long].
  				[#asInteger]			->	[#sqInt].
  				[#asIntegerPtr]			->	[#'sqIntptr_t'].
  				[#asUnsignedInteger]	->	[#usqInt].
  				[#asUnsignedIntegerPtr]->	[#'usqIntptr_t'].
  				[#asUnsignedLong]		->	[#'unsigned long'].
  				[#asUnsignedLongLong]		->	[#'unsigned long long'].
  				[#asVoidPointer]		->	[#'void *'].
  				[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
  				[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
  				[#cCoerce:to:]			->	[sendNode args last value].
  				[#cCoerceSimple:to:]	->	[sendNode args last value].
+ 				[#sizeof:]				->	[#'usqIntptr_t']. "Technically it's a size_t but it matches on target architectures so far..."
- 				[#sizeof:]				->	[#'unsigned long']. "Technically it's a size_t but it matches unsigned long on target architectures so far..."
  				[#ifTrue:ifFalse:]		->	[self typeForConditional: sendNode in: aTMethod].
  				[#ifFalse:ifTrue:]		->	[self typeForConditional: sendNode in: aTMethod].
  				[#ifTrue:]				->	[self typeForConditional: sendNode in: aTMethod].
  				[#ifFalse:]				->	[self typeForConditional: sendNode in: aTMethod].
  				[#and:]					->	[#sqInt].
  				[#or:]					->	[#sqInt] }
  				otherwise: "If there /is/ a method for sel but its return type is as yet unknown it /mustn't/ be defaulted,
  							since on a subsequent pass its type may be computable.  Only default unbound selectors."
  					[methodOrNil ifNotNil: [nil] ifNil: [typeIfNil]]]!

Item was changed:
  ----- Method: ClipboardExtendedPlugin>>ioAddClipboardData:data:dataFormat: (in category 'io') -----
  ioAddClipboardData: clipboard data: data dataFormat: aFormat
  	| clipboardAddress formatLength dataLength |
+ 	<var: #clipboardAddress type: #'usqIntptr_t'>
- 	<var: #clipboardAddress type: #'unsigned long'>
  	self primitive: 'ioAddClipboardData' parameters: #(Oop ByteArray String).
  
  	clipboardAddress := interpreterProxy positiveMachineIntegerValueOf: clipboard.
  	dataLength := interpreterProxy slotSizeOf: data cPtrAsOop.
  	formatLength := interpreterProxy slotSizeOf: aFormat cPtrAsOop.
  
  	self sqPasteboardPutItemFlavor: clipboardAddress data: data length: dataLength formatType: aFormat formatLength: formatLength.
  !

Item was changed:
  ----- Method: ClipboardExtendedPlugin>>ioClearClipboard: (in category 'io') -----
  ioClearClipboard: clipboard
  	| clipboardAddress |
+ 	<var: #clipboardAddress type: #'usqIntptr_t'>
- 	<var: #clipboardAddress type: #'unsigned long'>
  	self primitive: 'ioClearClipboard' parameters: #(Oop).
  	clipboardAddress :=  interpreterProxy positiveMachineIntegerValueOf: clipboard.
  	self sqPasteboardClear: clipboardAddress.!

Item was changed:
  ----- Method: ClipboardExtendedPlugin>>ioGetClipboardFormat:formatNumber: (in category 'io') -----
  ioGetClipboardFormat: clipboard formatNumber: formatNumber 
  	| clipboardAddress itemCount |
+ 	<var: #clipboardAddress type: #'usqIntptr_t'>
- 	<var: #clipboardAddress type: #'unsigned long'>
  	self primitive: 'ioGetClipboardFormat' parameters: #(#Oop #SmallInteger ).
  	clipboardAddress := interpreterProxy positiveMachineIntegerValueOf: clipboard.
  	itemCount := self sqPasteboardGetItemCount: clipboardAddress.
  	itemCount > 0
  		ifTrue: [^ self sqPasteboardCopyItemFlavors: clipboardAddress itemNumber: formatNumber].
  	^ interpreterProxy nilObject!

Item was changed:
  ----- Method: ClipboardExtendedPlugin>>ioReadClipboardData:format: (in category 'io') -----
  ioReadClipboardData: clipboard format: format
  	| clipboardAddress formatLength |
+ 	<var: #clipboardAddress type: #'usqIntptr_t'>
- 	<var: #clipboardAddress type: #'unsigned long'>
  	self primitive: 'ioReadClipboardData' parameters: #(Oop String).
  	clipboardAddress := interpreterProxy positiveMachineIntegerValueOf: clipboard.
  	formatLength := interpreterProxy slotSizeOf: format cPtrAsOop.
  	^ self sqPasteboardCopyItemFlavorData: clipboardAddress format: format formatLength: formatLength.
  !

Item was changed:
  ----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
  printMethodCacheFor: thing
  	<api>
  	| n |
  	n := 0.
  	0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
  		[:i | | s c m p |
  		s := methodCache at: i + MethodCacheSelector.
  		c := methodCache at: i + MethodCacheClass.
  		m := methodCache at: i + MethodCacheMethod.
  		p := methodCache at: i + MethodCachePrimFunction.
  		((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing
  			or: [(objectMemory addressCouldBeObj: m)
  				and: [(self maybeMethodHasCogMethod: m)
  				and: [(self cogMethodOf: m) asInteger = thing]]]]]]])
  		 and: [(objectMemory addressCouldBeOop: s)
  		 and: [c ~= 0
  		 and: [(self addressCouldBeClassObj: c)
  			or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
  			[n := n + 1.
  			 self cCode: [] inSmalltalk: [self transcript ensureCr].
  			 self printNum: i; space; printHexnp: i; cr; tab.
  			 (objectMemory isBytesNonImm: s)
+ 				ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
- 				ifTrue: [self cCode: 'printf("%lx %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
  						inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
  				ifFalse: [self shortPrintOop: s].
  			 self tab.
  			 (self addressCouldBeClassObj: c)
  				ifTrue: [self shortPrintOop: c]
  				ifFalse: [self printNum: c; space; printHexnp: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
  			self tab; shortPrintOop: m; tab.
  			self cCode:
  					[p > 1024
  						ifTrue: [self printHexnp: p]
  						ifFalse: [self printNum: p]]
  				inSmalltalk:
  					[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
  			self cr]].
  	n > 1 ifTrue:
  		[self printNum: n; cr]!

Item was changed:
  ----- Method: CoInterpreter>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') -----
  rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress
  	"Rewrite an existing entry in the method cache with a new primitive function address.
  	 Used by primitiveExternalCall to make direct calls to found external prims, or quickly
  	 fail not found external prims.
  	 Override to do the same to the machine code call.  If methodObj has a cogged dual
  	 rewrite the primitive call in it to call localPrimAddress. Used to update calls through
  	 primitiveExternalCall to directly call the target function or to revert to calling
  	 primitiveExternalCall after a flush."
  	<var: #localPrimAddress declareC: 'void (*localPrimAddress)(void)'>
  	<inline: false>
  	(self methodHasCogMethod: newMethod) ifTrue:
  		[cogit
  			rewritePrimInvocationIn: (self cogMethodOf: newMethod)
  			to: (localPrimAddress = 0
  				ifTrue: [self cCoerceSimple: #primitiveFail to: #'void (*)(void)']
  				ifFalse: [localPrimAddress])].
  	(methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue:
  		[methodCache
  			at: lastMethodCacheProbeWrite + MethodCachePrimFunction
+ 			put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]!
- 			put: (self cCoerce: localPrimAddress to: #long)]!

Item was changed:
  ----- Method: CogARMCompiler class>>machineCodeDeclaration (in category 'translation') -----
  machineCodeDeclaration
  	"Answer the declaration for the machineCode array."
+ 	^{#'usqIntptr_t'. '[', self basicNew machineCodeWords printString, ']'}!
- 	^{#'unsigned long'. '[', self basicNew machineCodeWords printString, ']'}!

Item was changed:
  ----- Method: CogARMCompiler>>isInImmediateJumpRange: (in category 'testing') -----
  isInImmediateJumpRange: operand
  	"ARM calls and jumps span +/- 32 mb, more than enough for intra-zone calls and jumps."
+ 	<var: #operand type: #'usqIntptr_t'>
- 	<var: #operand type: #'unsigned long'>
  	^operand signedIntFromLong between: -16r2000000 and: 16r1FFFFFC!

Item was changed:
  ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct."
  	"{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do:
  		[:c| Transcript print: c; cr. c printTypedefOn: Transcript]"
  	(self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do:
  		[:ivn|
  		ivn ~= 'bcpc' ifTrue:
  			[aBinaryBlock
  				value: ivn
  				value: (ivn caseOf: {
+ 							['address']			-> [#'usqIntptr_t'].
- 							['address']			-> [#'unsigned long'].
  							['machineCode']	-> [self machineCodeDeclaration].
+ 							['operands']		-> [{#'usqIntptr_t'. '[', NumOperands, ']'}].
- 							['operands']		-> [{#'unsigned long'. '[', NumOperands, ']'}].
  							['dependent']		-> ['struct _AbstractInstruction *']}
  						otherwise:
  							[#'unsigned char'])]]!

Item was changed:
  ----- Method: CogMIPSELCompiler class>>machineCodeDeclaration (in category 'translation') -----
  machineCodeDeclaration
  	"Answer the declaration for the machineCode array."
+ 	^{#'usqIntptr_t'. '[', self basicNew machineCodeWords printString, ']'}!
- 	^{#'unsigned long'. '[', self basicNew machineCodeWords printString, ']'}!

Item was changed:
  ----- Method: CogMethodZone>>roundUpAddress: (in category 'accessing') -----
  roundUpAddress: address
  	<returnTypeC: #'void *'>
  	<var: #address type: #'void *'>
+ 	^self cCoerce: ((self cCoerce: address to: #'usqIntptr_t') + 7 bitAnd: -8) to: #'void *'!
- 	^self cCoerce: ((self cCoerce: address to: 'unsigned long') + 7 bitAnd: -8) to: #'void *'!

Item was changed:
  ----- Method: CogVMSimulator>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') -----
  rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress
  	super rewriteMethodCacheEntryForExternalPrimitiveToFunction:
  				(self mapFunctionToAddress: (localPrimAddress = 0
  												ifTrue: [#primitiveFail]
  												ifFalse: [localPrimAddress])).
  	"Hack; the super call will rewrite the entry to the address of the function.
  	 So (when simulating) undo the damage and put back the functionPointer"
  	(methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue:
  		[methodCache
  			at: lastMethodCacheProbeWrite + MethodCachePrimFunction
+ 			put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]!
- 			put: (self cCoerce: localPrimAddress to: #long)]!

Item was changed:
  ----- Method: CogX64Compiler>>isQuick: (in category 'testing') -----
  isQuick: operand
+ 	<var: #operand type: #'usqIntptr_t'>
- 	<var: #operand type: #'unsigned long'>
  	^operand signedIntFromLong64 between: -128 and: 127!

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:'"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: #ceGetFP
+ 			declareC: 'usqIntptr_t (*ceGetFP)(void)';
- 			declareC: 'unsigned long (*ceGetFP)(void)';
  		var: #ceGetSP
+ 			declareC: 'usqIntptr_t (*ceGetSP)(void)';
- 			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)(usqIntptr_t from, usqIntptr_t to)';
- 			declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
  		var: #ceCheckFeaturesFunction
+ 			declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)';
- 			declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
  		var: #ceTryLockVMOwner
+ 			declareC: 'usqIntptr_t (*ceTryLockVMOwner)(void)';
- 			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 *';
  		var: 'enumeratingCogMethod' type: #'CogMethod *'.
  	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
  					fullBlockNoContextSwitchEntry fullBlockEntry
  					picMNUAbort picInterpretAbort  endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
  			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: #'usqIntptr_t';
+ 		declareVar: #debugPrimCallStackOffset type: #'usqIntptr_t'.
- 		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)].
  	"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>>cFramePointerAddress (in category 'trampoline support') -----
  cFramePointerAddress
+ 	<cmacro: '() ((usqIntptr_t)&CFramePointer)'>
- 	<cmacro: '() ((unsigned long)&CFramePointer)'>
  	^(backEnd wantsNearAddressFor: #CFramePointer)
  		ifTrue: [self simulatedReadWriteVariableAddress: #getCFramePointer in: self]
  		ifFalse: [coInterpreter inMemoryCFramePointerAddress]!

Item was changed:
  ----- Method: Cogit>>cStackPointerAddress (in category 'trampoline support') -----
  cStackPointerAddress
+ 	<cmacro: '() ((usqIntptr_t)&CStackPointer)'>
- 	<cmacro: '() ((unsigned long)&CStackPointer)'>
  	^(backEnd wantsNearAddressFor: #CStackPointer)
  		ifTrue: [self simulatedReadWriteVariableAddress: #getCStackPointer in: self]
  		ifFalse: [coInterpreter inMemoryCStackPointerAddress]!

Item was changed:
  ----- Method: Cogit>>genGetLeafCallStackPointer (in category 'initialization') -----
  genGetLeafCallStackPointer
  	"Generate a routine that answers the stack pointer immedately
  	 after a leaf call, used for checking stack pointer alignment."
  	| startAddress |
  	<inline: false>
  	self allocateOpcodes: 4 bytecodes: 0.
  	startAddress := methodZoneBase.
  	self
  		MoveR: FPReg R: backEnd cResultRegister;
  		RetN: 0.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: 'ceGetFP' address: startAddress.
+ 	ceGetFP := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'.
- 	ceGetFP := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'.
  	startAddress := methodZoneBase.
  	self zeroOpcodeIndex.
  	self MoveR: SPReg R: backEnd cResultRegister.
  	backEnd leafCallStackPointerDelta ~= 0 ifTrue:
  		[self AddCq: backEnd leafCallStackPointerDelta R: backEnd cResultRegister].
  	self RetN: 0.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: 'ceGetSP' address: startAddress.
+ 	ceGetSP := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'!
- 	ceGetSP := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'!

Item was changed:
  ----- Method: Cogit>>generateVMOwnerLockFunctions (in category 'initialization') -----
  generateVMOwnerLockFunctions
  	| startAddress |
  	<inline: true>
  	self cppIf: COGMTVM
  		ifTrue:
  			[self allocateOpcodes: backEnd numLowLevelLockOpcodes bytecodes: 0.
  			self zeroOpcodeIndex.
  			startAddress := methodZoneBase.
  			backEnd generateLowLevelTryLock: coInterpreter vmOwnerLockAddress.
  			self outputInstructionsForGeneratedRuntimeAt: startAddress.
  			self recordGeneratedRunTime: 'ceTryLockVMOwner' address: startAddress.
+ 			ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'.
- 			ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'.
  
  			self zeroOpcodeIndex.
  			initialPC := 0.
  			endPC := numAbstractOpcodes - 1.
  			startAddress := methodZoneBase.
  			backEnd generateLowLevelUnlock: coInterpreter vmOwnerLockAddress.
  			self outputInstructionsForGeneratedRuntimeAt: startAddress.
  			self recordGeneratedRunTime: 'ceUnlockVMOwner' address: startAddress.
  			ceUnlockVMOwner := self cCoerceSimple: startAddress to: #'void (*)(void)']!

Item was changed:
  ----- Method: Cogit>>maybeGenerateCheckFeatures (in category 'initialization') -----
  maybeGenerateCheckFeatures
  	| startAddress |
  	<inline: true>
  	backEnd numCheckFeaturesOpcodes > 0 ifTrue:
  		[self allocateOpcodes: backEnd numCheckFeaturesOpcodes bytecodes: 0.
  		 startAddress := methodZoneBase.
  		 backEnd generateCheckFeatures.
  		 self outputInstructionsForGeneratedRuntimeAt: startAddress.
  		 self recordGeneratedRunTime: 'ceCheckFeaturesFunction' address: startAddress.
+ 		 ceCheckFeaturesFunction := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)']!
- 		 ceCheckFeaturesFunction := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)']!

Item was changed:
  ----- Method: Cogit>>maybeGenerateICacheFlush (in category 'initialization') -----
  maybeGenerateICacheFlush
  	| startAddress |
  	<inline: true>
  	backEnd numICacheFlushOpcodes > 0 ifTrue:
  		[self allocateOpcodes: backEnd numICacheFlushOpcodes bytecodes: 0.
  		 startAddress := methodZoneBase.
  		 backEnd generateICacheFlush.
  		 self outputInstructionsForGeneratedRuntimeAt: startAddress.
  		 self recordGeneratedRunTime: 'ceFlushICache' address: startAddress.
+ 		 ceFlushICache := self cCoerceSimple: startAddress to: #'void (*)(usqIntptr_t,usqIntptr_t)']!
- 		 ceFlushICache := self cCoerceSimple: startAddress to: #'void (*)(unsigned long,unsigned long)']!

Item was changed:
  ----- Method: Cogit>>positiveMachineIntegerFor: (in category 'profiling primitives') -----
  positiveMachineIntegerFor: value
+ 	<var: #value type: #'usqIntptr_t'>
- 	<var: #value type: #'unsigned long'>
  	<inline: true>
  	^objectMemory wordSize = 8
  		ifTrue: [coInterpreter positive64BitIntegerFor: value]
  		ifFalse: [coInterpreter positive32BitIntegerFor: value]!

Item was changed:
  ----- Method: IA32ABIPlugin>>primAllocateExecutablePage (in category 'primitives-memory management') -----
  primAllocateExecutablePage
  	"Answer an Alien for an executable page; for thunks"
  	"primAllocateExecutablePage ^<Alien>
  		<primitive: 'primAllocateExecutablePage' error: errorCode module: 'IA32ABI'>"
  	| byteSize ptr mem alien |
  	<export: true>
+ 	<var: #byteSize type: #'sqIntptr_t'>
+ 	<var: #ptr type: #'sqIntptr_t *'>
+ 	<var: #mem type: #'void *'>
- 	<var: #byteSize type: 'long'>
- 	<var: #ptr type: 'long *'>
- 	<var: #mem type: 'void *'>
  
  	self cCode: 'mem = allocateExecutablePage(&byteSize)'
  		inSmalltalk: [self error: 'not yet implemented'. mem := 0. byteSize := 0].
  	mem = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoCMemory].
  	alien := interpreterProxy
  				instantiateClass: interpreterProxy classAlien
  				indexableSize: 2 * interpreterProxy bytesPerOop.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	ptr := interpreterProxy firstIndexableField: alien.
  	ptr at: 0 put: 0 - byteSize. "indirect mem indicated by negative size. Slang doesn't grok negated"
+ 	ptr at: 1 put: (self cCoerce: mem to: #'sqIntptr_t').
- 	ptr at: 1 put: (self cCoerce: mem to: 'long').
  	interpreterProxy methodReturnValue: alien!

Item was changed:
  ----- Method: IA32ABIPlugin>>primBoxedFree (in category 'primitives-memory management') -----
  primBoxedFree
  	"Free the memory referenced by the receiver, an Alien."
  	"proxy <Alien> primFree ^<Alien>
  		<primitive: 'primBoxedFree' error: errorCode module: 'IA32ABI'>"
  	| addr rcvr ptr sizeField |
  	<export: true>
+ 	<var: #ptr type: #'sqIntptr_t *'>
+ 	<var: #addr type: #'sqIntptr_t'>
+ 	<var: #sizeField type: #'sqIntptr_t'>
- 	<var: #ptr type: 'sqInt *'>
- 	<var: #sizeField type: 'long'>
  
  	rcvr := interpreterProxy stackValue: 0.
  	(interpreterProxy byteSizeOf: rcvr) >= (2 * interpreterProxy bytesPerOop) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	ptr := interpreterProxy firstIndexableField: rcvr.
  	sizeField := ptr at: 0.
  	addr := ptr at: 1.
  	"Don't you dare to free Squeak's memory!!"
  	(sizeField >= 0 or: [addr = 0 or: [interpreterProxy isInMemory: addr]]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	self cCode: 'free((void *)addr)'
  		inSmalltalk: [self Cfree: addr].
  	ptr
  		at: 0 put: 0;
  		at: 1 put: 0 "cleanup"!

Item was changed:
  ----- Method: IA32ABIPlugin>>primThunkEntryAddress (in category 'primitives-callbacks') -----
  primThunkEntryAddress
  	"Answer the address of the entry-point for thunk callbacks:
  		long thunkEntry(void *thunkp, long *stackp);
  	 This could be derived via loadModule: findSymbol: etc but that would
  	preclude making the plugin internal."
  	| address |
  	<export: true>
+ 	address := self cCode: [#thunkEntry asIntegerPtr] inSmalltalk: [0].
- 	address := self cCode: [#thunkEntry asInteger] inSmalltalk: [0].
  	interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: address)!

Item was changed:
  ----- Method: Interpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	aCCodeGenerator addHeaderFile:'<setjmp.h>'.
  	self declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: 'Context'.
  	aCCodeGenerator 
  		var: #interpreterProxy 
  		type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void *primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex +2) printString, ' */] = ',	self primitiveTableString.
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  		declareC: 'void *primitiveFunctionPointer'.	"xxxx FIX THIS STUPIDITY xxxx - ikp. What he means is use a better type than void *, apparently - tpr"
  	aCCodeGenerator
  		var: #methodCache
+ 		declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
- 		declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #atCache
  		declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
  	aCCodeGenerator var: #localIP type: #'char*'.
  	aCCodeGenerator var: #localSP type: #'char*'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void*'.
  	aCCodeGenerator var: 'semaphoresToSignalA'
  		declareC: 'sqInt semaphoresToSignalA[SemaphoresToSignalSize + 1 /* ', (SemaphoresToSignalSize + 1) printString, ' */]'.
  	aCCodeGenerator var: 'semaphoresToSignalB'
  		declareC: 'sqInt semaphoresToSignalB[SemaphoresToSignalSize + 1 /* ', (SemaphoresToSignalSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #compilerHooks
  		declareC: 'sqInt (*compilerHooks[CompilerHooksSize + 1 /* ', (CompilerHooksSize + 1) printString, ' */])()'.
  	aCCodeGenerator
  		var: #externalPrimitiveTable
  		declareC: 'void *externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */]'.
  
  	aCCodeGenerator
  		var: #jmpBuf
  		declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedCallbacks
  		declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedMethods
  		declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  
  	self declareCAsOop: {
  		#instructionPointer. 
  		#method. 
  		#newMethod. 
  		#activeContext. 
  		#theHomeContext. 
  		#stackPointer
  	} in: aCCodeGenerator.
  
  	aCCodeGenerator var: #nextProfileTick type: #sqLong.
  !

Item was changed:
  ----- Method: Interpreter>>addNewMethodToCache (in category 'method lookup cache') -----
  addNewMethodToCache
  	"Add the given entry to the method cache.
  	The policy is as follows:
  		Look for an empty entry anywhere in the reprobe chain.
  		If found, install the new entry there.
  		If not found, then install the new entry at the first probe position
  			and delete the entries in the rest of the reprobe chain.
  		This has two useful purposes:
  			If there is active contention over the first slot, the second
  				or third will likely be free for reentry after ejection.
  			Also, flushing is good when reprobe chains are getting full."
  	| probe hash |
  	<inline: false>
  	hash := messageSelector bitXor: lkupClass.  "drop low-order zeros from addresses"
  	(self isOopCompiledMethod: newMethod)
  		ifTrue:
  			[primitiveIndex := self primitiveIndexOf: newMethod.
  			 primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: lkupClass]
  		ifFalse:
  			[primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
  
  	primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: lkupClass.
  	
  	0 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
  		(methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
  			["Found an empty entry -- use it"
  			methodCache at: probe + MethodCacheSelector put: messageSelector.
  			methodCache at: probe + MethodCacheClass put: lkupClass.
  			methodCache at: probe + MethodCacheMethod put: newMethod.
  			methodCache at: probe + MethodCachePrim put: primitiveIndex.
+ 			methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t').
- 			methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: 'long').
  			^ nil]].
  
  	"OK, we failed to find an entry -- install at the first slot..."
  	probe := hash bitAnd: MethodCacheMask.  "first probe"
  	methodCache at: probe + MethodCacheSelector put: messageSelector.
  	methodCache at: probe + MethodCacheClass put: lkupClass.
  	methodCache at: probe + MethodCacheMethod put: newMethod.
  	methodCache at: probe + MethodCachePrim put: primitiveIndex.
+ 	methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t').
- 	methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: 'long').
  
  	"...and zap the following entries"
  	1 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
  		methodCache at: probe + MethodCacheSelector put: 0].
  !

Item was changed:
  ----- Method: Interpreter>>rewriteMethodCacheSel:class:primIndex:primFunction: (in category 'method lookup cache') -----
  rewriteMethodCacheSel: selector class: class primIndex: localPrimIndex primFunction: localPrimAddress
  	"Rewrite an existing entry in the method cache with a new primitive 
  	index & function address. Used by primExternalCall to make direct jumps to found external prims"
  	| probe hash |
  	<inline: false>
  	<var: #localPrimAddress type: 'void *'>
  	hash := selector bitXor: class.
  	0 to: CacheProbeMax - 1 do: [:p | 
  			probe := hash >> p bitAnd: MethodCacheMask.
  			((methodCache at: probe + MethodCacheSelector) = selector
  					and: [(methodCache at: probe + MethodCacheClass) = class])
  				ifTrue: [methodCache at: probe + MethodCachePrim put: localPrimIndex.
+ 					methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: localPrimAddress to: #'sqIntptr_t').
- 					methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: localPrimAddress to: 'long').
  					^ nil]]!

Item was changed:
  ----- Method: InterpreterPlugin>>positiveMachineIntegerFor: (in category 'API access') -----
  positiveMachineIntegerFor: value
+ 	<var: #value type: #'usqIntptr_t'>
- 	<var: #value type: #'unsigned long'>
  	<inline: true>
  	^interpreterProxy wordSize = 8
  		ifTrue: [interpreterProxy positive64BitIntegerFor: value]
  		ifFalse: [interpreterProxy positive32BitIntegerFor: value]!

Item was changed:
  ----- Method: InterpreterPlugin>>signedMachineIntegerFor: (in category 'API access') -----
  signedMachineIntegerFor: value
+ 	<var: #value type: #'sqIntptr_t'>
- 	<var: #value type: #'unsigned long'>
  	<inline: true>
  	^interpreterProxy wordSize = 8
  		ifTrue: [interpreterProxy signed64BitIntegerFor: value]
  		ifFalse: [interpreterProxy signed32BitIntegerFor: value]!

Item was changed:
  ----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') -----
  positiveMachineIntegerValueOf: oop
  	"Answer a value of an integer in address range, i.e up to the size of a machine word.
  	The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size."
+ 	<returnTypeC: #'usqIntptr_t'>
- 	<returnTypeC: #'unsigned long'>
  	<inline: true> "only two callers & one is primitiveNewWithArg"
  	| value bs ok |
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[value := objectMemory integerValueOf: oop.
  		 value < 0 ifTrue: [^self primitiveFail].
  		^value].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok ifFalse:
  		[self primitiveFail.
  		 ^0].
  	bs := objectMemory numBytesOfBytes: oop.
+ 	bs > (self sizeof: #'usqIntptr_t') ifTrue:
- 	bs > (self sizeof: #'unsigned long') ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	"self cppIf: SPURVM
  		ifTrue: [""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes""
  			^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
+ 		ifFalse: ["((self sizeof: #'usqIntptr_t') = 8
- 		ifFalse: ["((self sizeof: #'unsigned long') = 8
  			and: [bs > 4])
  				ifTrue:
  					[^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
  				ifFalse:
  					[^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]"!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetNextEvent (in category 'I/O primitives') -----
  primitiveGetNextEvent
  	"Primitive. Return the next input event from the VM event queue."
  	| evtBuf arg value eventTypeIs |
+ 	<var: #evtBuf declareC:'sqIntptr_t evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
- 	<var: #evtBuf declareC:'long evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
  	self cCode: [] inSmalltalk: [evtBuf := objectMemory newInputEventAccessorOfSize: 8].
  	arg := self stackTop.
  	((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  
  	self ioGetNextEvent: (self cCoerce: evtBuf to: 'sqInputEvent*').
  	self successful ifFalse:
  		[^nil].
  
  	"Event type"
  	eventTypeIs := evtBuf at: 0.
  	self storeInteger: 0 ofObject: arg withValue: (evtBuf at: 0).
  	self successful ifFalse:
  		[^nil].
  
  	eventTypeIs = 6 
  		ifTrue: "Event is Complex, assume evtBuf is populated correctly and return"
  			[1 to: 7 do: [:i |
  				value := evtBuf at: i.
  				self storePointer: i ofObject: arg withValue: value]]
  		ifFalse:
  			["Event time stamp"
  			self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
  			self successful ifFalse:
  				[^nil].	
  
  			"Event arguments"
  			2 to: 7 do:[:i|
  				value := evtBuf at: i.
  				(objectMemory isIntegerValue: value)
  					ifTrue:[self storeInteger: i ofObject: arg withValue: value]
  					ifFalse:
  						[value := self positiveMachineIntegerFor: value.
  						objectMemory storePointer: i ofObject: arg withValue: value]]].
  
  	self successful ifTrue: [self pop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>signedMachineIntegerValueOf: (in category 'primitive support') -----
  signedMachineIntegerValueOf: oop
  	"Answer a signed value of an integer up to the size of a machine word.
  	The object may be either a positive SmallInteger or a LargeInteger of size <= word size."
+ 	<returnTypeC: #'sqIntptr_t'>
- 	<returnTypeC: #'long'>
  	| negative ok bs value limit magnitude |
+ 	<var: #value type: #sqInt>
+ 	<var: #magnitude type: #'usqIntptr_t'>
+ 	<var: #limit type: #'usqIntptr_t'>
- 	<var: #value type: #long>
- 	<var: #magnitude type: #usqInt>
- 	<var: #limit type: #usqInt>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[^objectMemory integerValueOf: oop].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[^self primitiveFail].
  
  	ok := objectMemory isClassOfNonImm: oop
  					equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  					compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok
  		ifTrue: [negative := false]
  		ifFalse:
  			[negative := true.
  			 ok := objectMemory isClassOfNonImm: oop
  							equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
  							compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
  			ok ifFalse: [^self primitiveFail]].
  	bs := objectMemory numBytesOf: oop.
+ 	bs > (self sizeof: #'usqIntptr_t') ifTrue:
- 	bs > (self sizeof: #'unsigned long') ifTrue:
  		[^self primitiveFail].
  
  	"self cppIf: SPURVM
  		ifTrue:
  			[""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes""
  			magnitude := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
  		ifFalse:
+ 			["((self sizeof: #'sqIntptr_t') = 8
- 			["((self sizeof: #'unsigned long') = 8
  			and: [bs > 4])
  				ifTrue:
  					[magnitude := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
  				ifFalse:
  					[magnitude := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]".
  
+ 	limit := 1 asUnsignedIntegerPtr << ((self sizeof: #'sqIntptr_t') * 8 - 1).
- 	limit := 1 asUnsignedInteger << ((self sizeof: #usqInt) * 8 - 1).
  	(negative
  		ifTrue: [magnitude > limit]
  		ifFalse: [magnitude >= limit])
  			ifTrue: [self primitiveFail.
  				^0].
  	negative
  		ifTrue: [value := 0 - magnitude]
  		ifFalse: [value := magnitude].
  	^value!

Item was changed:
  ----- Method: InterpreterProxy>>positiveMachineIntegerValueOf: (in category 'converting') -----
  positiveMachineIntegerValueOf: oop
+ 	<returnTypeC: #'usqIntptr_t'>
- 	<returnTypeC: #'unsigned long'>
  	oop isInteger ifFalse:[self error: 'Not an integer object'].
  	^oop < 0 
  		ifTrue: [self primitiveFail. 0]
  		ifFalse: [oop]!

Item was changed:
  ----- Method: InterpreterProxy>>signedMachineIntegerValueOf: (in category 'converting') -----
  signedMachineIntegerValueOf: oop
+ 	<returnTypeC: #'sqIntptr_t'>
- 	<returnTypeC: #'long'>
  	oop isInteger ifFalse:[self error:'Not an integer object'].
  	^oop!

Item was changed:
  ----- Method: InterpreterProxy>>stackPositiveMachineIntegerValue: (in category 'stack access') -----
  stackPositiveMachineIntegerValue: offset
+ 	<returnTypeC: #'usqIntptr_t'>
  	^self positiveMachineIntegerValueOf: (self stackValue: offset)!

Item was changed:
  ----- Method: InterpreterProxy>>stackSignedMachineIntegerValue: (in category 'stack access') -----
  stackSignedMachineIntegerValue: offset
+ 	<returnTypeC: #'sqIntptr_t'>
  	^self signedMachineIntegerValueOf: (self stackValue: offset)!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitSizeOfCSI: (in category 'util') -----
  digitSizeOfCSI: csi 
  	"Answer the number of 32-bits fields of a C-SmallInteger. This value is 
  	   the same as the largest legal subscript."
  	^(interpreterProxy maxSmallInteger <= 16r3FFFFFFF)
  		ifTrue: [1]
+ 		ifFalse: [csi > 16rFFFFFFFF asIntegerPtr "conversion is not really needed here, but avoid generating a warning in 32bits, and harmless in 64bits"
- 		ifFalse: [csi > 16rFFFFFFFF asLong "asLong is not really needed here, but avoid generating a warning in 32bits, and harmless in 64bits"
  			ifTrue: [2]
  			ifFalse: [csi < -16rFFFFFFFF
  				ifTrue: [2]
  				ifFalse: [1]]]!

Item was changed:
  ----- Method: MacMenubarPlugin>>primitiveCreateStandardWindowMenu: (in category 'system primitives') -----
  primitiveCreateStandardWindowMenu: inOptions 
  	<var: #menuHandle type: #MenuHandle>
  	| menuHandle result |
  	self primitive: 'primitiveCreateStandardWindowMenu'
  		parameters: #(SmallInteger).
  	self cppIf: #'TARGET_API_MAC_CARBON'
  		ifTrue: [result := self cCode: 'CreateStandardWindowMenu(inOptions,&menuHandle);' inSmalltalk:[0]].
+ 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
- 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')!

Item was changed:
  ----- Method: MacMenubarPlugin>>primitiveGetIndMenuWithCommandID:commandID: (in category 'system primitives') -----
  primitiveGetIndMenuWithCommandID: menuHandleOop commandID: aCommandID
  	<var: #menuHandle type: #MenuHandle>
  	<var: #commandID type: #MenuCommand>
  	<var: #applicationMenu type: #MenuHandle>
  	<var: #outIndex type: #MenuItemIndex>
  	| menuHandle commandID applicationMenu outIndex |
  	self primitive: 'primitiveGetIndMenuWithCommandID'
  		parameters: #(Oop Oop).
  	menuHandle := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: menuHandleOop) to: 'MenuHandle'.
  	commandID := self cCoerce: (interpreterProxy positive32BitValueOf: aCommandID) to: 'MenuCommand'.
  	(self ioCheckMenuHandle: menuHandle) ifFalse: [^interpreterProxy success: false].
  	self cppIf: #'TARGET_API_MAC_CARBON'
  		ifTrue: [self cCode: 'GetIndMenuItemWithCommandID(menuHandle, kHICommandHide, 1,
                     &applicationMenu, &outIndex);' inSmalltalk: [menuHandle]].
  	outIndex asSmallIntegerObj. "to avoid elimination of the variable..."
+ 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: applicationMenu to: #'usqIntptr_t')
- 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: applicationMenu to: 'long')
  
  !

Item was changed:
  ----- Method: MacMenubarPlugin>>primitiveGetMenuBar (in category 'system primitives') -----
  primitiveGetMenuBar 
  	<var: #menuHandle type: #Handle>
  	| menuHandle |
  	self primitive: 'primitiveGetMenuBar'
  		parameters: #().
  	menuHandle := self cCode: 'GetMenuBar()' inSmalltalk:[0].
+ 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
- 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')!

Item was changed:
  ----- Method: MacMenubarPlugin>>primitiveGetMenuHandle: (in category 'system primitives') -----
  primitiveGetMenuHandle: menuID 
  	<var: #menuHandle type: #MenuHandle>
  	<var: #menuID type: #MenuID>
  	| menuHandle |
  	self primitive: 'primitiveGetMenuHandle'
  		parameters: #(SmallInteger).
  	menuHandle := self cCode: 'GetMenuHandle(menuID)' inSmalltalk:[0].
+ 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
- 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')!

Item was changed:
  ----- Method: MacMenubarPlugin>>primitiveNewMenu:menuTitle: (in category 'system primitives') -----
  primitiveNewMenu: menuID menuTitle: menuTitle
  	<var: #menuHandle type: #MenuHandle>
  	<var: #constStr255 type: #ConstStr255Param>
  	<var: #menuID type: #MenuID>
  	| menuHandle constStr255 |
  	self primitive: 'primitiveNewMenu'
  		parameters: #(SmallInteger ByteArray).
  	constStr255 := self cCoerce: menuTitle to: #ConstStr255Param.	
  	menuHandle := self cCode: 'NewMenu(menuID,constStr255)' inSmalltalk:[0].
+ 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')!
- 	^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')!

Item was changed:
  ----- Method: QuicktimePlugin>>primitiveSetGWorldPtrOntoExistingSurface:gWorld:width:height:rowBytes:depth:movie: (in category 'system primitives') -----
  primitiveSetGWorldPtrOntoExistingSurface: surfaceID gWorld: bitMapPtr width: width height: height rowBytes: rowBytes depth: depth movie: moviePtr
  	| buffer movie |
  
  	<var: #buffer type: #'char *'>
+ 	<var: #movie type: #'sqIntptr_t'>
- 	<var: #movie type: #'long'>
  	self primitive: 'primitiveSetGWorldPtrOntoExistingSurface'  parameters:#(SmallInteger Oop SmallInteger SmallInteger SmallInteger SmallInteger Oop).
  	buffer := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: bitMapPtr) to: 'char *'.
+ 	movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: #'sqIntptr_t'.
- 	movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: 'long'.
  	self stQuicktimeSetToExistingSurface: surfaceID gworld: buffer width: width height: height rowBytes: rowBytes depth: depth movie: movie.
  	!

Item was changed:
  ----- Method: QuicktimePlugin>>primitiveSetGWorldPtrOntoSurface:width:height:rowBytes:depth:movie: (in category 'system primitives') -----
  primitiveSetGWorldPtrOntoSurface: bitMapPtr width: width height: height rowBytes: rowBytes depth: depth movie: moviePtr
  	| buffer movie results |
  
  	<var: #buffer type: #'char *'>
+ 	<var: #movie type: #'sqIntptr_t'>
- 	<var: #movie type: #'long'>
  	self primitive: 'primitiveSetGWorldPtrOntoSurface'  parameters:#(Oop SmallInteger SmallInteger SmallInteger SmallInteger Oop).
  	buffer := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: bitMapPtr) to: 'char *'.
+ 	movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: #'sqIntptr_t'.
- 	movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: 'long'.
  	results := self stQuicktimeSetSurface: buffer width: width height: height rowBytes: rowBytes depth: depth movie: movie.
  	^results asOop: SmallInteger !

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive: (in category 'primitive generators') -----
  compileInterpreterPrimitive: primitiveRoutine
  	"Compile a call to an interpreter primitive.  Call the C routine with the
  	 usual stack-switching dance, test the primFailCode and then either
  	 return on success or continue to the method body."
  	<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
  	| flags jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
  	<var: #jmp type: #'AbstractInstruction *'>
  	<var: #jmpSamplePrim type: #'AbstractInstruction *'>
  	<var: #jmpSampleNonPrim type: #'AbstractInstruction *'>
  	<var: #continuePostSamplePrim type: #'AbstractInstruction *'>
  	<var: #continuePostSampleNonPrim type: #'AbstractInstruction *'>
  
  	"Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers"
  	self genExternalizePointersForPrimitiveCall.
  	"Switch to the C stack."
  	self genLoadCStackPointersForPrimCall.
  
  	flags := coInterpreter primitivePropertyFlags: primitiveIndex.
  	(flags anyMask: PrimCallDoNotJIT) ifTrue:
  		[^ShouldNotJIT].
  
  	(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  		["Test nextProfileTick for being non-zero and call checkProfileTick if so"
  		objectMemory wordSize = 4
  			ifTrue:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  				 self OrR: TempReg R: ClassReg]
  			ifFalse:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self CmpCq: 0 R: TempReg].
  		"If set, jump to record sample call."
  		jmpSampleNonPrim := self JumpNonZero: 0.
  		continuePostSampleNonPrim := self Label].
  
  	"Old full prim trace is in VMMaker-eem.550 and prior"
  	self recordPrimTrace ifTrue:
  		[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
  
  	"Clear the primFailCode and set argumentCount"
  	self MoveCq: 0 R: TempReg.
  	self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
  	methodOrBlockNumArgs ~= 0 ifTrue:
  		[self MoveCq: methodOrBlockNumArgs R: TempReg].
  	self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
  
  	"If required, set primitiveFunctionPointer and newMethod"
  	(flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
  		[self MoveCw: primitiveRoutine asInteger R: TempReg.
  		 primSetFunctionLabel :=
  		 self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
  	(flags anyMask: PrimCallNeedsNewMethod+PrimCallMayCallBack) ifTrue:
  		["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
  		 (flags anyMask: PrimCallMayCallBack) ifTrue:
  			[needsFrame := true].
  		 methodLabel addDependent:
  			(self annotateAbsolutePCRef:
  				(self MoveCw: methodLabel asInteger R: ClassReg)).
  		 self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
  		 self MoveR: TempReg Aw: coInterpreter newMethodAddress].
  
  	"Invoke the primitive"
  	self PrefetchAw: coInterpreter primFailCodeAddress.
  	(flags anyMask: PrimCallMayCallBack)
  		ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
  			["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders
  			  are found. So insist on PrimCallNeedsPrimitiveFunction being set too."
  			 self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction).
  			 backEnd genSubstituteReturnAddress:
  				((flags anyMask: PrimCallCollectsProfileSamples)
  					ifTrue: [cePrimReturnEnterCogCodeProfiling]
  					ifFalse: [cePrimReturnEnterCogCode]).
  			 primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger.
  			 jmp := jmpSamplePrim := continuePostSamplePrim := nil]
  		ifFalse:
  			["Call the C primitive routine."
  			primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger.
  			(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  				[self assert: (flags anyMask: PrimCallNeedsNewMethod).
  				"Test nextProfileTick for being non-zero and call checkProfileTick if so"
  				objectMemory wordSize = 4
  					ifTrue:
  						[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  						 self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  						 self OrR: TempReg R: ClassReg]
  					ifFalse:
  						[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  						 self CmpCq: 0 R: TempReg].
  				"If set, jump to record sample call."
  				jmpSamplePrim := self JumpNonZero: 0.
  				continuePostSamplePrim := self Label].
  			objectRepresentation maybeCompileRetryOnPrimitiveFail: primitiveIndex.
  			self maybeCompileAllocFillerCheck.
  			"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  				success:	stackPointer ->	result (was receiver)
  											arg1
  											...
  											argN
  											return pc
  				failure:						receiver
  											arg1
  											...
  							stackPointer ->	argN
  											return pc
  			In either case we can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  			self MoveAw: coInterpreter instructionPointerAddress
  				R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  			backEnd genLoadStackPointers.
  			"Test primitive failure"
  			self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  			backEnd hasLinkRegister ifFalse: [self PushR: ClassReg]. "Restore return pc on CISCs"
  			self flag: 'ask concrete code gen if move sets condition codes?'.
  			self CmpCq: 0 R: TempReg.
  			jmp := self JumpNonZero: 0.
  			"Fetch result from stack"
  			self MoveMw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize])
  				r: SPReg
  				R: ReceiverResultReg.
  			self RetN: objectMemory wordSize].	"return to caller, popping receiver"
  
  	(flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  		["The sample is collected by cePrimReturnEnterCogCode for external calls"
  		jmpSamplePrim ifNotNil:
  			["Call ceCheckProfileTick: to record sample and then continue."
  			jmpSamplePrim jmpTarget: self Label.
  			self assert: (flags anyMask: PrimCallNeedsNewMethod).
+ 			self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
- 			self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedLong]
  							   inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  			"reenter the post-primitive call flow"
  			self Jump: continuePostSamplePrim].
  		"Null newMethod and call ceCheckProfileTick: to record sample and then continue.
  		 ceCheckProfileTick will map null/0 to coInterpreter nilObject"
  		jmpSampleNonPrim jmpTarget: self Label.
  		self MoveCq: 0 R: TempReg.
  		self MoveR: TempReg Aw: coInterpreter newMethodAddress.
+ 		self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
- 		self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedLong]
  						   inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  		"reenter the post-primitive call flow"
  		self Jump: continuePostSampleNonPrim].
  
  	jmp ifNotNil:
  		["Jump to restore of receiver reg and proceed to frame build for failure."
  		 jmp jmpTarget: self Label.
  		 "Restore receiver reg from stack.  If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack."
  		 self MoveMw: objectMemory wordSize * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]))
  			r: SPReg
  			R: ReceiverResultReg].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') -----
  genPrimReturnEnterCogCodeEnilopmart: profiling
  	"Generate the substitute return code for an external or FFI primitive call.
  	 On success simply return, extracting numArgs from newMethod.
  	 On primitive failure call ceActivateFailingPrimitiveMethod: newMethod."
  	| jmpSample continuePostSample jmpFail |
  	<var: #jmpSample type: #'AbstractInstruction *'>
  	<var: #continuePostSample type: #'AbstractInstruction *'>
  	<var: #jmpFail type: #'AbstractInstruction *'>
  	self zeroOpcodeIndex.
  	backEnd hasVarBaseRegister ifTrue:
  		[self MoveCq: self varBaseAddress R: VarBaseReg]. "Must happen sometime"
  
  	profiling ifTrue:
  		["Test nextProfileTick for being non-zero and call checkProfileTick: if so.
  		  N.B. nextProfileTick is 64-bits so 32-bit systems need to test both halves."
  		objectMemory wordSize = 4
  			ifTrue:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  				 self OrR: TempReg R: ClassReg]
  			ifFalse:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self CmpCq: 0 R: TempReg].
  		"If set, jump to record sample call."
  		jmpSample := self JumpNonZero: 0.
  		continuePostSample := self Label].
  
  	self maybeCompileAllocFillerCheck.
  
  	"Test primitive failure"
  	self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  	self flag: 'ask concrete code gen if move sets condition codes?'.
  	self CmpCq: 0 R: TempReg.
  	jmpFail := self JumpNonZero: 0.
  
  	"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  		success:	stackPointer	->	result (was receiver)
  										arg1
  										...
  										argN
  										return pc
  		failure:							receiver
  										arg1
  										...
  					stackPointer	->	argN
  										return pc
  	We push the instructionPointer to reestablish the return pc in the success case,
  	but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case."
  
  	backEnd hasLinkRegister
  		ifTrue:
  			[backEnd genLoadStackPointers.											"Switch back to Smalltalk stack."
  			 backEnd hasPCRegister
  				ifTrue:
  					[self PopR: ReceiverResultReg.										"Pop result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: PCReg]	"Return"
  				ifFalse:
  					[self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: LinkReg.	"Get ret pc"
  					 self RetN: objectMemory wordSize]]								"Return, popping result from stack"
  		ifFalse:
  			[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.	"Get return pc"
  			 backEnd genLoadStackPointers.									"Switch back to Smalltalk stack."
  			 self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  			 self MoveR: ClassReg Mw: 0 r: SPReg.								"Restore return pc"
  			 self RetN: 0].														"Return, popping result from stack"
  
  	"Primitive failed.  Invoke C code to build the frame and continue."
  	jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg).
  	"Reload sp with CStackPointer; easier than popping args of checkProfileTick."
  	self MoveAw: self cStackPointerAddress R: SPReg.
  	self 
  		compileCallFor: #ceActivateFailingPrimitiveMethod:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: NoReg
  		regsToSave: self emptyRegisterMask.
  
  	"On Spur ceActivateFailingPrimitiveMethod: may retry the primitive and return if successful.
  	 So continue by returning to the caller.
  	 Switch back to the Smalltalk stack.  Stack should be in this state:
  				success:	stackPointer ->	result (was receiver)
  											arg1
  											...
  											argN
  											return pc
  	 We can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  	self MoveAw: coInterpreter instructionPointerAddress
  		R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  	backEnd genLoadStackPointers.
  	backEnd hasLinkRegister
  		ifTrue:
  			[self MoveMw: 0 r: SPReg R: ReceiverResultReg]	"Fetch result from stack"
  		ifFalse:
  			[self MoveMw: objectMemory wordSize r: SPReg R: ReceiverResultReg.	"Fetch result from stack"
  			 self PushR: ClassReg].											"Restore return pc on CISCs"
  	self RetN: objectMemory wordSize.	"return to caller, popping receiver"
  
  	profiling ifTrue:
  		["Call ceCheckProfileTick: to record sample and then continue.  newMethod
  		 should be up-to-date.  Need to save and restore the link reg around this call."
  		 jmpSample jmpTarget: self Label.
  		 backEnd saveAndRestoreLinkRegAround:
+ 			[self CallFullRT: (self cCode: '(usqIntptr_t)ceCheckProfileTick'
- 			[self CallFullRT: (self cCode: '(unsigned long)ceCheckProfileTick'
  						inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick])].
  		 self Jump: continuePostSample]!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>generateCPtrAsOop:on:indent: (in category 'translating builtins') -----
  generateCPtrAsOop: aNode on: aStream indent: anInteger
+ 	aStream nextPutAll: '((sqInt)(sqIntptr_t)('.
- 	aStream nextPutAll: '((sqInt)(long)('.
  	self emitCExpression: aNode receiver on: aStream.
  	aStream nextPutAll: ') - BaseHeaderSize)'!

Item was changed:
  ----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') -----
  printOopsFrom: startAddress to: endAddress
  	<api>
  	| oop limit |
  	oop := self objectBefore: startAddress.
+ 	limit := endAddress asUnsignedIntegerPtr min: endOfMemory.
- 	limit := endAddress asUnsignedLong min: endOfMemory.
  	oop := oop
  				ifNil: [startAddress]
  				ifNotNil: [(self objectAfter: oop) = startAddress
  							ifTrue: [startAddress]
  							ifFalse: [oop]].
  	[self oop: oop isLessThan: limit] whileTrue:
  		[coInterpreter
  			printHex: oop; print: '/'; printNum: oop; space;
  			print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse:
  					[(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse:
  					[(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse:
  					['object']]]);
  			cr.
  		oop := self objectAfter: oop]!

Item was changed:
  ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
  addSegmentOfSize: ammount
  	<returnTypeC: #'SpurSegmentInfo *'>
  	<inline: false>
  	| allocatedSize |
  	<var: #newSeg type: #'SpurSegmentInfo *'>
  	<var: #segAddress type: #'void *'>
  	<var: #allocatedSize type: #'usqInt'>
  	self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap"
  	(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
  			sqAllocateMemorySegmentOfSize: ammount
  			Above: (self firstGapOfSizeAtLeast: ammount)
  			AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
  									inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
  		[:segAddress| | newSegIndex newSeg |
+ 		 newSegIndex := self insertSegmentFor: segAddress asUnsignedIntegerPtr.
- 		 newSegIndex := self insertSegmentFor: segAddress asUnsignedLong.
  		 newSeg := self addressOf: (segments at: newSegIndex).
  		 newSeg
+ 			segStart: segAddress asUnsignedIntegerPtr;
- 			segStart: segAddress asUnsignedLong;
  			segSize: allocatedSize.
  		 self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
  		 self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
  										[self addressOf: (segments at: newSegIndex + 1)]).
  		 "test isInMemory:"
  		 0 to: numSegments - 1 do:
  			[:i|
  			self assert: (self isInSegments: (segments at: i) segStart).
  			self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize).
  			self assert: ((self isInSegments: (segments at: i) segLimit) not
  						or: [i < (numSegments - 1)
  							and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]).
  			self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not
  							or: [i > 0
  								and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])].
  		 ^newSeg].
  	^nil!

Item was changed:
  ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| vmClass |
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  		addHeaderFile:'<setjmp.h>';
  		addHeaderFile:'<wchar.h> /* for wint_t */';
  		addHeaderFile:'"vmCallback.h"';
  		addHeaderFile:'"sqMemoryFence.h"';
  		addHeaderFile:'"dispdbg.h"'.
  	LowcodeVM ifTrue: [ aCCodeGenerator addHeaderFile:'"sqLowcodeFFI.h"'].
  	
  	vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
  	aCCodeGenerator
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		declareVar: #sendTrace type: 'volatile int';
+ 		declareVar: #byteCount type: #usqInt.
- 		declareVar: #byteCount type: 'unsigned long'.
  	"These need to be pointers or unsigned."
  	self declareC: #(instructionPointer method newMethod)
  		as: #usqInt
  		in: aCCodeGenerator.
  	"These are all pointers; char * because Slang has no support for C pointer arithmetic."
  	self declareC: #(localIP localSP localFP nativeSP stackPointer framePointer stackLimit breakSelector nativeStackPointer nativeFramePointer shadowCallStack)
  		as: #'char *'
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
  	NewspeakVM ifFalse:
  		[aCCodeGenerator
  			removeVariable: 'localAbsentReceiver';
  			removeVariable: 'localAbsentReceiverOrZero';
  			removeVariable: 'nsMethodCache'].
  	"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
  	 is not defined, for the benefit of the interpreter on slow machines."
  	aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
  	MULTIPLEBYTECODESETS == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'bytecodeSetSelector'].
  	BytecodeSetHasExtensions == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'extA';
  			removeVariable: 'extB'].
  	aCCodeGenerator
  		var: #methodCache
+ 		declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
- 		declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #nsMethodCache
+ 		declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'.
- 		declareC: 'long nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'.
  	AtCacheTotalSize isInteger ifTrue:
  		[aCCodeGenerator
  			var: #atCache
  			declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
  	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
  	vmClass primitiveTable do:
  		[:symbolOrNot|
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  	vmClass objectMemoryClass hasSpurMemoryManagerAPI
  		ifTrue:
  			[aCCodeGenerator
  				var: #primitiveAccessorDepthTable
  				type: 'signed char'
  				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
  				array: vmClass primitiveAccessorDepthTable]
  		ifFalse:
  			[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  		declareC: 'void (*primitiveFunctionPointer)()'.
  	aCCodeGenerator
  		var: #externalPrimitiveTable
  		declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void *'.
  	aCCodeGenerator
  		var: #jmpBuf
  		declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedCallbacks
  		declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedMethods
  		declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #interruptCheckChain
  		declareC: 'void (*interruptCheckChain)(void) = 0'.
  
  	self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  								longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
  								"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
  								statProcessSwitch statIOProcessEvents statForceInterruptCheck
  								statCheckForEvents statStackOverflow statStackPageDivorce)
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong.
  	
  	LowcodeVM ifTrue: [
  		aCCodeGenerator
  			var: #shadowCallStackPointer
  			type: #'char*'.
  		aCCodeGenerator
  			var: #lowcodeCalloutState
  			type: #'sqLowcodeCalloutState*'
  	].!

Item was changed:
  ----- Method: StackInterpreter>>addNewMethodToCache: (in category 'method lookup cache') -----
  addNewMethodToCache: classObj
  	"Add the given entry to the method cache.
  	The policy is as follows:
  		Look for an empty entry anywhere in the reprobe chain.
  		If found, install the new entry there.
  		If not found, then install the new entry at the first probe position
  			and delete the entries in the rest of the reprobe chain.
  		This has two useful purposes:
  			If there is active contention over the first slot, the second
  				or third will likely be free for reentry after ejection.
  			Also, flushing is good when reprobe chains are getting full."
  	| probe hash primitiveIndex |
  	<inline: false>
  	hash := objectMemory methodCacheHashOf: messageSelector with: (objectMemory classTagForClass: classObj).  "shift drops low-order zeros from addresses"
  	(objectMemory isOopCompiledMethod: newMethod)
  		ifTrue:
  			[primitiveIndex := self primitiveIndexOf: newMethod.
  			 primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj]
  		ifFalse:
  			[self assert: ((objectMemory isNonImmediate: newMethod)
  						  and: [objectMemory isForwarded: newMethod]) not.
  			 primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
  
  	0 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
  		(methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
  			["Found an empty entry -- use it"
  			methodCache at: probe + MethodCacheSelector put: messageSelector.
  			methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj).
  			methodCache at: probe + MethodCacheMethod put: newMethod.
+ 			methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t').
- 			methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  			lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
  			^self]].
  
  	"OK, we failed to find an entry -- install at the first slot..."
  	probe := hash bitAnd: MethodCacheMask.  "first probe"
  	methodCache at: probe + MethodCacheSelector put: messageSelector.
  	methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj).
  	methodCache at: probe + MethodCacheMethod put: newMethod.
+ 	methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t').
- 	methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  	lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
  
  	"...and zap the following entries"
  	1 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
  		methodCache at: probe + MethodCacheSelector put: 0]!

Item was changed:
  ----- Method: StackInterpreter>>addNewMethodToNSCache: (in category 'method lookup cache') -----
  addNewMethodToNSCache: rule
  	<option: #NewspeakVM>
  	<inline: false>
  	| classObj probe hash primitiveIndex |
  	classObj := lkupClass.
  	hash := (objectMemory methodCacheHashOf: messageSelector with: lkupClassTag) bitXor: (method bitXor: rule).
  	self deny: rule = LookupRuleOrdinary.
  
  	(objectMemory isOopCompiledMethod: newMethod)
  		ifTrue:
  			[primitiveIndex := self primitiveIndexOf: newMethod.
  			 primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj]
  		ifFalse:
  			[self assert: ((objectMemory isNonImmediate: newMethod)
  						  and: [objectMemory isForwarded: newMethod]) not.
  			 primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
  
  	0 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: NSMethodCacheMask.
  		(nsMethodCache at: probe + NSMethodCacheSelector) = 0 ifTrue:
  			["Found an empty entry -- use it"
  			nsMethodCache at: probe + NSMethodCacheSelector put: messageSelector.
  			nsMethodCache at: probe + NSMethodCacheClassTag put: lkupClassTag. "(objectMemory classTagForClass: classObj)."
  			nsMethodCache at: probe + NSMethodCacheCallingMethod put: method.
  			nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule put: rule.
  			nsMethodCache at: probe + NSMethodCacheTargetMethod put: newMethod.
+ 			nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t').
- 			nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  			nsMethodCache at: probe + NSMethodCacheActualReceiver put: localAbsentReceiverOrZero.
  			"lastMethodCacheProbeWrite := probe." "this for primitiveExternalMethod"
  			^self]].
  
  	"OK, we failed to find an entry -- install at the first slot..."
  	probe := hash bitAnd: NSMethodCacheMask.  "first probe"
  	nsMethodCache at: probe + NSMethodCacheSelector put: messageSelector.
  	nsMethodCache at: probe + NSMethodCacheClassTag put: lkupClassTag. "(objectMemory classTagForClass: classObj)."
  	nsMethodCache at: probe + NSMethodCacheCallingMethod put: method.
  	nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule put: rule.
  	nsMethodCache at: probe + NSMethodCacheTargetMethod put: newMethod.
+ 	nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t').
- 	nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
  	nsMethodCache at: probe + NSMethodCacheActualReceiver put: localAbsentReceiverOrZero.
  	"lastMethodCacheProbeWrite := probe. ""this for primitiveExternalMethod"
  
  	"...and zap the following entries"
  	1 to: CacheProbeMax-1 do:
  		[:p | probe := (hash >> p) bitAnd: NSMethodCacheMask.
  		nsMethodCache at: probe + NSMethodCacheSelector put: 0]!

Item was changed:
  ----- Method: StackInterpreter>>isPrimitiveFunctionPointerAnIndex (in category 'primitive support') -----
  isPrimitiveFunctionPointerAnIndex
  	"We save slots in the method cache by using the primitiveFunctionPointer
  	 to hold either a function pointer or the index of a quick primitive. Since
  	 quick primitive indices are small they can't be confused with function
  	 addresses. "
+ 	^(self cCoerce: primitiveFunctionPointer to: #'usqIntptr_t') <= MaxQuickPrimitiveIndex!
- 	^(self cCoerce: primitiveFunctionPointer to: 'unsigned long') <= MaxQuickPrimitiveIndex!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| fmt lastIndex startIP bytecodesPerLine column |
  	((objectMemory isImmediate: oop)
  	 or: [(objectMemory addressCouldBeObj: oop) not
  	 or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [objectMemory isForwarded: oop]]]]) ifTrue:
  		[self printOop: oop.
  		 ^self].
  	self printHex: oop.
  	(objectMemory fetchClassOfNonImm: oop)
  		ifNil: [self print: ' has a nil class!!!!']
  		ifNotNil: [:class|
  			self print: ': a(n) '; printNameOfClass: class count: 5;
  				print: ' ('.
  			objectMemory hasSpurMemoryManagerAPI ifTrue:
  				[self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>'].
  			self printHexnp: class; print: ')'].
  	fmt := objectMemory formatOf: oop.
  	self print: ' format '; printHexnp: fmt.
  	fmt > objectMemory lastPointerFormat
  		ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)]
  		ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
  					[| len |
  					len := objectMemory lengthOf: oop.
  					self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
  	objectMemory printHeaderTypeOf: oop.
  	self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
  	self cr.
  	(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		[^self printStringOf: oop; cr].
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
  		[0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchLong32: i ofObject: oop.
  			self space; printNum: i; space; printHex: fieldOop; space; cr].
  		 ^self].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
  			self space; printNum: i - 1; space; printHex: fieldOop; space.
  			(i = 1 and: [objectMemory isCompiledMethod: oop])
  				ifTrue: [self printMethodHeaderOop: fieldOop]
  				ifFalse: [self cCode: [self printOopShort: fieldOop]
  							inSmalltalk: [self print: (self shortPrint: fieldOop)]].
  			self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > lastIndex ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * objectMemory wordSize + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
+ 					[self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))'
- 					[self cCode: 'printf("0x%08lx: ", (unsigned long)(oop+BaseHeaderSize+index-1))'
  						inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>positiveMachineIntegerFor: (in category 'callback support') -----
  positiveMachineIntegerFor: value
+ 	<var: #value type: #'usqIntptr_t'>
- 	<var: #value type: #'unsigned long'>
  	<inline: false>
  	| resultObj |
  	objectMemory wordSize = 8
  		ifTrue: [resultObj := self positive64BitIntegerFor: value]
  		ifFalse: [resultObj := self positive32BitIntegerFor: value].
  	^resultObj!

Item was changed:
  ----- Method: StackInterpreter>>printHex: (in category 'debug printing') -----
  printHex: n
  	"Print n in hex,  in the form '    0x1234', padded to a width of 10 characters
  	 in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)"
  	<api>
  	| len buf |
  	<var: #buf declareC: 'char buf[37]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces"
  	self cCode: 'memset(buf,'' '',36)' inSmalltalk: [buf := 'doh!!'].
+ 	len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%" PRIxSQPTR, (usqIntptr_t)(n))'.
- 	len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%lx", (unsigned long)(n))'.
  	self cCode: 'printf("%s", buf + len)'.
  	len touch: buf!

Item was changed:
  ----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
  printMethodCacheFor: thing
  	<api>
  	| n |
  	n := 0.
  	0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
  		[:i | | s c m p |
  		s := methodCache at: i + MethodCacheSelector.
  		c := methodCache at: i + MethodCacheClass.
  		m := methodCache at: i + MethodCacheMethod.
  		p := methodCache at: i + MethodCachePrimFunction.
  		((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing]]]])
  		 and: [(objectMemory addressCouldBeOop: s)
  		 and: [c ~= 0
  		 and: [(self addressCouldBeClassObj: c)
  			or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
  			[self cCode: [] inSmalltalk: [self transcript ensureCr].
  			 self printNum: i; space; printHexnp: i; cr; tab.
  			 (objectMemory isBytesNonImm: s)
+ 				ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
- 				ifTrue: [self cCode: 'printf("%lx %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
  						inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
  				ifFalse: [self shortPrintOop: s].
  			 self tab.
  			 (self addressCouldBeClassObj: c)
  				ifTrue: [self shortPrintOop: c]
  				ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
  			self tab; shortPrintOop: m; tab.
  			self cCode:
  					[p > 1024
  						ifTrue: [self printHexnp: p]
  						ifFalse: [self printNum: p]]
  				inSmalltalk:
  					[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
  			self cr]].
  	n > 1 ifTrue:
  		[self printNum: n; cr]!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
  	| cls fmt lastIndex startIP bytecodesPerLine column |
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[^self shortPrintOop: oop].
  	self printHex: oop.
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [self whereIs: oop]); cr].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop).
  		 objectMemory hasSpurMemoryManagerAPI ifTrue:
  			[self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop).
  			 objectMemory printHeaderTypeOf: oop].
  		 ^self cr].
  	(objectMemory isForwarded: oop) ifTrue:
  		[self
  			print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
  			print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop).
  		 objectMemory printHeaderTypeOf: oop.
  		 ^self cr].
  	self print: ': a(n) '.
  	self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr].
  	fmt := objectMemory formatOf: oop.
  	fmt > objectMemory lastPointerFormat ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
  	self cr.
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		["This will answer false if splObj: ClassAlien is nilObject"
  		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  			self print: ((self isIndirectAlien: oop)
  							ifTrue: [' indirect @ ']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: [' pointer @ ']
  									ifFalse: [' direct @ ']]).
  			 ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
  		 (objectMemory isWordsNonImm: oop) ifTrue:
  			[lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
  			 lastIndex > 0 ifTrue:
  				[1 to: lastIndex do:
  					[:index|
  					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  						[self cr]].
  				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  					[self cr]].
  			^self].
  		^self printStringOf: oop; cr].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index|
  			self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
  				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  				[self cr]].
  		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  			[self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * objectMemory wordSize + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
+ 					[self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))'
- 					[self cCode: 'printf("0x%08lx: ", (unsigned long)(oop+BaseHeaderSize+index-1))'
  						inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') -----
  rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress
  	"Rewrite an existing entry in the method cache with a new primitive function address.
  	 Used by primitiveExternalCall to make direct calls to found external prims, or quickly
  	 fail not found external prims."
  	<inline: false>
  	<var: #localPrimAddress declareC: 'void (*localPrimAddress)(void)'>
  	(methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue:
  		[methodCache
  			at: lastMethodCacheProbeWrite + MethodCachePrimFunction
+ 			put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]!
- 			put: (self cCoerce: localPrimAddress to: #long)]!

Item was changed:
  ----- Method: StackInterpreter>>stackPositiveMachineIntegerValue: (in category 'stack access') -----
  stackPositiveMachineIntegerValue: offset
  	<api>
+ 	<returnTypeC: #'usqIntptr_t'>
  	"In the StackInterpreter stacks grow down."
  	| integerPointer |
  	integerPointer := stackPages longAt: stackPointer + (offset*objectMemory wordSize).
  	^self positiveMachineIntegerValueOf: integerPointer!

Item was changed:
  ----- Method: StackInterpreter>>stackSignedMachineIntegerValue: (in category 'stack access') -----
  stackSignedMachineIntegerValue: offset
  	<api>
+ 	<returnTypeC: #'sqIntptr_t'>
  	"In the StackInterpreter stacks grow down."
  	| integerPointer |
  	integerPointer := stackPages longAt: stackPointer + (offset*objectMemory wordSize).
  	^self signedMachineIntegerValueOf: integerPointer!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiAddressOf:startingAt:size: (in category 'primitive support') -----
  ffiAddressOf: rcvr startingAt: byteOffset size: byteSize
  	"Answer a long of the address of the byteSize slot (byte, short, int, whatever) at byteOffset in rcvr.
  	 Nominally intended for use with ExternalAddress objects, this code will work (for obscure historical
  	 reasons) with plain Byte or Word Arrays as well. "
  	| rcvrClass rcvrSize addr |
  	(interpreterProxy isBytes: rcvr) ifFalse:[^interpreterProxy primitiveFail].
  	byteOffset > 0 ifFalse:[^interpreterProxy primitiveFail].
  	rcvrClass := interpreterProxy fetchClassOf: rcvr.
  	rcvrSize := interpreterProxy byteSizeOf: rcvr.
  	rcvrClass = interpreterProxy classExternalAddress
  		ifTrue:
  			[rcvrSize = BytesPerWord ifFalse:[^interpreterProxy primitiveFail].
  			addr := interpreterProxy fetchPointer: 0 ofObject: rcvr. "Hack!!!!"
  			"don't you dare to read from object memory (unless is pinned)!!"
  			(addr = 0 "or: [(interpreterProxy isInMemory: addr) or: [(interpreterProxy isPinned: rcvr) not]]") ifTrue:
  				[^interpreterProxy primitiveFail]]
  		ifFalse:
  			[byteOffset+byteSize-1 <= rcvrSize ifFalse:
  				[^interpreterProxy primitiveFail].
+ 			addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'sqIntptr_t'].
- 			addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #long].
  	addr := addr + byteOffset - 1.
  	^addr!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiLoadCalloutAddress: (in category 'symbol loading') -----
  ffiLoadCalloutAddress: lit
  	"Load the address of the foreign function from the given object"
  	| addressPtr address ptr |
+ 	<var: #ptr type: #'sqIntptr_t *'>
- 	<var: #ptr type: #'long *'>
  	"Lookup the address"
  	addressPtr := interpreterProxy fetchPointer: 0 ofObject: lit.
  	"Make sure it's an external handle"
  	address := self ffiContentsOfHandle: addressPtr errCode: FFIErrorBadAddress.
  	interpreterProxy failed ifTrue:
  		[^0].
  	address = 0 ifTrue:"Go look it up in the module"
  		[self externalFunctionHasStackSizeSlot ifTrue:
  			[interpreterProxy
  				storePointer: ExternalFunctionStackSizeIndex
  				ofObject: lit
  				withValue: (interpreterProxy integerObjectOf: -1)].
  		(interpreterProxy slotSizeOf: lit) < 5 ifTrue:
  			[^self ffiFail: FFIErrorNoModule].
  		address := self ffiLoadCalloutAddressFrom: lit.
  		interpreterProxy failed ifTrue:
  			[^0].
  		"Store back the address"
  		ptr := interpreterProxy firstIndexableField: addressPtr.
  		ptr at: 0 put: address].
  	^address!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIAllocate (in category 'primitives') -----
  primitiveFFIAllocate
  	"Primitive. Allocate an object on the external heap."
  	| byteSize addr oop ptr |
  	<export: true>
  	<inline: false>
+ 	<var: #ptr type: #'sqIntptr_t *'>
- 	<var: #ptr type: #'long *'>
  	byteSize := interpreterProxy stackIntegerValue: 0.
  	interpreterProxy failed ifTrue:
  		[^nil].
  	addr := self ffiAlloc: byteSize.
  	addr = 0 ifTrue:
  		[^interpreterProxy primitiveFail].
  	oop := interpreterProxy 
  			instantiateClass: interpreterProxy classExternalAddress 
+ 			indexableSize: (self sizeof: #'sqIntptr_t').
- 			indexableSize: (self sizeof: #long).
  	ptr := interpreterProxy firstIndexableField: oop.
  	ptr at: 0 put: addr.
  	^interpreterProxy pop: 2 thenPush: oop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIFree (in category 'primitives') -----
  primitiveFFIFree
  	"Primitive. Free the object pointed to on the external heap."
  	| addr oop ptr |
  	<export: true>
  	<inline: false>
+ 	<var: #ptr type: #'sqIntptr_t *'>
- 	<var: #ptr type: #'long *'>
  	oop := interpreterProxy stackObjectValue: 0.
  	((interpreterProxy fetchClassOf: oop) = interpreterProxy classExternalAddress
+ 	 and: [(interpreterProxy byteSizeOf: oop) = (self sizeof: #'sqIntptr_t')]) ifFalse:
- 	 and: [(interpreterProxy byteSizeOf: oop) = (self sizeof: #long)]) ifFalse:
  		[^interpreterProxy primitiveFail].
  	ptr := interpreterProxy firstIndexableField: oop.
  	addr := ptr at: 0.
  	"Don't you dare to free Squeak's memory!!"
  	(addr = 0
+ 	 or: [(addr asUnsignedIntegerPtr bitAnd: (self sizeof: #'sqIntptr_t') - 1) ~= 0
- 	 or: [(addr asUnsignedLong bitAnd: (self sizeof: #long) - 1) ~= 0
  	 or: [interpreterProxy isInMemory: addr]]) ifTrue:
  		[^interpreterProxy primitiveFail].
  	self ffiFree: addr.
  	^ptr at: 0 put: 0 "cleanup"!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveSetManualSurfacePointer (in category 'primitives - surfaces') -----
  primitiveSetManualSurfacePointer
  	"Create a 'manual surface' data-structure.  See the ExternalForm class in the FFI package for example usage."
  	"arguments: name(type, stack offset)
  		surfaceID(Integer, 1)
  		ptr(uint32/uint64, 0)"
  	| surfaceID ptr result |
  	<export: true>
+ 	<var: #ptr type: #'usqIntptr_t'>
- 	<var: #ptr type: #'unsigned long'>
  	
  	interpreterProxy methodArgumentCount = 2 ifFalse: [^interpreterProxy primitiveFail].
  	surfaceID := interpreterProxy stackIntegerValue: 1.
  	ptr := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0).
  	interpreterProxy failed ifTrue: [^nil].
  
  	self touch: surfaceID; touch: ptr.
  	
  	result := self setManualSurface: surfaceID Pointer: ptr asVoidPointer.
  	result = 0 ifTrue: [^interpreterProxy primitiveFail].
  	^interpreterProxy pop: 2
  	!

Item was removed:
- ----- Method: ThreadedX64FFIPlugin class>>excludingPredefinedMacros (in category 'translation') -----
- excludingPredefinedMacros
- 	"Answer the predefined macros that disqualify the platforms a subclass handles, if any.
- 	 This can be used to differentiate e.g. x64 Sys V from x64 Win64."
- 	^#('WIN64')!

Item was changed:
  ----- Method: Unsigned class>>ccgDeclareCForVar: (in category 'plugin generation') -----
  ccgDeclareCForVar: aSymbolOrString
  
+ 	^'usqIntptr_t ', aSymbolOrString!
- 	^'unsigned long ', aSymbolOrString!

Item was changed:
  ----- Method: VMCallbackContext class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  	"Define a CallbackContext, the argument to sendInvokeCallbackContext:
  	 self typedef"
  
  	self instVarNames do:
  		[:ivn|
  		aBinaryBlock
  			value: ivn
  			value: (ivn caseOf: {
  					['thunkp']				-> [#'void *'].
+ 					['stackp']				-> [#'sqIntptr_t *'].
+ 					['intregargsp']			-> [#'sqIntptr_t *'].
- 					['stackp']				-> [#'long *'].
- 					['intregargsp']			-> [#'long *'].
  					['floatregargsp']		-> [#'double *'].
  					['rvs']					-> [
  						'union {
+ 							sqIntptr_t valword;
- 							long valword;
  							struct { int low, high; } valleint64;
  							struct { int high, low; } valbeint64;
  							double valflt64;
+ 							struct { void *addr; sqIntptr_t size; } valstruct;
- 							struct { void *addr; long size; } valstruct;
  						}'].
  					['savedCStackPointer']		-> [#'void *'].
  					['savedCFramePointer']		-> [#'void *'].
  					['trampoline']				-> [#'jmp_buf'].
  					['savedReenterInterpreter']	-> [#'jmp_buf']})]!

Item was changed:
  ----- Method: VMProfileLinuxSupportPlugin>>primitiveDLSymInLibrary (in category 'primitives') -----
  primitiveDLSymInLibrary
  	"Answer the address of the symbol whose name is the first argument
  	 in the library whose name is the second argument, or nil if none."
  	| nameObj symName libName lib sz addr ok |
  	<export: true>
  	<var: #symName type: #'char *'>
  	<var: #libName type: #'char *'>
  	<var: #lib type: #'void *'>
  	<var: #addr type: #'void *'>
  	nameObj := interpreterProxy stackValue: 0.
  	(interpreterProxy isBytes: nameObj) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	sz := interpreterProxy byteSizeOf: nameObj.
  	libName := self malloc: sz+1.
  	self st: libName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz.
  	libName at: sz put: 0.
  	nameObj := interpreterProxy stackValue: 1.
  	(interpreterProxy isBytes: nameObj) ifFalse:
  		[self free: libName.
  		 ^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	sz := interpreterProxy byteSizeOf: nameObj.
  	symName := self malloc: sz+1.
  	self st: symName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz.
  	symName at: sz put: 0.
  	lib := self dl: libName open: (#'RTLD_LAZY' bitOr: #'RTLD_NODELETE').
  	lib ifNil:
  		[self free: libName; free: symName.
  		 ^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	self dlerror. "clear dlerror"
  	addr := self dl: lib sym: symName.
  	ok := self dlerror isNil.
  	self free: symName.
  	self free: libName.
  	self dlclose: lib.
  	ok ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrNotFound].
+ 	^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: addr asUnsignedIntegerPtr)!
- 	^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: addr asUnsignedLong)!

Item was changed:
  ----- Method: VMProfileLinuxSupportPlugin>>primitiveInterpretAddress (in category 'primitives') -----
  primitiveInterpretAddress
  	"Answer the address of the interpret routine."
  	<export: true>
  	| interpret |
  	<var: #interpret declareC: 'extern void interpret()'>
+ 	^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: interpret asUnsignedIntegerPtr)!
- 	^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: interpret asUnsignedLong)!

Item was changed:
  ----- Method: VMProfileMacSupportPlugin>>primitiveDLSym (in category 'primitives') -----
  primitiveDLSym
  	"Answer the address of the argument in the current process or nil if none."
  	| nameObj name namePtr sz addr |
  	<export: true>
  	<var: #name type: #'char *'>
  	<var: #namePtr type: #'char *'>
  	<var: #addr type: #'void *'>
  	nameObj := interpreterProxy stackValue: 0.
  	(interpreterProxy isBytes: nameObj) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	sz := interpreterProxy byteSizeOf: nameObj.
  	name := self malloc: sz+1.
  	namePtr := interpreterProxy firstIndexableField: nameObj.
  	0 to: sz-1 do:[:i| name at: i put: (namePtr at: i)].
  	name at: sz put: 0.
  	addr := self cCode: 'dlsym(RTLD_SELF,name)' inSmalltalk: [0].
  	self free: name.
  	^interpreterProxy methodReturnValue: (addr = 0
  												ifTrue: [interpreterProxy nilObject]
+ 												ifFalse: [interpreterProxy positiveMachineIntegerFor: addr asUnsignedIntegerPtr])!
- 												ifFalse: [interpreterProxy positiveMachineIntegerFor: addr asUnsignedLong])!

Item was changed:
  ----- Method: VMProfileMacSupportPlugin>>primitiveExecutableModulesAndOffsets (in category 'primitives') -----
  primitiveExecutableModulesAndOffsets
  	"Answer an Array of quads for executable modules (the VM executable
  	 and loaded libraries).  Each quad is the module's name, its vm address
  	 relocation in memory, the (unrelocated) start address, and the size."
  	| nimages resultObj name valueObj nameObjData slide start size |
  	<export: true>
  	<var: #name type: 'const char *'>
  	<var: #nameObjData type: #'char *'>
  	<var: #h type: 'const struct mach_header *'>
  	<var: #h64 type: 'const struct mach_header_64 *'>
  	<var: #s64 type: 'const struct section_64 *'>
  	<var: #s type: 'const struct section *'>
+ 	<var: #start type: 'usqIntptr_t'>
+ 	<var: #slide type: 'usqIntptr_t'>
+ 	<var: #size type: 'usqIntptr_t'>
- 	<var: #start type: 'unsigned long'>
- 	<var: #slide type: 'unsigned long'>
- 	<var: #size type: 'unsigned long'>
  	self cppIf: #'MAC_OS_X_VERSION_MIN_REQUIRED' <= #'MAC_OS_X_VERSION_10_4'
  		ifTrue: "_dyld_present was deprecated in 10.5"
  			[(self cCode: '_dyld_present()' inSmalltalk: false) ifFalse:
  				[^interpreterProxy primitiveFail]].
  	nimages := self cCode: '_dyld_image_count()' inSmalltalk: 0.
  	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: nimages * 4.
  	resultObj = 0 ifTrue:
  		[^interpreterProxy primitiveFail].
  
  	interpreterProxy pushRemappableOop: resultObj.
  	0 to: nimages - 1 do:
  		[:i|
  		start := size := -1. "impossible start & size"
  		name := self cCode: '_dyld_get_image_name(i)' inSmalltalk: 0.
  		slide   := self cCode: '_dyld_get_image_vmaddr_slide(i)' inSmalltalk: 0.
  		self cppIf: #'__x86_64__'
  			ifTrue:
  				[(self cCode: '(const struct mach_header_64 *)_dyld_get_image_header(i)' inSmalltalk: nil) ifNotNil:
  					[:h64|
  					 (self cCode: 'getsectbynamefromheader_64(h64,SEG_TEXT,SECT_TEXT)' inSmalltalk: nil) ifNotNil:
  						[:s64|
  						 start := self cCode: 's64->addr' inSmalltalk: 0.
  						 size := self cCode: 's64->size' inSmalltalk: 0]]]
  			ifFalse:
  				[(self cCode: '_dyld_get_image_header(i)' inSmalltalk: nil) ifNotNil:
  					[:h|
  					 (self cCode: 'getsectbynamefromheader(h,SEG_TEXT,SECT_TEXT)' inSmalltalk: nil) ifNotNil:
  						[:s|
  						 start := self cCode: 's->addr' inSmalltalk: 0.
  						 size := self cCode: 's->size' inSmalltalk: 0]]].
  
  		valueObj := interpreterProxy
  						instantiateClass: interpreterProxy classString
  						indexableSize: (self strlen: name).
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  		nameObjData := interpreterProxy arrayValueOf: valueObj.
  		self mem: nameObjData cp: name y: (self strlen: name).
  
  		valueObj := interpreterProxy signedMachineIntegerFor: slide.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 1 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  
  		valueObj := interpreterProxy positiveMachineIntegerFor: start.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 2 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  
  		valueObj := interpreterProxy positiveMachineIntegerFor: size.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 3 ofObject: interpreterProxy topRemappableOop withValue: valueObj].
  
  	resultObj := interpreterProxy popRemappableOop.
  	^interpreterProxy pop: 1 thenPush: resultObj!



More information about the Vm-dev mailing list