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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 22 05:18:21 UTC 2017


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

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

Name: VMMaker.oscog-eem.2299
Author: eem
Time: 21 December 2017, 9:17:52.747344 pm
UUID: 53b6a352-dbde-430a-9ec1-cb56154fe2c5
Ancestors: VMMaker.oscog-eem.2298

Get the StackInterpreterSimulator to a state where it can correctly simulate the DoubleByteArray, WordArray, DoubleWordArray and MemoryTests.  Principally allow the SqueakFFIPrims plugin (ThreadedFFIPlugin) to load and make primitiveFFIIntegerAt[Put] function correctly in simulation.  Change the two primitives to use unalignedShortAt:[put:], unalignedLong32At:[put:] & unalignedLong64At:[put:] and implement these in SpurMemoryManager (ObjectMemory can wait) and have the preambleCCode map these to the original shortAt[put],  long32At[put] & long32At[put] C functions/macros.

Fix a bug in the simulation of LargeIntegersPlugin>>cDigitSub:len:with:len:into: (Nicolas, there may be similar signedness issues in other functions.  If you have time and energy please consider taking a look at the code in the simulator).

Fix a slip in the range comparison for 64-bit integer arguments in genPrimitiveAtPut.

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

Item was added:
+ ----- Method: CoInterpreter>>ISA (in category 'simulation') -----
+ ISA
+ 	<doNotGenerate>
+ 	^cogit backEnd class ISA!

Item was changed:
  ----- Method: CogClass>>cCoerceSimple:to: (in category 'translation support') -----
  cCoerceSimple: value to: cTypeString
  	<doNotGenerate>
  	"Type coercion for translation and simulation.
  	 For simulation answer a suitable surrogate for the struct types"
  	^cTypeString caseOf:
  	   {	[#'unsigned long']							->	[value].
  		[#'unsigned int']							->	[value].
+ 		[#'unsigned short']							->	[value].
+ 		[#sqInt]									->	[value].
- 		[#sqInt]										->	[value].
  		[#'sqIntptr_t']								->	[value].
  		[#'usqIntptr_t']								->	[value].
  		[#usqInt]									->	[value].
  		[#sqLong]									->	[value].
+ 		[#usqLong]								->	[value].
- 		[#usqLong]									->	[value].
  		[#'AbstractInstruction *']					->	[value].
  		[#'BytecodeFixup *']						->	[value].
  		[#'CogMethod *']							->	[value].
  		[#'char *']									->	[value].
  		[#'sqInt *']									->	[value].
  		[#'void *']									->	[value].
  		[#void]										->	[value].
  		[#'void (*)()']								->	[value].
  		[#'void (*)(void)']							->	[value].
  		[#'unsigned long (*)(void)']					->	[value].
  		[#'void (*)(unsigned long,unsigned long)']	->	[value].
  		[#'usqIntptr_t (*)(void)']					->	[value] }!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveAtPut (in category 'primitive generators') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: FFIPlugin class>>moduleName (in category 'translation') -----
  moduleName "FFIPlugin translate"
  	"IMPORTANT: IF YOU CHANGE THE NAME OF THIS PLUGIN YOU MUST CHANGE
  		Interpreter>>primitiveCalloutToFFI
  	TO REFLECT THE CHANGE."
+ 	^'SqueakFFIPrims (Obsolete)'!
- 	^'SqueakFFIPrims'!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFileDeleteName:Size: (in category 'simulation') -----
  sqFileDeleteName: nameIndex Size: nameSize
  	| path |
+ 	path := interpreterProxy asString: nameIndex size: nameSize.
- 	path := interpreterProxy interpreter asString: nameIndex size: nameSize.
  	(StandardFileStream isAFileNamed: path) ifFalse:
  		[^interpreterProxy primitiveFail].
  	[FileDirectory deleteFilePath: path]
  		on: Error
  		do: [:ex| interpreterProxy primitiveFail]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>cDigitSub:len:with:len:into: (in category 'C core') -----
  cDigitSub: pWordSmall
  		len: smallLen
  		with: pWordLarge
  		len: largeLen
  		into: pWordRes
  	| z |
  	<var: #pWordSmall type: #'unsigned int *'>
  	<var: #pWordLarge type: #'unsigned int *'>
  	<var: #pWordRes type: #'unsigned int *'>
  	<var: #z type: #'unsigned long long'>
  
  	z := 0.
  	0 to: smallLen - 1 do: 
  		[:i | 
  		z := z + (self cDigitOf: pWordLarge at: i) - (self cDigitOf: pWordSmall at: i).
  		self cDigitOf: pWordRes at: i put: (z bitAnd: 16rFFFFFFFF).
+ 		z := 0 - (self cCode: [z >> 63] inSmalltalk: [z >> 63 bitAnd: 1])].
- 		z := 0 - (z >> 63)].
  	smallLen to: largeLen - 1 do: 
  		[:i | 
  		z := z + (self cDigitOf: pWordLarge at: i) .
  		self cDigitOf: pWordRes at: i put: (z bitAnd: 16rFFFFFFFF).
+ 		z := 0 - (self cCode: [z >> 63] inSmalltalk: [z >> 63 bitAnd: 1])].
- 		z := 0 - (z >> 63)].
  	^0!

Item was changed:
  ----- Method: Spur64BitMMLECoSimulatorFor64Bits>>long64At: (in category 'memory access') -----
  long64At: byteAddress
+ 	"memory is a DoubleWordArray, a 64-bit indexable array of bits"
- 	"memory is a DobleWordArray, a 64-bit indexable array of bits"
  	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
  	^memory at: byteAddress // 8 + 1!

Item was changed:
  ----- Method: Spur64BitMMLECoSimulatorFor64Bits>>long64At:put: (in category 'memory access') -----
  long64At: byteAddress put: a64BitValue
+ 	"memory is a DoubleWordArray, a 64-bit indexable array of bits"
- 	"memory is a DobleWordArray, a 64-bit indexable array of bits"
  	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
  	^memory at: byteAddress // 8 + 1 put: a64BitValue!

Item was changed:
  ----- Method: Spur64BitMMLESimulatorFor64Bits>>long32At:put: (in category 'memory access') -----
  long32At: byteAddress put: a32BitValue
   	"Store the 32-bit word at byteAddress which must be a multiple of four."
  	| lowBits long longAddress |
+ 	a32BitValue < 0 ifTrue:
+ 		[self long32At: byteAddress put: (a32BitValue bitAnd: 16rFFFFFFFF).
+ 		 ^a32BitValue].
  	lowBits := byteAddress bitAnd: 4.
  	lowBits = 0
  		ifTrue: "storing into LS word"
  			[long := self long64At: byteAddress.
  			 self long64At: byteAddress
  				put: ((long bitAnd: 16rFFFFFFFF00000000) bitOr: a32BitValue)]
  		ifFalse: "storing into MS word"
  			[longAddress := byteAddress - 4.
  			long := self long64At: longAddress.
  			self long64At: longAddress
  				put: ((long bitAnd: 16rFFFFFFFF) bitOr: (a32BitValue bitShift: 32))].
  	^a32BitValue!

Item was changed:
  ----- Method: Spur64BitMMLESimulatorFor64Bits>>long64At:put: (in category 'memory access') -----
  long64At: byteAddress put: a64BitValue
+ 	"memory is a DoubleWordArray, a 64-bit indexable array of bits"
- 	"memory is a DobleWordArray, a 64-bit indexable array of bits"
  	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
  	^memory at: byteAddress // 8 + 1 put: a64BitValue!

Item was added:
+ ----- Method: SpurMemoryManager>>ISA (in category 'simulation only') -----
+ ISA
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter ISA!

Item was added:
+ ----- Method: SpurMemoryManager>>signed64BitIntegerFor: (in category 'simulation only') -----
+ signed64BitIntegerFor: integerValue
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter signed64BitIntegerFor: integerValue!

Item was added:
+ ----- Method: SpurMemoryManager>>signed64BitValueOf: (in category 'simulation only') -----
+ signed64BitValueOf: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter signed64BitValueOf: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>unalignedLong32At: (in category 'simulation') -----
+ unalignedLong32At: index
+ 	"Support for primitiveFFIIntegerAt[Put]"
+ 	<doNotGenerate>
+ 	| odd hi lo |
+ 	(odd := index bitAnd: 3) = 0 ifTrue:
+ 		[^self long32At: index].
+ 	lo := self long32At: index - odd.
+ 	hi := self long32At: index + 4 - odd.
+ 	^lo >> (odd * 8) + ((hi bitAnd: 1 << (odd * 8) - 1) << (4 - odd * 8))!

Item was added:
+ ----- Method: SpurMemoryManager>>unalignedLong32At:put: (in category 'simulation') -----
+ unalignedLong32At: index put: aValue
+ 	"Support for primitiveFFIIntegerAt[Put]"
+ 	<doNotGenerate>
+ 	| odd hi lo mask |
+ 	aValue < 0 ifTrue:
+ 		[self unalignedLong64At: index put: (aValue bitAnd: 16rFFFFFFFF).
+ 		 ^aValue].
+ 	(odd := index bitAnd: 3) = 0 ifTrue:
+ 		[^self long32At: index put: aValue].
+ 	mask := 1 << (odd * 8) - 1.
+ 	lo := self long32At: index - odd.
+ 	self long32At: index - odd
+ 		put: (lo bitAnd: mask)
+ 			+ ((aValue bitAnd: 1 << (4 - odd * 8) - 1) << (odd * 8)).
+ 	hi := self long32At: index + 4 - odd.
+ 	self long32At: index + 4 - odd
+ 		put: (hi bitClear: mask) + (aValue >> (4 - odd * 8) bitAnd: mask).
+ 	^aValue!

Item was added:
+ ----- Method: SpurMemoryManager>>unalignedLong64At: (in category 'simulation') -----
+ unalignedLong64At: index
+ 	"Support for primitiveFFIIntegerAt[Put]"
+ 	<doNotGenerate>
+ 	| odd hi lo |
+ 	(odd := index bitAnd: 7) = 0 ifTrue:
+ 		[^self long64At: index].
+ 	lo := self long64At: index - odd.
+ 	hi := self long64At: index + 8 - odd.
+ 	^lo >> (odd * 8) + ((hi bitAnd: 1 << (odd * 8) - 1) << (8 - odd * 8))!

Item was added:
+ ----- Method: SpurMemoryManager>>unalignedLong64At:put: (in category 'simulation') -----
+ unalignedLong64At: index put: aValue
+ 	"Support for primitiveFFIIntegerAt[Put]"
+ 	<doNotGenerate>
+ 	| odd hi lo mask |
+ 	aValue < 0 ifTrue:
+ 		[self unalignedLong64At: index put: (aValue bitAnd: 16rFFFFFFFFFFFFFFFF).
+ 		 ^aValue].
+ 	(odd := index bitAnd: 7) = 0 ifTrue:
+ 		[^self long64At: index put: aValue].
+ 	mask := 1 << (odd * 8) - 1.
+ 	lo := self long64At: index - odd.
+ 	self long64At: index - odd
+ 		put: (lo bitAnd: mask)
+ 			+ ((aValue bitAnd: 1 << (8 - odd * 8) - 1) << (odd * 8)).
+ 	hi := self long64At: index + 8 - odd.
+ 	self long64At: index + 8 - odd
+ 		put: (hi bitClear: mask) + (aValue >> (8 - odd * 8) bitAnd: mask).
+ 	^aValue!

Item was added:
+ ----- Method: SpurMemoryManager>>unalignedShortAt: (in category 'simulation') -----
+ unalignedShortAt: index
+ 	"Support for primitiveFFIIntegerAt[Put]"
+ 	<doNotGenerate>
+ 	| hi lo |
+ 	(index bitAnd: 1) = 0 ifTrue:
+ 		[^self shortAt: index].
+ 	lo := self shortAt: index - 1.
+ 	hi := self shortAt: index + 1.
+ 	^lo >> 8 + ((hi bitAnd: 16rFF) << 8)!

Item was added:
+ ----- Method: SpurMemoryManager>>unalignedShortAt:put: (in category 'simulation') -----
+ unalignedShortAt: index put: aValue
+ 	"Support for primitiveFFIIntegerAt[Put]"
+ 	<doNotGenerate>
+ 	(index bitAnd: 1) = 0 ifTrue:
+ 		[^self shortAt: index put: aValue].
+ 	self shouldBeImplemented.
+ 	^aValue!

Item was added:
+ ----- Method: StackInterpreter>>ISA (in category 'simulation') -----
+ ISA
+ 	<doNotGenerate>
+ 	^self class initializationOptions
+ 		at: #ISA
+ 		ifAbsent: [Smalltalk wordSize = 8
+ 					ifTrue: [#X64]
+ 					ifFalse: [#IA32]]!

Item was changed:
  ----- Method: StackInterpreter>>ioLoadExternalFunction:OfLength:FromModule:OfLength:AccessorDepthInto: (in category 'primitive support') -----
  ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength AccessorDepthInto: accessorDepthPtr
  	"Load and return the requested function from a module.  Assign the accessor depth through accessorDepthPtr.
  	 N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
  	<doNotGenerate>
  	| pluginString functionString |
  	pluginString := String new: moduleLength.
+ 	(1 to: moduleLength) do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
- 	1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
  	functionString := String new: functionLength.
+ 	(1 to: functionLength) do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
+ 	"We used to ignore loads of the SqueakFFIPrims plugin, but that means doing without integerAt:[put:]size:signed:
+ 	 which is too much of a limitation (not that these simulate unaligned accesses yet)."
- 	1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
- 	"Pharo images as of 2016 use the FFI plugin (for getenv:?).  We can't simulate such function loads.  So ignore"
- 	pluginString = 'SqueakFFIPrims' ifTrue:
- 		["self halt."
- 		 true ifTrue:
- 			[self transcript cr; show: 'ignoring function load from SqueakFFIPrims'.
- 			 ^0]].
  	^self ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr!

Item was changed:
  ----- Method: ThreadedFFIPlugin class>>preambleCCode (in category 'translation') -----
  preambleCCode
  	"For a source of builtin defines grep for builtin_define in a gcc release config directory."
  	^'
  #include "sqAssert.h" /* for assert */
  #define ThreadedFFIPlugin 1 /* to filter-out unwanted declarations from sqFFI.h */
  #include "sqFFI.h" /* for logging and surface functions */
  #include "sqCogStackAlignment.h" /* for STACK_ALIGN_BYTES and getsp() */
  
  #ifdef _MSC_VER
  # define alloca _alloca
  #endif
  #if defined(__GNUC__) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__))
  # define setsp(sp) asm volatile ("movl %0,%%esp" : : "m"(sp))
  # elif defined(__GNUC__) && (defined(__amd64__) || defined(__x86_64__) ||  defined(__amd64) || defined(__x86_64))
  # define setsp(sp) asm volatile ("movq %0,%%rsp" : : "m"(sp))
  # elif defined(__GNUC__) && (defined(__arm__))
  # define setsp(sp) asm volatile ("ldr %%sp, %0" : : "m"(sp))
  #endif
  #if !!defined(getsp)
  # define getsp() 0
  #endif 
  #if !!defined(setsp)
  # define setsp(ignored) 0
  #endif 
  
  #if !!defined(STACK_ALIGN_BYTES)
  #  define STACK_ALIGN_BYTES 0
  #endif /* !!defined(STACK_ALIGN_BYTES) */
  
  /* For ABI that require stack alignment greater than natural word size */
  #define MUST_ALIGN_STACK (STACK_ALIGN_BYTES > sizeof(void*))
  
  #if defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)
  /* Both Mac OS X x86 and Win32 x86 return structs of a power of two in size
   * less than or equal to eight bytes in length in registers. Linux never does so.
   */
  # if __linux__
  #	define WIN32_X86_STRUCT_RETURN 0
  # else
  #	define WIN32_X86_STRUCT_RETURN 1
  # endif
  # if _WIN32
  #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1
  # endif
  # elif defined(__amd64__) || defined(__x86_64__) ||  defined(__amd64) || defined(__x86_64)
  # if _WIN32 | _WIN64
  #	define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1
  # endif
  #endif /* defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) */
  
  #if !!defined(ALLOCA_LIES_SO_SETSP_BEFORE_CALL)
  # if defined(__MINGW32__) && !!defined(__clang__) && (__GNUC__ >= 3) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__))
      /*
       * cygwin -mno-cygwin (MinGW) gcc 3.4.x''s alloca is a library routine that answers
       * %esp + xx, so the outgoing stack is offset by one or more word if uncorrected.
       * Grab the actual stack pointer to correct.
       */
  #	define ALLOCA_LIES_SO_SETSP_BEFORE_CALL 1
  # else
  #	define ALLOCA_LIES_SO_SETSP_BEFORE_CALL 0
  # endif
  #endif /* !!defined(ALLOCA_LIES_SO_SETSP_BEFORE_CALL) */
  
  #if !!defined(PLATFORM_API_USES_CALLEE_POPS_CONVENTION)
  # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0
  #endif
  
+ /* This alignment stuff is a hack for integerAt:put:size:signed:/primitiveFFIIntegerAt[Put].
+  * The assumption right now is that all processors suppoprt unaligned access.  That only
+  * holds true for x86, x86-64 & ARMv6 & later.  But this keeps us going until we can addresws it properly.
+  */
+ #define unalignedShortAt(a) shortAt(a)
+ #define unalignedShortAtput(a) shortAtput(a)
+ #define unalignedLong32At(a) long32At(a)
+ #define unalignedLong32Atput(a) long32Atput(a)
+ #define unalignedLong64At(a) long64At(a)
+ #define unalignedLong64Atput(a) long64Atput(a)
+ 
  /* The dispatchOn:in:with:with: generates an unwanted call on error.  Just squash it. */
  #define error(foo) 0
  #ifndef SQUEAK_BUILTIN_PLUGIN
  /* but print assert failures. */
  void
  warning(char *s) { /* Print an error message but don''t exit. */
  	printf("\n%s\n", s);
  }
  #endif
  
  /* sanitize */
  #ifdef SQUEAK_BUILTIN_PLUGIN
  # define EXTERN 
  #else
  # define EXTERN extern
  #endif
  '!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>initSurfacePluginFunctionPointers (in category 'simulation') -----
+ initSurfacePluginFunctionPointers
+ 	"This is a simulation-only stub.  The real code is in
+ 		platforms/Cross/plugins/SqueakFFIPrims/sqManualSurface.c"
+ 	<doNotGenerate>!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>initialiseModule (in category 'initialize') -----
  initialiseModule
  	<export: true>
  	"By default, disable logging"
  	ffiLogEnabled := false.
  	"Get the instSize of ExternalFunction to know whether it contains a cache of the stackSize,
  	 and what the offset of ExternalLibraryFunction's functionName and moduleName slots are."
  	externalFunctionInstSize := interpreterProxy instanceSizeOf: interpreterProxy classExternalFunction.
  	self initSurfacePluginFunctionPointers.
+ 	^true!
- 	^1!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>morphIntoConcreteSubclass: (in category 'simulation') -----
+ morphIntoConcreteSubclass: aCoInterpreter
+ 	<doNotGenerate>
+ 	| concreteClass |
+ 	concreteClass :=
+ 		aCoInterpreter ISA caseOf: {
+ 			[#X64]		->	[(Smalltalk platformName beginsWith: 'Win')
+ 								ifTrue: [ThreadedX64Win64FFIPlugin]
+ 								ifFalse: [ThreadedX64SysVFFIPlugin]].
+ 			[#IA32]	->	[ThreadedIA32FFIPlugin].
+ 			[#ARMv5]	->	[ThreadedARMFFIPlugin] }
+ 			otherwise: [self error: 'simulation not set up for this ISA'].
+ 	self changeClassTo: concreteClass!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIIntegerAt (in category 'primitives') -----
  primitiveFFIIntegerAt
  	"Answer a (signed or unsigned) n byte integer from the given byte offset
  	 in the receiver, using the platform's endianness."
  	| isSigned byteSize byteOffset rcvr addr value mask valueOop |
  	<var: 'value' type: #usqLong>
  	<var: 'mask' type: #usqLong>
  	<export: true>
  	<inline: false>
  	isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
  	byteSize := interpreterProxy stackIntegerValue: 1.
  	byteOffset := interpreterProxy stackIntegerValue: 2.
  	rcvr := interpreterProxy stackObjectValue: 3.
  	interpreterProxy failed ifTrue:[^0].
  	(byteOffset > 0
  	 and: [(byteSize between: 1 and: 8)
  	 and: [(byteSize bitAnd: byteSize - 1) = 0 "a.k.a. isPowerOfTwo"]]) ifFalse:
  		[^interpreterProxy primitiveFail].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
  	interpreterProxy failed ifTrue:[^0].
  	byteSize <= 2
  		ifTrue:
  			[byteSize = 1
  				ifTrue: [value := self cCoerceSimple: (interpreterProxy byteAt: addr) to: #'unsigned char']
+ 				ifFalse: [value := self cCoerceSimple: (interpreterProxy unalignedShortAt: addr) to: #'unsigned short']]
- 				ifFalse: [value := self cCoerceSimple: (interpreterProxy shortAt: addr) to: #'unsigned short']]
  		ifFalse:
  			[byteSize = 4
+ 				ifTrue: [value := self cCoerceSimple: (interpreterProxy unalignedLong32At: addr) to: #'unsigned int']
+ 				ifFalse: [value := interpreterProxy unalignedLong64At: addr]].
- 				ifTrue: [value := self cCoerceSimple: (interpreterProxy long32At: addr) to: #'unsigned int']
- 				ifFalse: [value := interpreterProxy long64At: addr]].
  	byteSize < BytesPerWord
  		ifTrue:
  			[isSigned ifTrue: "sign extend value"
  				[mask := 1 asUnsignedLongLong << (byteSize * 8 - 1).
  				value := (value bitAnd: mask-1) - (value bitAnd: mask)].
  			 "note: byte/short (&long if BytesPerWord=8) never exceed SmallInteger range"
  			 valueOop := interpreterProxy integerObjectOf: value]
  		ifFalse: "general 64 bit integer; note these never fail"
  			[isSigned
  				ifTrue:
  					[byteSize < 8 ifTrue: "sign extend value"
  						[mask := 1 asUnsignedLongLong << (byteSize * 8 - 1).
  						value := (value bitAnd: mask-1) - (value bitAnd: mask)].
+ 					 self cCode: [] inSmalltalk:
+ 						[(byteSize = 8 and: [(value bitShift: -56) >= 128]) ifTrue:
+ 							[value := value - (1 bitShift: 64)]].
  					 valueOop := interpreterProxy signed64BitIntegerFor: value]
  				ifFalse:[valueOop := interpreterProxy positive64BitIntegerFor: value]].
  	^interpreterProxy pop: 4 thenPush: valueOop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIIntegerAtPut (in category 'primitives') -----
  primitiveFFIIntegerAtPut
  	"Store a (signed or unsigned) n byte integer at the given byte offset
  	 in the receiver, using the platform's endianness."
  	| isSigned byteSize byteOffset rcvr addr value max valueOop |
  	<var: 'value' type: #sqLong>
  	<var: 'max' type: #sqLong>
  	<export: true>
  	<inline: false>
  	isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
  	byteSize := interpreterProxy stackIntegerValue: 1.
  	valueOop := interpreterProxy stackValue: 2.
  	byteOffset := interpreterProxy stackIntegerValue: 3.
  	rcvr := interpreterProxy stackObjectValue: 4.
  	interpreterProxy failed ifTrue:[^0].
  	(byteOffset > 0
  	 and: [(byteSize between: 1 and: 8)
  	 and: [(byteSize bitAnd: byteSize - 1) = 0 "a.k.a. isPowerOfTwo"]]) ifFalse:
  		[^interpreterProxy primitiveFail].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
  	interpreterProxy failed ifTrue:[^0].
  	isSigned 
  		ifTrue:[value := interpreterProxy signed64BitValueOf: valueOop]
  		ifFalse:[value := interpreterProxy positive64BitValueOf: valueOop].
  	interpreterProxy failed ifTrue:[^0].
  	byteSize < 8 ifTrue:
  		[isSigned
  			ifTrue:
  				[max := 1 asUnsignedLongLong << (8 * byteSize - 1).
  				(value >= (0 - max) and: [value < max]) ifFalse: [^interpreterProxy primitiveFail]]
  			ifFalse:
  				[value asUnsignedLongLong < (1 asUnsignedLongLong << (8 * byteSize)) ifFalse: [^interpreterProxy primitiveFail]]].
  	byteSize <= 2
  		ifTrue:
  			[byteSize = 1
  				ifTrue: [interpreterProxy byteAt: addr put: value]
+ 				ifFalse: [interpreterProxy unalignedShortAt: addr put: value]]
- 				ifFalse: [interpreterProxy shortAt: addr put: value]]
  		ifFalse:
  			[byteSize = 4
+ 				ifTrue: [interpreterProxy unalignedLong32At: addr put: value]
+ 				ifFalse: [interpreterProxy unalignedLong64At: addr put: value]].
- 				ifTrue: [interpreterProxy long32At: addr put: value]
- 				ifFalse: [interpreterProxy long64At: addr put: value]].
  	^interpreterProxy pop: 5 thenPush: valueOop!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>setInterpreter: (in category 'simulation') -----
+ setInterpreter: anInterpreter
+ 	"Initialization of the plugin in the simulator.
+ 	 The real routine is in the superclass."
+ 	self cCode: []
+ 		inSmalltalk: [self class == thisContext method methodClass ifTrue:
+ 						[self morphIntoConcreteSubclass: anInterpreter]].
+ 	^super setInterpreter: anInterpreter!



More information about the Vm-dev mailing list