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

Nicolas Cellier nicolas.cellier.aka.nice at gmail.com
Fri Dec 22 09:39:49 UTC 2017


Hi Eliot,
if we have a certified arithmetic right shift that preserves integer kind
- not something like (((usqint) x) >> 32), which is a logical right shift
- nor (((sqint) x) >> 32)
then what we could do is use a signed long long to store intermediate
result:
(I call it arithmeticRightShift: because I don't have a VMMaker handy to
verify the right name
maybe it was >>> ? but then that's the reverse meaning of java!)

        <var: #pWordSmall type: #'unsigned int *'>
        <var: #pWordLarge type: #'unsigned int *'>
        <var: #pWordRes type: #'unsigned int *'>
        <var: #z type: #'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 := z arithmeticRightShift: 32].
        smallLen to: largeLen - 1 do:
                [:i |
                z := z + (self cDigitOf: pWordLarge at: i).
                self cDigitOf: pWordRes at: i put: (z bitAnd: 16rFFFFFFFF).
                z := z arithmeticRightShift: 32].
        ^0!

2017-12-22 6:18 GMT+01:00 <commits at source.squeak.org>:

>
> 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!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20171222/64409dc7/attachment-0001.html>


More information about the Vm-dev mailing list