[OpenSmalltalk/opensmalltalk-vm] 7af801: CogVM source as per VMMaker.oscog-eem.3148
by Eliot Miranda 08 Feb '22
by Eliot Miranda 08 Feb '22
08 Feb '22
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: 7af8010e2f26673025b37fcc3177999dde8744cd
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/7af8010e2f26673025…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2022-02-07 (Mon, 07 Feb 2022)
Changed paths:
M src/spur32.cog.lowcode/cointerp.c
M src/spur32.cog.lowcode/cointerp.h
M src/spur32.cog.lowcode/gcc3x-cointerp.c
M src/spur32.cog/cointerp.c
M src/spur32.cog/cointerp.h
M src/spur32.cog/cointerpmt.c
M src/spur32.cog/cointerpmt.h
M src/spur32.cog/gcc3x-cointerp.c
M src/spur32.cog/gcc3x-cointerpmt.c
M src/spur32.sista/cointerp.c
M src/spur32.sista/cointerp.h
M src/spur32.sista/gcc3x-cointerp.c
M src/spur64.cog.lowcode/cointerp.c
M src/spur64.cog.lowcode/cointerp.h
M src/spur64.cog.lowcode/gcc3x-cointerp.c
M src/spur64.cog/cointerp.c
M src/spur64.cog/cointerp.h
M src/spur64.cog/cointerpmt.c
M src/spur64.cog/cointerpmt.h
M src/spur64.cog/gcc3x-cointerp.c
M src/spur64.cog/gcc3x-cointerpmt.c
M src/spur64.sista/cointerp.c
M src/spur64.sista/cointerp.h
M src/spur64.sista/gcc3x-cointerp.c
M src/v3.cog/cointerp.c
M src/v3.cog/cointerp.h
M src/v3.cog/gcc3x-cointerp.c
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.3148
Spur CoInterpreter: fix crashes of vmParameterAt: on WIndows under Clang.
The PrimCallOnSmalltalkStack needs PrimCallOnSmalltalkStackAlign2x also.
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3148.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3148
Author: eem
Time: 7 February 2022, 7:59:49.131441 pm
UUID: 55858401-f9a2-4458-ab45-b576bac43a1c
Ancestors: VMMaker.oscog-eem.3147
Spur CoInterpreter: fix crashes of vmParameterAt: on WIndows under Clang. The PrimCallOnSmalltalkStack needs PrimCallOnSmalltalkStackAlign2x also.
=============== Diff against VMMaker.oscog-eem.3147 ===============
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlagsForSpur:numArgs: (in category 'cog jit support') -----
primitivePropertyFlagsForSpur: primIndex numArgs: numArgs
<inline: true>
"Answer any special requirements of the given primitive. Spur needs to set
newMethod if and when a primitive fails so primitives can retry on failure due
to forwarders, but this isn't done until failure. The primitiveMetadataTable
is populated based on the primitiveMetadata: pragma in internal primitives."
| baseFlags |
baseFlags := profileSemaphore = objectMemory nilObject
ifTrue: [0]
ifFalse: [PrimCallCollectsProfileSamples].
self cppIf: #LRPCheck
ifTrue:
[longRunningPrimitiveCheckSemaphore ifNotNil:
[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod]].
(primIndex = PrimNumberVMParameter and: [numArgs = 1]) "vmParameterAt:" ifTrue:
+ [^baseFlags + PrimCallOnSmalltalkStack + PrimCallOnSmalltalkStackAlign2x + PrimCallIsInternalPrim].
- [^baseFlags + PrimCallOnSmalltalkStack + PrimCallIsInternalPrim].
^baseFlags bitOr: ((primitiveMetadataTable at: primIndex) bitAnd: SpurPrimitiveFlagsMask)!
1
0
[OpenSmalltalk/opensmalltalk-vm] 2410b6: CogVM source as per VMMaker.oscog-eem.3147
by Eliot Miranda 06 Feb '22
by Eliot Miranda 06 Feb '22
06 Feb '22
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: 2410b68e8f432b584cbca1ec9eb88b3a43ec4111
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2410b68e8f432b584c…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2022-02-06 (Sun, 06 Feb 2022)
Changed paths:
M platforms/Mac OS/vm/sqMacMain.c
M platforms/iOS/vm/OSX/sqSqueakOSXApplication.m
M platforms/minheadless/common/sqVirtualMachineInterface.c
M platforms/unix/vm/sqUnixMain.c
M platforms/win32/vm/sqWin32Main.c
M src/spur32.cog.lowcode/cogit.h
M src/spur32.cog.lowcode/cointerp.c
M src/spur32.cog.lowcode/cointerp.h
M src/spur32.cog.lowcode/gcc3x-cointerp.c
M src/spur32.cog/cogit.h
M src/spur32.cog/cointerp.c
M src/spur32.cog/cointerp.h
M src/spur32.cog/cointerpmt.c
M src/spur32.cog/cointerpmt.h
M src/spur32.cog/gcc3x-cointerp.c
M src/spur32.cog/gcc3x-cointerpmt.c
M src/spur32.sista/cogit.h
M src/spur32.sista/cointerp.c
M src/spur32.sista/cointerp.h
M src/spur32.sista/gcc3x-cointerp.c
M src/spur32.stack.lowcode/gcc3x-interp.c
M src/spur32.stack.lowcode/interp.c
M src/spur32.stack/gcc3x-interp.c
M src/spur32.stack/interp.c
M src/spur32.stack/validImage.c
M src/spur64.cog.lowcode/cogit.h
M src/spur64.cog.lowcode/cointerp.c
M src/spur64.cog.lowcode/cointerp.h
M src/spur64.cog.lowcode/gcc3x-cointerp.c
M src/spur64.cog/cogit.h
M src/spur64.cog/cointerp.c
M src/spur64.cog/cointerp.h
M src/spur64.cog/cointerpmt.c
M src/spur64.cog/cointerpmt.h
M src/spur64.cog/gcc3x-cointerp.c
M src/spur64.cog/gcc3x-cointerpmt.c
M src/spur64.sista/cogit.h
M src/spur64.sista/cointerp.c
M src/spur64.sista/cointerp.h
M src/spur64.sista/gcc3x-cointerp.c
M src/spur64.stack.lowcode/gcc3x-interp.c
M src/spur64.stack.lowcode/interp.c
M src/spur64.stack/gcc3x-interp.c
M src/spur64.stack/interp.c
M src/spur64.stack/validImage.c
M src/v3.cog/cogit.h
M src/v3.cog/cointerp.c
M src/v3.cog/cointerp.h
M src/v3.cog/gcc3x-cointerp.c
M src/v3.stack/gcc3x-interp.c
M src/v3.stack/interp.c
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.3147
Fix regressions in the stack interpreter generated sources from
VMMaker.oscog-eem.3144, and in primitiveSupend[V2] from
VMMaker.oscog-eem.3142,VMMaker.oscog-eem.3134,VMMaker.oscog-eem.3127.
Include the processor in the version output information, so
[Production Spur 64-bit VM] => [Production Spur 64-bit x64 VM]
1
0
All white screen on Arm 32 with commit 71ffd3fc0eb74519e2ddd8ea4de87503e925fa16
by Bruce O'Neel 06 Feb '22
by Bruce O'Neel 06 Feb '22
06 Feb '22
Hi all,
The commit below causes an all white screen on 32 bit Squeak. Well
at least Arm 32.
Thanks.
bruce
CogVM source as per Name: VMMaker.oscog-eem.3144
Spur CoInterpreter: harmonize named and numbered primitive Spur primitive
property flags. Use a common pragma, primitiveMetadata:, to mark named
primitives and numbered primitives. Mark several methods with the
PrimCallOnSmalltalkStack (a.k.a. FastCPrimitiveFlag) flag, especially
BoxedFloat, SmallFloat, and 64-bit LargeInteger primitives in
InterpreterPrimitives. Make sure that vmParameterAt: uses that flag, even
though the other versions of primitive 254 do not.
Nuke support for the old pre-Alien callbacks. Only very old versions of
two plugins use this, and it's easy to upgrade to use Alien callbacks.
(missing from the Monticello commit message)
Spur Cogit: Instead of setting newMethod & primitiveFunctionPointer for all
primitives, only set newMethod & primitiveFunctionPointer on failure (unless
a primitive uses the PrimCallNeedsNewMethod flag). Use a CallRT to invoke
internal primitives if it spans far enough.
2
2
[OpenSmalltalk/opensmalltalk-vm] a29dc4: CogVM sources as per VMMaker.oscog-eem.3146
by Eliot Miranda 06 Feb '22
by Eliot Miranda 06 Feb '22
06 Feb '22
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: a29dc4bea18c728d40f8b16dfe879642d0410d91
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/a29dc4bea18c728d40…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2022-02-06 (Sun, 06 Feb 2022)
Changed paths:
M src/spur32.cog.lowcode/cogit.h
M src/spur32.cog.lowcode/cointerp.c
M src/spur32.cog.lowcode/cointerp.h
M src/spur32.cog.lowcode/gcc3x-cointerp.c
M src/spur32.cog/cogit.h
M src/spur32.cog/cointerp.c
M src/spur32.cog/cointerp.h
M src/spur32.cog/cointerpmt.c
M src/spur32.cog/cointerpmt.h
M src/spur32.cog/gcc3x-cointerp.c
M src/spur32.cog/gcc3x-cointerpmt.c
M src/spur32.sista/cogit.h
M src/spur32.sista/cointerp.c
M src/spur32.sista/cointerp.h
M src/spur32.sista/gcc3x-cointerp.c
M src/spur32.stack.lowcode/gcc3x-interp.c
M src/spur32.stack.lowcode/interp.c
M src/spur32.stack/gcc3x-interp.c
M src/spur32.stack/interp.c
M src/spur32.stack/validImage.c
M src/spur64.cog.lowcode/cogit.h
M src/spur64.cog.lowcode/cointerp.c
M src/spur64.cog.lowcode/cointerp.h
M src/spur64.cog.lowcode/gcc3x-cointerp.c
M src/spur64.cog/cogit.h
M src/spur64.cog/cointerp.c
M src/spur64.cog/cointerp.h
M src/spur64.cog/cointerpmt.c
M src/spur64.cog/cointerpmt.h
M src/spur64.cog/gcc3x-cointerp.c
M src/spur64.cog/gcc3x-cointerpmt.c
M src/spur64.sista/cogit.h
M src/spur64.sista/cointerp.c
M src/spur64.sista/cointerp.h
M src/spur64.sista/gcc3x-cointerp.c
M src/spur64.stack.lowcode/gcc3x-interp.c
M src/spur64.stack.lowcode/interp.c
M src/spur64.stack/gcc3x-interp.c
M src/spur64.stack/interp.c
M src/spur64.stack/validImage.c
M src/v3.cog/cogit.h
M src/v3.cog/cointerp.c
M src/v3.cog/cointerp.h
M src/v3.cog/gcc3x-cointerp.c
M src/v3.stack/gcc3x-interp.c
M src/v3.stack/interp.c
Log Message:
-----------
CogVM sources as per VMMaker.oscog-eem.3146
InterpreterPrimitives: fix the 64-bit large integer support on 32-bit platforms.
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3146.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3146
Author: eem
Time: 6 February 2022, 10:39:32.817152 am
UUID: 56a45acd-d113-4fea-9a49-4397e8bd260f
Ancestors: VMMaker.oscog-eem.3145
InterpreterPrimitives: fix the 64-bit large integer support on 32-bit platforms.
=============== Diff against VMMaker.oscog-eem.3145 ===============
Item was changed:
----- Method: InterpreterPrimitives>>magnitude64BitIntegerFor:neg: (in category 'primitive support') -----
magnitude64BitIntegerFor: magnitude neg: isNegative
"Return a Large Integer object for the given integer magnitude and sign"
| newLargeInteger largeClassIndex highWord sz isSmall smallVal |
<var: 'magnitude' type: #usqLong>
<var: 'highWord' type: #usqInt>
isSmall := isNegative
ifTrue: [magnitude <= (objectMemory maxSmallInteger + 1)]
ifFalse: [magnitude <= objectMemory maxSmallInteger].
isSmall ifTrue:
[smallVal := self cCoerceSimple: magnitude to: #sqInt.
isNegative ifTrue: [smallVal := 0 - smallVal].
^objectMemory integerObjectOf: smallVal].
largeClassIndex := isNegative
ifTrue: [ClassLargeNegativeIntegerCompactIndex]
ifFalse: [ClassLargePositiveIntegerCompactIndex].
objectMemory wordSize = 8
ifTrue: [sz := 8]
ifFalse:
[(highWord := magnitude >> 32) = 0
ifTrue: [sz := 4]
ifFalse:
[sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse: [sz := sz + 1]]]]].
newLargeInteger := objectMemory
eeInstantiateSmallClassIndex: largeClassIndex
format: (objectMemory byteFormatForNumBytes: sz)
+ numBytes: sz.
- numSlots: sz / objectMemory bytesPerOop.
SPURVM
ifTrue:
["Memory is eight byte aligned in SPUR, so we are sure to have room for 64bits word whatever allocated sz"
objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
ifFalse:
[sz > 4
ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: magnitude)]].
^newLargeInteger!
Item was added:
+ ----- Method: NewObjectMemory>>eeInstantiateSmallClassIndex:format:numBytes: (in category 'interpreter access') -----
+ eeInstantiateSmallClassIndex: compactClassIndex format: objFormat numBytes: numBytes
+ "This version of instantiateClass assumes that the total object size is under
+ 256 bytes, the limit for objects with only one or two header words.
+ NOTE this code will only work for sizes that are an integral number of words
+ (hence not a 32-bit LargeInteger in a 64-bit system).
+ Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak.
+ Since this call is used in routines that do just that we are safe. Break this rule and die in GC.
+ Will *not* cause a GC. Result is guaranteed to be young."
+
+ | sizeInBytes hash header1 |
+ "cannot have a negative indexable field count"
+ self assert: (numBytes >= 0 and: [compactClassIndex ~= 0]).
+ self assert: (objFormat < self firstByteFormat
+ ifTrue: [objFormat]
+ ifFalse: [objFormat bitAnd: self byteFormatMask])
+ = (self instSpecOfClass: (self compactClassAt: compactClassIndex)).
+ sizeInBytes := numBytes << self shiftForWord + self baseHeaderSize.
+ self assert: sizeInBytes <= 252.
+ hash := self newObjectHash.
+ header1 := (objFormat << self instFormatFieldLSB
+ bitOr: compactClassIndex << 12)
+ bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
+ header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)).
+ ^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: 0 h3: 0!
Item was added:
+ ----- Method: SpurMemoryManager>>eeInstantiateSmallClassIndex:format:numBytes: (in category 'instantiation') -----
+ eeInstantiateSmallClassIndex: knownClassIndex format: objFormat numBytes: numBytes
+ "Instantiate a small instance of a compact class. ee stands for execution engine and
+ implies that this allocation will *NOT* cause a GC. small implies the object will have
+ less than 255 slots. N.B. the instantiated object IS NOT FILLED and must be completed
+ before returning it to Smalltalk. Since this call is used in routines that do just that we
+ are safe. Break this rule and die in GC. Result is guaranteed to be young."
+ <inline: true>
+ self assert: (numBytes >= 0 and: [knownClassIndex ~= 0 and: [(self knownClassAtIndex: knownClassIndex) ~= nilObj]]).
+ self assert: (objFormat < self firstByteFormat
+ ifTrue: [objFormat]
+ ifFalse: [objFormat bitAnd: self byteFormatMask])
+ = (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)).
+ ^self allocateSmallNewSpaceSlots: numBytes + self wordSize - 1 // self wordSize format: objFormat classIndex: knownClassIndex!
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3145.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3145
Author: eem
Time: 6 February 2022, 9:56:10.40233 am
UUID: 7a77008d-0c1a-4bcc-8595-0ff2f95dd334
Ancestors: VMMaker.oscog-eem.3144
Simulator: complete simulation of frexp(3); thanks Nicolas!
The previous commit should have mentioned that support for pre-Alien callbacks has been dropped.
=============== Diff against VMMaker.oscog-eem.3144 ===============
Item was changed:
----- Method: InterpreterPrimitives>>frexp:_: (in category 'primitive support') -----
frexp: aFloat _: eptr
"Simulate the C library frexp(3) function."
<doNotGenerate>
+ | exponent |
+ exponent := aFloat exponent.
+ eptr at: 0 put: exponent.
+ ^aFloat timesTwoPower: -1 - exponent "a.k.a. aFloat significand / 2"!
- eptr at: 0 put: aFloat exponent.
- ^nil "result unused..."!
1
0
[OpenSmalltalk/opensmalltalk-vm] 71ffd3: CogVM source as per Name: VMMaker.oscog-eem.3144
by Eliot Miranda 06 Feb '22
by Eliot Miranda 06 Feb '22
06 Feb '22
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: 71ffd3fc0eb74519e2ddd8ea4de87503e925fa16
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/71ffd3fc0eb74519e2…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2022-02-05 (Sat, 05 Feb 2022)
Changed paths:
M src/plugins/B2DPlugin/B2DPlugin.c
M src/plugins/DESPlugin/DESPlugin.c
M src/plugins/DSAPrims/DSAPrims.c
M src/plugins/MD5Plugin/MD5Plugin.c
M src/plugins/SHA2Plugin/SHA2Plugin.c
M src/spur32.cog.lowcode/cogit.h
M src/spur32.cog.lowcode/cogitARMv5.c
M src/spur32.cog.lowcode/cogitIA32.c
M src/spur32.cog.lowcode/cointerp.c
M src/spur32.cog.lowcode/cointerp.h
M src/spur32.cog.lowcode/gcc3x-cointerp.c
M src/spur32.cog/cogit.h
M src/spur32.cog/cogitARMv5.c
M src/spur32.cog/cogitIA32.c
M src/spur32.cog/cointerp.c
M src/spur32.cog/cointerp.h
M src/spur32.cog/cointerpmt.c
M src/spur32.cog/cointerpmt.h
M src/spur32.cog/gcc3x-cointerp.c
M src/spur32.cog/gcc3x-cointerpmt.c
M src/spur32.sista/cogit.h
M src/spur32.sista/cogitARMv5.c
M src/spur32.sista/cogitIA32.c
M src/spur32.sista/cointerp.c
M src/spur32.sista/cointerp.h
M src/spur32.sista/gcc3x-cointerp.c
M src/spur32.stack.lowcode/gcc3x-interp.c
M src/spur32.stack.lowcode/interp.c
M src/spur32.stack/gcc3x-interp.c
M src/spur32.stack/interp.c
M src/spur32.stack/validImage.c
M src/spur64.cog.lowcode/cogit.h
M src/spur64.cog.lowcode/cogitARMv8.c
M src/spur64.cog.lowcode/cogitX64SysV.c
M src/spur64.cog.lowcode/cogitX64WIN64.c
M src/spur64.cog.lowcode/cointerp.c
M src/spur64.cog.lowcode/cointerp.h
M src/spur64.cog.lowcode/gcc3x-cointerp.c
M src/spur64.cog/cogit.h
M src/spur64.cog/cogitARMv8.c
M src/spur64.cog/cogitX64SysV.c
M src/spur64.cog/cogitX64WIN64.c
M src/spur64.cog/cointerp.c
M src/spur64.cog/cointerp.h
M src/spur64.cog/cointerpmt.c
M src/spur64.cog/cointerpmt.h
M src/spur64.cog/gcc3x-cointerp.c
M src/spur64.cog/gcc3x-cointerpmt.c
M src/spur64.sista/cogit.h
M src/spur64.sista/cogitARMv8.c
M src/spur64.sista/cogitX64SysV.c
M src/spur64.sista/cogitX64WIN64.c
M src/spur64.sista/cointerp.c
M src/spur64.sista/cointerp.h
M src/spur64.sista/gcc3x-cointerp.c
M src/spur64.stack.lowcode/gcc3x-interp.c
M src/spur64.stack.lowcode/interp.c
M src/spur64.stack/gcc3x-interp.c
M src/spur64.stack/interp.c
M src/spur64.stack/validImage.c
M src/v3.cog/cogit.h
M src/v3.cog/cogitARMv5.c
M src/v3.cog/cogitIA32.c
M src/v3.cog/cointerp.c
M src/v3.cog/cointerp.h
M src/v3.cog/gcc3x-cointerp.c
M src/v3.stack/gcc3x-interp.c
M src/v3.stack/interp.c
Log Message:
-----------
CogVM source as per Name: VMMaker.oscog-eem.3144
Spur CoInterpreter: harmonize named and numbered primitive Spur primitive
property flags. Use a common pragma, primitiveMetadata:, to mark named
primitives and numbered primitives. Mark several methods with the
PrimCallOnSmalltalkStack (a.k.a. FastCPrimitiveFlag) flag, especially
BoxedFloat, SmallFloat, and 64-bit LargeInteger primitives in
InterpreterPrimitives. Make sure that vmParameterAt: uses that flag, even
though the other versions of primitive 254 do not.
Nuke support for the old pre-Alien callbacks. Only very old versions of
two plugins use this, and it's easy to upgrade to use Alien callbacks.
(missing from the Monticello commit message)
Spur Cogit: Instead of setting newMethod & primitiveFunctionPointer for all
primitives, only set newMethod & primitiveFunctionPointer on failure (unless
a primitive uses the PrimCallNeedsNewMethod flag). Use a CallRT to invoke
internal primitives if it spans far enough.
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3144.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3144
Author: eem
Time: 5 February 2022, 11:15:53.618518 pm
UUID: 37de7fbf-c56f-4ea3-bdf1-23cef3bb9631
Ancestors: VMMaker.oscog-eem.3143
Spur CoInterpreter: harmonize named and numbered primitive Spur primitive property flags. Use a common pragma, primitiveMetadata:, to mark named primitives and numbered primitives. Mark several methods with the PrimCallOnSmalltalkStack (a.k.a. FastCPrimitiveFlag) flag, especially BoxedFloat, SmallFloat, and 64-bit LargeInteger primitives in InterpreterPrimitives. Make sure that vmParameterAt: uses that flag, even though the other versions of primitive 254 do not.
Spur Cogit: Instead of setting newMethod & primitiveFunctionPointer for all primitives, only set newMethod & primitiveFunctionPointer on failure (unless a primitive uses the PrimCallNeedsNewMethod flag). Use a CallRT to invoke internal primitives if it spans far enough.
Simulation: implement frexp:_: et al as doNotGenerate, aqvoiding cCode:inSmalltalk: bifurcation.
Measurement: provide CogClass class>>{externalCallNoOp,fastCNoOp,fastCNoOpAlignedForFloats} to compare performance.
=============== Diff against VMMaker.oscog-eem.3143 ===============
Item was changed:
----- Method: BalloonEngineBase>>primitiveAbortProcessing (in category 'primitives-other') -----
primitiveAbortProcessing
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
| failureCode |
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
self statePut: GEStateCompleted.
+ self storeEngineStateInto: engine!
- self storeEngineStateInto: engine.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveAddActiveEdgeEntry (in category 'primitives-incremental') -----
primitiveAddActiveEdgeEntry
"Note: No need to load either bitBlt or spanBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode edgeOop edge |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateWaitingForEdge) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
edgeOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
edge := self loadEdgeStateFrom: edgeOop.
edge = nil ifTrue:[^interpreterProxy primitiveFailFor: GEFEdgeDataTooSmall].
(self needAvailableSpace: 1)
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
(self edgeNumLinesOf: edge) > 0 ifTrue:[
self insertEdgeIntoAET: edge.
].
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
self statePut: GEStateAddingFromGET. "Back to adding edges from GET"
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"
doProfileStats ifTrue:[
self incrementStat: GWCountAddAETEntry by: 1.
+ self incrementStat: GWTimeAddAETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
- self incrementStat: GWTimeAddAETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)].
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveChangedActiveEdgeEntry (in category 'primitives-incremental') -----
primitiveChangedActiveEdgeEntry
"Note: No need to load either bitBlt or spanBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode edgeOop edge |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateWaitingChange) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
edgeOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
edge := self loadEdgeStateFrom: edgeOop.
edge = nil ifTrue:[^interpreterProxy primitiveFailFor: GEFEdgeDataTooSmall].
(self edgeNumLinesOf: edge) = 0
ifTrue:[ self removeFirstAETEntry]
ifFalse:[ self resortFirstAETEntry.
self aetStartPut: self aetStartGet + 1].
self statePut: GEStateUpdateEdges. "Back to updating edges"
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"
doProfileStats ifTrue:[
self incrementStat: GWCountChangeAETEntry by: 1.
+ self incrementStat: GWTimeChangeAETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
- self incrementStat: GWTimeChangeAETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)].
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveCopyBuffer (in category 'primitives-other') -----
primitiveCopyBuffer
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failCode buf1 buf2 diff src dst |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
<var: 'src' type: #'int *'>
<var: 'dst' type: #'int *'>
interpreterProxy methodArgumentCount = 2
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
buf2 := interpreterProxy stackValue: 0.
buf1 := interpreterProxy stackValue: 1.
"Make sure the old buffer is properly initialized"
(failCode := self loadWorkBufferFrom: buf1) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failCode].
"Make sure the buffers are of the same type"
(interpreterProxy fetchClassOf: buf1) = (interpreterProxy fetchClassOf: buf2)
ifFalse:[^interpreterProxy primitiveFailFor: GEFClassMismatch].
"Make sure buf2 is at least of the size of buf1"
diff := (interpreterProxy slotSizeOf: buf2) - (interpreterProxy slotSizeOf: buf1).
diff < 0 ifTrue:[^interpreterProxy primitiveFailFor: GEFSizeMismatch].
"Okay - ready for copying. First of all just copy the contents up to wbTop"
src := workBuffer.
dst := interpreterProxy firstIndexableField: buf2.
0 to: self wbTopGet-1 do:[:i|
dst at: i put: (src at: i).
].
"Adjust wbSize and wbTop in the new buffer"
dst at: GWBufferTop put: self wbTopGet + diff.
dst at: GWSize put: self wbSizeGet + diff.
"Now copy the entries from wbTop to wbSize"
src := src + self wbTopGet.
dst := dst + self wbTopGet + diff.
0 to: (self wbSizeGet - self wbTopGet - 1) do:[:i|
dst at: i put: (src at: i).
].
"Okay, done. Check the new buffer by loading the state from it"
(failCode := self loadWorkBufferFrom: buf2) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failCode].
+ interpreterProxy pop: 2. "Leave rcvr on stack"!
- interpreterProxy pop: 2. "Leave rcvr on stack"
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveDoProfileStats (in category 'primitives-other') -----
primitiveDoProfileStats
"Turn on/off profiling. Return the old value of the flag."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| oldValue newValue |
- <inline: false>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
oldValue := doProfileStats.
newValue := interpreterProxy stackObjectValue: 0.
newValue := interpreterProxy booleanValueOf: newValue.
interpreterProxy failed ifFalse:[
doProfileStats := newValue.
interpreterProxy pop: 2. "Pop rcvr, arg"
interpreterProxy pushBool: oldValue.
+ ]!
- ].!
Item was changed:
----- Method: BalloonEngineBase>>primitiveFinishedProcessing (in category 'primitives-other') -----
primitiveFinishedProcessing
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| finished failureCode |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
finished := self finishedProcessing.
self storeEngineStateInto: engine.
interpreterProxy pop: 1.
interpreterProxy pushBool: finished.
doProfileStats ifTrue:[
self incrementStat: GWCountFinishTest by: 1.
+ self incrementStat: GWTimeFinishTest by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
- self incrementStat: GWTimeFinishTest by: (interpreterProxy ioMicroMSecs - geProfileTime)].
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetAALevel (in category 'primitives-access') -----
primitiveGetAALevel
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
| failureCode |
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
interpreterProxy pop: 1.
+ interpreterProxy pushInteger: self aaLevelGet!
- interpreterProxy pushInteger: self aaLevelGet.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetClipRect (in category 'primitives-access') -----
primitiveGetClipRect
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode rectOop pointOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
rectOop := interpreterProxy stackObjectValue: 0.
(interpreterProxy failed not
and: [(interpreterProxy isPointers: rectOop)
and: [(interpreterProxy slotSizeOf: rectOop) >= 2]])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
interpreterProxy pushRemappableOop: rectOop.
pointOop := interpreterProxy makePointwithxValue: self clipMinXGet yValue: self clipMinYGet.
interpreterProxy storePointer: 0 ofObject: interpreterProxy topRemappableOop withValue: pointOop.
pointOop := interpreterProxy makePointwithxValue: self clipMaxXGet yValue: self clipMaxYGet.
rectOop := interpreterProxy popRemappableOop.
interpreterProxy storePointer: 1 ofObject: rectOop withValue: pointOop.
+ interpreterProxy pop: 2 thenPush: rectOop!
- interpreterProxy pop: 2 thenPush: rectOop.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetCounts (in category 'primitives-access') -----
primitiveGetCounts
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode statOop stats |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
<var: 'stats' type: #'int *'>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
statOop := interpreterProxy stackObjectValue: 0.
(interpreterProxy failed not
and: [(interpreterProxy isWords: statOop)
and: [(interpreterProxy slotSizeOf: statOop) >= 9]])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
stats := interpreterProxy firstIndexableField: statOop.
stats at: 0 put: (stats at: 0) + (workBuffer at: GWCountInitializing).
stats at: 1 put: (stats at: 1) + (workBuffer at: GWCountFinishTest).
stats at: 2 put: (stats at: 2) + (workBuffer at: GWCountNextGETEntry).
stats at: 3 put: (stats at: 3) + (workBuffer at: GWCountAddAETEntry).
stats at: 4 put: (stats at: 4) + (workBuffer at: GWCountNextFillEntry).
stats at: 5 put: (stats at: 5) + (workBuffer at: GWCountMergeFill).
stats at: 6 put: (stats at: 6) + (workBuffer at: GWCountDisplaySpan).
stats at: 7 put: (stats at: 7) + (workBuffer at: GWCountNextAETEntry).
stats at: 8 put: (stats at: 8) + (workBuffer at: GWCountChangeAETEntry).
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetDepth (in category 'primitives-access') -----
primitiveGetDepth
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
| failureCode |
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
interpreterProxy pop: 1.
+ interpreterProxy pushInteger: self currentZGet!
- interpreterProxy pushInteger: self currentZGet.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetFailureReason (in category 'primitives-access') -----
primitiveGetFailureReason
"Return the reason why the last operation failed."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
| failCode |
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
engine := interpreterProxy stackValue: 0.
"Note -- don't call loadEngineFrom here because this will override the stopReason with Zero"
(interpreterProxy isImmediate: engine) ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineIsInteger].
(interpreterProxy isPointers: engine) ifFalse:[^interpreterProxy primitiveFailFor: GEFEngineIsWords].
(interpreterProxy slotSizeOf: engine) < BEBalloonEngineSize ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineTooSmall].
(failCode := self loadWorkBufferFrom:
(interpreterProxy fetchPointer: BEWorkBufferIndex ofObject: engine)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failCode].
interpreterProxy pop: 1.
+ interpreterProxy pushInteger: self stopReasonGet!
- interpreterProxy pushInteger: self stopReasonGet.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetOffset (in category 'primitives-access') -----
primitiveGetOffset
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode pointOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
pointOop := interpreterProxy makePointwithxValue: self destOffsetXGet yValue: self destOffsetYGet.
+ interpreterProxy pop: 1 thenPush: pointOop!
- interpreterProxy pop: 1 thenPush: pointOop.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetTimes (in category 'primitives-access') -----
primitiveGetTimes
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode statOop stats |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
<var: 'stats' type: #'int *'>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
statOop := interpreterProxy stackObjectValue: 0.
(interpreterProxy failed not
and: [(interpreterProxy isWords: statOop)
and: [(interpreterProxy slotSizeOf: statOop) >= 9]])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
stats := interpreterProxy firstIndexableField: statOop.
stats at: 0 put: (stats at: 0) + (workBuffer at: GWTimeInitializing).
stats at: 1 put: (stats at: 1) + (workBuffer at: GWTimeFinishTest).
stats at: 2 put: (stats at: 2) + (workBuffer at: GWTimeNextGETEntry).
stats at: 3 put: (stats at: 3) + (workBuffer at: GWTimeAddAETEntry).
stats at: 4 put: (stats at: 4) + (workBuffer at: GWTimeNextFillEntry).
stats at: 5 put: (stats at: 5) + (workBuffer at: GWTimeMergeFill).
stats at: 6 put: (stats at: 6) + (workBuffer at: GWTimeDisplaySpan).
stats at: 7 put: (stats at: 7) + (workBuffer at: GWTimeNextAETEntry).
stats at: 8 put: (stats at: 8) + (workBuffer at: GWTimeChangeAETEntry).
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveInitializeBuffer (in category 'primitives-other') -----
primitiveInitializeBuffer
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| wbOop size |
(interpreterProxy methodArgumentCount = 1
and: [(interpreterProxy isWords: (wbOop := interpreterProxy stackValue: 0))
and: [(size := interpreterProxy slotSizeOf: wbOop) >= GWMinimalSize]]) ifFalse:
[^interpreterProxy primitiveFail].
self workBufferPut: wbOop.
objBuffer := workBuffer + GWHeaderSize.
self magicNumberPut: GWMagicNumber.
self wbSizePut: size.
self wbTopPut: size.
self statePut: GEStateUnlocked.
self objStartPut: GWHeaderSize.
self objUsedPut: 4. "Dummy fill object"
self objectTypeOf: 0 put: GEPrimitiveFill.
self objectLengthOf: 0 put: 4.
self objectIndexOf: 0 put: 0.
self getStartPut: 0.
self getUsedPut: 0.
self aetStartPut: 0.
self aetUsedPut: 0.
self stopReasonPut: 0.
self needsFlushPut: 0.
self clipMinXPut: 0.
self clipMaxXPut: 0.
self clipMinYPut: 0.
self clipMaxYPut: 0.
self currentZPut: 0.
self resetGraphicsEngineStats.
self initEdgeTransform.
self initColorTransform.
interpreterProxy pop: 2 thenPush: wbOop!
Item was changed:
----- Method: BalloonEngineBase>>primitiveInitializeProcessing (in category 'primitives-incremental') -----
primitiveInitializeProcessing
"Note: No need to load bitBlt but must load spanBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
| failureCode |
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"Load span buffer for clear operation"
(failureCode := self loadSpanBufferFrom:
(interpreterProxy fetchPointer: BESpanIndex ofObject: engine)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
self initializeGETProcessing.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
self statePut: GEStateAddingFromGET. "Initialized"
interpreterProxy failed ifFalse:[self storeEngineStateInto: engine].
doProfileStats ifTrue:[
self incrementStat: GWCountInitializing by: 1.
+ self incrementStat: GWTimeInitializing by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
- self incrementStat: GWTimeInitializing by: (interpreterProxy ioMicroMSecs - geProfileTime)].
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveMergeFillFrom (in category 'primitives-incremental') -----
primitiveMergeFillFrom
"Note: No need to load bitBlt but must load spanBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode fillOop bitsOop value |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 2
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 2)
requiredState: GEStateWaitingForFill) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"Load span buffer for merging the fill"
(failureCode := self loadSpanBufferFrom:
(interpreterProxy fetchPointer: BESpanIndex ofObject: engine)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
fillOop := interpreterProxy stackObjectValue: 0.
bitsOop := interpreterProxy stackObjectValue: 1.
"Check bitmap"
(interpreterProxy failed not
and: [(interpreterProxy fetchClassOf: bitsOop) = interpreterProxy classBitmap])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
"Check fillOop"
(interpreterProxy slotSizeOf: fillOop) < FTBalloonFillDataSize
ifTrue:[^interpreterProxy primitiveFailFor: GEFFillDataTooSmall].
"Check if this was the fill we have exported"
value := interpreterProxy fetchInteger: FTIndexIndex ofObject: fillOop.
(self objectIndexOf: self lastExportedFillGet) = value
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
value := interpreterProxy fetchInteger: FTMinXIndex ofObject: fillOop.
self lastExportedLeftXGet = value
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
value := interpreterProxy fetchInteger: FTMaxXIndex ofObject: fillOop.
self lastExportedRightXGet = value
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
(interpreterProxy slotSizeOf: bitsOop) < (self lastExportedRightXGet - self lastExportedLeftXGet)
ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
interpreterProxy failed ifTrue:[^nil].
self fillBitmapSpan: (interpreterProxy firstIndexableField: bitsOop)
from: self lastExportedLeftXGet
to: self lastExportedRightXGet.
self statePut: GEStateScanningAET. "Back to scanning AET"
self storeEngineStateInto: engine.
interpreterProxy pop: 2. "Leave rcvr on stack"
doProfileStats ifTrue:[
self incrementStat: GWCountMergeFill by: 1.
+ self incrementStat: GWTimeMergeFill by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
- self incrementStat: GWTimeMergeFill by: (interpreterProxy ioMicroMSecs - geProfileTime)].
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveNeedsFlush (in category 'primitives-access') -----
primitiveNeedsFlush
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode needFlush |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
needFlush := self needsFlush.
self storeEngineStateInto: engine.
interpreterProxy pop: 1.
+ interpreterProxy pushBool: needFlush!
- interpreterProxy pushBool: needFlush.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveNeedsFlushPut (in category 'primitives-access') -----
primitiveNeedsFlushPut
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode needFlush |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
needFlush := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
needFlush == true
ifTrue:[self needsFlushPut: 1]
ifFalse:[self needsFlushPut: 0].
self storeEngineStateInto: engine.
+ interpreterProxy pop: 1. "Leave rcvr on stack"!
- interpreterProxy pop: 1. "Leave rcvr on stack"
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveNextActiveEdgeEntry (in category 'primitives-incremental') -----
primitiveNextActiveEdgeEntry
"Note: No need to load either bitBlt or spanBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode edgeOop hasEdge edge |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUpdateEdges or: GEStateCompleted) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
edgeOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
hasEdge := false.
self stateGet = GEStateCompleted ifFalse:[
hasEdge := self findNextExternalUpdateFromAET.
hasEdge ifTrue:[
edge := aetBuffer at: self aetStartGet.
self storeEdgeStateFrom: edge into: edgeOop.
"Do not advance to the next aet entry yet"
"self aetStartPut: self aetStartGet + 1."
self statePut: GEStateWaitingChange. "Wait for changed edge"
] ifFalse:[self statePut: GEStateAddingFromGET]. "Start over"
].
interpreterProxy failed ifTrue:[^nil].
self storeEngineStateInto: engine.
interpreterProxy pop: 2.
interpreterProxy pushBool: hasEdge not.
doProfileStats ifTrue:[
self incrementStat: GWCountNextAETEntry by: 1.
+ self incrementStat: GWTimeNextAETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
- self incrementStat: GWTimeNextAETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)].
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveNextFillEntry (in category 'primitives-incremental') -----
primitiveNextFillEntry
"Note: No need to load bitBlt but must load spanBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode fillOop hasFill |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateScanningAET) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"Load span buffer for internal handling of fills"
(failureCode := self loadSpanBufferFrom:
(interpreterProxy fetchPointer: BESpanIndex ofObject: engine)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
(self loadFormsFrom:
(interpreterProxy fetchPointer: BEFormsIndex ofObject: engine))
ifFalse:[^interpreterProxy primitiveFailFor: GEFFormLoadFailed].
"Check if we have to clear the span buffer before proceeding"
(self clearSpanBufferGet = 0) ifFalse:[
(self currentYGet bitAnd: self aaScanMaskGet) = 0
ifTrue:[self clearSpanBuffer].
self clearSpanBufferPut: 0].
fillOop := interpreterProxy stackObjectValue: 0.
hasFill := self findNextExternalFillFromAET.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
hasFill ifTrue:[self storeFillStateInto: fillOop].
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFWrongFill].
hasFill
ifTrue:[ self statePut: GEStateWaitingForFill]
ifFalse:[ self wbStackClear.
self spanEndAAPut: 0.
self statePut: GEStateBlitBuffer].
self storeEngineStateInto: engine.
interpreterProxy pop: 2.
interpreterProxy pushBool: hasFill not.
doProfileStats ifTrue:[
self incrementStat: GWCountNextFillEntry by: 1.
self incrementStat: GWTimeNextFillEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
Item was changed:
----- Method: BalloonEngineBase>>primitiveNextGlobalEdgeEntry (in category 'primitives-incremental') -----
primitiveNextGlobalEdgeEntry
"Note: No need to load either bitBlt or spanBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode edgeOop hasEdge edge |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateAddingFromGET) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
edgeOop := interpreterProxy stackObjectValue: 0.
hasEdge := self findNextExternalEntryFromGET.
hasEdge ifTrue:[
edge := getBuffer at: self getStartGet.
self storeEdgeStateFrom: edge into: edgeOop.
self getStartPut: self getStartGet + 1].
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFWrongEdge].
hasEdge
ifTrue:[ self statePut: GEStateWaitingForEdge] "Wait for adding edges"
ifFalse:[ "Start scanning the AET"
self statePut: GEStateScanningAET.
self clearSpanBufferPut: 1. "Clear span buffer at next entry"
self aetStartPut: 0.
self wbStackClear].
self storeEngineStateInto: engine.
interpreterProxy pop: 2.
interpreterProxy pushBool: hasEdge not.
doProfileStats ifTrue:[
self incrementStat: GWCountNextGETEntry by: 1.
+ self incrementStat: GWTimeNextGETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)]!
- self incrementStat: GWTimeNextGETEntry by: (interpreterProxy ioMicroMSecs - geProfileTime)].
- !
Item was changed:
----- Method: BalloonEngineBase>>primitiveRegisterExternalEdge (in category 'primitives-other') -----
primitiveRegisterExternalEdge
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode rightFillIndex leftFillIndex initialZ initialY initialX index edge |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 6
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 6)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
rightFillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
leftFillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
initialZ := interpreterProxy stackIntegerValue: 2.
initialY := interpreterProxy stackIntegerValue: 3.
initialX := interpreterProxy stackIntegerValue: 4.
index := interpreterProxy stackIntegerValue: 5.
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self allocateObjEntry: GEBaseEdgeSize)
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
"Make sure the fills are okay"
((self isFillOkay: leftFillIndex)
and: [self isFillOkay: rightFillIndex])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
edge := objUsed.
objUsed := edge + GEBaseEdgeSize.
"Install type and length"
self objectTypeOf: edge put: GEPrimitiveEdge.
self objectLengthOf: edge put: GEBaseEdgeSize.
self objectIndexOf: edge put: index.
"Install remaining stuff"
self edgeXValueOf: edge put: initialX.
self edgeYValueOf: edge put: initialY.
self edgeZValueOf: edge put: initialZ.
self edgeLeftFillOf: edge put: (self transformColor: leftFillIndex).
self edgeRightFillOf: edge put: (self transformColor: rightFillIndex).
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed ifFalse:[
self storeEngineStateInto: engine.
interpreterProxy pop: 6. "Leave rcvr on stack"
+ ]!
- ].!
Item was changed:
----- Method: BalloonEngineBase>>primitiveRegisterExternalFill (in category 'primitives-other') -----
primitiveRegisterExternalFill
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode index fill |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
index := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
"Note: We *must* not allocate any fill with index 0"
fill := 0.
[fill = 0] whileTrue:[
(self allocateObjEntry: GEBaseEdgeSize)
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
fill := objUsed.
objUsed := fill + GEBaseFillSize.
"Install type and length"
self objectTypeOf: fill put: GEPrimitiveFill.
self objectLengthOf: fill put: GEBaseFillSize.
self objectIndexOf: fill put: index.
].
interpreterProxy failed ifFalse:[
self storeEngineStateInto: engine.
interpreterProxy pop: 2.
interpreterProxy pushInteger: fill.
+ ]!
- ].!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetAALevel (in category 'primitives-access') -----
primitiveSetAALevel
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode level |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
level := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self setAALevel: level.
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetBitBltPlugin (in category 'primitives-access') -----
primitiveSetBitBltPlugin
"Primitive. Set the BitBlt plugin to use."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| pluginName length ptr needReload |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
<var: 'ptr' type: #'char *'>
pluginName := interpreterProxy stackValue: 0.
"Must be string to work"
(interpreterProxy isBytes: pluginName)
ifFalse:[^interpreterProxy primitiveFail].
length := interpreterProxy byteSizeOf: pluginName.
length >= 256
ifTrue:[^interpreterProxy primitiveFail].
ptr := interpreterProxy firstIndexableField: pluginName.
needReload := false.
0 to: length-1 do:[:i|
"Compare and store the plugin to be used"
(bbPluginName at: i) = (ptr at: i) ifFalse:[
bbPluginName at: i put: (ptr at: i).
needReload := true]].
(bbPluginName at: length) = 0 ifFalse:[
bbPluginName at: length put: 0.
needReload := true].
needReload ifTrue:[
self initialiseModule
ifFalse:[^interpreterProxy primitiveFail]].
interpreterProxy pop: 1. "Return receiver"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetClipRect (in category 'primitives-access') -----
primitiveSetClipRect
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode rectOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
rectOop := interpreterProxy stackObjectValue: 0.
(interpreterProxy failed not
and: [(interpreterProxy isPointers: rectOop)
and: [(interpreterProxy slotSizeOf: rectOop) >= 2]])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self loadPoint: self point1Get from: (interpreterProxy fetchPointer: 0 ofObject: rectOop).
self loadPoint: self point2Get from: (interpreterProxy fetchPointer: 1 ofObject: rectOop).
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self clipMinXPut: (self point1Get at: 0).
self clipMinYPut: (self point1Get at: 1).
self clipMaxXPut: (self point2Get at: 0).
self clipMaxYPut: (self point2Get at: 1).
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetColorTransform (in category 'primitives-access') -----
primitiveSetColorTransform
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode transformOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
transformOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed
ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self loadColorTransformFrom: transformOop.
interpreterProxy failed
ifTrue: [^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetDepth (in category 'primitives-access') -----
primitiveSetDepth
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode depth |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
depth := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self currentZPut: depth.
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetEdgeTransform (in category 'primitives-access') -----
primitiveSetEdgeTransform
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode transformOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
transformOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self loadEdgeTransformFrom: transformOop.
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetOffset (in category 'primitives-access') -----
primitiveSetOffset
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode pointOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
pointOop := interpreterProxy stackValue: 0.
(interpreterProxy fetchClassOf: pointOop) = interpreterProxy classPoint
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self loadPoint: self point1Get from: pointOop.
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self destOffsetXPut: (self point1Get at: 0).
self destOffsetYPut: (self point1Get at: 1).
self storeEngineStateInto: engine.
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddBezier (in category 'primitives') -----
primitiveAddBezier
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode leftFill rightFill viaOop endOop startOop nSegments |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
rightFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
leftFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
viaOop := interpreterProxy stackObjectValue: 2.
endOop := interpreterProxy stackObjectValue: 3.
startOop := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"Make sure the fills are okay"
((self isFillOkay: leftFill) and:[self isFillOkay: rightFill])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Do a quick check if the fillIndices are equal - if so, just ignore it"
leftFill = rightFill & false ifTrue:[
^interpreterProxy pop: 6. "Leave rcvr on stack"
].
self loadPoint: self point1Get from: startOop.
self loadPoint: self point2Get from: viaOop.
self loadPoint: self point3Get from: endOop.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self transformPoints: 3.
nSegments := self loadAndSubdivideBezierFrom: self point1Get
via: self point2Get
to: self point3Get
isWide: false.
self needAvailableSpace: nSegments * GBBaseSize.
engineStopped ifFalse:[
leftFill := self transformColor: leftFill.
rightFill := self transformColor: rightFill].
engineStopped ifFalse:[
self loadWideBezier: 0 lineFill: 0 leftFill: leftFill rightFill: rightFill n: nSegments.
].
engineStopped ifTrue:[
"Make sure the stack is okay"
self wbStackClear.
^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self storeEngineStateInto: engine.
interpreterProxy pop: 5. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddBezierShape (in category 'primitives') -----
primitiveAddBezierShape
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode points lineFill lineWidth fillIndex length pointsIsArray segSize nSegments |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
lineFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
lineWidth := interpreterProxy stackIntegerValue: 1.
fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2).
nSegments := interpreterProxy stackIntegerValue: 3.
points := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"First, do a check if the points look okay"
length := interpreterProxy slotSizeOf: points.
(interpreterProxy isWords: points) ifTrue:[
pointsIsArray := false.
"Either PointArray or ShortPointArray"
(length = (nSegments * 3) or:[length = (nSegments * 6)])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
] ifFalse:["Must be Array of points"
(interpreterProxy isArray: points)
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
length = (nSegments * 3)
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
pointsIsArray := true.
].
"Now check that we have some hope to have enough free space.
Do this by assuming nPoints boundaries of maximum size,
hoping that most of the fills will be colors and many boundaries
will be line segments"
(lineWidth = 0 or:[lineFill = 0])
ifTrue:[segSize := GLBaseSize]
ifFalse:[segSize := GLWideSize].
(self needAvailableSpace: segSize * nSegments)
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
"Check the fills"
((self isFillOkay: lineFill) and:[self isFillOkay: fillIndex])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Transform colors"
lineFill := self transformColor: lineFill.
fillIndex := self transformColor: fillIndex.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
"Check if have anything at all to do"
((lineFill = 0 or:[lineWidth = 0]) and:[fillIndex = 0])
ifTrue:[^interpreterProxy pop: 5].
"Transform the lineWidth"
lineWidth = 0 ifFalse:[
lineWidth := self transformWidth: lineWidth.
lineWidth < 1 ifTrue:[lineWidth := 1]].
"And load the actual shape"
pointsIsArray ifTrue:[
self loadArrayShape: points nSegments: nSegments
fill: fillIndex lineWidth: lineWidth lineFill: lineFill.
] ifFalse:[
self loadShape: (interpreterProxy firstIndexableField: points) nSegments: nSegments
fill: fillIndex lineWidth: lineWidth lineFill: lineFill
pointsShort: (nSegments * 3 = length)].
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self needsFlushPut: 1.
self storeEngineStateInto: engine.
interpreterProxy pop: 5. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddBitmapFill (in category 'primitives') -----
primitiveAddBitmapFill
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode nrmOop dirOop originOop tileFlag fill xIndex cmOop formOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 7
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
xIndex := interpreterProxy stackIntegerValue: 0.
xIndex <= 0 ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
nrmOop := interpreterProxy stackObjectValue: 1.
dirOop := interpreterProxy stackObjectValue: 2.
originOop := interpreterProxy stackObjectValue: 3.
tileFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 4).
cmOop := interpreterProxy stackObjectValue: 5.
formOop := interpreterProxy stackObjectValue: 6.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 7)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
self loadPoint: self point1Get from: originOop.
self loadPoint: self point2Get from: dirOop.
self loadPoint: self point3Get from: nrmOop.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
fill := self loadBitmapFill: formOop
colormap: cmOop
tile: (tileFlag ifTrue:[1] ifFalse:[0])
from: self point1Get
along: self point2Get
normal: self point3Get
xIndex: xIndex-1.
engineStopped ifTrue:[
"Make sure the stack is okay"
^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self storeEngineStateInto: engine.
interpreterProxy pop: 8 thenPush: (interpreterProxy positive32BitIntegerFor: fill)!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddCompressedShape (in category 'primitives') -----
primitiveAddCompressedShape
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode fillIndexList lineFills lineWidths rightFills leftFills nSegments points pointsShort |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 7
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
fillIndexList := interpreterProxy stackObjectValue: 0.
lineFills := interpreterProxy stackObjectValue: 1.
lineWidths := interpreterProxy stackObjectValue: 2.
rightFills := interpreterProxy stackObjectValue: 3.
leftFills := interpreterProxy stackObjectValue: 4.
nSegments := interpreterProxy stackIntegerValue: 5.
points := interpreterProxy stackObjectValue: 6.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 7)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"First, do a check if the compressed shape is okay"
(self checkCompressedShape: points
segments: nSegments
leftFills: leftFills
rightFills: rightFills
lineWidths: lineWidths
lineFills: lineFills
fillIndexList: fillIndexList) ifFalse:[^interpreterProxy primitiveFailFor: GEFEntityCheckFailed].
"Now check that we have some hope to have enough free space.
Do this by assuming nSegments boundaries of maximum size,
hoping that most of the fills will be colors and many boundaries
will be line segments"
(self needAvailableSpace: (GBBaseSize max: GLBaseSize) * nSegments)
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
"Check if the points are short"
pointsShort := (interpreterProxy slotSizeOf: points) = (nSegments * 3).
"Then actually load the compressed shape"
self loadCompressedShape: (interpreterProxy firstIndexableField: points)
segments: nSegments
leftFills: (interpreterProxy firstIndexableField: leftFills)
rightFills: (interpreterProxy firstIndexableField: rightFills)
lineWidths: (interpreterProxy firstIndexableField: lineWidths)
lineFills: (interpreterProxy firstIndexableField: lineFills)
fillIndexList: (interpreterProxy firstIndexableField: fillIndexList)
pointShort: pointsShort.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self needsFlushPut: 1.
self storeEngineStateInto: engine.
interpreterProxy pop: 7. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddGradientFill (in category 'primitives') -----
primitiveAddGradientFill
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode isRadial nrmOop dirOop originOop rampOop fill |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
isRadial := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
nrmOop := interpreterProxy stackValue: 1.
dirOop := interpreterProxy stackValue: 2.
originOop := interpreterProxy stackValue: 3.
rampOop := interpreterProxy stackValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
self loadPoint: self point1Get from: originOop.
self loadPoint: self point2Get from: dirOop.
self loadPoint: self point3Get from: nrmOop.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
fill := self loadGradientFill: rampOop
from: self point1Get
along: self point2Get
normal: self point3Get
isRadial: isRadial.
engineStopped ifTrue:[
"Make sure the stack is okay"
^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed
ifTrue: [^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self storeEngineStateInto: engine.
interpreterProxy pop: 6 thenPush: (interpreterProxy positive32BitIntegerFor: fill)!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddLine (in category 'primitives') -----
primitiveAddLine
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode leftFill rightFill endOop startOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
rightFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
leftFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
endOop := interpreterProxy stackObjectValue: 2.
startOop := interpreterProxy stackObjectValue: 3.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 4)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"Make sure the fills are okay"
((self isFillOkay: leftFill) and:[self isFillOkay: rightFill])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Load the points"
self loadPoint: self point1Get from: startOop.
self loadPoint: self point2Get from: endOop.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
"Transform points"
self transformPoints: 2.
"Transform colors"
leftFill := self transformColor: leftFill.
rightFill := self transformColor: rightFill.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
"Load line"
self loadWideLine: 0 from: self point1Get to: self point2Get
lineFill: 0 leftFill: leftFill rightFill: rightFill.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self storeEngineStateInto: engine.
interpreterProxy pop: 4. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddOval (in category 'primitives') -----
primitiveAddOval
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode fillIndex borderWidth borderIndex endOop startOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
borderIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
borderWidth := interpreterProxy stackIntegerValue: 1.
fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2).
endOop := interpreterProxy stackObjectValue: 3.
startOop := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"Make sure the fills are okay"
((self isFillOkay: borderIndex) and:[self isFillOkay: fillIndex])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Transform colors"
fillIndex := self transformColor: fillIndex.
borderIndex := self transformColor: borderIndex.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
"Check if we have anything at all to do"
(fillIndex = 0 and:[borderIndex = 0 or:[borderWidth <= 0]]) ifTrue:[
^interpreterProxy pop: 5. "Leave rcvr on stack"
].
"Make sure we have some space"
(self needAvailableSpace: (16 * GBBaseSize))
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
"Check if we need a border"
(borderWidth > 0 and:[borderIndex ~= 0])
ifTrue:[borderWidth := self transformWidth: borderWidth]
ifFalse:[borderWidth := 0].
"Load the rectangle points"
self loadPoint: self point1Get from: startOop.
self loadPoint: self point2Get from: endOop.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
self loadOval: borderWidth lineFill: borderIndex
leftFill: 0 rightFill: fillIndex.
engineStopped ifTrue:[
self wbStackClear.
^interpreterProxy primitiveFailFor: GEFEngineStopped.
].
interpreterProxy failed
ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self needsFlushPut: 1.
self storeEngineStateInto: engine.
interpreterProxy pop: 5. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddPolygon (in category 'primitives') -----
primitiveAddPolygon
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode points lineFill lineWidth fillIndex nPoints length pointsIsArray segSize |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
lineFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
lineWidth := interpreterProxy stackIntegerValue: 1.
fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2).
nPoints := interpreterProxy stackIntegerValue: 3.
points := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"First, do a check if the points look okay"
length := interpreterProxy slotSizeOf: points.
(interpreterProxy isWords: points) ifTrue:[
pointsIsArray := false.
"Either PointArray or ShortPointArray"
(length = nPoints or:[nPoints * 2 = length])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
] ifFalse:["Must be Array of points"
(interpreterProxy isArray: points)
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
length = nPoints
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
pointsIsArray := true.
].
"Now check that we have some hope to have enough free space.
Do this by assuming nPoints boundaries of maximum size,
hoping that most of the fills will be colors and many boundaries
will be line segments"
(lineWidth = 0 or:[lineFill = 0])
ifTrue:[segSize := GLBaseSize]
ifFalse:[segSize := GLWideSize].
(self needAvailableSpace: segSize * nPoints)
ifFalse:[^interpreterProxy primitiveFail].
"Check the fills"
((self isFillOkay: lineFill) and:[self isFillOkay: fillIndex])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Transform colors"
lineFill := self transformColor: lineFill.
fillIndex := self transformColor: fillIndex.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
"Check if have anything at all to do"
((lineFill = 0 or:[lineWidth = 0]) and:[fillIndex = 0])
ifTrue:[^interpreterProxy pop: 5].
"Transform the lineWidth"
lineWidth = 0 ifFalse:[lineWidth := self transformWidth: lineWidth].
"And load the actual polygon"
pointsIsArray ifTrue:[
self loadArrayPolygon: points nPoints: nPoints
fill: fillIndex lineWidth: lineWidth lineFill: lineFill
] ifFalse:[
self loadPolygon: (interpreterProxy firstIndexableField: points) nPoints: nPoints
fill: fillIndex lineWidth: lineWidth lineFill: lineFill
pointsShort: (nPoints = length)].
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self needsFlushPut: 1.
self storeEngineStateInto: engine.
interpreterProxy pop: 5. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddRect (in category 'primitives') -----
primitiveAddRect
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode fillIndex borderWidth borderIndex endOop startOop |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
borderIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
borderWidth := interpreterProxy stackIntegerValue: 1.
fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2).
endOop := interpreterProxy stackObjectValue: 3.
startOop := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
requiredState: GEStateUnlocked) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
"Make sure the fills are okay"
((self isFillOkay: borderIndex) and:[self isFillOkay: fillIndex])
ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
"Transform colors"
borderIndex := self transformColor: borderIndex.
fillIndex := self transformColor: fillIndex.
engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
"Check if we have anything at all to do"
(fillIndex = 0 and:[borderIndex = 0 or:[borderWidth = 0]]) ifTrue:[
^interpreterProxy pop: 5. "Leave rcvr on stack"
].
"Make sure we have some space"
(self needAvailableSpace: (4 * GLBaseSize))
ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
"Check if we need a border"
(borderWidth > 0 and:[borderIndex ~= 0])
ifTrue:[borderWidth := self transformWidth: borderWidth]
ifFalse:[borderWidth := 0].
"Load the rectangle"
self loadPoint: self point1Get from: startOop.
self loadPoint: self point3Get from: endOop.
interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
self point2Get at: 0 put: (self point3Get at: 0).
self point2Get at: 1 put: (self point1Get at: 1).
self point4Get at: 0 put: (self point1Get at: 0).
self point4Get at: 1 put: (self point3Get at: 1).
"Transform the points"
self transformPoints: 4.
self loadRectangle: borderWidth lineFill: borderIndex leftFill: 0 rightFill: fillIndex.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
self needsFlushPut: 1.
self storeEngineStateInto: engine.
interpreterProxy pop: 5. "Leave rcvr on stack"!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveGetBezierStats (in category 'primitives') -----
primitiveGetBezierStats
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| failureCode statOop stats |
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <inline: false>
<var: 'stats' type: #'int *'>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
(failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)) = 0
ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
statOop := interpreterProxy stackObjectValue: 0.
(interpreterProxy failed not
and: [(interpreterProxy isWords: statOop)
and: [(interpreterProxy slotSizeOf: statOop) >= 4]])
ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
stats := interpreterProxy firstIndexableField: statOop.
stats at: 0 put: (stats at: 0) + (workBuffer at: GWBezierMonotonSubdivisions).
stats at: 1 put: (stats at: 1) + (workBuffer at: GWBezierHeightSubdivisions).
stats at: 2 put: (stats at: 2) + (workBuffer at: GWBezierOverflowSubdivisions).
stats at: 3 put: (stats at: 3) + (workBuffer at: GWBezierLineConversions).
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
StackInterpreterPrimitives subclass: #CoInterpreter
instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile CFramePointer CStackPointer CReturnAddress primTracePluginName'
+ classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimNumberCopyObject PrimNumberObjectAtPut PrimTraceLogSize PrimitiveMetadataFlagsShift RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
category: 'VMMaker-JIT'!
!CoInterpreter commentStamp: 'eem 3/31/2020 18:56' prior: 0!
I am a variant of the StackInterpreter that can co-exist with the Cog JIT. I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT. See CogMethod class's comment for method interoperability.
cogCodeSize
- the current size of the machine code zone
cogCompiledCodeCompactionCalledFor
- a variable set when the machine code zone runs out of space, causing a machine code zone compaction at the next available opportunity
cogMethodZone
- the manager for the machine code zone (instance of CogMethodZone)
cogit
- the JIT (co-jit) (instance of SimpleStackBasedCogit, StackToRegisterMappoingCogit, etc)
deferSmash
- a flag causing deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
deferredSmash
- a flag noting deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
desiredCogCodeSize
- the desred size of the machine code zone, set at startup or via primitiveVMParameter to be written at snapshot time
flagInterpretedMethods
- true if methods that are interpreted shoudl have their flag bit set (used to identity methods that are interpreted because they're unjittable for some reason)
gcMode
- the variable holding the gcMode, used to inform the cogit of how to scan the machine code zone for oops on GC
heapBase
- the address in memory of the base of the objectMemory's heap, which is immediately above the machine code zone
lastCoggableInterpretedBlockMethod
- a variable used to invoke the cogit for a block mehtod being invoked repeatedly in the interpreter
lastUncoggableInterpretedBlockMethod
- a variable used to avoid invoking the cogit for an unjittable method encountered on block evaluation
maxLiteralCountForCompile
- the variable controlling which methods to jit. methods with a literal count above this value will not be jitted (on the grounds that large methods are typically used for initialization, and take up a lot of space in the code zone)
minBackwardJumpCountForCompile
- the variable controlling when to attempt to jit a method being interpreted. If as many backward jumps as this occur, the current method will be jitted
primTraceLog
- a small array implementing a crcular buffer logging the last N primitive invocations, GCs, code compactions, etc used for crash reporting
primTraceLogIndex
- the index into primTraceLog of the next entry
reenterInterpreter
- the jmpbuf used to jmp back into the interpreter when transitioning from machine code to the interpreter
statCodeCompactionCount
- the count of machine code zone compactions
statCodeCompactionUsecs
- the total microseconds spent in machine code zone compactions
traceLog
- a log of various events, used in debugging
traceLogIndex
- the index into traceLog of the next entry
traceSources
- the names associated with the codes of events in traceLog
CFramePointer
- if in use, the value of the C frame pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CStackPointer
- the value of the C stack pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CReturnAddress
- the return address for the function call which invoked the interpreter at start-up. Using this as teh return address when entering the interpreter via ceInvokeInterpeter maintains a valid stack. Since this is effevtively a constant it does not need to be saved and restored once set.!
Item was changed:
----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
super initializeMiscConstants.
COGVM := true.
MinBackwardJumpCountForCompile := 40.
MaxNumArgs := 15.
- PrimCallNeedsNewMethod := 1.
- PrimCallNeedsPrimitiveFunction := 2.
- PrimCallMayEndureCodeCompaction := 4.
- PrimCallCollectsProfileSamples := 8.
- PrimCallDoNotJIT := 16.
- PrimCallIsExternalCall := 32.
- "CheckAllocationFillerAfterPrimCall := 32. this has never been successfully used in all the years we've had it; nuking it"
- PrimCallOnSmalltalkStack := 64. "Speed up simple external prims by avoiding stack switch"
- PrimCallOnSmalltalkStackAlign2x := 128. "Align stack to a 2 x word size boundary, e.g. for MMX instructions etc"
+ PrimCallOnSmalltalkStack := 1. "Speed up simple external prims by avoiding stack switch"
+ PrimCallOnSmalltalkStackAlign2x := 2. "Align stack to a 2 x word size boundary, e.g. for MMX instructions etc"
+ PrimCallIsExternalCall := 4.
+ PrimCallNeedsNewMethod := 8.
+ PrimCallMayEndureCodeCompaction := 16.
+ PrimCallCollectsProfileSamples := 32.
+
+ "Flags for use in primitiveMetadata: in external primitives, overlap with the PrimCallXXX flags above"
- "Flags for use in export:flags:, shifted to overlap with the PrimCallXXX flags above"
FastCPrimitiveFlag := 1. "a.k.a. PrimCallOnSmalltalkStack"
FastCPrimitiveAlignForFloatsFlag := 2. "a.k.a. PrimCallOnSmalltalkStackAlign2x"
- PrimitiveMetadataFlagsShift := PrimCallOnSmalltalkStack highBit - FastCPrimitiveFlag highBit.
"And to shift away the flags, to compute the accessor depth, use...
c.f. NullSpurMetadata in sq.h"
SpurPrimitiveAccessorDepthShift := 8.
SpurPrimitiveFlagsMask := 1 << SpurPrimitiveAccessorDepthShift - 1.
"the primitive trace log; a record of the last 256 named/external primitives or significant events invoked."
PrimTraceLogSize := 256. "Room for 256 selectors. Must be 256 because we use a byte to hold the index"
TraceBufferSize := 256 * 3. "Room for 256 events"
TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
TracePrimitiveFailure := self objectMemoryClass basicNew integerObjectOf: 14.
TracePrimitiveRetry := self objectMemoryClass basicNew integerObjectOf: 15.
TraceIsFromMachineCode := 1.
TraceIsFromInterpreter := 2.
CSCallbackEnter := 3.
CSCallbackLeave := 4.
CSEnterCriticalSection := 5.
CSExitCriticalSection := 6.
CSResume := 7.
CSSignal := 8.
CSSuspend := 9.
CSWait := 10.
CSYield := 11.
CSCheckEvents := 12.
CSThreadSchedulingLoop := 13.
CSOwnVM := 14.
CSThreadBind := 15.
CSSwitchIfNeccessary := 16.
TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal' 'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
"this is simulation only"
RumpCStackSize := 4096!
Item was changed:
----- Method: CoInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
initializePrimitiveTable
super initializePrimitiveTable.
+ self assert: (PrimitiveTable at: 215 + 1) = #primitiveFlushCacheByMethod.
- "These two are run on the Smalltalk stack under Spur. See primitivePropertyFlagsForSpur:"
- PrimNumberObjectAtPut := 69.
- self assert: (PrimitiveTable at: PrimNumberObjectAtPut + 1) = #primitiveObjectAtPut.
- PrimNumberCopyObject := 168.
- self assert: (PrimitiveTable at: PrimNumberCopyObject + 1) = #primitiveCopyObject.
-
#(216 253) do:
[:pidx| self assert: (PrimitiveTable at: pidx + 1) = #primitiveFail].
- self assert: (PrimitiveTable at: 215 + 1) = #primitiveFlushCacheByMethod.
PrimitiveTable
- at: 253 + 1 put: #primitiveCollectCogCodeConstituents;
at: 215 + 1 put: #primitiveVoidVMStateForMethod;
+ at: 216 + 1 put: #primitiveMethodXray;
+ at: 253 + 1 put: #primitiveCollectCogCodeConstituents!
- at: 216 + 1 put: #primitiveMethodXray!
Item was changed:
----- Method: CoInterpreter class>>metadataFlagsForPrimitive: (in category 'spur compilation support') -----
metadataFlagsForPrimitive: aPrimitiveMethodOrNil
+ "We allow methods to decorate themselves with 8 flags (FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag et al)
+ that alter how the Cogit dispatches primitives. These flags are supplied by the primitiveMetadata: pragma."
- "We allow methods to decorate themselves with 8 flags (only one specified so far: FastCPrimitiveFlag)
- using the export:flags: pragma."
aPrimitiveMethodOrNil ifNil: [^0].
+ ^(aPrimitiveMethodOrNil pragmaAt: #primitiveMetadata:)
- ^(aPrimitiveMethodOrNil pragmaAt: #export:flags:)
ifNil: [0]
+ ifNotNil:
+ [:pragma| | flags |
+ flags := (flags := pragma arguments first) isInteger
+ ifTrue: [flags]
+ ifFalse: [self valueOfMetadataFlag: flags].
+ "PrimCallMayEndureCodeCompaction & PrimCallOnSmalltalkStack[Align2x] are mutually exclusive..."
+ self assert: ((flags anyMask: PrimCallMayEndureCodeCompaction) & (flags anyMask: PrimCallOnSmalltalkStack + PrimCallOnSmalltalkStackAlign2x)) not.
+ flags]!
- ifNotNil: [:pragma| | flags |
- (flags := pragma arguments second) isInteger
- ifTrue: [flags]
- ifFalse: [self valueOfMetadataFlag: flags]]!
Item was removed:
- ----- Method: CoInterpreter>>accessorDepthForPrimitiveIndex: (in category 'cog jit support') -----
- accessorDepthForPrimitiveIndex: primIndex
- <api>
- <option: #SpurObjectMemory>
- ^primitiveAccessorDepthTable at: primIndex!
Item was removed:
- ----- Method: CoInterpreter>>accessorDepthForPrimitiveMethod: (in category 'cog jit support') -----
- accessorDepthForPrimitiveMethod: aMethodObj
- <api>
- <option: #SpurObjectMemory>
- | primIndex |
- primIndex := self primitiveIndexOf: aMethodObj.
- ^primIndex = PrimNumberExternalCall
- ifTrue: [self accessorDepthForExternalPrimitiveMethod: aMethodObj]
- ifFalse: [self accessorDepthForPrimitiveIndex: primIndex]!
Item was removed:
- ----- Method: CoInterpreter>>callbackEnter: (in category 'callback support') -----
- callbackEnter: callbackID
- "Re-enter the interpreter for executing a callback"
- | currentCStackPointer currentCFramePointer wasInMachineCode calledFromMachineCode |
- <volatile>
- <export: true>
- <var: #currentCStackPointer type: #usqIntptr_t>
- <var: #currentCFramePointer type: #usqIntptr_t>
- <var: #callbackID type: #'sqInt *'>
-
- "For now, do not allow a callback unless we're in a primitiveResponse"
- (self asserta: primitiveFunctionPointer ~= 0) ifFalse:
- [^false].
-
- self assert: primFailCode = 0.
-
- "Check if we've exceeded the callback depth"
- (self asserta: jmpDepth < MaxJumpBuf) ifFalse:
- [^false].
- jmpDepth := jmpDepth + 1.
-
- wasInMachineCode := self isMachineCodeFrame: framePointer.
- calledFromMachineCode := instructionPointer <= objectMemory startOfMemory.
-
- "Suspend the currently active process"
- suspendedCallbacks at: jmpDepth put: self activeProcess.
- "We need to preserve newMethod explicitly since it is not activated yet
- and therefore no context has been created for it. If the caller primitive
- for any reason decides to fail we need to make sure we execute the correct
- method and not the one 'last used' in the call back"
- suspendedMethods at: jmpDepth put: newMethod.
- self flag: 'need to debug this properly. Conceptually it is the right thing to do but it crashes in practice'.
- false
- ifTrue:
- ["Signal external semaphores since a signalSemaphoreWithIndex: request may
- have been issued immediately prior to this callback before the VM has any
- chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
- self signalExternalSemaphores.
- "If no process is awakened by signalExternalSemaphores then transfer
- to the highest priority runnable one."
- (suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue:
- [self transferTo: self wakeHighestPriority from: CSCallbackLeave]]
- ifFalse:
- [self transferTo: self wakeHighestPriority from: CSCallbackLeave].
-
- "Typically, invoking the callback means that some semaphore has been
- signaled to indicate the callback. Force an interrupt check as soon as possible."
- self forceInterruptCheck.
-
- "Save the previous CStackPointers..."
- currentCStackPointer := CStackPointer.
- currentCFramePointer := CFramePointer.
- cogit assertCStackWellAligned.
- (self _setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID"
- [callbackID at: 0 put: jmpDepth.
- self enterSmalltalkExecutive.
- self assert: false "NOTREACHED"].
-
- "Restore the previous CStackPointers..."
- self setCFramePointer: currentCFramePointer setCStackPointer: currentCStackPointer.
-
- "Transfer back to the previous process so that caller can push result"
- self putToSleep: self activeProcess yieldingIf: preemptionYields.
- self transferTo: (suspendedCallbacks at: jmpDepth) from: CSCallbackLeave.
- newMethod := suspendedMethods at: jmpDepth. "see comment above"
- argumentCount := self argumentCountOf: newMethod.
- self assert: wasInMachineCode = (self isMachineCodeFrame: framePointer).
- calledFromMachineCode
- ifTrue:
- [instructionPointer >= objectMemory startOfMemory ifTrue:
- [self iframeSavedIP: framePointer put: instructionPointer.
- instructionPointer := cogit ceReturnToInterpreterPC]]
- ifFalse:
- ["Even if the context was flushed to the heap and rebuilt in transferTo:from:
- above it will remain an interpreted frame because the context's pc would
- remain a bytecode pc. So the instructionPointer must also be a bytecode pc."
- self assert: (self isMachineCodeFrame: framePointer) not.
- self assert: instructionPointer > objectMemory startOfMemory].
- self assert: primFailCode = 0.
- jmpDepth := jmpDepth-1.
- ^true!
Item was changed:
----- Method: CoInterpreter>>ceActivateFailingPrimitiveMethod: (in category 'enilopmarts') -----
ceActivateFailingPrimitiveMethod: aPrimitiveMethod
"An external call or FFI primitive has failed. Build the frame and
activate as appropriate. Enter either the interpreter or machine
code depending on whether aPrimitiveMethod has been or is still
cogged. Note that we could always interpret but want the efficiency
of executing machine code if it is available."
<api>
| methodHeader result |
self assert: primFailCode ~= 0.
self assert: newMethod = aPrimitiveMethod.
"If we're on Spur, retry the primitive, if appropriate,
returning if successful after retry."
objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [primitiveFunctionPointer := self functionPointerForCompiledMethod: aPrimitiveMethod
+ primitiveIndex: (self primitiveIndexOf: aPrimitiveMethod)
+ primitivePropertyFlagsInto: nil.
+ self retryPrimitiveOnFailure.
- [self retryPrimitiveOnFailure.
self successful ifTrue:
[(profileSemaphore ~= objectMemory nilObject
and: [self ioHighResClock >= nextProfileTick]) ifTrue:
[self ceTakeProfileSample: nil].
result := self stackTop.
self stackTopPut: instructionPointer.
self push: result.
cogit ceEnterCogCodePopReceiverReg]].
methodHeader := self rawHeaderOf: aPrimitiveMethod.
(self isCogMethodReference: methodHeader)
ifTrue: [self activateNewCogMethod: (self cCoerceSimple: methodHeader to: #'CogMethod *') inInterpreter: false]
ifFalse: [self activateNewMethod]!
Item was added:
+ ----- Method: CoInterpreter>>externalCallLiteralModuleIsVM: (in category 'plugin primitive support') -----
+ externalCallLiteralModuleIsVM: firstLiteral
+ <inline: #always>
+ "A module value that is nil or the empty string implies a primitive in the CoInterpreter itself."
+ ^(objectMemory numBytesOf: (objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: firstLiteral)) = 0!
Item was changed:
----- Method: CoInterpreter>>functionForPrimitiveExternalCall: (in category 'plugin primitives') -----
functionForPrimitiveExternalCall: methodObj
+ "Arrange to call the external primitive function directly. The complication is arranging that
+ the call can be flushed, given that it is embedded in machine code. The strategy is to map
+ machine code activations, and machine code pcs in contexts, to interpreter activations/pcs
+ on unloading a plugin/flushing a primitive. See CoInterpreter>>flushExternalPrimitives.
+
+ Hence we never have a machine code method referring to an unlinked external primitive in a
+ loaded plugin module. We may have a machine code method referring to a missing primitive
+ module or missing function in a loaded module, in which case machne code will invoke
+ primitiveExternalCall which will fail appropriately.
+
+ The key goal here is to allow the JIT to generate whatever code sequence it needs to to invoke
+ an external primitive, without having to generate the same sequence for any external primitive
+ invocation. The JIT may be asked to invoke the primitive conventionally (on the C stack), or on
+ a Smalltalk stack page (FastCPrimitiveFlag et al), and this may change if a plugin is unloaded and
+ a different version loaded, etc. If we allowed machine code activations/pcs for such methods to
+ persist then the JIT would be unable to generate different sequences over time since this would
+ break machine code to bytecode pc mapping, which depends on exactly the same machine code
+ sequences being generated for a given bytecoded method. So by linking an external method
+ before JITing and aggressively flushing machine code for external primitive invocations the JIT is
+ free to generate different sequences as specified by an external primitive's primitiveMetadata: pragma."
- "Arrange to call the external primitive directly. The complication is arranging
- that the call can be flushed, given that it is embedded in machine code."
<returnTypeC: 'void (*functionForPrimitiveExternalCall(sqInt methodObj))(void)'>
| lit index functionPointer |
<var: #functionPointer declareC: #'void (*functionPointer)(void)'>
(objectMemory literalCountOf: methodObj) > 0 ifFalse:
[^#primitiveExternalCall].
lit := self literal: 0 ofMethod: methodObj.
"Check if it's an array of length 4"
((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]) ifFalse:
[^#primitiveExternalCall].
index := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit.
((objectMemory isIntegerObject: index)
and: [(index := objectMemory integerValueOf: index) > 0
and: [index <= MaxExternalPrimitiveTableSize]]) ifFalse:
[^#primitiveExternalCall].
functionPointer := externalPrimitiveTable at: index - 1.
functionPointer = 0 ifTrue:
[^#primitiveExternalCall].
^functionPointer!
Item was changed:
----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'cog jit support') -----
functionPointerForCompiledMethod: methodObj primitiveIndex: primitiveIndex primitivePropertyFlagsInto: flagsPtr
<api>
<returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndexprimitivePropertyFlagsInto(sqInt methodObj, sqInt primitiveIndex, sqInt *flagsPtr))(void)'>
| functionPointer flags |
<var: #functionPointer declareC: #'void (*functionPointer)(void)'>
flagsPtr ifNotNil:
+ [flagsPtr at: 0 put: (flags := self primitivePropertyFlags: primitiveIndex numArgs: (self argumentCountOf: methodObj))].
- [flagsPtr at: 0 put: (flags := self primitivePropertyFlags: primitiveIndex)].
functionPointer := self functionPointerFor: primitiveIndex inClass: nil.
functionPointer == #primitiveCalloutToFFI ifTrue:
[^self functionForPrimitiveCallout].
functionPointer == #primitiveExternalCall ifTrue:
[| lit |
lit := self attemptToLinkExternalPrimitive: methodObj.
+ flagsPtr ifNotNil:
+ ["N.B. We only support the FastCPrimitiveFlag on Spur because Spur
+ will *not* run a GC to satisfy an allocation in a primitive. The V3
+ ObjectMemory will and hence the depth of stack needed in a V3
+ primitive is probably too large to safely execute on a stack page."
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [| metadataFlags shiftedMetadataFlags |
+ metadataFlags := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit.
+ (objectMemory isIntegerObject: metadataFlags) ifTrue:
+ [shiftedMetadataFlags := (objectMemory integerValueOf: metadataFlags)
+ bitAnd: SpurPrimitiveFlagsMask.
+ shiftedMetadataFlags > 0 ifTrue:
+ ["Intentionally clear all other flags if there are Spur metadata flags..."
+ flags := shiftedMetadataFlags].
+ (self externalCallLiteralModuleIsVM: lit) ifTrue:
+ [flags := flags bitOr: PrimCallIsInternalPrim]]].
+ (self object: (objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit)
+ equalsString: 'primitiveProfileSemaphore') ifTrue:
+ [flags := flags bitOr: PrimCallMayEndureCodeCompaction].
+ profileSemaphore ~= objectMemory nilObject ifTrue:
+ [flags := flags bitOr: PrimCallCollectsProfileSamples].
+ flagsPtr at: 0 put: flags].
- "N.B. We only support the FastCPrimitiveFlag on Spur because Spur
- will *not* run a GC to satisfy an allocation in a primitive. The V3
- ObjectMemory will and hence the depth of stack needed in a V3
- primitive is probably too large to safely execute on a stack page."
- objectMemory hasSpurMemoryManagerAPI ifTrue:
- [| metadataFlags shiftedMetadataFlags |
- metadataFlags := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit.
- (objectMemory isIntegerObject: metadataFlags) ifTrue:
- [shiftedMetadataFlags := ((objectMemory integerValueOf: metadataFlags)
- bitAnd: SpurPrimitiveFlagsMask)
- bitShift: PrimitiveMetadataFlagsShift.
- shiftedMetadataFlags > 0 ifTrue:
- ["Intentionally clear all other flags if there are Spur metadata flags..."
- flags := shiftedMetadataFlags]]].
- (self object: (objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit)
- equalsString: 'primitiveProfileSemaphore') ifTrue:
- [flags := flags bitOr: PrimCallMayEndureCodeCompaction].
- profileSemaphore ~= objectMemory nilObject ifTrue:
- [flags := flags bitOr: PrimCallCollectsProfileSamples].
- flagsPtr at: 0 put: flags.
^self functionForPrimitiveExternalCall: methodObj].
^functionPointer!
Item was changed:
----- Method: CoInterpreter>>isCodeCompactingPrimitiveIndex: (in category 'primitive support') -----
isCodeCompactingPrimitiveIndex: primIndex
"If instVarAt:, slotAt: or shallowCopy operate on a Context then they compute a
bytecode pc and hence may provoke a code compaction. Hence primitive invocation
from these primitives must use a static return address (cePrimReturnEnterCogCode:).
Note that the process switch primitives may also provoke a code compaction, which
happens when switching to a process whose top context has a machine code pc but
the method is no longer in the code cache. However, in this case they are switching
process and don't go through the normal return. So we don't include them here."
+ <inline: #always>
- <inline: true>
self cCode: [] inSmalltalk: [#primitiveClone. #primitiveInstVarAt. #primitiveSlotAt. #primitiveFlushExternalPrimitives. #primitiveUnloadModule]. "For senders..."
^primIndex = PrimNumberInstVarAt
or: [primIndex = PrimNumberShallowCopy
or: [primIndex = PrimNumberSlotAt
or: [primIndex = PrimNumberFlushExternalPrimitives
or: [primIndex = PrimNumberUnloadModule]]]]!
Item was changed:
----- Method: CoInterpreter>>isExternalMethodInPlugin: (in category 'plugin primitive support') -----
isExternalMethodInPlugin: methodObj
| header primIdx literal |
header := objectMemory methodHeaderOf: methodObj.
primIdx := self primitiveIndexOfMethod: methodObj header: header.
^primIdx = PrimNumberExternalCall
and: [(objectMemory literalCountOfMethodHeader: header) > 0
and: [(objectMemory isArray: (literal := self literal: 0 ofMethod: methodObj))
and: [(objectMemory numSlotsOf: literal) = 4
and: [(objectMemory isBytes: (objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: literal))
+ and: [(self externalCallLiteralModuleIsVM: literal) not]]]]]!
- and: [(objectMemory numBytesOf: (objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: literal)) > 0]]]]] "A 0 byte module name implies a primitive in the main VM; these can't change"!
Item was added:
+ ----- Method: CoInterpreter>>isPerformPrimitive: (in category 'primitive support') -----
+ isPerformPrimitive: primIndex
+ <inline: #always>
+ self cCode: [] inSmalltalk: [#primitivePerform. #primitivePerformWithArgs]. "For senders..."
+ ^primIndex = PrimNumberPerform
+ or: [primIndex = PrimNumberPerformWithArgs]!
Item was removed:
- ----- Method: CoInterpreter>>primNumberExternalCall (in category 'compiled methods') -----
- primNumberExternalCall
- "Answer if the method is an external primitive call (prim 117)."
- <api>
- <cmacro>
- ^PrimNumberExternalCall!
Item was removed:
- ----- Method: CoInterpreter>>primitivePropertyFlags: (in category 'cog jit support') -----
- primitivePropertyFlags: primIndex
- <api>
- "Answer any special requirements of the given primitive"
- objectMemory hasSpurMemoryManagerAPI
- ifTrue: [^self primitivePropertyFlagsForSpur: primIndex]
- ifFalse: [^self primitivePropertyFlagsForV3: primIndex]!
Item was added:
+ ----- Method: CoInterpreter>>primitivePropertyFlags:numArgs: (in category 'cog jit support') -----
+ primitivePropertyFlags: primIndex numArgs: numArgs
+ <api>
+ "Answer any special requirements of the given primitive"
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [^self primitivePropertyFlagsForSpur: primIndex numArgs: numArgs]
+ ifFalse: [^self primitivePropertyFlagsForV3: primIndex numArgs: numArgs]!
Item was removed:
- ----- Method: CoInterpreter>>primitivePropertyFlagsFor: (in category 'cog jit support') -----
- primitivePropertyFlagsFor: externalBytecodedMethod
- <doNotGenerate>
- "Support for in-image compilation. This is intended to do for methods in the image what
- functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: does for methods in the simulation."
- | flags metadata |
- flags := self primitivePropertyFlags: externalBytecodedMethod primitive.
- externalBytecodedMethod primitive = PrimNumberExternalCall ifTrue:
- [metadata := self class metadataFlagsForPrimitive: externalBytecodedMethod.
- flags := flags bitOr: ((metadata bitAnd: SpurPrimitiveFlagsMask) bitShift: PrimitiveMetadataFlagsShift).
- (InitializationOptions at: #profiling ifAbsent: [false]) ifTrue:
- [flags := flags bitOr: PrimCallCollectsProfileSamples]].
- ^flags!
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlagsFor:primitiveIndex: (in category 'cog jit support') -----
primitivePropertyFlagsFor: externalBytecodedMethod primitiveIndex: primIndex
<doNotGenerate>
"Support for in-image compilation. This is intended to do for methods in the image what
functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: does for methods in the simulation."
| flags metadata |
+ flags := self primitivePropertyFlags: primIndex numArgs: (self argumentCountOf: externalBytecodedMethod).
- flags := self primitivePropertyFlags: primIndex.
primIndex = PrimNumberExternalCall ifTrue:
[metadata := self class metadataFlagsForPrimitive: externalBytecodedMethod.
"nuke base flags..."
+ flags := metadata bitAnd: SpurPrimitiveFlagsMask.
- flags := (metadata bitAnd: SpurPrimitiveFlagsMask) bitShift: PrimitiveMetadataFlagsShift.
(InitializationOptions at: #profiling ifAbsent: [false]) ifTrue:
[flags := flags bitOr: PrimCallCollectsProfileSamples]].
^flags!
Item was removed:
- ----- Method: CoInterpreter>>primitivePropertyFlagsForSpur: (in category 'cog jit support') -----
- primitivePropertyFlagsForSpur: primIndex
- <inline: true>
- "Answer any special requirements of the given primitive. Spur always needs to set
- primitiveFunctionPointer and newMethod so primitives can retry on failure due to forwarders."
- | baseFlags |
- self cCode: [] inSmalltalk: [#( primitiveObjectAtPut primitiveCopyObject primitiveSpurStringReplace
- primitiveSpurFloatArrayAt primitiveSpurFloatArrayAtPut
- primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
- baseFlags := profileSemaphore = objectMemory nilObject
- ifTrue: [0]
- ifFalse: [PrimCallCollectsProfileSamples].
-
- (primIndex = PrimNumberObjectAtPut
- or: [primIndex = PrimNumberCopyObject
- or: [primIndex = PrimNumberStringReplace
- or: [primIndex = PrimNumberShortArrayAt
- or: [primIndex = PrimNumberShortArrayAtPut]]]]) ifTrue:
- [^baseFlags + PrimCallOnSmalltalkStack].
-
- (primIndex = PrimNumberFloatArrayAt
- or: [primIndex = PrimNumberFloatArrayAtPut]) ifTrue:
- [^baseFlags + PrimCallOnSmalltalkStack + PrimCallOnSmalltalkStackAlign2x].
-
- "N.B. if and when this changes remember to add back support for the longRunningPrimitiveCheck"
- baseFlags := baseFlags + PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod.
-
- (self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks & module unloading"
- [^baseFlags + PrimCallMayEndureCodeCompaction + PrimCallIsExternalCall].
- (self isCodeCompactingPrimitiveIndex: primIndex) ifTrue: "For code reclamations"
- [^baseFlags bitOr: PrimCallMayEndureCodeCompaction].
-
- ^baseFlags!
Item was added:
+ ----- Method: CoInterpreter>>primitivePropertyFlagsForSpur:numArgs: (in category 'cog jit support') -----
+ primitivePropertyFlagsForSpur: primIndex numArgs: numArgs
+ <inline: true>
+ "Answer any special requirements of the given primitive. Spur needs to set
+ newMethod if and when a primitive fails so primitives can retry on failure due
+ to forwarders, but this isn't done until failure. The primitiveMetadataTable
+ is populated based on the primitiveMetadata: pragma in internal primitives."
+ | baseFlags |
+ baseFlags := profileSemaphore = objectMemory nilObject
+ ifTrue: [0]
+ ifFalse: [PrimCallCollectsProfileSamples].
+ self cppIf: #LRPCheck
+ ifTrue:
+ [longRunningPrimitiveCheckSemaphore ifNotNil:
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod]].
+
+ (primIndex = PrimNumberVMParameter and: [numArgs = 1]) "vmParameterAt:" ifTrue:
+ [^baseFlags + PrimCallOnSmalltalkStack + PrimCallIsInternalPrim].
+
+ ^baseFlags bitOr: ((primitiveMetadataTable at: primIndex) bitAnd: SpurPrimitiveFlagsMask)!
Item was removed:
- ----- Method: CoInterpreter>>primitivePropertyFlagsForV3: (in category 'cog jit support') -----
- primitivePropertyFlagsForV3: primIndex
- <inline: true>
- "Answer any special requirements of the given primitive"
- | baseFlags |
- baseFlags := profileSemaphore ~= objectMemory nilObject
- ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
- ifFalse: [0].
-
- self cppIf: #LRPCheck
- ifTrue:
- [longRunningPrimitiveCheckSemaphore ifNotNil:
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod]].
-
- (self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks & module unloading"
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayEndureCodeCompaction + PrimCallIsExternalCall].
- (self isCodeCompactingPrimitiveIndex: primIndex) ifTrue:
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction].
-
- ^baseFlags!
Item was added:
+ ----- Method: CoInterpreter>>primitivePropertyFlagsForV3:numArgs: (in category 'cog jit support') -----
+ primitivePropertyFlagsForV3: primIndex numArgs: numArgs
+ <inline: true>
+ "Answer any special requirements of the given primitive"
+ | baseFlags |
+ baseFlags := profileSemaphore ~= objectMemory nilObject
+ ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
+ ifFalse: [0].
+
+ self cppIf: #LRPCheck
+ ifTrue:
+ [longRunningPrimitiveCheckSemaphore ifNotNil:
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod]].
+
+ (self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks & module unloading"
+ [^baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction + PrimCallIsExternalCall].
+ (self isCodeCompactingPrimitiveIndex: primIndex) ifTrue:
+ [^baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction].
+ ((self isPerformPrimitive: primIndex)
+ or: [self isMetaPrimitiveIndex: primIndex]) ifTrue:
+ [^baseFlags bitOr: PrimCallNeedsNewMethod].
+ ^baseFlags!
Item was changed:
----- Method: CoInterpreterMT>>assertValidNewMethodPropertyFlags (in category 'simulation') -----
assertValidNewMethodPropertyFlags
<cmacro: '() 0'> "simulation only"
+ | header primitiveIndex |
self assert: (objectMemory addressCouldBeObj: newMethod).
self assert: (objectMemory isCompiledMethod: newMethod).
+ header := objectMemory methodHeaderOf: newMethod.
+ primitiveIndex := self primitiveIndexOfMethod: newMethod header: header.
+ self assert: primitiveIndex > 0.
+ self assert: ((self primitivePropertyFlags: primitiveIndex numArgs: (self argumentCountOfMethodHeader: header)) anyMask: PrimCallMayEndureCodeCompaction)!
- self assert: (self primitiveIndexOf: newMethod) > 0.
- self assert: ((self primitivePropertyFlags: (self primitiveIndexOf: newMethod)) anyMask: PrimCallMayEndureCodeCompaction)!
Item was changed:
----- Method: CoInterpreterMT>>preemptDisowningThread (in category 'vm scheduling') -----
preemptDisowningThread
"Set the relevant state for disowningVMThread so that it can resume after
being preempted and set disowningVMThread to nil to indicate preemption.
N.B. This should only be sent from checkPreemptionOfDisowningThread.
There are essentially four things to do.
a) save the VM's notion of the current C stack pointers; these are pointers
into a thread's stack and must be saved and restored in thread switch.
b) save the VM's notion of the current Smalltalk execution point. This is
simply the suspend half of a process switch that saves the current context
in the current process.
c) add the process to the thread's set of AWOL processes so that the scheduler
won't try to run the process while the thread has disowned the VM.
d) save the in-primitive VM state, newMethod and argumentCount
ownVM: will restore the VM context as of disownVM: from the above when it
finds it has been preempted."
| activeProc activeContext preemptedThread |
<var: #preemptedThread type: #'CogVMThread *'>
<inline: false>
self assert: disowningVMThread notNil.
self assert: (disowningVMThread state = CTMUnavailable
or: [disowningVMThread state = CTMWantingOwnership]).
self assertCStackPointersBelongToDisowningThread.
cogit recordEventTrace ifTrue:
[self recordTrace: TracePreemptDisowningThread
thing: (objectMemory integerObjectOf: disowningVMThread index)
source: 0].
disowningVMThread cStackPointer: CStackPointer.
disowningVMThread cFramePointer: CFramePointer.
activeProc := self activeProcess.
self assert: (objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject.
objectMemory
storePointer: MyListIndex
ofObject: activeProc
withValue: (objectMemory splObj: ProcessInExternalCodeTag).
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
objectMemory
storePointer: SuspendedContextIndex
ofObject: activeProc
withValue: activeContext.
"The instructionPointer must be pushed because the convention for inactive stack pages is that the
instructionPointer is top of stack. We need to know if this primitive is called from machine code
because the invariant that the return pc of an interpreter callee calling a machine code caller is
ceReturnToInterpreterPC must be maintained."
self push: instructionPointer.
self externalWriteBackHeadFramePointers.
"Since pushing the awol process may realloc disowningVMThread we need to reassign.
But since we're going to nil disowningVMThread anyway we can assign to a local."
preemptedThread := cogThreadManager pushAWOLProcess: activeProc on: disowningVMThread.
disowningVMThread := nil.
preemptedThread priority: (self quickFetchInteger: PriorityIndex ofObject: activeProc).
(self ownerIndexOfProcess: activeProc) = 0 ifTrue:
[self setOwnerIndexOfProcess: activeProc to: preemptedThread index bind: false].
preemptedThread
newMethodOrNull: newMethod;
argumentCount: argumentCount;
- primitiveFunctionPointer: primitiveFunctionPointer;
inMachineCode: instructionPointer <= objectMemory startOfMemory!
Item was removed:
- ----- Method: CoInterpreterMT>>primitivePropertyFlagsForSpur: (in category 'cog jit support') -----
- primitivePropertyFlagsForSpur: primIndex
- <inline: true>
- "Answer any special requirements of the given primitive. Spur always needs to set
- primitiveFunctionPointer and newMethod so primitives can retry on failure due to forwarders."
- self cCode: [] inSmalltalk: [#(primitiveRelinquishProcessor)]. "For senders..."
- primIndex = PrimNumberRelinquishProcessor ifTrue:
- [^profileSemaphore ~= objectMemory nilObject
- ifTrue: [PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction + PrimCallCollectsProfileSamples]
- ifFalse: [PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction]].
- ^super primitivePropertyFlagsForSpur: primIndex!
Item was added:
+ ----- Method: CoInterpreterMT>>primitivePropertyFlagsForSpur:numArgs: (in category 'cog jit support') -----
+ primitivePropertyFlagsForSpur: primIndex numArgs: numArgs
+ <inline: true>
+ "Answer any special requirements of the given primitive. Spur always needs to set
+ newMethod so primitives can retry on failure due to forwarders."
+ self cCode: [] inSmalltalk: [#(primitiveRelinquishProcessor)]. "For senders..."
+ primIndex = PrimNumberRelinquishProcessor ifTrue:
+ [^profileSemaphore ~= objectMemory nilObject
+ ifTrue: [PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction + PrimCallCollectsProfileSamples]
+ ifFalse: [PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction]].
+ ^super primitivePropertyFlagsForSpur: primIndex numArgs: numArgs!
Item was changed:
----- Method: CoInterpreterMT>>restoreVMStateFor:threadIndexAndFlags: (in category 'vm scheduling') -----
restoreVMStateFor: vmThread threadIndexAndFlags: threadIndexAndFlags
"We've been preempted; we must restore state and update the threadId
in our process, and may have to put the active process to sleep."
| sched activeProc myProc |
sched := self schedulerPointer.
activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
(threadIndexAndFlags anyMask: OwnVMForeignThreadFlag)
ifTrue:
[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
myProc := objectMemory splObj: foreignCallbackProcessSlot.
self assert: myProc ~= objectMemory nilObject.
objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
self assert: activeProc ~= myProc.
(activeProc ~= objectMemory nilObject
and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
[self putToSleep: activeProc yieldingIf: preemptionYields].
self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
objectMemory
storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
"Only unaffine if the process was affined at this level and did not become bound in the interim."
((threadIndexAndFlags anyMask: ProcessUnaffinedOnDisown)
and: [(self isBoundProcess: myProc) not]) ifTrue:
[self setOwnerIndexOfProcess: myProc to: 0 bind: false].
self initPrimCall.
self cCode:
[self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc]
inSmalltalk:
["Bypass the no-offset stack depth check in the simulator's externalSetStackPageAndPointersForSuspendedContextOfProcess:"
super externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
"We're in ownVM:, hence in a primitive, hence need to include the argument count"
(self isMachineCodeFrame: framePointer) ifTrue:
[self maybeCheckStackDepth: vmThread argumentCount
sp: stackPointer
pc: instructionPointer]].
"If this primitive is called from machine code maintain the invariant that the return pc
of an interpreter callee calling a machine code caller is ceReturnToInterpreterPC."
(vmThread inMachineCode
and: [instructionPointer >= objectMemory startOfMemory]) ifTrue:
[self iframeSavedIP: framePointer put: instructionPointer.
instructionPointer := cogit ceReturnToInterpreterPC].
newMethod := vmThread newMethodOrNull.
argumentCount := vmThread argumentCount.
- primitiveFunctionPointer := vmThread primitiveFunctionPointer.
vmThread newMethodOrNull: nil.
self cCode: '' inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: vmThread index.
self assert: ((range includes: vmThread cStackPointer) and: [range includes: vmThread cFramePointer])].
self setCFramePointer: vmThread cFramePointer setCStackPointer: vmThread cStackPointer.
self assert: newMethod notNil
!
Item was changed:
----- Method: CoInterpreterMT>>saveVMStateFor:threadIndexAndFlags: (in category 'vm scheduling') -----
saveVMStateFor: vmThread threadIndexAndFlags: threadIndexAndFlags
"Save the VM state for the disowning thread."
vmThread
newMethodOrNull: newMethod;
argumentCount: argumentCount;
- primitiveFunctionPointer: primitiveFunctionPointer;
inMachineCode: instructionPointer < objectMemory startOfMemory!
Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveExternalCallNoOp (in category 'other primitives') -----
+ primitiveExternalCallNoOp
+ "No-op for measuring performance of primitiveExternalCall/#117 linkage"
+ <export: true>
+ self methodReturnReceiver!
Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveFastCNoOp (in category 'other primitives') -----
+ primitiveFastCNoOp
+ "No-op for measuring performance of FastCPrimitiveFlag linkage"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
+ self methodReturnReceiver!
Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveFastCNoOpAlignedForFloats (in category 'other primitives') -----
+ primitiveFastCNoOpAlignedForFloats
+ "No-op for measuring performance of FastCPrimitiveFlag+FastCPrimitiveAlignForFloatsFlag linkage"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
+ self methodReturnReceiver!
Item was changed:
----- Method: CoInterpreterPrimitives>>primitiveObjectAtPut (in category 'object access primitives') -----
primitiveObjectAtPut
"Store a literal into a CompiledMethod at the given index. Defined for CompiledMethods only.
We assume that if the user is using this on active code then they will use primitiveVoidVMStateForMethod
to discard the machine code as required."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| thisReceiver rawHeader realHeader index newValue |
newValue := self stackValue: 0.
index := self stackValue: 1.
(objectMemory isNonIntegerObject: index) ifTrue:
[^self primitiveFailFor: PrimErrBadArgument].
index := objectMemory integerValueOf: index.
thisReceiver := self stackValue: 2.
(objectMemory isObjImmutable: thisReceiver) ifTrue:
[^self primitiveFailFor: PrimErrNoModification].
rawHeader := self rawHeaderOf: thisReceiver.
realHeader := (self isCogMethodReference: rawHeader)
ifTrue: [(self cCoerceSimple: rawHeader to: #'CogMethod *') methodHeader]
ifFalse: [rawHeader].
(index > 0
and: [index <= ((objectMemory literalCountOfMethodHeader: realHeader) + LiteralStart)]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
index = 1
ifTrue:
[((objectMemory isNonIntegerObject: newValue)
or: [(objectMemory literalCountOfMethodHeader: newValue) ~= (objectMemory literalCountOfMethodHeader: realHeader)]) ifTrue:
[^self primitiveFailFor: PrimErrBadArgument].
(self isCogMethodReference: rawHeader)
ifTrue: [(self cCoerceSimple: rawHeader to: #'CogMethod *') methodHeader: newValue]
ifFalse: [objectMemory storePointerUnchecked: 0 ofObject: thisReceiver withValue: newValue]]
ifFalse:
[objectMemory storePointer: index - 1 ofObject: thisReceiver withValue: newValue].
self pop: 3 thenPush: newValue!
Item was changed:
----- Method: CoInterpreterPrimitives>>primitiveUnloadModule (in category 'plugin primitives') -----
primitiveUnloadModule
+ "Primitive. Unload the module with the given name.
+ Reloading of the module will happen *later* automatically, when a
+ function from it is called. This is forced by invalidating all external
+ primitive methods and activations in flushExternalPrimitives.
+ N.B. since this is most likely a development time activity we don't care about performance."
+ <primitiveMetadata: #PrimCallMayEndureCodeCompaction>
- "Primitive. Unload the module with the given name."
- "Reloading of the module will happen *later* automatically, when a
- function from it is called. This is ensured by invalidating current sessionID."
| moduleName |
- self methodArgumentCount = 1 ifFalse:[^self primitiveFail].
moduleName := self stackTop.
(objectMemory isBytes: moduleName) ifFalse:[^self primitiveFail].
(self ioUnloadModule: (self oopForPointer: (objectMemory firstIndexableField: moduleName))
+ OfLength: (objectMemory numBytesOfBytes: moduleName)) ifFalse:[^self primitiveFail].
- OfLength: (objectMemory byteSizeOf: moduleName)) ifFalse:[^self primitiveFail].
"N.B. flushExternalPrimitives continues. Do *not* do anything after flushExternalPrimitives in the CoInterpreter"
self forceInterruptCheck.
self flushExternalPrimitives
"NOTREACHED"!
Item was added:
+ ----- Method: CogARMCompiler>>isWithinCallRange: (in category 'testing') -----
+ isWithinCallRange: anAddress
+ "Answer if an address can be reached by a normal Call insruction.
+ We assume this is true for 32-bit processors and expect 64-bit processors to answer false
+ for values in the object memory, and perhaps true in the interpreter."
+ ^self isInImmediateJumpRange: (cogit maximumDistanceFromCodeZone: anAddress)!
Item was added:
+ ----- Method: CogARMv8Compiler>>isWithinCallRange: (in category 'testing') -----
+ isWithinCallRange: anAddress
+ "Answer if an address can be reached by a normal Call insruction.
+ We assume this is true for 32-bit processors and expect 64-bit processors to answer false
+ for values in the object memory, and perhaps true in the interpreter."
+ <inline: true>
+ ^self isInImmediateBranchAndLinkRange: (cogit maximumDistanceFromCodeZone: anAddress)!
Item was added:
+ ----- Method: CogAbstractInstruction>>isWithinCallRange: (in category 'testing') -----
+ isWithinCallRange: anAddress
+ "Answer if an address can be reached by a normal Call insruction.
+ We assume this is true for 32-bit processors and expect 64-bit processors to answer false
+ for values in the object memory, and perhaps true in the interpreter."
+ <inline: true>
+ ^true!
Item was added:
+ ----- Method: CogClass class>>externalCallNoOp (in category 'system primitives') -----
+ externalCallNoOp
+ "No-op for measuring performance of primitiveExternalCall/#117 linkage"
+ <primitive: 'primitiveExternalCallNoOp'>
+ self primitiveFailed
+
+ "Note: #yourself is the equivalent of a machine code primitive noop, albeit with 0 args whereas the below are varargs"
+ "{ [CogClass yourself yourself yourself yourself yourself yourself yourself yourself yourself yourself] bench.
+ [CogClass fastCNoOp fastCNoOp fastCNoOp fastCNoOp fastCNoOp fastCNoOp fastCNoOp fastCNoOp fastCNoOp fastCNoOp] bench.
+ [CogClass fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats fastCNoOpAlignedForFloats] bench.
+ [CogClass externalCallNoOp externalCallNoOp externalCallNoOp externalCallNoOp externalCallNoOp externalCallNoOp externalCallNoOp externalCallNoOp externalCallNoOp externalCallNoOp] bench }"
+
+ "MacBook Pro (16-inch, 2019) 2.6 GHz 6-Core Intel Core i7
+ #( '65,700,000 per second. 15.2 nanoseconds per run. 0 % GC time.'
+ '23,200,000 per second. 43.2 nanoseconds per run. 0 % GC time.'
+ '22,400,000 per second. 44.6 nanoseconds per run. 0 % GC time.'
+ '8,200,000 per second. 122 nanoseconds per run. 0 % GC time.')"!
Item was added:
+ ----- Method: CogClass class>>fastCNoOp (in category 'system primitives') -----
+ fastCNoOp
+ "No-op for measuring performance of FastCPrimitiveFlag linkage"
+ <primitive: 'primitiveFastCNoOp'>
+ self primitiveFailed!
Item was added:
+ ----- Method: CogClass class>>fastCNoOpAlignedForFloats (in category 'system primitives') -----
+ fastCNoOpAlignedForFloats
+ "No-op for measuring performance of FastCPrimitiveFlag+FastCPrimitiveAlignForFloatsFlag linkage"
+ <primitive: 'primitiveFastCNoOpAlignedForFloats'>
+ self primitiveFailed!
Item was changed:
SharedPool subclass: #CogMethodConstants
instanceVariableNames: ''
+ classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallIsExternalCall PrimCallIsInternalPrim PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
- classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallIsExternalCall PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x PrimCallUseCABI ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
poolDictionaries: ''
category: 'VMMaker-JIT'!
Item was added:
+ ----- Method: CogObjectRepresentation>>maybeCompileRetryOf:onPrimitiveFail:flags: (in category 'primitive generators') -----
+ maybeCompileRetryOf: primitiveRoutine onPrimitiveFail: primIndex flags: flags
+ "Object representations with lazy forwarding will want to check for
+ forwarding pointers on primitive failure and retry the primitive if found.
+ By default do nothing."
+ <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
+ <inline: true>!
Item was removed:
- ----- Method: CogObjectRepresentation>>maybeCompileRetryOnPrimitiveFail: (in category 'primitive generators') -----
- maybeCompileRetryOnPrimitiveFail: primIndex
- "Object representations with lazy forwarding will want to check for
- forwarding pointers on primitive failure and retry the primitive if found.
- By default do nothing."
- <inline: true>!
Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>maybeCompileRetryOf:onPrimitiveFail:flags: (in category 'primitive generators') -----
+ maybeCompileRetryOf: primitiveRoutine onPrimitiveFail: primIndex flags: flags
+ "If primIndex has an accessorDepth and fails, or it is external and fails with PrimErrNoMemory,
+ call ceCheckAndMaybeRetryPrimitive if so If ceCheck.... answers true, retry the primitive."
+ <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
+ | jmp |
+ <var: #jmp type: #'AbstractInstruction *'>
+ (coInterpreter accessorDepthForPrimitiveIndex: primIndex) >= 0
+ ifTrue:
+ [jmp := cogit
+ MoveAw: coInterpreter primFailCodeAddress R: TempReg;
+ CmpCq: 0 R: TempReg;
+ JumpZero: 0]
+ ifFalse:
+ [PrimNumberExternalCall ~= primIndex ifTrue:
+ [^0].
+ jmp := cogit
+ MoveAw: coInterpreter primFailCodeAddress R: TempReg;
+ CmpCq: PrimErrNoMemory R: TempReg;
+ JumpNonZero: 0].
+ "newMethod must be set unless it already has been."
+ (flags anyMask: PrimCallNeedsNewMethod) ifFalse:
+ [cogit genLoadNewMethod].
+ "primitiveFunctionPointer must be set"
+ cogit
+ MoveCw: primitiveRoutine asInteger R: TempReg;
+ MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress;
+ compileCallFor: #ceCheckAndMaybeRetryPrimitive:
+ numArgs: 1
+ arg: (cogit trampolineArgConstant: primIndex)
+ arg: nil
+ arg: nil
+ arg: nil
+ resultReg: TempReg
+ regsToSave: cogit emptyRegisterMask.
+ jmp jmpTarget: cogit Label.
+ ^0!
Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>maybeCompileRetryOnPrimitiveFail: (in category 'primitive generators') -----
- maybeCompileRetryOnPrimitiveFail: primIndex
- "If primIndex has an accessorDepth and fails, or it is external and fails with PrimErrNoMemory,
- call ceCheckAndMaybeRetryPrimitive if so If ceCheck.... answers true, retry the primitive."
- | jmp |
- <var: #jmp type: #'AbstractInstruction *'>
- (coInterpreter accessorDepthForPrimitiveIndex: primIndex) >= 0
- ifTrue:
- [jmp := cogit
- MoveAw: coInterpreter primFailCodeAddress R: TempReg;
- CmpCq: 0 R: TempReg;
- JumpZero: 0]
- ifFalse:
- [coInterpreter primNumberExternalCall ~= primIndex ifTrue:
- [^0].
- jmp := cogit
- MoveAw: coInterpreter primFailCodeAddress R: TempReg;
- CmpCq: PrimErrNoMemory R: TempReg;
- JumpNonZero: 0].
- cogit
- compileCallFor: #ceCheckAndMaybeRetryPrimitive:
- numArgs: 1
- arg: (cogit trampolineArgConstant: primIndex)
- arg: nil
- arg: nil
- arg: nil
- resultReg: TempReg
- regsToSave: cogit emptyRegisterMask.
- jmp jmpTarget: cogit Label.
- ^0!
Item was removed:
- ----- Method: CogVMSimulator>>hasFastCLinkage: (in category 'plugin primitive support') -----
- hasFastCLinkage: methodObj
- "Simulation only!!!! the attempt to look up is entirely inappropriate for the real VM!!!!"
- | header primIdx literal metadata |
- objectMemory hasSpurMemoryManagerAPI ifFalse:
- [^false].
- header := objectMemory methodHeaderOf: methodObj.
- primIdx := self primitiveIndexOfMethod: methodObj header: header.
- (primIdx = PrimNumberExternalCall
- and: [(objectMemory literalCountOfMethodHeader: header) > 0
- and: [(objectMemory isArray: (literal := self literal: 0 ofMethod: methodObj))
- and: [(objectMemory numSlotsOf: literal) = 4]]]) ifFalse:
- [^primIdx = PrimNumberObjectAtPut].
- (objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: literal) ~= (objectMemory integerObjectOf: 0) ifTrue:
- [^FastCPrimitiveFlag anyMask: (objectMemory integerValueOf: (objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: literal))].
- ^(self ioLoadFunction: (self stringOf: (objectMemory fetchPointer: ExternalCallLiteralFunctionNameIndex ofObject: literal))
- From: (self stringOf: (objectMemory fetchPointer: ExternalCallLiteralModuleNameIndex ofObject: literal))
- MetadataInto: (self addressOf: metadata put: [:v| metadata := v])) ~= 0
- and: [FastCPrimitiveFlag anyMask: metadata]!
Item was removed:
- ----- Method: CogVMSimulator>>primitivePropertyFlagsForSpur: (in category 'multi-threading simulation switch') -----
- primitivePropertyFlagsForSpur: primIndex
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #primitivePropertyFlagsForSpur:
- withArguments: {primIndex}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was removed:
- ----- Method: CogVMSimulator>>saneFunctionPointerForFailureOfPrimIndex: (in category 'primitive support') -----
- saneFunctionPointerForFailureOfPrimIndex: primIndex
- "For simulation override to do the check specially when the
- primitiveFunctionPointer is an invalid address proxy for a primitive."
- | basePrimitive |
- (instructionPointer < objectMemory nilObject asUnsignedInteger
- and: [primitiveFunctionPointer isInteger
- and: [self isPrimitiveFunctionPointerAnIndex not
- and: [primIndex ~= PrimNumberExternalCall
- and: [(self isMetaPrimitiveIndex: primIndex) not]]]]) ifTrue:
- [basePrimitive := self functionPointerFor: primIndex inClass: objectMemory nilObject.
- ^(cogit lookupAddress: primitiveFunctionPointer) endsWith: basePrimitive].
-
- ^super saneFunctionPointerForFailureOfPrimIndex: primIndex!
Item was changed:
VMStructType subclass: #CogVMThread
+ instanceVariableNames: 'index state priority osSemaphore osThread newMethodOrNull argumentCount inMachineCode cStackPointer cFramePointer awolProcIndex awolProcLength awolProcesses'
- instanceVariableNames: 'index state priority osSemaphore osThread newMethodOrNull argumentCount primitiveFunctionPointer inMachineCode cStackPointer cFramePointer awolProcIndex awolProcLength awolProcesses'
classVariableNames: ''
poolDictionaries: 'VMThreadingConstants'
category: 'VMMaker-Multithreading'!
!CogVMThread commentStamp: '<historical>' prior: 0!
Instances of this class represent control blocks for native threads that cooperatively schedule the VM. See the class comment of CogThreadManager for full documentation.
N.B. awolProcesses must be the last inst var.!
Item was changed:
----- Method: CogVMThread class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
instVarNamesAndTypesForTranslationDo: aBinaryBlock
"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogVMThread struct."
self allInstVarNames do:
[:ivn|
aBinaryBlock
value: ivn
value: (ivn caseOf: {
['awolProcesses'] -> [{#sqInt. '[', CogThreadManager awolProcessesIncrement printString, ']'}].
['cStackPointer'] -> [#usqIntptr_t].
['cFramePointer'] -> [#usqIntptr_t].
- ['primitiveFunctionPointer'] -> [#('void (*' ')()')].
['osSemaphore'] -> ['sqOSSemaphore'].
['osThread'] -> ['sqOSThread'] }
otherwise:
[#sqInt])]!
Item was removed:
- ----- Method: CogVMThread>>primitiveFunctionPointer (in category 'accessing') -----
- primitiveFunctionPointer
- "Answer the value of primitiveFunctionPointer"
-
- ^primitiveFunctionPointer!
Item was removed:
- ----- Method: CogVMThread>>primitiveFunctionPointer: (in category 'accessing') -----
- primitiveFunctionPointer: anObject
- "Set the value of primitiveFunctionPointer"
-
- ^primitiveFunctionPointer := anObject!
Item was added:
+ ----- Method: CogX64Compiler>>isWithinCallRange: (in category 'testing') -----
+ isWithinCallRange: anAddress
+ "Answer if an address can be reached by a normal Call insruction.
+ We assume this is true for 32-bit processors and expect 64-bit processors to answer false
+ for values in the object memory, and perhaps true in the interpreter."
+ <inline: true>
+ ^self is32BitSignedImmediate: (cogit maximumDistanceFromCodeZone: anAddress)!
Item was added:
+ ----- Method: Cogit>>maximumDistanceFromCodeZone: (in category 'compile abstract instructions') -----
+ maximumDistanceFromCodeZone: anAddress
+ ^anAddress > codeBase
+ ifTrue: [anAddress - codeBase]
+ ifFalse: [methodZone zoneEnd - anAddress]!
Item was changed:
----- Method: CroquetPlugin>>primitiveARC4Transform (in category 'cryptography') -----
primitiveARC4Transform
"Perform an ARC4 transform of input.
Arguments:
buffer <ByteArray> transformed data
startIndex <Integer> start of transform
stopIndex <Integer> end of transform
m <ByteArray> key stream data
x <Integer> key state value
y <Integer> key state value
Return value:
x@y - updated key state value
"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "Align in case the compiler identifies and generates vector instructions"
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "Align in case the compiler identifies and generates vector instructions"
| y x mOop stopIndex startIndex bufOop bufSize buffer a m b mask ptOop xOop yOop |
<var: 'buffer' type: #'unsigned char *'>
<var: 'm' type: #'unsigned char *'>
interpreterProxy methodArgumentCount = 6
ifFalse:[^interpreterProxy primitiveFail].
"pick up arguments"
y := interpreterProxy stackIntegerValue: 0.
x := interpreterProxy stackIntegerValue: 1.
mOop := interpreterProxy stackValue: 2.
stopIndex := interpreterProxy stackIntegerValue: 3.
startIndex := interpreterProxy stackIntegerValue: 4.
bufOop := interpreterProxy stackValue: 5.
interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isBytes: mOop)
and: [(interpreterProxy isBytes: bufOop)
and: [(interpreterProxy byteSizeOf: mOop) = 256
and: [startIndex > 0 and: [startIndex <= (bufSize := interpreterProxy byteSizeOf: bufOop)
and: [stopIndex >= startIndex and: [stopIndex <= bufSize]]]]]]) ifFalse:
[^interpreterProxy primitiveFail].
m := interpreterProxy firstIndexableField: mOop.
buffer := interpreterProxy firstIndexableField: bufOop.
startIndex-1 to: stopIndex-1 do:[:i|
x := (x + 1) bitAnd: 255.
a := m at: x.
y := (y + a) bitAnd: 255.
b := m at: y.
m at: x put: b.
m at: y put: a.
mask := m at: ((a + b) bitAnd: 255).
buffer at: i put: ((buffer at: i) bitXor: mask).
].
ptOop := interpreterProxy instantiateClass: interpreterProxy classPoint indexableSize: 0.
self cppIf: #SPURVM
ifTrue:
[xOop := interpreterProxy positive32BitIntegerFor: x.
yOop := interpreterProxy positive32BitIntegerFor: y.
(ptOop isNil or: [xOop isNil or: [yOop isNil]]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: 0 ofObject: ptOop withValue: xOop.
interpreterProxy storePointer: 1 ofObject: ptOop withValue: yOop]
ifFalse:
[interpreterProxy pushRemappableOop: ptOop.
xOop := interpreterProxy positive32BitIntegerFor: x.
interpreterProxy pushRemappableOop: xOop.
yOop := interpreterProxy positive32BitIntegerFor: y.
xOop := interpreterProxy popRemappableOop.
ptOop := interpreterProxy popRemappableOop.
interpreterProxy storePointer: 0 ofObject: ptOop withValue: xOop.
interpreterProxy storePointer: 1 ofObject: ptOop withValue: yOop].
^interpreterProxy methodReturnValue: ptOop!
Item was changed:
----- Method: CroquetPlugin>>primitiveAdj3 (in category 'transforms') -----
primitiveAdj3
"Computes the adjoint of the Matrix4x4 receiver,
placing the results the the Matrix4x4 argument,
"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
|
srcOop src
dstOop dst
m11 m12 m13 m21 m22 m23 m31 m32 m33
c11 c12 c13 c21 c22 c23 c31 c32 c33
|
<var: #c11 declareC: 'const int c11 = 0'>
<var: #c12 declareC: 'const int c12 = 1'>
<var: #c13 declareC: 'const int c13 = 2'>
"<var: #c14 declareC: 'const int c14 = 3'>"
<var: #c21 declareC: 'const int c21 = 4'>
<var: #c22 declareC: 'const int c22 = 5'>
<var: #c23 declareC: 'const int c23 = 6'>
"<var: #c24 declareC: 'const int c24 = 7'>"
<var: #c31 declareC: 'const int c31 = 8'>
<var: #c32 declareC: 'const int c32 = 9'>
<var: #c33 declareC: 'const int c33 = 10'>
"<var: #c34 declareC: 'const int c34 = 11'>"
<var: #m11 type: #double>
<var: #m12 type: #double>
<var: #m13 type: #double>
<var: #m21 type: #double>
<var: #m22 type: #double>
<var: #m23 type: #double>
<var: #m31 type: #double>
<var: #m32 type: #double>
<var: #m33 type: #double>
"then we need the following no-op to make Smalltalk shut up about vars not being initted."
self cCode: '' inSmalltalk: [
c11 := 0.
c12 := 1.
c13 := 2.
"c14 := 3."
c21 := 4.
c22 := 5.
c23 := 6.
"c24 := 7."
c31 := 8.
c32 := 9.
c33 := 10.
"c34 := 11."
].
"NOTE: the bottom row of a OpenGL-ordered matrix is always 0 0 0 1,
so we don't need consts here for those elements."
srcOop := interpreterProxy stackObjectValue: 1.
dstOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:
[^nil].
src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: #'float *'.
dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: #'float *'.
"read in the source matrix 3x3, which contains the encoded rotation and scale factors"
m11 := src at: c11.
m12 := src at: c12.
m13 := src at: c13.
m21 := src at: c21.
m22 := src at: c22.
m23 := src at: c23.
m31 := src at: c31.
m32 := src at: c32.
m33 := src at: c33.
"do the actual work"
"compute our cofactors and transpose. adj = transpose of cofactors"
dst at: c11 put: ((m22 * m33) - (m23 * m32)) .
dst at: c21 put: (0.0 - ((m21 * m33) - (m23 * m31))).
dst at: c31 put: ((m21 * m32) - (m22 * m31)).
dst at: c12 put: (0.0 - ((m12 * m33) - (m13 * m32))).
dst at: c22 put: ((m11 * m33) - (m13 * m31)).
dst at: c32 put: (0.0 - ((m11 * m32) - (m12 * m31))).
dst at: c13 put: ((m12 * m23) - (m13 * m22)).
dst at: c23 put: (0.0 - ((m11 * m23) - (m13 * m21))).
dst at: c33 put: ((m11 * m22) - (m12 * m21)).
^interpreterProxy methodReturnValue: dstOop!
Item was changed:
----- Method: CroquetPlugin>>primitiveDet3 (in category 'transforms') -----
primitiveDet3
"Computes the determinant of the upper 3x3 of a Matrix4x4"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| srcOop src m11 m12 m13 m21 m22 m23 m31 m32 m33 |
<var: #m11 type: #double>
<var: #m12 type: #double>
<var: #m13 type: #double>
<var: #m21 type: #double>
<var: #m22 type: #double>
<var: #m23 type: #double>
<var: #m31 type: #double>
<var: #m32 type: #double>
<var: #m33 type: #double>
"
Load element vars using C version of Matrix4x4 storage, as 0-based, 1-dimensional array:
0 1 2 3
4 5 6 7
8 9 10 11
"
srcOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:
[^nil].
src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: #'float *'.
m11 := src at: 0.
m12 := src at: 1.
m13 := src at: 2.
m21 := src at: 4.
m22 := src at: 5.
m23 := src at: 6.
m31 := src at: 8.
m32 := src at: 9.
m33 := src at: 10.
^interpreterProxy methodReturnFloat: (m11 * ((m22 * m33) - (m23 * m32)))
+ (m12 * ((m23 * m31) - (m21 * m33)))
+ + (m13 * ((m21 * m32) - (m22 * m31)))!
- + (m13 * ((m21 * m32) - (m22 * m31)))
- !
Item was changed:
----- Method: CroquetPlugin>>primitiveInplaceHouseHolderInvert (in category 'transforms') -----
primitiveInplaceHouseHolderInvert
"Primitive. Perform an inplace house holder matrix inversion"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr d x sigma beta sum s m |
<var: #rcvr type: #'float *'>
<var: #m declareC:'double m[4][4]'>
<var: #x declareC:'double x[4][4] = { {1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1} }'>
<var: #d declareC:'double d[4][4]'>
<var: #sigma type: #double>
<var: #beta type: #double>
<var: #sum type: #double>
<var: #s type: #double>
self cCode:'' inSmalltalk:[
m := CArrayAccessor on:
((1 to: 4) collect:[:i| CArrayAccessor on: (Array new: 4)]).
x := CArrayAccessor on: (Array
with: (CArrayAccessor on: #(1.0 0.0 0.0 0.0) copy)
with: (CArrayAccessor on: #(0.0 1.0 0.0 0.0) copy)
with: (CArrayAccessor on: #(0.0 0.0 1.0 0.0) copy)
with: (CArrayAccessor on: #(0.0 0.0 0.0 1.0) copy)).
d := CArrayAccessor on:
((1 to: 4) collect:[:i| CArrayAccessor on: (Array new: 4)]).
].
rcvr := self stackMatrix: 0.
rcvr ifNil:
[^interpreterProxy primitiveFail].
0 to: 3 do:[:i| 0 to: 3 do:[:j|
(m at: i) at: j put: (rcvr at: i*4+j)]].
0 to: 3 do:[:j|
sigma := 0.0.
j to: 3 do:[:i| sigma := sigma + (((m at: i) at: j) * ((m at: i) at: j))].
sigma < 1.0e-10 ifTrue:[^interpreterProxy primitiveFail]. "matrix is singular"
(((m at: j) at: j) < 0.0)
ifTrue:[ s:= sigma sqrt]
ifFalse:[ s:= 0.0 - sigma sqrt].
0 to: 3 do:[:r| (d at: j) at: r put: s].
beta := 1.0 / ( s * ((m at: j) at: j) - sigma).
(m at: j) at: j put: (((m at: j) at: j) - s).
"update remaining columns"
j+1 to: 3 do:[:k|
sum := 0.0.
j to: 3 do:[:i| sum := sum + (((m at: i) at: j) * ((m at: i) at: k))].
sum := sum * beta.
j to: 3 do:[:i|
(m at: i) at: k put: (((m at: i) at: k) + (((m at: i) at: j) * sum))]].
"update vector"
0 to: 3 do:[:r|
sum := 0.0.
j to: 3 do:[:i|
sum := sum + (((x at: i) at: r) * ((m at: i) at: j))].
sum := sum * beta.
j to: 3 do:[:i|
(x at: i) at: r put:(((x at: i) at: r) + (sum * ((m at: i) at: j)))].
].
].
"Now calculate result"
0 to: 3 do:[:r|
3 to: 0 by: -1 do:[:i|
i+1 to: 3 do:[:j|
(x at: i) at: r put: (((x at: i) at: r) - (((x at: j) at: r) * ((m at: i) at: j))) ].
(x at: i) at: r put: (((x at: i) at: r) / ((d at: i) at: r))].
].
0 to: 3 do:[:i| 0 to: 3 do:[:j|
rcvr at: i*4+j put: (self cCoerce: ((x at: i) at: j) to:'float')]].
"Return receiver"
^nil!
Item was changed:
----- Method: CroquetPlugin>>primitiveInverseByAdjoint (in category 'transforms') -----
primitiveInverseByAdjoint
"Computes the inverse of the Matrix4x4 receiver, using the 'classical adjoint' method,
placing the results the the Matrix4x4 argument,
"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
|
srcOop src
dstOop dst
det
m11 m12 m13 m21 m22 m23 m31 m32 m33
c11 c12 c13 c14 c21 c22 c23 c24 c31 c32 c33 c34
x y z
|
<var: #c11 declareC: 'const int c11 = 0'>
<var: #c12 declareC: 'const int c12 = 1'>
<var: #c13 declareC: 'const int c13 = 2'>
<var: #c14 declareC: 'const int c14 = 3'>
<var: #c21 declareC: 'const int c21 = 4'>
<var: #c22 declareC: 'const int c22 = 5'>
<var: #c23 declareC: 'const int c23 = 6'>
<var: #c24 declareC: 'const int c24 = 7'>
<var: #c31 declareC: 'const int c31 = 8'>
<var: #c32 declareC: 'const int c32 = 9'>
<var: #c33 declareC: 'const int c33 = 10'>
<var: #c34 declareC: 'const int c34 = 11'>
<var: #m11 type: #double>
<var: #m12 type: #double>
<var: #m13 type: #double>
<var: #m21 type: #double>
<var: #m22 type: #double>
<var: #m23 type: #double>
<var: #m31 type: #double>
<var: #m32 type: #double>
<var: #m33 type: #double>
<var: #x type:#double>
<var: #y type:#double>
<var: #z type:#double>
<var: #det type:#double>
"then we need the following no-op to make Smalltalk shut up about vars not being initted."
self cCode: '' inSmalltalk: [
c11 := 0.
c12 := 1.
c13 := 2.
c14 := 3.
c21 := 4.
c22 := 5.
c23 := 6.
c24 := 7.
c31 := 8.
c32 := 9.
c33 := 10.
c34 := 11.
].
"NOTE: the bottom row of a OpenGL-ordered matrix is always 0 0 0 1,
so we don't need consts here for those elements."
"do the dance to get our receiver and argument"
srcOop := interpreterProxy stackValue: 1.
dstOop := interpreterProxy stackValue: 0.
interpreterProxy failed ifTrue:
[^nil].
src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: #'float *'.
dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: #'float *'.
"read in the source matrix 3x3, which contains the encoded rotation and scale factors"
m11 := src at: c11.
m12 := src at: c12.
m13 := src at: c13.
m21 := src at: c21.
m22 := src at: c22.
m23 := src at: c23.
m31 := src at: c31.
m32 := src at: c32.
m33 := src at: c33.
"read in the source translation vector"
x := src at: c14.
y := src at: c24.
z := src at: c34.
"do the actual work"
"first, compute the determinant of the upper 3x3 of the source"
det :=
( m11 * ((m22 * m33) - (m23 * m32))) +
(m12 * ((m23 * m31) - (m21 * m33))) +
(m13 * ((m21 * m32) - (m22 * m31))).
"Compute the classical adjunct of the source, and divide by the source determinant
storing in the destination. adjoint = transpose of cofactors, so we'll transpose as we store."
det := 1 / det. "let's make div by det a multiply"
dst at: c11 put: ((m22 * m33) - (m23 * m32)) * det .
dst at: c21 put: (0.0 - ((m21 * m33) - (m23 * m31))) * det.
dst at: c31 put: ((m21 * m32) - (m22 * m31)) * det.
dst at: c12 put: (0.0 - ((m12 * m33) - (m13 * m32))) * det.
dst at: c22 put: ((m11 * m33) - (m13 * m31)) * det.
dst at: c32 put: (0.0 - ((m11 * m32) - (m12 * m31))) * det.
dst at: c13 put: ((m12 * m23) - (m13 * m22)) * det.
dst at: c23 put: (0.0 - ((m11 * m23) - (m13 * m21))) * det.
dst at: c33 put: ((m11 * m22) - (m12 * m21)) * det.
"finally, apply the inversed rotation transform to our translation"
"read in the source matrix 3x3"
m11 := dst at: c11.
m12 := dst at: c12.
m13 := dst at: c13.
m21 := dst at: c21.
m22 := dst at: c22.
m23 := dst at: c23.
m31 := dst at: c31.
m32 := dst at: c32.
m33 := dst at: c33.
dst at: c14 put: 0.0 - ((x * m11) + (y * m12) + (z * m13)).
dst at: c24 put: 0.0 - ((x * m21) + (y * m22) + (z * m23)).
dst at: c34 put: 0.0 - ((x * m31) + (y * m32) + (z * m33)).
^interpreterProxy methodReturnValue: dstOop!
Item was changed:
----- Method: CroquetPlugin>>primitiveMD5Transform (in category 'cryptography') -----
primitiveMD5Transform
"Perform an MD5 transform of input"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "Align in case the compiler identifies and generates vector instructions"
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "Align in case the compiler identifies and generates vector instructions"
| bufOop hashOop |
hashOop := interpreterProxy stackValue: 0.
bufOop := interpreterProxy stackValue: 1.
((interpreterProxy isWords: hashOop) and: [(interpreterProxy slotSizeOf: hashOop) = 4
and: [(interpreterProxy isWords: bufOop) and: [(interpreterProxy slotSizeOf: bufOop) = 16]]])
ifFalse:
[^interpreterProxy primitiveFail].
self MD5Transform: (interpreterProxy firstIndexableField: hashOop) _: (interpreterProxy firstIndexableField: bufOop).
^interpreterProxy methodReturnValue: bufOop!
Item was changed:
----- Method: CroquetPlugin>>primitiveOrthoNormInverseMatrix (in category 'transforms') -----
primitiveOrthoNormInverseMatrix
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| srcOop dstOop src dst x y z rx ry rz |
<var: #x type: #double>
<var: #y type: #double>
<var: #z type: #double>
<var: #rx type: #double>
<var: #ry type: #double>
<var: #rz type: #double>
srcOop := interpreterProxy stackValue: 0.
((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16]) ifFalse:
[^interpreterProxy primitiveFail].
dstOop := interpreterProxy cloneObject: srcOop.
dstOop = 0 ifTrue:
[^interpreterProxy primitiveFail].
"reload srcOop in case of GC"
self cppIf: #SPURVM ifFalse: [srcOop := interpreterProxy stackValue: 0].
src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: #'float *'.
dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: #'float *'.
"Transpose upper 3x3 matrix"
"dst at: 0 put: (src at: 0)." dst at: 1 put: (src at: 4). dst at: 2 put: (src at: 8).
dst at: 4 put: (src at: 1). "dst at: 5 put: (src at: 5)." dst at: 6 put: (src at: 9).
dst at: 8 put: (src at: 2). dst at: 9 put: (src at: 6). "dst at: 10 put: (src at: 10)."
"Compute inverse translation vector"
x := src at: 3.
y := src at: 7.
z := src at: 11.
rx := (x * (dst at: 0)) + (y * (dst at: 1)) + (z * (dst at: 2)).
ry := (x * (dst at: 4)) + (y * (dst at: 5)) + (z * (dst at: 6)).
rz := (x * (dst at: 8)) + (y * (dst at: 9)) + (z * (dst at: 10)).
dst at: 3 put: 0.0 - rx.
dst at: 7 put: 0.0 - ry.
dst at: 11 put: 0.0 - rz.
^interpreterProxy methodReturnValue: dstOop!
Item was changed:
----- Method: CroquetPlugin>>primitiveTransformDirection (in category 'transforms') -----
primitiveTransformDirection
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| x y z rx ry rz matrix vertex v3Oop |
<var: #x type: #double>
<var: #y type: #double>
<var: #z type: #double>
<var: #rx type: #double>
<var: #ry type: #double>
<var: #rz type: #double>
matrix := self stackMatrix: 1.
v3Oop := interpreterProxy stackValue: 0.
(matrix notNil and: [(interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3]]) ifFalse:
[^interpreterProxy primitiveFail].
vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
x := vertex at: 0.
y := vertex at: 1.
z := vertex at: 2.
rx := (x * (matrix at: 0)) + (y * (matrix at: 1)) + (z * (matrix at: 2)).
ry := (x * (matrix at: 4)) + (y * (matrix at: 5)) + (z * (matrix at: 6)).
rz := (x * (matrix at: 8)) + (y * (matrix at: 9)) + (z * (matrix at: 10)).
v3Oop := interpreterProxy cloneObject: v3Oop.
v3Oop = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
vertex at: 0 put: rx.
vertex at: 1 put: ry.
vertex at: 2 put: rz.
^interpreterProxy methodReturnValue: v3Oop!
Item was changed:
----- Method: CroquetPlugin>>primitiveTransformMatrixWithInto (in category 'transforms') -----
primitiveTransformMatrixWithInto
"Transform two matrices into the third"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| m1 m2 m3 |
m3 := self stackMatrix: 0.
m2 := self stackMatrix: 1.
m1 := self stackMatrix: 2.
(m1 isNil or: [m2 isNil or: [m3 isNil
or: [m2 = m3]]]) ifTrue:
[^interpreterProxy primitiveFail].
self transformMatrix: m1 with: m2 into: m3.
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: CroquetPlugin>>primitiveTransformVector3 (in category 'transforms') -----
primitiveTransformVector3
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| x y z rx ry rz rw matrix vertex v3Oop |
<var: #x type: #double>
<var: #y type: #double>
<var: #z type: #double>
<var: #rx type: #double>
<var: #ry type: #double>
<var: #rz type: #double>
<var: #rw type: #double>
matrix := self stackMatrix: 1.
v3Oop := interpreterProxy stackValue: 0.
(matrix notNil and: [(interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3]]) ifFalse:
[^interpreterProxy primitiveFail].
vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
x := vertex at: 0.
y := vertex at: 1.
z := vertex at: 2.
rx := (x * (matrix at: 0)) + (y * (matrix at: 1)) + (z * (matrix at: 2)) + (matrix at: 3).
ry := (x * (matrix at: 4)) + (y * (matrix at: 5)) + (z * (matrix at: 6)) + (matrix at: 7).
rz := (x * (matrix at: 8)) + (y * (matrix at: 9)) + (z * (matrix at: 10)) + (matrix at: 11).
rw := (x * (matrix at: 12)) + (y * (matrix at: 13)) + (z * (matrix at: 14)) + (matrix at: 15).
v3Oop := interpreterProxy cloneObject: v3Oop.
v3Oop = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
rw = 1.0 ifTrue:[
vertex at: 0 put: rx.
vertex at: 1 put: ry.
vertex at: 2 put: rz.
] ifFalse:[
rw = 0.0
ifTrue:[rw := 0.0]
ifFalse:[rw := 1.0 / rw].
vertex at: 0 put: rx * rw.
vertex at: 1 put: ry * rw.
vertex at: 2 put: rz * rw.
].
^interpreterProxy methodReturnValue: v3Oop!
Item was changed:
----- Method: CroquetPlugin>>primitiveTriBoxIntersects (in category 'transforms') -----
primitiveTriBoxIntersects
"Primitive. Answer whether an AABB intersects with a given triangle"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| minCorner maxCorner v0 v1 v2 result |
v2 := self stackVector3: 0.
v1 := self stackVector3: 1.
v0 := self stackVector3: 2.
maxCorner := self stackVector3: 3.
minCorner := self stackVector3: 4.
(v0 isNil or: [v1 isNil or: [v2 isNil
or: [maxCorner isNil or: [minCorner isNil]]]]) ifTrue:
[^interpreterProxy primitiveFail].
"N.B. as of 8/2021 triBoxOverlap is simply a stub."
result := self triBoxOverlap: minCorner _: maxCorner _: v0 _: v1 _: v2.
result < 0 ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnBool: result > 0!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>primNumberExternalCall (in category 'accessing') -----
- primNumberExternalCall
- ^coInterpreter primNumberExternalCall!
Item was changed:
----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>accessorDepthForPrimitiveIndex: (in category 'accessing') -----
accessorDepthForPrimitiveIndex: anInteger
+ ^(StackInterpreterPrimitives primitiveMetadataTable at: anInteger + 1) >>> SpurPrimitiveAccessorDepthShift!
- ^StackInterpreterPrimitives primitiveAccessorDepthTable at: anInteger + 1!
Item was changed:
----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>accessorDepthForPrimitiveMethod: (in category 'accessing') -----
accessorDepthForPrimitiveMethod: methodOop
| primIndex |
primIndex := self primitiveIndexOf: methodOop.
^primIndex = PrimNumberExternalCall
ifTrue: [self accessorDepthForExternalPrimitiveMethod: methodOop]
ifFalse:
+ [coInterpreter computeAccessorDepthsForInterpreterPrimitives.
- [coInterpreter computeAccessorDepthsForInterpreterPrmitives.
coInterpreter accessorDepthForPrimitiveIndex: primIndex]!
Item was changed:
----- Method: FFTPlugin>>primitiveFFTPermuteData (in category 'primitives') -----
primitiveFFTPermuteData
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
(self loadFFTFrom: (interpreterProxy stackValue: 0)) ifFalse:[^nil].
self permuteData.
interpreterProxy failed ifTrue:
"permuteData went wrong. Do the permutation again -- this will restore the original order"
+ [self permuteData]!
- [self permuteData].!
Item was changed:
----- Method: FFTPlugin>>primitiveFFTScaleData (in category 'primitives') -----
primitiveFFTScaleData
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
(self loadFFTFrom: (interpreterProxy stackValue: 0)) ifFalse:[^nil].
self scaleData!
Item was changed:
----- Method: FFTPlugin>>primitiveFFTTransformData (in category 'primitives') -----
primitiveFFTTransformData
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| forward |
forward := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
(self loadFFTFrom: (interpreterProxy stackValue: 1)) ifFalse:[^nil].
self transformData: forward.
interpreterProxy failed ifFalse:
[interpreterProxy pop: 1] "Leave rcvr on stack"!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveAddFloat64Array (in category 'arithmetic primitives') -----
primitiveAddFloat64Array
"Primitive. Add the receiver and the argument, both Float64Arrays and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'double *'>
<var: #argPtr type: #'double *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isLong64s: arg)
and: [(interpreterProxy isLong64s: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (rcvrPtr at: i) + (argPtr at: i)].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveAddScalar (in category 'arithmetic primitives') -----
primitiveAddScalar
"Primitive. Add the argument, a scalar value to the receiver, a Float64Array"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'double *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (rcvrPtr at: i) + value].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveAt (in category 'access primitives') -----
primitiveAt
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| index rcvr doublePtr |
<var: #doublePtr type: #'double *'>
index := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy failed not
and: [(interpreterProxy isLong64s: rcvr)
and: [index > 0 and: [index <= (interpreterProxy slotSizeOf: rcvr)]]]) ifFalse:
[^interpreterProxy primitiveFail].
doublePtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
^interpreterProxy methodReturnFloat: (doublePtr at: index - 1)!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveAtPut (in category 'access primitives') -----
primitiveAtPut
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| value floatValue index rcvr doublePtr |
<var: #floatValue type: #double>
<var: #doublePtr type: #'double *'>
value := interpreterProxy stackValue: 0.
floatValue := (interpreterProxy isIntegerObject: value)
ifTrue: [(interpreterProxy integerValueOf: value) asFloat]
ifFalse: [interpreterProxy floatValueOf: value].
index := interpreterProxy stackIntegerValue: 1.
rcvr := interpreterProxy stackValue: 2.
(interpreterProxy failed not
and: [(interpreterProxy isLong64s: rcvr)
and: [index > 0 and: [index <= (interpreterProxy slotSizeOf: rcvr)]]]) ifFalse:
[^interpreterProxy primitiveFail].
doublePtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
doublePtr at: index-1 put: floatValue.
^interpreterProxy methodReturnValue: value!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveDivFloat64Array (in category 'arithmetic primitives') -----
primitiveDivFloat64Array
"Primitive. Divide each element in the receiver by the corresponding element in the argument, both Float64Arrays, and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'double *'>
<var: #argPtr type: #'double *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isLong64s: arg)
and: [(interpreterProxy isLong64s: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'double *'.
"Check if any of the argument's values is zero"
0 to: length - 1 do:
[:i| (argPtr at: i) = 0.0 ifTrue: "i.e. check for both 0.0 and -0.0"
[^interpreterProxy primitiveFail]].
0 to: length - 1 do:
[:i| rcvrPtr at: i put: (rcvrPtr at: i) / (argPtr at: i)].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveDivScalar (in category 'arithmetic primitives') -----
primitiveDivScalar
"Primitive. Divide each element in the receiver by the argument, a scalar, and store the result into the receiver, a Float64Array"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'double *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (rcvrPtr at: i) / value.
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveDotProduct (in category 'arithmetic primitives') -----
primitiveDotProduct
"Primitive. Compute the dot product of the receiver and the argument, both Float64Arrays.
The dot product is defined as the sum of the products of the individual elements."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length result |
<var: #result type: #double>
<var: #rcvrPtr type: #'double *'>
<var: #argPtr type: #'double *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isLong64s: arg)
and: [(interpreterProxy isLong64s: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'double *'.
result := 0.0.
0 to: length-1 do:[:i|
result := result + ((rcvrPtr at: i) * (argPtr at: i)).
].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveEqual (in category 'access primitives') -----
primitiveEqual
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'double *'>
<var: #argPtr type: #'double *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isLong64s: arg)
and: [(interpreterProxy isLong64s: rcvr)]) ifFalse:
[^interpreterProxy primitiveFail].
(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr) ifFalse:
[^interpreterProxy methodReturnBool: false].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'double *'.
0 to: length-1 do:[:i|
(rcvrPtr at: i) = (argPtr at: i) ifFalse:[^interpreterProxy methodReturnBool: false].
].
^interpreterProxy methodReturnBool: true!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveFromFloatArray (in category 'access primitives') -----
primitiveFromFloatArray
"Primitive. Set each element of the receiver, a Float64Array with that of the argument, a FloatArray and return the receiver.
Fail if both have different size"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'double *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isLong64s: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (argPtr at: i) to: #double)].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveHashArray (in category 'access primitives') -----
primitiveHashArray
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length result |
<var: #rcvrPtr type: #'unsigned int *'>
<var: #result type: #'unsigned int'>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'unsigned int *'.
result := 0.
0 to: length*2-1 do:[:i|
result := result + (rcvrPtr at: i).
].
^interpreterProxy methodReturnInteger: (result bitAnd: 16r1FFFFFFF)!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveLength (in category 'arithmetic primitives') -----
primitiveLength
"Primitive. Compute the length of the argument (sqrt of sum of component squares)."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length len |
<var: #rcvrPtr type: #'double *'>
<var: #len type: #double>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
len := 0.0.
0 to: length-1 do:
[:i| len := len + ((rcvrPtr at: i) * (rcvrPtr at: i)) ].
len > 0.0 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
^interpreterProxy methodReturnFloat: (self sqrt: len)!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveMulFloat64Array (in category 'arithmetic primitives') -----
primitiveMulFloat64Array
"Primitive. Multiply the receiver and the argument, both Float64Arrays and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'double *'>
<var: #argPtr type: #'double *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isLong64s: arg)
and: [(interpreterProxy isLong64s: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (rcvrPtr at: i) * (argPtr at: i).
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveMulScalar (in category 'arithmetic primitives') -----
primitiveMulScalar
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
"Primitive. Multiply elements in the receiver, a Float64Array, by argument, a scalar value, and store the result into the receiver."
| rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'double *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (rcvrPtr at: i) * value.
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveNormalize (in category 'arithmetic primitives') -----
primitiveNormalize
"Primitive. Normalize the argument (A Float64Array) in place."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length len |
<var: #rcvrPtr type: #'double *'>
<var: #len type: #double>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
len := 0.0.
0 to: length - 1 do:
[:i| len := len + ((rcvrPtr at: i) * (rcvrPtr at: i)) ].
len > 0.0 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
len := self sqrt: len.
0 to: length - 1 do:
[:i| rcvrPtr at: i put: (rcvrPtr at: i) / len ].
"Leave receiver on the stack."!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveSubFloat64Array (in category 'arithmetic primitives') -----
primitiveSubFloat64Array
"Primitive. Subtract each element in the argument from each element in the receiver, both Float64Arrays and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'double *'>
<var: #argPtr type: #'double *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isLong64s: arg)
and: [(interpreterProxy isLong64s: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (rcvrPtr at: i) - (argPtr at: i).
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveSubScalar (in category 'arithmetic primitives') -----
primitiveSubScalar
"Primitive. Subtract the argument, a scalar value from each element in the receiver, a Float64Array"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'double *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (rcvrPtr at: i) - value.
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: Float64ArrayPlugin>>primitiveSum (in category 'arithmetic primitives') -----
primitiveSum
"Primitive. Answer the sum of each float in the receiver, a Float64Array."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length sum |
<var: #sum type: #double>
<var: #rcvrPtr type: #'double *'>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isLong64s: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'double *'.
sum := 0.0.
0 to: length-1 do:[:i|
sum := sum + (rcvrPtr at: i).
].
^interpreterProxy methodReturnFloat: sum!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAddFloatArray (in category 'arithmetic primitives') -----
primitiveAddFloatArray
"Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) + (self cCoerce: (argPtr at: i) to: #double)].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAddScalar (in category 'arithmetic primitives') -----
primitiveAddScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'float *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) + value].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAt (in category 'access primitives') -----
primitiveAt
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| index rcvr floatPtr |
<var: #floatPtr type: #'float *'>
index := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy failed not
and: [(interpreterProxy isWords: rcvr)
and: [index > 0 and: [index <= (interpreterProxy slotSizeOf: rcvr)]]]) ifFalse:
[^interpreterProxy primitiveFail].
floatPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
^interpreterProxy methodReturnFloat: (floatPtr at: index - 1)!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAtPut (in category 'access primitives') -----
primitiveAtPut
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| value floatValue index rcvr floatPtr |
<var: #floatValue type: #double>
<var: #floatPtr type: #'float *'>
value := interpreterProxy stackValue: 0.
floatValue := (interpreterProxy isIntegerObject: value)
ifTrue: [(interpreterProxy integerValueOf: value) asFloat]
ifFalse: [interpreterProxy floatValueOf: value].
index := interpreterProxy stackIntegerValue: 1.
rcvr := interpreterProxy stackValue: 2.
(interpreterProxy failed not
and: [(interpreterProxy isWords: rcvr)
and: [index > 0 and: [index <= (interpreterProxy slotSizeOf: rcvr)]]]) ifFalse:
[^interpreterProxy primitiveFail].
floatPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
floatPtr at: index-1 put: (self cCoerce: floatValue to: #float).
^interpreterProxy methodReturnValue: value!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDivFloatArray (in category 'arithmetic primitives') -----
primitiveDivFloatArray
"Primitive. Divide each element in the receiver by the corresponding element in the argument, both FloatArrays, and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
"Check if any of the argument's values is zero"
0 to: length - 1 do:
[:i| (argPtr at: i) = (self cCoerce: 0.0 to: #float) ifTrue: "i.e. check for both 0.0 and -0.0"
[^interpreterProxy primitiveFail]].
0 to: length - 1 do:
[:i| rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) / (self cCoerce: (argPtr at: i) to: #double)].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDivScalar (in category 'arithmetic primitives') -----
primitiveDivScalar
"Primitive. Divide each element in the receiver by the argument, a scalar, and store the result into the receiver, a FloatArray"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr value inverse length |
<var: #inverse type:'double '>
<var: #value type: #double>
<var: #rcvrPtr type:#'float *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
inverse := 1.0 / value.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) * inverse.
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDotProduct (in category 'arithmetic primitives') -----
primitiveDotProduct
"Primitive. Compute the dot product of the receiver and the argument.
The dot product is defined as the sum of the products of the individual elements."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length result |
<var: #result type: #double>
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
result := 0.0.
0 to: length-1 do:[:i|
result := result + ((self cCoerce: (rcvrPtr at: i) to: #double) * (self cCoerce: (argPtr at: i) to: #double)).
].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveEqual (in category 'access primitives') -----
primitiveEqual
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)]) ifFalse:
[^interpreterProxy primitiveFail].
(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr) ifFalse:
[^interpreterProxy methodReturnBool: false].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
0 to: length-1 do:[:i|
(rcvrPtr at: i) = (argPtr at: i) ifFalse:[^interpreterProxy methodReturnBool: false].
].
^interpreterProxy methodReturnBool: true!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveFromFloat64Array (in category 'access primitives') -----
primitiveFromFloat64Array
"Primitive. Set each element of the receiver, a FloatArray with that of the argument, a Float64Array and return the receiver.
Note that this conversion might loose bits, or generate overflow.
Fail if both have different size"
<option: #SpurObjectMemory>
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'double *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isLong64s: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'double *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (argPtr at: i) to: #float)].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveHashArray (in category 'access primitives') -----
primitiveHashArray
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length result |
<var: #rcvrPtr type: #'unsigned int *'>
<var: #result type: #'unsigned int'>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'unsigned int *'.
result := 0.
0 to: length-1 do:[:i|
result := result + (rcvrPtr at: i).
].
^interpreterProxy methodReturnInteger: (result bitAnd: 16r1FFFFFFF)!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveLength (in category 'arithmetic primitives') -----
primitiveLength
"Primitive. Compute the length of the argument (sqrt of sum of component squares)."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length len |
<var: #rcvrPtr type: #'float *'>
<var: #len type: #double>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
len := 0.0.
0 to: length-1 do:
[:i| len := len + ((self cCoerce: (rcvrPtr at: i) to: #double) * (self cCoerce: (rcvrPtr at: i) to: #double)) ].
len > 0.0 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
^interpreterProxy methodReturnFloat: (self sqrt: len)!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveMulFloatArray (in category 'arithmetic primitives') -----
primitiveMulFloatArray
"Primitive. Multiply the receiver and the argument, both FloatArrays and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) * (self cCoerce: (argPtr at: i) to: #double).
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveMulScalar (in category 'arithmetic primitives') -----
primitiveMulScalar
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
"Primitive. Multiply elements in the receiver, a FloatArray, by argument, a scalar value, and store the result into the receiver."
| rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'float *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) * value.
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveNormalize (in category 'arithmetic primitives') -----
primitiveNormalize
"Primitive. Normalize the argument (A FloatArray) in place."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length len |
<var: #rcvrPtr type: #'float *'>
<var: #len type: #double>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
len := 0.0.
0 to: length - 1 do:
[:i| len := len + ((self cCoerce: (rcvrPtr at: i) to: #double) * (self cCoerce: (rcvrPtr at: i) to: #double)) ].
len > 0.0 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
len := self sqrt: len.
0 to: length - 1 do:
[:i| rcvrPtr at: i put: ((self cCoerce: (rcvrPtr at: i) to: #double) / len) ].
"Leave receiver on the stack."!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSubFloatArray (in category 'arithmetic primitives') -----
primitiveSubFloatArray
"Primitive. Subtract each element in the argument from each element in the receiver, both FloatArrays and store the result into the receiver."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) - (self cCoerce: (argPtr at: i) to: #double).
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSubScalar (in category 'arithmetic primitives') -----
primitiveSubScalar
"Primitive. Subtract the argument, a scalar value from each element in the receiver, a FloatArray"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'float *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) - value.
].
^interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSum (in category 'arithmetic primitives') -----
primitiveSum
"Primitive. Answer the sum of each float in the receiver, a FloatArray."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr rcvrPtr length sum |
<var: #sum type: #double>
<var: #rcvrPtr type: #'float *'>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
sum := 0.0.
0 to: length-1 do:[:i|
sum := sum + (self cCoerce: (rcvrPtr at: i) to: #double).
].
^interpreterProxy methodReturnFloat: sum!
Item was changed:
----- Method: FloatMathPlugin>>primitiveArcCos (in category 'float primitives') -----
primitiveArcCos
"Computes acos(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_acos(rcvr)' inSmalltalk: [rcvr arcCos].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveArcCosH (in category 'float primitives') -----
primitiveArcCosH
"Computes acosh(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_acosh(rcvr)' inSmalltalk: [rcvr arcCosH].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveArcSin (in category 'float primitives') -----
primitiveArcSin
"Computes asin(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_asin(rcvr)' inSmalltalk: [rcvr arcSin].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveArcSinH (in category 'float primitives') -----
primitiveArcSinH
"Computes asinh(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_asinh(rcvr)' inSmalltalk: [rcvr arcSinH].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveArcTan (in category 'float primitives') -----
primitiveArcTan
"Computes atan(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_atan(rcvr)' inSmalltalk: [rcvr arcTan].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveArcTan2 (in category 'float primitives') -----
primitiveArcTan2
"Computes atan2(receiver, arg)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg result |
<var: #rcvr type: #double>
<var: #arg type: #double>
<var: #result type: #double>
arg := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackFloatValue: 1.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_atan2(rcvr, arg)' inSmalltalk: [rcvr arcTan: arg].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveArcTanH (in category 'float primitives') -----
primitiveArcTanH
"Computes atanh(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_atanh(rcvr)' inSmalltalk: [rcvr arcTanH].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveCos (in category 'float primitives') -----
primitiveCos
"Computes cos(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_cos(rcvr)' inSmalltalk: [rcvr cos].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveCosH (in category 'float primitives') -----
primitiveCosH
"Computes cosh(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_cosh(rcvr)' inSmalltalk: [rcvr cosH].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveExp (in category 'float primitives') -----
primitiveExp
"Computes E raised to the receiver power."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := (self cCode: '__ieee754_exp(rcvr)' inSmalltalk: [rcvr exp]).
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveFMod (in category 'float primitives') -----
primitiveFMod
"Computes receiver \\ arg"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg result |
<var: #rcvr type: #double>
<var: #arg type: #double>
<var: #result type: #double>
arg := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackFloatValue: 1.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_fmod(rcvr, arg)' inSmalltalk: [rcvr \\ arg].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveFractionalPart (in category 'float primitives') -----
primitiveFractionalPart
"Computes receiver \\ 1.0"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result trunc |
<var: #rcvr type: #double>
<var: #result type: #double>
<var: #trunc type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_modf(rcvr, &trunc)' inSmalltalk: [rcvr fractionPart].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveHypot (in category 'float primitives') -----
primitiveHypot
"hypot(x,y) returns sqrt(x^2+y^2) with error less than 1 ulps"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg result |
<var: #rcvr type: #double>
<var: #arg type: #double>
<var: #result type: #double>
arg := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackFloatValue: 1.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_hypot(rcvr, arg)' inSmalltalk: [rcvr hypot: arg].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveLog10 (in category 'float primitives') -----
primitiveLog10
"Computes log10(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr < 0.0 ifTrue:[^interpreterProxy primitiveFail].
result := self cCode: '__ieee754_log10(rcvr)' inSmalltalk: [rcvr log: 10].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveLogN (in category 'float primitives') -----
primitiveLogN
"Computes log(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr < 0.0 ifTrue:[^interpreterProxy primitiveFail].
result := self cCode: '__ieee754_log(rcvr)' inSmalltalk: [rcvr ln].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveRaisedToPower (in category 'float primitives') -----
primitiveRaisedToPower
"Computes receiver**arg"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg result |
<var: #rcvr type: #double>
<var: #arg type: #double>
<var: #result type: #double>
arg := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackFloatValue: 1.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_pow(rcvr, arg)' inSmalltalk: [rcvr raisedTo: arg].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveSin (in category 'float primitives') -----
primitiveSin
"Computes sin(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_sin(rcvr)' inSmalltalk: [rcvr sin].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveSinH (in category 'float primitives') -----
primitiveSinH
"Computes sinh(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_sinh(rcvr)' inSmalltalk: [rcvr sinH].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveSqrt (in category 'float primitives') -----
primitiveSqrt
"Computes sqrt(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr < 0.0 ifTrue:[^interpreterProxy primitiveFail].
result := self cCode: '__ieee754_sqrt(rcvr)' inSmalltalk: [rcvr sqrt].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveTan (in category 'float primitives') -----
primitiveTan
"Computes tan(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_tan(rcvr)' inSmalltalk: [rcvr tan].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveTanH (in category 'float primitives') -----
primitiveTanH
"Computes tanh(receiver)"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr result |
<var: #rcvr type: #double>
<var: #result type: #double>
rcvr := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
result := self cCode: '__ieee754_tanh(rcvr)' inSmalltalk: [rcvr tanH].
(self isnan: result) ifTrue:[^interpreterProxy primitiveFail].
^interpreterProxy methodReturnFloat: result!
Item was changed:
----- Method: FloatMathPlugin>>primitiveTimesTwoPower (in category 'float primitives') -----
primitiveTimesTwoPower
"Multiply the receiver by the power of the argument."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| rcvr arg result |
<var: #rcvr type: #double>
<var: #result type: #double>
arg := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackFloatValue: 1.
interpreterProxy failed ifTrue:
[^nil].
interpreterProxy bytesPerOop > 4 ifTrue:
[| twiceMaxExponent | "clip arg to at most int range; ldexp's last arg is of type int"
twiceMaxExponent := 2 * (1 << self floatExponentBits).
arg < twiceMaxExponent negated
ifTrue: [arg := twiceMaxExponent negated]
ifFalse: [arg > twiceMaxExponent ifTrue:
[arg := twiceMaxExponent]]].
result := self cCode: '__ieee754_ldexp(rcvr, (int)arg)'
inSmalltalk: [rcvr timesTwoPower: arg].
(self isnan: result) ifFalse:
[interpreterProxy methodReturnFloat: result].
^nil!
Item was changed:
ObjectMemory subclass: #Interpreter
instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector argumentCount newMethod currentBytecode successFlag primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized extraVMMemory receiverClass interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTable globalSessionID jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods profileProcess profileMethod profileSemaphore nextProfileTick metaclassSizeBits statIOProcessEvents statCheckForEvents statQuickCheckForEvents statProce
ssSwitch statPendingFinalizationSignals gcSemaphoreIndex'
+ classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CallerIndex CompilerHooksSize CrossedX DoBalanceChecks EndOfRun HomeIndex InitialIPIndex MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MillisecondClockMask PrimitiveExternalCallIndex PrimitiveTable SemaphoresToSignalSize TempFrameStart'
- classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BlockMethodIndex BytecodeTable CacheProbeMax CallerIndex ClosureMethodIndex CompilerHooksSize CrossedX DirBadPath DirEntryFound DirNoMoreEntries DoBalanceChecks EndOfRun HomeIndex InitialIPIndex JitterTable MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MillisecondClockMask PrimitiveExternalCallIndex PrimitiveTable SemaphoresToSignalSize TempFrameStart'
poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices'
category: 'VMMaker-Interpreter'!
!Interpreter commentStamp: '<historical>' prior: 0!
This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.
It has been modernized with 32-bit pointers, better management of Contexts, and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
In addition to SmallInteger arithmetic and Floats, it supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
1. There are a number of things that should be done the next time we plan to release a copletely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item).
2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the systemTracer. A better solution would be to reserve one of the format codes for Contexts only.
3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes.
4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache. !
Item was removed:
- ----- Method: Interpreter class>>initializeDirectoryLookupResultCodes (in category 'initialization') -----
- initializeDirectoryLookupResultCodes
-
- DirEntryFound := 0.
- DirNoMoreEntries := 1.
- DirBadPath := 2.!
Item was changed:
----- Method: Interpreter class>>initializeWithOptions: (in category 'initialization') -----
initializeWithOptions: optionsDictionary
"Interpreter initializeWithOptions: Dictionary new"
super initializeWithOptions: optionsDictionary. "initialize ObjectMemory constants"
self initializeMiscConstants. "must precede other initialization."
self initializeAssociationIndex.
self initializeBytecodeTable.
self initializeCaches.
self initializeCharacterIndex.
self initializeCharacterScannerIndices.
self initializeClassIndices.
self initializeCompilerHooks.
self initializeContextIndices.
- self initializeDirectoryLookupResultCodes.
self initializeMessageIndices.
self initializeMethodIndices.
self initializePointIndices.
self initializePrimitiveTable.
self initializeSchedulerIndices.
self initializeSmallIntegers.
self initializeStreamIndices!
Item was added:
+ ----- Method: InterpreterPrimitives>>atan: (in category 'primitive support') -----
+ atan: aFloat
+ "Simulate the C library atan(3) function."
+ <doNotGenerate>
+ ^aFloat = aFloat
+ ifTrue: [aFloat arcTan]
+ ifFalse: [Float nan]!
Item was added:
+ ----- Method: InterpreterPrimitives>>exp: (in category 'primitive support') -----
+ exp: aFloat
+ "Simulate the C library exp(3) function."
+ <doNotGenerate>
+ ^aFloat = aFloat
+ ifTrue: [aFloat exp]
+ ifFalse: [Float nan]!
Item was added:
+ ----- Method: InterpreterPrimitives>>frexp:_: (in category 'primitive support') -----
+ frexp: aFloat _: eptr
+ "Simulate the C library frexp(3) function."
+ <doNotGenerate>
+ eptr at: 0 put: aFloat exponent.
+ ^nil "result unused..."!
Item was added:
+ ----- Method: InterpreterPrimitives>>ldexp:_: (in category 'primitive support') -----
+ ldexp: aFloat _: powerOfTwo
+ "Simulate the C library ldexp(3) function."
+ <doNotGenerate>
+ ^aFloat timesTwoPower: powerOfTwo!
Item was added:
+ ----- Method: InterpreterPrimitives>>log: (in category 'primitive support') -----
+ log: aFloat
+ "Simulate the C library log:(3) function."
+ <doNotGenerate>
+ aFloat = aFloat
+ ifTrue: [aFloat ln]
+ ifFalse: [Float nan]!
Item was changed:
----- Method: InterpreterPrimitives>>magnitude64BitIntegerFor:neg: (in category 'primitive support') -----
magnitude64BitIntegerFor: magnitude neg: isNegative
"Return a Large Integer object for the given integer magnitude and sign"
+ | newLargeInteger largeClassIndex highWord sz isSmall smallVal |
- | newLargeInteger largeClass highWord sz isSmall smallVal |
<var: 'magnitude' type: #usqLong>
<var: 'highWord' type: #usqInt>
isSmall := isNegative
ifTrue: [magnitude <= (objectMemory maxSmallInteger + 1)]
ifFalse: [magnitude <= objectMemory maxSmallInteger].
isSmall ifTrue:
[smallVal := self cCoerceSimple: magnitude to: #sqInt.
isNegative ifTrue: [smallVal := 0 - smallVal].
^objectMemory integerObjectOf: smallVal].
+ largeClassIndex := isNegative
+ ifTrue: [ClassLargeNegativeIntegerCompactIndex]
+ ifFalse: [ClassLargePositiveIntegerCompactIndex].
- largeClass := isNegative
- ifTrue: [objectMemory classLargeNegativeInteger]
- ifFalse: [objectMemory classLargePositiveInteger].
objectMemory wordSize = 8
ifTrue: [sz := 8]
ifFalse:
[(highWord := magnitude >> 32) = 0
ifTrue: [sz := 4]
ifFalse:
[sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse: [sz := sz + 1]]]]].
+ newLargeInteger := objectMemory
+ eeInstantiateSmallClassIndex: largeClassIndex
+ format: (objectMemory byteFormatForNumBytes: sz)
+ numSlots: sz / objectMemory bytesPerOop.
- newLargeInteger := objectMemory instantiateClass: largeClass indexableSize: sz.
SPURVM
ifTrue:
["Memory is eight byte aligned in SPUR, so we are sure to have room for 64bits word whatever allocated sz"
objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
ifFalse:
[sz > 4
ifTrue: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped64IfBigEndian: magnitude)]
ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (objectMemory byteSwapped32IfBigEndian: magnitude)]].
^newLargeInteger!
Item was added:
+ ----- Method: InterpreterPrimitives>>mod:f: (in category 'primitive support') -----
+ mod: aFloat f: iptr
+ "Simulate the C library modf(3) function.
+ N.B.
+ modf(+-infinity, iptr) returns +-0 and stores +-infinity in the object pointed to by iptr.
+ modf(NaN, iptr) returns a NaN and stores a NaN in the object pointed to by iptr."
+ <doNotGenerate>
+ iptr at: 0 put: (aFloat isFinite ifTrue: [aFloat truncated] ifFalse: [aFloat]).
+ ^aFloat isFinite
+ ifTrue: [aFloat fractionPart]
+ ifFalse:
+ [aFloat isInfinite
+ ifTrue: [aFloat > 0 ifTrue: [0.0] ifFalse: [-0.0]] "+/- infinity"
+ ifFalse: [aFloat]] "nan"!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveAddLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveAddLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | a b result oopResult aIsNegative bIsNegative resultIsNegative oopArg oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | a b result oopResult aIsNegative bIsNegative resultIsNegative oopArg oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
bIsNegative := self isNegativeIntegerValueOf: oopArg.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
self successful ifFalse:[^nil].
(aIsNegative = bIsNegative)
ifTrue:
["Protect against overflow"
a > (16rFFFFFFFFFFFFFFFF - b) ifTrue: [self primitiveFail. ^nil].
result := a + b.
resultIsNegative := aIsNegative]
ifFalse:
[(a >= b)
ifTrue:
[result := a - b.
resultIsNegative := aIsNegative]
ifFalse:
[result := b - a.
resultIsNegative := bIsNegative]].
oopResult := self magnitude64BitIntegerFor: result neg: resultIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult]!
- self successful ifTrue:[self pop: 2 thenPush: oopResult].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArctan (in category 'arithmetic float primitives') -----
primitiveArctan
"N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr |
- <var: #rcvr type: #double>
rcvr := self stackFloatValue: 0.
self successful ifTrue:
+ [self stackTopPut: (objectMemory floatObjectOf: (self atan: rcvr))]!
- [self stackTopPut: (objectMemory floatObjectOf:
- (self cCode: [rcvr atan]
- inSmalltalk: [rcvr = rcvr
- ifTrue: [rcvr arcTan]
- ifFalse: [Float nan]]))]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBitAndLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveBitAndLargeIntegers
"Primitive logical operations for large integers in 64 bit range"
- | integerRcvr integerArg oopResult |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg oopResult |
+ <var: 'integerRcvr' type: #usqLong>
+ <var: 'integerArg' type: #usqLong>
- <var: 'integerRcvr' type: 'usqLong'>
- <var: 'integerArg' type: 'usqLong'>
integerArg := self positive64BitValueOf: (self stackValue: 0).
integerRcvr := self positive64BitValueOf: (self stackValue: 1).
self successful ifFalse:[^nil].
oopResult := self positive64BitIntegerFor: (integerRcvr bitAnd: integerArg).
self successful ifTrue:[self pop: 2 thenPush: oopResult]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBitOrLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveBitOrLargeIntegers
"Primitive logical operations for large integers in 64 bit range"
- | integerRcvr integerArg oopResult |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg oopResult |
+ <var: 'integerRcvr' type: #usqLong>
+ <var: 'integerArg' type: #usqLong>
- <var: 'integerRcvr' type: 'usqLong'>
- <var: 'integerArg' type: 'usqLong'>
integerArg := self positive64BitValueOf: (self stackValue: 0).
integerRcvr := self positive64BitValueOf: (self stackValue: 1).
self successful ifFalse:[^nil].
oopResult := self positive64BitIntegerFor: (integerRcvr bitOr: integerArg).
self successful ifTrue:[self pop: 2 thenPush: oopResult]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBitShiftLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveBitShiftLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | a shift result oopResult aIsNegative oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | a shift result oopResult aIsNegative oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
shift := self stackIntegerValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
a := self magnitude64BitValueOf: oopRcvr.
self successful ifFalse:[^nil].
(shift >= 0)
ifTrue:
["Protect against overflow"
result := 16rFFFFFFFFFFFFFFFF. "This is to avoid undue (usqInt) cast"
(shift >= 64 or: [a > (result >> shift)]) ifTrue: [self primitiveFail. ^nil].
result := a << shift]
ifFalse:
[shift := 0 - shift.
shift >= 64
ifTrue: [result := 0]
ifFalse: [result := a >> shift].
"Fake 2 complement for negative values"
(aIsNegative and: [result << shift ~= a]) ifTrue: [result := result + 1]].
oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult]!
- self successful ifTrue:[self pop: 2 thenPush: oopResult].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBitXorLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveBitXorLargeIntegers
"Primitive logical operations for large integers in 64 bit range"
- | integerRcvr integerArg oopResult |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg oopResult |
+ <var: 'integerRcvr' type: #usqLong>
+ <var: 'integerArg' type: #usqLong>
- <var: 'integerRcvr' type: 'usqLong'>
- <var: 'integerArg' type: 'usqLong'>
integerArg := self positive64BitValueOf: (self stackValue: 0).
integerRcvr := self positive64BitValueOf: (self stackValue: 1).
self successful ifFalse:[^nil].
oopResult := self positive64BitIntegerFor: (integerRcvr bitXor: integerArg).
self successful ifTrue:[self pop: 2 thenPush: oopResult]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveCalloutToFFI (in category 'plugin primitives') -----
primitiveCalloutToFFI
"Perform a function call to a foreign function.
Only invoked from method containing explicit external call spec.
Due to this we use the pluggable prim mechanism explicitly here
(the first literal of any FFI spec'ed method is an ExternalFunction
and not an array as used in the pluggable primitive mechanism)."
<accessorDepth: 2> "Manually copied from primitiveCalloutAccessorDepth in the ThreadedFFIPlugins..."
+ <primitiveMetadata: #( PrimCallMayEndureCodeCompaction "since call may invoke a callback"
+ PrimCallNeedsNewMethod "since call signature is in first literal...")>
+
<var: #primitiveCallout declareC: 'void (*primitiveCallout)(void)'>
self functionForPrimitiveCallout
ifNil: [self primitiveFail]
ifNotNil: [:primitiveCallout| self dispatchFunctionPointer: primitiveCallout]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveCompareBytes (in category 'indexing primitives') -----
primitiveCompareBytes
"Primitive. Compare two byte-indexed objects for equality"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| arg1 arg2 len |
arg1 := self stackValue: 1.
arg2 := self stackValue: 0.
"Quick identity test"
arg1 = arg2 ifTrue:
[^self methodReturnBool: true].
((objectMemory isBytes: arg1) and:[objectMemory isBytes: arg2]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
len := objectMemory numBytesOfBytes: arg1.
len = (objectMemory numBytesOfBytes: arg2) ifFalse:
[^self methodReturnBool: false].
0 to: len - 1 do:
[:i|
(objectMemory fetchByte: i ofObject: arg1) = (objectMemory fetchByte: i ofObject: arg2) ifFalse:
[^self methodReturnBool: false]].
^self methodReturnBool: true!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveConstantFill (in category 'sound primitives') -----
primitiveConstantFill
"Fill the receiver, which must be an indexable non-pointer
object, with the given integer value."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
objectMemory hasSpurMemoryManagerAPI
ifTrue: [self primitiveConstantFillSpur]
ifFalse: [self primitiveConstantFillV3]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveCopyObject (in category 'object access primitives') -----
primitiveCopyObject
"Primitive. Copy the state of the receiver from the argument.
Fail if receiver and argument are of a different class.
Fail if the receiver or argument are contexts (because of context-to-stack mapping).
Fail if receiver and argument have different lengths (for indexable objects).
Fail if the objects are not in a fit state to be copied (e.g. married contexts and Cogged methods)"
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| rcvr arg length |
self methodArgumentCount >= 1 ifFalse:
[^self primitiveFailFor: PrimErrBadNumArgs].
arg := self stackTop.
rcvr := self stackValue: 1.
(objectMemory isImmediate: rcvr) ifTrue:
[^self primitiveFailFor: PrimErrBadReceiver].
(objectMemory isImmediate: arg) ifTrue:
[^self primitiveFailFor: PrimErrBadArgument].
(objectMemory fetchClassTagOfNonImm: rcvr)
~= (objectMemory fetchClassTagOfNonImm: arg) ifTrue:
[^self primitiveFailFor: PrimErrBadArgument].
(objectMemory isWordsOrBytesNonImm: rcvr)
ifTrue:
[length := objectMemory numBytesOf: rcvr.
((objectMemory formatOf: rcvr) = (objectMemory formatOf: arg)
and: [length = (objectMemory numBytesOf: arg)]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
self memcpy: (rcvr + objectMemory baseHeaderSize) asVoidPointer
_: (arg + objectMemory baseHeaderSize) asVoidPointer
_: length]
ifFalse:
[(self isAppropriateForCopyObject: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrBadReceiver].
length := objectMemory numSlotsOf: rcvr.
((self isAppropriateForCopyObject: arg)
and: [length = (objectMemory lengthOf: arg)]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
0 to: length - 1 do:
[:i|
objectMemory
storePointer: i
ofObject: rcvr
withValue: (objectMemory fetchPointer: i ofObject: arg)]].
"Note: The above could be faster for young receivers but I don't think it'll matter"
self pop: self methodArgumentCount "pop arg; answer receiver"!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveDivLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveDivLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr rem |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr rem |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
+ <var: 'rem' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
- <var: 'rem' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
bIsNegative := self isNegativeIntegerValueOf: oopArg.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
b = 0 ifTrue:[self primitiveFail].
self successful ifFalse:[^nil].
result := a // b.
a = 0
ifFalse: [bIsNegative = aIsNegative
ifFalse:
["Round toward negative infinity"
rem := a \\ b.
rem = 0 ifFalse:
["This can not overflow, because b > 1, otherwise rem = 0"
result := result + 1]]].
oopResult := self magnitude64BitIntegerFor: result neg: bIsNegative ~= aIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult]!
- self successful ifTrue: [self pop: 2 thenPush: oopResult].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveDivideLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveDivideLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | a b result oopResult aIsNegative bIsNegative oopArg oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | a b result oopResult aIsNegative bIsNegative oopArg oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
bIsNegative := self isNegativeIntegerValueOf: oopArg.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
self successful ifFalse:[^nil].
"check for exact division"
(b ~= 0 and:[a \\ b = 0]) ifFalse:[self primitiveFail. ^nil].
result := a // b.
oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative ~= bIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult]!
- self successful ifTrue:[self pop: 2 thenPush: oopResult].
- !
Item was changed:
----- Method: InterpreterPrimitives>>primitiveEqualLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveEqualLargeIntegers
"Primitive comparison operations for large integers in 64 bit range"
- | integerRcvr integerArg |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg |
+ <var: 'integerRcvr' type: #sqLong>
+ <var: 'integerArg' type: #sqLong>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
integerArg := self signed64BitValueOf: (self stackValue: 0).
integerRcvr := self signed64BitValueOf: (self stackValue: 1).
self successful ifTrue:
[self pop: 2 thenPushBool: integerRcvr = integerArg]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveExp (in category 'arithmetic float primitives') -----
primitiveExp
"Computes E raised to the receiver power.
N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr |
- <var: #rcvr type: #double>
rcvr := self stackFloatValue: 0.
self successful ifTrue:
+ [self stackTopPut: (objectMemory floatObjectOf: (self exp: rcvr))]!
- [self stackTopPut: (objectMemory floatObjectOf:
- (self cCode: [rcvr exp]
- inSmalltalk: [rcvr = rcvr
- ifTrue: [rcvr exp]
- ifFalse: [Float nan]]))]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveExponent (in category 'arithmetic float primitives') -----
primitiveExponent
"Exponent part of this float.
N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr pwr |
- <var: #rcvr type: #double>
<var: #pwr type: #int>
rcvr := self stackFloatValue: 0.
self successful ifTrue:
["rcvr = frac * 2^pwr, where frac is in [0.5..1.0)"
+ self frexp: rcvr _: (self addressOf: pwr put: [:v| pwr := v]).
- self cCode: [self fr: rcvr exp: (self addressOf: pwr)]
- inSmalltalk: [pwr := rcvr exponent].
self stackTopPut: (objectMemory integerObjectOf: pwr - 1)]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFloatArrayAt (in category 'indexing primitives') -----
primitiveFloatArrayAt
+ "Index the receiver, which must be an indexable non-pointer object, and yield a float."
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
- "Index the receiver, which must be an indexable non-pointer
- object, and yield a float."
objectMemory hasSpurMemoryManagerAPI
ifTrue: [self primitiveSpurFloatArrayAt]
ifFalse: [self primitiveFailFor: PrimErrUnsupported]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFloatArrayAtPut (in category 'indexing primitives') -----
primitiveFloatArrayAtPut
+ "Index the receiver, which must be an indexable non-pointer object, and store a float."
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
- "Index the receiver, which must be an indexable non-pointer
- object, and store a float."
objectMemory hasSpurMemoryManagerAPI
ifTrue: [self primitiveSpurFloatArrayAtPut]
ifFalse: [self primitiveFailFor: PrimErrUnsupported]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFloatAt (in category 'indexing primitives') -----
primitiveFloatAt
"Provide platform-independent access to 32-bit words comprising
a Float. Map index 1 onto the most significant word and index 2
onto the least significant word."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| rcvr index result |
<var: #result type: #usqInt>
rcvr := self stackValue: 1.
index := self stackTop.
index = ConstOne ifTrue:
[result := self positive32BitIntegerFor:
(objectMemory
fetchLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1])
ofFloatObject: rcvr).
^self pop: 2 thenPush: result].
index = ConstTwo ifTrue:
[result := self positive32BitIntegerFor:
(objectMemory
fetchLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0])
ofFloatObject: rcvr).
^self pop: 2 thenPush: result].
self primitiveFailFor: ((objectMemory isIntegerObject: index)
ifTrue: [PrimErrBadIndex]
ifFalse: [PrimErrBadArgument])!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFloatAtPut (in category 'indexing primitives') -----
primitiveFloatAtPut
"Provide platform-independent access to 32-bit words comprising
a Float. Map index 1 onto the most significant word and index 2
onto the least significant word."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| rcvr index oopToStore valueToStore |
<var: #valueToStore type: #usqInt>
oopToStore := self stackTop.
valueToStore := self positive32BitValueOf: oopToStore.
self successful ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 2.
index := self stackValue: 1.
(objectMemory isImmediateFloat: rcvr) ifTrue:
[^self primitiveFailFor: PrimErrBadReceiver].
(objectMemory isObjImmutable: rcvr) ifTrue:
[^self primitiveFailFor: PrimErrNoModification].
index = ConstOne ifTrue:
[objectMemory storeLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1])
ofObject: rcvr
withValue: valueToStore.
^self pop: 3 thenPush: oopToStore].
index = ConstTwo ifTrue:
[objectMemory storeLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0])
ofObject: rcvr
withValue: valueToStore.
^self pop: 3 thenPush: oopToStore].
self primitiveFailFor: ((objectMemory isIntegerObject: index)
ifTrue: [PrimErrBadIndex]
ifFalse: [PrimErrBadArgument])!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFlushExternalPrimitives (in category 'plugin primitives') -----
primitiveFlushExternalPrimitives
+ "Primitive. Flush all the existing external primitives in the image thus forcing a reload on next invocation."
+ <primitiveMetadata: #PrimCallMayEndureCodeCompaction>
- "Primitive. Flush all the existing external primitives in the image thus forcing a reload on next invokation."
self flushExternalPrimitives!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFractionalPart (in category 'arithmetic float primitives') -----
primitiveFractionalPart
"Fractional part of this float.
N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr trunc |
- <var: #rcvr type: #double>
<var: #trunc type: #double>
rcvr := self stackFloatValue: 0.
self successful ifTrue:
[self stackTopPut: (objectMemory floatObjectOf:
+ (self mod: rcvr f: (self addressOf: trunc put: [:v| trunc := v])))]!
- (self cCode: [self mod: rcvr f: (self addressOf: trunc)]
- inSmalltalk: [rcvr fractionPart]))]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveGetImmutability (in category 'object access primitives') -----
primitiveGetImmutability
<option: #IMMUTABILITY>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| rcvr |
rcvr := self stackValue: 0.
self pop: argumentCount + 1 thenPushBool: (objectMemory isOopImmutable: rcvr)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveGreaterOrEqualLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveGreaterOrEqualLargeIntegers
"Primitive comparison operations for large integers in 64 bit range"
- | integerRcvr integerArg |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg |
+ <var: 'integerRcvr' type: #sqLong>
+ <var: 'integerArg' type: #sqLong>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
integerArg := self signed64BitValueOf: (self stackValue: 0).
integerRcvr := self signed64BitValueOf: (self stackValue: 1).
self successful ifTrue:
[self pop: 2 thenPushBool: integerRcvr >= integerArg]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveGreaterThanLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveGreaterThanLargeIntegers
"Primitive comparison operations for large integers in 64 bit range"
- | integerRcvr integerArg |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg |
+ <var: 'integerRcvr' type: #sqLong>
+ <var: 'integerArg' type: #sqLong>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
integerArg := self signed64BitValueOf: (self stackValue: 0).
integerRcvr := self signed64BitValueOf: (self stackValue: 1).
self successful ifTrue:
[self pop: 2 thenPushBool: integerRcvr > integerArg]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveHighResClock (in category 'system control primitives') -----
primitiveHighResClock
"Return the value of the high resolution clock if this system has any.
The exact frequency of the high res clock is undefined specifically so that we can use
processor dependent instructions (like RDTSC). The only use for the high res clock is for
profiling where we can allocate time based on sub-msec resolution of the high res clock.
If no high-resolution counter is available, the platform should return zero. ar 6/22/2007"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
self methodReturnValue: (self positive64BitIntegerFor: self ioHighResClock)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveIsPinned (in category 'memory space primitives') -----
primitiveIsPinned
"Answer if the receiver is pinned, i.e. immobile."
<option: #SpurObjectMemory>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| obj |
obj := self stackTop.
((objectMemory isImmediate: obj)
or: [objectMemory isForwarded: obj]) ifTrue:
[^self primitiveFailFor: PrimErrBadReceiver].
self pop: argumentCount + 1
thenPushBool: (objectMemory isPinned: obj)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLessOrEqualLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveLessOrEqualLargeIntegers
"Primitive comparison operations for large integers in 64 bit range"
- | integerRcvr integerArg |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg |
+ <var: 'integerRcvr' type: #sqLong>
+ <var: 'integerArg' type: #sqLong>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
integerArg := self signed64BitValueOf: (self stackValue: 0).
integerRcvr := self signed64BitValueOf: (self stackValue: 1).
self successful ifTrue:
[self pop: 2 thenPushBool: integerRcvr <= integerArg]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLessThanLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveLessThanLargeIntegers
"Primitive comparison operations for large integers in 64 bit range"
- | integerRcvr integerArg |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg |
+ <var: 'integerRcvr' type: #sqLong>
+ <var: 'integerArg' type: #sqLong>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
integerArg := self signed64BitValueOf: (self stackValue: 0).
integerRcvr := self signed64BitValueOf: (self stackValue: 1).
self successful ifTrue:
[self pop: 2 thenPushBool: integerRcvr < integerArg]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLogN (in category 'arithmetic float primitives') -----
primitiveLogN
"Natural log.
N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr |
- <var: #rcvr type: #double>
rcvr := self stackFloatValue: 0.
self successful ifTrue:
+ [self stackTopPut: (objectMemory floatObjectOf: (self log: rcvr))]!
- [self stackTopPut: (objectMemory floatObjectOf:
- (self cCode: [rcvr log]
- inSmalltalk: [rcvr = rcvr
- ifTrue: [rcvr ln]
- ifFalse: [Float nan]]))]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLowSpaceSemaphore (in category 'memory space primitives') -----
primitiveLowSpaceSemaphore
"Register the low-space semaphore. If the argument is not a
Semaphore, unregister the current low-space Semaphore."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| arg |
arg := self stackTop.
(arg = objectMemory nilObject
or: [objectMemory isSemaphoreOop: arg])
ifTrue:
[objectMemory splObj: TheLowSpaceSemaphore put: arg.
self pop: 1]
ifFalse:
[self primitiveFailFor: PrimErrBadArgument]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveModLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveModLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
bIsNegative := self isNegativeIntegerValueOf: oopArg.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
b = 0 ifTrue:[self primitiveFail].
self successful ifFalse:[^nil].
result := a \\ b.
"Handle remainder of same sign as argument"
result = 0
ifFalse: [bIsNegative = aIsNegative
ifFalse: [result := b - result]].
oopResult := self magnitude64BitIntegerFor: result neg: bIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult]!
- self successful ifTrue: [self pop: 2 thenPush: oopResult].
- !
Item was changed:
----- Method: InterpreterPrimitives>>primitiveMultiplyLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveMultiplyLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | a b result oopResult aIsNegative bIsNegative oopArg oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | a b result oopResult aIsNegative bIsNegative oopArg oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
bIsNegative := self isNegativeIntegerValueOf: oopArg.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
self successful ifFalse:[^nil].
"check for overflow"
(a > 1 and: [b > 1 and: [a > (16rFFFFFFFFFFFFFFFF / b)]])
ifTrue: [self primitiveFail. ^nil].
result := a * b.
oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative ~= bIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult]!
- self successful ifTrue:[self pop: 2 thenPush: oopResult].
- !
Item was changed:
----- Method: InterpreterPrimitives>>primitiveNotEqualLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveNotEqualLargeIntegers
"Primitive comparison operations for large integers in 64 bit range"
- | integerRcvr integerArg |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | integerRcvr integerArg |
+ <var: 'integerRcvr' type: #sqLong>
+ <var: 'integerArg' type: #sqLong>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
integerArg := self signed64BitValueOf: (self stackValue: 0).
integerRcvr := self signed64BitValueOf: (self stackValue: 1).
self successful ifTrue:
[self pop: 2 thenPushBool: integerRcvr ~= integerArg]!
Item was changed:
----- Method: InterpreterPrimitives>>primitivePerformInSuperclass (in category 'control primitives') -----
primitivePerformInSuperclass
+ <primitiveMetadata: #PrimCallNeedsNewMethod>
| lookupClass rcvr currentClass |
rcvr := self stackValue: 3.
lookupClass := self stackTop.
+ argumentCount ~= 3 ifTrue: "e.g. object:perform:withArguments:inClass:"
+ [argumentCount ~= 4 ifTrue:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+ (objectMemory isOopForwarded: rcvr) ifTrue:
+ [^self primitiveFail]].
- (argumentCount > 3 "e.g. object:perform:withArguments:inClass:"
- and: [objectMemory isOopForwarded: rcvr]) ifTrue:
- [^self primitiveFail].
currentClass := objectMemory fetchClassOf: rcvr.
[currentClass ~= lookupClass] whileTrue:
[currentClass := self superclassOf: currentClass.
currentClass = objectMemory nilObject ifTrue:
[^self primitiveFailFor: PrimErrBadArgument]].
self primitiveObject: rcvr "a.k.a. self stackValue: 3"
perform: (self stackValue: 2)
withArguments: (self stackValue: 1)
lookedUpIn: lookupClass "a.k.a. self stackTop"!
Item was changed:
----- Method: InterpreterPrimitives>>primitivePerformWithArgs (in category 'control primitives') -----
primitivePerformWithArgs
+ <primitiveMetadata: #PrimCallNeedsNewMethod>
self primitiveObject: (self stackValue: 2)
perform: (self stackValue: 1)
withArguments: self stackTop
lookedUpIn: nil!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveProfilePrimitive (in category 'process primitives') -----
primitiveProfilePrimitive
"Primitive. Answer the last primitive method sampled by the profiler."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
self methodReturnValue: profileMethod.
profileMethod := objectMemory nilObject!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveProfileSample (in category 'process primitives') -----
primitiveProfileSample
"Primitive. Answer the last sample taken by the profiler, or nil if the profiler isn't active.
See also primitiveProfileStart."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
self methodReturnValue: profileProcess.
profileProcess := objectMemory nilObject!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveProfileStart (in category 'process primitives') -----
primitiveProfileStart
"Primitive. Begin profiling execution every by using the interrupt check-counter instead of a time-based process (which is limited to timing resolution and triggers off the same signal that many of the processes being profiled trigger off leading to consistently wrong results).
The argument is the number of interrupt checks (method activations) to let go by before taking a sample. The sample is being stored in the profileSample iVar which can be retrieved by executing primitiveProfileSample. When a sample is taken, it signals the semaphore specified in primitiveProfileSemaphore.
If the argument is less or equal to zero, it disables profiling."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| deltaTicks |
deltaTicks := self stackValue: 0.
(objectMemory isIntegerObject: deltaTicks) ifTrue:
[nextProfileTick := self ioHighResClock + (objectMemory integerValueOf: deltaTicks).
^self methodReturnReceiver].
^self primitiveFailFor: PrimErrBadArgument!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveQuoLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveQuoLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
bIsNegative := self isNegativeIntegerValueOf: oopArg.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
b = 0 ifTrue:[self primitiveFail].
self successful ifFalse:[^nil].
result := a // b.
oopResult := self magnitude64BitIntegerFor: result neg: bIsNegative ~= aIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult]!
- self successful ifTrue: [self pop: 2 thenPush: oopResult].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveRemLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveRemLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | result oopResult a aIsNegative b oopArg oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | result oopResult a aIsNegative b oopArg oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
b = 0 ifTrue:[self primitiveFail].
self successful ifFalse:[^nil].
result := a \\ b.
oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult]!
- self successful ifTrue: [self pop: 2 thenPush: oopResult].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSetIdentityHash (in category 'object access primitives') -----
primitiveSetIdentityHash
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| hash oldHash thisReceiver |
hash := self stackIntegerValue: 0.
thisReceiver := self stackObjectValue: 1.
self successful ifTrue:
[oldHash := objectMemory hashBitsOf: thisReceiver.
objectMemory setHashBitsOf: thisReceiver to: hash.
self pop: argumentCount + 1 thenPushInteger: oldHash]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSetImmutability (in category 'object access primitives') -----
primitiveSetImmutability
<option: #IMMUTABILITY>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| rcvr wasImmutable |
rcvr := self stackValue: 1.
(objectMemory isImmediate: rcvr) ifTrue:
[^self primitiveFailFor: PrimErrBadReceiver].
wasImmutable := objectMemory isObjImmutable: rcvr.
self stackTop = objectMemory trueObject
ifTrue:
[(self canBeImmutable: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate].
objectMemory setIsImmutableOf: rcvr to: true]
ifFalse: [
self stackTop = objectMemory falseObject
ifTrue: [objectMemory setIsImmutableOf: rcvr to: false]
ifFalse:
[^self primitiveFailFor: PrimErrBadArgument]].
self pop: argumentCount + 1 thenPushBool: wasImmutable!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveShortAt (in category 'sound primitives') -----
primitiveShortAt
"Treat the receiver, which can be indexible by either bytes or words, as
an array of signed 16-bit values. Answer the contents of the given index.
Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
-
| index rcvr value |
index := self stackTop.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 1.
(objectMemory isWordsOrBytes: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate].
index := objectMemory integerValueOf: index.
((index >= 1) and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
value := objectMemory fetchShort16: index - 1 ofObject: rcvr.
self cCode: []
inSmalltalk: [value > 32767 ifTrue: [value := value - 65536]].
self pop: 2 thenPushInteger: value!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveShortAtPut (in category 'sound primitives') -----
primitiveShortAtPut
"Treat the receiver, which can be indexible by either bytes or words, as an array
of signed 16-bit values. Set the contents of the given index to the given value.
Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
-
| index rcvr value |
value := self stackTop.
index := self stackValue: 1.
((objectMemory isIntegerObject: value)
and: [(objectMemory isIntegerObject: index)
and: [value := objectMemory integerValueOf: value.
(value >= -32768) and: [value <= 32767]]]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 2.
(objectMemory isWordsOrBytes: rcvr) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate].
(objectMemory isObjImmutable: rcvr) ifTrue:
[^self primitiveFailFor: PrimErrNoModification].
index := objectMemory integerValueOf: index.
(index >= 1 and: [index <= (objectMemory num16BitUnitsOf: rcvr)]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
objectMemory storeShort16: index - 1 ofObject: rcvr withValue: value.
self pop: 3 thenPush: (objectMemory integerObjectOf: value)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSine (in category 'arithmetic float primitives') -----
primitiveSine
"N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr |
- <var: #rcvr type: #double>
rcvr := self stackFloatValue: 0.
self successful ifTrue:
[self stackTopPut: (objectMemory floatObjectOf:
(self cCode: [rcvr sin]
inSmalltalk: [rcvr = rcvr
ifTrue: [rcvr sin]
ifFalse: [Float nan]]))]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSizeInBytes (in category 'memory space primitives') -----
primitiveSizeInBytes
<option: #SpurObjectMemory>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| byteSize |
byteSize := objectMemory totalByteSizeOf: self stackTop.
self pop: argumentCount + 1
thenPush: (self positive64BitIntegerFor: byteSize)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSizeInBytesOfInstance (in category 'memory space primitives') -----
primitiveSizeInBytesOfInstance
"Answer the byte size of an instance of the receiver. If num args > 0
then the last argument is a variable size and the size answered is the
size of an instance of the receiver with that many indexable elements."
<option: #SpurObjectMemory>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
| byteSize err |
NewspeakVM
ifTrue: "Support VMMirror>>byteSizeOfInstanceOf:WithIndexableVariables:"
[argumentCount > 2 ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs]]
ifFalse:
[argumentCount > 1 ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs]].
err := -1.
argumentCount >= 1 ifTrue:
[(objectMemory isIntegerObject: self stackTop) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
byteSize := objectMemory
byteSizeOfInstanceOf: (self stackValue: 1)
withIndexableSlots: (objectMemory integerValueOf: self stackTop)
errInto: [:code| err := code].
err >= 0 ifTrue:
[^self primitiveFailFor: err].
^self pop: argumentCount + 1 thenPush: (self positive64BitIntegerFor: byteSize)].
byteSize := objectMemory
byteSizeOfInstanceOf: (self stackValue: 0)
errInto: [:code| err := code].
err >= 0 ifTrue:
[^self primitiveFailFor: err].
self pop: 1 thenPushInteger: byteSize!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatArctan (in category 'arithmetic float primitives') -----
primitiveSmallFloatArctan
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr |
- <var: #rcvr type: #double>
rcvr := objectMemory smallFloatValueOf: self stackTop.
+ self stackTopPut: (objectMemory floatObjectOf: (self atan: rcvr))!
- self stackTopPut: (objectMemory floatObjectOf: (self cCode: [rcvr atan]
- inSmalltalk: [rcvr arcTan]))!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatExp (in category 'arithmetic float primitives') -----
primitiveSmallFloatExp
"Computes E raised to the receiver power.
Since SmallFloats cannot represent NaNs there's no need to special case."
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
-
self stackTopPut: (objectMemory floatObjectOf: (objectMemory smallFloatValueOf: self stackTop) exp)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatExponent (in category 'arithmetic float primitives') -----
primitiveSmallFloatExponent
"Answer the exponent part of this float."
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
-
self stackTopPut: (objectMemory integerObjectOf: (objectMemory exponentOfSmallFloat: self stackTop) - 1)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatFractionalPart (in category 'arithmetic float primitives') -----
primitiveSmallFloatFractionalPart
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr frac trunc |
- <var: #rcvr type: #double>
- <var: #frac type: #double>
<var: #trunc type: #double>
rcvr := objectMemory smallFloatValueOf: self stackTop.
+ frac := self mod: rcvr f: (self addressOf: trunc put: [:v| trunc := v]).
- frac := self cCode: [self mod: rcvr f: (self addressOf: trunc)]
- inSmalltalk: [rcvr fractionPart].
self stackTopPut: (objectMemory floatObjectOf: frac)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatLogN (in category 'arithmetic float primitives') -----
primitiveSmallFloatLogN
"Natural log."
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr |
- <var: #rcvr type: #double>
rcvr := objectMemory smallFloatValueOf: self stackTop.
+ self stackTopPut: (objectMemory floatObjectOf: (objectMemory floatObjectOf: (self log: rcvr)))!
- self stackTopPut: (objectMemory floatObjectOf: (self cCode: [rcvr log] inSmalltalk: [rcvr ln]))!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatSine (in category 'arithmetic float primitives') -----
primitiveSmallFloatSine
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr |
- <var: #rcvr type: #double>
rcvr := objectMemory smallFloatValueOf: self stackTop.
self stackTopPut: (objectMemory floatObjectOf: rcvr sin)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatSquareRoot (in category 'arithmetic float primitives') -----
primitiveSmallFloatSquareRoot
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
- <var: #rcvr type: #double>
| rcvr |
rcvr := objectMemory smallFloatValueOf: self stackTop.
rcvr >= 0.0
ifTrue: [self stackTopPut: (objectMemory floatObjectOf: rcvr sqrt)]
ifFalse: [self primitiveFail]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatTimesTwoPower (in category 'arithmetic float primitives') -----
primitiveSmallFloatTimesTwoPower
"Multiply the receiver by the power of the argument."
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr result arg twiceMaxExponent |
arg := self stackTop.
(objectMemory isIntegerObject: arg) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
rcvr := self stackValue: 1.
"N.B. SmallFloats are finite. NaN and Infinity overflow into boxed floats.
This is doing range checking work that is done in ldexp, but we include
it explicitly to exemplify bit manipulation of SmallFloats."
(objectMemory isSmallFloatZero: rcvr)
ifTrue:
[result := rcvr]
ifFalse:
[arg := objectMemory integerValueOf: arg.
twiceMaxExponent := 2 * (1 << self floatExponentBits).
arg < twiceMaxExponent negated
ifTrue:
[result := objectMemory mapSignedSmallFloatToSignedSmallFloatZero: rcvr]
ifFalse:
["clip arg to at most int range; ldexp's last arg is of type int"
arg > twiceMaxExponent ifTrue: [arg := twiceMaxExponent].
result := objectMemory floatObjectOf: (self cCode: [self ld: (objectMemory smallFloatValueOf: rcvr)
exp: (self cCoerceSimple: arg to: #int)]
inSmalltalk: [(objectMemory smallFloatValueOf: rcvr) timesTwoPower: arg])]].
self pop: 2 thenPush: result!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSmallFloatTruncated (in category 'arithmetic float primitives') -----
primitiveSmallFloatTruncated
<option: #Spur64BitMemoryManager>
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr trunc |
- <var: #rcvr type: #double>
<var: #trunc type: #double>
rcvr := objectMemory smallFloatValueOf: self stackTop.
+ self mod: rcvr f: (self addressOf: trunc put: [:v| trunc := v]).
- self cCode: [self mod: rcvr f: (self addressOf: trunc)]
- inSmalltalk: [trunc := rcvr truncated].
((trunc between: objectMemory minSmallInteger asFloat and: objectMemory maxSmallInteger asFloat)
and: [objectMemory isIntegerValue: trunc asInteger])
ifTrue: [self stackTopPut: (objectMemory integerObjectOf: trunc asInteger)]
ifFalse: [self primitiveFail]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSpecialObjectsOop (in category 'system control primitives') -----
primitiveSpecialObjectsOop
"Return the oop of the SpecialObjectsArray."
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
-
self pop: 1 thenPush: objectMemory specialObjectsOop.!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveStringReplace (in category 'indexing primitives') -----
primitiveStringReplace
"<array> primReplaceFrom: start to: stop with: replacement startingAt: repStart
<primitive: 105>"
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
objectMemory hasSpurMemoryManagerAPI
ifTrue: [self primitiveSpurStringReplace]
ifFalse: [self primitiveV3StringReplace]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSubtractLargeIntegers (in category 'arithmetic largeint primitives') -----
primitiveSubtractLargeIntegers
"Primitive arithmetic operations for large integers in 64 bit range"
- | a b result oopResult aIsNegative bIsNegative resultIsNegative oopArg oopRcvr |
<export: true>
+ <primitiveMetadata: #PrimCallOnSmalltalkStack>
+ | a b result oopResult aIsNegative bIsNegative resultIsNegative oopArg oopRcvr |
+ <var: 'a' type: #usqLong>
+ <var: 'b' type: #usqLong>
+ <var: 'result' type: #usqLong>
- <var: 'a' type: 'usqLong'>
- <var: 'b' type: 'usqLong'>
- <var: 'result' type: 'usqLong'>
oopArg := self stackValue: 0.
oopRcvr := self stackValue: 1.
aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
bIsNegative := self isNegativeIntegerValueOf: oopArg.
a := self magnitude64BitValueOf: oopRcvr.
b := self magnitude64BitValueOf: oopArg.
self successful ifFalse:[^nil].
(aIsNegative ~= bIsNegative)
ifTrue:
["Protect against overflow"
a > (16rFFFFFFFFFFFFFFFF - b) ifTrue: [self primitiveFail. ^nil].
result := a + b.
resultIsNegative := aIsNegative]
ifFalse:
[(a >= b)
ifTrue:
[result := a - b.
resultIsNegative := aIsNegative]
ifFalse:
[result := b - a.
resultIsNegative := aIsNegative not]].
oopResult := self magnitude64BitIntegerFor: result neg: resultIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult]!
- self successful ifTrue:[self pop: 2 thenPush: oopResult].
- !
Item was changed:
----- Method: InterpreterPrimitives>>primitiveTimesTwoPower (in category 'arithmetic float primitives') -----
primitiveTimesTwoPower
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
"Multiply the receiver by the power of the argument."
| rcvr result arg |
<var: #rcvr type: #double>
<var: #result type: #double>
arg := self stackTop.
(objectMemory isIntegerObject: arg) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
arg := objectMemory integerValueOf: arg.
objectMemory bytesPerOop > 4 ifTrue:
[| twiceMaxExponent | "clip arg to at most int range; ldexp's last arg is of type int"
twiceMaxExponent := 2 * (1 << self floatExponentBits).
arg < twiceMaxExponent negated
ifTrue: [arg := twiceMaxExponent negated]
ifFalse: [arg > twiceMaxExponent ifTrue:
[arg := twiceMaxExponent]]].
rcvr := objectMemory floatValueOf: (self stackValue: 1).
+ result := self ldexp: rcvr _: (self cCoerceSimple: arg to: #int).
- result := self cCode: [self ld: rcvr exp: (self cCoerceSimple: arg to: #int)]
- inSmalltalk: [rcvr timesTwoPower: arg].
self pop: 2 thenPushFloat: result!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveTruncated (in category 'arithmetic float primitives') -----
primitiveTruncated
"N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ <primitiveMetadata: #(PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x)>
| rcvr trunc |
- <var: #rcvr type: #double>
<var: #trunc type: #double>
rcvr := self stackFloatValue: 0.
self successful ifTrue:
+ [self mod: rcvr f: (self addressOf: trunc put: [:v| trunc := v]).
- [self cCode: [self mod: rcvr f: (self addressOf: trunc)]
- inSmalltalk: [trunc := rcvr = rcvr
- ifTrue: [rcvr truncated]
- ifFalse: [Float nan]].
(trunc between: objectMemory minSmallInteger asFloat and: objectMemory maxSmallInteger asFloat)
ifTrue: [self stackTopPut: (objectMemory integerObjectOf: trunc asInteger)]
ifFalse: [self primitiveFail]]!
Item was changed:
----- Method: LargeIntegersPlugin>>primAnyBitFrom:to: (in category 'Integer primitives') -----
primAnyBitFrom: from to: to
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| integer someBitIsSet val mask |
integer := self primitive: 'primAnyBitFromTo' parameters: #(SmallInteger SmallInteger) receiver: #Integer.
from < 1 | (to < 1) ifTrue:
[^ interpreterProxy primitiveFail].
(interpreterProxy isIntegerObject: integer)
ifTrue: "For small integers, use a single bit mask operation"
[from <= to
ifTrue:
[val := interpreterProxy integerValueOf: integer.
val < 0 ifTrue: ["Get the bits of magnitude" val := 0 - val].
mask := (1 asUnsignedInteger << (to min: (self sizeof: #usqInt) * 8 - 1))
- (1 asUnsignedInteger << (from - 1 min: (self sizeof: #usqInt) * 8 - 1)).
someBitIsSet := val anyMask: mask]
ifFalse: [someBitIsSet := 0]]
ifFalse:
[someBitIsSet := self anyBitOfLargeInt: integer from: from to: to].
^someBitIsSet asOop: Boolean!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitAdd: (in category 'Integer primitives') -----
primDigitAdd: secondInteger
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstLarge secondLarge firstInteger |
firstInteger := self primitive: 'primDigitAdd' parameters: #(Integer) receiver: #Integer.
(interpreterProxy isIntegerObject: firstInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse: [secondLarge := secondInteger].
^ self digitAddLarge: firstLarge with: secondLarge!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitAnd: (in category 'Integer primitives') -----
primDigitBitAnd: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstInteger |
firstInteger := self primitive: 'primDigitBitAnd' parameters: #(Integer) receiver: #Integer.
^self
digitBitLogic: firstInteger
with: secondInteger
opIndex: andOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitOr: (in category 'Integer primitives') -----
primDigitBitOr: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstInteger |
firstInteger := self primitive: 'primDigitBitOr' parameters: #(Integer) receiver: #Integer.
^self
digitBitLogic: firstInteger
with: secondInteger
opIndex: orOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitShiftMagnitude: (in category 'Integer primitives') -----
primDigitBitShiftMagnitude: shiftCount
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| rShift aLarge anInteger |
anInteger := self primitive: 'primDigitBitShiftMagnitude' parameters: #(SmallInteger) receiver: #Integer.
(interpreterProxy isIntegerObject: anInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[aLarge := self createLargeFromSmallInteger: anInteger]
ifFalse: [aLarge := anInteger].
shiftCount >= 0 ifTrue:
[^ self digit: aLarge Lshift: shiftCount].
rShift := 0 - shiftCount.
^self normalize: (self
digit: aLarge
Rshift: rShift
lookfirst: (self digitSizeOfLargeInt: aLarge))!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitXor: (in category 'Integer primitives') -----
primDigitBitXor: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstInteger |
firstInteger := self primitive: 'primDigitBitXor' parameters: #(Integer) receiver: #Integer.
^self
digitBitLogic: firstInteger
with: secondInteger
opIndex: xorOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitCompare: (in category 'Integer primitives') -----
primDigitCompare: secondInteger
"Compare the magnitude of self with that of arg.
Answer a code of 1, 0, -1 for self >, = , < arg"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstVal secondVal firstInteger |
firstInteger := self primitive: 'primDigitCompare' parameters: #(Integer) receiver: #Integer.
"shortcut: aSmallInteger has to be smaller in Magnitude than aLargeInteger"
(interpreterProxy isIntegerObject: firstInteger) ifTrue:
[(interpreterProxy isIntegerObject: secondInteger) ifTrue:
[firstVal := interpreterProxy integerValueOf: firstInteger.
secondVal := interpreterProxy integerValueOf: secondInteger.
"Compute their magnitudes. Since SmallIntegers are tagged they have
fewer bits than an integer on the platform; therefore in computing their
magnitude they cannot overflow."
firstVal < 0 ifTrue: [firstVal := 0 - firstVal].
secondVal < 0 ifTrue: [secondVal := 0 - secondVal].
^firstVal = secondVal
ifTrue: [0 asOop: SmallInteger]
ifFalse:
[firstVal < secondVal
ifTrue: [-1 asOop: SmallInteger]
ifFalse: [1 asOop: SmallInteger]]].
^-1 asOop: SmallInteger]. "first < second"
(interpreterProxy isIntegerObject: secondInteger) ifTrue:
[^1 asOop: SmallInteger]. "first > second"
^ self digitCompareLarge: firstInteger with: secondInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitDiv:negative: (in category 'Integer primitives') -----
primDigitDiv: secondInteger negative: neg
"Answer the result of dividing firstInteger by secondInteger.
Fail if parameters are not integers, not normalized or secondInteger is zero. "
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstAsLargeInteger secondAsLargeInteger firstInteger |
firstInteger := self primitive: 'primDigitDivNegative' parameters: #(Integer Boolean) receiver: #Integer.
"Coerce SmallIntegers to corresponding (not normalized) large integers
and check for zerodivide."
(interpreterProxy isIntegerObject: firstInteger)
ifTrue: "convert to LargeInteger"
[self
remapOop: secondInteger
in: [firstAsLargeInteger := self createLargeFromSmallInteger: firstInteger]]
ifFalse:
["Avoid crashes in case of getting unnormalized args."
(self isNormalized: firstInteger)
ifFalse:
[self debugCode:
[self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
self msg: '------> receiver *not* normalized!!'].
^ interpreterProxy primitiveFail].
firstAsLargeInteger := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
ifTrue: "check for zerodivide and convert to LargeInteger"
[(interpreterProxy integerValueOf: secondInteger)
= 0
ifTrue: [^ interpreterProxy primitiveFail].
self
remapOop: firstAsLargeInteger
in: [secondAsLargeInteger := self createLargeFromSmallInteger: secondInteger]]
ifFalse:
["Avoid crashes in case of getting unnormalized args."
(self isNormalized: secondInteger) ifFalse:
[self debugCode:
[self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
self msg: '------> argument *not* normalized!!'].
^ interpreterProxy primitiveFail].
secondAsLargeInteger := secondInteger].
^ self
digitDivLarge: firstAsLargeInteger
with: secondAsLargeInteger
negative: neg!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitMultiply:negative: (in category 'Integer primitives') -----
primDigitMultiply: secondInteger negative: neg
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstLarge secondLarge firstInteger |
firstInteger := self primitive: 'primDigitMultiplyNegative' parameters: #(Integer Boolean) receiver: #Integer.
(interpreterProxy isIntegerObject: firstInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[self
remapOop: secondInteger
in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[self
remapOop: firstLarge
in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse: [secondLarge := secondInteger].
^ self
digitMultiplyLarge: firstLarge
with: secondLarge
negative: neg!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitSubtract: (in category 'Integer primitives') -----
primDigitSubtract: secondInteger
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstLarge secondLarge firstInteger |
firstInteger := self primitive: 'primDigitSubtract' parameters: #(Integer) receiver: #Integer.
(interpreterProxy isIntegerObject: firstInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[self
remapOop: secondInteger
in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[self
remapOop: firstLarge
in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse: [secondLarge := secondInteger].
^ self digitSubLarge: firstLarge with: secondLarge!
Item was changed:
----- Method: LargeIntegersPlugin>>primMontgomeryDigitLength (in category 'Integer primitives') -----
primMontgomeryDigitLength
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
self primitive: #primMontgomeryDigitLength parameters: #() receiver: #Integer.
^interpreterProxy integerObjectOf: 32!
Item was changed:
----- Method: LargeIntegersPlugin>>primMontgomeryTimes:modulo:mInvModB: (in category 'Integer primitives') -----
primMontgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: mInverseInteger
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| firstLarge secondLarge firstInteger thirdLarge mInv |
<var: #mInv type: #'unsigned int'>
firstInteger := self primitive: 'primMontgomeryTimesModulo' parameters: #(Integer Integer Integer) receiver: #Integer.
mInv := interpreterProxy positive32BitValueOf: mInverseInteger.
(interpreterProxy isIntegerObject: firstInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[self remapOop: #(secondOperandInteger thirdModuloInteger) in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondOperandInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[self remapOop: #(firstLarge thirdModuloInteger) in: [secondLarge := self createLargeFromSmallInteger: secondOperandInteger]]
ifFalse: [secondLarge := secondOperandInteger].
(interpreterProxy isIntegerObject: thirdModuloInteger)
ifTrue: "convert it to a not normalized LargeInteger"
[self remapOop: #(firstLarge secondLarge) in: [thirdLarge := self createLargeFromSmallInteger: thirdModuloInteger]]
ifFalse: [thirdLarge := thirdModuloInteger].
^ self digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv!
Item was changed:
----- Method: LargeIntegersPlugin>>primNormalizeNegative (in category 'Integer primitives') -----
primNormalizeNegative
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| rcvr |
rcvr := self primitive: #primNormalizeNegative parameters: #() receiver: #LargeNegativeInteger.
^ self normalizeNegative: rcvr!
Item was changed:
----- Method: LargeIntegersPlugin>>primNormalizePositive (in category 'Integer primitives') -----
primNormalizePositive
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| rcvr |
rcvr := self primitive: #primNormalizePositive parameters: #() receiver: #LargePositiveInteger.
^ self normalizePositive: rcvr!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveCompareString (in category 'primitives') -----
primitiveCompareString
"ByteString (class) compare: string1 with: string2 collated: order"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| len1 len2 order string1 string2 orderOop string1Oop string2Oop |
<var: 'order' type: #'unsigned char *'>
<var: 'string1' type: #'unsigned char *'>
<var: 'string2' type: #'unsigned char *'>
orderOop := interpreterProxy stackValue: 0.
string2Oop := interpreterProxy stackValue: 1.
string1Oop := interpreterProxy stackValue: 2.
((interpreterProxy isBytes: orderOop)
and: [(interpreterProxy isBytes: string2Oop)
and: [interpreterProxy isBytes: string1Oop]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
order := interpreterProxy firstIndexableField: orderOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
string1 := interpreterProxy firstIndexableField: string1Oop.
string2 := interpreterProxy firstIndexableField: string2Oop.
len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1.
len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
0 to: (len1 min: len2) - 1 do:
[ :i | | c1 c2 |
c1 := order at: (string1 at: i).
c2 := order at: (string2 at: i).
c1 = c2 ifFalse:
[^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]].
interpreterProxy methodReturnInteger:
(len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') -----
primitiveCompressToByteArray
"Bitmap compress: bm toByteArray: ba"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "optimizing compilers require this; e.g. Clang/MSVC uses xmm/SE3"
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "optimizing compilers require this; e.g. Clang/MSVC uses xmm/SE3"
| bmOop baOop bm ba eqBytes i j k lowByte size destSize word |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
bmOop := interpreterProxy stackValue: 1.
baOop := interpreterProxy stackValue: 0.
bm := self cCode: [interpreterProxy arrayValueOf: bmOop]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: bmOop)
to: #'int *'].
interpreterProxy failed ifTrue: [^nil].
(interpreterProxy isBytes: baOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: baOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
ba := interpreterProxy firstIndexableField: baOop.
size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
i := self encodeInt: size in: ba at: 0.
k := 0.
[k < size] whileTrue:
[word := bm at: k.
lowByte := word bitAnd: 255.
eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
j := k.
[j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
j > k
ifTrue:
[eqBytes
ifTrue:
[i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1]
ifFalse:
[i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
i := self encodeBytesOf: word in: ba at: i].
k := j + 1]
ifFalse:
[eqBytes
ifTrue:
[i := self encodeInt: 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1.
k := k + 1]
ifFalse:
[[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
j + 1 = size ifTrue: [j := j + 1].
i := self encodeInt: j - k * 4 + 3 in: ba at: i.
k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
k := j]]].
interpreterProxy methodReturnInteger: i!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveConvert8BitSigned (in category 'primitives') -----
primitiveConvert8BitSigned
"SampledSound (class) convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "optimizing compilers require this; e.g. Clang/MSVC uses xmm/SE3"
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "optimizing compilers require this; e.g. Clang/MSVC uses xmm/SE3"
| aByteArray aSoundBuffer arraySize byteArrayOop soundBufferOop |
<var: 'aByteArray' type: #'unsigned char *'>
<var: 'aSoundBuffer' type: #'unsigned short *'>
byteArrayOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: byteArrayOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
soundBufferOop := interpreterProxy stackValue: 0.
(interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
aSoundBuffer := self
cCode: [interpreterProxy arrayValueOf: soundBufferOop]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: soundBufferOop)
to: #'unsigned short *'].
arraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy byteSizeOf: soundBufferOop) < (2 * arraySize) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
0 to: arraySize - 1 do:
[ :i | | s |
s := aByteArray at: i.
aSoundBuffer
at: i
put: (s > 127
ifTrue: [s - 256 bitShift: 8]
ifFalse: [s bitShift: 8])].
interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveDecompressFromByteArray (in category 'primitives') -----
primitiveDecompressFromByteArray
"Bitmap decompress: bm fromByteArray: ba at: index"
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "optimizing compilers require this; e.g. Clang/MSVC uses xmm/SE3"
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)> "optimizing compilers require this; e.g. Clang/MSVC uses xmm/SE3"
| bmOop baOop bm ba index i anInt code data end k n pastEnd |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
<var: 'anInt' type: #'unsigned int'>
<var: 'code' type: #'unsigned int'>
<var: 'data' type: #'unsigned int'>
<var: 'n' type: #'unsigned int'>
bmOop := interpreterProxy stackValue: 2.
baOop := interpreterProxy stackValue: 1.
bm := self cCode: [interpreterProxy arrayValueOf: bmOop]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: bmOop)
to: #'int *'].
(interpreterProxy isOopImmutable: bmOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
(interpreterProxy isBytes: baOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
ba := interpreterProxy firstIndexableField: baOop.
index := interpreterProxy stackIntegerValue: 0.
end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := index - 1.
k := 0.
[i < end] whileTrue:
[anInt := ba at: i.
i := i + 1.
anInt <= 223 ifFalse:
[anInt <= 254
ifTrue:
[anInt := anInt - 224 * 256 + (ba at: i).
i := i + 1]
ifFalse:
[anInt := 0.
1 to: 4 by: 1 do:
[ :j | anInt := (anInt bitShift: 8) + (ba at: i).
i := i + 1]]].
n := anInt >> 2.
k + n > pastEnd ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
code := anInt bitAnd: 3.
"code = 0 ifTrue: [nil]."
code = 1 ifTrue:
[data := ba at: i.
i := i + 1.
data := data bitOr: (data bitShift: 8).
data := data bitOr: (data bitShift: 16).
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 2 ifTrue:
[data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 3 ifTrue:
[1 to: n do:
[ :m |
data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
bm at: k put: data.
k := k + 1]]].
interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveFindFirstInString (in category 'primitives') -----
primitiveFindFirstInString
"ByteString (class) findFirstInString: aString inSet: inclusionMap startingAt: start"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| aString i inclusionMap stringSize aStringOop inclusionMapOop |
<var: 'aString' type: #'unsigned char *'>
<var: 'inclusionMap' type: #'unsigned char *'>
aStringOop := interpreterProxy stackValue: 2.
(interpreterProxy isBytes: aStringOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
inclusionMapOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: inclusionMapOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := i - 1. "Convert to 0-based index."
i < 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
inclusionMap := interpreterProxy firstIndexableField: inclusionMapOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue:
[^interpreterProxy methodReturnInteger: 0].
aString := interpreterProxy firstIndexableField: aStringOop.
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
[i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue:
[i := i + 1].
interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveFindSubstring (in category 'primitives') -----
primitiveFindSubstring
"ByteString findSubstring: key in: body startingAt: start matchTable: matchTable"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| body key keySize bodySize matchTable start bodyOop keyOop matchTableOop |
<var: #key type: #'unsigned char *'>
<var: #body type: #'unsigned char *'>
<var: #matchTable type: #'unsigned char *'>
keyOop := interpreterProxy stackValue: 3.
(interpreterProxy isBytes: keyOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
bodyOop := interpreterProxy stackValue: 2.
(interpreterProxy isBytes: bodyOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
matchTableOop := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: matchTableOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
matchTable := interpreterProxy firstIndexableField: matchTableOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: matchTable) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
key := interpreterProxy firstIndexableField: keyOop.
(keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue:
[keySize := keySize - 1. "adjust for zero relative indexes"
start := start - 1 max: 0. "adjust for zero relative indexes"
body := interpreterProxy firstIndexableField: bodyOop.
bodySize := interpreterProxy sizeOfSTArrayFromCPrimitive: body.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start to: bodySize - 1 - keySize do:
[ :startIndex | | index |
index := 0.
[(matchTable at: (body at: startIndex + index)) = (matchTable at: (key at: index))] whileTrue:
[index = keySize ifTrue:
[^interpreterProxy methodReturnInteger: startIndex + 1].
index := index + 1]]].
^interpreterProxy methodReturnInteger: 0!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveIndexOfAsciiInString (in category 'primitives') -----
primitiveIndexOfAsciiInString
"ByteString indexOfAscii: anInteger inString: aString startingAt: start"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| integerOop startOop anInteger aString start stringSize stringOop |
<var: #aString type: #'unsigned char *'>
integerOop := interpreterProxy stackValue: 2.
stringOop := interpreterProxy stackValue: 1.
startOop := interpreterProxy stackValue: 0.
((interpreterProxy isIntegerObject: integerOop)
and: [(interpreterProxy isIntegerObject: startOop)
and: [(interpreterProxy isBytes: stringOop)
and: [interpreterProxy isWordsOrBytes: stringOop]]]) ifFalse: "sizeOfSTArrayFromCPrimitive: is defined only for words or bytes"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(start := interpreterProxy integerValueOf: startOop) >= 1 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
anInteger := interpreterProxy integerValueOf: integerOop.
aString := interpreterProxy firstIndexableField: stringOop.
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
start - 1 to: stringSize - 1 do:
[:pos |
(aString at: pos) = anInteger ifTrue:
[^interpreterProxy methodReturnInteger: pos + 1]].
^interpreterProxy methodReturnInteger: 0!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveStringHash (in category 'primitives') -----
primitiveStringHash
"ByteArray (class) hashBytes: aByteArray startingWith: speciesHash"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| aByteArray hash byteArrayOop |
<var: 'aByteArray' type: #'unsigned char *'>
<var: 'hash' type: #'unsigned int'>
hash := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
byteArrayOop := interpreterProxy stackValue: 1.
((interpreterProxy isBytes: byteArrayOop)
and: [interpreterProxy isWordsOrBytes: byteArrayOop]) ifFalse: "filters out CompiledMethods"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
0 to: (interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray) - 1 do:
[ :pos |
hash := hash + (aByteArray at: pos) * 16r19660D ].
interpreterProxy methodReturnInteger: (hash bitAnd: 16r0FFFFFFF)!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveTranslateStringWithTable (in category 'primitives') -----
primitiveTranslateStringWithTable
"ByteString (class) translate: aString from: start to: stop table: table"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| aString start stop table aStringOop tableOop |
<var: #table type: #'unsigned char *'>
<var: #aString type: #'unsigned char *'>
aStringOop := interpreterProxy stackValue: 3.
(interpreterProxy isBytes: aStringOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: aStringOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
start := interpreterProxy stackIntegerValue: 2.
stop := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
tableOop := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: tableOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aString := interpreterProxy firstIndexableField: aStringOop.
(start >= 1 and: [stop <= (interpreterProxy sizeOfSTArrayFromCPrimitive: aString)]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
table := interpreterProxy firstIndexableField: tableOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: table) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start - 1 to: stop - 1 do: [ :i | aString at: i put: (table at: (aString at: i))].
interpreterProxy methodReturnReceiver!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive:flags: (in category 'primitive generators') -----
compileInterpreterPrimitive: primitiveRoutine flags: flags
"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)'>
| jmp continueAfterProfileSample jumpToTakeSample |
self deny: (backEnd hasVarBaseRegister
and: [self register: VarBaseReg isInMask: ABICallerSavedRegisterMask]).
"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.
"Old old full prim trace is in VMMaker-eem.550 and prior.
Old simpler full prim trace is in VMMaker-eem.2969 and prior."
(coInterpreter recordPrimTraceForMethod: methodObj) 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 AddCq: methodOrBlockNumArgs R: TempReg]. "As small or smaller than move on most archs"
self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
+ "If required, set newMethod"
+ (flags anyMask: PrimCallNeedsNewMethod) ifTrue:
+ [self genLoadNewMethod].
- "If required, set primitiveFunctionPointer and newMethod"
- (flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
- [self MoveCw: primitiveRoutine asInteger R: TempReg.
- self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
- (flags anyMask: PrimCallNeedsNewMethod+PrimCallMayEndureCodeCompaction) ifTrue:
- ["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
- (flags anyMask: PrimCallMayEndureCodeCompaction) 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. If the primitive (potentially) contains a call-back then its code
+ may disappear and consequently we cannot return here, since here may evaporate.
- may disappear and consequently we cannot return here, sicne here may evaporate.
Instead sideways-call the routine, substituting cePrimReturnEnterCogCode[Profiling]
as the return address, so the call always returns there."
self PrefetchAw: coInterpreter primFailCodeAddress.
(flags anyMask: PrimCallMayEndureCodeCompaction) ifTrue:
+ ["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
+ needsFrame := true.
- ["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders
- are found. So insist on PrimCallNeedsPrimitiveFunction being set too."
- objectMemory hasSpurMemoryManagerAPI ifTrue:
- [self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction)].
backEnd
genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil;
genSubstituteReturnAddress:
((flags anyMask: PrimCallCollectsProfileSamples)
ifTrue: [cePrimReturnEnterCogCodeProfiling]
ifFalse: [cePrimReturnEnterCogCode]).
self JumpFullRT: primitiveRoutine asInteger.
^0].
"Call the C primitive routine."
backEnd genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil.
self CallFullRT: primitiveRoutine asInteger.
backEnd genRemoveNArgsFromStack: 0.
+ objectRepresentation maybeCompileRetryOf: primitiveRoutine onPrimitiveFail: primitiveIndex flags: flags.
- objectRepresentation maybeCompileRetryOnPrimitiveFail: primitiveIndex.
"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"
backEnd genLoadStackPointersForPrimCall: ClassReg.
"genLoadStackPointersForPrimCall: leaves the stack in these states:
NoLinkRegister LinkRegister
success: result (was receiver) stackPointer -> result (was receiver)
stackPointer -> arg1 arg1
... ...
argN argN
return pc
failure: receiver receiver
arg1 arg1
... ...
argN stackPointer -> argN
stackPointer -> return pc
which corresponds to the stack on entry after pushRegisterArgs.
In either case we can write the instructionPointer to top of stack or load it into the LinkRegister to reestablish the return pc."
backEnd hasLinkRegister
ifTrue:
[self MoveAw: coInterpreter instructionPointerAddress R: LinkReg]
ifFalse:
[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.
self MoveR: ClassReg Mw: 0 r: SPReg].
"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.
jmp := self JumpNonZero: 0.
"placing the test here attributes the tick to the primitive plus any checkForAndFollowForwardedPrimitiveState
scanning, but attributes all of a failing primitive to the current method (in ceStackOverflow: on frame build)."
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample := self genCheckForProfileTimerTick: (self registerMaskFor: NoReg)].
"Fetch result from stack"
continueAfterProfileSample :=
self MoveMw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize])
r: SPReg
R: ReceiverResultReg.
self RetN: objectMemory wordSize. "return to caller, popping receiver"
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample jmpTarget: self Label.
self genTakeProfileSample.
backEnd genLoadStackPointerForPrimCall: ClassReg.
backEnd hasLinkRegister
ifTrue:
[self MoveAw: coInterpreter instructionPointerAddress R: LinkReg]
ifFalse:
[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.
self MoveR: ClassReg Mw: 0 r: SPReg].
self Jump: continueAfterProfileSample].
"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>>compileOnStackExternalPrimitive:flags: (in category 'primitive generators') -----
compileOnStackExternalPrimitive: primitiveRoutine flags: flags
"Compile a fast call of a C primitive using the current stack page, avoiding the stack switch except on failure.
This convention still uses stackPointer and argumentCount to access operands. Push all operands to the stack,
assign stackPointer, argumentCount, and zero primFailCode. Make the call (saving a LinkReg if required).
Test for failure and return. On failure on Spur, if there is an accessor depth, assign framePointer and newMethod,
do the stack switch, call checkForAndFollowForwardedPrimitiveState, and loop back if forwarders are found.
Fall through to frame build."
<option: #SpurObjectMemory>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
| calleeSavedRegisterMask linkRegSaveRegister spRegSaveRegister jmpFail retry continueAfterProfileSample jumpToTakeSample |
self assert: (objectRepresentation hasSpurMemoryManagerAPI and: [flags anyMask: PrimCallOnSmalltalkStack]).
self deny: (backEnd hasVarBaseRegister
and: [self register: VarBaseReg isInMask: ABICallerSavedRegisterMask]).
(coInterpreter recordFastCCallPrimTraceForMethod: methodObj) 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 AddCq: methodOrBlockNumArgs R: TempReg]. "As small or smaller than move on most archs"
self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
self genExternalizeStackPointerForFastPrimitiveCall.
"We may need to save LinkReg and/or SPReg, and given the stack machinations
it is much easier to save them in callee saved registers than on the stack itself."
calleeSavedRegisterMask := ABICalleeSavedRegisterMask bitClear: (self registerMaskFor: ClassReg).
backEnd hasLinkRegister ifTrue:
[linkRegSaveRegister := self availableRegisterOrNoneIn: calleeSavedRegisterMask.
self deny: linkRegSaveRegister = NoReg.
self MoveR: LinkReg R: linkRegSaveRegister.
calleeSavedRegisterMask := calleeSavedRegisterMask bitClear: (self registerMaskFor: linkRegSaveRegister)].
spRegSaveRegister := NoReg.
(SPReg ~= NativeSPReg
and: [(self isCalleeSavedReg: SPReg) not]) ifTrue:
[spRegSaveRegister := self availableRegisterOrNoneIn: calleeSavedRegisterMask.
self deny: spRegSaveRegister = NoReg.
self MoveR: SPReg R: spRegSaveRegister].
retry := self Label.
(flags anyMask: PrimCallOnSmalltalkStackAlign2x)
ifTrue: [self AndCq: (objectMemory wordSize * 2 - 1) bitInvert R: SPReg R: NativeSPReg]
ifFalse:
[SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadNativeSPRegWithAlignedSPReg]].
+ backEnd genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil.
+ "If the primitive is in the interpreter then its address won't change relative to the code zone over time,
+ whereas if it is in a plugin its address could change if the module is un/re/over/loaded.
+ So if in the interpreter and in range use a normal call instruction."
+ ((flags anyMask: PrimCallIsInternalPrim)
+ and: [backEnd isWithinCallRange: primitiveRoutine asInteger])
+ ifTrue: [self CallRT: primitiveRoutine asInteger]
+ ifFalse: [self CallFullRT: primitiveRoutine asInteger].
- backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
- self CallFullRT: primitiveRoutine asInteger.
backEnd genRemoveNArgsFromStack: 0.
"test primFailCode and jump to failure sequence if non-zero"
self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
spRegSaveRegister ~= NoReg ifTrue:
[self MoveR: spRegSaveRegister R: SPReg].
self CmpCq: 0 R: TempReg.
jmpFail := self JumpNonZero: 0.
"Remember to restore the native stack pointer to point to the C stack,
otherwise the Smalltalk frames will get overwritten on an interrupt."
SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadCStackPointer].
"placing the test here attributes the tick to the primitive plus any checkForAndFollowForwardedPrimitiveState
scanning, but attributes all of a failing primitive to the current method (in ceStackOverflow: on frame build)."
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample := self genCheckForProfileTimerTick: (self registerMaskFor: NoReg)].
"At this point the primitive has cut back stackPointer to point to the result."
continueAfterProfileSample :=
self MoveAw: coInterpreter stackPointerAddress R: TempReg.
"get result and restore retpc"
backEnd hasLinkRegister
ifTrue:
[self MoveMw: 0 r: TempReg R: ReceiverResultReg;
AddCq: objectMemory wordSize R: TempReg R: SPReg;
MoveR: linkRegSaveRegister R: LinkReg]
ifFalse:
[| retpcOffset |
"The original retpc is (argumentCount + 1) words below stackPointer."
retpcOffset := (methodOrBlockNumArgs + 1 * objectMemory wordSize) negated.
self MoveMw: retpcOffset r: TempReg R: ClassReg; "get retpc"
MoveR: TempReg R: SPReg;
MoveMw: 0 r: TempReg R: ReceiverResultReg;
MoveR: ClassReg Mw: 0 r: TempReg "put it back on stack for the return..."].
self RetN: 0.
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample jmpTarget: self Label.
self genTakeProfileSample.
self Jump: continueAfterProfileSample].
"primitive failure. if there is an accessor depth, scan and retry on failure (but what if faling for out of memory?)"
jmpFail jmpTarget: self Label.
(coInterpreter accessorDepthForPrimitiveMethod: methodObj) >= 0
ifTrue:
[| skip |
"Given that following primitive state to the accessor depth is recursive, we're asking for
trouble if we run the fixup on the Smalltalk stack page. Run it on the full C stack instead.
This won't be a performance issue since primitive failure should be very rare."
self MoveR: FPReg Aw: coInterpreter framePointerAddress.
self MoveCw: primitiveRoutine asInteger R: TempReg.
self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress.
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.
self genLoadCStackPointersForPrimCall.
backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
+ (backEnd isWithinCallRange: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
+ inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState]))
+ ifTrue:
+ [self CallRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
+ inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState])]
+ ifFalse:
+ [self CallFullRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
+ inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState])].
- self CallFullRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
- inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState]).
backEnd genLoadStackPointersForPrimCall: ClassReg.
self CmpCq: 0 R: ABIResultReg.
skip := self JumpZero: 0.
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
self Jump: retry.
skip jmpTarget: self Label]
ifFalse: "must reload SPReg to undo any alignment change,"
[(flags anyMask: PrimCallOnSmalltalkStackAlign2x) ifTrue:
[backEnd hasLinkRegister
ifTrue:
[self MoveAw: coInterpreter stackPointerAddress R: SPReg]
ifFalse: "remember to include return address; use scratch to avoid an interrupt overwriting retpc"
[self MoveAw: coInterpreter stackPointerAddress R: TempReg.
self SubCq: objectRepresentation wordSize R: TempReg.
self MoveR: TempReg R: SPReg]]].
"Remember to restore the native stack pointer to point to the C stack,
otherwise the Smalltalk frames will get overwritten on an interrupt."
SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadCStackPointer].
"The LinkRegister now contains the return address either of the primitive call or of checkForAndFollowForwardedPrimitiveState.
It must be restored to the return address of the send invoking this primtiive method."
backEnd hasLinkRegister ifTrue:
[self MoveR: linkRegSaveRegister R: LinkReg].
"Finally remember to reload ReceiverResultReg if required. Even if
arguments have been pushed, the prolog sequence assumes it is live."
(self register: ReceiverResultReg isInMask: ABICallerSavedRegisterMask) ifTrue:
[self MoveMw: (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1])) * objectMemory wordSize
r: SPReg
R: ReceiverResultReg].
"continue to frame build..."
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>compilePrimitive (in category 'primitive generators') -----
compilePrimitive
"Compile a primitive. If possible, performance-critical primitives will
be generated by their own routines (primitiveGenerator). Otherwise,
if there is a primitive at all, we 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."
<inline: false>
| primitiveDescriptor primitiveRoutine flags |
<var: #primitiveDescriptor type: #'PrimitiveDescriptor *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
primitiveIndex = 0 ifTrue: [^0].
"If a descriptor specifies an argument count (by numArgs >= 0) then it must match
for the generated code to be correct. For example for speed many primitives use
ResultReceiverReg instead of accessing the stack, so the receiver better be at
numArgs down the stack. Use the interpreter version if not."
((primitiveDescriptor := self primitiveGeneratorOrNil) notNil
and: [primitiveDescriptor primitiveGenerator notNil
and: [(primitiveDescriptor primNumArgs < 0 "means generator doesn't care"
or: [primitiveDescriptor primNumArgs = (coInterpreter argumentCountOf: methodObj)])]]) ifTrue:
[| opcodeIndexAtPrimitive code |
"Note opcodeIndex so that any arg load instructions
for unimplemented primitives can be discarded."
opcodeIndexAtPrimitive := opcodeIndex.
code := objectRepresentation perform: primitiveDescriptor primitiveGenerator.
(code < 0 and: [code ~= UnimplementedPrimitive]) ifTrue: "Generator failed, so no point continuing..."
[^code].
"If the primitive can never fail then there is nothing more that needs to be done."
code = UnfailingPrimitive ifTrue:
[^0].
"If the machine code version handles all cases the only reason to call the interpreter
primitive is to reap the primitive error code. Don't bother if it isn't used."
(code = CompletePrimitive
and: [(self methodUsesPrimitiveErrorCode: methodObj header: methodHeader) not]) ifTrue:
[^0].
"Discard any arg load code generated by the primitive generator."
code = UnimplementedPrimitive ifTrue:
[opcodeIndex := opcodeIndexAtPrimitive]].
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
primitiveIndex: primitiveIndex
primitivePropertyFlagsInto: (self addressOf: flags put: [:val| flags := val]).
- (flags anyMask: PrimCallDoNotJIT) ifTrue:
- [^ShouldNotJIT].
(primitiveRoutine = 0 "no primitive"
or: [primitiveRoutine = (self cCoerceSimple: #primitiveFail to: 'void (*)(void)')]) ifTrue:
[^self genFastPrimFail].
(objectRepresentation hasSpurMemoryManagerAPI
and: [flags anyMask: PrimCallOnSmalltalkStack]) ifTrue:
[^self compileOnStackExternalPrimitive: primitiveRoutine flags: flags].
^self compileInterpreterPrimitive: primitiveRoutine flags: flags!
Item was added:
+ ----- Method: SimpleStackBasedCogit>>genLoadNewMethod (in category 'primitive generators') -----
+ genLoadNewMethod
+ <inline: false>
+ 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!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveClosureValue (in category 'primitive generators') -----
genPrimitiveClosureValue
"Check the argument count. Fail if wrong.
Get the method from the outerContext and see if it is cogged. If so, jump to the
block entry or the no-context-switch entry, as appropriate, and we're done. If not,
invoke the interpreter primitive."
| jumpFailNArgs jumpFail1 jumpFail2 jumpFail3 jumpFail4 jumpBCMethod primitiveRoutine result |
- <var: #jumpFail1 type: #'AbstractInstruction *'>
- <var: #jumpFail2 type: #'AbstractInstruction *'>
- <var: #jumpFail3 type: #'AbstractInstruction *'>
- <var: #jumpFail4 type: #'AbstractInstruction *'>
- <var: #jumpFailNArgs type: #'AbstractInstruction *'>
- <var: #jumpBCMethod type: #'AbstractInstruction *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
objectRepresentation genLoadSlot: ClosureNumArgsIndex sourceReg: ReceiverResultReg destReg: TempReg.
self CmpCq: (objectMemory integerObjectOf: methodOrBlockNumArgs) R: TempReg.
jumpFailNArgs := self JumpNonZero: 0.
objectRepresentation genLoadSlot: ClosureOuterContextIndex sourceReg: ReceiverResultReg destReg: ClassReg.
jumpFail1 := objectRepresentation genJumpImmediate: ClassReg.
objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: TempReg.
objectRepresentation genCmpClassMethodContextCompactIndexR: TempReg.
jumpFail2 := self JumpNonZero: 0.
"We defer unforwarding the receiver to the prologue; scanning blocks
for inst var refs and only unforwarding if the block refers to inst vars."
(false
and: [objectRepresentation hasSpurMemoryManagerAPI]) ifTrue:
[objectRepresentation
genLoadSlot: ReceiverIndex sourceReg: ClassReg destReg: SendNumArgsReg;
genEnsureOopInRegNotForwarded: SendNumArgsReg
scratchReg: TempReg
updatingSlot: ReceiverIndex
in: ClassReg].
objectRepresentation genLoadSlot: MethodIndex sourceReg: ClassReg destReg: SendNumArgsReg.
jumpFail3 := objectRepresentation genJumpImmediate: SendNumArgsReg.
objectRepresentation genGetFormatOf: SendNumArgsReg into: TempReg.
self CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
jumpFail4 := self JumpLess: 0.
objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
self MoveM16: (self offset: CogMethod of: #blockEntryOffset) r: ClassReg R: TempReg.
self AddR: ClassReg R: TempReg.
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
primitiveIndex: primitiveIndex
primitivePropertyFlagsInto: nil.
primitiveRoutine = #primitiveClosureValueNoContextSwitch ifTrue:
[blockNoContextSwitchOffset = nil ifTrue:
[^NotFullyInitialized].
self SubCq: blockNoContextSwitchOffset R: TempReg].
self JumpR: TempReg.
jumpBCMethod jmpTarget: (jumpFail1 jmpTarget: (jumpFail2 jmpTarget: (jumpFail3 jmpTarget: (jumpFail4 jmpTarget: self Label)))).
(result := self
compileInterpreterPrimitive: primitiveRoutine
+ flags: (coInterpreter primitivePropertyFlags: primitiveIndex numArgs: methodOrBlockNumArgs)) < 0 ifTrue:
- flags: (coInterpreter primitivePropertyFlags: primitiveIndex)) < 0 ifTrue:
[^result].
jumpFailNArgs jmpTarget: self Label.
^CompletePrimitive!
Item was changed:
----- Method: SimpleStackBasedCogit>>genPrimitiveFullClosureValue (in category 'primitive generators') -----
genPrimitiveFullClosureValue
"Check the argument count. Fail if wrong.
Get the method from the outerContext and see if it is cogged. If so, jump to the
block entry or the no-context-switch entry, as appropriate, and we're done. If not,
invoke the interpreter primitive."
| jumpFailNArgs jumpFailImmediateMethod jumpFail4 jumpBCMethod primitiveRoutine result |
<option: #SistaV1BytecodeSet>
- <var: #jumpFailImmediateMethod type: #'AbstractInstruction *'>
- <var: #jumpFail4 type: #'AbstractInstruction *'>
- <var: #jumpFailNArgs type: #'AbstractInstruction *'>
- <var: #jumpBCMethod type: #'AbstractInstruction *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
objectRepresentation genLoadSlot: ClosureNumArgsIndex sourceReg: ReceiverResultReg destReg: TempReg.
self CmpCq: (objectMemory integerObjectOf: methodOrBlockNumArgs) R: TempReg.
jumpFailNArgs := self JumpNonZero: 0.
"We defer unforwarding the receiver to the prologue; scanning blocks
for inst var refs and only unforwarding if the block refers to inst vars."
(false
and: [objectRepresentation hasSpurMemoryManagerAPI]) ifTrue:
[objectRepresentation
genLoadSlot: FullClosureReceiverIndex sourceReg: ReceiverResultReg destReg: SendNumArgsReg;
genEnsureOopInRegNotForwarded: SendNumArgsReg
scratchReg: TempReg
updatingSlot: FullClosureReceiverIndex
in: ReceiverResultReg].
objectRepresentation genLoadSlot: FullClosureCompiledBlockIndex sourceReg: ReceiverResultReg destReg: SendNumArgsReg.
jumpFailImmediateMethod := objectRepresentation genJumpImmediate: SendNumArgsReg.
objectRepresentation genGetFormatOf: SendNumArgsReg into: TempReg.
self CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
jumpFail4 := self JumpLess: 0.
objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
primitiveIndex: primitiveIndex
primitivePropertyFlagsInto: nil.
self AddCq: (primitiveRoutine = #primitiveFullClosureValueNoContextSwitch
ifTrue: [self fullBlockNoContextSwitchEntryOffset]
ifFalse: [self fullBlockEntryOffset])
R: ClassReg.
self JumpR: ClassReg.
jumpBCMethod jmpTarget: (jumpFailImmediateMethod jmpTarget: (jumpFail4 jmpTarget: self Label)).
(result := self
compileInterpreterPrimitive: primitiveRoutine
+ flags: (coInterpreter primitivePropertyFlags: primitiveIndex numArgs: methodOrBlockNumArgs)) < 0 ifTrue:
- flags: (coInterpreter primitivePropertyFlags: primitiveIndex)) < 0 ifTrue:
[^result].
jumpFailNArgs jmpTarget: self Label.
^CompletePrimitive!
Item was changed:
----- Method: SimpleStackBasedCogit>>genTakeProfileSample (in category 'primitive generators') -----
genTakeProfileSample
methodLabel addDependent:
(self annotateAbsolutePCRef:
(self MoveCw: methodLabel asInteger R: ClassReg)).
backEnd genMarshallNArgs: 1 arg: ClassReg arg: nil arg: nil arg: nil.
SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadNativeSPRegWithAlignedSPReg].
+ (backEnd isWithinCallRange: (self cCode: [#ceTakeProfileSample: asInteger]
+ inSmalltalk: [self simulatedTrampolineFor: #ceTakeProfileSample:]))
+ ifTrue:
+ [self CallRT: (self cCode: [#ceTakeProfileSample: asUnsignedIntegerPtr]
+ inSmalltalk: [self simulatedTrampolineFor: #ceTakeProfileSample:])]
+ ifFalse:
+ [self CallFullRT: (self cCode: [#ceTakeProfileSample: asUnsignedIntegerPtr]
+ inSmalltalk: [self simulatedTrampolineFor: #ceTakeProfileSample:])].
- self CallFullRT: (self cCode: [#ceTakeProfileSample: asUnsignedIntegerPtr]
- inSmalltalk: [self simulatedTrampolineFor: #ceTakeProfileSample:]).
backEnd genRemoveNArgsFromStack: 1.
"Remember to restore the native stack pointer to point to the C stack,
otherwise the Smalltalk frames will get overwritten on an interrupt."
SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadCStackPointer]!
Item was added:
+ ----- Method: SocketPluginSimulator class>>cleanUp (in category 'class initialization') -----
+ cleanUp
+ "SocketPluginSimulator cleanUp"
+ "InterpreterPrimitives allSubInstances"
+ Smalltalk unregisterExternalObjects: (Smalltalk externalObjects select: [:s| s class == Semaphore and: [s notEmpty and: [s first suspendedContext receiver class == SocketPluginSimulator]]])!
Item was added:
+ ----- Method: SpurMemoryManager>>makePointwithxValue:yValue: (in category 'simulation only') -----
+ makePointwithxValue: xValue yValue: yValue
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter makePointwithxValue: xValue yValue: yValue!
Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
(excessive size, no diff calculated)
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: '<stdio.h> /* for printf */';
addHeaderFile: '<stdlib.h> /* for e.g. alloca */';
addHeaderFile: '<setjmp.h>';
addHeaderFile: '<wchar.h> /* for wint_t */';
addHeaderFile: '"vmCallback.h"';
addHeaderFile: '"sqMemoryFence.h"';
addHeaderFile: '"sqImageFileAccess.h"';
addHeaderFile: '"sqSetjmpShim.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: #usqLong. "see dispdbg.h"
"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 stackPointer framePointer stackLimit breakSelector)
as: #'char *'
in: aCCodeGenerator.
aCCodeGenerator
var: #breakSelectorLength
declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
self declareC: #(stackPage overflowedPage)
as: #'StackPage *'
in: aCCodeGenerator.
aCCodeGenerator
var: #transcript type: #'FILE *'.
aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code."
"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, ' */]'.
NewspeakVM
ifTrue:
[aCCodeGenerator
var: #nsMethodCache
declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]']
ifFalse:
[aCCodeGenerator
removeVariable: #nsMethodCache;
removeVariable: 'localAbsentReceiver';
removeVariable: 'localAbsentReceiverOrZero'].
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: #primitiveMetadataTable
+ type: 'signed short'
- var: #primitiveAccessorDepthTable
- type: 'signed char'
sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
+ array: (vmClass primitiveMetadataTableUsing: aCCodeGenerator).
+ aCCodeGenerator
+ removeConstant: #PrimNumberInstVarAt;
+ removeConstant: #PrimNumberPerform;
+ removeConstant: # PrimNumberPerformWithArgs;
+ removeConstant: #PrimNumberShallowCopy;
+ removeConstant: #PrimNumberSlotAt;
+ removeConstant: #PrimNumberFlushExternalPrimitives;
+ removeConstant: #PrimNumberUnloadModule]
- array: (vmClass primitiveAccessorDepthTableUsing: aCCodeGenerator)]
ifFalse:
+ [aCCodeGenerator
+ removeVariable: #primitiveMetadataTable;
+ removeConstant: #PrimNumberVMParameter].
+
- [aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
aCCodeGenerator
var: #displayBits type: #'void *';
var: #primitiveCalloutPointer declareC: 'void *primitiveCalloutPointer = (void *)-1'.
self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator.
aCCodeGenerator
var: #primitiveFunctionPointer
declareC: 'void (*primitiveFunctionPointer)()';
var: 'pcPreviousToFunction'
declareC: 'sqInt (* const pcPreviousToFunction)(sqInt,sqInt) = ', (aCCodeGenerator cFunctionNameFor: PCPreviousToFunction);
var: #externalPrimitiveTable
declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)';
var: #interruptCheckChain
declareC: 'void (*interruptCheckChain)(void) = 0';
var: #showSurfaceFn
+ declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)'.
- declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)';
- var: #jmpBuf
- declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
- var: #suspendedCallbacks
- declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
- var: #suspendedMethods
- declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs
"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
statProcessSwitch statIOProcessEvents statForceInterruptCheck
statCheckForEvents statStackOverflow statStackPageDivorce
statIdleUsecs)
in: aCCodeGenerator.
aCCodeGenerator var: #nextProfileTick type: #sqLong.
aCCodeGenerator var: #reenterInterpreter type: 'jmp_buf'.
LowcodeVM
ifTrue:
[aCCodeGenerator
var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'.
self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer)
as: #'char *'
in: aCCodeGenerator]
ifFalse:
[#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do:
[:var| aCCodeGenerator removeVariable: var]].
(self instVarNames select: [:ivn| ivn beginsWith: 'longRunningPrimitive']) do:
[:lrpmVar|
aCCodeGenerator
var: lrpmVar
declareC: '#if LRPCheck\', ((lrpmVar endsWith: 'Usecs') ifTrue: [#usqLong] ifFalse: [#sqInt]), ' ', lrpmVar, '\#endif']!
Item was removed:
- ----- Method: StackInterpreter class>>initializeDirectoryLookupResultCodes (in category 'initialization') -----
- initializeDirectoryLookupResultCodes
-
- DirEntryFound := 0.
- DirNoMoreEntries := 1.
- DirBadPath := 2.!
Item was changed:
----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
super initializeMiscConstants.
STACKVM := true.
RevisedSuspend := true. "primitiveSuspend no longer allows a process waiting on a condition variable to go past the condition variable"
"These flags identify a GC operation (& hence a reason to leak check),
or just operations the leak checker can be run for."
GCModeFull := 1. "stop-the-world global GC"
GCModeNewSpace := 2. "Spur's scavenge, or V3's incremental"
GCModeIncremental := 4. "incremental global gc (Dijkstra tri-colour marking); as yet unimplemented"
GCModeBecome := 8. "v3 post-become sweeping/Spur forwarding"
GCCheckImageSegment := 16. "just a flag for leak checking image segments"
GCCheckFreeSpace := 32. "just a flag for leak checking free space; Spur only"
GCCheckShorten := 64. "just a flag for leak checking object shortening operations; Spur only"
GCCheckPrimCall := 128. "just a flag for leak checking external primitive calls"
StackPageTraceInvalid := -1.
StackPageUnreached := 0.
StackPageReachedButUntraced := 1.
StackPageTraced := 2.
- DumpStackOnLowSpace := 0.
MillisecondClockMask := 16r1FFFFFFF.
"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
MaxExternalPrimitiveTableSize := 4096. "entries"
- MaxJumpBuf := 32. "max. callback depth"
FailImbalancedPrimitives := InitializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true].
EnforceAccessControl := InitializationOptions at: #EnforceAccessControl ifAbsent: [true].
ReturnToInterpreter := 1. "setjmp/longjmp code."
"Because of a hack with callbacks in the non-threaded VM they must not conflct with the VM's tag bits."
DisownVMForFFICall := 16.
DisownVMForThreading := 32
!
Item was changed:
----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreter class>>initializeWithOptions: (in category 'initialization') -----
initializeWithOptions: optionsDictionary
"StackInterpreter initializeWithOptions: Dictionary new"
super initializeWithOptions: optionsDictionary.
self initializeMiscConstants. "must precede other initialization."
self initializeAssociationIndex.
self initializeBytecodeTable.
self initializeCaches.
self initializeCharacterIndex.
self initializeCharacterScannerIndices.
self initializeClassIndices.
self initializeContextIndices.
- self initializeDirectoryLookupResultCodes.
self initializeFrameIndices.
self initializeMessageIndices.
self initializeMethodIndices.
self initializePointIndices.
self initializePrimitiveTable.
self initializeSchedulerIndices.
self initializeSmallIntegers.
self initializeStreamIndices!
Item was changed:
----- Method: StackInterpreter class>>metadataFlagsForPrimitive: (in category 'spur compilation support') -----
metadataFlagsForPrimitive: aPrimitiveMethod
+ "We allow methods to decorate themselves with 8 flags (FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag et al)
+ that alter how the Cogit dispatches primitives. These flags are supplied by the primitiveMetadata: pragma.
+ But this is not relevant to the StackInterpreter."
- "We allow methods to decorate themselves with 8 flags (only one specified so far: FastCPrimitiveFlag)
- using the export:flags: pragma. But this is not relevant to the StackInterpreter."
^0!
Item was removed:
- ----- Method: StackInterpreter class>>primitiveAccessorDepthTable (in category 'constants') -----
- primitiveAccessorDepthTable
- | cg |
- cg := CCodeGenerator new.
- cg vmClass: StackInterpreter.
- ^self primitiveAccessorDepthTableUsing: cg!
Item was removed:
- ----- Method: StackInterpreter class>>primitiveAccessorDepthTableUsing: (in category 'constants') -----
- primitiveAccessorDepthTableUsing: aCCodeGenerator
- ^self primitiveTable collect:
- [:thing| | implementingClass |
- (thing isInteger "quick prims, 0 for fast primitve fail"
- or: [thing == #primitiveFail
- or: [(implementingClass := self primitivesClass whichClassIncludesSelector: thing) isNil]])
- ifTrue: [-1]
- ifFalse:
- [aCCodeGenerator accessorDepthForMethod:
- ((aCCodeGenerator methodNamed: thing) ifNil:
- [aCCodeGenerator compileToTMethodSelector: thing in: implementingClass])]]!
Item was added:
+ ----- Method: StackInterpreter class>>primitiveMetadataDepthTable (in category 'constants') -----
+ primitiveMetadataDepthTable
+ | cg |
+ cg := CCodeGenerator new.
+ cg vmClass: StackInterpreter.
+ ^self primitiveMetadataTableUsing: cg!
Item was added:
+ ----- Method: StackInterpreter class>>primitiveMetadataTableUsing: (in category 'constants') -----
+ primitiveMetadataTableUsing: aCCodeGenerator
+ ^self primitiveTable collect:
+ [:thing| | implementingClass tMethod |
+ (thing isInteger "quick prims, 0 for fast primitve fail"
+ or: [thing == #primitiveFail
+ or: [(implementingClass := self primitivesClass whichClassIncludesSelector: thing) isNil]])
+ ifTrue: [-1 << SpurPrimitiveAccessorDepthShift]
+ ifFalse:
+ [tMethod := (aCCodeGenerator methodNamed: thing) ifNil:
+ [aCCodeGenerator compileToTMethodSelector: thing in: implementingClass].
+ (aCCodeGenerator accessorDepthForMethod: tMethod) << SpurPrimitiveAccessorDepthShift
+ + (self metadataFlagsForPrimitive: tMethod)]]!
Item was added:
+ ----- Method: StackInterpreter>>accessorDepthForPrimitiveIndex: (in category 'cog jit support') -----
+ accessorDepthForPrimitiveIndex: primIndex
+ <api>
+ <option: #SpurObjectMemory>
+ ^(primitiveMetadataTable at: primIndex) >>> SpurPrimitiveAccessorDepthShift!
Item was added:
+ ----- Method: StackInterpreter>>accessorDepthForPrimitiveMethod: (in category 'cog jit support') -----
+ accessorDepthForPrimitiveMethod: aMethodObj
+ <api>
+ <option: #SpurObjectMemory>
+ | primIndex |
+ primIndex := self primitiveIndexOf: aMethodObj.
+ ^(primIndex = PrimNumberExternalCall
+ and: [self isLinkedExternalPrimitive: aMethodObj])
+ ifTrue: [self accessorDepthForExternalPrimitiveMethod: aMethodObj]
+ ifFalse: [self accessorDepthForPrimitiveIndex: primIndex]!
Item was changed:
----- Method: StackInterpreter>>callbackEnter: (in category 'callback support') -----
callbackEnter: callbackID
+ "Re-enter the interpreter to execute a (non-Alien) callback."
- "Re-enter the interpreter to execute a (non-ALien,non-FFI) callback (as used by the Python bridge)."
- <volatile>
<export: true>
<var: #callbackID type: #'sqInt *'>
+ self warning: 'callbackEnter: is obsolete'.
+ ^false!
- | savedReenterInterpreter |
- <var: #savedReenterInterpreter type: #'jmp_buf'>
-
- "For now, do not allow a callback unless we're in a primitiveResponse"
- (self asserta: primitiveFunctionPointer ~= 0) ifFalse:
- [^false].
-
- self assert: primFailCode = 0.
-
- "Check if we've exceeded the callback depth"
- (self asserta: jmpDepth < MaxJumpBuf) ifFalse:
- [^false].
- jmpDepth := jmpDepth + 1.
-
- "Suspend the currently active process"
- suspendedCallbacks at: jmpDepth put: self activeProcess.
- "We need to preserve newMethod explicitly since it is not activated yet
- and therefore no context has been created for it. If the caller primitive
- for any reason decides to fail we need to make sure we execute the correct
- method and not the one 'last used' in the call back"
- suspendedMethods at: jmpDepth put: newMethod.
- "Signal external semaphores since a signalSemaphoreWithIndex: request may
- have been issued immediately prior to this callback before the VM has any
- chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
- self signalExternalSemaphores.
- "If no process is awakened by signalExternalSemaphores then transfer
- to the highest priority runnable one."
- (suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue:
- [self transferTo: self wakeHighestPriority].
-
- "Typically, invoking the callback means that some semaphore has been
- signaled to indicate the callback. Force an interrupt check as soon as possible."
- self forceInterruptCheck.
-
- "Save the previous interpreter entry jmp_buf."
- self memcpy: savedReenterInterpreter asVoidPointer
- _: reenterInterpreter
- _: (self sizeof: #'jmp_buf').
- (self _setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID"
- [callbackID at: 0 put: jmpDepth.
- self enterSmalltalkExecutive.
- self assert: false "NOTREACHED"].
-
- "Restore the previous interpreter entry jmp_buf."
- self memcpy: reenterInterpreter
- _: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
- _: (self sizeof: #'jmp_buf').
-
- "Transfer back to the previous process so that caller can push result"
- self putToSleep: self activeProcess yieldingIf: preemptionYields.
- self transferTo: (suspendedCallbacks at: jmpDepth).
- newMethod := suspendedMethods at: jmpDepth. "see comment above"
- argumentCount := self argumentCountOf: newMethod.
- self assert: primFailCode = 0.
- jmpDepth := jmpDepth - 1.
- ^true!
Item was changed:
----- Method: StackInterpreter>>callbackLeave: (in category 'callback support') -----
callbackLeave: cbID
"Leave from a previous callback"
<export: true>
+ self warning: 'callbackLeave: is obsolete'.
+ ^false!
- "For now, do not allow a callback return unless we're in a primitiveResponse"
- (self asserta: primitiveFunctionPointer ~= 0) ifFalse:
- [^false].
-
- "Check if this is the top-level callback"
- cbID = jmpDepth ifFalse:[^false].
- cbID < 1 ifTrue:[^false].
- "This is ugly but necessary, or otherwise the Mac will not build"
- self _longjmp: (jmpBuf at: jmpDepth) _: 1.
- "NOTREACHED"
- ^nil!
Item was changed:
----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
checkForAndFollowForwardedPrimitiveState
"In Spur a primitive may fail due to encountering a forwarder. On failure, check the accessorDepth for the
primitive and if non-negative scan the args to the depth, following any forwarders. Answer if any are found
so the prim can be retried. The primitive index is derived from newMethod.
See http://www.mirandabanda.org/cogblog/2014/02/08/primitives-and-the-partial-r…
and SpurMemoryManager's class comment."
<option: #SpurObjectMemory>
| primIndex accessorDepth found |
self assert: self failed.
found := false.
primIndex := self primitiveIndexOf: newMethod.
self assert: (argumentCount = (self argumentCountOf: newMethod) or: [self isMetaPrimitiveIndex: primIndex]).
"First things first; make sure the metadata has been followed before it is accessed to derive accessorDepth..."
(((self isCalloutPrimitiveIndex: primIndex) or: [primIndex = PrimNumberDoExternalCall])
and: [self unfollowFirstLiteralOfMaybeCalloutMethod: newMethod primitiveIndex: primIndex]) ifTrue:
[found := true].
"If the primitive is one of the meta primitives PrimNumberDoPrimitive or PrimNumberDoExternalCall, then
metaAccessorDepth will have been set to nil at the start of the primitive, and to the accessor depth of the
called primitive (or external call) immediately before dispatch. Hence if primIndex is that of a meta primitive
then if metaAccessorDepth is -2, the accessor depth is that of the meta primitive, and if > -2, then
metaAccessorDepth is the accessor depth of the primitive (or external call). Similarly, if the primitive is
primitiveExternalCall then the accessor depth is that of primitiveExternalCall until primitiveFunctionPointer
is assigned, at which point the accessor depth is taken from the slot in newMethod's first literal."
accessorDepth := ((self isMetaPrimitiveIndex: primIndex)
and: [metaAccessorDepth > -2])
ifTrue: [metaAccessorDepth]
+ ifFalse: [self accessorDepthForPrimitiveMethod: newMethod].
- ifFalse:
- [(primIndex = PrimNumberExternalCall
- and: [primitiveFunctionPointer ~~ #primitiveExternalCall])
- ifTrue: [self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]
- ifFalse: [primitiveAccessorDepthTable at: primIndex]].
- self assert: (self saneFunctionPointerForFailureOfPrimIndex: primIndex).
self assert: (accessorDepth between: -1 and: 5).
accessorDepth >= 0 ifTrue:
[| scannedStackFrame |
scannedStackFrame := false.
0 to: argumentCount do:
[:index| | oop |
oop := self stackValue: index.
(objectMemory isNonImmediate: oop) ifTrue:
[(objectMemory isForwarded: oop) ifTrue:
[self assert: index < argumentCount. "receiver should have been caught at send time."
found := true.
oop := objectMemory followForwarded: oop.
self stackValue: index put: oop.
scannedStackFrame ifFalse:
[scannedStackFrame := true.
self "Avoid repeated primitive failures by following all state in the current stack frame."
followForwardedFrameContents: framePointer
stackPointer: stackPointer + (argumentCount + 1 * objectMemory wordSize)]].
(accessorDepth > 0
and: [(objectMemory hasPointerFields: oop)
and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]]) ifTrue:
[found := true]]]].
^found!
Item was changed:
----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
checkInterpreterIntegrity
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Check that all oops in the interpreter's state
points to a header. Answer 0 if all checks pass."
| flags |
flags := 0.
(objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop') ifFalse:
[flags := 1].
"No longer check messageSelector; it is ephemeral, not living beyond message lookup.
(objectMemory isNonImmediate: messageSelector) ifTrue:
[(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector') ifFalse:
[flags := flags + N]]."
(objectMemory checkOopIntegrity: newMethod named: 'newMethod') ifFalse:
[flags := flags + 2].
"No longer check lkupClass; it is ephemeral, not living beyond message lookup.
(objectMemory checkOopIntegrity: lkupClass named: 'lkupClass') ifFalse:
[flags := flags + N]."
(objectMemory checkOopIntegrity: profileProcess named: 'profileProcess') ifFalse:
[flags := flags + 4].
(objectMemory checkOopIntegrity: profileMethod named: 'profileMethod') ifFalse:
[flags := flags + 8].
(objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore') ifFalse:
[flags := flags + 16].
tempOop = 0 ifFalse:
[(objectMemory checkOopIntegrity: tempOop named: 'tempOop') ifFalse:
[flags := flags + 32]].
tempOop2 = 0 ifFalse:
[(objectMemory checkOopIntegrity: tempOop2 named: 'tempOop2') ifFalse:
[flags := flags + 64]].
- "Callback support - check suspended callback list"
- 1 to: jmpDepth do:
- [:i|
- (objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
- [flags := flags + 128].
- (objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
- [flags := flags + 256]].
-
self checkLogIntegrity ifFalse:
+ [flags := flags + 128].
- [flags := flags + 512].
^flags!
Item was added:
+ ----- Method: StackInterpreter>>computeAccessorDepthsForInterpreterPrimitives (in category 'primitive support') -----
+ computeAccessorDepthsForInterpreterPrimitives
+ <doNotGenerate>
+ | cg |
+ cg := self codeGeneratorToComputeAccessorDepth.
+ primitiveMetadataTable ifNil:
+ [primitiveMetadataTable := Array new: primitiveTable size withAll: (-1 bitShift: SpurPrimitiveAccessorDepthShift)].
+ primitiveTable withIndexDo:
+ [:prim :index| | depthAndFlags |
+ prim isSymbol ifTrue:
+ [depthAndFlags := self metadataFlagsFor: prim using: cg.
+ self assert: depthAndFlags isInteger.
+ (self isCalloutPrimitiveIndex: index) ifFalse:
+ [depthAndFlags := depthAndFlags bitOr: PrimCallIsInternalPrim].
+ primitiveMetadataTable at: index - 1 put: depthAndFlags]].
+ ^cg!
Item was removed:
- ----- Method: StackInterpreter>>computeAccessorDepthsForInterpreterPrmitives (in category 'primitive support') -----
- computeAccessorDepthsForInterpreterPrmitives
- <doNotGenerate>
- | cg |
- cg := self codeGeneratorToComputeAccessorDepth.
- primitiveAccessorDepthTable ifNil:
- [primitiveAccessorDepthTable := Array new: primitiveTable size].
- primitiveTable withIndexDo:
- [:prim :index| | depth |
- prim isSymbol ifTrue:
- [depth := cg accessorDepthForSelector: prim.
- self assert: depth isInteger.
- primitiveAccessorDepthTable at: index - 1 put: depth]].
- ^cg!
Item was changed:
----- Method: StackInterpreter>>initialize (in category 'initialization') -----
initialize
"Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
super initialize.
primitiveDoMixedArithmetic := true. "whether we authorize primitives to perform mixed arithmetic or not".
newFinalization := false.
stackLimit := 0. "This is also the initialization flag for the stack system."
stackPage := overflowedPage := 0.
extraFramesToMoveOnOverflow := 0.
bytecodeSetSelector := 0.
highestRunnableProcessPriority := 0.
nextPollUsecs := 0.
nextWakeupUsecs := 0.
tempOop := tempOop2 := theUnknownShort := 0.
interruptPending := false.
inIOProcessEvents := 0.
fullScreenFlag := 0.
sendWheelEvents := deferDisplayUpdates := false.
displayBits := displayWidth := displayHeight := displayDepth := 0.
pendingFinalizationSignals := statPendingFinalizationSignals := 0.
globalSessionID := 0.
- jmpDepth := 0.
longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
maxExtSemTabSizeSet := false.
debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0.
primitiveCalloutPointer := -1. "initialized in declaration in declareCVarsIn:"
transcript := Transcript. "initialized to stdout in readImageFromFile:HeapSize:StartingAt:"
pcPreviousToFunction := PCPreviousToFunction. "initialized via StackInterpreter class>>declareCVarsIn:"
statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
statProcessSwitch := statIOProcessEvents := statStackPageDivorce :=
statIdleUsecs := 0!
Item was changed:
----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
mapInterpreterOops
"Map all oops in the interpreter's state to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops."
<inline: false>
self mapStackPages.
self mapMachineCode: self getGCMode.
self mapTraceLogs.
self mapVMRegisters.
self mapProfileState.
- self remapCallbackState.
(tempOop ~= 0
and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
[tempOop := objectMemory remapObj: tempOop].
(tempOop2 ~= 0
and: [objectMemory shouldRemapOop: tempOop2]) ifTrue:
[tempOop2 := objectMemory remapObj: tempOop2].
objectMemory hasSpurMemoryManagerAPI ifFalse:
[self getClassTagOfLinkedList]!
Item was changed:
----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
markAndTraceInterpreterOops: fullGCFlag
"Mark and trace all oops in the interpreter's state."
"Assume: All traced variables contain valid oops.
N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
only during message lookup and because createActualMessageTo will not
cause a GC these cannot change during message lookup."
| oop |
"Must mark stack pages first to initialize the per-page trace
flags for full garbage collect before any subsequent tracing."
self markAndTraceStackPages: fullGCFlag.
self markAndTraceTraceLog.
self markAndTracePrimTraceLog.
objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
(objectMemory isImmediate: newMethod) ifFalse:
[objectMemory markAndTrace: newMethod].
self traceProfileState.
tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
tempOop2 = 0 ifFalse: [objectMemory markAndTrace: tempOop2].
"V3 memory manager support"
1 to: objectMemory remapBufferCount do:
[:i |
oop := objectMemory remapBuffer at: i.
+ (objectMemory isImmediate: oop) ifFalse: [objectMemory markAndTrace: oop]]!
- (objectMemory isImmediate: oop) ifFalse: [objectMemory markAndTrace: oop]].
-
- "Old callback support - trace suspended callback list"
- 1 to: jmpDepth do:
- [:i|
- oop := suspendedCallbacks at: i.
- (objectMemory isImmediate: oop) ifFalse:[objectMemory markAndTrace: oop].
- oop := suspendedMethods at: i.
- (objectMemory isImmediate: oop) ifFalse:[objectMemory markAndTrace: oop]]!
Item was changed:
----- Method: StackInterpreter>>metadataFlagsFor:using: (in category 'primitive support') -----
metadataFlagsFor: selector using: aCCodeGenerator
"Compute a primitive's metadata. This is the accessorDepth which is derived from parse tree analysis,
and some optional flags. Try and locate the flags parameter in an export:flags: pragma in the primitive method."
<doNotGenerate>
+ ^(((aCCodeGenerator accessorDepthForSelector: selector) ifNil: [0]) bitShift: SpurPrimitiveAccessorDepthShift)
- ^(((aCCodeGenerator accessorDepthForSelector: selector) ifNil: [0]) bitShift: 8)
+ (self class metadataFlagsForPrimitive: ((aCCodeGenerator methodNamed: selector) ifNotNil: [:m| m definingClass >> m smalltalkSelector]))!
Item was removed:
- ----- Method: StackInterpreter>>primitiveAccessorDepthForExternalPrimitiveMethod: (in category 'primitive support') -----
- primitiveAccessorDepthForExternalPrimitiveMethod: methodObj
- ^(objectMemory integerValueOf:
- (objectMemory
- fetchPointer: ExternalCallLiteralFlagsIndex
- ofObject: (self literal: 0 ofMethod: methodObj))) >>> SpurPrimitiveAccessorDepthShift!
Item was removed:
- ----- Method: StackInterpreter>>remapCallbackState (in category 'object memory support') -----
- remapCallbackState
- "Callback support - trace suspended callback list"
- 1 to: jmpDepth do:
- [:i| | oop |
- oop := suspendedCallbacks at: i.
- (objectMemory shouldRemapOop: oop) ifTrue:
- [suspendedCallbacks at: i put: (objectMemory remapObj: oop)].
- oop := suspendedMethods at: i.
- (objectMemory shouldRemapObj: oop) ifTrue:
- [suspendedMethods at: i put: (objectMemory remapObj: oop)]]!
Item was changed:
----- Method: StackInterpreter>>retryPrimitiveOnFailure (in category 'primitive support') -----
retryPrimitiveOnFailure
"In Spur two cases of primitive failure are handled specially. A primitive may fail due to validation
encountering a forwarder. On failure, check the accessorDepth for the primitive and if non-negative
scan the args to the depth, following any forwarders. Retry the primitive if any are found. Hence
lazily and transparently following forwarders on primitive failure. Additionally a primitive might fail
due to an allocation failing. Retry if external primitives have failed with PrimErrNoMemory after running
first the scavenger and then on a subsequent failure, the global mark-sweep collector. Hence lazily
and transparently GC on memory exhaustion."
<option: #SpurObjectMemory>
<inline: false>
+ | primitiveIndex gcDone followDone canRetry retry retried |
+ primitiveIndex := self primitiveIndexOf: newMethod.
+ self assert: (self saneFunctionPointerForFailureOfPrimIndex: primitiveIndex).
- | gcDone followDone canRetry retry retried |
gcDone := 0.
followDone := canRetry := retried := false.
[retry := false.
primFailCode = PrimErrNoMemory
ifTrue:
[(gcDone := gcDone + 1) = 1 ifTrue:
+ [canRetry := primitiveIndex = PrimNumberExternalCall].
- [canRetry := self isExternalPrimitiveCall: newMethod].
canRetry ifTrue:
[gcDone = 1 ifTrue:
[objectMemory scavengingGC].
gcDone = 2 ifTrue:
[objectMemory fullGC].
retry := gcDone <= 2]]
ifFalse:
[followDone ifFalse:
[followDone := true.
retry := self checkForAndFollowForwardedPrimitiveState]].
retry] whileTrue:
[self assert: primFailCode ~= 0.
retried := true.
self initPrimCall.
self cCode: [] inSmalltalk:
[self maybeMapPrimitiveFunctionPointerBackToSomethingEvaluable].
self dispatchFunctionPointer: primitiveFunctionPointer].
^retried!
Item was changed:
----- Method: StackInterpreter>>saneFunctionPointerForFailureOfPrimIndex: (in category 'primitive support') -----
saneFunctionPointerForFailureOfPrimIndex: primIndex
"This is an assert function used to ensure consistency between the primitiveFunctionPointer
and the primitive index when a primitive fails in Spur. Since Spur automagically retries
+ failing primitives we want to know that the primitiveFunctionPointer is actually valid. This isn't
+ always possible for the `indirect'' primitives (calling a plugin primitive, calling the ffi, using the
- primitives that fail and are found to have a forwarder within the primitive's accessor depth
- we want to know that the primitiveFuncitonPointer is actually valid. This isn't always
- possible for the `indirect'' primitives (calling a plugin primitive, calling the ffi, using the
receiver:tryPrimitive:withArgs: primitive evaluator in the simulator. We do the best we can."
| basePrimitive |
<var: 'basePrimitive' declareC: 'void (*basePrimitive)(void)'>
basePrimitive := self functionPointerFor: primIndex inClass: objectMemory nilObject.
^primitiveFunctionPointer = basePrimitive
or: [((self isCalloutPrimitiveIndex: primIndex) and: [self isPrimitiveFunctionPointerAnIndex not])
or: [(self isMetaPrimitiveIndex: primIndex) and: [metaAccessorDepth > -2]]]!
Item was changed:
----- Method: StackInterpreter>>setSignalLowSpaceFlagAndSaveProcess (in category 'process primitive support') -----
setSignalLowSpaceFlagAndSaveProcess
"The low space semaphore is about to be signaled. Set the signalLowSpace flag,
and force an interrupt check. Save the currently active process in the special
objects array so that the low space handler will be able to determine the process
that first triggered a low space condition. The image's low space handler is expected
to nil out the special objects array slot when it handles the low space condition."
| lastSavedProcess activeProc |
<inline: false>
- DumpStackOnLowSpace ~= 0 ifTrue:
- [self printCallStack.
- self printAllStacks].
objectMemory signalLowSpace: true.
objectMemory lowSpaceThreshold: 0. "disable additional interrupts until lowSpaceThreshold is reset by image"
lastSavedProcess := objectMemory splObj: ProcessSignalingLowSpace.
lastSavedProcess = objectMemory nilObject ifTrue:
[activeProc := self activeProcess.
objectMemory splObj: ProcessSignalingLowSpace put: activeProc].
self forceInterruptCheck!
Item was changed:
----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
<doNotGenerate>
| plugin realPluginClass plugins |
self transcript cr; show: 'Looking for module ', pluginString.
pluginString isEmpty
ifTrue:
[plugin := self]
ifFalse:
[plugins := InterpreterPlugin allSubclasses select:
[:psc|
psc moduleName asString = pluginString asString
and: [psc shouldBeTranslated]].
plugins isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
plugins size > 1 ifTrue: [^self error: 'This won''t work...'].
"plugins size > 1 ifTrue:
[self transcript show: '...multiple plugin classes; choosing ', plugins last name]."
realPluginClass := plugins anyOne. "hopefully lowest in the hierarchy..."
plugin := realPluginClass simulatorForInterpreterInterface: objectMemory.
plugin ifNil: [self transcript show: ' ... no simulator class; cannot simulate'. ^nil].
(plugin respondsTo: #initialiseModule) ifTrue:
[plugin initialiseModule ifFalse:
[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
self transcript show: ' ... loaded'.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[| realPlugin cg |
self transcript show: '...computing accessor depths'.
plugin class isPluginClass
ifTrue:
[realPlugin := (plugin isSmartSyntaxPluginSimulator
ifTrue: [realPluginClass]
ifFalse: [plugin class])
withAllSuperclasses detect: [:class| class shouldBeTranslated].
cg := realPlugin buildCodeGenerator]
ifFalse:
+ [cg := self computeAccessorDepthsForInterpreterPrimitives].
- [cg := self computeAccessorDepthsForInterpreterPrmitives].
cg exportedPrimitiveNames do:
[:primName| | fnSymbol |
fnSymbol := primName asSymbol.
pluginEntries addLast: {plugin.
fnSymbol.
[plugin perform: fnSymbol. self].
self metadataFlagsFor: fnSymbol using: cg}].
self transcript show: '...done'].
^pluginString asString -> plugin!
Item was changed:
----- Method: StackInterpreter>>unfollowFirstLiteralOfMaybeCalloutMethod:primitiveIndex: (in category 'primitive support') -----
unfollowFirstLiteralOfMaybeCalloutMethod: methodObj primitiveIndex: primIndex
"Follow the first literal of either a primitiveCallout or primitiveExternalCall primitive method. This
will be an ExternalFunction for primitiveCallout or a four element Array for primitiveExternalCall.
This is here to avoid following all the literals in a method, which would be slow. Remember
forwarders are unlikely, so we only want to follow what is necessary, and for an FFI call or
external primitive only the first literal is salient."
<option: #SpurObjectMemory>
| found firstLiteral |
found := false.
"inlined self literal: 0 ofMethod: methodObj for clarity..."
firstLiteral := objectMemory fetchPointer: LiteralStart ofObject: methodObj.
(objectMemory isOopForwarded: firstLiteral) ifTrue:
[found := true.
firstLiteral := objectMemory fixFollowedField: LiteralStart ofObject: methodObj withInitialValue: firstLiteral].
(objectMemory
followForwardedObjectFields: firstLiteral
toDepth: (primIndex = PrimNumberFFICall
+ ifTrue: [(self accessorDepthForPrimitiveIndex: PrimNumberFFICall) - 1]
- ifTrue: [(primitiveAccessorDepthTable at: primIndex) - 1]
ifFalse: [0])) ifTrue:
[found := true].
^found!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
primitiveClone
"Return a shallow copy of the receiver.
Special-case non-single contexts (because of context-to-stack mapping).
Can't fail for contexts cuz of image context instantiation code (sigh)."
+ <primitiveMetadata: #PrimCallMayEndureCodeCompaction> "because of cloneContext: below"
| rcvr newCopy |
rcvr := self stackTop.
(objectMemory isImmediate: rcvr)
ifTrue:
[newCopy := rcvr]
ifFalse:
[(objectMemory isContextNonImm: rcvr)
ifTrue:
[newCopy := self cloneContext: rcvr]
ifFalse:
[(argumentCount = 0
or: [(objectMemory isForwarded: rcvr) not])
ifTrue: [newCopy := objectMemory cloneObject: rcvr]
ifFalse: [newCopy := 0]].
newCopy = 0 ifTrue:
[^self primitiveFailFor: PrimErrNoMemory]].
+ self methodReturnValue: newCopy!
- self pop: argumentCount + 1 thenPush: newCopy!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
primitiveDoNamedPrimitiveWithArgs
"Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything.
e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
| argumentArray arraySize methodArg methodHeader
moduleName functionName moduleLength functionLength
spec addr primRcvr isArray |
+ <primitiveMetadata: #PrimCallNeedsNewMethod>
<var: #addr declareC: 'void (*addr)()'>
objectMemory hasSpurMemoryManagerAPI ifTrue: "See checkForAndFollowForwardedPrimitiveState"
[metaAccessorDepth := -2].
argumentArray := self stackTop.
methodArg := self stackValue: 2.
((objectMemory isArray: argumentArray)
and: [objectMemory isOopCompiledMethod: methodArg]) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
arraySize := objectMemory numSlotsOf: argumentArray.
(self roomToPushNArgs: arraySize) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
methodHeader := objectMemory methodHeaderOf: methodArg.
(objectMemory literalCountOfMethodHeader: methodHeader) > 2 ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
isArray := self isInstanceOfClassArray: spec.
(isArray
and: [(objectMemory numSlotsOf: spec) = 4
and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = PrimNumberExternalCall]]) ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: spec.
moduleName = objectMemory nilObject
ifTrue: [moduleLength := 0]
ifFalse: [self success: (objectMemory isBytes: moduleName).
moduleLength := objectMemory numBytesOfBytes: moduleName].
functionName := objectMemory fetchPointer: 1 ofObject: spec.
self success: (objectMemory isBytes: functionName).
functionLength := objectMemory numBytesOfBytes: functionName.
self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
"Spur needs to know the primitive's accessorDepth."
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
OfLength: functionLength
FromModule: moduleName + objectMemory baseHeaderSize
OfLength: moduleLength
MetadataInto: (self addressOf: metaAccessorDepth
put: [:val| metaAccessorDepth := val]).
"N.B. the accessor depth is the second byte of the primitive's metadata;
the first byte is various flags (currently l.s.b. = use fast C linkage)."
metaAccessorDepth := addr = 0 ifTrue: [-2] ifFalse: [metaAccessorDepth bitShift: -8]]
ifFalse:
[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
OfLength: functionLength
FromModule: moduleName + objectMemory baseHeaderSize
OfLength: moduleLength].
addr = 0 ifTrue:
[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
"Cannot fail this primitive from now on. Can only fail the external primitive."
tempOop := objectMemory
eeInstantiateClassIndex: ClassArrayCompactIndex
format: objectMemory arrayFormat
numSlots: 4.
objectMemory
storePointerUnchecked: 0 ofObject: tempOop withValue: (argumentArray := self popStack);
storePointerUnchecked: 1 ofObject: tempOop withValue: (primRcvr := self popStack);
storePointerUnchecked: 2 ofObject: tempOop withValue: self popStack; "the method"
storePointerUnchecked: 3 ofObject: tempOop withValue: self popStack. "the context receiver"
self push: primRcvr. "replace context receiver with actual receiver"
argumentCount := arraySize.
1 to: arraySize do:
[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
self callExternalPrimitive: addr.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize + 1.
self push: (objectMemory fetchPointer: 3 ofObject: tempOop).
self push: (objectMemory fetchPointer: 2 ofObject: tempOop).
self push: (objectMemory fetchPointer: 1 ofObject: tempOop).
self push: (objectMemory fetchPointer: 0 ofObject: tempOop).
argumentCount := 3.
"Must reset primitiveFunctionPointer for checkForAndFollowForwardedPrimitiveState"
objectMemory hasSpurMemoryManagerAPI ifTrue:
[primitiveFunctionPointer := #primitiveDoNamedPrimitiveWithArgs].
"Hack. A nil prim error code (primErrorCode = 1) is interpreted by the image
as meaning this primitive is not implemented. So to pass back nil as an error
code we use -1 to indicate generic failure."
primFailCode = 1 ifTrue:
[primFailCode := -1]]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
primitiveDoPrimitiveWithArgs
"Implement either ProtoObject>>tryPrimitive: primIndex withArgs: argArray
or Context>>receiver: anObject tryPrimitive: primIndex withArgs: argArray.
If this primitive fails, arrange that its error code is a negative integer, to
distinguish between this failing and the primitive it invokes failing."
+ <primitiveMetadata: #PrimCallNeedsNewMethod>
| argumentArray arraySize index primIdx savedNumArgs rcvr |
objectMemory hasSpurMemoryManagerAPI ifTrue: "See checkForAndFollowForwardedPrimitiveState"
[metaAccessorDepth := -2].
(argumentCount between: 2 and: 3) ifFalse:
[^self primitiveFailFor: PrimErrUnsupported negated].
argumentArray := self stackTop.
primIdx := self stackValue: 1.
((objectMemory isArray: argumentArray)
and: [objectMemory isIntegerObject: primIdx]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument negated].
arraySize := objectMemory numSlotsOf: argumentArray.
(self roomToPushNArgs: arraySize) ifFalse:
[^self primitiveFailFor: PrimErrLimitExceeded negated].
primIdx := objectMemory integerValueOf: primIdx.
primitiveFunctionPointer := self functionPointerFor: primIdx inClass: nil.
primitiveFunctionPointer = 0 ifTrue:
[primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs.
^self primitiveFailFor: PrimErrBadIndex negated].
"Pop primIndex and argArray, then push args in place..."
(savedNumArgs := argumentCount) = 3
ifTrue: "...and receiver if the three arg form"
[tempOop2 := self stackValue: 4. "actual receiver"
rcvr := self stackValue: 3. "receiver for primitive"
(objectMemory isOopForwarded: rcvr) ifTrue:
[rcvr := objectMemory followForwarded: rcvr].
self pop: 4; push: rcvr] "use first arg as receiver"
ifFalse:
[self pop: 2].
argumentCount := arraySize.
index := 1.
[index <= arraySize] whileTrue:
[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
self isPrimitiveFunctionPointerAnIndex ifTrue:
[self externalQuickPrimitiveResponse.
tempOop2 := 0.
^nil].
"We use tempOop instead of pushRemappableOop:/popRemappableOop here because in
the Cogit primitiveEnterCriticalSection, primitiveSignal, primitiveResume et al longjmp back
to either the interpreter or machine code, depending on the process activated. So if we're
executing one of these primitives, control won't actually return here and the matching
popRemappableOop: wouldn't occur, potentially overflowing the remap buffer.
Note that while recursion could occur (nil tryPrimitive: 118 withArgs: #(118 #(110 #())))
it counts as shooting oneself in the foot."
tempOop := argumentArray. "prim might alloc/gc"
"Run the primitive (sets primFailCode)"
objectMemory hasSpurMemoryManagerAPI ifTrue: "See checkForAndFollowForwardedPrimitiveState"
+ [metaAccessorDepth := self accessorDepthForPrimitiveIndex: primIdx].
- [metaAccessorDepth := primitiveAccessorDepthTable at: primIdx].
self slowPrimitiveResponse.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[tempOop = 0 ifTrue: "the primitive failed in a recursive invocation. can't fix things with no value..."
[^self].
self pop: arraySize.
savedNumArgs = 3 ifTrue:
[rcvr := self stackTop.
self stackTopPut: tempOop2.
self push: rcvr].
self pushInteger: primIdx.
self push: tempOop.
primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs.
argumentCount := savedNumArgs].
tempOop := tempOop2 := 0!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
primitiveExternalCall
"Call an external primitive. External primitive methods first literals are an array of
* The module name (String | Symbol)
* The function name (String | Symbol)
* The session ID (SmallInteger) [OBSOLETE], or in Spur, the metadata (accessorDepth and flags; Integer))
* The function index (Integer) in the externalPrimitiveTable
For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
in the method cache is rewritten, either to the function itself, or to zero if the external
function is not found. This allows for fast responses as long as the method stays in
the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
addNewMethodToCache:.
Now that the VM flushes function addresses from its tables, the session ID is obsolete,
but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
method has been looked up and not been found, the function address is stored as -1
(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
lookup), and the primitive fails with PrimErrNotFound."
<accessorDepth: 0> "because the primitive accesses newMethod's first literal, which is checked for explicitly in checkForAndFollowForwardedPrimitiveState"
+ <primitiveMetadata: #( PrimCallMayEndureCodeCompaction "since call may invoke a callback"
+ PrimCallNeedsNewMethod "since external primitive linkage is in first literal...")>
| lit addr index |
<var: #addr declareC: 'void (*addr)()'>
"Check for it being a method for primitiveDoPrimitiveWithArgs.
Fetch the first literal of the method; check its an Array of length 4.
Look at the function index in case it has been loaded before"
((objectMemory isOopCompiledMethod: newMethod)
and: [(objectMemory literalCountOf: newMethod) > 0
and: [lit := self literal: 0 ofMethod: newMethod.
(objectMemory isArray: lit)
and: [(objectMemory numSlotsOf: lit) = 4
and: [index := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit.
objectMemory isIntegerObject: index]]]]) ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
index := objectMemory integerValueOf: index.
"Check if we have already looked up the function and failed."
index < 0 ifTrue:
["Function address was not found in this session,
Void the primitive function."
self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
^self primitiveFailFor: PrimErrNotFound].
"Try to call the function directly"
(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
[addr := externalPrimitiveTable at: index - 1.
addr ~= 0 ifTrue:
[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
self callExternalPrimitive: addr. "On Spur, sets primitiveFunctionPointer"
self maybeRetryPrimitiveOnFailure.
^nil].
"if we get here, then an index to the external prim was
kept on the ST side although the underlying prim
table was already flushed"
^self primitiveFailFor: PrimErrNamedInternal].
"Clean up session id/metadata and external primitive index"
objectMemory storePointerUnchecked: ExternalCallLiteralFlagsIndex ofObject: lit withValue: ConstZero.
objectMemory storePointerUnchecked: ExternalCallLiteralTargetFunctionIndex ofObject: lit withValue: ConstZero.
"The function has not been loaded yet. Attempt to link it, cache it, and call it."
addr := self linkExternalCall: lit errInto: (self addressOf: primFailCode put: [:v| primFailCode := v]).
addr = 0 ifTrue:
[self assert: (objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit) = ConstZero.
^self primitiveFailFor: (primFailCode = 0 ifTrue: [PrimErrNotFound] ifFalse: [primFailCode])].
self callExternalPrimitive: addr.
self maybeRetryPrimitiveOnFailure !
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveInstVarAt (in category 'object access primitives') -----
primitiveInstVarAt
+ <primitiveMetadata: #PrimCallMayEndureCodeCompaction> "because of externalInstVar:ofContext: below"
| index rcvr hdr fmt totalLength fixedFields value |
index := self stackTop.
rcvr := self stackValue: 1.
((objectMemory isNonIntegerObject: index)
or: [argumentCount > 1 "e.g. object:instVarAt:"
and: [objectMemory isOopForwarded: rcvr]]) ifTrue:
[^self primitiveFailFor: PrimErrBadArgument].
(objectMemory isImmediate: rcvr) ifTrue: [^self primitiveFailFor: PrimErrInappropriate].
index := objectMemory integerValueOf: index.
hdr := objectMemory baseHeader: rcvr.
fmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
(index >= 1 and: [index <= fixedFields]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
(fmt = objectMemory indexablePointersFormat
and: [objectMemory isContextHeader: hdr])
ifTrue: [value := self externalInstVar: index - 1 ofContext: rcvr]
ifFalse: [value := self subscript: rcvr with: index format: fmt].
self pop: argumentCount + 1 thenPush: value!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') -----
primitivePerform
+ <primitiveMetadata: #PrimCallNeedsNewMethod>
<returnTypeC: #void>
| newReceiver lookupClassTag performMethod |
performMethod := newMethod.
messageSelector := self stackValue: argumentCount - 1.
newReceiver := self stackValue: argumentCount.
"NOTE: the following lookup may fail and be converted to #doesNotUnderstand:,
so we must adjust argumentCount and slide args now, so that will work."
"Slide arguments down over selector"
argumentCount := argumentCount - 1.
argumentCount to: 1 by: -1 do:
[:i|
stackPages
longAt: stackPointer + (i * objectMemory wordSize)
put: (stackPages longAt: stackPointer + ((i - 1) * objectMemory wordSize))].
self pop: 1.
lookupClassTag := objectMemory fetchClassTagOf: newReceiver.
self sendBreakpoint: messageSelector receiver: newReceiver.
self printSends ifTrue:
[self printActivationNameForSelector: messageSelector
startClass: (objectMemory classForClassTag: lookupClassTag); cr].
self findNewMethodInClassTag: lookupClassTag.
"Only test CompiledMethods for argument count - other objects will have to take their chances"
((objectMemory isOopCompiledMethod: newMethod)
and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
["Slide the args back up (sigh) and re-insert the selector."
self unPop: 1.
1 to: argumentCount by: 1 do:
[:i |
stackPages longAt: stackPointer + ((i - 1) * objectMemory wordSize)
put: (stackPages longAt: stackPointer + (i * objectMemory wordSize))].
stackPages longAt: stackPointer + (argumentCount * objectMemory wordSize) put: messageSelector.
argumentCount := argumentCount + 1.
newMethod := performMethod.
"Must reset primitiveFunctionPointer for checkForAndFollowForwardedPrimitiveState"
objectMemory hasSpurMemoryManagerAPI ifTrue:
[primitiveFunctionPointer := #primitivePerform].
^self primitiveFailFor: PrimErrBadNumArgs].
self executeNewMethod.
"Recursive xeq affects primErrorCode"
self initPrimCall!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
primitiveSlotAt
"Answer a slot in an object. This numbers all slots from 1, ignoring the distinction between
named and indexed inst vars. In objects with both named and indexed inst vars, the named
inst vars precede the indexed ones. In non-object indexed objects (objects that contain
bits, not object references) this primitive answers the raw integral value at each slot.
e.g. for Strings it answers the character code, not the Character object at each slot."
+ <primitiveMetadata: #PrimCallMayEndureCodeCompaction> "because of externalInstVar:ofContext: below"
| index rcvr fmt numSlots |
index := self stackTop.
rcvr := self stackValue: 1.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
(objectMemory isImmediate: rcvr) ifTrue:
[^self primitiveFailFor: PrimErrBadReceiver].
fmt := objectMemory formatOf: rcvr.
index := (objectMemory integerValueOf: index) - 1.
fmt <= objectMemory lastPointerFormat ifTrue:
[numSlots := objectMemory numSlotsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[| value numLiveSlots |
(objectMemory isContextNonImm: rcvr)
ifTrue:
[self externalWriteBackHeadFramePointers.
numLiveSlots := (self stackPointerForMaybeMarriedContext: rcvr) + CtxtTempFrameStart.
value := (self asUnsigned: index) < numLiveSlots
ifTrue: [self externalInstVar: index ofContext: rcvr]
ifFalse: [objectMemory nilObject]]
ifFalse:
[value := objectMemory fetchPointer: index ofObject: rcvr].
self pop: argumentCount + 1 thenPush: value.
^0].
^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstByteFormat ifTrue:
[fmt >= objectMemory firstCompiledMethodFormat ifTrue:
[^self primitiveFailFor: PrimErrUnsupported].
numSlots := objectMemory numBytesOfBytes: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr).
^0].
^self primitiveFailFor: PrimErrBadIndex].
(objectMemory hasSpurMemoryManagerAPI
and: [fmt >= objectMemory firstShortFormat]) ifTrue:
[numSlots := objectMemory num16BitUnitsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchUnsignedShort16: index ofObject: rcvr).
^0].
^self primitiveFailFor: PrimErrBadIndex].
fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
[numSlots := objectMemory num64BitUnitsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1
thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)).
^0].
^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstLongFormat ifTrue:
[numSlots := objectMemory num32BitUnitsOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue:
[self pop: argumentCount + 1
thenPush: (self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)).
^0].
^self primitiveFailFor: PrimErrBadIndex].
^self primitiveFailFor: PrimErrBadReceiver!
Item was changed:
----- Method: StackInterpreterSimulator>>initializePluginEntries (in category 'plugin support') -----
initializePluginEntries
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
+ [primitiveMetadataTable := Array new: primitiveTable size withAll: (-1 bitShift: SpurPrimitiveAccessorDepthShift).
- [primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }]!
Item was changed:
----- Method: TMethod>>extractExportDirective (in category 'transformations') -----
extractExportDirective
"Scan the top-level statements for an inlining directive of the form:
self export: <boolean>
and remove the directive from the method body. Answer the
argument of the directive or false if there is no export directive."
^self
+ extractDirective: #export:
- extractDirective: ((properties includesKey: #export:flags:) ifTrue: [#export:flags:] ifFalse: [#export:])
valueBlock: [:sendNode| sendNode args first value ~= false]
default: false!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveCDataModel (in category 'primitives') -----
primitiveCDataModel
"Two forms of C Data Model infomation.
With 0 arguments answer the string naming the C data model, LP32, LP64, LLP64, etc.
WIth 1 argument, which must be a ByteArray of at least 9 elements, answer the sizes of
char, short, int, long, long long, wchar_t, float, double, void *."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| errorCode model |
interpreterProxy methodArgumentCount = 1 ifTrue:
[| sizes |
sizes := interpreterProxy stackValue: 0.
((interpreterProxy isBytes: sizes)
and: [(interpreterProxy slotSizeOf: sizes) = 9]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self cCoerceSimple: (interpreterProxy firstIndexableField: sizes) to: #'char *')
at: 0 put: (self sizeof: #char);
at: 1 put: (self sizeof: #short);
at: 2 put: (self sizeof: #int);
at: 3 put: (self sizeof: #long);
at: 4 put: (self sizeof: #'long long');
at: 5 put: (self sizeof: #wchar_t);
at: 6 put: (self sizeof: #float);
at: 7 put: (self sizeof: #double);
at: 8 put: (self sizeof: #'void *').
^interpreterProxy methodReturnValue: sizes].
interpreterProxy methodArgumentCount = 0 ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
"Attempt to identify the programming model:
LP32 ILP32 LLP64 LP64 ILP64 SILP64(unidentified)
char 8 8 8 8 8 8
short 16 16 16 16 16 64
int 16 32 32 32 64 64
long 32 32 32 64 64 64
long long 64 64 64 64 64 64
pointer 32 32 64 64 64 64"
errorCode := 0. "Set bit 0 if char is wrong, bit 1 if short is wrong, 2 for int, 3 for long, 4 for long long, 5 for void *"
(self sizeof: #char) ~= 1 ifTrue:
[errorCode := errorCode + 1].
(self sizeof: #short) ~= 2 ifTrue: "N.B. SILP64 exists on Cray supercomputers; we don't care..."
[errorCode := errorCode + 2].
(self sizeof: #'long long') ~= 8 ifTrue:
[errorCode := errorCode + 16].
(self sizeof: #'void *') = 8 ifTrue: "LP64 LLP64 ILP64"
[(self sizeof: #int) = 8 ifTrue: "ILP64"
[(self sizeof: #long) = 8
ifTrue: [model := 'ILP64']
ifFalse: [errorCode := errorCode + 8]].
(self sizeof: #int) = 4 ifTrue: "LP64 or LLP64"
[(self sizeof: #long) = 8 ifTrue: "LP64"
[model := 'LP64'].
(self sizeof: #long) = 4 ifTrue: "LLP64"
[model := 'LLP64'].
((self sizeof: #long) ~= 8 and: [(self sizeof: #long) ~= 4]) ifTrue:
[errorCode := errorCode + 8]].
((self sizeof: #int) ~= 8 and: [(self sizeof: #int) ~= 4]) ifTrue:
[errorCode := errorCode + 4]].
(self sizeof: #'void *') = 4 ifTrue: "LP32 ILP32"
[(self sizeof: #long) ~= 4 ifTrue:
[errorCode := errorCode + 8].
(self sizeof: #int) = 4 ifTrue: "ILP32"
[model := 'ILP32'].
(self sizeof: #int) = 2 ifTrue: "LP32"
[model := 'LP32'].
((self sizeof: #int) ~= 4 and: [(self sizeof: #int) ~= 2]) ifTrue:
[errorCode := errorCode + 4]].
((self sizeof: #'void *') ~= 8 and: [(self sizeof: #'void *') ~= 4]) ifTrue:
[errorCode := errorCode + 32].
errorCode ~= 0 ifTrue:
[^interpreterProxy primitiveFailForOSError: errorCode].
model ifNil:
[^interpreterProxy primitiveFailFor: PrimErrNotFound].
+
interpreterProxy methodReturnString: model
"Screed for testing
| proxy plugin |
proxy := InterpreterProxy new.
plugin := ThreadedFFIPluginPartialSimulator new.
plugin sizes: (Dictionary newFromPairs: #(char 1 short 2 int 4 long 4 #'long long' 8 #'void *' 8 #'void *' 4 float 4 double 8 wchar_t 4)).
plugin sizes: (Dictionary newFromPairs: #(char 1 short 2 int 2 long 4 #'long long' 8 #'void *' 4 float 4 double 8 wchar_t 4)).
plugin instVarNamed: 'interpreterProxy' put: proxy.
proxy synthesizeStackFor: plugin with: (Array with: (ByteArray new: 9)).
plugin primitiveCDataModel.
^proxy stackValue: 0"!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveExternalAddressAsInteger (in category 'primitives') -----
primitiveExternalAddressAsInteger
"Answer the address of a 4 byte or 8 byte ExternalAddress."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| rcvr size |
rcvr := interpreterProxy stackValue: 0.
size := interpreterProxy byteSizeOf: rcvr.
size = 8 ifTrue:
[^interpreterProxy methodReturnValue:
(interpreterProxy positive64BitIntegerFor:
((self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'usqLong *') at: 0))].
size = 4 ifTrue:
[^interpreterProxy methodReturnValue:
(interpreterProxy positive32BitIntegerFor:
((self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'unsigned int *') at: 0))].
interpreterProxy primitiveFailFor: PrimErrBadReceiver!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveExternalAddressFromInteger (in category 'primitives') -----
primitiveExternalAddressFromInteger
"Answer a 4 byte or 8 byte ExternalAddress with value of the argument."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| value |
value := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0).
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy instantiateClass: interpreterProxy classExternalAddress indexableSize: BytesPerWord)
ifNil: [^interpreterProxy primitiveFailFor: PrimErrNoMemory]
ifNotNil:
[:address|
(self cCoerce: (interpreterProxy firstIndexableField: address) to: #'usqIntptr_t *') at: 0 put: value.
^interpreterProxy methodReturnValue: address]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') -----
primitiveFFIDoubleAt
"Answer a 64-bit IEEE double the given byte offset."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| byteOffset rcvr floatValue |
<var: #floatValue type: #double>
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #double))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: #double).
^interpreterProxy methodReturnFloat: floatValue]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') -----
primitiveFFIDoubleAtPut
"Store a 64-bit IEEE double the given byte offset."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| byteOffset rcvr floatValue valueOop |
<var: #floatValue type: #double>
valueOop := interpreterProxy stackValue: 0.
(interpreterProxy isFloatObject: valueOop)
ifTrue: [floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double]
ifFalse:
[(interpreterProxy isIntegerObject: valueOop)
ifTrue: [floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]].
byteOffset := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
rcvr := interpreterProxy stackValue: 2.
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #double))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
+ self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: #double).
- self memcpy: addr _: (self addressOf: floatValue put: [:v| floatValue := Float fromIEEE64Bit: v]) _: (self sizeof: #double).
^interpreterProxy methodReturnValue: valueOop]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAt (in category 'primitives') -----
primitiveFFIFloatAt
"Answer a 32-bit IEEE float the given byte offset."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| byteOffset rcvr floatValue |
<var: #floatValue type: #float>
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #float))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
self memcpy: (self addressOf: floatValue put: [:v| floatValue := Float fromIEEE32Bit: v]) _: addr _: (self sizeof: #float).
^interpreterProxy methodReturnFloat: floatValue]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') -----
primitiveFFIFloatAtPut
"Store a 32-bit IEEE float the given byte offset."
+ <export: true>
+ <primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
- <export: true flags: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
| byteOffset rcvr floatValue valueOop |
<var: #floatValue type: #float>
valueOop := interpreterProxy stackValue: 0.
(interpreterProxy isFloatObject: valueOop)
ifTrue: [floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #float]
ifFalse:
[(interpreterProxy isIntegerObject: valueOop)
ifTrue: [floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #float]
ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]].
byteOffset := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
rcvr := interpreterProxy stackValue: 2.
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #float))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
^interpreterProxy methodReturnValue: valueOop]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIGetLastError (in category 'primitives') -----
primitiveFFIGetLastError
"Primitive. Return the error code from a failed call to the foreign function interface.
This is for backwards-compatibility. Thread-safe access to the error code is via the
primitive error code."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
interpreterProxy methodReturnInteger: ffiLastError!
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."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| isSigned byteSize byteOffset rcvr 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].
(self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize)
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
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:
[byteSize = 4
ifTrue: [value := self cCoerceSimple: (interpreterProxy unalignedLong32At: addr) to: #'unsigned int']
ifFalse: [value := interpreterProxy unalignedLong64At: 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 methodReturnValue: 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."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| isSigned byteSize byteOffset rcvr 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].
(self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize)
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
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:
[byteSize = 4
ifTrue: [interpreterProxy unalignedLong32At: addr put: value]
ifFalse: [interpreterProxy unalignedLong64At: addr put: value]].
^interpreterProxy methodReturnValue: valueOop]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitivePluginVersion (in category 'primitives') -----
primitivePluginVersion
"Answer the plugins current version to ensure compatibility with data structures shared between plugin an image code such as:
- Type codes in FFIConstants
- Known classes in the special-objects array"
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
^ interpreterProxy methodReturnInteger: 1!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt16At (in category 'primitives') -----
primitiveSignedInt16At
"Answer the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy unalignedShortAt: addr) to: #'signed short')]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt16AtPut (in category 'primitives') -----
primitiveSignedInt16AtPut
"Store the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
((interpreterProxy isIntegerObject: valueArg)
and: [((value := interpreterProxy integerValueOf: valueArg) between: -32768 and: 32767)
and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy unalignedShortAt: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt32At (in category 'primitives') -----
primitiveSignedInt32At
"Answer the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnValue:
(interpreterProxy signed32BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong32At: addr) to: #'signed int'))]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt32AtPut (in category 'primitives') -----
primitiveSignedInt32AtPut
"Store the signed 32-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
value := interpreterProxy signed32BitValueOf: valueArg.
(interpreterProxy failed not
and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy unalignedLong32At: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt64At (in category 'primitives') -----
primitiveSignedInt64At
"Answer the signed 64-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #sqLong))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnValue:
(interpreterProxy signed64BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong64At: addr) to: #sqLong))]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt64AtPut (in category 'primitives') -----
primitiveSignedInt64AtPut
"Store the signed 64-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
value := interpreterProxy signed64BitValueOf: valueArg.
(interpreterProxy failed not
and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #sqLong))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy unalignedLong64At: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt8At (in category 'primitives') -----
primitiveSignedInt8At
"Answer the signed 8-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy byteAt: addr) to: #'signed char')]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveSignedInt8AtPut (in category 'primitives') -----
primitiveSignedInt8AtPut
"Store the signed 8-bit integer starting at the given byte offset."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
((interpreterProxy isIntegerObject: valueArg)
and: [((value := interpreterProxy integerValueOf: valueArg) between: -128 and: 127)
and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy byteAt: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveStructureElementAlignment (in category 'primitives') -----
primitiveStructureElementAlignment
"Answer the alignment of an element of an atomic type, or a structure, within a structure on the current platform."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| typeCode alignment |
<var: 'alignment' type: #'void *'>
typeCode := interpreterProxy stackValue: 0.
((interpreterProxy isIntegerObject: typeCode)
and: [((typeCode := interpreterProxy integerValueOf: typeCode) between: FFITypeUnsignedInt8 and: FFITypeDoubleFloat)
or: [typeCode = FFIFlagStructure]]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
alignment := typeCode
caseOf: {
[FFITypeUnsignedInt8] -> [self structOffsetOf: 'structByte *' atomicTypeCode: FFITypeUnsignedInt8].
[FFITypeSignedInt8] -> [self structOffsetOf: 'structByte *' atomicTypeCode: FFITypeSignedInt8].
[FFITypeUnsignedInt16] -> [self structOffsetOf: 'structShort *' atomicTypeCode: FFITypeUnsignedInt16].
[FFITypeSignedInt16] -> [self structOffsetOf: 'structShort *' atomicTypeCode: FFITypeSignedInt16].
[FFITypeUnsignedInt32] -> [self structOffsetOf: 'structInt *' atomicTypeCode: FFITypeUnsignedInt32].
[FFITypeSignedInt32] -> [self structOffsetOf: 'structInt *' atomicTypeCode: FFITypeSignedInt32].
[FFITypeUnsignedInt64] -> [self structOffsetOf: 'structLongLong *' atomicTypeCode: FFITypeUnsignedInt64].
[FFITypeSignedInt64] -> [self structOffsetOf: 'structLongLong *' atomicTypeCode: FFITypeSignedInt64].
[FFITypeSingleFloat] -> [self structOffsetOf: 'structFloat *' atomicTypeCode: FFITypeSingleFloat].
[FFITypeDoubleFloat] -> [self structOffsetOf: 'structDouble *' atomicTypeCode: FFITypeDoubleFloat].
}
otherwise: [self structOffsetOf: 'structStruct *' atomicTypeCode: FFIFlagStructure].
^interpreterProxy methodReturnInteger: alignment asUnsignedIntegerPtr!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt16At (in category 'primitives') -----
primitiveUnsignedInt16At
"Answer the unsigned 16-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy unalignedShortAt: addr) to: #'unsigned short')]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt16AtPut (in category 'primitives') -----
primitiveUnsignedInt16AtPut
"Store the signed 16-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
((interpreterProxy isIntegerObject: valueArg)
and: [((value := interpreterProxy integerValueOf: valueArg) between: 0 and: 65535)
and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #short))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy unalignedShortAt: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt32At (in category 'primitives') -----
primitiveUnsignedInt32At
"Answer the unsigned 32-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnValue:
(interpreterProxy positive32BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong32At: addr) to: #'unsigned int'))]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt32AtPut (in category 'primitives') -----
primitiveUnsignedInt32AtPut
"Store the unsigned 32-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
value := interpreterProxy positive32BitValueOf: valueArg.
(interpreterProxy failed not
and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #int))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy unalignedLong32At: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt64At (in category 'primitives') -----
primitiveUnsignedInt64At
"Answer the unsigned 64-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #usqLong))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnValue:
(interpreterProxy positive64BitIntegerFor: (self cCoerce: (interpreterProxy unalignedLong64At: addr) to: #usqLong))]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt64AtPut (in category 'primitives') -----
primitiveUnsignedInt64AtPut
"Store the unsigned 64-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
value := interpreterProxy positive64BitValueOf: valueArg.
(interpreterProxy failed not
and: [interpreterProxy isIntegerObject: byteOffset]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #sqLong))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy unalignedLong64At: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt8At (in category 'primitives') -----
primitiveUnsignedInt8At
"Answer the unsigned 8-bit integer starting at the given byte offset (native endian)."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| byteOffset rcvr |
byteOffset := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isIntegerObject: byteOffset) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
^interpreterProxy methodReturnInteger: (self cCoerce: (interpreterProxy byteAt: addr) to: #'unsigned char')]!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveUnsignedInt8AtPut (in category 'primitives') -----
primitiveUnsignedInt8AtPut
"Store the unsigned 8-bit integer starting at the given byte offset."
+ <export: true>
+ <primitiveMetadata: #FastCPrimitiveFlag>
- <export: true flags: #FastCPrimitiveFlag>
| valueArg value byteOffset rcvr |
valueArg := interpreterProxy stackValue: 0.
byteOffset := interpreterProxy stackValue: 1.
rcvr := interpreterProxy stackValue: 2.
((interpreterProxy isIntegerObject: valueArg)
and: [((value := interpreterProxy integerValueOf: valueArg) between: 0 and: 255)
and: [interpreterProxy isIntegerObject: byteOffset]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self ffiAddressOf: rcvr startingAt: (interpreterProxy integerValueOf: byteOffset) size: (self sizeof: #char))
ifNil: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]
ifNotNil:
[:addr|
interpreterProxy byteAt: addr put: value.
^interpreterProxy methodReturnValue: valueArg]!
Item was changed:
SharedPool subclass: #VMBytecodeConstants
instanceVariableNames: ''
+ classVariableNames: 'BytecodeSetHasDirectedSuperSend CtxtTempFrameStart LargeContextBit LargeContextSize LargeContextSlots NewsqueakV4BytecodeSet PrimNumberExternalCall PrimNumberFFICall SistaV1BytecodeSet SmallContextSize SmallContextSlots SqueakV3PlusClosuresBytecodeSet'
- classVariableNames: 'BytecodeSetHasDirectedSuperSend CtxtTempFrameStart LargeContextBit LargeContextSize LargeContextSlots NewsqueakV4BytecodeSet PrimNumberDoExternalCall PrimNumberDoPrimitive PrimNumberExternalCall PrimNumberFFICall PrimNumberFloatArrayAt PrimNumberFloatArrayAtPut PrimNumberFlushExternalPrimitives PrimNumberInstVarAt PrimNumberShallowCopy PrimNumberShortArrayAt PrimNumberShortArrayAtPut PrimNumberSlotAt PrimNumberStringReplace PrimNumberUnloadModule SistaV1BytecodeSet SmallContextSize SmallContextSlots SqueakV3PlusClosuresBytecodeSet'
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-Interpreter'!
!VMBytecodeConstants commentStamp: '<historical>' prior: 0!
self ensureClassPool.
#(CtxtTempFrameStart LargeContextBit LargeContextSize SmallContextSize) do:
[:k|
self classPool declare: k from: ObjectMemory classPool]!
1
0
Hey
> On 4. Feb 2022, at 17:32, Christian Kellermann <ckeen(a)pestilenz.org> wrote:
>
> Hey Tobias!
>
> * Tobias Pape <Das.Linux(a)gmx.de> [220204 14:46]:
>> The host is not a string but rather an address. Try this:
>>
>> ```
>> addr := NetNameResolver addressForName: '255.255.255.255' timeout: 10.
>> s := Socket newUDP.
>>
>> s setOption: 'SO_BROADCAST' value: 1.
>> [[(Delay forSeconds: numberOfSeconds) wait.
>> s sendUDPData: shoutout toHost: addr port: (self portNumber) ]
>> repeat] fork.
>> ```
>
> Oh, duh! Yes of course. I stopped at the <prim> call pragma, I should have gone deeper.
> I somehow missed the example in the code.
No worries!
>
> Another error state for invalid parameters might have helped here in general though.
Funnily enough, the primitive does this for all sort of things:
(c code generated from SLANG:
https://github.com/OpenSmalltalk/opensmalltalk-vm/blob/Cog/src/plugins/Sock…
) but not the host.
This might be because things changed over time, and, indeed, there used to be a variant to pass
a host in a different manner.
>
> Thanks for your patience explaining all this.
No, no worries at all.
I actually debugged the VM until i reached here:
https://github.com/OpenSmalltalk/opensmalltalk-vm/blob/Cog/src/plugins/Sock…
and, yes, sz was not 4, and yes, primitiveFail should probably be primitiveFailFor(PrimErrBadArgument)
:D
Best regards
-Tobias
>
> Cheers,
>
> Christian
1
0