VM Maker: VMMaker.oscog-eem.2510.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-eem.2510.mcz

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

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

Name: VMMaker.oscog-eem.2510
Author: eem
Time: 20 January 2019, 7:05:51.510109 pm
UUID: 4108a547-dc5c-47ed-9521-d25f5918b426
Ancestors: VMMaker.oscog-eem.2509, VMMaker.oscog-KenD.2509

Merge VMMaker.oscog-eem.2509, VMMaker.oscog-KenD.2509.  Rename ThreadedFFICalloutStateForARMto ThreadedFFICalloutStateForARM32.  Pull ThreadedFFICalloutStateForARM64 out from under so that ThreadedFFICalloutStateForARM64 typedef generates the right thing.  Defaylt to sqInt in its instVarNamesAndTypesForTranslationDo:

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

Item was changed:
  ----- Method: RiscOSVMMaker class>>generateSqueakStackVM (in category 'configurations') -----
  generateSqueakStackVM
  "RISC OS version; build needed plugins, make sure filename tweaking is used"
  "RiscOSVMMaker generateSqueakStackVM"
  ^self
  generate: StackInterpreter
  to: (FileDirectory default directoryNamed: 'stacksrc') fullName
  platformDir: (FileDirectory default directoryNamed: 'platforms') fullName
+ excluding: #(AsynchFilePlugin BrokenPlugin CroquetPlugin FFIPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JoystickTabletPlugin MIDIPlugin MacMenubarPlugin Mpeg3Plugin NewsqueakIA32ABIPlugin QuicktimePlugin SerialPlugin  TestOSAPlugin ThreadedARMFFIPlugin ThreadedARMFFI64Plugin ThreadedFFIPlugin ThreadedIA32FFIPlugin ThreadedPPCBEFFIPlugin UUIDPlugin VMProfileMacSupportPlugin)!
- excluding: #(AsynchFilePlugin BrokenPlugin CroquetPlugin FFIPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JoystickTabletPlugin MIDIPlugin MacMenubarPlugin Mpeg3Plugin NewsqueakIA32ABIPlugin QuicktimePlugin SerialPlugin  TestOSAPlugin ThreadedARMFFIPlugin ThreadedFFIPlugin ThreadedIA32FFIPlugin ThreadedPPCBEFFIPlugin UUIDPlugin VMProfileMacSupportPlugin)!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin class>>calloutStateClass (in category 'translation') -----
+ calloutStateClass
+ ^ThreadedFFICalloutStateForARM64!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>ffiPushDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDoubleFloat: value in: calloutState
+ <var: #value type: #double>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: #always>
+
+ calloutState floatRegisterIndex < (NumFloatRegArgs - 1)
+ ifTrue:
+ [(self cCoerceSimple:
+ (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex))
+ to: 'double*')
+ at: 0
+ put: value.
+ calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ calloutState floatRegisterIndex: NumFloatRegArgs.
+ interpreterProxy storeFloatAtPointer: calloutState currentArg from: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>ffiPushSignedInt:in: (in category 'marshalling') -----
+ ffiPushSignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters
+ at: calloutState integerRegisterIndex
+ put: (self cCoerceSimple: value to: #sqLong).
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0
+ !

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>ffiPushSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushSignedLongLong: value in: calloutState
+ <var: #value type: #sqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters
+ at: calloutState integerRegisterIndex
+ put: (self cCoerceSimple: value to: #sqLong).
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>ffiPushSingleFloat:in: (in category 'marshalling') -----
+ ffiPushSingleFloat: value in: calloutState
+ <var: #value type: #float>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: #always>
+ calloutState floatRegisterIndex < NumFloatRegArgs
+ ifTrue:
+ [calloutState floatRegisters
+ at: calloutState floatRegisterIndex
+ put: (self cCoerceSimple: value to: #double).
+ calloutState floatRegisterIndex: calloutState floatRegisterIndex + 2]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy storeSingleFloatAtPointer: calloutState currentArg from: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
+ ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
+ <var: #pointer type: #'void *'>
+ <var: #argSpec type: #'sqInt *'>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ | availableRegisterSpace stackPartSize roundedSize |
+
+ availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * self wordSize.
+ stackPartSize := structSize.
+ availableRegisterSpace > 0
+ ifTrue:
+ [structSize <= availableRegisterSpace
+ ifTrue:
+ ["all in registers"
+ stackPartSize := 0.
+ self
+ memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *')
+ _: pointer
+ _: structSize.
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 3 bitShift: -2) ]
+ ifFalse:
+ ["If no previous co-processor candidate arg has already been pushed on the stack, then split the struct between registers and stack.
+  Otherwise push entire struct on stack."
+ calloutState currentArg = calloutState argVector
+ ifTrue:
+ [stackPartSize := structSize - availableRegisterSpace.
+ self
+ memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *')
+ _: pointer
+ _: availableRegisterSpace]
+ ifFalse:
+ [availableRegisterSpace := 0].
+ calloutState integerRegisterIndex: NumIntRegArgs]].
+
+ stackPartSize > 0
+ ifTrue:
+ [roundedSize := stackPartSize + 3 bitClear: 3.
+ calloutState currentArg + roundedSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ self memcpy: calloutState currentArg _: (self addressOf: ((self cCoerceSimple: pointer to: 'char *') at: availableRegisterSpace)) _: stackPartSize.
+ calloutState currentArg: calloutState currentArg + roundedSize].
+ ^0!

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>ffiPushUnsignedInt:in: (in category 'marshalling') -----
+ ffiPushUnsignedInt: value in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters
+ at: calloutState integerRegisterIndex
+ put:  (self cCoerceSimple: value to: #usqLong).
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0
+
+ !

Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>ffiPushUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushUnsignedLongLong: value in: calloutState
+ <var: #value type: #usqLong>
+ <var: #calloutState type: #'CalloutState *'>
+ <inline: true>
+ calloutState integerRegisterIndex < NumIntRegArgs
+ ifTrue:
+ [calloutState integerRegisters
+ at: calloutState integerRegisterIndex
+ put:(self cCoerceSimple: value to: #usqLong).
+ calloutState integerRegisterIndex: calloutState integerRegisterIndex + 1]
+ ifFalse:
+ [calloutState currentArg + self wordSize > calloutState limit ifTrue: [^FFIErrorCallFrameTooBig].
+ interpreterProxy longAt: calloutState currentArg put: value.
+ calloutState currentArg: calloutState currentArg + self wordSize].
+ ^0
+ !

Item was changed:
  ----- Method: ThreadedARMFFIPlugin class>>calloutStateClass (in category 'translation') -----
  calloutStateClass
+ ^ThreadedFFICalloutStateForARM32!
- ^ThreadedFFICalloutStateForARM!

Item was removed:
- ThreadedFFICalloutState subclass: #ThreadedFFICalloutStateForARM
- instanceVariableNames: 'integerRegisterIndex integerRegisters floatRegisterIndex backfillFloatRegisterIndex floatRegisters'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'VMMaker-Plugins-FFI'!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct."
-
- superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
- self instVarNames do:
- [:ivn|
- aBinaryBlock
- value: ivn
- value: (ivn caseOf: {
- ['integerRegisters'] -> [{#sqInt. '[NumIntRegArgs]'}].
- ['floatRegisters'] -> [{#float. '[NumFloatRegArgs]'}] }
- otherwise:
- [#sqInt])]!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>backfillFloatRegisterIndex (in category 'accessing') -----
- backfillFloatRegisterIndex
-
- ^ backfillFloatRegisterIndex!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>backfillFloatRegisterIndex: (in category 'accessing') -----
- backfillFloatRegisterIndex: anObject
-
- ^backfillFloatRegisterIndex := anObject!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>floatRegisterIndex (in category 'accessing') -----
- floatRegisterIndex
-
- ^ floatRegisterIndex!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>floatRegisterIndex: (in category 'accessing') -----
- floatRegisterIndex: anObject
-
- ^floatRegisterIndex := anObject!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>floatRegisters (in category 'accessing') -----
- floatRegisters
-
- ^ floatRegisters!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>floatRegisters: (in category 'accessing') -----
- floatRegisters: anObject
-
- ^floatRegisters := anObject!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>initialize (in category 'initialize-release') -----
- initialize
- super initialize.
- integerRegisterIndex := 0.
- floatRegisterIndex := 0.
- backfillFloatRegisterIndex := 0.
- integerRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numIntRegArgs).
- floatRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numFloatRegArgs)!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>integerRegisterIndex (in category 'accessing') -----
- integerRegisterIndex
-
- ^ integerRegisterIndex!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>integerRegisterIndex: (in category 'accessing') -----
- integerRegisterIndex: anObject
-
- ^integerRegisterIndex := anObject!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>integerRegisters (in category 'accessing') -----
- integerRegisters
- "Answer the value of integerRegisters"
-
- ^ integerRegisters!

Item was removed:
- ----- Method: ThreadedFFICalloutStateForARM>>integerRegisters: (in category 'accessing') -----
- integerRegisters: anObject
- "Set the value of integerRegisters"
-
- ^integerRegisters := anObject!

Item was added:
+ ThreadedFFICalloutState subclass: #ThreadedFFICalloutStateForARM32
+ instanceVariableNames: 'integerRegisterIndex integerRegisters floatRegisterIndex backfillFloatRegisterIndex floatRegisters'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins-FFI'!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32 class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct."
+
+ superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['integerRegisters'] -> [{#sqInt. '[NumIntRegArgs]'}].
+ ['floatRegisters'] -> [{#float. '[NumFloatRegArgs]'}] }
+ otherwise:
+ [#sqInt])]!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>backfillFloatRegisterIndex (in category 'accessing') -----
+ backfillFloatRegisterIndex
+
+ ^ backfillFloatRegisterIndex!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>backfillFloatRegisterIndex: (in category 'accessing') -----
+ backfillFloatRegisterIndex: anObject
+
+ ^backfillFloatRegisterIndex := anObject!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>floatRegisterIndex (in category 'accessing') -----
+ floatRegisterIndex
+
+ ^ floatRegisterIndex!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>floatRegisterIndex: (in category 'accessing') -----
+ floatRegisterIndex: anObject
+
+ ^floatRegisterIndex := anObject!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>floatRegisters (in category 'accessing') -----
+ floatRegisters
+
+ ^ floatRegisters!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>floatRegisters: (in category 'accessing') -----
+ floatRegisters: anObject
+
+ ^floatRegisters := anObject!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>initialize (in category 'initialize-release') -----
+ initialize
+ super initialize.
+ integerRegisterIndex := 0.
+ floatRegisterIndex := 0.
+ backfillFloatRegisterIndex := 0.
+ integerRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numIntRegArgs).
+ floatRegisters := CArrayAccessor on: (Array new: ThreadedARMFFIPlugin numFloatRegArgs)!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>integerRegisterIndex (in category 'accessing') -----
+ integerRegisterIndex
+
+ ^ integerRegisterIndex!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>integerRegisterIndex: (in category 'accessing') -----
+ integerRegisterIndex: anObject
+
+ ^integerRegisterIndex := anObject!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>integerRegisters (in category 'accessing') -----
+ integerRegisters
+ "Answer the value of integerRegisters"
+
+ ^ integerRegisters!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM32>>integerRegisters: (in category 'accessing') -----
+ integerRegisters: anObject
+ "Set the value of integerRegisters"
+
+ ^integerRegisters := anObject!

Item was added:
+ ThreadedFFICalloutState subclass: #ThreadedFFICalloutStateForARM64
+ instanceVariableNames: 'integerRegisterIndex floatRegisterIndex integerRegisters floatRegisters'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins-FFI'!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64 class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a ThreadedFFICalloutState struct."
+
+ superclass instVarNamesAndTypesForTranslationDo: aBinaryBlock.
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn caseOf: {
+ ['integerRegisters'] -> [{#sqInt. '[NumIntRegArgs]'}].
+ ['floatRegisters'] -> [{#double. '[NumFloatRegArgs]'}] }
+ otherwise:
+ [#sqInt])]!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>floatRegisterIndex (in category 'accessing') -----
+ floatRegisterIndex
+
+ ^ floatRegisterIndex!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>floatRegisterIndex: (in category 'accessing') -----
+ floatRegisterIndex: anObject
+
+ ^ floatRegisterIndex := anObject.!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>floatRegisters (in category 'accessing') -----
+ floatRegisters
+
+ ^ floatRegisters!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>floatRegisters: (in category 'accessing') -----
+ floatRegisters: anObject
+
+ ^ floatRegisters := anObject.!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>initialize (in category 'initialize-release') -----
+ initialize
+ super initialize.
+ integerRegisterIndex := 0.
+ floatRegisterIndex := 0.
+ integerRegisters := CArrayAccessor on: (Array new: ThreadedARM64FFIPlugin numIntRegArgs).
+ floatRegisters     := CArrayAccessor on: (Array new: ThreadedARM64FFIPlugin numFloatRegArgs)!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>integerRegisterIndex (in category 'accessing') -----
+ integerRegisterIndex
+
+ ^ integerRegisterIndex!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>integerRegisterIndex: (in category 'accessing') -----
+ integerRegisterIndex: anObject
+
+ ^ integerRegisterIndex := anObject.!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>integerRegisters (in category 'accessing') -----
+ integerRegisters
+
+ ^ integerRegisters!

Item was added:
+ ----- Method: ThreadedFFICalloutStateForARM64>>integerRegisters: (in category 'accessing') -----
+ integerRegisters: anObject
+
+ ^ integerRegisters := anObject.!

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.
  See See platforms/Cross/vm/sqCogStackAlignment.h for per-platform definitions for
  STACK_ALIGN_BYTES MUST_ALIGN_STACK et al."
  ^'
  #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(__arm64__) || defined(__aarch64__) || defined(ARM64)
+         /* https://gcc.gnu.org/onlinedocs/gcc/Extended-Asm.html#Extended-Asm
+          * http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.den0024a/index.html
+          */
+ #  if __GNUC__
+ #   define getfp() ({ usqIntptr_t fp;                                                           \
+                                           asm volatile ("mov x0, x29" : "=r"(x29) : );  \
+                                           fp; })
+ #   define getsp() ({ usqIntptr_t sp;                                                           \
+                                           asm volatile ("mov x0, sp" : "=r"(sp) : );    \
+                                           sp; })
+ # define setsp(sp) asm volatile ("ldr x16, %0 \n\t" "mov sp, x16"  : : "m"(sp) )
+ #  endif
  # 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 support unaligned access.  That only
   * holds true for x86, x86-64 & ARMv6 & later.  But this keeps us going until we can address
   * it properly.
   */
  #define unalignedShortAt(a) shortAt(a)
  #define unalignedShortAtput(a,v) shortAtput(a,v)
  #define unalignedLong32At(a) long32At(a)
  #define unalignedLong32Atput(a,v) long32Atput(a,v)
  #define unalignedLong64At(a) long64At(a)
  #define unalignedLong64Atput(a,v) long64Atput(a,v)
 
  /* 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 changed:
  ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') -----
  generateVMPlugins
  ^VMMaker
  generatePluginsTo: self sourceTree, '/src'
  options: #()
  platformDir: self sourceTree, '/platforms'
  including:#( ADPCMCodecPlugin AsynchFilePlugin
  BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation
  BochsIA32Plugin BochsX64Plugin
  CameraPlugin CroquetPlugin DeflatePlugin DropPlugin
  "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA256Plugin
  "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin FloatArrayPlugin FloatMathPlugin
  GeniePlugin GdbARMPlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin
  JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin
  LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin
  MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin
  ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin
  SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin
+ ThreadedFFIPlugin ThreadedARMFFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin
+ ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin
- ThreadedFFIPlugin ThreadedARMFFIPlugin ThreadedIA32FFIPlugin ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin
  UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin
  Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin
  XDisplayControlPlugin)!