Revision: 2721
Author: lewis
Date: 2013-04-13 07:52:46 -0700 (Sat, 13 Apr 2013)
Log Message:
-----------
Sources as per VMMaker-dtl.317
VMMaker 4.12.1
Caution: FloatMathPluginTests now included in VMMaker-Tests will crash
the VM if compiled 64-bit (Mantis 7760)
Merge changes from oscog plugins.
Update to VM_PROXY_MINOR 11 (was 9). Requires some support code
functions not present in SVN trunk, so temporary implementations are
provided in InterpreterPrimitives method category "FIXME" for:
add: ticker HighPriorityTickee: periodms
add: ticker Synchronous: periodms Tickee: roundms
amInVMThread
ioUTCMicroseconds
These methods must be removed when platform sources are updated.
Not included in merge:
FilePlugin>>primitiveDirectoryEntry requires support code
SocketPlugin>>primitiveSocketCreateRaw:... requires support code.
Revert previous cosmetic changes (e.g. space added to
<returnTypeC:'void*'> declaration) in order to eliminate unnecessary
differences versus oscog.
Add missing __buildInfo[] and comment generation for src/vm files.
Modified Paths:
--------------
trunk/src/ckformat.c
trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c
trunk/src/plugins/AioPlugin/AioPlugin.c
trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c
trunk/src/plugins/B2DPlugin/B2DPlugin.c
trunk/src/plugins/B3DAcceleratorPlugin/B3DAcceleratorPlugin.c
trunk/src/plugins/BMPReadWriterPlugin/BMPReadWriterPlugin.c
trunk/src/plugins/BitBltPlugin/BitBltPlugin.c
trunk/src/plugins/CameraPlugin/CameraPlugin.c
trunk/src/plugins/ClipboardExtendedPlugin/ClipboardExtendedPlugin.c
trunk/src/plugins/CroquetPlugin/CroquetPlugin.c
trunk/src/plugins/DBusPlugin/DBusPlugin.c
trunk/src/plugins/DSAPrims/DSAPrims.c
trunk/src/plugins/DropPlugin/DropPlugin.c
trunk/src/plugins/FFTPlugin/FFTPlugin.c
trunk/src/plugins/FT2Plugin/FT2Plugin.c
trunk/src/plugins/FileCopyPlugin/FileCopyPlugin.c
trunk/src/plugins/FilePlugin/FilePlugin.c
trunk/src/plugins/FloatArrayPlugin/FloatArrayPlugin.c
trunk/src/plugins/FloatMathPlugin/FloatMathPlugin.c
trunk/src/plugins/GeniePlugin/GeniePlugin.c
trunk/src/plugins/HostWindowPlugin/HostWindowPlugin.c
trunk/src/plugins/JPEGReadWriter2Plugin/JPEGReadWriter2Plugin.c
trunk/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c
trunk/src/plugins/JoystickTabletPlugin/JoystickTabletPlugin.c
trunk/src/plugins/Klatt/Klatt.c
trunk/src/plugins/LargeIntegers/LargeIntegers.c
trunk/src/plugins/LocalePlugin/LocalePlugin.c
trunk/src/plugins/MIDIPlugin/MIDIPlugin.c
trunk/src/plugins/Matrix2x3Plugin/Matrix2x3Plugin.c
trunk/src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c
trunk/src/plugins/Mpeg3Plugin/Mpeg3Plugin.c
trunk/src/plugins/RePlugin/RePlugin.c
trunk/src/plugins/RomePlugin/RomePlugin.c
trunk/src/plugins/ScratchPlugin/ScratchPlugin.c
trunk/src/plugins/SecurityPlugin/SecurityPlugin.c
trunk/src/plugins/SerialPlugin/SerialPlugin.c
trunk/src/plugins/SocketPlugin/SocketPlugin.c
trunk/src/plugins/SoundCodecPrims/SoundCodecPrims.c
trunk/src/plugins/SoundGenerationPlugin/SoundGenerationPlugin.c
trunk/src/plugins/SoundPlugin/SoundPlugin.c
trunk/src/plugins/Squeak3D/Squeak3D.c
trunk/src/plugins/SqueakFFIPrims/SqueakFFIPrims.c
trunk/src/plugins/SqueakSSL/SqueakSSL.c
trunk/src/plugins/StarSqueakPlugin/StarSqueakPlugin.c
trunk/src/plugins/UUIDPlugin/UUIDPlugin.c
trunk/src/plugins/UnicodePlugin/UnicodePlugin.c
trunk/src/plugins/UnixOSProcessPlugin/UnixOSProcessPlugin.c
trunk/src/plugins/WeDoPlugin/WeDoPlugin.c
trunk/src/plugins/XDisplayControlPlugin/XDisplayControlPlugin.c
trunk/src/plugins/ZipPlugin/ZipPlugin.c
trunk/src/vm/interp.c
trunk/src/vm/interp.h
trunk/src/vm/sqNamedPrims.h
Modified: trunk/src/ckformat.c
===================================================================
--- trunk/src/ckformat.c 2013-04-12 22:16:14 UTC (rev 2720)
+++ trunk/src/ckformat.c 2013-04-13 14:52:46 UTC (rev 2721)
@@ -5,7 +5,7 @@
/* Usage: ckformat imageFileName */
/* --- DO NOT EDIT THIS FILE --- */
-/* --- Automatically generated from class ImageFormat 2013-04-06T10:59:51.052-05:00--- */
+/* --- Automatically generated from class ImageFormat 2013-04-13T10:48:51.504-05:00--- */
/* --- Source code is in package ImageFormat in the VMMaker repository --- */
/* --- DO NOT EDIT THIS FILE --- */
Modified: trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c
===================================================================
--- trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c 2013-04-12 22:16:14 UTC (rev 2720)
+++ trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c 2013-04-13 14:52:46 UTC (rev 2721)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.3 with VMMaker 4.11.5 translated as C source on 6 April 2013 10:59:34 am */
+/* Smalltalk from Squeak4.3 with VMMaker 4.12.1 translated as C source on 13 April 2013 10:48:31 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d
+ VMPluginCodeGenerator VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14
from
- ADPCMCodecPlugin * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d
+ ADPCMCodecPlugin VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14
*/
-static char __buildInfo[] = "ADPCMCodecPlugin * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d " __DATE__ ;
+static char __buildInfo[] = "ADPCMCodecPlugin VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14 " __DATE__ ;
@@ -70,9 +70,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "ADPCMCodecPlugin 6 April 2013 (i)"
+ "ADPCMCodecPlugin 13 April 2013 (i)"
#else
- "ADPCMCodecPlugin 6 April 2013 (e)"
+ "ADPCMCodecPlugin 13 April 2013 (e)"
#endif
;
Modified: trunk/src/plugins/AioPlugin/AioPlugin.c
===================================================================
--- trunk/src/plugins/AioPlugin/AioPlugin.c 2013-04-12 22:16:14 UTC (rev 2720)
+++ trunk/src/plugins/AioPlugin/AioPlugin.c 2013-04-13 14:52:46 UTC (rev 2721)
@@ -1,6 +1,6 @@
-/* Smalltalk from Squeak4.3 with VMMaker 4.11.5 translated as C source on 6 April 2013 10:59:50 am */
+/* Smalltalk from Squeak4.3 with VMMaker 4.12.1 translated as C source on 13 April 2013 10:48:50 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d
+ VMPluginCodeGenerator VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14
from
UnixAioPlugin VMConstruction-Plugins-AioPlugin-dtl.14 uuid: 965d54b7-4309-42fd-adb0-64400d3c780b
*/
@@ -88,9 +88,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "AioPlugin 6 April 2013 (i)"
+ "AioPlugin 13 April 2013 (i)"
#else
- "AioPlugin 6 April 2013 (e)"
+ "AioPlugin 13 April 2013 (e)"
#endif
;
Modified: trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c
===================================================================
--- trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2013-04-12 22:16:14 UTC (rev 2720)
+++ trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2013-04-13 14:52:46 UTC (rev 2721)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.3 with VMMaker 4.11.5 translated as C source on 6 April 2013 10:59:34 am */
+/* Smalltalk from Squeak4.3 with VMMaker 4.12.1 translated as C source on 13 April 2013 10:48:31 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14
from
- AsynchFilePlugin * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d
+ AsynchFilePlugin VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14
*/
-static char __buildInfo[] = "AsynchFilePlugin * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d " __DATE__ ;
+static char __buildInfo[] = "AsynchFilePlugin VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14 " __DATE__ ;
@@ -67,9 +67,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "AsynchFilePlugin 6 April 2013 (i)"
+ "AsynchFilePlugin 13 April 2013 (i)"
#else
- "AsynchFilePlugin 6 April 2013 (e)"
+ "AsynchFilePlugin 13 April 2013 (e)"
#endif
;
static void * sCOAFfn;
Modified: trunk/src/plugins/B2DPlugin/B2DPlugin.c
===================================================================
--- trunk/src/plugins/B2DPlugin/B2DPlugin.c 2013-04-12 22:16:14 UTC (rev 2720)
+++ trunk/src/plugins/B2DPlugin/B2DPlugin.c 2013-04-13 14:52:46 UTC (rev 2721)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.3 with VMMaker 4.11.5 translated as C source on 6 April 2013 10:59:36 am */
+/* Smalltalk from Squeak4.3 with VMMaker 4.12.1 translated as C source on 13 April 2013 10:48:33 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d
+ VMPluginCodeGenerator VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14
from
- BalloonEnginePlugin * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d
+ BalloonEnginePlugin VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14
*/
-static char __buildInfo[] = "BalloonEnginePlugin * VMMaker-dtl.314 uuid: 27bc9a3b-01be-47b3-8e3a-b5f5554a389d " __DATE__ ;
+static char __buildInfo[] = "BalloonEnginePlugin VMMaker-dtl.317 uuid: cc922d07-b988-4034-9bf9-31e7b86e9a14 " __DATE__ ;
@@ -87,6 +87,30 @@
#define GEBaseEdgeSize 10
#define GEBaseFillSize 4
#define GEEdgeFillsInvalid 65536
+#define GEFAlreadyFailed 100
+#define GEFBadPoint 121
+#define GEFBitBltLoadFailed 122
+#define GEFClassMismatch 114
+#define GEFEdgeDataTooSmall 112
+#define GEFEngineIsInteger 101
+#define GEFEngineIsWords 102
+#define GEFEngineStopped 104
+#define GEFEngineTooSmall 103
+#define GEFEntityCheckFailed 120
+#define GEFEntityLoadFailed 119
+#define GEFFillDataTooSmall 113
+#define GEFFormLoadFailed 123
+#define GEFSizeMismatch 115
+#define GEFWorkBufferBadMagic 108
+#define GEFWorkBufferIsInteger 105
+#define GEFWorkBufferIsPointers 106
+#define GEFWorkBufferStartWrong 110
+#define GEFWorkBufferTooSmall 107
+#define GEFWorkBufferWrongSize 109
+#define GEFWorkTooBig 111
+#define GEFWrongEdge 118
+#define GEFWrongFill 117
+#define GEFWrongState 116
#define GEFillIndexLeft 8
#define GEFillIndexRight 9
#define GENumLines 7
@@ -221,6 +245,8 @@
#define GWTimeNextAETEntry 104
#define GWTimeNextFillEntry 98
#define GWTimeNextGETEntry 94
+#define PrimErrBadArgument 3
+#define PrimErrBadNumArgs 5
/*** Function Prototypes ***/
static sqInt accurateLengthOfwith(sqInt deltaX, sqInt deltaY);
@@ -421,9 +447,9 @@
static void * loadBBFn;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "B2DPlugin 6 April 2013 (i)"
+ "B2DPlugin 13 April 2013 (i)"
#else
- "B2DPlugin 6 April 2013 (e)"
+ "B2DPlugin 13 April 2013 (e)"
#endif
;
static int* objBuffer;
@@ -3570,7 +3596,7 @@
edge = workBuffer[GWLastExportedEdge];
if ((interpreterProxy->slotSizeOf(edgeOop)) < ETBalloonEdgeDataSize) {
- return interpreterProxy->primitiveFail();
+ return null;
}
/* begin edgeXValueOf:put: */
value = interpreterProxy->fetchIntegerofObject(ETXValueIndex, edgeOop);
@@ -3912,45 +3938,46 @@
}
-/* Load the entire state from the interpreter for the rendering primitives */
+/* Load the entire state from the interpreter for the rendering primitives.
+ Answer 0 on success or a non-zero failure code on failure. */
static sqInt loadRenderingState(void) {
sqInt edgeOop;
+ sqInt failCode;
sqInt fillOop;
sqInt state;
if (!((interpreterProxy->methodArgumentCount()) == 2)) {
- return interpreterProxy->primitiveFail();
+ return PrimErrBadNumArgs;
}
+ if (((failCode = quickLoadEngineFrom(interpreterProxy->stackValue(2)))) != 0) {
+ return failCode;
+ }
fillOop = interpreterProxy->stackObjectValue(0);
edgeOop = interpreterProxy->stackObjectValue(1);
- engine = interpreterProxy->stackObjectValue(2);
if (interpreterProxy->failed()) {
- return 0;
+ return PrimErrBadArgument;
}
- if (!(quickLoadEngineFrom(engine))) {
- return 0;
+ if (!(((failCode = loadSpanBufferFrom(interpreterProxy->fetchPointerofObject(BESpanIndex, engine)))) == 0)) {
+ return failCode;
}
- if (!(loadSpanBufferFrom(interpreterProxy->fetchPointerofObject(BESpanIndex, engine)))) {
- return 0;
- }
if (!(loadBitBltFrom(interpreterProxy->fetchPointerofObject(BEBitBltIndex, engine)))) {
- return 0;
+ return GEFBitBltLoadFailed;
}
if (!(loadFormsFrom(interpreterProxy->fetchPointerofObject(BEFormsIndex, engine)))) {
- return 0;
+ return GEFFormLoadFailed;
}
if ((interpreterProxy->slotSizeOf(edgeOop)) < ETBalloonEdgeDataSize) {
- return 0;
+ return GEFEdgeDataTooSmall;
}
if ((interpreterProxy->slotSizeOf(fillOop)) < FTBalloonFillDataSize) {
- return 0;
+ return GEFFillDataTooSmall;
}
state = workBuffer[GWState];
if ((state == GEStateWaitingForEdge) || ((state == GEStateWaitingForFill) || (state == GEStateWaitingChange))) {
- return 0;
+ return GEFWrongState;
}
- return 1;
+ return 0;
}
static sqInt loadShapenSegmentsfilllineWidthlineFillpointsShort(int *points, sqInt nSegments, sqInt fillIndex, sqInt lineWidth, sqInt lineFill, sqInt pointsShort) {
@@ -4041,13 +4068,14 @@
}
-/* Load the span buffer from the given oop. */
+/* Load the span buffer from the given oop.
+ Answer 0 on success or a non-zero failure code on failure. */
static sqInt loadSpanBufferFrom(sqInt spanOop) {
sqInt value;
if (!((interpreterProxy->fetchClassOf(spanOop)) == (interpreterProxy->classBitmap()))) {
- return 0;
+ return GEFClassMismatch;
}
/* Leave last entry unused to avoid complications */
@@ -4056,7 +4084,7 @@
/* begin spanSizePut: */
value = (interpreterProxy->slotSizeOf(spanOop)) - 1;
workBuffer[GWSpanSize] = value;
- return 1;
+ return 0;
}
@@ -4211,24 +4239,24 @@
static sqInt loadWorkBufferFrom(sqInt wbOop) {
if ((wbOop & 1)) {
- return 0;
+ return GEFWorkBufferIsInteger;
}
if (!(interpreterProxy->isWords(wbOop))) {
- return 0;
+ return GEFWorkBufferIsPointers;
}
if ((interpreterProxy->slotSizeOf(wbOop)) < GWMinimalSize) {
- return 0;
+ return GEFWorkBufferTooSmall;
}
/* begin workBufferPut: */
workBuffer = interpreterProxy->firstIndexableField(wbOop);
if (!((workBuffer[GWMagicIndex]) == GWMagicNumber)) {
- return 0;
+ return GEFWorkBufferBadMagic;
}
if (!((workBuffer[GWSize]) == (interpreterProxy->slotSizeOf(wbOop)))) {
- return 0;
+ return GEFWorkBufferWrongSize;
}
if (!((workBuffer[GWObjStart]) == GWHeaderSize)) {
- return 0;
+ return GEFWorkBufferStartWrong;
}
objBuffer = workBuffer + (workBuffer[GWObjStart]);
getBuffer = objBuffer + (workBuffer[GWObjUsed]);
@@ -4237,9 +4265,9 @@
aetBuffer = getBuffer + (workBuffer[GWGETUsed]);
if ((((GWHeaderSize + (workBuffer[GWObjUsed])) + (workBuffer[GWGETUsed])) + (workBuffer[GWAETUsed])) > (workBuffer[GWSize])) {
- return 0;
+ return GEFWorkTooBig;
}
- return 1;
+ return 0;
}
@@ -4306,16 +4334,14 @@
}
EXPORT(sqInt) primitiveAbortProcessing(void) {
+ sqInt failureCode;
+
if (!((interpreterProxy->methodArgumentCount()) == 0)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
- engine = interpreterProxy->stackObjectValue(0);
- if (interpreterProxy->failed()) {
- return null;
+ if (!(((failureCode = quickLoadEngineFrom(interpreterProxy->stackValue(0)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
- if (!(quickLoadEngineFrom(engine))) {
- return interpreterProxy->primitiveFail();
- }
workBuffer[GWState] = GEStateCompleted;
/* begin storeEngineStateInto: */
workBuffer[GWObjUsed] = objUsed;
@@ -4327,34 +4353,34 @@
EXPORT(sqInt) primitiveAddActiveEdgeEntry(void) {
sqInt edge;
sqInt edgeOop;
+ sqInt failureCode;
sqInt value;
if (doProfileStats) {
geProfileTime = interpreterProxy->ioMicroMSecs();
}
if (!((interpreterProxy->methodArgumentCount()) == 1)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(1), GEStateWaitingForEdge))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
+ }
edgeOop = interpreterProxy->stackObjectValue(0);
- engine = interpreterProxy->stackObjectValue(1);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(engine, GEStateWaitingForEdge))) {
- return interpreterProxy->primitiveFail();
- }
edge = loadEdgeStateFrom(edgeOop);
- if (interpreterProxy->failed()) {
- return null;
+ if (edge == null) {
+ return interpreterProxy->primitiveFailFor(GEFEdgeDataTooSmall);
}
if (!(needAvailableSpace(1))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWorkTooBig);
}
if ((objBuffer[edge + GENumLines]) > 0) {
insertEdgeIntoAET(edge);
}
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
workBuffer[GWState] = GEStateAddingFromGET;
/* begin storeEngineStateInto: */
@@ -4370,6 +4396,7 @@
EXPORT(sqInt) primitiveAddBezier(void) {
sqInt endOop;
+ sqInt failureCode;
sqInt leftFill;
sqInt nSegments;
sqInt rightFill;
@@ -4380,7 +4407,7 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 5)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
rightFill = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(0));
leftFill = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(1));
@@ -4388,13 +4415,13 @@
endOop = interpreterProxy->stackObjectValue(3);
startOop = interpreterProxy->stackObjectValue(4);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(5), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(5), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
if (!((isFillOkay(leftFill)) && (isFillOkay(rightFill)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWrongFill);
}
if ((leftFill == rightFill) && 0) {
return interpreterProxy->pop(6);
@@ -4403,7 +4430,7 @@
loadPointfrom(((int *) (workBuffer + GWPoint2)), viaOop);
loadPointfrom(((int *) (workBuffer + GWPoint3)), endOop);
if (interpreterProxy->failed()) {
- return 0;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
/* begin transformPoints: */
if (3 > 0) {
@@ -4440,30 +4467,32 @@
/* begin wbStackClear */
workBuffer[GWBufferTop] = (workBuffer[GWSize]);
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(5);
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->pop(5);
}
EXPORT(sqInt) primitiveAddBezierShape(void) {
+ sqInt failureCode;
sqInt fillIndex;
- sqInt isArray;
sqInt length;
sqInt lineFill;
sqInt lineWidth;
sqInt nSegments;
sqInt points;
+ sqInt pointsIsArray;
sqInt segSize;
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 5)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
lineFill = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(0));
lineWidth = interpreterProxy->stackIntegerValue(1);
@@ -4471,31 +4500,31 @@
nSegments = interpreterProxy->stackIntegerValue(3);
points = interpreterProxy->stackObjectValue(4);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(5), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(5), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
length = interpreterProxy->slotSizeOf(points);
if (interpreterProxy->isWords(points)) {
/* Either PointArray or ShortPointArray */
- isArray = 0;
+ pointsIsArray = 0;
if (!((length == (nSegments * 3)) || (length == (nSegments * 6)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
} else {
/* Must be Array of points */
if (!(interpreterProxy->isArray(points))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
if (!(length == (nSegments * 3))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- isArray = 1;
+ pointsIsArray = 1;
}
if ((lineWidth == 0) || (lineFill == 0)) {
segSize = GLBaseSize;
@@ -4503,15 +4532,15 @@
segSize = GLWideSize;
}
if (!(needAvailableSpace(segSize * nSegments))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWorkTooBig);
}
if (!((isFillOkay(lineFill)) && (isFillOkay(fillIndex)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWrongFill);
}
lineFill = transformColor(lineFill);
fillIndex = transformColor(fillIndex);
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
if (((lineFill == 0) || (lineWidth == 0)) && (fillIndex == 0)) {
return interpreterProxy->pop(5);
@@ -4522,25 +4551,27 @@
lineWidth = 1;
}
}
- if (isArray) {
+ if (pointsIsArray) {
loadArrayShapenSegmentsfilllineWidthlineFill(points, nSegments, fillIndex, lineWidth, lineFill);
} else {
loadShapenSegmentsfilllineWidthlineFillpointsShort(interpreterProxy->firstIndexableField(points), nSegments, fillIndex, lineWidth, lineFill, (nSegments * 3) == length);
}
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- workBuffer[GWNeedsFlush] = 1;
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(5);
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ workBuffer[GWNeedsFlush] = 1;
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->pop(5);
}
EXPORT(sqInt) primitiveAddBitmapFill(void) {
sqInt cmOop;
sqInt dirOop;
+ sqInt failureCode;
sqInt fill;
sqInt formOop;
sqInt nrmOop;
@@ -4552,51 +4583,49 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 7)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
xIndex = interpreterProxy->stackIntegerValue(0);
if (xIndex <= 0) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
nrmOop = interpreterProxy->stackObjectValue(1);
dirOop = interpreterProxy->stackObjectValue(2);
originOop = interpreterProxy->stackObjectValue(3);
tileFlag = interpreterProxy->booleanValueOf(interpreterProxy->stackValue(4));
- if (tileFlag) {
- tileFlag = 1;
- } else {
- tileFlag = 0;
- }
cmOop = interpreterProxy->stackObjectValue(5);
formOop = interpreterProxy->stackObjectValue(6);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(7), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(7), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
loadPointfrom(((int *) (workBuffer + GWPoint1)), originOop);
loadPointfrom(((int *) (workBuffer + GWPoint2)), dirOop);
loadPointfrom(((int *) (workBuffer + GWPoint3)), nrmOop);
if (interpreterProxy->failed()) {
- return 0;
+ return interpreterProxy->primitiveFailFor(GEFBadPoint);
}
- fill = loadBitmapFillcolormaptilefromalongnormalxIndex(formOop, cmOop, tileFlag, ((int *) (workBuffer + GWPoint1)), ((int *) (workBuffer + GWPoint2)), ((int *) (workBuffer + GWPoint3)), xIndex - 1);
+ fill = loadBitmapFillcolormaptilefromalongnormalxIndex(formOop, cmOop, (tileFlag
+ ? 1
+ : 0), ((int *) (workBuffer + GWPoint1)), ((int *) (workBuffer + GWPoint2)), ((int *) (workBuffer + GWPoint3)), xIndex - 1);
if (engineStopped) {
/* Make sure the stack is okay */
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(8);
- interpreterProxy->push(interpreterProxy->positive32BitIntegerFor(fill));
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->popthenPush(8, interpreterProxy->positive32BitIntegerFor(fill));
}
EXPORT(sqInt) primitiveAddCompressedShape(void) {
+ sqInt failureCode;
sqInt fillIndexList;
sqInt leftFills;
sqInt lineFills;
@@ -4610,7 +4639,7 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 7)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
fillIndexList = interpreterProxy->stackObjectValue(0);
lineFills = interpreterProxy->stackObjectValue(1);
@@ -4620,16 +4649,16 @@
nSegments = interpreterProxy->stackIntegerValue(5);
points = interpreterProxy->stackObjectValue(6);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(7), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(7), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
if (!(checkCompressedShapesegmentsleftFillsrightFillslineWidthslineFillsfillIndexList(points, nSegments, leftFills, rightFills, lineWidths, lineFills, fillIndexList))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEntityCheckFailed);
}
if (!(needAvailableSpace((((GBBaseSize < GLBaseSize) ? GLBaseSize : GBBaseSize)) * nSegments))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWorkTooBig);
}
/* Then actually load the compressed shape */
@@ -4637,18 +4666,20 @@
pointsShort = (interpreterProxy->slotSizeOf(points)) == (nSegments * 3);
loadCompressedShapesegmentsleftFillsrightFillslineWidthslineFillsfillIndexListpointShort(interpreterProxy->firstIndexableField(points), nSegments, interpreterProxy->firstIndexableField(leftFills), interpreterProxy->firstIndexableField(rightFills), interpreterProxy->firstIndexableField(lineWidths), interpreterProxy->firstIndexableField(lineFills), interpreterProxy->firstIndexableField(fillIndexList), pointsShort);
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- workBuffer[GWNeedsFlush] = 1;
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(7);
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ workBuffer[GWNeedsFlush] = 1;
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->pop(7);
}
EXPORT(sqInt) primitiveAddGradientFill(void) {
sqInt dirOop;
+ sqInt failureCode;
sqInt fill;
sqInt isRadial;
sqInt nrmOop;
@@ -4659,7 +4690,7 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 5)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
isRadial = interpreterProxy->booleanValueOf(interpreterProxy->stackValue(0));
nrmOop = interpreterProxy->stackValue(1);
@@ -4667,34 +4698,35 @@
originOop = interpreterProxy->stackValue(3);
rampOop = interpreterProxy->stackValue(4);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(5), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(5), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
loadPointfrom(((int *) (workBuffer + GWPoint1)), originOop);
loadPointfrom(((int *) (workBuffer + GWPoint2)), dirOop);
loadPointfrom(((int *) (workBuffer + GWPoint3)), nrmOop);
if (interpreterProxy->failed()) {
- return 0;
+ return interpreterProxy->primitiveFailFor(GEFBadPoint);
}
fill = loadGradientFillfromalongnormalisRadial(rampOop, ((int *) (workBuffer + GWPoint1)), ((int *) (workBuffer + GWPoint2)), ((int *) (workBuffer + GWPoint3)), isRadial);
if (engineStopped) {
/* Make sure the stack is okay */
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(6);
- interpreterProxy->push(interpreterProxy->positive32BitIntegerFor(fill));
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->popthenPush(6, interpreterProxy->positive32BitIntegerFor(fill));
}
EXPORT(sqInt) primitiveAddLine(void) {
sqInt endOop;
+ sqInt failureCode;
sqInt leftFill;
sqInt rightFill;
sqInt startOop;
@@ -4703,25 +4735,25 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 4)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
rightFill = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(0));
leftFill = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(1));
endOop = interpreterProxy->stackObjectValue(2);
startOop = interpreterProxy->stackObjectValue(3);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(4), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(4), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
if (!((isFillOkay(leftFill)) && (isFillOkay(rightFill)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWrongFill);
}
loadPointfrom(((int *) (workBuffer + GWPoint1)), startOop);
loadPointfrom(((int *) (workBuffer + GWPoint2)), endOop);
if (interpreterProxy->failed()) {
- return 0;
+ return interpreterProxy->primitiveFailFor(GEFBadPoint);
}
/* begin transformPoints: */
if (2 > 0) {
@@ -4739,23 +4771,25 @@
leftFill = transformColor(leftFill);
rightFill = transformColor(rightFill);
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
loadWideLinefromtolineFillleftFillrightFill(0, ((int *) (workBuffer + GWPoint1)), ((int *) (workBuffer + GWPoint2)), 0, leftFill, rightFill);
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(4);
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->pop(4);
}
EXPORT(sqInt) primitiveAddOval(void) {
sqInt borderIndex;
sqInt borderWidth;
sqInt endOop;
+ sqInt failureCode;
sqInt fillIndex;
sqInt startOop;
@@ -4763,7 +4797,7 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 5)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
borderIndex = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(0));
borderWidth = interpreterProxy->stackIntegerValue(1);
@@ -4771,24 +4805,24 @@
endOop = interpreterProxy->stackObjectValue(3);
startOop = interpreterProxy->stackObjectValue(4);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(5), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(5), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
if (!((isFillOkay(borderIndex)) && (isFillOkay(fillIndex)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWrongFill);
}
fillIndex = transformColor(fillIndex);
borderIndex = transformColor(borderIndex);
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
if ((fillIndex == 0) && ((borderIndex == 0) || (borderWidth <= 0))) {
return interpreterProxy->pop(5);
}
if (!(needAvailableSpace(16 * GBBaseSize))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWorkTooBig);
}
if ((borderWidth > 0) && (borderIndex != 0)) {
borderWidth = transformWidth(borderWidth);
@@ -4798,30 +4832,32 @@
loadPointfrom(((int *) (workBuffer + GWPoint1)), startOop);
loadPointfrom(((int *) (workBuffer + GWPoint2)), endOop);
if (interpreterProxy->failed()) {
- return 0;
+ return interpreterProxy->primitiveFailFor(GEFBadPoint);
}
loadOvallineFillleftFillrightFill(borderWidth, borderIndex, 0, fillIndex);
if (engineStopped) {
/* begin wbStackClear */
workBuffer[GWBufferTop] = (workBuffer[GWSize]);
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- workBuffer[GWNeedsFlush] = 1;
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(5);
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ workBuffer[GWNeedsFlush] = 1;
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->pop(5);
}
EXPORT(sqInt) primitiveAddPolygon(void) {
+ sqInt failureCode;
sqInt fillIndex;
- sqInt isArray;
sqInt length;
sqInt lineFill;
sqInt lineWidth;
sqInt nPoints;
sqInt points;
+ sqInt pointsIsArray;
sqInt segSize;
sqInt i;
sqInt x0;
@@ -4833,7 +4869,7 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 5)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
lineFill = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(0));
lineWidth = interpreterProxy->stackIntegerValue(1);
@@ -4841,31 +4877,31 @@
nPoints = interpreterProxy->stackIntegerValue(3);
points = interpreterProxy->stackObjectValue(4);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(5), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(5), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
length = interpreterProxy->slotSizeOf(points);
if (interpreterProxy->isWords(points)) {
/* Either PointArray or ShortPointArray */
- isArray = 0;
+ pointsIsArray = 0;
if (!((length == nPoints) || ((nPoints * 2) == length))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
} else {
/* Must be Array of points */
if (!(interpreterProxy->isArray(points))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
if (!(length == nPoints)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- isArray = 1;
+ pointsIsArray = 1;
}
if ((lineWidth == 0) || (lineFill == 0)) {
segSize = GLBaseSize;
@@ -4876,20 +4912,20 @@
return interpreterProxy->primitiveFail();
}
if (!((isFillOkay(lineFill)) && (isFillOkay(fillIndex)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWrongFill);
}
lineFill = transformColor(lineFill);
fillIndex = transformColor(fillIndex);
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
if (((lineFill == 0) || (lineWidth == 0)) && (fillIndex == 0)) {
- return interpreterProxy->pop(6);
+ return interpreterProxy->pop(5);
}
if (!(lineWidth == 0)) {
lineWidth = transformWidth(lineWidth);
}
- if (isArray) {
+ if (pointsIsArray) {
/* begin loadArrayPolygon:nPoints:fill:lineWidth:lineFill: */
loadPointfrom(((int *) (workBuffer + GWPoint1)), interpreterProxy->fetchPointerofObject(0, points));
if (interpreterProxy->failed()) {
@@ -4933,20 +4969,22 @@
loadPolygonnPointsfilllineWidthlineFillpointsShort(interpreterProxy->firstIndexableField(points), nPoints, fillIndex, lineWidth, lineFill, nPoints == length);
}
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
- if (!(interpreterProxy->failed())) {
- workBuffer[GWNeedsFlush] = 1;
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(5);
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ workBuffer[GWNeedsFlush] = 1;
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->pop(5);
}
EXPORT(sqInt) primitiveAddRect(void) {
sqInt borderIndex;
sqInt borderWidth;
sqInt endOop;
+ sqInt failureCode;
sqInt fillIndex;
sqInt startOop;
@@ -4954,7 +4992,7 @@
/* Fail if we have the wrong number of arguments */
if (!((interpreterProxy->methodArgumentCount()) == 5)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
borderIndex = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(0));
borderWidth = interpreterProxy->stackIntegerValue(1);
@@ -4962,24 +5000,24 @@
endOop = interpreterProxy->stackObjectValue(3);
startOop = interpreterProxy->stackObjectValue(4);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(interpreterProxy->stackObjectValue(5), GEStateUnlocked))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(5), GEStateUnlocked))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
if (!((isFillOkay(borderIndex)) && (isFillOkay(fillIndex)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWrongFill);
}
borderIndex = transformColor(borderIndex);
fillIndex = transformColor(fillIndex);
if (engineStopped) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFEngineStopped);
}
if ((fillIndex == 0) && ((borderIndex == 0) || (borderWidth == 0))) {
return interpreterProxy->pop(5);
}
if (!(needAvailableSpace(4 * GLBaseSize))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFWorkTooBig);
}
if ((borderWidth > 0) && (borderIndex != 0)) {
borderWidth = transformWidth(borderWidth);
@@ -4989,7 +5027,7 @@
loadPointfrom(((int *) (workBuffer + GWPoint1)), startOop);
loadPointfrom(((int *) (workBuffer + GWPoint3)), endOop);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(GEFBadPoint);
}
(((int *) (workBuffer + GWPoint2)))[0] = ((((int *) (workBuffer + GWPoint3)))[0]);
(((int *) (workBuffer + GWPoint2)))[1] = ((((int *) (workBuffer + GWPoint1)))[1]);
@@ -5013,12 +5051,13 @@
loadWideLinefromtolineFillleftFillrightFill(borderWidth, ((int *) (workBuffer + GWPoint2)), ((int *) (workBuffer + GWPoint3)), borderIndex, 0, fillIndex);
loadWideLinefromtolineFillleftFillrightFill(borderWidth, ((int *) (workBuffer + GWPoint3)), ((int *) (workBuffer + GWPoint4)), borderIndex, 0, fillIndex);
loadWideLinefromtolineFillleftFillrightFill(borderWidth, ((int *) (workBuffer + GWPoint4)), ((int *) (workBuffer + GWPoint1)), borderIndex, 0, fillIndex);
- if (!(interpreterProxy->failed())) {
- workBuffer[GWNeedsFlush] = 1;
- /* begin storeEngineStateInto: */
- workBuffer[GWObjUsed] = objUsed;
- interpreterProxy->pop(5);
+ if (interpreterProxy->failed()) {
+ return interpreterProxy->primitiveFailFor(GEFEntityLoadFailed);
}
+ workBuffer[GWNeedsFlush] = 1;
+ /* begin storeEngineStateInto: */
+ workBuffer[GWObjUsed] = objUsed;
+ interpreterProxy->pop(5);
}
@@ -5027,25 +5066,25 @@
EXPORT(sqInt) primitiveChangedActiveEdgeEntry(void) {
sqInt edge;
sqInt edgeOop;
+ sqInt failureCode;
sqInt value;
if (doProfileStats) {
geProfileTime = interpreterProxy->ioMicroMSecs();
}
if (!((interpreterProxy->methodArgumentCount()) == 1)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(1), GEStateWaitingChange))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
+ }
edgeOop = interpreterProxy->stackObjectValue(0);
- engine = interpreterProxy->stackObjectValue(1);
if (interpreterProxy->failed()) {
- return null;
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFromrequiredState(engine, GEStateWaitingChange))) {
- return interpreterProxy->primitiveFail();
- }
edge = loadEdgeStateFrom(edgeOop);
- if (interpreterProxy->failed()) {
- return null;
+ if (edge == null) {
+ return interpreterProxy->primitiveFailFor(GEFEdgeDataTooSmall);
}
if ((objBuffer[edge + GENumLines]) == 0) {
removeFirstAETEntry();
@@ -5070,27 +5109,28 @@
sqInt buf2;
sqInt diff;
int * dst;
+ sqInt failCode;
sqInt i;
int * src;
sqInt iLimiT;
if (!((interpreterProxy->methodArgumentCount()) == 2)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
- buf2 = interpreterProxy->stackObjectValue(0);
- buf1 = interpreterProxy->stackObjectValue(1);
- if (interpreterProxy->failed()) {
- return null;
+ buf2 = interpreterProxy->stackValue(0);
+
+ /* Make sure the old buffer is properly initialized */
+
+ buf1 = interpreterProxy->stackValue(1);
+ if (!(((failCode = loadWorkBufferFrom(buf1))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failCode);
}
- if (!(loadWorkBufferFrom(buf1))) {
- return interpreterProxy->primitiveFail();
- }
if (!((interpreterProxy->fetchClassOf(buf1)) == (interpreterProxy->fetchClassOf(buf2)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFClassMismatch);
}
diff = (interpreterProxy->slotSizeOf(buf2)) - (interpreterProxy->slotSizeOf(buf1));
if (diff < 0) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFSizeMismatch);
}
src = workBuffer;
dst = interpreterProxy->firstIndexableField(buf2);
@@ -5104,8 +5144,8 @@
for (i = 0, iLimiT = (((workBuffer[GWSize]) - (workBuffer[GWBufferTop])) - 1); i <= iLimiT; i += 1) {
dst[i] = (src[i]);
}
- if (!(loadWorkBufferFrom(buf2))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failCode = loadWorkBufferFrom(buf2))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failCode);
}
interpreterProxy->pop(2);
}
@@ -5114,26 +5154,23 @@
/* Note: Must load bitBlt and spanBuffer */
EXPORT(sqInt) primitiveDisplaySpanBuffer(void) {
+ sqInt failureCode;
sqInt value;
if (doProfileStats) {
geProfileTime = interpreterProxy->ioMicroMSecs();
}
if (!((interpreterProxy->methodArgumentCount()) == 0)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
- engine = interpreterProxy->stackObjectValue(0);
- if (interpreterProxy->failed()) {
- return null;
+ if (!(((failureCode = quickLoadEngineFromrequiredState(interpreterProxy->stackValue(0), GEStateBlitBuffer))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
- if (!(quickLoadEngineFromrequiredState(engine, GEStateBlitBuffer))) {
- return interpreterProxy->primitiveFail();
+ if (!(((failureCode = loadSpanBufferFrom(interpreterProxy->fetchPointerofObject(BESpanIndex, engine)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
- if (!(loadSpanBufferFrom(interpreterProxy->fetchPointerofObject(BESpanIndex, engine)))) {
- return interpreterProxy->primitiveFail();
- }
if (!(loadBitBltFrom(interpreterProxy->fetchPointerofObject(BEBitBltIndex, engine)))) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(GEFBitBltLoadFailed);
}
if (((workBuffer[GWCurrentY]) & (workBuffer[GWAAScanMask])) == (workBuffer[GWAAScanMask])) {
displaySpanBufferAt(workBuffer[GWCurrentY]);
@@ -5172,6 +5209,7 @@
}
EXPORT(sqInt) primitiveFinishedProcessing(void) {
+ sqInt failureCode;
sqInt finished;
sqInt value;
@@ -5179,15 +5217,11 @@
geProfileTime = interpreterProxy->ioMicroMSecs();
}
if (!((interpreterProxy->methodArgumentCount()) == 0)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
- engine = interpreterProxy->stackObjectValue(0);
- if (interpreterProxy->failed()) {
- return null;
+ if (!(((failureCode = quickLoadEngineFrom(interpreterProxy->stackValue(0)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
- if (!(quickLoadEngineFrom(engine))) {
- return interpreterProxy->primitiveFail();
- }
finished = (workBuffer[GWState]) == GEStateCompleted;
/* begin storeEngineStateInto: */
workBuffer[GWObjUsed] = objUsed;
@@ -5202,41 +5236,33 @@
}
EXPORT(sqInt) primitiveGetAALevel(void) {
+ sqInt failureCode;
+
if (!((interpreterProxy->methodArgumentCount()) == 0)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
- engine = interpreterProxy->stackObjectValue(0);
- if (interpreterProxy->failed()) {
- return null;
+ if (!(((failureCode = quickLoadEngineFrom(interpreterProxy->stackValue(0)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
- if (!(quickLoadEngineFrom(engine))) {
- return interpreterProxy->primitiveFail();
- }
interpreterProxy->pop(1);
interpreterProxy->pushInteger(workBuffer[GWAALevel]);
}
EXPORT(sqInt) primitiveGetBezierStats(void) {
+ sqInt failureCode;
sqInt statOop;
int *stats;
if (!((interpreterProxy->methodArgumentCount()) == 1)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
+ if (!(((failureCode = quickLoadEngineFrom(interpreterProxy->stackValue(1)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
+ }
statOop = interpreterProxy->stackObjectValue(0);
- engine = interpreterProxy->stackObjectValue(1);
- if (interpreterProxy->failed()) {
- return null;
+ if (!((!(interpreterProxy->failed())) && ((interpreterProxy->isWords(statOop)) && ((interpreterProxy->slotSizeOf(statOop)) >= 4)))) {
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFrom(engine))) {
- return interpreterProxy->primitiveFail();
- }
- if (!(interpreterProxy->isWords(statOop))) {
- return interpreterProxy->primitiveFail();
- }
- if ((interpreterProxy->slotSizeOf(statOop)) < 4) {
- return interpreterProxy->primitiveFail();
- }
stats = interpreterProxy->firstIndexableField(statOop);
stats[0] = ((stats[0]) + (workBuffer[GWBezierMonotonSubdivisions]));
stats[1] = ((stats[1]) + (workBuffer[GWBezierHeightSubdivisions]));
@@ -5246,59 +5272,44 @@
}
EXPORT(sqInt) primitiveGetClipRect(void) {
+ sqInt failureCode;
sqInt pointOop;
sqInt rectOop;
if (!((interpreterProxy->methodArgumentCount()) == 1)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
+ if (!(((failureCode = quickLoadEngineFrom(interpreterProxy->stackValue(1)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
+ }
rectOop = interpreterProxy->stackObjectValue(0);
- engine = interpreterProxy->stackObjectValue(1);
- if (interpreterProxy->failed()) {
- return null;
+ if (!((!(interpreterProxy->failed())) && ((interpreterProxy->isPointers(rectOop)) && ((interpreterProxy->slotSizeOf(rectOop)) >= 2)))) {
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFrom(engine))) {
- return interpreterProxy->primitiveFail();
- }
- if (!(interpreterProxy->isPointers(rectOop))) {
- return interpreterProxy->primitiveFail();
- }
- if ((interpreterProxy->slotSizeOf(rectOop)) < 2) {
- return interpreterProxy->primitiveFail();
- }
interpreterProxy->pushRemappableOop(rectOop);
pointOop = interpreterProxy->makePointwithxValueyValue(workBuffer[GWClipMinX], workBuffer[GWClipMinY]);
- rectOop = interpreterProxy->popRemappableOop();
- interpreterProxy->storePointerofObjectwithValue(0, rectOop, pointOop);
- interpreterProxy->pushRemappableOop(rectOop);
+ interpreterProxy->storePointerofObjectwithValue(0, interpreterProxy->topRemappableOop(), pointOop);
pointOop = interpreterProxy->makePointwithxValueyValue(workBuffer[GWClipMaxX], workBuffer[GWClipMaxY]);
rectOop = interpreterProxy->popRemappableOop();
interpreterProxy->storePointerofObjectwithValue(1, rectOop, pointOop);
- interpreterProxy->pop(2);
- interpreterProxy->push(rectOop);
+ interpreterProxy->popthenPush(2, rectOop);
}
EXPORT(sqInt) primitiveGetCounts(void) {
+ sqInt failureCode;
sqInt statOop;
int *stats;
if (!((interpreterProxy->methodArgumentCount()) == 1)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
+ if (!(((failureCode = quickLoadEngineFrom(interpreterProxy->stackValue(1)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
+ }
statOop = interpreterProxy->stackObjectValue(0);
- engine = interpreterProxy->stackObjectValue(1);
- if (interpreterProxy->failed()) {
- return null;
+ if (!((!(interpreterProxy->failed())) && ((interpreterProxy->isWords(statOop)) && ((interpreterProxy->slotSizeOf(statOop)) >= 9)))) {
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
}
- if (!(quickLoadEngineFrom(engine))) {
- return interpreterProxy->primitiveFail();
- }
- if (!(interpreterProxy->isWords(statOop))) {
- return interpreterProxy->primitiveFail();
- }
- if ((interpreterProxy->slotSizeOf(statOop)) < 9) {
- return interpreterProxy->primitiveFail();
- }
stats = interpreterProxy->firstIndexableField(statOop);
stats[0] = ((stats[0]) + (workBuffer[GWCountInitializing]));
stats[1] = ((stats[1]) + (workBuffer[GWCountFinishTest]));
@@ -5313,16 +5324,14 @@
}
EXPORT(sqInt) primitiveGetDepth(void) {
+ sqInt failureCode;
+
if (!((interpreterProxy->methodArgumentCount()) == 0)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
- engine = interpreterProxy->stackObjectValue(0);
- if (interpreterProxy->failed()) {
- return null;
+ if (!(((failureCode = quickLoadEngineFrom(interpreterProxy->stackValue(0)))) == 0)) {
+ return interpreterProxy->primitiveFailFor(failureCode);
}
- if (!(quickLoadEngineFrom(engine))) {
- return interpreterProxy->primitiveFail();
- }
interpreterProxy->pop(1);
interpreterProxy->pushInteger(workBuffer[GWCurrentZ]);
}
@@ -5331,68 +5340,60 @@
/* Return the reason why the last operation failed. */
EXPORT(sqInt) primitiveGetFailureReason(void) {
+ sqInt failCode;
+
if (!((interpreterProxy->methodArgumentCount()) == 0)) {
- return interpreterProxy->primitiveFail();
+ return interpreterProxy->primitiveFailFor(PrimErrBadNumArgs);
}
- engine = interpreterProxy->stackObjectValue(0);
- if (interpreterProxy->failed()) {
- return null;
- }
+
@@ Diff output truncated at 50000 characters. @@
1
0
David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.317.mcz
==================== Summary ====================
Name: VMMaker-dtl.317
Author: dtl
Time: 13 April 2013, 10:47:32.636 am
UUID: cc922d07-b988-4034-9bf9-31e7b86e9a14
Ancestors: VMMaker-dtl.316
VMMaker 4.12.1
Caution: FloatMathPluginTests now included in VMMaker-Tests will crash the VM if compiled 64-bit (Mantis 7760)
Merge changes from oscog plugins.
Update to VM_PROXY_MINOR 11 (was 9). Requires some support code functions not present in SVN trunk, so temporary implementations are provided in InterpreterPrimitives method category "FIXME" for:
add: ticker HighPriorityTickee: periodms
add: ticker Synchronous: periodms Tickee: roundms
amInVMThread
ioUTCMicroseconds
These methods must be removed when platform sources are updated.
Not included in merge:
FilePlugin>>primitiveDirectoryEntry requires support code
SocketPlugin>>primitiveSocketCreateRaw:... requires support code.
Revert previous cosmetic changes (e.g. space added to <returnTypeC:'void*'> declaration) in order to eliminate unnecessary differences versus oscog.
Add missing __buildInfo[] and comment generation for src/vm files.
Classes in oscog that require updates from VMM trunk:
AsyncFilePlugin oscog requires update from trunk
BitBltSimulation in oscog has the rgbMul:with: unicode comment bug, update it from trunk
CameraPlugin missing from oscog
ClipboardExtendedPlugin missing from oscog
JPEGReaderPlugin update oscog from trunk to get missing fix from Mantis 7691 (VMMaker-dtl.192)
LargeIntegersPlugin one unneeded method in oscog
MIDIPlugin update oscog with fix from trunk
MacMenubarPlugin restore oscog from trunk to fix author initials
MiscPrimitivePlugin update class comment from trunk
Mpeg3Plugin class>> requiredMethodNames missing in oscog.
ScratchPlugin missing from oscog
SerialPlugin update oscog from trunk.
UnicodePlugin missing from oscog.
WeDoPlugin missing from oscog.
=============== Diff against VMMaker-dtl.316 ===============
Item was added:
+ ----- Method: ADPCMCodecPlugin class>>monticelloDescription (in category 'translation') -----
+ monticelloDescription
+ "Override to include the ADPCMCodec class."
+ "self monticelloDescription"
+ ^super monticelloDescription, '\' withCRs, (CCodeGenerator monticelloDescriptionFor: ADPCMCodec)!
Item was changed:
InterpreterPlugin subclass: #B3DAcceleratorPlugin
+ instanceVariableNames: 'doRangeChecks'
- instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-Plugins'!
!B3DAcceleratorPlugin commentStamp: '<historical>' prior: 0!
B3DAcceleratorPlugin translate!
Item was added:
+ ----- Method: B3DAcceleratorPlugin>>checkBoundsRange:faces:count: (in category 'primitives-qwaq') -----
+ checkBoundsRange: vertices faces: facePtr count: faceCount
+ "Verify the bounds condition on the entire faces array"
+ | vtxSize |
+ <var: #facePtr type: 'unsigned int *'>
+ vtxSize := (interpreterProxy slotSizeOf: vertices) / 3.
+ 0 to: faceCount-1 do:[:i|
+ (facePtr at: i) > vtxSize
+ ifTrue:[^interpreterProxy primitiveFail]].
+ !
Item was added:
+ ----- Method: B3DAcceleratorPlugin>>checkVertexData: (in category 'primitives-qwaq') -----
+ checkVertexData: vertices
+ "Check the entire vertex data to ensure no nan/inf values"
+ | vtxSize vtxPtr f |
+ <var: #vtxPtr type: 'float *'>
+ <var: #f type: 'float'>
+ vtxSize := interpreterProxy slotSizeOf: vertices.
+ vtxPtr := interpreterProxy firstIndexableField: vertices.
+ 0 to: vtxSize-1 do:[:i|
+ f := vtxPtr at: i.
+ (self isnan: (f-f)) ifTrue:[^interpreterProxy primitiveFail].
+ ].
+ !
Item was changed:
----- Method: B3DAcceleratorPlugin>>fetchLightSource:ofObject: (in category 'primitive support') -----
fetchLightSource: index ofObject: anArray
"Fetch the primitive light source from the given array.
Note: No checks are done within here - that happened in stackLightArrayValue:"
| lightOop |
<inline: true>
+ <returnTypeC:'void*'>
- <returnTypeC: 'void*'>
lightOop := interpreterProxy fetchPointer: index ofObject: anArray.
^interpreterProxy firstIndexableField: lightOop!
Item was changed:
----- Method: B3DAcceleratorPlugin>>initialiseModule (in category 'initialize-release') -----
initialiseModule
<export: true>
+ doRangeChecks := true.
^self b3dxInitialize!
Item was added:
+ ----- Method: B3DAcceleratorPlugin>>loadClientState:vertices:colors:normals:texCoords: (in category 'primitives-qwaq') -----
+ loadClientState: handle vertices: vertices colors: colors normals: normals texCoords: texCoords
+ "Common method to set up client state for some render ops"
+ | vtxSize sz colorPtr normalPtr txPtr vertexPtr ok |
+ <var: #colorPtr type: 'void *'>
+ <var: #normalPtr type: 'void *'>
+ <var: #txPtr type: 'void *'>
+ <var: #vertexPtr type: 'void *'>
+
+ colorPtr := normalPtr := txPtr := vertexPtr := nil.
+
+ "Verify vertex data"
+ (interpreterProxy isWords: vertices)
+ ifFalse:[^interpreterProxy primitiveFail].
+ vtxSize := (interpreterProxy slotSizeOf: vertices) / 3.
+
+ "Verify assumptions of color, normal, texCoords data"
+ (colors = interpreterProxy nilObject
+ or:[(interpreterProxy isWords: colors)
+ and:[(interpreterProxy slotSizeOf: colors) = (vtxSize * 4)]])
+ ifFalse:[^interpreterProxy primitiveFail].
+ (normals = interpreterProxy nilObject
+ or:[(interpreterProxy isWords: normals)
+ and:[(interpreterProxy slotSizeOf: normals) = (vtxSize * 3)]])
+ ifFalse:[^interpreterProxy primitiveFail].
+ "Don't check size for texCoords since they can be 2,3,4 elements"
+ (texCoords = interpreterProxy nilObject
+ or:[(interpreterProxy isWords: texCoords)])
+ ifFalse:[^interpreterProxy primitiveFail].
+
+ "Finally submit the data to OpenGL"
+ (colors = interpreterProxy nilObject) ifFalse:[
+ colorPtr := interpreterProxy firstIndexableField: colors.
+ ].
+ (normals = interpreterProxy nilObject) ifFalse:[
+ normalPtr := interpreterProxy firstIndexableField: normals.
+ ].
+ (texCoords = interpreterProxy nilObject) ifFalse:[
+ sz := (interpreterProxy slotSizeOf: texCoords) / vtxSize.
+ txPtr := interpreterProxy firstIndexableField: texCoords.
+ ].
+ vertexPtr := interpreterProxy firstIndexableField: vertices.
+ interpreterProxy failed ifTrue:[^nil].
+ ok := self cCode:'b3dLoadClientState(handle, vertexPtr, 3, colorPtr, 4, normalPtr, 3, txPtr, sz)'
+ inSmalltalk:[vertexPtr. colorPtr. normalPtr. txPtr. sz false].
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ !
Item was added:
+ ----- Method: B3DAcceleratorPlugin>>primitiveDrawArrays (in category 'primitives-qwaq') -----
+ primitiveDrawArrays
+ "Primitive. Setup non-VBO client state and call drawRangeElements in one go to avoid
+ garbage collection to move the buffers underneith."
+ | maxIdx minIdx mode texCoords normals colors vertices handle vtxSize ok |
+ <export: true>
+
+ interpreterProxy methodArgumentCount = 8
+ ifFalse:[^interpreterProxy primitiveFail].
+
+ maxIdx := interpreterProxy stackIntegerValue: 0.
+ minIdx := interpreterProxy stackIntegerValue: 1.
+ mode := interpreterProxy stackIntegerValue: 2.
+ texCoords := interpreterProxy stackValue: 3.
+ normals := interpreterProxy stackValue: 4.
+ colors := interpreterProxy stackValue: 5.
+ vertices := interpreterProxy stackValue: 6.
+ handle := interpreterProxy stackIntegerValue: 7.
+
+ self loadClientState: handle vertices: vertices colors: colors normals: normals texCoords: texCoords.
+ interpreterProxy failed ifTrue:[^nil].
+ doRangeChecks ifTrue:[
+ "Verify the vertex data itself"
+ self checkVertexData: vertices.
+
+ "Verify min-max range in bounds for given vertex array"
+ vtxSize := (interpreterProxy slotSizeOf: vertices) / 3.
+ (minIdx < 0 or:[minIdx > maxIdx or:[maxIdx > vtxSize]])
+ ifTrue:[^interpreterProxy primitiveFail].
+ ].
+ interpreterProxy failed ifTrue:[^nil].
+ ok := self cCode: 'b3dDrawArrays(handle, mode, minIdx, maxIdx)'
+ inSmalltalk:[mode. false].
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ interpreterProxy failed
+ ifFalse:[interpreterProxy pop: interpreterProxy methodArgumentCount].
+ !
Item was added:
+ ----- Method: B3DAcceleratorPlugin>>primitiveDrawElements (in category 'primitives-qwaq') -----
+ primitiveDrawElements
+ "Primitive. Setup non-VBO client state and call drawElements in one go to avoid
+ garbage collection to move the buffers underneith."
+ | faces mode texCoords normals colors vertices handle ok facePtr faceSize |
+ <export: true>
+ <var: #facePtr type: 'unsigned int *'>
+
+ interpreterProxy methodArgumentCount = 7
+ ifFalse:[^interpreterProxy primitiveFail].
+
+ faces := interpreterProxy stackValue: 0.
+ (interpreterProxy isWords: faces)
+ ifFalse:[^interpreterProxy primitiveFail].
+ faceSize := interpreterProxy slotSizeOf: faces.
+ facePtr := interpreterProxy firstIndexableField: faces.
+
+ mode := interpreterProxy stackIntegerValue: 1.
+ texCoords := interpreterProxy stackValue: 2.
+ normals := interpreterProxy stackValue: 3.
+ colors := interpreterProxy stackValue: 4.
+ vertices := interpreterProxy stackValue: 5.
+ handle := interpreterProxy stackIntegerValue: 6.
+
+ self loadClientState: handle vertices: vertices colors: colors normals: normals texCoords: texCoords.
+ interpreterProxy failed ifTrue:[^nil].
+
+ doRangeChecks ifTrue:[
+ "Verify the vertex data itself"
+ self checkVertexData: vertices.
+ "Change bounds range to make sure the data is valid"
+ self checkBoundsRange: vertices faces: facePtr count: faceSize.
+ ].
+
+ interpreterProxy failed ifTrue:[^nil].
+ ok := self cCode: 'b3dDrawElements(handle, mode, faceSize, facePtr)'
+ inSmalltalk:[mode. facePtr. false].
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ interpreterProxy failed
+ ifFalse:[interpreterProxy pop: interpreterProxy methodArgumentCount].
+ !
Item was added:
+ ----- Method: B3DAcceleratorPlugin>>primitiveDrawRangeElements (in category 'primitives-qwaq') -----
+ primitiveDrawRangeElements
+ "Primitive. Setup non-VBO client state and call drawRangeElements in one go to avoid
+ garbage collection to move the buffers underneith."
+ | faces maxIdx minIdx mode texCoords normals colors vertices handle vtxSize ok facePtr faceSize |
+ <export: true>
+ <var: #facePtr type: 'unsigned int *'>
+
+ interpreterProxy methodArgumentCount = 9
+ ifFalse:[^interpreterProxy primitiveFail].
+
+ faces := interpreterProxy stackValue: 0.
+ (interpreterProxy isWords: faces)
+ ifFalse:[^interpreterProxy primitiveFail].
+ faceSize := interpreterProxy slotSizeOf: faces.
+ facePtr := interpreterProxy firstIndexableField: faces.
+
+ maxIdx := interpreterProxy stackIntegerValue: 1.
+ minIdx := interpreterProxy stackIntegerValue: 2.
+ mode := interpreterProxy stackIntegerValue: 3.
+ texCoords := interpreterProxy stackValue: 4.
+ normals := interpreterProxy stackValue: 5.
+ colors := interpreterProxy stackValue: 6.
+ vertices := interpreterProxy stackValue: 7.
+ handle := interpreterProxy stackIntegerValue: 8.
+
+ self loadClientState: handle vertices: vertices colors: colors normals: normals texCoords: texCoords.
+ interpreterProxy failed ifTrue:[^nil].
+
+ doRangeChecks ifTrue:[
+ "Verify the vertex data itself"
+ self checkVertexData: vertices.
+ "Change bounds range to make sure the data is valid"
+ self checkBoundsRange: vertices faces: facePtr count: faceSize.
+ "Verify min-max range in bounds for given vertex array"
+ vtxSize := (interpreterProxy slotSizeOf: vertices) / 3.
+ (minIdx < 0 or:[minIdx > maxIdx or:[maxIdx > vtxSize]])
+ ifTrue:[^interpreterProxy primitiveFail].
+ ].
+
+ interpreterProxy failed ifTrue:[^nil].
+ ok := self cCode: 'b3dDrawRangeElements(handle, mode, minIdx, maxIdx, faceSize, facePtr)'
+ inSmalltalk:[mode. facePtr. false].
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ interpreterProxy failed
+ ifFalse:[interpreterProxy pop: interpreterProxy methodArgumentCount].
+ !
Item was added:
+ ----- Method: B3DAcceleratorPlugin>>primitiveEnableDrawRangeChecks (in category 'primitives-qwaq') -----
+ primitiveEnableDrawRangeChecks
+ "Primitive. Enable/disable draw (range) checks"
+ | enabled |
+ <export: true>
+ interpreterProxy methodArgumentCount = 0 ifTrue:[
+ interpreterProxy pop: 1.
+ ^interpreterProxy pushBool: doRangeChecks.
+ ].
+ interpreterProxy methodArgumentCount = 1 ifTrue:[
+ enabled := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
+ interpreterProxy failed ifTrue:[^nil].
+ doRangeChecks := enabled.
+ ^interpreterProxy pop: 1. "pop arg; return recvr"
+ ].!
Item was changed:
----- Method: B3DAcceleratorPlugin>>primitiveGetRendererColorMasks (in category 'primitives-renderer') -----
primitiveGetRendererColorMasks
| handle result masks array arrayOop |
<export: true>
+ <var: #masks declareC:'int masks[4]'>
- <var: #masks declareC: 'int masks[4]'>
interpreterProxy methodArgumentCount = 2
ifFalse:[^interpreterProxy primitiveFail].
array := interpreterProxy stackObjectValue: 0.
handle := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy fetchClassOf: array) = interpreterProxy classArray
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy slotSizeOf: array) = 4
ifFalse:[^interpreterProxy primitiveFail].
result := self cCode:'b3dxGetRendererColorMasks(handle, masks)' inSmalltalk:[false].
result ifFalse:[^interpreterProxy primitiveFail].
arrayOop := array.
0 to: 3 do:[:i|
interpreterProxy pushRemappableOop: arrayOop.
result := interpreterProxy positive32BitIntegerFor: (masks at: i).
arrayOop := interpreterProxy popRemappableOop.
interpreterProxy storePointer: i ofObject: arrayOop withValue: result].
^interpreterProxy pop: 2. "pop args return receiver"!
Item was changed:
----- Method: B3DAcceleratorPlugin>>primitiveSetFog (in category 'primitives-renderer') -----
primitiveSetFog
| result handle rgba density fogType stop start |
<export: true>
+ <var: #density type:'double'>
- <var: #density type: 'double'>
<var: #start type: 'double'>
<var: #stop type: 'double'>
interpreterProxy methodArgumentCount = 6
ifFalse:[^interpreterProxy primitiveFail].
rgba := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
stop := interpreterProxy floatValueOf: (interpreterProxy stackValue: 1).
start := interpreterProxy floatValueOf: (interpreterProxy stackValue: 2).
density := interpreterProxy floatValueOf: (interpreterProxy stackValue: 3).
fogType := interpreterProxy stackIntegerValue: 4.
handle := interpreterProxy stackIntegerValue: 5.
interpreterProxy failed ifTrue:[^nil].
result := self cCode:'b3dxSetFog(handle, fogType, density, start, stop, rgba)'.
result ifFalse:[^interpreterProxy primitiveFail].
^interpreterProxy pop: 6. "pop args; return rcvr"!
Item was changed:
----- Method: B3DAcceleratorPlugin>>primitiveSetTransform (in category 'primitives-renderer') -----
primitiveSetTransform
"Transform an entire vertex buffer using the supplied modelview and projection matrix."
| projectionMatrix modelViewMatrix handle |
<export: true>
<inline: false>
+ <var: #projectionMatrix declareC:'float *projectionMatrix'>
+ <var: #modelViewMatrix declareC:'float *modelViewMatrix'>
- <var: #projectionMatrix declareC: 'float *projectionMatrix'>
- <var: #modelViewMatrix declareC: 'float *modelViewMatrix'>
interpreterProxy methodArgumentCount = 3
ifFalse:[^interpreterProxy primitiveFail].
projectionMatrix := self stackMatrix: 0.
modelViewMatrix := self stackMatrix: 1.
handle := interpreterProxy stackIntegerValue: 2.
interpreterProxy failed ifTrue:[^nil].
self cCode: 'b3dxSetTransform(handle, modelViewMatrix, projectionMatrix)'.
^interpreterProxy pop: 3. "Leave rcvr on stack"!
Item was changed:
----- Method: B3DAcceleratorPlugin>>primitiveTextureGetColorMasks (in category 'primitives-textures') -----
primitiveTextureGetColorMasks
| handle result masks array renderer arrayOop |
<export: true>
+ <var: #masks declareC:'int masks[4]'>
- <var: #masks declareC: 'int masks[4]'>
interpreterProxy methodArgumentCount = 3
ifFalse:[^interpreterProxy primitiveFail].
array := interpreterProxy stackObjectValue: 0.
handle := interpreterProxy stackIntegerValue: 1.
renderer := interpreterProxy stackIntegerValue: 2.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy fetchClassOf: array) = interpreterProxy classArray
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy slotSizeOf: array) = 4
ifFalse:[^interpreterProxy primitiveFail].
result := self cCode:'b3dxTextureColorMasks(renderer, handle, masks)' inSmalltalk:[false].
result ifFalse:[^interpreterProxy primitiveFail].
arrayOop := array.
0 to: 3 do:[:i|
interpreterProxy pushRemappableOop: arrayOop.
result := interpreterProxy positive32BitIntegerFor: (masks at: i).
arrayOop := interpreterProxy popRemappableOop.
interpreterProxy storePointer: i ofObject: arrayOop withValue: result].
^interpreterProxy pop: 3. "pop args return receiver"!
Item was changed:
----- Method: B3DAcceleratorPlugin>>stackMaterialValue: (in category 'primitive support') -----
stackMaterialValue: stackIndex
"Load a B3DMaterial from the given stack index"
| oop |
<inline: false>
+ <returnTypeC:'void *'>
- <returnTypeC: 'void *'>
oop := interpreterProxy stackObjectValue: stackIndex.
oop = nil ifTrue:[^nil].
oop = interpreterProxy nilObject ifTrue:[^nil].
((interpreterProxy isWords: oop) and:[(interpreterProxy slotSizeOf: oop) = 17])
ifTrue:[^interpreterProxy firstIndexableField: oop].
^nil!
Item was changed:
----- Method: B3DAcceleratorPlugin>>stackMatrix: (in category 'primitive support') -----
stackMatrix: index
"Load a 4x4 transformation matrix from the interpreter stack.
Return a pointer to the matrix data if successful, nil otherwise."
| oop |
<inline: false>
+ <returnTypeC:'void*'>
- <returnTypeC: 'void*'>
oop := interpreterProxy stackObjectValue: index.
oop = nil ifTrue:[^nil].
- oop = interpreterProxy nilObject ifTrue:[^nil].
((interpreterProxy isWords: oop) and:[(interpreterProxy slotSizeOf: oop) = 16])
ifTrue:[^interpreterProxy firstIndexableField: oop].
^nil!
Item was changed:
----- Method: B3DAcceleratorPlugin>>stackPrimitiveIndexArray:ofSize:validate:forVertexSize: (in category 'primitive support') -----
stackPrimitiveIndexArray: stackIndex ofSize: nItems validate: aBool forVertexSize: maxIndex
"Load a primitive index array from the interpreter stack.
If aBool is true then check that all the indexes are in the range (1,maxIndex).
Return a pointer to the index data if successful, nil otherwise."
| oop oopSize idxPtr index |
<inline: false>
+ <returnTypeC:'void*'>
+ <var: #idxPtr declareC:'int *idxPtr'>
- <returnTypeC: 'void*'>
- <var: #idxPtr declareC: 'int *idxPtr'>
oop := interpreterProxy stackObjectValue: stackIndex.
oop = nil ifTrue:[^nil].
(interpreterProxy isWords: oop) ifFalse:[^nil].
oopSize := interpreterProxy slotSizeOf: oop.
oopSize < nItems ifTrue:[^nil].
idxPtr := self cCoerce: (interpreterProxy firstIndexableField: oop) to:'int *'.
aBool ifTrue:[
0 to: nItems-1 do:[:i|
index := idxPtr at: i.
(index < 0 or:[index > maxIndex]) ifTrue:[^nil]]].
^idxPtr!
Item was changed:
----- Method: B3DAcceleratorPlugin>>stackPrimitiveVertex: (in category 'primitive support') -----
stackPrimitiveVertex: index
"Load a primitive vertex from the interpreter stack.
Return a pointer to the vertex data if successful, nil otherwise."
| oop |
<inline: false>
+ <returnTypeC:'void*'>
- <returnTypeC: 'void*'>
oop := interpreterProxy stackObjectValue: index.
oop = nil ifTrue:[^nil].
((interpreterProxy isWords: oop) and:[(interpreterProxy slotSizeOf: oop) = 16])
ifTrue:[^interpreterProxy firstIndexableField: oop].
^nil!
Item was changed:
----- Method: B3DAcceleratorPlugin>>stackPrimitiveVertexArray:ofSize: (in category 'primitive support') -----
stackPrimitiveVertexArray: index ofSize: nItems
"Load a primitive vertex array from the interpreter stack.
Return a pointer to the vertex data if successful, nil otherwise."
| oop oopSize |
<inline: false>
+ <returnTypeC:'void*'>
- <returnTypeC: 'void*'>
oop := interpreterProxy stackObjectValue: index.
oop = nil ifTrue:[^nil].
(interpreterProxy isWords: oop) ifTrue:[
oopSize := interpreterProxy slotSizeOf: oop.
(oopSize >= nItems * 16 and:[oopSize \\ 16 = 0])
ifTrue:[^interpreterProxy firstIndexableField: oop]].
^nil!
Item was changed:
----- Method: BalloonEngineBase class>>initialize (in category 'class initialization') -----
initialize
"BalloonEngineBase initialize"
"BalloonEnginePlugin translateDoInlining: true."
EdgeInitTable := self initializeEdgeInitTable.
EdgeStepTable := self initializeEdgeStepTable.
WideLineWidthTable := self initializeWideLineWidthTable.
WideLineFillTable := self initializeWideLineFillTable.
+ FillTable := self initializeFillTable.
+
+ (Smalltalk classNamed: #BalloonEngineConstants) ifNotNil:
+ [:balloonEngineConstants|
+ (balloonEngineConstants classPool anySatisfy: [:classVarValue| classVarValue isNil]) ifTrue:
+ [balloonEngineConstants initialize]]!
- FillTable := self initializeFillTable.!
Item was changed:
+ ----- Method: BalloonEngineBase class>>moduleName (in category 'translation') -----
- ----- Method: BalloonEngineBase class>>moduleName (in category 'accessing') -----
moduleName
^'B2DPlugin'!
Item was changed:
+ ----- Method: BalloonEngineBase class>>simulatorClass (in category 'simulation') -----
- ----- Method: BalloonEngineBase class>>simulatorClass (in category 'accessing') -----
simulatorClass
^BalloonEngineSimulation!
Item was changed:
----- Method: BalloonEngineBase>>colorTransform (in category 'accessing state') -----
colorTransform
+ <returnTypeC:'float *'>
- <returnTypeC: 'float *'>
^self cCoerce: workBuffer + GWColorTransform to:'float *'!
Item was changed:
----- Method: BalloonEngineBase>>edgeTransform (in category 'accessing state') -----
edgeTransform
+ <returnTypeC:'float *'>
- <returnTypeC: 'float *'>
^self cCoerce: workBuffer + GWEdgeTransform to:'float *'!
Item was changed:
----- Method: BalloonEngineBase>>fillBitmapSpan:from:to: (in category 'displaying') -----
fillBitmapSpan: bits from: leftX to: rightX
"Fill the span buffer between leftEdge and rightEdge using the given bits.
Note: We always start from zero - this avoids using huge bitmap buffers if the bitmap is to be displayed at the very far right hand side and also gives us a chance of using certain bitmaps (e.g., those with depth 32) directly."
| x0 x1 x bitX colorMask colorShift baseShift fillValue |
<inline: false>
+ <var: #bits type:'int *'>
- <var: #bits type: 'int *'>
x0 := leftX.
x1 := rightX.
bitX := -1. "Hack for pre-increment"
self aaLevelGet = 1 ifTrue:["Speedy version for no anti-aliasing"
[x0 < x1] whileTrue:[
fillValue := (self cCoerce: bits to: 'int *') at: (bitX := bitX + 1).
spanBuffer at: x0 put: fillValue.
x0 := x0 + 1.
].
] ifFalse:["Generic version with anti-aliasing"
colorMask := self aaColorMaskGet.
colorShift := self aaColorShiftGet.
baseShift := self aaShiftGet.
[x0 < x1] whileTrue:[
x := x0 >> baseShift.
fillValue := (self cCoerce: bits to: 'int *') at: (bitX := bitX + 1).
fillValue := (fillValue bitAnd: colorMask) >> colorShift.
spanBuffer at: x put: (spanBuffer at: x) + fillValue.
x0 := x0 + 1.
].
].
x1 > self spanEndGet ifTrue:[self spanEndPut: x1].
x1 > self spanEndAAGet ifTrue:[self spanEndAAPut: x1].!
Item was changed:
----- Method: BalloonEngineBase>>incrementPoint:by: (in category 'transforming') -----
incrementPoint: point by: delta
+ <var: #point type:'int *'>
- <var: #point type: 'int *'>
point at: 0 put: (point at: 0) + delta.
point at: 1 put: (point at: 1) + delta.!
Item was changed:
----- Method: BalloonEngineBase>>initColorTransform (in category 'other') -----
initColorTransform
| transform |
<inline: false>
+ <var: #transform type:'float *'>
- <var: #transform type: 'float *'>
transform := self colorTransform.
transform at: 0 put: (self cCoerce: 1.0 to: 'float').
transform at: 1 put: (self cCoerce: 0.0 to: 'float').
transform at: 2 put: (self cCoerce: 1.0 to: 'float').
transform at: 3 put: (self cCoerce: 0.0 to: 'float').
transform at: 4 put: (self cCoerce: 1.0 to: 'float').
transform at: 5 put: (self cCoerce: 0.0 to: 'float').
transform at: 6 put: (self cCoerce: 1.0 to: 'float').
transform at: 7 put: (self cCoerce: 0.0 to: 'float').
self hasColorTransformPut: 0.!
Item was changed:
----- Method: BalloonEngineBase>>initEdgeTransform (in category 'other') -----
initEdgeTransform
| transform |
<inline: false>
+ <var: #transform type:'float *'>
- <var: #transform type: 'float *'>
transform := self edgeTransform.
transform at: 0 put: (self cCoerce: 1.0 to: 'float').
transform at: 1 put: (self cCoerce: 0.0 to: 'float').
transform at: 2 put: (self cCoerce: 0.0 to: 'float').
transform at: 3 put: (self cCoerce: 0.0 to: 'float').
transform at: 4 put: (self cCoerce: 1.0 to: 'float').
transform at: 5 put: (self cCoerce: 0.0 to: 'float').
self hasEdgeTransformPut: 0.!
Item was changed:
----- Method: BalloonEngineBase>>loadArrayTransformFrom:into:length: (in category 'loading state') -----
loadArrayTransformFrom: transformOop into: destPtr length: n
"Load a transformation from the given array."
| value |
<inline: false>
+ <var: #destPtr type:'float *'>
- <var: #destPtr type: 'float *'>
0 to: n-1 do:[:i|
value := interpreterProxy fetchPointer: i ofObject: transformOop.
((interpreterProxy isIntegerObject: value) or:[interpreterProxy isFloatObject: value])
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isIntegerObject: value)
ifTrue:[destPtr at: i put:
(self cCoerce: (interpreterProxy integerValueOf: value) asFloat to:'float')]
ifFalse:[destPtr at: i put:
(self cCoerce: (interpreterProxy floatValueOf: value) to: 'float')].
].!
Item was changed:
----- Method: BalloonEngineBase>>loadColorTransformFrom: (in category 'loading state') -----
loadColorTransformFrom: transformOop
"Load a 2x3 transformation matrix from the given oop.
Return true if the matrix is not nil, false otherwise"
| okay transform |
+ <var: #transform type:'float *'>
- <var: #transform type: 'float *'>
transform := self colorTransform.
self hasColorTransformPut: 0.
okay := self loadTransformFrom: transformOop into: transform length: 8.
okay ifFalse:[^false].
self hasColorTransformPut: 1.
"Scale transform to be in 0-256 range"
transform at: 1 put: (transform at: 1) * (self cCoerce: 256.0 to:'float').
transform at: 3 put: (transform at: 3) * (self cCoerce: 256.0 to:'float').
transform at: 5 put: (transform at: 5) * (self cCoerce: 256.0 to:'float').
transform at: 7 put: (transform at: 7) * (self cCoerce: 256.0 to:'float').
^okay!
Item was changed:
----- Method: BalloonEngineBase>>loadEdgeStateFrom: (in category 'loading state') -----
loadEdgeStateFrom: edgeOop
| edge |
<inline: false>
edge := self lastExportedEdgeGet.
(interpreterProxy slotSizeOf: edgeOop) < ETBalloonEdgeDataSize
+ ifTrue:[^nil].
- ifTrue:[^interpreterProxy primitiveFail].
self edgeXValueOf: edge
put: (interpreterProxy fetchInteger: ETXValueIndex ofObject: edgeOop).
self edgeYValueOf: edge
put: (interpreterProxy fetchInteger: ETYValueIndex ofObject: edgeOop).
self edgeZValueOf: edge
put: (interpreterProxy fetchInteger: ETZValueIndex ofObject: edgeOop).
self edgeNumLinesOf: edge
put: (interpreterProxy fetchInteger: ETLinesIndex ofObject: edgeOop).
^edge!
Item was changed:
----- Method: BalloonEngineBase>>loadEdgeTransformFrom: (in category 'loading state') -----
loadEdgeTransformFrom: transformOop
"Load a 2x3 transformation matrix from the given oop.
Return true if the matrix is not nil, false otherwise"
| transform okay |
<inline: false>
+ <var: #transform type:'float *'>
- <var: #transform type: 'float *'>
self hasEdgeTransformPut: 0.
transform := self edgeTransform.
okay := self loadTransformFrom: transformOop into: transform length: 6.
interpreterProxy failed ifTrue:[^nil].
okay ifFalse:[^false].
self hasEdgeTransformPut: 1.
"Add the fill offset to the matrix"
transform at: 2 put:
(self cCoerce: (transform at: 2) + self destOffsetXGet asFloat to:'float').
transform at: 5 put:
(self cCoerce: (transform at: 5) + self destOffsetYGet asFloat to:'float').
^true!
Item was changed:
----- Method: BalloonEngineBase>>loadPoint:from: (in category 'loading state') -----
loadPoint: pointArray from: pointOop
"Load the contents of pointOop into pointArray"
| value |
<inline: false>
+ <var: #pointArray type:'int *'>
- <var: #pointArray type: 'int *'>
(interpreterProxy fetchClassOf: pointOop) = interpreterProxy classPoint
ifFalse:[^interpreterProxy primitiveFail].
value := interpreterProxy fetchPointer: 0 ofObject: pointOop.
((interpreterProxy isIntegerObject: value) or:[interpreterProxy isFloatObject: value])
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isIntegerObject: value)
ifTrue:[pointArray at: 0 put: (interpreterProxy integerValueOf: value)]
ifFalse:[pointArray at: 0 put: (interpreterProxy floatValueOf: value) asInteger].
value := interpreterProxy fetchPointer: 1 ofObject: pointOop.
((interpreterProxy isIntegerObject: value) or:[interpreterProxy isFloatObject: value])
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isIntegerObject: value)
ifTrue:[pointArray at: 1 put: (interpreterProxy integerValueOf: value)]
ifFalse:[pointArray at: 1 put: (interpreterProxy floatValueOf: value) asInteger].
!
Item was changed:
----- Method: BalloonEngineBase>>loadRenderingState (in category 'primitives-rendering') -----
loadRenderingState
+ "Load the entire state from the interpreter for the rendering primitives.
+ Answer 0 on success or a non-zero failure code on failure."
+ | failCode edgeOop fillOop state |
- "Load the entire state from the interpreter for the rendering primitives"
- | edgeOop fillOop state |
<inline: false>
interpreterProxy methodArgumentCount = 2
+ ifFalse:[^PrimErrBadNumArgs].
+
+ (failCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 2)) ~= 0 ifTrue:
+ [^failCode].
+
- ifFalse:[^interpreterProxy primitiveFail].
fillOop := interpreterProxy stackObjectValue: 0.
edgeOop := interpreterProxy stackObjectValue: 1.
+ interpreterProxy failed ifTrue: [^PrimErrBadArgument].
- engine := interpreterProxy stackObjectValue: 2.
- interpreterProxy failed ifTrue:[^false].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^false].
"Load span buffer and bitBlt"
+ (failCode := self loadSpanBufferFrom:
+ (interpreterProxy fetchPointer: BESpanIndex ofObject: engine)) = 0 ifFalse:
+ [^failCode].
- (self loadSpanBufferFrom:
- (interpreterProxy fetchPointer: BESpanIndex ofObject: engine))
- ifFalse:[^false].
(self loadBitBltFrom:
+ (interpreterProxy fetchPointer: BEBitBltIndex ofObject: engine)) ifFalse:
+ [^GEFBitBltLoadFailed].
- (interpreterProxy fetchPointer: BEBitBltIndex ofObject: engine))
- ifFalse:[^false].
(self loadFormsFrom:
+ (interpreterProxy fetchPointer: BEFormsIndex ofObject: engine)) ifFalse:
+ [^GEFFormLoadFailed].
- (interpreterProxy fetchPointer: BEFormsIndex ofObject: engine))
- ifFalse:[^false].
"Check edgeOop and fillOop"
(interpreterProxy slotSizeOf: edgeOop) < ETBalloonEdgeDataSize
+ ifTrue:[^GEFEdgeDataTooSmall].
- ifTrue:[^false].
(interpreterProxy slotSizeOf: fillOop) < FTBalloonFillDataSize
+ ifTrue:[^GEFFillDataTooSmall].
- ifTrue:[^false].
"Note: Rendering can only take place if we're not in one of the intermediate
(e.g., external) states."
state := self stateGet.
(state = GEStateWaitingForEdge or:[
state = GEStateWaitingForFill or:[
+ state = GEStateWaitingChange]]) ifTrue:[^GEFWrongState].
- state = GEStateWaitingChange]]) ifTrue:[^false].
+ ^0!
- ^true!
Item was changed:
----- Method: BalloonEngineBase>>loadSpanBufferFrom: (in category 'loading state') -----
loadSpanBufferFrom: spanOop
+ "Load the span buffer from the given oop.
+ Answer 0 on success or a non-zero failure code on failure."
- "Load the span buffer from the given oop."
<inline: false>
+ (interpreterProxy fetchClassOf: spanOop) = (interpreterProxy classBitmap) ifFalse:[^GEFClassMismatch].
- (interpreterProxy fetchClassOf: spanOop) = (interpreterProxy classBitmap) ifFalse:[^false].
spanBuffer := interpreterProxy firstIndexableField: spanOop.
"Leave last entry unused to avoid complications"
self spanSizePut: (interpreterProxy slotSizeOf: spanOop) - 1.
+ ^0!
- ^true!
Item was changed:
----- Method: BalloonEngineBase>>loadTransformFrom:into:length: (in category 'loading state') -----
loadTransformFrom: transformOop into: destPtr length: n
"Load a transformation from transformOop into the float array
defined by destPtr. The transformation is assumed to be either
an array or a FloatArray of length n."
<inline: false>
+ <var: #destPtr type:'float *'>
- <var: #destPtr type: 'float *'>
transformOop = interpreterProxy nilObject ifTrue:[^false].
(interpreterProxy isIntegerObject: transformOop)
ifTrue:[^interpreterProxy primitiveFail].
(interpreterProxy slotSizeOf: transformOop) = n
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isWords: transformOop)
ifTrue:[self loadWordTransformFrom: transformOop into: destPtr length: n]
ifFalse:[self loadArrayTransformFrom: transformOop into: destPtr length: n].
^true!
Item was changed:
----- Method: BalloonEngineBase>>loadWordTransformFrom:into:length: (in category 'loading state') -----
loadWordTransformFrom: transformOop into: destPtr length: n
"Load a float array transformation from the given oop"
| srcPtr |
<inline: false>
+ <var: #srcPtr type:'float *'>
+ <var: #destPtr type:'float *'>
- <var: #srcPtr type: 'float *'>
- <var: #destPtr type: 'float *'>
srcPtr := self cCoerce: (interpreterProxy firstIndexableField: transformOop) to: 'float *'.
0 to: n-1 do:[:i| destPtr at: i put: (srcPtr at: i)].!
Item was changed:
----- Method: BalloonEngineBase>>loadWorkBufferFrom: (in category 'loading state') -----
loadWorkBufferFrom: wbOop
"Load the working buffer from the given oop"
<inline: false>
+ (interpreterProxy isIntegerObject: wbOop) ifTrue:[^GEFWorkBufferIsInteger].
+ (interpreterProxy isWords: wbOop) ifFalse:[^GEFWorkBufferIsPointers].
+ (interpreterProxy slotSizeOf: wbOop) < GWMinimalSize ifTrue:[^GEFWorkBufferTooSmall].
- (interpreterProxy isIntegerObject: wbOop) ifTrue:[^false].
- (interpreterProxy isWords: wbOop) ifFalse:[^false].
- (interpreterProxy slotSizeOf: wbOop) < GWMinimalSize ifTrue:[^false].
self workBufferPut: wbOop.
+ self magicNumberGet = GWMagicNumber ifFalse:[^GEFWorkBufferBadMagic].
- self magicNumberGet = GWMagicNumber ifFalse:[^false].
"Sanity checks"
+ (self wbSizeGet = (interpreterProxy slotSizeOf: wbOop)) ifFalse:[^GEFWorkBufferWrongSize].
+ self objStartGet = GWHeaderSize ifFalse:[^GEFWorkBufferStartWrong].
- (self wbSizeGet = (interpreterProxy slotSizeOf: wbOop)) ifFalse:[^false].
- self objStartGet = GWHeaderSize ifFalse:[^false].
"Load buffers"
objBuffer := workBuffer + self objStartGet.
getBuffer := objBuffer + self objUsedGet.
aetBuffer := getBuffer + self getUsedGet.
"Make sure we don't exceed the work buffer"
+ GWHeaderSize + self objUsedGet + self getUsedGet + self aetUsedGet
+ > self wbSizeGet ifTrue:[^GEFWorkTooBig].
- GWHeaderSize + self objUsedGet + self getUsedGet + self aetUsedGet > self wbSizeGet ifTrue:[^false].
+ ^0!
- ^true!
Item was changed:
----- Method: BalloonEngineBase>>point1Get (in category 'accessing state') -----
point1Get
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
^self cCoerce: workBuffer + GWPoint1 to:'int *'!
Item was changed:
----- Method: BalloonEngineBase>>point2Get (in category 'accessing state') -----
point2Get
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
^self cCoerce: workBuffer + GWPoint2 to:'int *'!
Item was changed:
----- Method: BalloonEngineBase>>point3Get (in category 'accessing state') -----
point3Get
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
^self cCoerce: workBuffer + GWPoint3 to:'int *'!
Item was changed:
----- Method: BalloonEngineBase>>point4Get (in category 'accessing state') -----
point4Get
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
^self cCoerce: workBuffer + GWPoint4 to:'int *'!
Item was changed:
----- Method: BalloonEngineBase>>primitiveAbortProcessing (in category 'primitives-other') -----
primitiveAbortProcessing
<export: true>
<inline: false>
+ | failureCode |
interpreterProxy methodArgumentCount = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
self statePut: GEStateCompleted.
self storeEngineStateInto: engine.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveAddActiveEdgeEntry (in category 'primitives-incremental') -----
primitiveAddActiveEdgeEntry
"Note: No need to load either bitBlt or spanBuffer"
+ | failureCode edgeOop edge |
- | edgeOop edge |
<export: true>
<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].
- ifFalse:[^interpreterProxy primitiveFail].
- edgeOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateWaitingForEdge)
- ifFalse:[^interpreterProxy primitiveFail].
+ edgeOop := interpreterProxy stackObjectValue: 0.
+ interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
edge := self loadEdgeStateFrom: edgeOop.
+ edge = nil ifTrue:[^interpreterProxy primitiveFailFor: GEFEdgeDataTooSmall].
- interpreterProxy failed ifTrue:[^nil].
(self needAvailableSpace: 1)
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
- ifFalse:[^interpreterProxy primitiveFail].
(self edgeNumLinesOf: edge) > 0 ifTrue:[
self insertEdgeIntoAET: edge.
].
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
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)].
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveChangedActiveEdgeEntry (in category 'primitives-incremental') -----
primitiveChangedActiveEdgeEntry
"Note: No need to load either bitBlt or spanBuffer"
+ | failureCode edgeOop edge |
- | edgeOop edge |
<export: true>
<inline: false>
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
- edgeOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateWaitingChange)
- ifFalse:[^interpreterProxy primitiveFail].
+ (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].
- interpreterProxy failed ifTrue:[^nil].
(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)].
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveCopyBuffer (in category 'primitives-other') -----
primitiveCopyBuffer
+ | failCode buf1 buf2 diff src dst |
- | buf1 buf2 diff src dst |
<export: true>
<inline: false>
+ <var: #src type:'int * '>
+ <var: #dst type:'int * '>
- <var: #src type: 'int * '>
- <var: #dst type: 'int * '>
interpreterProxy methodArgumentCount = 2
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ buf2 := interpreterProxy stackValue: 0.
+ buf1 := interpreterProxy stackValue: 1.
- buf2 := interpreterProxy stackObjectValue: 0.
- buf1 := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
"Make sure the old buffer is properly initialized"
+ (failCode := self loadWorkBufferFrom: buf1) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failCode].
- (self loadWorkBufferFrom: buf1)
- ifFalse:[^interpreterProxy primitiveFail].
"Make sure the buffers are of the same type"
(interpreterProxy fetchClassOf: buf1) = (interpreterProxy fetchClassOf: buf2)
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFClassMismatch].
- ifFalse:[^interpreterProxy primitiveFail].
"Make sure buf2 is at least of the size of buf1"
diff := (interpreterProxy slotSizeOf: buf2) - (interpreterProxy slotSizeOf: buf1).
+ diff < 0 ifTrue:[^interpreterProxy primitiveFailFor: GEFSizeMismatch].
- diff < 0 ifTrue:[^interpreterProxy primitiveFail].
"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].
- (self loadWorkBufferFrom: buf2)
- ifFalse:[^interpreterProxy primitiveFail].
interpreterProxy pop: 2. "Leave rcvr on stack"
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveDisplaySpanBuffer (in category 'primitives-incremental') -----
primitiveDisplaySpanBuffer
"Note: Must load bitBlt and spanBuffer"
<export: true>
<inline: false>
+ | failureCode |
doProfileStats ifTrue:[geProfileTime := interpreterProxy ioMicroMSecs].
interpreterProxy methodArgumentCount = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)
+ requiredState: GEStateBlitBuffer) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateBlitBuffer)
- ifFalse:[^interpreterProxy primitiveFail].
"Load span buffer and bitBlt"
+ (failureCode := self loadSpanBufferFrom:
+ (interpreterProxy fetchPointer: BESpanIndex ofObject: engine)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self loadSpanBufferFrom:
- (interpreterProxy fetchPointer: BESpanIndex ofObject: engine))
- ifFalse:[^interpreterProxy primitiveFail].
(self loadBitBltFrom:
(interpreterProxy fetchPointer: BEBitBltIndex ofObject: engine))
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFBitBltLoadFailed].
- ifFalse:[^interpreterProxy primitiveFail].
(self currentYGet bitAnd: self aaScanMaskGet) = self aaScanMaskGet ifTrue:[
self displaySpanBufferAt: self currentYGet.
self postDisplayAction.
].
self finishedProcessing ifFalse:[
self aetStartPut: 0.
self currentYPut: self currentYGet + 1.
self statePut: GEStateUpdateEdges].
self storeEngineStateInto: engine.
doProfileStats ifTrue:[
self incrementStat: GWCountDisplaySpan by: 1.
self incrementStat: GWTimeDisplaySpan by: (interpreterProxy ioMicroMSecs - geProfileTime)].
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveFinishedProcessing (in category 'primitives-other') -----
primitiveFinishedProcessing
+ | finished failureCode |
- | finished |
<export: true>
<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].
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
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)].
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetAALevel (in category 'primitives-access') -----
primitiveGetAALevel
<export: true>
<inline: false>
+ | failureCode |
interpreterProxy methodArgumentCount = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
interpreterProxy pop: 1.
interpreterProxy pushInteger: self aaLevelGet.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetClipRect (in category 'primitives-access') -----
primitiveGetClipRect
+ | failureCode rectOop pointOop |
- | rectOop pointOop |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (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].
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy isPointers: rectOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: rectOop) < 2
- ifTrue:[^interpreterProxy primitiveFail].
-
interpreterProxy pushRemappableOop: rectOop.
pointOop := interpreterProxy makePointwithxValue: self clipMinXGet yValue: self clipMinYGet.
+ interpreterProxy storePointer: 0 ofObject: interpreterProxy topRemappableOop withValue: pointOop.
- rectOop := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: 0 ofObject: rectOop withValue: pointOop.
- interpreterProxy pushRemappableOop: rectOop.
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.
- interpreterProxy push: rectOop.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetCounts (in category 'primitives-access') -----
primitiveGetCounts
+ | failureCode statOop stats |
- | statOop stats |
<export: true>
<inline: false>
+ <var: #stats type:'int *'>
- <var: #stats type: 'int *'>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (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].
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy isWords: statOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: statOop) < 9
- ifTrue:[^interpreterProxy primitiveFail].
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>
<inline: false>
+ | failureCode |
interpreterProxy methodArgumentCount = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
interpreterProxy pop: 1.
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>
<inline: false>
+ | failCode |
interpreterProxy methodArgumentCount = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ engine := interpreterProxy stackValue: 0.
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
"Note -- don't call loadEngineFrom here because this will override the stopReason with Zero"
+ (interpreterProxy isIntegerObject: 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 isIntegerObject: engine) ifTrue:[^false].
- (interpreterProxy isPointers: engine) ifFalse:[^false].
- (interpreterProxy slotSizeOf: engine) < BEBalloonEngineSize ifTrue:[^false].
- (self loadWorkBufferFrom:
- (interpreterProxy fetchPointer: BEWorkBufferIndex ofObject: engine))
- ifFalse:[^interpreterProxy primitiveFail].
interpreterProxy pop: 1.
interpreterProxy pushInteger: self stopReasonGet.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetOffset (in category 'primitives-access') -----
primitiveGetOffset
+ | failureCode pointOop |
- | pointOop |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
pointOop := interpreterProxy makePointwithxValue: self destOffsetXGet yValue: self destOffsetYGet.
+ interpreterProxy pop: 1 thenPush: pointOop.!
- interpreterProxy pop: 1.
- interpreterProxy push: pointOop.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveGetTimes (in category 'primitives-access') -----
primitiveGetTimes
+ | failureCode statOop stats |
- | statOop stats |
<export: true>
<inline: false>
+ <var: #stats type:'int *'>
- <var: #stats type: 'int *'>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (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].
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy isWords: statOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: statOop) < 9
- ifTrue:[^interpreterProxy primitiveFail].
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>>primitiveInitializeProcessing (in category 'primitives-incremental') -----
primitiveInitializeProcessing
"Note: No need to load bitBlt but must load spanBuffer"
<export: true>
<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].
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"Load span buffer for clear operation"
+ (failureCode := self loadSpanBufferFrom:
+ (interpreterProxy fetchPointer: BESpanIndex ofObject: engine)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self loadSpanBufferFrom:
- (interpreterProxy fetchPointer: BESpanIndex ofObject: engine))
- ifFalse:[^interpreterProxy primitiveFail].
self initializeGETProcessing.
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
self statePut: GEStateAddingFromGET. "Initialized"
interpreterProxy failed ifFalse:[self storeEngineStateInto: engine].
doProfileStats ifTrue:[
self incrementStat: GWCountInitializing by: 1.
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"
+ | failureCode fillOop bitsOop value |
- | fillOop bitsOop value |
<export: true>
<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].
+
- ifFalse:[^interpreterProxy primitiveFail].
fillOop := interpreterProxy stackObjectValue: 0.
bitsOop := interpreterProxy stackObjectValue: 1.
- engine := interpreterProxy stackObjectValue: 2.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateWaitingForFill)
- ifFalse:[^interpreterProxy primitiveFail].
- "Load span buffer for merging the fill"
- (self loadSpanBufferFrom:
- (interpreterProxy fetchPointer: BESpanIndex ofObject: engine))
- ifFalse:[^interpreterProxy primitiveFail].
"Check bitmap"
+ (interpreterProxy failed not
+ and: [(interpreterProxy fetchClassOf: bitsOop) = interpreterProxy classBitmap])
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- (interpreterProxy fetchClassOf: bitsOop) = interpreterProxy classBitmap
- ifFalse:[^interpreterProxy primitiveFail].
"Check fillOop"
(interpreterProxy slotSizeOf: fillOop) < FTBalloonFillDataSize
+ ifTrue:[^interpreterProxy primitiveFailFor: GEFFillDataTooSmall].
- ifTrue:[^interpreterProxy primitiveFail].
"Check if this was the fill we have exported"
value := interpreterProxy fetchInteger: FTIndexIndex ofObject: fillOop.
(self objectIndexOf: self lastExportedFillGet) = value
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
value := interpreterProxy fetchInteger: FTMinXIndex ofObject: fillOop.
self lastExportedLeftXGet = value
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
value := interpreterProxy fetchInteger: FTMaxXIndex ofObject: fillOop.
self lastExportedRightXGet = value
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy slotSizeOf: bitsOop) < (self lastExportedRightXGet - self lastExportedLeftXGet)
+ ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- ifTrue:[^interpreterProxy primitiveFail].
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)].
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveNeedsFlush (in category 'primitives-access') -----
primitiveNeedsFlush
+ | failureCode needFlush |
- | needFlush |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 0)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- ifFalse:[^interpreterProxy primitiveFail].
- engine := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
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
+ | failureCode needFlush |
- | needFlush |
<export: true>
<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].
- ifFalse:[^interpreterProxy primitiveFail].
- needFlush := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- needFlush := interpreterProxy booleanValueOf: needFlush.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
needFlush == true
ifTrue:[self needsFlushPut: 1]
ifFalse:[self needsFlushPut: 0].
self storeEngineStateInto: engine.
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"
+ | failureCode edgeOop hasEdge edge |
- | edgeOop hasEdge edge |
<export: true>
<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].
- ifFalse:[^interpreterProxy primitiveFail].
- edgeOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUpdateEdges or: GEStateCompleted)
- ifFalse:[^interpreterProxy primitiveFail].
+ 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)].
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveNextFillEntry (in category 'primitives-incremental') -----
primitiveNextFillEntry
"Note: No need to load bitBlt but must load spanBuffer"
+ | failureCode fillOop hasFill |
- | fillOop hasFill |
<export: true>
<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].
- ifFalse:[^interpreterProxy primitiveFail].
- fillOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateScanningAET)
- ifFalse:[^interpreterProxy primitiveFail].
"Load span buffer for internal handling of fills"
+ (failureCode := self loadSpanBufferFrom:
+ (interpreterProxy fetchPointer: BESpanIndex ofObject: engine)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self loadSpanBufferFrom:
- (interpreterProxy fetchPointer: BESpanIndex ofObject: engine))
- ifFalse:[^interpreterProxy primitiveFail].
(self loadFormsFrom:
(interpreterProxy fetchPointer: BEFormsIndex ofObject: engine))
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFFormLoadFailed].
- ifFalse:[^interpreterProxy primitiveFail].
"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].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
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)]!
- interpreterProxy failed ifFalse:[
- 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"
+ | failureCode edgeOop hasEdge edge |
- | edgeOop hasEdge edge |
<export: true>
<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].
- ifFalse:[^interpreterProxy primitiveFail].
- edgeOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateAddingFromGET)
- ifFalse:[^interpreterProxy primitiveFail].
+ 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].
- interpreterProxy failed ifTrue:[^nil].
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)].
!
Item was changed:
----- Method: BalloonEngineBase>>primitiveRegisterExternalEdge (in category 'primitives-other') -----
primitiveRegisterExternalEdge
+ | failureCode rightFillIndex leftFillIndex initialZ initialY initialX index edge |
- | rightFillIndex leftFillIndex initialZ initialY initialX index edge |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 6
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 6)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
+
- ifFalse:[^interpreterProxy primitiveFail].
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].
- engine := interpreterProxy stackObjectValue: 6.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
(self allocateObjEntry: GEBaseEdgeSize)
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
- ifFalse:[^interpreterProxy primitiveFail].
"Make sure the fills are okay"
+ ((self isFillOkay: leftFillIndex)
+ and: [self isFillOkay: rightFillIndex])
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- (self isFillOkay: leftFillIndex)
- ifFalse:[^interpreterProxy primitiveFail].
- (self isFillOkay: rightFillIndex)
- ifFalse:[^interpreterProxy primitiveFail].
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].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
interpreterProxy failed ifFalse:[
self storeEngineStateInto: engine.
interpreterProxy pop: 6. "Leave rcvr on stack"
].!
Item was changed:
----- Method: BalloonEngineBase>>primitiveRegisterExternalFill (in category 'primitives-other') -----
primitiveRegisterExternalFill
+ | failureCode index fill |
- | index fill |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
+
- ifFalse:[^interpreterProxy primitiveFail].
index := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"Note: We *must* not allocate any fill with index 0"
fill := 0.
[fill = 0] whileTrue:[
(self allocateObjEntry: GEBaseEdgeSize)
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig].
- ifFalse:[^interpreterProxy primitiveFail].
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>>primitiveRenderImage (in category 'primitives-rendering') -----
primitiveRenderImage
"Start/Proceed rendering the entire image"
<export: true>
<inline: false>
+ | failCode |
+ (failCode := self loadRenderingState) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failCode].
- self loadRenderingState ifFalse:[^interpreterProxy primitiveFail].
-
self proceedRenderingScanline. "Finish this scan line"
engineStopped ifTrue:[^self storeRenderingState].
self proceedRenderingImage. "And go on as usual"
self storeRenderingState.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveRenderScanline (in category 'primitives-rendering') -----
primitiveRenderScanline
"Start rendering the entire image"
<export: true>
<inline: false>
+ | failCode |
+ (failCode := self loadRenderingState) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failCode].
- self loadRenderingState ifFalse:[^interpreterProxy primitiveFail].
-
self proceedRenderingScanline. "Finish the current scan line"
self storeRenderingState.!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetAALevel (in category 'primitives-access') -----
primitiveSetAALevel
+ | failureCode level |
- | level |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- ifFalse:[^interpreterProxy primitiveFail].
level := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed
+ ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
self setAALevel: level.
self storeEngineStateInto: engine.
+ interpreterProxy pop: 1. "Leave rcvr on stack"!
- interpreterProxy pop: 1. "Leace rcvr on stack"!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetBitBltPlugin (in category 'primitives-access') -----
primitiveSetBitBltPlugin
"Primitive. Set the BitBlt plugin to use."
| pluginName length ptr needReload |
<export: true>
+ <var: #ptr type:'char *'>
- <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
+ | failureCode rectOop |
- | rectOop |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- rectOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
+ rectOop := interpreterProxy stackObjectValue: 0.
+ (interpreterProxy failed not
+ and: [(interpreterProxy isPointers: rectOop)
+ and: [(interpreterProxy slotSizeOf: rectOop) >= 2]])
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- (interpreterProxy isPointers: rectOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: rectOop) < 2
- ifTrue:[^interpreterProxy primitiveFail].
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"!
- interpreterProxy failed ifFalse:[
- 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
+ | failureCode transformOop |
- | transformOop |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- transformOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
+ 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"!
- interpreterProxy failed ifFalse:[
- self storeEngineStateInto: engine.
- interpreterProxy pop: 1. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetDepth (in category 'primitives-access') -----
primitiveSetDepth
+ | failureCode depth |
- | depth |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- depth := interpreterProxy stackIntegerValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
+ depth := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed
+ ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
self currentZPut: depth.
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 1. "Leave rcvr on stack"!
- interpreterProxy failed ifFalse:[
- self storeEngineStateInto: engine.
- interpreterProxy pop: 1. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetEdgeTransform (in category 'primitives-access') -----
primitiveSetEdgeTransform
+ | failureCode transformOop |
- | transformOop |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- transformOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
+ 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"!
- interpreterProxy failed ifFalse:[
- self storeEngineStateInto: engine.
- interpreterProxy pop: 1. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEngineBase>>primitiveSetOffset (in category 'primitives-access') -----
primitiveSetOffset
+ | failureCode pointOop |
- | pointOop |
<export: true>
<inline: false>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
+
+ pointOop := interpreterProxy stackValue: 0.
- pointOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy fetchClassOf: pointOop) = interpreterProxy classPoint
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- ifFalse:[^interpreterProxy primitiveFail].
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"!
- interpreterProxy failed ifFalse:[
- 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: BalloonEngineBase>>quickLoadEngineFrom: (in category 'loading state') -----
quickLoadEngineFrom: engineOop
+ "Load the minimal required state from the engineOop, e.g., just the work buffer.
+ Answer 0 on success or non-zero a failure code on failure"
- "Load the minimal required state from the engineOop, e.g., just the work buffer."
<inline: false>
+ | failCode |
+ interpreterProxy failed ifTrue:[^GEFAlreadyFailed].
+ (interpreterProxy isIntegerObject: engineOop) ifTrue:[^GEFEngineIsInteger].
+ (interpreterProxy isPointers: engineOop) ifFalse:[^GEFEngineIsWords].
+ (interpreterProxy slotSizeOf: engineOop) < BEBalloonEngineSize ifTrue:[^GEFEngineTooSmall].
- interpreterProxy failed ifTrue:[^false].
- (interpreterProxy isIntegerObject: engineOop) ifTrue:[^false].
- (interpreterProxy isPointers: engineOop) ifFalse:[^false].
- (interpreterProxy slotSizeOf: engineOop) < BEBalloonEngineSize ifTrue:[^false].
engine := engineOop.
+ (failCode := self loadWorkBufferFrom: (interpreterProxy
+ fetchPointer: BEWorkBufferIndex
+ ofObject: engineOop)) = 0
+ ifFalse: [^failCode].
- (self loadWorkBufferFrom:
- (interpreterProxy fetchPointer: BEWorkBufferIndex ofObject: engineOop))
- ifFalse:[^false].
self stopReasonPut: 0.
objUsed := self objUsedGet.
engineStopped := false.
+ ^0!
- ^true!
Item was changed:
----- Method: BalloonEngineBase>>quickLoadEngineFrom:requiredState: (in category 'loading state') -----
quickLoadEngineFrom: oop requiredState: requiredState
<inline: false>
+ | failureCode |
+ (failureCode := self quickLoadEngineFrom: oop) = 0 ifFalse:[^failureCode].
+ self stateGet = requiredState ifTrue:[^0].
- (self quickLoadEngineFrom: oop) ifFalse:[^false].
- self stateGet = requiredState ifTrue:[^true].
self stopReasonPut: GErrorBadState.
+ ^GEFWrongState!
- ^false!
Item was changed:
----- Method: BalloonEngineBase>>quickLoadEngineFrom:requiredState:or: (in category 'loading state') -----
quickLoadEngineFrom: oop requiredState: requiredState or: alternativeState
<inline: false>
+ | failureCode |
+ (failureCode := self quickLoadEngineFrom: oop) = 0 ifFalse:[^failureCode].
+ self stateGet = requiredState ifTrue:[^0].
+ self stateGet = alternativeState ifTrue:[^0].
- (self quickLoadEngineFrom: oop) ifFalse:[^false].
- self stateGet = requiredState ifTrue:[^true].
- self stateGet = alternativeState ifTrue:[^true].
self stopReasonPut: GErrorBadState.
+ ^GEFWrongState!
- ^false!
Item was changed:
----- Method: BalloonEngineBase>>quickSortGlobalEdgeTable:from:to: (in category 'GET processing') -----
quickSortGlobalEdgeTable: array from: i to: j
"Sort elements i through j of self to be nondescending according to
sortBlock."
"Note: The original loop has been heavily re-written for C translation"
| di dij dj tt ij k l n tmp again before |
+ <var: #array type:'int *'>
- <var: #array type: 'int *'>
<inline: false>
"The prefix d means the data at that index."
(n := j + 1 - i) <= 1 ifTrue: [^0]. "Nothing to sort."
"Sort di,dj."
di := array at: i.
dj := array at: j.
before := self getSorts: di before: dj. "i.e., should di precede dj?"
before ifFalse:[
tmp := array at: i.
array at: i put: (array at: j).
array at: j put: tmp.
tt := di. di := dj. dj := tt].
n <= 2 ifTrue:[^0].
"More than two elements."
ij := (i + j) // 2. "ij is the midpoint of i and j."
dij := array at: ij. "Sort di,dij,dj. Make dij be their median."
before := (self getSorts: di before: dij). "i.e. should di precede dij?"
before ifTrue:[
before := (self getSorts: dij before: dj). "i.e., should dij precede dj?"
before ifFalse:["i.e., should dij precede dj?"
tmp := array at: j.
array at: j put: (array at: ij).
array at: ij put: tmp.
dij := dj]
] ifFalse:[ "i.e. di should come after dij"
tmp := array at: i.
array at: i put: (array at: ij).
array at: ij put: tmp.
dij := di].
n <= 3 ifTrue:[^0].
"More than three elements."
"Find k>i and l<j such that dk,dij,dl are in reverse order.
Swap k and l. Repeat this procedure until k and l pass each other."
k := i.
l := j.
again := true.
[again] whileTrue:[
before := true.
[before] whileTrue:[
k <= (l := l - 1)
ifTrue:[ tmp := array at: l.
before := self getSorts: dij before: tmp]
ifFalse:[before := false].
].
before := true.
[before] whileTrue:[
(k := k + 1) <= l
ifTrue:[ tmp := array at: k.
before := self getSorts: tmp before: dij]
ifFalse:[before := false]].
again := k <= l.
again ifTrue:[
tmp := array at: k.
array at: k put: (array at: l).
array at: l put: tmp]].
"Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk
through dj. Sort those two segments."
self quickSortGlobalEdgeTable: array from: i to: l.
self quickSortGlobalEdgeTable: array from: k to: j.!
Item was changed:
----- Method: BalloonEngineBase>>smallSqrtTable (in category 'other') -----
smallSqrtTable
| theTable |
<inline: false>
+ <returnTypeC:'int *'>
+ <var: #theTable declareC:'static int theTable[32] =
- <returnTypeC: 'int *'>
- <var: #theTable declareC: 'static int theTable[32] =
{0, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6}'>
^theTable!
Item was changed:
----- Method: BalloonEngineBase>>transformColor: (in category 'transforming') -----
transformColor: fillIndex
| r g b a transform alphaScale |
+ <var: #transform type:'float *'>
+ <var: #alphaScale type:'double '>
- <var: #transform type: 'float *'>
- <var: #alphaScale type: 'double '>
(fillIndex = 0 or:[self isFillColor: fillIndex]) ifFalse:[^fillIndex].
b := fillIndex bitAnd: 255.
g := (fillIndex >> 8) bitAnd: 255.
r := (fillIndex >> 16) bitAnd: 255.
a := (fillIndex >> 24) bitAnd: 255.
(self hasColorTransform) ifTrue:[
transform := self colorTransform.
alphaScale := (a * (transform at: 6) + (transform at: 7)) / a.
r := (r * (transform at: 0) + (transform at: 1) * alphaScale) asInteger.
g := (g * (transform at: 2) + (transform at: 3) * alphaScale) asInteger.
b := (b * (transform at: 4) + (transform at: 5) * alphaScale) asInteger.
a := a * alphaScale.
r := r max: 0. r := r min: 255.
g := g max: 0. g := g min: 255.
b := b max: 0. b := b min: 255.
a := a max: 0. a := a min: 255.
].
a < 1 ifTrue:[^0]."ALWAYS return zero for transparent fills"
"If alpha is not 255 (or close thereto) then we need to flush the engine before proceeding"
(a < 255 and:[self needsFlush])
ifTrue:[self stopBecauseOf: GErrorNeedFlush].
^b + (g << 8) + (r << 16) + (a << 24)!
Item was changed:
----- Method: BalloonEngineBase>>transformPoint: (in category 'transforming') -----
transformPoint: point
"Transform the given point. If haveMatrix is true then use the current transformation."
+ <var:#point type:'int *'>
- <var: #point type: 'int *'>
self hasEdgeTransform ifFalse:[
"Multiply each component by aaLevel and add a half pixel"
point at: 0 put: (point at: 0) + self destOffsetXGet * self aaLevelGet.
point at: 1 put: (point at: 1) + self destOffsetYGet * self aaLevelGet.
] ifTrue:[
"Note: AA adjustment is done in #transformPoint: for higher accuracy"
self transformPoint: point into: point.
].!
Item was changed:
----- Method: BalloonEngineBase>>transformPointX:y:into: (in category 'transforming') -----
transformPointX: xValue y: yValue into: dstPoint
"Transform srcPoint into dstPoint by using the currently loaded matrix"
"Note: This should be rewritten so that inlining works (e.g., removing
the declarations and adding argument coercions at the appropriate points)"
| x y transform |
<inline: true>
+ <var: #dstPoint type:'int *'>
- <var: #dstPoint type: 'int *'>
<var: #xValue type: 'double '>
<var: #yValue type: 'double '>
+ <var: #transform type:'float *'>
- <var: #transform type: 'float *'>
transform := self edgeTransform.
x := ((((transform at: 0) * xValue) +
((transform at: 1) * yValue) +
(transform at: 2)) * self aaLevelGet asFloat) asInteger.
y := ((((transform at: 3) * xValue) +
((transform at: 4) * yValue) +
(transform at: 5)) * self aaLevelGet asFloat) asInteger.
dstPoint at: 0 put: x.
dstPoint at: 1 put: y.!
Item was changed:
----- Method: BalloonEngineBase>>transformWidth: (in category 'transforming') -----
transformWidth: w
"Transform the given width"
| deltaX deltaY dstWidth dstWidth2 |
<inline: false>
+ <var: #deltaX type:'double '>
+ <var: #deltaY type:'double '>
- <var: #deltaX type: 'double '>
- <var: #deltaY type: 'double '>
w = 0 ifTrue:[^0].
self point1Get at: 0 put: 0.
self point1Get at: 1 put: 0.
self point2Get at: 0 put: w * 256.
self point2Get at: 1 put: 0.
self point3Get at: 0 put: 0.
self point3Get at: 1 put: w * 256.
self transformPoints: 3.
deltaX := ((self point2Get at: 0) - (self point1Get at: 0)) asFloat.
deltaY := ((self point2Get at: 1) - (self point1Get at: 1)) asFloat.
dstWidth := (((deltaX * deltaX) + (deltaY * deltaY)) sqrt asInteger + 128) // 256.
deltaX := ((self point3Get at: 0) - (self point1Get at: 0)) asFloat.
deltaY := ((self point3Get at: 1) - (self point1Get at: 1)) asFloat.
dstWidth2 := (((deltaX * deltaX) + (deltaY * deltaY)) sqrt asInteger + 128) // 256.
dstWidth2 < dstWidth ifTrue:[dstWidth := dstWidth2].
dstWidth = 0
ifTrue:[^1]
ifFalse:[^dstWidth]!
Item was changed:
----- Method: BalloonEngineBase>>uncheckedTransformColor: (in category 'transforming') -----
uncheckedTransformColor: fillIndex
| r g b a transform |
+ <var: #transform type:'float *'>
- <var: #transform type: 'float *'>
(self hasColorTransform) ifFalse:[^fillIndex].
b := fillIndex bitAnd: 255.
g := (fillIndex >> 8) bitAnd: 255.
r := (fillIndex >> 16) bitAnd: 255.
a := (fillIndex >> 24) bitAnd: 255.
transform := self colorTransform.
r := (r * (transform at: 0) + (transform at: 1)) asInteger.
g := (g * (transform at: 2) + (transform at: 3)) asInteger.
b := (b * (transform at: 4) + (transform at: 5)) asInteger.
a := (a * (transform at: 6) + (transform at: 7)) asInteger.
r := r max: 0. r := r min: 255.
g := g max: 0. g := g min: 255.
b := b max: 0. b := b min: 255.
a := a max: 0. a := a min: 255.
a < 16 ifTrue:[^0]."ALWAYS return zero for transparent fills"
^b + (g << 8) + (r << 16) + (a << 24)!
Item was changed:
----- Method: BalloonEnginePlugin>>allocateBitmapFill:colormap: (in category 'allocation') -----
allocateBitmapFill: cmSize colormap: cmBits
| fill fillSize cm |
+ <var:#cm type:'int *'>
+ <var:#cmBits type:'int *'>
- <var: #cm type: 'int *'>
- <var: #cmBits type: 'int *'>
fillSize := GBMBaseSize + cmSize.
(self allocateObjEntry: fillSize) ifFalse:[^0].
fill := objUsed.
objUsed := fill + fillSize.
self objectTypeOf: fill put: GEPrimitiveClippedBitmapFill.
self objectIndexOf: fill put: 0.
self objectLengthOf: fill put: fillSize.
cm := self colormapOf: fill.
self hasColorTransform ifTrue:[
0 to: cmSize-1 do:[:i| cm at: i put: (self transformColor: (cmBits at: i))].
] ifFalse:[
0 to: cmSize-1 do:[:i| cm at: i put: (cmBits at: i)].
].
self bitmapCmSizeOf: fill put: cmSize.
^fill!
Item was changed:
----- Method: BalloonEnginePlugin>>allocateGradientFill:rampWidth:isRadial: (in category 'allocation') -----
allocateGradientFill: ramp rampWidth: rampWidth isRadial: isRadial
| fill fillSize rampPtr |
+ <var:#ramp type:'int *'>
+ <var:#rampPtr type:'int *'>
- <var: #ramp type: 'int *'>
- <var: #rampPtr type: 'int *'>
fillSize := GGBaseSize + rampWidth.
(self allocateObjEntry: fillSize) ifFalse:[^0].
fill := objUsed.
objUsed := fill + fillSize.
isRadial
ifTrue:[self objectTypeOf: fill put: GEPrimitiveRadialGradientFill]
ifFalse:[self objectTypeOf: fill put: GEPrimitiveLinearGradientFill].
self objectIndexOf: fill put: 0.
self objectLengthOf: fill put: fillSize.
rampPtr := self gradientRampOf: fill.
self hasColorTransform ifTrue:[
0 to: rampWidth-1 do:[:i| rampPtr at: i put: (self transformColor: (ramp at: i))].
] ifFalse:[
0 to: rampWidth-1 do:[:i| rampPtr at: i put: (ramp at: i)].
].
self gradientRampLengthOf: fill put: rampWidth.
^fill!
Item was changed:
----- Method: BalloonEnginePlugin>>checkCompressedFillIndexList:max:segments: (in category 'shapes-compressed') -----
checkCompressedFillIndexList: fillList max: maxIndex segments: nSegs
"Check the fill indexes in the run-length encoded fillList"
| length runLength runValue nFills fillPtr |
<inline: false>
+ <var: #fillPtr type:'int *'>
- <var: #fillPtr type: 'int *'>
length := interpreterProxy slotSizeOf: fillList.
fillPtr := interpreterProxy firstIndexableField: fillList.
nFills := 0.
0 to: length-1 do:[:i |
runLength := self shortRunLengthAt: i from: fillPtr.
runValue := self shortRunValueAt: i from: fillPtr.
(runValue >= 0 and:[runValue <= maxIndex]) ifFalse:[^false].
nFills := nFills + runLength.
].
^nFills = nSegs!
Item was changed:
----- Method: BalloonEnginePlugin>>checkCompressedFills: (in category 'shapes-compressed') -----
checkCompressedFills: indexList
"Check if the indexList (containing fill handles) is okay."
| fillPtr length fillIndex |
<inline: false>
+ <var: #fillPtr type:'int *'>
- <var: #fillPtr type: 'int *'>
"First check if the oops have the right format"
(interpreterProxy isWords: indexList) ifFalse:[^false].
"Then check the fill entries"
length := interpreterProxy slotSizeOf: indexList.
fillPtr := interpreterProxy firstIndexableField: indexList.
0 to: length-1 do:[:i |
fillIndex := fillPtr at: i.
"Make sure the fill is okay"
(self isFillOkay: fillIndex) ifFalse:[^false]].
^ true!
Item was changed:
----- Method: BalloonEnginePlugin>>checkCompressedLineWidths:segments: (in category 'shapes-compressed') -----
checkCompressedLineWidths: lineWidthList segments: nSegments
"Check the run-length encoded lineWidthList matches nSegments"
| length runLength nItems ptr |
<inline: false>
+ <var: #ptr type:'int *'>
- <var: #ptr type: 'int *'>
length := interpreterProxy slotSizeOf: lineWidthList.
ptr := interpreterProxy firstIndexableField: lineWidthList.
nItems := 0.
0 to: length-1 do:[:i|
runLength := self shortRunLengthAt: i from: ptr.
nItems := nItems + runLength.
].
^nItems = nSegments!
Item was changed:
----- Method: BalloonEnginePlugin>>circleCosTable (in category 'private') -----
circleCosTable
| theTable |
+ <returnTypeC:'double *'>
- <returnTypeC: 'double *'>
<inline: false>
+ <var:#theTable declareC:'static double theTable[33] =
- <var: #theTable declareC: 'static double theTable[33] =
{1.0, 0.98078528040323, 0.923879532511287, 0.831469612302545,
0.7071067811865475, 0.555570233019602, 0.38268343236509, 0.1950903220161286,
0.0, -0.1950903220161283, -0.3826834323650896, -0.555570233019602,
-0.707106781186547, -0.831469612302545, -0.9238795325112865, -0.98078528040323,
-1.0, -0.98078528040323, -0.923879532511287, -0.831469612302545,
-0.707106781186548, -0.555570233019602, -0.3826834323650903, -0.1950903220161287,
0.0, 0.1950903220161282, 0.38268343236509, 0.555570233019602,
0.707106781186547, 0.831469612302545, 0.9238795325112865, 0.98078528040323,
1.0 }'>
^theTable!
Item was changed:
----- Method: BalloonEnginePlugin>>circleSinTable (in category 'private') -----
circleSinTable
| theTable |
+ <returnTypeC:'double *'>
- <returnTypeC: 'double *'>
<inline: false>
+ <var:#theTable declareC:'static double theTable[33] =
- <var: #theTable declareC: 'static double theTable[33] =
{0.0, 0.1950903220161282, 0.3826834323650897, 0.555570233019602,
0.707106781186547, 0.831469612302545, 0.923879532511287, 0.98078528040323,
1.0, 0.98078528040323, 0.923879532511287, 0.831469612302545,
0.7071067811865475, 0.555570233019602, 0.38268343236509, 0.1950903220161286,
0.0, -0.1950903220161283, -0.3826834323650896, -0.555570233019602,
-0.707106781186547, -0.831469612302545, -0.9238795325112865, -0.98078528040323,
-1.0, -0.98078528040323, -0.923879532511287, -0.831469612302545,
-0.707106781186548, -0.555570233019602, -0.3826834323650903, -0.1950903220161287,
0.0 }'>
^theTable!
Item was changed:
----- Method: BalloonEnginePlugin>>colormapOf: (in category 'accessing bitmaps') -----
colormapOf: bmFill
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
^objBuffer + bmFill + GBColormapOffset!
Item was changed:
----- Method: BalloonEnginePlugin>>computeBezier:splitAt: (in category 'bezier-loading') -----
computeBezier: index splitAt: param
"Split the bezier curve at the given parametric value.
Note: Since this method is only invoked to make non-monoton
beziers monoton we must check for the resulting y values
to be *really* between the start and end value."
| startX startY viaX viaY endX endY newIndex
leftViaX leftViaY rightViaX rightViaY sharedX sharedY |
<inline: false>
+ <var: #param type:'double '>
- <var: #param type: 'double '>
leftViaX := startX := self bzStartX: index.
leftViaY := startY := self bzStartY: index.
rightViaX := viaX := self bzViaX: index.
rightViaY := viaY := self bzViaY: index.
endX := self bzEndX: index.
endY := self bzEndY: index.
"Compute intermediate points"
sharedX := leftViaX := leftViaX + ((viaX - startX) asFloat * param) asInteger.
sharedY := leftViaY := leftViaY + ((viaY - startY) asFloat * param) asInteger.
rightViaX := rightViaX + ((endX - viaX) asFloat * param) asInteger.
rightViaY := rightViaY + ((endY - viaY) asFloat * param) asInteger.
"Compute new shared point"
sharedX := sharedX + ((rightViaX - leftViaX) asFloat * param) asInteger.
sharedY := sharedY + ((rightViaY - leftViaY) asFloat * param) asInteger.
"Check the new via points"
leftViaY := self assureValue: leftViaY between: startY and: sharedY.
rightViaY := self assureValue: rightViaY between: sharedY and: endY.
newIndex := self allocateBezierStackEntry.
engineStopped ifTrue:[^0]. "Something went wrong"
"Store the first part back"
self bzViaX: index put: leftViaX.
self bzViaY: index put: leftViaY.
self bzEndX: index put: sharedX.
self bzEndY: index put: sharedY.
"Store the second point back"
self bzStartX: newIndex put: sharedX.
self bzStartY: newIndex put: sharedY.
self bzViaX: newIndex put: rightViaX.
self bzViaY: newIndex put: rightViaY.
self bzEndX: newIndex put: endX.
self bzEndY: newIndex put: endY.
^newIndex!
Item was changed:
----- Method: BalloonEnginePlugin>>fillBitmapSpan:from:to:at: (in category 'fills-bitmaps') -----
fillBitmapSpan: bmFill from: leftX to: rightX at: yValue
| x x1 dsX ds dtX dt deltaX deltaY bits xp yp bmWidth bmHeight fillValue tileFlag |
<inline: false>
+ <var: #bits type:'int *'>
- <var: #bits type: 'int *'>
self aaLevelGet = 1
ifFalse:[^self fillBitmapSpanAA: bmFill from: leftX to: rightX at: yValue].
bits := self loadBitsFrom: bmFill.
bits == nil ifTrue:[^nil].
bmWidth := self bitmapWidthOf: bmFill.
bmHeight := self bitmapHeightOf: bmFill.
tileFlag := (self bitmapTileFlagOf: bmFill) = 1.
deltaX := leftX - (self fillOriginXOf: bmFill).
deltaY := yValue - (self fillOriginYOf: bmFill).
dsX := self fillDirectionXOf: bmFill.
dtX := self fillNormalXOf: bmFill.
ds := (deltaX * dsX) + (deltaY * (self fillDirectionYOf: bmFill)).
dt := (deltaX * dtX) + (deltaY * (self fillNormalYOf: bmFill)).
x := leftX.
x1 := rightX.
[x < x1] whileTrue:[
tileFlag ifTrue:[
ds := self repeatValue: ds max: bmWidth << 16.
dt := self repeatValue: dt max: bmHeight << 16].
xp := ds // 16r10000.
yp := dt // 16r10000.
tileFlag ifFalse:[
xp := self clampValue: xp max: bmWidth.
yp := self clampValue: yp max: bmHeight].
(xp >= 0 and:[yp >= 0 and:[xp < bmWidth and:[yp < bmHeight]]]) ifTrue:[
fillValue := self bitmapValue: bmFill bits: bits atX: xp y: yp.
spanBuffer at: x put: fillValue.
].
ds := ds + dsX.
dt := dt + dtX.
x := x + 1.
].!
Item was changed:
----- Method: BalloonEnginePlugin>>fillBitmapSpanAA:from:to:at: (in category 'fills-bitmaps') -----
fillBitmapSpanAA: bmFill from: leftX to: rightX at: yValue
| x dsX ds dtX dt deltaX deltaY bits xp yp bmWidth bmHeight fillValue baseShift cMask cShift idx aaLevel firstPixel lastPixel tileFlag |
<inline: false>
+ <var: #bits type:'int *'>
- <var: #bits type: 'int *'>
bits := self loadBitsFrom: bmFill.
bits == nil ifTrue:[^nil].
bmWidth := self bitmapWidthOf: bmFill.
bmHeight := self bitmapHeightOf: bmFill.
tileFlag := (self bitmapTileFlagOf: bmFill) = 1.
deltaX := leftX - (self fillOriginXOf: bmFill).
deltaY := yValue - (self fillOriginYOf: bmFill).
dsX := self fillDirectionXOf: bmFill.
dtX := self fillNormalXOf: bmFill.
ds := (deltaX * dsX) + (deltaY * (self fillDirectionYOf: bmFill)).
dt := (deltaX * dtX) + (deltaY * (self fillNormalYOf: bmFill)).
aaLevel := self aaLevelGet.
firstPixel := self aaFirstPixelFrom: leftX to: rightX.
lastPixel := self aaLastPixelFrom: leftX to: rightX.
baseShift := self aaShiftGet.
cMask := self aaColorMaskGet.
cShift := self aaColorShiftGet.
x := leftX.
[x < firstPixel] whileTrue:[
tileFlag ifTrue:[
ds := self repeatValue: ds max: bmWidth << 16.
dt := self repeatValue: dt max: bmHeight << 16].
xp := ds // 16r10000.
yp := dt // 16r10000.
tileFlag ifFalse:[
xp := self clampValue: xp max: bmWidth.
yp := self clampValue: yp max: bmHeight].
(xp >= 0 and:[yp >= 0 and:[xp < bmWidth and:[yp < bmHeight]]]) ifTrue:[
fillValue := self bitmapValue: bmFill bits: bits atX: xp y: yp.
fillValue := (fillValue bitAnd: cMask) >> cShift.
idx := x >> baseShift.
spanBuffer at: idx put: (spanBuffer at: idx) + fillValue.
].
ds := ds + dsX.
dt := dt + dtX.
x := x + 1.
].
cMask := (self aaColorMaskGet >> self aaShiftGet) bitOr: 16rF0F0F0F0.
cShift := self aaShiftGet.
[x < lastPixel] whileTrue:[
tileFlag ifTrue:[
ds := self repeatValue: ds max: bmWidth << 16.
dt := self repeatValue: dt max: bmHeight << 16].
xp := ds // 16r10000.
yp := dt // 16r10000.
tileFlag ifFalse:[
xp := self clampValue: xp max: bmWidth.
yp := self clampValue: yp max: bmHeight].
(xp >= 0 and:[yp >= 0 and:[xp < bmWidth and:[yp < bmHeight]]]) ifTrue:[
fillValue := self bitmapValue: bmFill bits: bits atX: xp y: yp.
fillValue := (fillValue bitAnd: cMask) >> cShift.
idx := x >> baseShift.
spanBuffer at: idx put: (spanBuffer at: idx) + fillValue.
].
ds := ds + (dsX << cShift).
dt := dt + (dtX << cShift).
x := x + aaLevel.
].
cMask := self aaColorMaskGet.
cShift := self aaColorShiftGet.
[x < rightX] whileTrue:[
tileFlag ifTrue:[
ds := self repeatValue: ds max: bmWidth << 16.
dt := self repeatValue: dt max: bmHeight << 16].
xp := ds // 16r10000.
yp := dt // 16r10000.
tileFlag ifFalse:[
xp := self clampValue: xp max: bmWidth.
yp := self clampValue: yp max: bmHeight].
(xp >= 0 and:[yp >= 0 and:[xp < bmWidth and:[yp < bmHeight]]]) ifTrue:[
fillValue := self bitmapValue: bmFill bits: bits atX: xp y: yp.
fillValue := (fillValue bitAnd: cMask) >> cShift.
idx := x >> baseShift.
spanBuffer at: idx put: (spanBuffer at: idx) + fillValue.
].
ds := ds + dsX.
dt := dt + dtX.
x := x + 1.
].
!
Item was changed:
----- Method: BalloonEnginePlugin>>fillLinearGradient:from:to:at: (in category 'fills-gradient') -----
fillLinearGradient: fill from: leftX to: rightX at: yValue
"Draw a linear gradient fill."
| x0 x1 ramp rampSize dsX ds x rampIndex |
<inline: false>
+ <var: #ramp type:'int *'>
- <var: #ramp type: 'int *'>
ramp := self gradientRampOf: fill.
rampSize := self gradientRampLengthOf: fill.
dsX := self fillDirectionXOf: fill.
ds := ((leftX - (self fillOriginXOf: fill)) * dsX) +
((yValue - (self fillOriginYOf: fill)) * (self fillDirectionYOf: fill)).
x := x0 := leftX.
x1 := rightX.
"Note: The inner loop has been divided into three parts for speed"
"Part one: Fill everything outside the left boundary"
[((rampIndex := ds // 16r10000) < 0 or:[rampIndex >= rampSize]) and:[x < x1]]
whileTrue:[ x := x + 1.
ds := ds + dsX].
x > x0 ifTrue:[
rampIndex < 0 ifTrue:[rampIndex := 0].
rampIndex >= rampSize ifTrue:[rampIndex := rampSize - 1].
self fillColorSpan: (self makeUnsignedFrom: (ramp at: rampIndex)) from: x0 to: x].
"Part two: Fill everything inside the boundaries"
self aaLevelGet = 1 ifTrue:[
"Fast version w/o anti-aliasing"
[((rampIndex := ds // 16r10000) < rampSize and:[rampIndex >= 0]) and:[x < x1]] whileTrue:[
spanBuffer at: x put: (self makeUnsignedFrom: (ramp at: rampIndex)).
x := x + 1.
ds := ds + dsX.
].
] ifFalse:[x := self fillLinearGradientAA: fill ramp: ramp ds: ds dsX: dsX from: x to: rightX].
"Part three fill everything outside right boundary"
x < x1 ifTrue:[
rampIndex < 0 ifTrue:[rampIndex := 0].
rampIndex >= rampSize ifTrue:[rampIndex := rampSize-1].
self fillColorSpan: (self makeUnsignedFrom: (ramp at: rampIndex)) from: x to: x1].
!
Item was changed:
----- Method: BalloonEnginePlugin>>fillLinearGradientAA:ramp:ds:dsX:from:to: (in category 'fills-gradient') -----
fillLinearGradientAA: fill ramp: ramp ds: deltaS dsX: dsX from: leftX to: rightX
"This is the AA version of linear gradient filling."
| colorMask colorShift baseShift rampIndex ds rampSize x idx rampValue
aaLevel firstPixel lastPixel |
<inline: false>
+ <var: #ramp type:'int *'>
- <var: #ramp type: 'int *'>
aaLevel := self aaLevelGet.
baseShift := self aaShiftGet.
rampSize := self gradientRampLengthOf: fill.
ds := deltaS.
x := leftX.
rampIndex := ds // 16r10000.
firstPixel := self aaFirstPixelFrom: leftX to: rightX.
lastPixel := self aaLastPixelFrom: leftX to: rightX.
"Deal with the first n sub-pixels"
colorMask := self aaColorMaskGet.
colorShift := self aaColorShiftGet.
[x < firstPixel and:[rampIndex < rampSize and:[rampIndex >= 0]]] whileTrue:[
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
"Copy as many pixels as possible"
[x < firstPixel and:[(ds//16r10000) = rampIndex]] whileTrue:[
idx := x >> baseShift.
spanBuffer at: idx put: (spanBuffer at: idx) + rampValue.
x := x + 1.
ds := ds + dsX].
rampIndex := ds // 16r10000.
].
"Deal with the full pixels"
colorMask := (self aaColorMaskGet >> self aaShiftGet) bitOr: 16rF0F0F0F0.
colorShift := self aaShiftGet.
[x < lastPixel and:[rampIndex < rampSize and:[rampIndex >= 0]]] whileTrue:[
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
"Copy as many pixels as possible"
[x < lastPixel and:[(ds//16r10000) = rampIndex]] whileTrue:[
idx := x >> baseShift.
spanBuffer at: idx put: (spanBuffer at: idx) + rampValue.
x := x + aaLevel.
ds := ds + (dsX << colorShift)].
rampIndex := ds // 16r10000.
].
"Deal with the last n sub-pixels"
colorMask := self aaColorMaskGet.
colorShift := self aaColorShiftGet.
[x < rightX and:[rampIndex < rampSize and:[rampIndex>=0]]] whileTrue:[
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
"Copy as many pixels as possible"
[x < rightX and:[(ds//16r10000) = rampIndex]] whileTrue:[
idx := x >> baseShift.
spanBuffer at: idx put: (spanBuffer at: idx) + rampValue.
x := x + 1.
ds := ds + dsX].
rampIndex := ds // 16r10000.
].
^x!
Item was changed:
----- Method: BalloonEnginePlugin>>fillRadialDecreasingAA:ramp:deltaST:dsX:dtX:from:to: (in category 'fills-gradient') -----
fillRadialDecreasingAA: fill ramp: ramp deltaST: deltaST dsX: dsX dtX: dtX from: leftX to: rightX
"Part 2a) Compute the decreasing part of the ramp"
| ds dt rampIndex rampValue length2 x nextLength x1
aaLevel colorMask colorShift baseShift index firstPixel lastPixel |
<inline: false>
+ <var: #ramp type:'int *'>
+ <var: #deltaST type:' int *'>
- <var: #ramp type: 'int *'>
- <var: #deltaST type: ' int *'>
ds := (self cCoerce: deltaST to:'int*') at: 0.
dt := (self cCoerce: deltaST to:'int*') at: 1.
aaLevel := self aaLevelGet.
baseShift := self aaShiftGet.
rampIndex := self accurateLengthOf: ds // 16r10000 with: dt // 16r10000.
length2 := (rampIndex-1) * (rampIndex-1).
x := leftX.
x1 := self fillOriginXOf: fill.
x1 > rightX ifTrue:[x1 := rightX].
firstPixel := self aaFirstPixelFrom: leftX to: x1.
lastPixel := self aaLastPixelFrom: leftX to: x1.
"Deal with the first n sub-pixels"
(x < firstPixel) ifTrue:[
colorMask := self aaColorMaskGet.
colorShift := self aaColorShiftGet.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
[x < firstPixel] whileTrue:[
"Try to copy the current value more than just once"
[x < firstPixel and:[(self squaredLengthOf: ds // 16r10000 with: dt // 16r10000) >= length2]]
whileTrue:[ index := x >> baseShift.
spanBuffer at: index put: (spanBuffer at: index) + rampValue.
x := x + 1.
ds := ds + dsX.
dt := dt + dtX].
"Step to next ramp value"
nextLength := self squaredLengthOf: ds // 16r10000 with: dt // 16r10000.
[nextLength < length2] whileTrue:[
rampIndex := rampIndex - 1.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
length2 := (rampIndex-1) * (rampIndex-1).
].
].
].
"Deal with the full pixels"
(x < lastPixel) ifTrue:[
colorMask := (self aaColorMaskGet >> self aaShiftGet) bitOr: 16rF0F0F0F0.
colorShift := self aaShiftGet.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
[x < lastPixel] whileTrue:[
"Try to copy the current value more than just once"
[x < lastPixel and:[(self squaredLengthOf: ds // 16r10000 with: dt // 16r10000) >= length2]]
whileTrue:[ index := x >> baseShift.
spanBuffer at: index put: (spanBuffer at: index) + rampValue.
x := x + aaLevel.
ds := ds + (dsX << colorShift).
dt := dt + (dtX << colorShift)].
"Step to next ramp value"
nextLength := self squaredLengthOf: ds // 16r10000 with: dt // 16r10000.
[nextLength < length2] whileTrue:[
rampIndex := rampIndex - 1.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
length2 := (rampIndex-1) * (rampIndex-1).
].
].
].
"Deal with the last n sub-pixels"
(x < x1) ifTrue:[
colorMask := self aaColorMaskGet.
colorShift := self aaColorShiftGet.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
[x < x1] whileTrue:[
"Try to copy the current value more than just once"
[x < x1 and:[(self squaredLengthOf: ds // 16r10000 with: dt // 16r10000) >= length2]]
whileTrue:[ index := x >> baseShift.
spanBuffer at: index put: (spanBuffer at: index) + rampValue.
x := x + 1.
ds := ds + dsX.
dt := dt + dtX].
"Step to next ramp value"
nextLength := self squaredLengthOf: ds // 16r10000 with: dt // 16r10000.
[nextLength < length2] whileTrue:[
rampIndex := rampIndex - 1.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
length2 := (rampIndex-1) * (rampIndex-1).
].
].
].
"Done -- store stuff back"
(self cCoerce: deltaST to: 'int *') at: 0 put: ds.
(self cCoerce: deltaST to: 'int *') at: 1 put: dt.
^x!
Item was changed:
----- Method: BalloonEnginePlugin>>fillRadialGradient:from:to:at: (in category 'fills-gradient') -----
fillRadialGradient: fill from: leftX to: rightX at: yValue
"Draw a radial gradient fill."
| x x1 ramp rampSize dsX ds dtX dt length2 deltaX deltaY deltaST |
<inline: false>
+ <var: #ramp type:'int *'>
+ <var: #deltaST type:'int *'>
- <var: #ramp type: 'int *'>
- <var: #deltaST type: 'int *'>
ramp := self gradientRampOf: fill.
rampSize := self gradientRampLengthOf: fill.
deltaX := leftX - (self fillOriginXOf: fill).
deltaY := yValue - (self fillOriginYOf: fill).
dsX := self fillDirectionXOf: fill.
dtX := self fillNormalXOf: fill.
ds := (deltaX * dsX) + (deltaY * (self fillDirectionYOf: fill)).
dt := (deltaX * dtX) + (deltaY * (self fillNormalYOf: fill)).
x := leftX.
x1 := rightX.
"Note: The inner loop has been divided into three parts for speed"
"Part one: Fill everything outside the left boundary"
length2 := (rampSize-1) * (rampSize-1). "This is the upper bound"
[(self squaredLengthOf: ds // 16r10000 with: dt // 16r10000) >= length2 and:[x < x1]]
whileTrue:[ x := x + 1. ds := ds + dsX. dt := dt + dtX].
x > leftX ifTrue:[self fillColorSpan: (self makeUnsignedFrom: (ramp at: rampSize-1)) from: leftX to: x].
"Part two: Fill everything inside the boundaries"
deltaST := self point1Get.
deltaST at: 0 put: ds.
deltaST at: 1 put: dt.
(x < (self fillOriginXOf: fill)) ifTrue:[
"Draw the decreasing part"
self aaLevelGet = 1
ifTrue:[x := self fillRadialDecreasing: fill ramp: ramp deltaST: deltaST
dsX: dsX dtX: dtX from: x to: x1]
ifFalse:[x := self fillRadialDecreasingAA: fill ramp: ramp deltaST: deltaST
dsX: dsX dtX: dtX from: x to: x1].
].
x < x1 ifTrue:[
"Draw the increasing part"
self aaLevelGet = 1
ifTrue:[x := self fillRadialIncreasing: fill ramp: ramp deltaST: deltaST
dsX: dsX dtX: dtX from: x to: x1]
ifFalse:[x := self fillRadialIncreasingAA: fill ramp: ramp deltaST: deltaST
dsX: dsX dtX: dtX from: x to: x1].
].
"Part three fill everything outside right boundary"
x < rightX ifTrue:[self fillColorSpan: (self makeUnsignedFrom: (ramp at: rampSize-1)) from: x to: rightX].
!
Item was changed:
----- Method: BalloonEnginePlugin>>fillRadialIncreasingAA:ramp:deltaST:dsX:dtX:from:to: (in category 'fills-gradient') -----
fillRadialIncreasingAA: fill ramp: ramp deltaST: deltaST dsX: dsX dtX: dtX from: leftX to: rightX
"Part 2b) Compute the increasing part of the ramp"
| ds dt rampIndex rampValue length2 x nextLength rampSize lastLength
aaLevel colorMask colorShift baseShift index firstPixel lastPixel |
<inline: false>
+ <var: #ramp type:'int *'>
+ <var: #deltaST type:' int *'>
- <var: #ramp type: 'int *'>
- <var: #deltaST type: ' int *'>
ds := (self cCoerce: deltaST to:'int*') at: 0.
dt := (self cCoerce: deltaST to:'int*') at: 1.
aaLevel := self aaLevelGet.
baseShift := self aaShiftGet.
rampIndex := self accurateLengthOf: ds // 16r10000 with: dt // 16r10000.
rampSize := self gradientRampLengthOf: fill.
length2 := (rampSize-1) * (rampSize-1). "This is the upper bound"
nextLength := (rampIndex+1) * (rampIndex+1).
lastLength := self squaredLengthOf: ds // 16r10000 with: dt // 16r10000.
x := leftX.
firstPixel := self aaFirstPixelFrom: leftX to: rightX.
lastPixel := self aaLastPixelFrom: leftX to: rightX.
"Deal with the first n subPixels"
(x < firstPixel and:[lastLength < length2]) ifTrue:[
colorMask := self aaColorMaskGet.
colorShift := self aaColorShiftGet.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
[x < firstPixel and:[lastLength < length2]] whileTrue:[
"Try to copy the current value more than once"
[x < firstPixel and:[(self squaredLengthOf: ds // 16r10000 with: dt // 16r10000) <= nextLength]]
whileTrue:[ index := x >> baseShift.
spanBuffer at: index put: (spanBuffer at: index) + rampValue.
x := x + 1.
ds := ds + dsX.
dt := dt + dtX].
lastLength := self squaredLengthOf: ds // 16r10000 with: dt // 16r10000.
[lastLength > nextLength] whileTrue:[
rampIndex := rampIndex + 1.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
nextLength := (rampIndex+1) * (rampIndex+1).
].
].
].
"Deal with the full pixels"
(x < lastPixel and:[lastLength < length2]) ifTrue:[
colorMask := (self aaColorMaskGet >> self aaShiftGet) bitOr: 16rF0F0F0F0.
colorShift := self aaShiftGet.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
[x < lastPixel and:[lastLength < length2]] whileTrue:[
"Try to copy the current value more than once"
[x < lastPixel and:[(self squaredLengthOf: ds // 16r10000 with: dt // 16r10000) <= nextLength]]
whileTrue:[ index := x >> baseShift.
spanBuffer at: index put: (spanBuffer at: index) + rampValue.
x := x + aaLevel.
ds := ds + (dsX << colorShift).
dt := dt + (dtX << colorShift)].
lastLength := self squaredLengthOf: ds // 16r10000 with: dt // 16r10000.
[lastLength > nextLength] whileTrue:[
rampIndex := rampIndex + 1.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
nextLength := (rampIndex+1) * (rampIndex+1).
].
].
].
"Deal with last n sub-pixels"
(x < rightX and:[lastLength < length2]) ifTrue:[
colorMask := self aaColorMaskGet.
colorShift := self aaColorShiftGet.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
[x < rightX and:[lastLength < length2]] whileTrue:[
"Try to copy the current value more than once"
[x < rightX and:[(self squaredLengthOf: ds // 16r10000 with: dt // 16r10000) <= nextLength]]
whileTrue:[ index := x >> baseShift.
spanBuffer at: index put: (spanBuffer at: index) + rampValue.
x := x + 1.
ds := ds + dsX.
dt := dt + dtX].
lastLength := self squaredLengthOf: ds // 16r10000 with: dt // 16r10000.
[lastLength > nextLength] whileTrue:[
rampIndex := rampIndex + 1.
rampValue := self makeUnsignedFrom: ((self cCoerce: ramp to:'int *') at: rampIndex).
rampValue := (rampValue bitAnd: colorMask) >> colorShift.
nextLength := (rampIndex+1) * (rampIndex+1).
].
].
].
"Done -- store stuff back"
(self cCoerce: deltaST to: 'int *') at: 0 put: ds.
(self cCoerce: deltaST to: 'int *') at: 1 put: dt.
^x!
Item was changed:
----- Method: BalloonEnginePlugin>>gradientRampOf: (in category 'accessing gradients') -----
gradientRampOf: fill
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
^objBuffer + fill + GFRampOffset!
Item was changed:
----- Method: BalloonEnginePlugin>>loadAndSubdivideBezierFrom:via:to:isWide: (in category 'bezier-loading') -----
loadAndSubdivideBezierFrom: point1 via: point2 to: point3 isWide: wideFlag
"Load and subdivide the bezier curve from point1/point2/point3.
If wideFlag is set then make sure the curve is monoton in X."
| bz1 bz2 index2 index1 |
<inline: false>
+ <var: #point1 type:'int *'>
+ <var: #point2 type:'int *'>
+ <var: #point3 type:'int *'>
- <var: #point1 type: 'int *'>
- <var: #point2 type: 'int *'>
- <var: #point3 type: 'int *'>
bz1 := self allocateBezierStackEntry.
engineStopped ifTrue:[^0].
"Load point1/point2/point3 on the top of the stack"
self bzStartX: bz1 put: (point1 at: 0).
self bzStartY: bz1 put: (point1 at: 1).
self bzViaX: bz1 put: (point2 at: 0).
self bzViaY: bz1 put: (point2 at: 1).
self bzEndX: bz1 put: (point3 at: 0).
self bzEndY: bz1 put: (point3 at: 1).
"Now check if the bezier curve is monoton. If not, subdivide it."
index2 := bz2 := self subdivideToBeMonoton: bz1 inX: wideFlag.
bz1 to: bz2 by: 6 do:[:index|
index1 := self subdivideBezierFrom: index.
index1 > index2 ifTrue:[index2 := index1].
engineStopped ifTrue:[^0]. "Something went wrong"
].
"Return the number of segments"
^index2 // 6!
Item was changed:
----- Method: BalloonEnginePlugin>>loadBitmapFill:colormap:tile:from:along:normal:xIndex: (in category 'fills-bitmaps') -----
loadBitmapFill: formOop colormap: cmOop tile: tileFlag from: point1 along: point2 normal: point3 xIndex: xIndex
"Load the bitmap fill."
| bmFill cmSize cmBits bmBits bmBitsSize bmWidth bmHeight bmDepth ppw bmRaster |
+ <var: #cmBits type:'int *'>
+ <var: #point1 type:'int *'>
+ <var: #point2 type:'int *'>
+ <var: #point3 type:'int *'>
- <var: #cmBits type: 'int *'>
- <var: #point1 type: 'int *'>
- <var: #point2 type: 'int *'>
- <var: #point3 type: 'int *'>
cmOop == interpreterProxy nilObject ifTrue:[
cmSize := 0.
cmBits := nil.
] ifFalse:[
(interpreterProxy fetchClassOf: cmOop) == interpreterProxy classBitmap
ifFalse:[^interpreterProxy primitiveFail].
cmSize := interpreterProxy slotSizeOf: cmOop.
cmBits := interpreterProxy firstIndexableField: cmOop.
].
(interpreterProxy isIntegerObject: formOop)
ifTrue:[^interpreterProxy primitiveFail].
(interpreterProxy isPointers: formOop)
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy slotSizeOf: formOop) < 5
ifTrue:[^interpreterProxy primitiveFail].
bmBits := interpreterProxy fetchPointer: 0 ofObject: formOop.
(interpreterProxy fetchClassOf: bmBits) == interpreterProxy classBitmap
ifFalse:[^interpreterProxy primitiveFail].
bmBitsSize := interpreterProxy slotSizeOf: bmBits.
bmWidth := interpreterProxy fetchInteger: 1 ofObject: formOop.
bmHeight := interpreterProxy fetchInteger: 2 ofObject: formOop.
bmDepth := interpreterProxy fetchInteger: 3 ofObject: formOop.
interpreterProxy failed ifTrue:[^nil].
(bmWidth >= 0 and:[bmHeight >= 0]) ifFalse:[^interpreterProxy primitiveFail].
(bmDepth = 32) | (bmDepth = 8) | (bmDepth = 16) |
(bmDepth = 1) | (bmDepth = 2) | (bmDepth = 4)
ifFalse:[^interpreterProxy primitiveFail].
(cmSize = 0 or:[cmSize = (1 << bmDepth)])
ifFalse:[^interpreterProxy primitiveFail].
ppw := 32 // bmDepth.
bmRaster := bmWidth + (ppw-1) // ppw.
bmBitsSize = (bmRaster * bmHeight)
ifFalse:[^interpreterProxy primitiveFail].
bmFill := self allocateBitmapFill: cmSize colormap: cmBits.
engineStopped ifTrue:[^nil].
self bitmapWidthOf: bmFill put: bmWidth.
self bitmapHeightOf: bmFill put: bmHeight.
self bitmapDepthOf: bmFill put: bmDepth.
self bitmapRasterOf: bmFill put: bmRaster.
self bitmapSizeOf: bmFill put: bmBitsSize.
self bitmapTileFlagOf: bmFill put: tileFlag.
self objectIndexOf: bmFill put: xIndex.
self loadFillOrientation: bmFill
from: point1 along: point2 normal: point3
width: bmWidth height: bmHeight.
^bmFill!
Item was changed:
----- Method: BalloonEnginePlugin>>loadBitsFrom: (in category 'fills-bitmaps') -----
loadBitsFrom: bmFill
"Note: Assumes that the contents of formArray has been checked before"
| xIndex formOop bitsOop bitsLen |
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
xIndex := self objectIndexOf: bmFill.
xIndex > (interpreterProxy slotSizeOf: formArray) ifTrue:[^nil].
formOop := interpreterProxy fetchPointer: xIndex ofObject: formArray.
bitsOop := interpreterProxy fetchPointer: 0 ofObject: formOop.
bitsLen := interpreterProxy slotSizeOf: bitsOop.
bitsLen = (self bitmapSizeOf: bmFill) ifFalse:[^nil].
^interpreterProxy firstIndexableField: bitsOop!
Item was changed:
----- Method: BalloonEnginePlugin>>loadCompressedShape:segments:leftFills:rightFills:lineWidths:lineFills:fillIndexList:pointShort: (in category 'shapes-compressed') -----
loadCompressedShape: points segments: nSegments leftFills: leftFills rightFills: rightFills lineWidths: lineWidths lineFills: lineFills fillIndexList: fillIndexList pointShort: pointsShort
"Load a compressed shape into the engine.
WARNING: THIS METHOD NEEDS THE FULL FRAME SIZE!!!!!!!!
"
| leftRun rightRun widthRun lineFillRun
leftLength rightLength widthLength lineFillLength
leftValue rightValue widthValue lineFillValue |
<inline: false>
+ <var: #points type:'int *'>
+ <var: #leftFills type:'int *'>
+ <var: #rightFills type:'int *'>
+ <var: #lineWidths type:'int *'>
+ <var: #lineFills type:'int *'>
+ <var: #fillIndexList type:'int *'>
- <var: #points type: 'int *'>
- <var: #leftFills type: 'int *'>
- <var: #rightFills type: 'int *'>
- <var: #lineWidths type: 'int *'>
- <var: #lineFills type: 'int *'>
- <var: #fillIndexList type: 'int *'>
nSegments = 0 ifTrue:[^0].
"Initialize run length encodings"
leftRun := rightRun := widthRun := lineFillRun := -1.
leftLength := rightLength := widthLength := lineFillLength := 1.
leftValue := rightValue := widthValue := lineFillValue := 0.
1 to: nSegments do:[:i|
"Decrement current run length and load new stuff"
(leftLength := leftLength - 1) <= 0 ifTrue:[
leftRun := leftRun + 1.
leftLength := self shortRunLengthAt: leftRun from: leftFills.
leftValue := self shortRunValueAt: leftRun from: leftFills.
leftValue = 0 ifFalse:[
leftValue := fillIndexList at: leftValue-1.
leftValue := self transformColor: leftValue.
engineStopped ifTrue:[^nil]]].
(rightLength := rightLength - 1) <= 0 ifTrue:[
rightRun := rightRun + 1.
rightLength := self shortRunLengthAt: rightRun from: rightFills.
rightValue := self shortRunValueAt: rightRun from: rightFills.
rightValue = 0 ifFalse:[
rightValue := fillIndexList at: rightValue-1.
rightValue := self transformColor: rightValue]].
(widthLength := widthLength - 1) <= 0 ifTrue:[
widthRun := widthRun + 1.
widthLength := self shortRunLengthAt: widthRun from: lineWidths.
widthValue := self shortRunValueAt: widthRun from: lineWidths.
widthValue = 0 ifFalse:[widthValue := self transformWidth: widthValue]].
(lineFillLength := lineFillLength - 1) <= 0 ifTrue:[
lineFillRun := lineFillRun + 1.
lineFillLength := self shortRunLengthAt: lineFillRun from: lineFills.
lineFillValue := self shortRunValueAt: lineFillRun from: lineFills.
lineFillValue = 0 ifFalse:[lineFillValue := fillIndexList at: lineFillValue-1]].
self loadCompressedSegment: i - 1
from: points
short: pointsShort
leftFill: leftValue
rightFill: rightValue
lineWidth: widthValue
lineColor: lineFillValue.
engineStopped ifTrue:[^nil].
].!
Item was changed:
----- Method: BalloonEnginePlugin>>loadFillOrientation:from:along:normal:width:height: (in category 'fills-gradient') -----
loadFillOrientation: fill from: point1 along: point2 normal: point3 width: fillWidth height: fillHeight
"Transform the points"
| dirX dirY nrmX nrmY dsLength2 dsX dsY dtLength2 dtX dtY |
+ <var: #point1 type:'int *'>
+ <var: #point2 type:'int *'>
+ <var: #point3 type:'int *'>
- <var: #point1 type: 'int *'>
- <var: #point2 type: 'int *'>
- <var: #point3 type: 'int *'>
point2 at: 0 put: (point2 at: 0) + (point1 at: 0).
point2 at: 1 put: (point2 at: 1) + (point1 at: 1).
point3 at: 0 put: (point3 at: 0) + (point1 at: 0).
point3 at: 1 put: (point3 at: 1) + (point1 at: 1).
self transformPoint: point1.
self transformPoint: point2.
self transformPoint: point3.
dirX := (point2 at: 0) - (point1 at: 0).
dirY := (point2 at: 1) - (point1 at: 1).
nrmX := (point3 at: 0) - (point1 at: 0).
nrmY := (point3 at: 1) - (point1 at: 1).
"Compute the scale from direction/normal into ramp size"
dsLength2 := (dirX * dirX) + (dirY * dirY).
dsLength2 > 0 ifTrue:[
dsX := (dirX asFloat * fillWidth asFloat * 65536.0 / dsLength2 asFloat) asInteger.
dsY := (dirY asFloat * fillWidth asFloat * 65536.0 / dsLength2 asFloat) asInteger.
] ifFalse:[ dsX := 0. dsY := 0].
dtLength2 := (nrmX * nrmX) + (nrmY * nrmY).
dtLength2 > 0 ifTrue:[
dtX := (nrmX asFloat * fillHeight asFloat * 65536.0 / dtLength2 asFloat) asInteger.
dtY := (nrmY asFloat * fillHeight asFloat * 65536.0 / dtLength2 asFloat) asInteger.
] ifFalse:[dtX := 0. dtY := 0].
self fillOriginXOf: fill put: (point1 at: 0).
self fillOriginYOf: fill put: (point1 at: 1).
self fillDirectionXOf: fill put: dsX.
self fillDirectionYOf: fill put: dsY.
self fillNormalXOf: fill put: dtX.
self fillNormalYOf: fill put: dtY.
!
Item was changed:
----- Method: BalloonEnginePlugin>>loadGradientFill:from:along:normal:isRadial: (in category 'fills-gradient') -----
loadGradientFill: rampOop from: point1 along: point2 normal: point3 isRadial: isRadial
"Load the gradient fill as defined by the color ramp."
| rampWidth fill |
<inline: false>
+ <var: #point1 type:'int *'>
+ <var: #point2 type:'int *'>
+ <var: #point3 type:'int *'>
- <var: #point1 type: 'int *'>
- <var: #point2 type: 'int *'>
- <var: #point3 type: 'int *'>
(interpreterProxy fetchClassOf: rampOop) = interpreterProxy classBitmap
ifFalse:[^interpreterProxy primitiveFail].
rampWidth := interpreterProxy slotSizeOf: rampOop.
fill := self allocateGradientFill: (interpreterProxy firstIndexableField: rampOop)
rampWidth: rampWidth isRadial: isRadial.
engineStopped ifTrue:[^nil].
self loadFillOrientation: fill
from: point1 along: point2 normal: point3
width: rampWidth height: rampWidth.
^fill!
Item was changed:
----- Method: BalloonEnginePlugin>>loadLine:from:to:offset:leftFill:rightFill: (in category 'lines-loading') -----
loadLine: line from: point1 to: point2 offset: yOffset leftFill: leftFill rightFill: rightFill
"Load the line defined by point1 and point2."
| p1 p2 yDir |
+ <var: #point1 type:'int *'>
+ <var: #point2 type:'int *'>
+ <var: #p1 type:'int *'>
+ <var: #p2 type:'int *'>
- <var: #point1 type: 'int *'>
- <var: #point2 type: 'int *'>
- <var: #p1 type: 'int *'>
- <var: #p2 type: 'int *'>
(point1 at: 1) <= (point2 at: 1)
ifTrue:[ p1 := point1.
p2 := point2.
yDir := 1]
ifFalse:[ p1 := point2.
p2 := point1.
yDir := -1].
self edgeXValueOf: line put: (p1 at: 0).
self edgeYValueOf: line put: (p1 at: 1) - yOffset.
self edgeZValueOf: line put: self currentZGet.
self edgeLeftFillOf: line put: leftFill.
self edgeRightFillOf: line put: rightFill.
self lineEndXOf: line put: (p2 at: 0).
self lineEndYOf: line put: (p2 at: 1) - yOffset.
self lineYDirectionOf: line put: yDir.!
Item was changed:
----- Method: BalloonEnginePlugin>>loadPointShortAt:from: (in category 'private') -----
loadPointShortAt: index from: shortArray
"Load the short value from the given index in shortArray"
+ <returnTypeC:'short'>
- <returnTypeC: 'short'>
^(self cCoerce: shortArray to: 'short *') at: index!
Item was changed:
----- Method: BalloonEnginePlugin>>loadPolygon:nPoints:fill:lineWidth:lineFill:pointsShort: (in category 'shapes-polygons') -----
loadPolygon: points nPoints: nPoints fill: fillIndex lineWidth: lineWidth lineFill: lineFill pointsShort: isShort
| x0 y0 x1 y1 |
+ <var:#points type:'int *'>
- <var: #points type: 'int *'>
isShort ifTrue:[
x0 := self loadPointShortAt: 0 from: points.
y0 := self loadPointShortAt: 1 from: points.
] ifFalse:[
x0 := self loadPointIntAt: 0 from: points.
y0 := self loadPointIntAt: 1 from: points.
].
1 to: nPoints-1 do:[:i|
isShort ifTrue:[
x1 := self loadPointShortAt: i*2 from: points.
y1 := self loadPointShortAt: i*2+1 from: points.
] ifFalse:[
x1 := self loadPointIntAt: i*2 from: points.
y1 := self loadPointIntAt: i*2+1 from: points.
].
self point1Get at: 0 put: x0.
self point1Get at: 1 put: y0.
self point2Get at: 0 put: x1.
self point2Get at: 1 put: y1.
self transformPoints: 2.
self loadWideLine: lineWidth
from: self point1Get
to: self point2Get
lineFill: lineFill
leftFill: fillIndex
rightFill: 0.
engineStopped ifTrue:[^nil].
x0 := x1.
y0 := y1.
].!
Item was changed:
----- Method: BalloonEnginePlugin>>loadShape:nSegments:fill:lineWidth:lineFill:pointsShort: (in category 'shapes-polygons') -----
loadShape: points nSegments: nSegments fill: fillIndex lineWidth: lineWidth lineFill: lineFill pointsShort: pointsShort
<inline: false>
+ <var:#points type:'int *'>
- <var: #points type: 'int *'>
1 to: nSegments do:[:i|
self loadCompressedSegment: i-1
from: points
short: pointsShort
leftFill: fillIndex
rightFill: 0
lineWidth: lineWidth
lineColor: lineFill.
engineStopped ifTrue:[^nil].
].!
Item was changed:
----- Method: BalloonEnginePlugin>>loadWideLine:from:to:lineFill:leftFill:rightFill: (in category 'lines-loading') -----
loadWideLine: lineWidth from: p1 to: p2 lineFill: lineFill leftFill: leftFill rightFill: rightFill
"Load a (possibly wide) line defined by the points p1 and p2"
| line offset |
+ <var: #p1 type:'int *'>
+ <var: #p2 type:'int *'>
- <var: #p1 type: 'int *'>
- <var: #p2 type: 'int *'>
(lineWidth = 0 or:[lineFill = 0])
ifTrue:[ line := self allocateLine.
offset := 0]
ifFalse:[ line := self allocateWideLine.
offset := self offsetFromWidth: lineWidth].
engineStopped ifTrue:[^0].
self loadLine: line
from: p1
to: p2
offset: offset
leftFill: leftFill
rightFill: rightFill.
(self isWide: line) ifTrue:[
self wideLineFillOf: line put: lineFill.
self wideLineWidthOf: line put: lineWidth.
self wideLineExtentOf: line put: lineWidth].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddBezier (in category 'primitives') -----
primitiveAddBezier
+ | failureCode leftFill rightFill viaOop endOop startOop nSegments |
- | leftFill rightFill viaOop endOop startOop nSegments |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 5) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"Make sure the fills are okay"
((self isFillOkay: leftFill) and:[self isFillOkay: rightFill])
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
"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].
- interpreterProxy failed ifTrue:[^0].
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 primitiveFail].
+ interpreterProxy failed
+ ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 5. "Leave rcvr on stack"!
- interpreterProxy failed ifFalse:[
- self storeEngineStateInto: engine.
- interpreterProxy pop: 5. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddBezierShape (in category 'primitives') -----
primitiveAddBezierShape
+ | failureCode points lineFill lineWidth fillIndex length pointsIsArray segSize nSegments |
- | points lineFill lineWidth fillIndex length isArray segSize nSegments |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 5) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"First, do a check if the points look okay"
length := interpreterProxy slotSizeOf: points.
(interpreterProxy isWords: points) ifTrue:[
+ pointsIsArray := false.
- isArray := false.
"Either PointArray or ShortPointArray"
(length = (nSegments * 3) or:[length = (nSegments * 6)])
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- ifFalse:[^interpreterProxy primitiveFail].
] ifFalse:["Must be Array of points"
(interpreterProxy isArray: points)
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- ifFalse:[^interpreterProxy primitiveFail].
length = (nSegments * 3)
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ pointsIsArray := true.
- ifFalse:[^interpreterProxy primitiveFail].
- isArray := 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].
- ifFalse:[^interpreterProxy primitiveFail].
"Check the fills"
((self isFillOkay: lineFill) and:[self isFillOkay: fillIndex])
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
"Transform colors"
lineFill := self transformColor: lineFill.
fillIndex := self transformColor: fillIndex.
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
"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:[
- isArray 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].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
+ interpreterProxy failed
+ ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self needsFlushPut: 1.
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 5. "Leave rcvr on stack"!
- interpreterProxy failed ifFalse:[
- self needsFlushPut: 1.
- self storeEngineStateInto: engine.
- interpreterProxy pop: 5. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddBitmapFill (in category 'primitives') -----
primitiveAddBitmapFill
+ | failureCode nrmOop dirOop originOop tileFlag fill xIndex cmOop formOop |
- | nrmOop dirOop originOop tileFlag fill xIndex cmOop formOop |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 7
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
xIndex := interpreterProxy stackIntegerValue: 0.
+ xIndex <= 0 ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- xIndex <= 0 ifTrue:[^interpreterProxy primitiveFail].
nrmOop := interpreterProxy stackObjectValue: 1.
dirOop := interpreterProxy stackObjectValue: 2.
originOop := interpreterProxy stackObjectValue: 3.
tileFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 4).
- tileFlag ifTrue:[tileFlag := 1] ifFalse:[tileFlag := 0].
cmOop := interpreterProxy stackObjectValue: 5.
formOop := interpreterProxy stackObjectValue: 6.
+ interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 7)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 7) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
self loadPoint: self point1Get from: originOop.
self loadPoint: self point2Get from: dirOop.
self loadPoint: self point3Get from: nrmOop.
+ interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
- interpreterProxy failed ifTrue:[^0].
fill := self loadBitmapFill: formOop
colormap: cmOop
+ tile: (tileFlag ifTrue:[1] ifFalse:[0])
- tile: tileFlag
from: self point1Get
along: self point2Get
normal: self point3Get
xIndex: xIndex-1.
engineStopped ifTrue:[
"Make sure the stack is okay"
+ ^interpreterProxy primitiveFailFor: GEFEngineStopped].
- ^interpreterProxy primitiveFail].
+ interpreterProxy failed
+ ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 8 thenPush: (interpreterProxy positive32BitIntegerFor: fill)!
- interpreterProxy failed ifFalse:[
- self storeEngineStateInto: engine.
- interpreterProxy pop: 8.
- interpreterProxy push: (interpreterProxy positive32BitIntegerFor: fill).
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddCompressedShape (in category 'primitives') -----
primitiveAddCompressedShape
+ | failureCode fillIndexList lineFills lineWidths rightFills leftFills nSegments points pointsShort |
- | fillIndexList lineFills lineWidths rightFills leftFills nSegments points pointsShort |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 7
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 7)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 7) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"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].
- fillIndexList: fillIndexList) ifFalse:[^interpreterProxy primitiveFail].
"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].
- ifFalse:[^interpreterProxy primitiveFail].
"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].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
+ interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self needsFlushPut: 1.
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 7. "Leave rcvr on stack"!
- interpreterProxy failed ifFalse:[
- self needsFlushPut: 1.
- self storeEngineStateInto: engine.
- interpreterProxy pop: 7. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddGradientFill (in category 'primitives') -----
primitiveAddGradientFill
+ | failureCode isRadial nrmOop dirOop originOop rampOop fill |
- | isRadial nrmOop dirOop originOop rampOop fill |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 5) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
self loadPoint: self point1Get from: originOop.
self loadPoint: self point2Get from: dirOop.
self loadPoint: self point3Get from: nrmOop.
+ interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
- interpreterProxy failed ifTrue:[^0].
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 primitiveFail].
+ interpreterProxy failed
+ ifTrue: [^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 6 thenPush: (interpreterProxy positive32BitIntegerFor: fill)!
- interpreterProxy failed ifFalse:[
- self storeEngineStateInto: engine.
- interpreterProxy pop: 6.
- interpreterProxy push: (interpreterProxy positive32BitIntegerFor: fill).
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddLine (in category 'primitives') -----
primitiveAddLine
+ | failureCode leftFill rightFill endOop startOop |
- | leftFill rightFill endOop startOop |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 4
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 4)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 4) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"Make sure the fills are okay"
((self isFillOkay: leftFill) and:[self isFillOkay: rightFill])
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
"Load the points"
self loadPoint: self point1Get from: startOop.
self loadPoint: self point2Get from: endOop.
+ interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFBadPoint].
- interpreterProxy failed ifTrue:[^0].
"Transform points"
self transformPoints: 2.
"Transform colors"
leftFill := self transformColor: leftFill.
rightFill := self transformColor: rightFill.
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
"Load line"
self loadWideLine: 0 from: self point1Get to: self point2Get
lineFill: 0 leftFill: leftFill rightFill: rightFill.
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
+ interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 4. "Leave rcvr on stack"!
- interpreterProxy failed ifFalse:[
- self storeEngineStateInto: engine.
- interpreterProxy pop: 4. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddOval (in category 'primitives') -----
primitiveAddOval
+ | failureCode fillIndex borderWidth borderIndex endOop startOop |
- | fillIndex borderWidth borderIndex endOop startOop |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 5) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"Make sure the fills are okay"
((self isFillOkay: borderIndex) and:[self isFillOkay: fillIndex])
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
"Transform colors"
fillIndex := self transformColor: fillIndex.
borderIndex := self transformColor: borderIndex.
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
"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].
- ifFalse:[^interpreterProxy primitiveFail].
"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].
- interpreterProxy failed ifTrue:[^0].
self loadOval: borderWidth lineFill: borderIndex
leftFill: 0 rightFill: fillIndex.
engineStopped ifTrue:[
self wbStackClear.
+ ^interpreterProxy primitiveFailFor: GEFEngineStopped.
- ^interpreterProxy primitiveFail.
].
+ interpreterProxy failed
+ ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self needsFlushPut: 1.
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 5. "Leave rcvr on stack"!
- interpreterProxy failed ifFalse:[
- self needsFlushPut: 1.
- self storeEngineStateInto: engine.
- interpreterProxy pop: 5. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddPolygon (in category 'primitives') -----
primitiveAddPolygon
+ | failureCode points lineFill lineWidth fillIndex nPoints length pointsIsArray segSize |
- | points lineFill lineWidth fillIndex nPoints length isArray segSize |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 5) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"First, do a check if the points look okay"
length := interpreterProxy slotSizeOf: points.
(interpreterProxy isWords: points) ifTrue:[
+ pointsIsArray := false.
- isArray := false.
"Either PointArray or ShortPointArray"
(length = nPoints or:[nPoints * 2 = length])
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- ifFalse:[^interpreterProxy primitiveFail].
] ifFalse:["Must be Array of points"
(interpreterProxy isArray: points)
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- ifFalse:[^interpreterProxy primitiveFail].
length = nPoints
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ pointsIsArray := true.
- ifFalse:[^interpreterProxy primitiveFail].
- isArray := 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].
- ifFalse:[^interpreterProxy primitiveFail].
"Transform colors"
lineFill := self transformColor: lineFill.
fillIndex := self transformColor: fillIndex.
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
"Check if have anything at all to do"
((lineFill = 0 or:[lineWidth = 0]) and:[fillIndex = 0])
+ ifTrue:[^interpreterProxy pop: 5].
- ifTrue:[^interpreterProxy pop: 6].
"Transform the lineWidth"
lineWidth = 0 ifFalse:[lineWidth := self transformWidth: lineWidth].
"And load the actual polygon"
+ pointsIsArray ifTrue:[
- isArray 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].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
+ interpreterProxy failed ifTrue:
+ [^interpreterProxy primitiveFailFor: GEFEntityLoadFailed].
+ self needsFlushPut: 1.
+ self storeEngineStateInto: engine.
+ interpreterProxy pop: 5. "Leave rcvr on stack"!
- interpreterProxy failed ifFalse:[
- self needsFlushPut: 1.
- self storeEngineStateInto: engine.
- interpreterProxy pop: 5. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveAddRect (in category 'primitives') -----
primitiveAddRect
+ | failureCode fillIndex borderWidth borderIndex endOop startOop |
- | fillIndex borderWidth borderIndex endOop startOop |
<export: true>
<inline: false>
"Fail if we have the wrong number of arguments"
interpreterProxy methodArgumentCount = 5
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
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].
- interpreterProxy failed ifTrue:[^nil].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5)
+ requiredState: GEStateUnlocked) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- (self quickLoadEngineFrom: (interpreterProxy stackObjectValue: 5) requiredState: GEStateUnlocked)
- ifFalse:[^interpreterProxy primitiveFail].
"Make sure the fills are okay"
((self isFillOkay: borderIndex) and:[self isFillOkay: fillIndex])
+ ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill].
- ifFalse:[^interpreterProxy primitiveFail].
"Transform colors"
borderIndex := self transformColor: borderIndex.
fillIndex := self transformColor: fillIndex.
+ engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped].
- engineStopped ifTrue:[^interpreterProxy primitiveFail].
"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].
- ifFalse:[^interpreterProxy primitiveFail].
"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].
- interpreterProxy failed ifTrue:[^nil].
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"!
- interpreterProxy failed ifFalse:[
- self needsFlushPut: 1.
- self storeEngineStateInto: engine.
- interpreterProxy pop: 5. "Leave rcvr on stack"
- ].!
Item was changed:
----- Method: BalloonEnginePlugin>>primitiveGetBezierStats (in category 'primitives') -----
primitiveGetBezierStats
+ | failureCode statOop stats |
- | statOop stats |
<export: true>
<inline: false>
+ <var: #stats type:'int *'>
- <var: #stats type: 'int *'>
interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- ifFalse:[^interpreterProxy primitiveFail].
+ (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 1)) = 0
+ ifFalse:[^interpreterProxy primitiveFailFor: failureCode].
- statOop := interpreterProxy stackObjectValue: 0.
- engine := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- (self quickLoadEngineFrom: engine)
- ifFalse:[^interpreterProxy primitiveFail].
+ statOop := interpreterProxy stackObjectValue: 0.
+ (interpreterProxy failed not
+ and: [(interpreterProxy isWords: statOop)
+ and: [(interpreterProxy slotSizeOf: statOop) >= 4]])
+ ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- (interpreterProxy isWords: statOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: statOop) < 4
- ifTrue:[^interpreterProxy primitiveFail].
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:
----- Method: BalloonEnginePlugin>>rShiftTable (in category 'private') -----
rShiftTable
| theTable |
+ <returnTypeC:'int *'>
- <returnTypeC: 'int *'>
<inline: false>
+ <var:#theTable declareC:'static int theTable[17] =
- <var: #theTable declareC: 'static int theTable[17] =
{0, 5, 4, 0, 3, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 1}'>
^theTable!
Item was changed:
----- Method: BalloonEnginePlugin>>stepToFirstBezierIn:at: (in category 'beziers-simple') -----
stepToFirstBezierIn: bezier at: yValue
"Initialize the bezier at yValue.
TODO: Check if reducing maxSteps from 2*deltaY to deltaY
brings a *significant* performance improvement.
In theory this should make for double step performance
but will cost in quality. Might be that the AA stuff will
compensate for this - but I'm not really sure."
| updateData deltaY maxSteps scaledStepSize squaredStepSize
startX startY viaX viaY endX endY
fwX1 fwX2 fwY1 fwY2
fwDx fwDDx fwDy fwDDy |
<inline: false>
+ <var: #updateData type:'int *'>
- <var: #updateData type: 'int *'>
"Do a quick check if there is anything at all to do"
((self isWide: bezier) not and:[yValue >= (self bezierEndYOf: bezier)])
ifTrue:[^self edgeNumLinesOf: bezier put: 0].
"Now really initialize bezier"
startX := self edgeXValueOf: bezier.
startY := self edgeYValueOf: bezier.
viaX := self bezierViaXOf: bezier.
viaY := self bezierViaYOf: bezier.
endX := self bezierEndXOf: bezier.
endY := self bezierEndYOf: bezier.
deltaY := endY - startY.
"Initialize integer forward differencing"
fwX1 := (viaX - startX) * 2.
fwX2 := startX + endX - (viaX * 2).
fwY1 := (viaY - startY) * 2.
fwY2 := startY + endY - (viaY * 2).
maxSteps := deltaY * 2.
maxSteps < 2 ifTrue:[maxSteps := 2].
scaledStepSize := 16r1000000 // maxSteps.
squaredStepSize := self absoluteSquared8Dot24: scaledStepSize.
fwDx := fwX1 * scaledStepSize.
fwDDx := fwX2 * squaredStepSize * 2.
fwDx := fwDx + (fwDDx // 2).
fwDy := fwY1 * scaledStepSize.
fwDDy := fwY2 * squaredStepSize * 2.
fwDy := fwDy + (fwDDy // 2).
"Store the values"
self edgeNumLinesOf: bezier put: deltaY.
updateData := self bezierUpdateDataOf: bezier.
updateData at: GBUpdateX put: (startX * 256).
updateData at: GBUpdateY put: (startY * 256).
updateData at: GBUpdateDX put: fwDx.
updateData at: GBUpdateDY put: fwDy.
updateData at: GBUpdateDDX put: fwDDx.
updateData at: GBUpdateDDY put: fwDDy.
"And step to the first scan line"
(startY := self edgeYValueOf: bezier) = yValue ifFalse:[
self stepToNextBezierIn: bezier at: yValue.
"Adjust number of lines remaining"
self edgeNumLinesOf: bezier put: deltaY - (yValue - startY).
].!
Item was changed:
BalloonEnginePlugin subclass: #BalloonEngineSimulation
+ instanceVariableNames: 'bbObj savedBBObj workBufferArray'
- instanceVariableNames: 'bbObj workBufferArray'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
!BalloonEngineSimulation commentStamp: 'tpr 5/5/2003 11:48' prior: 0!
Support for the VM simulator Balloon graphics calls!
Item was changed:
----- Method: BalloonEngineSimulation>>copyBitsFrom:to:at: (in category 'simulation') -----
copyBitsFrom: x0 to: x1 at: y
"Simulate the copyBits primitive"
| bb |
bbObj isInteger ifTrue:
["Create a proxy object to handle BitBlt calls"
+ bb := savedBBObj
+ ifNil: [BitBltSimulator new
+ initialiseModule;
+ setInterpreter: interpreterProxy;
+ yourself]
+ ifNotNil: [savedBBObj].
- bb := BitBltSimulator new.
- bb initialiseModule.
- bb setInterpreter: interpreterProxy.
(bb loadBitBltFrom: bbObj)
ifTrue: [bbObj := bb]
ifFalse: [^ self]].
bbObj copyBitsFrom: x0 to: x1 at: y.
"
interpreterProxy showDisplayBits: bbObj destForm
Left: bb affectedLeft Top: bb affectedTop
Right: bb affectedRight Bottom: bb affectedBottom.
"!
Item was changed:
----- Method: BalloonEngineSimulation>>loadBitBltFrom: (in category 'simulation') -----
loadBitBltFrom: oop
+ (bbObj isInteger or: [bbObj isNil]) ifFalse:
+ [savedBBObj := bbObj].
bbObj := oop.
^true!
Item was changed:
----- Method: BalloonEngineSimulation>>loadWordTransformFrom:into:length: (in category 'initialize') -----
loadWordTransformFrom: transformOop into: destPtr length: n
"Load a float array transformation from the given oop"
| srcPtr wordDestPtr |
+ false ifTrue:
+ [^super loadWordTransformFrom: transformOop into: destPtr length: n].
- true ifTrue:
- [^ super loadWordTransformFrom: transformOop into: destPtr length: n].
srcPtr := interpreterProxy firstIndexableField: transformOop.
wordDestPtr := destPtr as: CArrayAccessor. "Remove float conversion shell"
+ 0 to: n-1 do: [:i | wordDestPtr at: i put: (srcPtr floatAt: i)]!
- 0 to: n-1 do: [:i | wordDestPtr at: i put: (srcPtr at: i)].!
Item was changed:
----- Method: BitBltSimulation>>alphaSourceBlendBits8 (in category 'inner loop') -----
alphaSourceBlendBits8
"This version assumes
combinationRule = 34
sourcePixSize = 32
destPixSize = 8
sourceForm ~= destForm.
Note: This is not real blending since we don't have the source colors available.
"
| srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
srcY dstY dstMask srcShift adjust mappingTable mapperFlags |
<inline: false>
+ <var: #mappingTable type:'unsigned int *'>
- <var: #mappingTable type: 'unsigned int *'>
mappingTable := self default8To32Table.
mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32.
deltaY := bbH + 1. "So we can pre-decrement"
srcY := sy.
dstY := dy.
mask1 := ((dx bitAnd: 3) * 8).
destMSB ifTrue:[mask1 := 24 - mask1].
mask2 := AllOnes bitXor:(16rFF << mask1).
(dx bitAnd: 1) = 0
ifTrue:[adjust := 0]
ifFalse:[adjust := 16r1F1F1F1F].
(dy bitAnd: 1) = 0
ifTrue:[adjust := adjust bitXor: 16r1F1F1F1F].
"This is the outer loop"
[(deltaY := deltaY - 1) ~= 0] whileTrue:[
adjust := adjust bitXor: 16r1F1F1F1F.
srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
dstIndex := destBits + (dstY * destPitch) + (dx // 4 * 4).
deltaX := bbW + 1. "So we can pre-decrement"
srcShift := mask1.
dstMask := mask2.
"This is the inner loop"
[(deltaX := deltaX - 1) ~= 0] whileTrue:[
sourceWord := ((self srcLongAt: srcIndex) bitAnd: (adjust bitInvert32)) + adjust.
srcAlpha := sourceWord >> 24.
srcAlpha > 31 ifTrue:["Everything below 31 is transparent"
srcAlpha < 224 ifTrue:["Everything above 224 is opaque"
destWord := self dstLongAt: dstIndex.
destWord := destWord bitAnd: dstMask bitInvert32.
destWord := destWord >> srcShift.
destWord := mappingTable at: destWord.
sourceWord := self alphaBlendScaled: sourceWord with: destWord.
].
sourceWord := self mapPixel: sourceWord flags: mapperFlags.
sourceWord := sourceWord << srcShift.
"Store back"
self dstLongAt: dstIndex put: sourceWord mask: dstMask.
].
srcIndex := srcIndex + 4.
destMSB ifTrue:[
srcShift = 0
ifTrue:[dstIndex := dstIndex + 4.
srcShift := 24.
dstMask := 16r00FFFFFF]
ifFalse:[srcShift := srcShift - 8.
dstMask := (dstMask >> 8) bitOr: 16rFF000000].
] ifFalse:[
srcShift = 32
ifTrue:[dstIndex := dstIndex + 4.
srcShift := 0.
dstMask := 16rFFFFFF00]
ifFalse:[srcShift := srcShift + 8.
dstMask := dstMask << 8 bitOr: 255].
].
adjust := adjust bitXor: 16r1F1F1F1F.
].
srcY := srcY + 1.
dstY := dstY + 1.
].!
Item was changed:
----- Method: BitBltSimulation>>default8To32Table (in category 'pixel mapping') -----
default8To32Table
"Return the default translation table from 1..8 bit indexed colors to 32bit"
"The table has been generated by the following statements"
"| pvs hex |
String streamContents:[:s|
s nextPutAll:'static unsigned int theTable[256] = { '.
pvs := (Color colorMapIfNeededFrom: 8 to: 32) asArray.
1 to: pvs size do:[:i|
i > 1 ifTrue:[s nextPutAll:', '].
(i-1 \\ 8) = 0 ifTrue:[s cr].
s nextPutAll:'0x'.
hex := (pvs at: i) printStringBase: 16.
s nextPutAll: (hex copyFrom: 4 to: hex size).
].
s nextPutAll:'};'.
]."
| theTable |
+ <returnTypeC:'unsigned int *'>
+ <var: #theTable declareC:'static unsigned int theTable[256] = {
- <returnTypeC: 'unsigned int *'>
- <var: #theTable declareC: 'static unsigned int theTable[256] = {
0x0, 0xFF000001, 0xFFFFFFFF, 0xFF808080, 0xFFFF0000, 0xFF00FF00, 0xFF0000FF, 0xFF00FFFF,
0xFFFFFF00, 0xFFFF00FF, 0xFF202020, 0xFF404040, 0xFF606060, 0xFF9F9F9F, 0xFFBFBFBF, 0xFFDFDFDF,
0xFF080808, 0xFF101010, 0xFF181818, 0xFF282828, 0xFF303030, 0xFF383838, 0xFF484848, 0xFF505050,
0xFF585858, 0xFF686868, 0xFF707070, 0xFF787878, 0xFF878787, 0xFF8F8F8F, 0xFF979797, 0xFFA7A7A7,
0xFFAFAFAF, 0xFFB7B7B7, 0xFFC7C7C7, 0xFFCFCFCF, 0xFFD7D7D7, 0xFFE7E7E7, 0xFFEFEFEF, 0xFFF7F7F7,
0xFF000001, 0xFF003300, 0xFF006600, 0xFF009900, 0xFF00CC00, 0xFF00FF00, 0xFF000033, 0xFF003333,
0xFF006633, 0xFF009933, 0xFF00CC33, 0xFF00FF33, 0xFF000066, 0xFF003366, 0xFF006666, 0xFF009966,
0xFF00CC66, 0xFF00FF66, 0xFF000099, 0xFF003399, 0xFF006699, 0xFF009999, 0xFF00CC99, 0xFF00FF99,
0xFF0000CC, 0xFF0033CC, 0xFF0066CC, 0xFF0099CC, 0xFF00CCCC, 0xFF00FFCC, 0xFF0000FF, 0xFF0033FF,
0xFF0066FF, 0xFF0099FF, 0xFF00CCFF, 0xFF00FFFF, 0xFF330000, 0xFF333300, 0xFF336600, 0xFF339900,
0xFF33CC00, 0xFF33FF00, 0xFF330033, 0xFF333333, 0xFF336633, 0xFF339933, 0xFF33CC33, 0xFF33FF33,
0xFF330066, 0xFF333366, 0xFF336666, 0xFF339966, 0xFF33CC66, 0xFF33FF66, 0xFF330099, 0xFF333399,
0xFF336699, 0xFF339999, 0xFF33CC99, 0xFF33FF99, 0xFF3300CC, 0xFF3333CC, 0xFF3366CC, 0xFF3399CC,
0xFF33CCCC, 0xFF33FFCC, 0xFF3300FF, 0xFF3333FF, 0xFF3366FF, 0xFF3399FF, 0xFF33CCFF, 0xFF33FFFF,
0xFF660000, 0xFF663300, 0xFF666600, 0xFF669900, 0xFF66CC00, 0xFF66FF00, 0xFF660033, 0xFF663333,
0xFF666633, 0xFF669933, 0xFF66CC33, 0xFF66FF33, 0xFF660066, 0xFF663366, 0xFF666666, 0xFF669966,
0xFF66CC66, 0xFF66FF66, 0xFF660099, 0xFF663399, 0xFF666699, 0xFF669999, 0xFF66CC99, 0xFF66FF99,
0xFF6600CC, 0xFF6633CC, 0xFF6666CC, 0xFF6699CC, 0xFF66CCCC, 0xFF66FFCC, 0xFF6600FF, 0xFF6633FF,
0xFF6666FF, 0xFF6699FF, 0xFF66CCFF, 0xFF66FFFF, 0xFF990000, 0xFF993300, 0xFF996600, 0xFF999900,
0xFF99CC00, 0xFF99FF00, 0xFF990033, 0xFF993333, 0xFF996633, 0xFF999933, 0xFF99CC33, 0xFF99FF33,
0xFF990066, 0xFF993366, 0xFF996666, 0xFF999966, 0xFF99CC66, 0xFF99FF66, 0xFF990099, 0xFF993399,
0xFF996699, 0xFF999999, 0xFF99CC99, 0xFF99FF99, 0xFF9900CC, 0xFF9933CC, 0xFF9966CC, 0xFF9999CC,
0xFF99CCCC, 0xFF99FFCC, 0xFF9900FF, 0xFF9933FF, 0xFF9966FF, 0xFF9999FF, 0xFF99CCFF, 0xFF99FFFF,
0xFFCC0000, 0xFFCC3300, 0xFFCC6600, 0xFFCC9900, 0xFFCCCC00, 0xFFCCFF00, 0xFFCC0033, 0xFFCC3333,
0xFFCC6633, 0xFFCC9933, 0xFFCCCC33, 0xFFCCFF33, 0xFFCC0066, 0xFFCC3366, 0xFFCC6666, 0xFFCC9966,
0xFFCCCC66, 0xFFCCFF66, 0xFFCC0099, 0xFFCC3399, 0xFFCC6699, 0xFFCC9999, 0xFFCCCC99, 0xFFCCFF99,
0xFFCC00CC, 0xFFCC33CC, 0xFFCC66CC, 0xFFCC99CC, 0xFFCCCCCC, 0xFFCCFFCC, 0xFFCC00FF, 0xFFCC33FF,
0xFFCC66FF, 0xFFCC99FF, 0xFFCCCCFF, 0xFFCCFFFF, 0xFFFF0000, 0xFFFF3300, 0xFFFF6600, 0xFFFF9900,
0xFFFFCC00, 0xFFFFFF00, 0xFFFF0033, 0xFFFF3333, 0xFFFF6633, 0xFFFF9933, 0xFFFFCC33, 0xFFFFFF33,
0xFFFF0066, 0xFFFF3366, 0xFFFF6666, 0xFFFF9966, 0xFFFFCC66, 0xFFFFFF66, 0xFFFF0099, 0xFFFF3399,
0xFFFF6699, 0xFFFF9999, 0xFFFFCC99, 0xFFFFFF99, 0xFFFF00CC, 0xFFFF33CC, 0xFFFF66CC, 0xFFFF99CC,
0xFFFFCCCC, 0xFFFFFFCC, 0xFFFF00FF, 0xFFFF33FF, 0xFFFF66FF, 0xFFFF99FF, 0xFFFFCCFF, 0xFFFFFFFF};'>
^theTable!
Item was changed:
----- Method: BitBltSimulation>>fetchIntOrFloat:ofObject: (in category 'interpreter interface') -----
fetchIntOrFloat: fieldIndex ofObject: objectPointer
"Return the integer value of the given field of the given object. If the field contains a Float, truncate it and return its integral part. Fail if the given field does not contain a small integer or Float, or if the truncated Float is out of the range of small integers."
| fieldOop floatValue |
+ <var: #floatValue type:'double '>
- <var: #floatValue type: 'double '>
fieldOop := interpreterProxy fetchPointer: fieldIndex ofObject: objectPointer.
(interpreterProxy isIntegerObject: fieldOop)
ifTrue:[^interpreterProxy integerValueOf: fieldOop].
floatValue := interpreterProxy floatValueOf: fieldOop.
(-2147483648.0 <= floatValue and:[floatValue <= 2147483647.0])
ifFalse:[interpreterProxy primitiveFail. ^0].
^floatValue asInteger!
Item was changed:
----- Method: BitBltSimulation>>fetchIntOrFloat:ofObject:ifNil: (in category 'interpreter interface') -----
fetchIntOrFloat: fieldIndex ofObject: objectPointer ifNil: defaultValue
"Return the integer value of the given field of the given object. If the field contains a Float, truncate it and return its integral part. Fail if the given field does not contain a small integer or Float, or if the truncated Float is out of the range of small integers."
| fieldOop floatValue |
+ <var: #floatValue type:'double '>
- <var: #floatValue type: 'double '>
fieldOop := interpreterProxy fetchPointer: fieldIndex ofObject: objectPointer.
(interpreterProxy isIntegerObject: fieldOop)
ifTrue:[^interpreterProxy integerValueOf: fieldOop].
(fieldOop = interpreterProxy nilObject) ifTrue:[^defaultValue].
floatValue := interpreterProxy floatValueOf: fieldOop.
(-2147483648.0 <= floatValue and:[floatValue <= 2147483647.0])
ifFalse:[interpreterProxy primitiveFail. ^0].
^floatValue asInteger!
Item was changed:
----- Method: BitBltSimulation>>isIdentityMap:with: (in category 'interpreter interface') -----
isIdentityMap: shifts with: masks
"Return true if shiftTable/maskTable define an identity mapping."
+ <var: #shifts type:'int *'>
+ <var: #masks type:'unsigned int *'>
- <var: #shifts type: 'int *'>
- <var: #masks type: 'unsigned int *'>
(shifts == nil or:[masks == nil]) ifTrue:[^true].
((shifts at: RedIndex) = 0
and:[(shifts at: GreenIndex) = 0
and:[(shifts at: BlueIndex) = 0
and:[(shifts at: AlphaIndex) = 0
and:[((masks at: RedIndex) = 16rFF0000)
and:[((masks at: GreenIndex) = 16r00FF00)
and:[((masks at: BlueIndex) = 16r0000FF)
and:[((masks at: AlphaIndex) = 16rFF000000)]]]]]]])
ifTrue:[^true].
^false!
Item was changed:
----- Method: BitBltSimulation>>loadColorMapShiftOrMaskFrom: (in category 'interpreter interface') -----
loadColorMapShiftOrMaskFrom: mapOop
+ <returnTypeC:'void *'>
- <returnTypeC: 'void *'>
mapOop = interpreterProxy nilObject ifTrue:[^nil].
(interpreterProxy isIntegerObject: mapOop)
ifTrue:[interpreterProxy primitiveFail. ^nil].
((interpreterProxy isWords: mapOop)
and:[(interpreterProxy slotSizeOf: mapOop) = 4])
ifFalse:[interpreterProxy primitiveFail. ^nil].
^interpreterProxy firstIndexableField: mapOop!
Item was changed:
----- Method: BitBltSimulation>>lockSurfaces (in category 'surface support') -----
lockSurfaces
"Get a pointer to the bits of any OS surfaces."
"Notes:
* For equal source/dest handles only one locking operation is performed.
This is to prevent locking of overlapping areas which does not work with
certain APIs (as an example, DirectDraw prevents locking of overlapping areas).
A special case for non-overlapping but equal source/dest handle would
be possible but we would have to transfer this information over to
unlockSurfaces somehow (currently, only one unlock operation is
performed for equal source and dest handles). Also, this would require
a change in the notion of ioLockSurface() which is right now interpreted
as a hint and not as a requirement to lock only the specific portion of
the surface.
* The arguments in ioLockSurface() provide the implementation with
an explicit hint what area is affected. It can be very useful to
know the max. affected area beforehand if getting the bits requires expensive
copy operations (e.g., like a roundtrip to the X server or a glReadPixel op).
However, the returned pointer *MUST* point to the virtual origin of the surface
and not to the beginning of the rectangle. The promise made by BitBlt
is to never access data outside the given rectangle (aligned to 4byte boundaries!!)
so it is okay to return a pointer to the virtual origin that is actually outside
the valid memory area.
* The area provided in ioLockSurface() is already clipped (e.g., it will always
be inside the source and dest boundingBox) but it is not aligned to word boundaries
yet. It is up to the support code to compute accurate alignment if necessary.
* Warping always requires the entire source surface to be locked because
there is no beforehand knowledge about what area will actually be traversed.
"
| sourceHandle destHandle l r t b fn |
<inline: true>
+ <var: #fn declareC:'sqInt (*fn)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'>
- <var: #fn declareC: 'sqInt (*fn)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'>
hasSurfaceLock := false.
destBits = 0 ifTrue:["Blitting *to* OS surface"
lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
fn := self cCoerce: lockSurfaceFn to: 'sqInt (*)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'.
destHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: destForm.
(sourceBits = 0 and:[noSource not]) ifTrue:[
sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
"Handle the special case of equal source and dest handles"
(sourceHandle = destHandle) ifTrue:[
"If we have overlapping source/dest we lock the entire area
so that there is only one area transmitted"
isWarping ifFalse:[
"When warping we always need the entire surface for the source"
sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0,0, sourceWidth, sourceHeight)'.
] ifTrue:[
"Otherwise use overlapping area"
l := sx min: dx. r := (sx max: dx) + bbW.
t := sy min: dy. b := (sy max: sy) + bbH.
sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, l, t, r-l, b-t)'.
].
destBits := sourceBits.
destPitch := sourcePitch.
hasSurfaceLock := true.
^destBits ~~ 0
].
"Fall through - if not equal it'll be handled below"
].
destBits := self cCode:'fn(destHandle, &destPitch, dx, dy, bbW, bbH)'.
hasSurfaceLock := true.
].
(sourceBits == 0 and:[noSource not]) ifTrue:["Blitting *from* OS surface"
sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
fn := self cCoerce: lockSurfaceFn to: 'sqInt (*)(sqInt, sqInt*, sqInt, sqInt, sqInt, sqInt)'.
"Warping requiring the entire surface"
isWarping ifTrue:[
sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0, 0, sourceWidth, sourceHeight)'.
] ifFalse:[
sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, sx, sy, bbW, bbH)'.
].
hasSurfaceLock := true.
].
^destBits ~~ 0 and:[sourceBits ~~ 0 or:[noSource]].!
Item was changed:
----- Method: BitBltSimulation>>setupColorMasksFrom:to: (in category 'interpreter interface') -----
setupColorMasksFrom: srcBits to: targetBits
"Setup color masks for converting an incoming RGB pixel value from srcBits to targetBits."
| mask shifts masks deltaBits |
+ <var: #shifts declareC:'static int shifts[4] = {0, 0, 0, 0}'>
+ <var: #masks declareC:'static unsigned int masks[4] = {0, 0, 0, 0}'>
- <var: #shifts declareC: 'static int shifts[4] = {0, 0, 0, 0}'>
- <var: #masks declareC: 'static unsigned int masks[4] = {0, 0, 0, 0}'>
self cCode:'' inSmalltalk:[
shifts := CArrayAccessor on: (IntegerArray new: 4).
masks := CArrayAccessor on: (WordArray new: 4).
].
deltaBits := targetBits - srcBits.
deltaBits = 0 ifTrue:[^0].
deltaBits <= 0
ifTrue:[ mask := 1 << targetBits - 1.
"Mask for extracting a color part of the source"
masks at: RedIndex put: mask << (srcBits*2 - deltaBits).
masks at: GreenIndex put: mask << (srcBits - deltaBits).
masks at: BlueIndex put: mask << (0 - deltaBits).
masks at: AlphaIndex put: 0]
ifFalse:[ mask := 1 << srcBits - 1.
"Mask for extracting a color part of the source"
masks at: RedIndex put: mask << (srcBits*2).
masks at: GreenIndex put: mask << srcBits.
masks at: BlueIndex put: mask].
"Shifts for adjusting each value in a cm RGB value"
shifts at: RedIndex put: deltaBits * 3.
shifts at: GreenIndex put: deltaBits * 2.
shifts at: BlueIndex put: deltaBits.
shifts at: AlphaIndex put: 0.
cmShiftTable := shifts.
cmMaskTable := masks.
cmFlags := cmFlags bitOr: (ColorMapPresent bitOr: ColorMapFixedPart).
!
Item was changed:
----- Method: BitBltSimulation>>unlockSurfaces (in category 'surface support') -----
unlockSurfaces
"Unlock the bits of any OS surfaces."
"See the comment in lockSurfaces. Similar rules apply. That is, the area provided in ioUnlockSurface can be used to determine the dirty region after drawing. If a source is unlocked, then the area will be (0,0,0,0) to indicate that no portion is dirty."
| sourceHandle destHandle destLocked fn |
+ <var: #fn declareC:'sqInt (*fn)(sqInt, sqInt, sqInt, sqInt, sqInt)'>
- <var: #fn declareC: 'sqInt (*fn)(sqInt, sqInt, sqInt, sqInt, sqInt)'>
hasSurfaceLock ifTrue:[
unlockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
fn := self cCoerce: unlockSurfaceFn to: 'sqInt (*)(sqInt, sqInt, sqInt, sqInt, sqInt)'.
destLocked := false.
destHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: destForm.
(interpreterProxy isIntegerObject: destHandle) ifTrue:[
destHandle := interpreterProxy integerValueOf: destHandle.
"The destBits are always assumed to be dirty"
self cCode:'fn(destHandle, affectedL, affectedT, affectedR-affectedL, affectedB-affectedT)'.
destBits := destPitch := 0.
destLocked := true.
].
noSource ifFalse:[
sourceHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: sourceForm.
(interpreterProxy isIntegerObject: sourceHandle) ifTrue:[
sourceHandle := interpreterProxy integerValueOf: sourceHandle.
"Only unlock sourceHandle if different from destHandle"
(destLocked and:[sourceHandle = destHandle])
ifFalse:[self cCode: 'fn(sourceHandle, 0, 0, 0, 0)'].
sourceBits := sourcePitch := 0.
].
].
hasSurfaceLock := false.
].!
Item was added:
+ InterpreterPlugin subclass: #BrokenPlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
+
+ !BrokenPlugin commentStamp: '<historical>' prior: 0!
+ A test plugin to exercise imbalanced stack access.!
Item was added:
+ ----- Method: BrokenPlugin class>>testNoPopButPush (in category 'tests') -----
+ testNoPopButPush
+ "BrokenPlugin testNoPopButPush"
+ <primitive: 'primitiveNoPopButPush' module: 'BrokenPlugin'>
+ !
Item was added:
+ ----- Method: BrokenPlugin class>>testPopAndFail (in category 'tests') -----
+ testPopAndFail
+ "BrokenPlugin testPopAndFail"
+ <primitive: 'primitivePopAndFail' module: 'BrokenPlugin'>
+ !
Item was added:
+ ----- Method: BrokenPlugin class>>testPopLessThanExpected:with: (in category 'tests') -----
+ testPopLessThanExpected: arg1 with: arg2
+ "BrokenPlugin testPopLessThanExpected: 3 with: 4"
+ <primitive: 'primitivePopLessThanExpected' module: 'BrokenPlugin'>
+ !
Item was added:
+ ----- Method: BrokenPlugin class>>testPopMoreThanExpected (in category 'tests') -----
+ testPopMoreThanExpected
+ "BrokenPlugin testPopMoreThanExpected"
+ <primitive: 'primitivePopMoreThanExpected' module: 'BrokenPlugin'>
+ !
Item was added:
+ ----- Method: BrokenPlugin>>primitiveNoPopButPush (in category 'primitives') -----
+ primitiveNoPopButPush
+ "Doesn't pop anything but pushes return value"
+ <export: true>
+ interpreterProxy pushBool: true.!
Item was added:
+ ----- Method: BrokenPlugin>>primitivePopAndFail (in category 'primitives') -----
+ primitivePopAndFail
+ "Pops in a failing primitive"
+ <export: true>
+ interpreterProxy pop: interpreterProxy methodArgumentCount + 1.
+ interpreterProxy primitiveFail.!
Item was added:
+ ----- Method: BrokenPlugin>>primitivePopLessThanExpected (in category 'primitives') -----
+ primitivePopLessThanExpected
+ "Pops less than expected; call this with two arguments."
+ <export: true>
+ interpreterProxy pop: interpreterProxy methodArgumentCount - 1.
+ !
Item was added:
+ ----- Method: BrokenPlugin>>primitivePopMoreThanExpected (in category 'primitives') -----
+ primitivePopMoreThanExpected
+ "Pops more than expected"
+ <export: true>
+ interpreterProxy pop: interpreterProxy methodArgumentCount + 4.
+ !
Item was changed:
----- Method: CCodeGenerator>>emitCHeaderOn: (in category 'C code generator') -----
emitCHeaderOn: aStream
"Write a C file header onto the given stream."
aStream nextPutAll: '/* '.
aStream nextPutAll: VMMaker headerNotice.
+ aStream nextPutAll: ' */'; cr;
+ nextPutAll: (self fileHeaderVersionStampForSourceClass: vmClass);
+ cr; cr.
- aStream nextPutAll: ' */'; cr.
- self fileHeaderVersionStampForSourceClass: vmClass.
- aStream cr; cr.
self emitGlobalStructFlagOn: aStream.
aStream nextPutAll: '#include "sq.h"'; cr.
"Additional header files"
headerFiles do:[:hdr|
aStream nextPutAll:'#include '; nextPutAll: hdr; cr].
"Default definitions for optional functions, provided for backward compatibility"
self emitDefaultMacrosOn: aStream.
aStream nextPutAll: '
#include "sqMemoryAccess.h"
sqInt printCallStack(void);
void defaultErrorProc(char *s) {
/* Print an error message and exit. */
static sqInt printingStack = false;
printf("\n%s\n\n", s);
if (!!printingStack) {
/* flag prevents recursive error when trying to print a broken stack */
printingStack = true;
printCallStack();
}
exit(-1);
}
'.
aStream cr.!
Item was changed:
----- Method: CCodeGenerator>>storeHeaderFor:onFile: (in category 'public') -----
storeHeaderFor: interpreterClassName onFile: fileName
"Store C header code for this interpreter on the given file."
| aStream |
aStream := CrLfFileStream forceNewFileNamed: fileName.
aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
aStream
nextPutAll: '/* ';
nextPutAll: VMMaker headerNotice;
+ nextPutAll: ' */'; cr; cr;
+ nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr; cr;
- nextPutAll: ' */'; cr; cr.
- self fileHeaderVersionStampForSourceClass: vmClass.
- aStream cr; cr;
nextPutAll: '#ifndef HAVE_INTERP_H'; cr;
nextPutAll: '# define HAVE_INTERP_H'; cr;
nextPutAll: '#endif'; cr; cr.
self emitVmmVersionOn: aStream.
(Smalltalk classNamed: interpreterClassName)
emitInterpreterProxyVersionOn: aStream.
self emitDefineBytesPerWordOn: aStream.
self emitDefineMemoryAccessInImageOn: aStream.
aStream cr.
aStream close
!
Item was changed:
+ ----- Method: CroquetPlugin class>>hasHeaderFile (in category 'translation') -----
- ----- Method: CroquetPlugin class>>hasHeaderFile (in category 'as yet unclassified') -----
hasHeaderFile
"If there is a single intrinsic header file to be associated with the plugin, here is where you want to flag"
^true!
Item was changed:
+ ----- Method: CroquetPlugin class>>requiresCrossPlatformFiles (in category 'translation') -----
- ----- Method: CroquetPlugin class>>requiresCrossPlatformFiles (in category 'as yet unclassified') -----
requiresCrossPlatformFiles
"default is ok for most, any plugin needing platform specific files must say so"
^true!
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
"
| y x mOop stopIndex startIndex bufOop bufSize buffer a m b mask ptOop xOop yOop |
<export: true>
<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 stackObjectValue: 2.
stopIndex := interpreterProxy stackIntegerValue: 3.
startIndex := interpreterProxy stackIntegerValue: 4.
bufOop := interpreterProxy stackObjectValue: 5.
interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isBytes: mOop) and:[interpreterProxy isBytes: bufOop])
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy byteSizeOf: mOop) = 256
ifFalse:[^interpreterProxy primitiveFail].
bufSize := interpreterProxy byteSizeOf: bufOop.
(startIndex > 0 and:[startIndex <= bufSize])
ifFalse:[^interpreterProxy primitiveFail].
+ (stopIndex >= startIndex and:[stopIndex <= bufSize])
- (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.
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 pop: interpreterProxy methodArgumentCount + 1.
+ ^interpreterProxy push: ptOop.
- interpreterProxy push: ptOop.
!
Item was added:
+ ----- Method: CroquetPlugin>>primitiveAdj3 (in category 'transforms') -----
+ primitiveAdj3
+ "Computes the adjoint of the Matrix4x4 receiver,
+ placing the results the the Matrix4x4 argument,
+ "
+ |
+ argc
+ srcOop src
+ dstOop dst
+ m11 m12 m13 m21 m22 m23 m31 m32 m33
+ c11 c12 c13 c21 c22 c23 c31 c32 c33
+
+ |
+ <export: true>
+ <inline: true>
+ <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: #src type: 'float *'>
+ <var: #dst type: 'float *'>
+ <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."
+
+ "do the dance to get our receiver and argument"
+ argc := interpreterProxy methodArgumentCount.
+ argc = 1
+ ifFalse:[^interpreterProxy primitiveFail].
+
+ "stackArgvObject is something I added to Interpreter, but since it's not in there yet,
+ this won't compile - use it when it's there. Yes, it would be nice if Smalltalk had #ifdefs..."
+ self flag: #stackArgv.
+ "
+ srcOop := interpreterProxy stackArgvObject: 0.
+ src := interpreterProxy firstIndexableField: srcOop.
+
+ dstOop := interpreterProxy stackArgvObject: 1.
+ dst := interpreterProxy firstIndexableField: dstOop.
+ "
+ srcOop := interpreterProxy stackObjectValue: argc.
+ src := interpreterProxy firstIndexableField: srcOop.
+
+ dstOop := interpreterProxy stackObjectValue: (argc - 1).
+ dst := interpreterProxy firstIndexableField: dstOop.
+
+
+ "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 pop: argc + 1.
+ ^interpreterProxy push: dstOop.
+ !
Item was added:
+ ----- Method: CroquetPlugin>>primitiveDet3 (in category 'transforms') -----
+ primitiveDet3
+ "Computes the determinant of the upper 3x3 of a Matrix4x4"
+ | argc srcOop src det m11 m12 m13 m21 m22 m23 m31 m32 m33 |
+ <export: true>
+ <inline: true>
+ <var: #src type: 'float *'>
+ <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: #det type: 'double'>
+
+ argc := interpreterProxy methodArgumentCount.
+ argc = 0
+ ifFalse:[^interpreterProxy primitiveFail].
+
+
+ "
+ 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
+ "
+
+ "stackArgvObject is something I added to Interpreter, but since it's not in there yet,
+ this won't compile - use it when it's there. Yes, it would be nice if Smalltalk had #ifdefs..."
+ self flag: #stackArgv.
+ "
+ srcOop := interpreterProxy stackArgvObject: 0.
+ src := interpreterProxy firstIndexableField: srcOop.
+ "
+ srcOop := interpreterProxy stackObjectValue: argc.
+ src := interpreterProxy firstIndexableField: srcOop.
+
+
+ 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.
+
+
+ "do the actual work"
+ det :=
+ ( m11 * ((m22 * m33) - (m23 * m32))) +
+ (m12 * ((m23 * m31) - (m21 * m33))) +
+ (m13 * ((m21 * m32) - (m22 * m31))).
+
+
+ interpreterProxy pop: argc + 1.
+ ^interpreterProxy pushFloat: det.
+ !
Item was changed:
----- Method: CroquetPlugin>>primitiveGatherEntropy (in category 'cryptography') -----
primitiveGatherEntropy
"Primitive. Gather good random entropy from a system source."
| bufOop bufSize bufPtr okay |
<export: true>
<var: 'bufPtr' type: 'void *'>
(interpreterProxy methodArgumentCount = 1)
ifFalse:[^interpreterProxy primitiveFail].
bufOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isBytes: bufOop)
ifFalse:[^interpreterProxy primitiveFail].
bufSize := interpreterProxy byteSizeOf: bufOop.
bufPtr := interpreterProxy firstIndexableField: bufOop.
okay := self cCode: 'ioGatherEntropy(bufPtr, bufSize)' inSmalltalk:[bufPtr. bufSize. false].
okay ifFalse:[^interpreterProxy primitiveFail].
interpreterProxy pop: interpreterProxy methodArgumentCount + 1.
+ ^interpreterProxy pushBool: true.!
- interpreterProxy pushBool: true.!
Item was changed:
----- Method: CroquetPlugin>>primitiveInplaceHouseHolderInvert (in category 'transforms') -----
primitiveInplaceHouseHolderInvert
"Primitive. Perform an inplace house holder matrix inversion"
| rcvr d x sigma beta sum s m |
<export: true>
+ <var: #rcvr declareC:'float *rcvr'>
+ <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 declareC:'double sigma'>
+ <var: #beta declareC:'double beta'>
+ <var: #sum declareC:'double sum'>
+ <var: #s declareC:'double s'>
- <var: #rcvr declareC: 'float *rcvr'>
- <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 declareC: 'double sigma'>
- <var: #beta declareC: 'double beta'>
- <var: #sum declareC: 'double sum'>
- <var: #s declareC: 'double s'>
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.
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!
- "Return receiver"!
Item was added:
+ ----- 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,
+ "
+ |
+ 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
+ argc |
+ <export: true>
+ <inline: true>
+ <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: #src type: 'float *'>
+ <var: #dst type: 'float *'>
+ <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"
+ argc := interpreterProxy methodArgumentCount.
+ argc = 1
+ ifFalse:[^interpreterProxy primitiveFail].
+
+ "stackArgvObject is something I added to Interpreter, but since it's not in there yet,
+ this won't compile - use it when it's there. Yes, it would be nice if Smalltalk had #ifdefs..."
+ self flag: #stackArgv.
+ "
+ srcOop := interpreterProxy stackArgvObject: 0.
+ src := interpreterProxy firstIndexableField: srcOop.
+
+ dstOop := interpreterProxy stackArgvObject: 1.
+ dst := interpreterProxy firstIndexableField: dstOop.
+ "
+ srcOop := interpreterProxy stackObjectValue: argc.
+ src := interpreterProxy firstIndexableField: srcOop.
+
+ dstOop := interpreterProxy stackObjectValue: (argc - 1).
+ dst := interpreterProxy firstIndexableField: dstOop.
+
+
+ "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 pop: argc + 1.
+ ^interpreterProxy push: dstOop.
+ !
Item was changed:
----- Method: CroquetPlugin>>primitiveMD5Transform (in category 'cryptography') -----
primitiveMD5Transform
"Perform an MD5 transform of input"
| bufOop hashOop hash buffer |
<export: true>
<var: 'hash' type: 'unsigned int *'>
<var: 'buffer' type: 'unsigned int *'>
interpreterProxy methodArgumentCount = 2
ifFalse:[^interpreterProxy primitiveFail].
hashOop := interpreterProxy stackObjectValue: 0.
((interpreterProxy isWords: hashOop) and:[(interpreterProxy slotSizeOf: hashOop) = 4])
ifFalse:[^interpreterProxy primitiveFail].
hash := interpreterProxy firstIndexableField: hashOop.
bufOop := interpreterProxy stackObjectValue: 1.
((interpreterProxy isWords: bufOop) and:[(interpreterProxy slotSizeOf: bufOop) = 16])
ifFalse:[^interpreterProxy primitiveFail].
buffer := interpreterProxy firstIndexableField: bufOop.
self cCode:'MD5Transform(hash, buffer)' inSmalltalk:[
hash. buffer.
^interpreterProxy primitiveFail].
"Pop args; return buffer"
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
+ ^interpreterProxy push: bufOop.!
- interpreterProxy push: bufOop.!
Item was changed:
----- Method: CroquetPlugin>>primitiveOrthoNormInverseMatrix (in category 'transforms') -----
primitiveOrthoNormInverseMatrix
| srcOop dstOop src dst x y z rx ry rz |
<export: true>
+ <var: #src declareC:'float *src'>
+ <var: #dst declareC:'float *dst'>
+ <var: #x declareC:'double x'>
+ <var: #y declareC:'double y'>
+ <var: #z declareC:'double z'>
+ <var: #rx declareC:'double rx'>
+ <var: #ry declareC:'double ry'>
+ <var: #rz declareC:'double rz'>
- <var: #src declareC: 'float *src'>
- <var: #dst declareC: 'float *dst'>
- <var: #x declareC: 'double x'>
- <var: #y declareC: 'double y'>
- <var: #z declareC: 'double z'>
- <var: #rx declareC: 'double rx'>
- <var: #ry declareC: 'double ry'>
- <var: #rz declareC: 'double rz'>
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFail].
srcOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16])
ifFalse:[^interpreterProxy primitiveFail].
dstOop := interpreterProxy clone: srcOop.
"reload srcOop in case of GC"
srcOop := interpreterProxy stackObjectValue: 0.
src := interpreterProxy firstIndexableField: srcOop.
dst := interpreterProxy firstIndexableField: dstOop.
"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: (self cCoerce: 0.0-rx to: 'float').
dst at: 7 put: (self cCoerce: 0.0-ry to: 'float').
dst at: 11 put: (self cCoerce: 0.0-rz to: 'float').
interpreterProxy pop: 1.
+ ^interpreterProxy push: dstOop.
- interpreterProxy push: dstOop.
!
Item was changed:
----- Method: CroquetPlugin>>primitiveTransformDirection (in category 'transforms') -----
primitiveTransformDirection
| x y z rx ry rz matrix vertex v3Oop |
<export: true>
+ <var: #vertex declareC:'float *vertex'>
+ <var: #matrix declareC:'float *matrix'>
+ <var: #x declareC:'double x'>
+ <var: #y declareC:'double y'>
+ <var: #z declareC:'double z'>
+ <var: #rx declareC:'double rx'>
+ <var: #ry declareC:'double ry'>
+ <var: #rz declareC:'double rz'>
- <var: #vertex declareC: 'float *vertex'>
- <var: #matrix declareC: 'float *matrix'>
- <var: #x declareC: 'double x'>
- <var: #y declareC: 'double y'>
- <var: #z declareC: 'double z'>
- <var: #rx declareC: 'double rx'>
- <var: #ry declareC: 'double ry'>
- <var: #rz declareC: 'double rz'>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFail].
v3Oop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3])
ifFalse:[^interpreterProxy primitiveFail].
vertex := interpreterProxy firstIndexableField: v3Oop.
matrix := self stackMatrix: 1.
(matrix == nil) ifTrue:[^interpreterProxy primitiveFail].
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 clone: v3Oop.
vertex := interpreterProxy firstIndexableField: v3Oop.
vertex at: 0 put: (self cCoerce: rx to: 'float').
vertex at: 1 put: (self cCoerce: ry to:'float').
vertex at: 2 put: (self cCoerce: rz to: 'float').
interpreterProxy pop: 2.
+ ^interpreterProxy push: v3Oop.
- interpreterProxy push: v3Oop.
!
Item was changed:
----- Method: CroquetPlugin>>primitiveTransformMatrixWithInto (in category 'transforms') -----
primitiveTransformMatrixWithInto
"Transform two matrices into the third"
| m1 m2 m3 |
<export: true>
<inline: false>
+ <var: #m1 declareC:'float *m1'>
+ <var: #m2 declareC:'float *m2'>
+ <var: #m3 declareC:'float *m3'>
- <var: #m1 declareC: 'float *m1'>
- <var: #m2 declareC: 'float *m2'>
- <var: #m3 declareC: 'float *m3'>
m3 := self stackMatrix: 0.
m2 := self stackMatrix: 1.
m1 := self stackMatrix: 2.
(m1 = nil) | (m2 = nil) | (m3 = nil)
ifTrue:[^interpreterProxy primitiveFail].
m2 == m3 ifTrue:[^interpreterProxy primitiveFail].
self transformMatrix: m1 with: m2 into: m3.
+ ^interpreterProxy pop: 3. "Leave rcvr on stack"!
- interpreterProxy pop: 3. "Leave rcvr on stack"!
Item was changed:
----- Method: CroquetPlugin>>primitiveTransformVector3 (in category 'transforms') -----
primitiveTransformVector3
| x y z rx ry rz rw matrix vertex v3Oop |
<export: true>
+ <var: #vertex declareC:'float *vertex'>
+ <var: #matrix declareC:'float *matrix'>
+ <var: #x declareC:'double x'>
+ <var: #y declareC:'double y'>
+ <var: #z declareC:'double z'>
+ <var: #rx declareC:'double rx'>
+ <var: #ry declareC:'double ry'>
+ <var: #rz declareC:'double rz'>
+ <var: #rw declareC:'double rw'>
- <var: #vertex declareC: 'float *vertex'>
- <var: #matrix declareC: 'float *matrix'>
- <var: #x declareC: 'double x'>
- <var: #y declareC: 'double y'>
- <var: #z declareC: 'double z'>
- <var: #rx declareC: 'double rx'>
- <var: #ry declareC: 'double ry'>
- <var: #rz declareC: 'double rz'>
- <var: #rw declareC: 'double rw'>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFail].
v3Oop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3])
ifFalse:[^interpreterProxy primitiveFail].
vertex := interpreterProxy firstIndexableField: v3Oop.
matrix := self stackMatrix: 1.
(matrix == nil) ifTrue:[^interpreterProxy primitiveFail].
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 clone: v3Oop.
vertex := interpreterProxy firstIndexableField: v3Oop.
rw = 1.0 ifTrue:[
vertex at: 0 put: (self cCoerce: rx to: 'float').
vertex at: 1 put: (self cCoerce: ry to:'float').
vertex at: 2 put: (self cCoerce: rz to: 'float').
] ifFalse:[
rw = 0.0
ifTrue:[rw := 0.0]
ifFalse:[rw := 1.0 / rw].
vertex at: 0 put: (self cCoerce: rx*rw to:'float').
vertex at: 1 put: (self cCoerce: ry*rw to:'float').
vertex at: 2 put: (self cCoerce: rz*rw to: 'float').
].
interpreterProxy pop: 2.
+ ^interpreterProxy push: v3Oop.
- interpreterProxy push: v3Oop.
!
Item was changed:
----- Method: CroquetPlugin>>primitiveTransposeMatrix (in category 'transforms') -----
primitiveTransposeMatrix
| srcOop dstOop src dst |
<export: true>
+ <var: #src declareC:'float *src'>
+ <var: #dst declareC:'float *dst'>
- <var: #src declareC: 'float *src'>
- <var: #dst declareC: 'float *dst'>
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFail].
srcOop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16])
ifFalse:[^interpreterProxy primitiveFail].
dstOop := interpreterProxy clone: srcOop.
"reload srcOop in case of GC"
srcOop := interpreterProxy stackObjectValue: 0.
src := interpreterProxy firstIndexableField: srcOop.
dst := interpreterProxy firstIndexableField: dstOop.
"dst at: 0 put: (src at: 0)."
dst at: 1 put: (src at: 4).
dst at: 2 put: (src at: 8).
dst at: 3 put: (src at: 12).
dst at: 4 put: (src at: 1).
"dst at: 5 put: (src at: 5)."
dst at: 6 put: (src at: 9).
dst at: 7 put: (src at: 13).
dst at: 8 put: (src at: 2).
dst at: 9 put: (src at: 6).
"dst at: 10 put: (src at: 10)."
dst at: 11 put: (src at: 14).
dst at: 12 put: (src at: 3).
dst at: 13 put: (src at: 7).
dst at: 14 put: (src at: 11).
"dst at: 15 put: (src at: 15)."
interpreterProxy pop: 1.
+ ^interpreterProxy push: dstOop.
- interpreterProxy push: dstOop.
!
Item was changed:
----- Method: CroquetPlugin>>primitiveTriBoxIntersects (in category 'transforms') -----
primitiveTriBoxIntersects
"Primitive. Answer whether an AABB intersects with a given triangle"
| minCorner maxCorner v0 v1 v2 result |
<export: true>
+ <var: #minCorner type: #'float *'>
+ <var: #maxCorner type: #'float *'>
+ <var: #v0 type: #'float *'>
+ <var: #v1 type: #'float *'>
+ <var: #v2 type: #'float *'>
- <var: #minCorner type: 'float*'>
- <var: #maxCorner type: 'float*'>
- <var: #v0 type: 'float*'>
- <var: #v1 type: 'float*'>
- <var: #v2 type: 'float*'>
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
v2 := self stackVector3: 0.
v1 := self stackVector3: 1.
v0 := self stackVector3: 2.
maxCorner := self stackVector3: 3.
minCorner := self stackVector3: 4.
result := self cCode:'triBoxOverlap(minCorner, maxCorner, v0, v1, v2)'
inSmalltalk:[minCorner. maxCorner. v0. v1. v2. -1].
result < 0 ifTrue:[^interpreterProxy primitiveFail].
interpreterProxy pop: 6. "args+rcvr"
+ ^interpreterProxy pushBool: result.!
- interpreterProxy pushBool: result.!
Item was changed:
----- Method: CroquetPlugin>>stackMatrix: (in category 'transforms') -----
stackMatrix: index
"Load a 4x4 transformation matrix from the interpreter stack.
Return a pointer to the matrix data if successful, nil otherwise."
| oop |
<inline: false>
+ <returnTypeC:'void*'>
- <returnTypeC: 'void*'>
oop := interpreterProxy stackObjectValue: index.
oop = nil ifTrue:[^nil].
((interpreterProxy isWords: oop) and:[(interpreterProxy slotSizeOf: oop) = 16])
ifTrue:[^interpreterProxy firstIndexableField: oop].
^nil!
Item was changed:
----- Method: CroquetPlugin>>stackVector3: (in category 'transforms') -----
stackVector3: index
"Load a Vector3 from the interpreter stack.
Return a pointer to the float data if successful, nil otherwise."
| oop |
<inline: false>
+ <returnTypeC:'void*'>
- <returnTypeC: 'void*'>
oop := interpreterProxy stackObjectValue: index.
oop = nil ifTrue:[^nil].
((interpreterProxy isWords: oop) and:[(interpreterProxy slotSizeOf: oop) = 3])
ifTrue:[^interpreterProxy firstIndexableField: oop].
^nil!
Item was changed:
----- Method: CroquetPlugin>>transformMatrix:with:into: (in category 'transforms') -----
transformMatrix: src with: arg into: dst
"Transform src with arg into dst.
It is allowed that src == dst but not arg == dst"
| m1 m2 m3 c1 c2 c3 c4 |
+ <var: #src declareC:'float *src'>
+ <var: #arg declareC:'float *arg'>
+ <var: #dst declareC:'float *dst'>
+ <var: #m1 declareC:'float *m1'>
+ <var: #m2 declareC:'float *m2'>
+ <var: #m3 declareC:'float *m3'>
- <var: #src declareC: 'float *src'>
- <var: #arg declareC: 'float *arg'>
- <var: #dst declareC: 'float *dst'>
- <var: #m1 declareC: 'float *m1'>
- <var: #m2 declareC: 'float *m2'>
- <var: #m3 declareC: 'float *m3'>
- <var: #c1 declareC: 'float c1'>
- <var: #c2 declareC: 'float c2'>
- <var: #c3 declareC: 'float c3'>
- <var: #c4 declareC: 'float c4'>
+ <var: #c1 declareC:'double c1'>
+ <var: #c2 declareC:'double c2'>
+ <var: #c3 declareC:'double c3'>
+ <var: #c4 declareC:'double c4'>
+
m1 := self cCoerce: src to:'float *'.
m2 := self cCoerce: arg to: 'float *'.
m3 := self cCoerce: dst to: 'float *'.
0 to: 3 do:[:i|
"Compute next row"
+ c1 := ((m1 at: 0) asFloat * (m2 at: 0) asFloat) + ((m1 at: 1) asFloat * (m2 at: 4) asFloat) +
+ ((m1 at: 2) asFloat * (m2 at: 8) asFloat) + ((m1 at: 3) asFloat * (m2 at: 12) asFloat).
- c1 := ((m1 at: 0) * (m2 at: 0)) + ((m1 at: 1) * (m2 at: 4)) +
- ((m1 at: 2) * (m2 at: 8)) + ((m1 at: 3) * (m2 at: 12)).
+ c2 := ((m1 at: 0) asFloat * (m2 at: 1) asFloat) + ((m1 at: 1) asFloat * (m2 at: 5) asFloat) +
+ ((m1 at: 2) asFloat * (m2 at: 9) asFloat) + ((m1 at: 3) asFloat * (m2 at: 13) asFloat).
- c2 := ((m1 at: 0) * (m2 at: 1)) + ((m1 at: 1) * (m2 at: 5)) +
- ((m1 at: 2) * (m2 at: 9)) + ((m1 at: 3) * (m2 at: 13)).
+ c3 := ((m1 at: 0) asFloat * (m2 at: 2) asFloat) + ((m1 at: 1) asFloat * (m2 at: 6) asFloat) +
+ ((m1 at: 2) asFloat * (m2 at: 10) asFloat) + ((m1 at: 3) asFloat * (m2 at: 14) asFloat).
- c3 := ((m1 at: 0) * (m2 at: 2)) + ((m1 at: 1) * (m2 at: 6)) +
- ((m1 at: 2) * (m2 at: 10)) + ((m1 at: 3) * (m2 at: 14)).
+ c4 := ((m1 at: 0) asFloat * (m2 at: 3) asFloat) + ((m1 at: 1) asFloat * (m2 at: 7) asFloat) +
+ ((m1 at: 2) asFloat * (m2 at: 11) asFloat) + ((m1 at: 3) asFloat * (m2 at: 15) asFloat).
- c4 := ((m1 at: 0) * (m2 at: 3)) + ((m1 at: 1) * (m2 at: 7)) +
- ((m1 at: 2) * (m2 at: 11)) + ((m1 at: 3) * (m2 at: 15)).
"Store result"
m3 at: 0 put: c1.
m3 at: 1 put: c2.
m3 at: 2 put: c3.
m3 at: 3 put: c4.
"Skip src and dst to next row"
m1 := m1 + 4.
m3 := m3 + 4.
].
+
+ ^nil
!
Item was changed:
+ ----- Method: DSAPlugin class>>declareCVarsIn: (in category 'translation') -----
- ----- Method: DSAPlugin class>>declareCVarsIn: (in category 'plugin translation') -----
declareCVarsIn: cg
cg var: #dsaRemainder type: #'unsigned char*'.
cg var: #dsaDivisor type: #'unsigned char*'.
cg var: #dsaQuotient type: #'unsigned char*'!
Item was changed:
+ ----- Method: DSAPlugin class>>moduleName (in category 'translation') -----
- ----- Method: DSAPlugin class>>moduleName (in category 'plugin translation') -----
moduleName
"Time millisecondsToRun: [
DSAPlugin translateDoInlining: true]"
^ 'DSAPrims' "Yes - it needs to be named this way or else we'll not find it"
!
Item was changed:
----- Method: DeflatePlugin>>loadDeflateStreamFrom: (in category 'primitive support') -----
loadDeflateStreamFrom: rcvr
| oop |
<inline: false>
((interpreterProxy isPointers: rcvr) and:[
(interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse:[^false].
oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
(interpreterProxy isIntegerObject: oop)
+ ifTrue:[^false].
- ifTrue:[^interpreterProxy primitiveFail].
(interpreterProxy isBytes: oop)
+ ifFalse:[^false].
- ifFalse:[^interpreterProxy primitiveFail].
zipCollection := interpreterProxy firstIndexableField: oop.
zipCollectionSize := interpreterProxy byteSizeOf: oop.
zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr.
zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr.
"zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr."
oop := interpreterProxy fetchPointer: 4 ofObject: rcvr.
((interpreterProxy isIntegerObject: oop) or:[
(interpreterProxy isWords: oop) not]) ifTrue:[^false].
(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize ifFalse:[^false].
zipHashHead := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 5 ofObject: rcvr.
((interpreterProxy isIntegerObject: oop) or:[
(interpreterProxy isWords: oop) not]) ifTrue:[^false].
(interpreterProxy slotSizeOf: oop) = DeflateWindowSize ifFalse:[^false].
zipHashTail := interpreterProxy firstIndexableField: oop.
zipHashValue := interpreterProxy fetchInteger: 6 ofObject: rcvr.
zipBlockPos := interpreterProxy fetchInteger: 7 ofObject: rcvr.
"zipBlockStart := interpreterProxy fetchInteger: 8 ofObject: rcvr."
oop := interpreterProxy fetchPointer: 9 ofObject: rcvr.
((interpreterProxy isIntegerObject: oop) or:[
(interpreterProxy isBytes: oop) not]) ifTrue:[^false].
zipLiteralSize := interpreterProxy slotSizeOf: oop.
zipLiterals := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 10 ofObject: rcvr.
((interpreterProxy isIntegerObject: oop) or:[
(interpreterProxy isWords: oop) not]) ifTrue:[^false].
(interpreterProxy slotSizeOf: oop) < zipLiteralSize ifTrue:[^false].
zipDistances := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 11 ofObject: rcvr.
((interpreterProxy isIntegerObject: oop) or:[
(interpreterProxy isWords: oop) not]) ifTrue:[^false].
(interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes ifFalse:[^false].
zipLiteralFreq := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 12 ofObject: rcvr.
((interpreterProxy isIntegerObject: oop) or:[
(interpreterProxy isWords: oop) not]) ifTrue:[^false].
(interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes ifFalse:[^false].
zipDistanceFreq := interpreterProxy firstIndexableField: oop.
zipLiteralCount := interpreterProxy fetchInteger: 13 ofObject: rcvr.
zipMatchCount := interpreterProxy fetchInteger: 14 ofObject: rcvr.
^interpreterProxy failed not!
Item was changed:
----- Method: DeflatePlugin>>primitiveDeflateUpdateHashTable (in category 'primitives') -----
primitiveDeflateUpdateHashTable
"Primitive. Update the hash tables after data has been moved by delta."
| delta table tableSize tablePtr entry |
<export: true>
+ <var: #tablePtr type:'int *'>
- <var: #tablePtr type: 'int *'>
interpreterProxy methodArgumentCount = 2
ifFalse:[^interpreterProxy primitiveFail].
delta := interpreterProxy stackIntegerValue: 0.
table := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isWords: table)
ifFalse:[^interpreterProxy primitiveFail].
tableSize := interpreterProxy slotSizeOf: table.
tablePtr := interpreterProxy firstIndexableField: table.
0 to: tableSize-1 do:[:i|
entry := tablePtr at: i.
entry >= delta
ifTrue:[tablePtr at: i put: entry - delta]
ifFalse:[tablePtr at: i put: 0]].
interpreterProxy pop: 2. "Leave rcvr on stack"!
Item was changed:
----- Method: DeflatePlugin>>primitiveUpdateAdler32 (in category 'primitives') -----
primitiveUpdateAdler32
"Primitive. Update a 32bit CRC value."
| collection stopIndex startIndex length bytePtr s1 adler32 s2 b |
<export: true>
+ <var: #adler32 type:'unsigned int '>
+ <var: #bytePtr type:'unsigned char *'>
- <var: #adler32 type: 'unsigned int '>
- <var: #bytePtr type: 'unsigned char *'>
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
collection := interpreterProxy stackObjectValue: 0.
stopIndex := interpreterProxy stackIntegerValue: 1.
startIndex := interpreterProxy stackIntegerValue: 2.
adler32 := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3).
interpreterProxy failed ifTrue:[^0].
((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]])
ifFalse:[^interpreterProxy primitiveFail].
length := interpreterProxy byteSizeOf: collection.
(stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail].
bytePtr := interpreterProxy firstIndexableField: collection.
startIndex := startIndex - 1.
stopIndex := stopIndex - 1.
s1 := adler32 bitAnd: 16rFFFF.
s2 := (adler32 >> 16) bitAnd: 16rFFFF.
startIndex to: stopIndex do:[:i|
b := bytePtr at: i.
s1 := (s1 + b) \\ 65521.
s2 := (s2 + s1) \\ 65521.
].
adler32 := (s2 bitShift: 16) + s1.
interpreterProxy pop: 5. "args + rcvr"
interpreterProxy push: (interpreterProxy positive32BitIntegerFor: adler32).!
Item was changed:
----- Method: DeflatePlugin>>primitiveUpdateGZipCrc32 (in category 'primitives') -----
primitiveUpdateGZipCrc32
"Primitive. Update a 32bit CRC value."
| collection stopIndex startIndex crc length bytePtr |
<export: true>
+ <var: #crc type:'unsigned int '>
+ <var: #bytePtr type:'unsigned char *'>
+ <var: #crcTable type:'unsigned int *'>
- <var: #crc type: 'unsigned int '>
- <var: #bytePtr type: 'unsigned char *'>
- <var: #crcTable type: 'unsigned int *'>
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
collection := interpreterProxy stackObjectValue: 0.
stopIndex := interpreterProxy stackIntegerValue: 1.
startIndex := interpreterProxy stackIntegerValue: 2.
crc := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3).
interpreterProxy failed ifTrue:[^0].
((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]])
ifFalse:[^interpreterProxy primitiveFail].
length := interpreterProxy byteSizeOf: collection.
(stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail].
bytePtr := interpreterProxy firstIndexableField: collection.
self cCode:'' inSmalltalk:[zipCrcTable := CArrayAccessor on: GZipWriteStream crcTable].
startIndex := startIndex - 1.
stopIndex := stopIndex - 1.
startIndex to: stopIndex do:[:i|
crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8).
].
interpreterProxy pop: 5. "args + rcvr"
interpreterProxy push: (interpreterProxy positive32BitIntegerFor: crc).!
Item was changed:
----- Method: DeflatePlugin>>sendBlock:with:with:with: (in category 'encoding') -----
sendBlock: literalStream with: distanceStream with: litTree with: distTree
"Require:
zipCollection, zipCollectionSize, zipPosition,
zipBitBuf, zipBitPos.
"
| oop litPos litLimit litArray distArray lit dist sum llBitLengths llCodes distBitLengths distCodes code extra litBlCount distBlCount |
+ <var: #litArray type:'unsigned char *'>
+ <var: #distArray type:'unsigned int *'>
+ <var: #llBitLengths type:'unsigned int *'>
+ <var: #llCodes type:'unsigned int *'>
+ <var: #distBitLengths type:'unsigned int *'>
+ <var: #distCodes type:'unsigned int *'>
- <var: #litArray type: 'unsigned char *'>
- <var: #distArray type: 'unsigned int *'>
- <var: #llBitLengths type: 'unsigned int *'>
- <var: #llCodes type: 'unsigned int *'>
- <var: #distBitLengths type: 'unsigned int *'>
- <var: #distCodes type: 'unsigned int *'>
oop := interpreterProxy fetchPointer: 0 ofObject: literalStream.
litPos := interpreterProxy fetchInteger: 1 ofObject: literalStream.
litLimit := interpreterProxy fetchInteger: 2 ofObject: literalStream.
((interpreterProxy isIntegerObject: oop) not and:[litPos <= litLimit and:[
litLimit <= (interpreterProxy byteSizeOf: oop) and:[interpreterProxy isBytes: oop]]])
ifFalse:[^interpreterProxy primitiveFail].
litArray := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 0 ofObject: distanceStream.
((interpreterProxy isIntegerObject: oop) not and:[
(interpreterProxy fetchInteger: 1 ofObject: distanceStream) = litPos and:[
(interpreterProxy fetchInteger: 2 ofObject: distanceStream) = litLimit]])
ifFalse:[^interpreterProxy primitiveFail].
((interpreterProxy isWords: oop) and:[
litLimit <= (interpreterProxy slotSizeOf: oop)])
ifFalse:[^interpreterProxy primitiveFail].
distArray := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 0 ofObject: litTree.
((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
ifFalse:[^interpreterProxy primitiveFail].
litBlCount := interpreterProxy slotSizeOf: oop.
llBitLengths := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 1 ofObject: litTree.
((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
ifFalse:[^interpreterProxy primitiveFail].
(litBlCount = (interpreterProxy slotSizeOf: oop))
ifFalse:[^interpreterProxy primitiveFail].
llCodes := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 0 ofObject: distTree.
((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
ifFalse:[^interpreterProxy primitiveFail].
distBlCount := interpreterProxy slotSizeOf: oop.
distBitLengths := interpreterProxy firstIndexableField: oop.
oop := interpreterProxy fetchPointer: 1 ofObject: distTree.
((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop])
ifFalse:[^interpreterProxy primitiveFail].
(distBlCount = (interpreterProxy slotSizeOf: oop))
ifFalse:[^interpreterProxy primitiveFail].
distCodes := interpreterProxy firstIndexableField: oop.
interpreterProxy failed ifTrue:[^nil].
self nextZipBits: 0 put: 0. "Flush pending bits if necessary"
sum := 0.
[litPos < litLimit and:[zipPosition + 4 < zipCollectionSize]] whileTrue:[
lit := litArray at: litPos.
dist := distArray at: litPos.
litPos := litPos + 1.
dist = 0 ifTrue:["literal"
sum := sum + 1.
lit < litBlCount ifFalse:[^interpreterProxy primitiveFail].
self nextZipBits: (llBitLengths at: lit) put: (llCodes at: lit).
] ifFalse:["match"
sum := sum + lit + DeflateMinMatch.
lit < 256 ifFalse:[^interpreterProxy primitiveFail].
code := zipMatchLengthCodes at: lit.
code < litBlCount ifFalse:[^interpreterProxy primitiveFail].
self nextZipBits: (llBitLengths at: code) put: (llCodes at: code).
extra := zipExtraLengthBits at: code - 257.
extra = 0 ifFalse:[
lit := lit - (zipBaseLength at: code - 257).
self nextZipBits: extra put: lit].
dist := dist - 1.
dist < 16r8000 ifFalse:[^interpreterProxy primitiveFail].
dist < 256
ifTrue:[code := zipDistanceCodes at: dist]
ifFalse:[code := zipDistanceCodes at: 256 + (dist >> 7)].
code < distBlCount ifFalse:[^interpreterProxy primitiveFail].
self nextZipBits: (distBitLengths at: code) put: (distCodes at: code).
extra := zipExtraDistanceBits at: code.
extra = 0 ifFalse:[
dist := dist - (zipBaseDistance at: code).
self nextZipBits: extra put: dist].
].
].
interpreterProxy failed ifTrue:[^nil].
interpreterProxy storeInteger: 1 ofObject: literalStream withValue: litPos.
interpreterProxy storeInteger: 1 ofObject: distanceStream withValue: litPos.
^sum!
Item was changed:
InterpreterPlugin subclass: #FFIPlugin
+ instanceVariableNames: 'ffiLastError ffiArgSpec ffiArgSpecSize ffiArgHeader ffiRetOop ffiRetClass ffiRetSpec ffiRetSpecSize ffiRetHeader ffiLogEnabled externalFunctionInstSize'
- instanceVariableNames: 'ffiLastError ffiArgClass ffiArgSpec ffiArgSpecSize ffiArgHeader ffiRetOop ffiRetClass ffiRetSpec ffiRetSpecSize ffiRetHeader'
classVariableNames: ''
poolDictionaries: 'FFIConstants'
category: 'VMMaker-Plugins'!
!FFIPlugin commentStamp: 'tpr 5/5/2003 11:54' prior: 0!
This plugin provides access to foreign function interfaces on those platforms that provide such. For example Windows DLLs and unix .so's.!
Item was changed:
+ ----- Method: FFIPlugin class>>moduleName (in category 'translation') -----
- ----- Method: FFIPlugin class>>moduleName (in category 'accessing') -----
moduleName "FFIPlugin translate"
"IMPORTANT: IF YOU CHANGE THE NAME OF THIS PLUGIN YOU MUST CHANGE
Interpreter>>primitiveCalloutToFFI
TO REFLECT THE CHANGE."
^'SqueakFFIPrims'!
Item was changed:
----- Method: FFIPlugin>>ffiArgByValue: (in category 'callout support') -----
ffiArgByValue: oop
"Support for generic callout. Prepare an argument by value for a callout."
| atomicType intValue floatValue |
<inline: true>
+ <var: #floatValue type: 'double'>
atomicType := self atomicTypeOf: ffiArgHeader.
"check if the range is valid"
(atomicType < 0 or:[atomicType > FFITypeDoubleFloat])
ifTrue:[^self ffiFail: FFIErrorBadAtomicType].
atomicType < FFITypeSingleFloat ifTrue:["integer types"
(atomicType >> 1) = (FFITypeSignedLongLong >> 1)
ifTrue:[intValue := oop] "ffi support code must coerce longlong"
ifFalse:[intValue := self ffiIntegerValueOf: oop]. "does all the coercions"
interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
self dispatchOn: atomicType
in: #(
ffiPushVoid:
ffiPushUnsignedInt:
ffiPushUnsignedByte:
ffiPushSignedByte:
ffiPushUnsignedShort:
ffiPushSignedShort:
ffiPushUnsignedInt:
ffiPushSignedInt:
ffiPushUnsignedLongLongOop:
ffiPushSignedLongLongOop:
ffiPushUnsignedChar:
ffiPushSignedChar:)
with: intValue.
] ifFalse:[
"either float or double"
floatValue := self ffiFloatValueOf: oop.
interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
atomicType = FFITypeSingleFloat
ifTrue:[self ffiPushSingleFloat: floatValue]
ifFalse:[self ffiPushDoubleFloat: floatValue].
].
^0!
Item was changed:
----- Method: FFIPlugin>>ffiArgument:Spec:Class: (in category 'callout support') -----
ffiArgument: oop Spec: argSpec Class: argClass
"Callout support. Prepare the given oop as argument.
argSpec defines the compiled spec for the argument.
argClass (if non-nil) defines the required (super)class for the argument."
| valueOop oopClass isStruct nilOop |
<inline: false>
oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class (we'll need it)"
nilOop := interpreterProxy nilObject.
"Do the necessary type checks"
argClass == nilOop ifFalse:[
"Type check 1:
Is the required class of the argument a subclass of ExternalStructure?"
(interpreterProxy includesBehavior: argClass
ThatOf: interpreterProxy classExternalStructure)
ifFalse:[^self ffiFail: FFIErrorWrongType]. "Nope. Fail."
"Type check 2:
Is the class of the argument a subclass of required class?"
((nilOop == oop) or:[interpreterProxy includesBehavior: oopClass ThatOf: argClass])
ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. "Nope. Fail."
"Okay, we've passed the type check (so far)"
].
"Check if oopClass is a subclass of ExternalStructure.
If this is the case we'll work on it's handle and not the actual oop."
isStruct := false.
((interpreterProxy isIntegerObject: oop) or:[oop == nilOop]) ifFalse:[
"#isPointers: will fail if oop is SmallInteger so don't even attempt to use it"
(interpreterProxy isPointers: oop)
ifTrue:[isStruct := interpreterProxy includesBehavior: oopClass
ThatOf: interpreterProxy classExternalStructure.
(argClass == nilOop or:[isStruct])
ifFalse:[^self ffiFail: FFIErrorCoercionFailed]].
"note: the test for #isPointers: above should speed up execution since no pointer type ST objects are allowed in external calls and thus if #isPointers: is true then the arg must be ExternalStructure to work. If it isn't then the code fails anyways so speed isn't an issue"
].
"Determine valueOop (e.g., the actual oop to pass as argument)"
isStruct
ifTrue:[valueOop := interpreterProxy fetchPointer: 0 ofObject: oop]
ifFalse:[valueOop := oop].
- ffiArgClass := argClass.
-
"Fetch and check the contents of the compiled spec"
(interpreterProxy isIntegerObject: argSpec)
ifTrue:[self ffiFail: FFIErrorWrongType. ^nil].
(interpreterProxy isWords: argSpec)
ifFalse:[self ffiFail: FFIErrorWrongType. ^nil].
ffiArgSpecSize := interpreterProxy slotSizeOf: argSpec.
ffiArgSpecSize = 0 ifTrue:[self ffiFail: FFIErrorWrongType. ^nil].
ffiArgSpec := self cCoerce: (interpreterProxy firstIndexableField: argSpec) to: 'int'.
ffiArgHeader := interpreterProxy longAt: ffiArgSpec.
"Do the actual preparation of the argument"
"Note: Order is important since FFIFlagStructure + FFIFlagPointer is used to represent 'typedef void* VoidPointer' and VoidPointer really is *struct* not pointer."
(ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[
"argument must be ExternalStructure"
isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
(ffiArgHeader anyMask: FFIFlagAtomic)
ifTrue:[^self ffiFail: FFIErrorWrongType]. "bad combination"
^self ffiPushStructureContentsOf: valueOop].
(ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[
"no integers for pointers please"
(interpreterProxy isIntegerObject: oop)
ifTrue:[^self ffiFail: FFIErrorIntAsPointer].
"but allow passing nil pointer for any pointer type"
oop == interpreterProxy nilObject ifTrue:[^self ffiPushPointer: nil].
"argument is reference to either atomic or structure type"
(ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
isStruct "e.g., ExternalData"
ifTrue:[^self ffiAtomicStructByReference: oop Class: oopClass]
ifFalse:[^self ffiAtomicArgByReference: oop Class: oopClass].
"********* NOTE: The above uses 'oop' not 'valueOop' (for ExternalData) ******"
].
"Needs to be external structure here"
isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
^self ffiPushPointerContentsOf: valueOop].
(ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
"argument is atomic value"
self ffiArgByValue: valueOop.
^0].
"None of the above - bad spec"
^self ffiFail: FFIErrorWrongType!
Item was changed:
----- Method: FFIPlugin>>ffiCreateLongLongReturn: (in category 'callout support') -----
ffiCreateLongLongReturn: isSigned
"Create a longlong return value from a previous call out"
| lowWord highWord largeClass nBytes largeInt ptr |
+ <var: #ptr type:'unsigned char *'>
- <var: #ptr type: 'unsigned char *'>
lowWord := self ffiLongLongResultLow.
highWord := self ffiLongLongResultHigh.
isSigned ifTrue:["check for 32 bit signed"
(highWord = 0 and:[lowWord >= 0])
ifTrue:[^interpreterProxy signed32BitIntegerFor: lowWord].
(highWord = -1 and:[lowWord < 0])
ifTrue:[^interpreterProxy signed32BitIntegerFor: lowWord].
"negate value for negative longlong"
highWord < 0
ifTrue:[ largeClass := interpreterProxy classLargeNegativeInteger.
lowWord := lowWord bitInvert32.
highWord := highWord bitInvert32.
lowWord = -1 "e.g., overflow when adding one"
ifTrue:[highWord := highWord + 1].
lowWord := lowWord + 1]
ifFalse:[largeClass := interpreterProxy classLargePositiveInteger].
"fall through"
] ifFalse:["check for 32 bit unsigned"
highWord = 0 ifTrue:[
^interpreterProxy positive32BitIntegerFor: lowWord].
largeClass := interpreterProxy classLargePositiveInteger.
"fall through"
].
"Create LargeInteger result"
nBytes := 8.
(highWord anyMask: 255 << 24) ifFalse:[
nBytes := 7.
highWord < (1 << 16) ifTrue:[nBytes := 6].
highWord < (1 << 8) ifTrue:[nBytes := 5].
highWord = 0 ifTrue:[nBytes := 4]].
"now we know how many bytes to create"
largeInt := interpreterProxy instantiateClass: largeClass indexableSize: nBytes.
(interpreterProxy isBytes: largeInt)
ifFalse:[^self ffiFail: FFIErrorBadReturn]. "Hossa!!"
ptr := interpreterProxy firstIndexableField: largeInt.
4 to: nBytes-1 do:[:i|
ptr at: i put: (highWord >> (i-4*8) bitAnd: 255)].
ptr at: 3 put: (lowWord >> 24 bitAnd: 255).
ptr at: 2 put: (lowWord >> 16 bitAnd: 255).
ptr at: 1 put: (lowWord >> 8 bitAnd: 255).
ptr at: 0 put: (lowWord bitAnd: 255).
^largeInt!
Item was changed:
----- Method: FFIPlugin>>ffiCreateReturnPointer: (in category 'callout support') -----
ffiCreateReturnPointer: retVal
"Generic callout support. Create a pointer return value from an external function call"
| atomicType retOop oop ptr classOop |
+ <var: #ptr type:'int *'>
- <var: #ptr type: 'int *'>
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
(ffiRetClass == interpreterProxy nilObject) ifTrue:[
"Create ExternalData upon return"
atomicType := self atomicTypeOf: ffiRetHeader.
(atomicType >> 1) = (FFITypeSignedChar >> 1) ifTrue:["String return"
^self ffiReturnCStringFrom: retVal].
"generate external data"
interpreterProxy pushRemappableOop: ffiRetOop.
oop := interpreterProxy
instantiateClass: interpreterProxy classExternalAddress
indexableSize: 4.
ptr := interpreterProxy firstIndexableField: oop.
ptr at: 0 put: retVal.
interpreterProxy pushRemappableOop: oop. "preserve for gc"
retOop := interpreterProxy
instantiateClass: interpreterProxy classExternalData
indexableSize: 0.
oop := interpreterProxy popRemappableOop. "external address"
interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
oop := interpreterProxy popRemappableOop. "return type"
interpreterProxy storePointer: 1 ofObject: retOop withValue: oop.
^interpreterProxy push: retOop.
].
"non-atomic pointer return"
interpreterProxy pushRemappableOop: ffiRetClass. "preserve for gc"
(ffiRetHeader anyMask: FFIFlagStructure)
ifTrue:[classOop := interpreterProxy classByteArray]
ifFalse:[classOop := interpreterProxy classExternalAddress].
oop := interpreterProxy
instantiateClass: classOop
indexableSize: 4.
ptr := interpreterProxy firstIndexableField: oop.
ptr at: 0 put: retVal.
ffiRetClass := interpreterProxy popRemappableOop. "return class"
interpreterProxy pushRemappableOop: oop. "preserve for gc"
retOop := interpreterProxy instantiateClass: ffiRetClass indexableSize: 0.
oop := interpreterProxy popRemappableOop. "external address"
interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
^interpreterProxy push: retOop.!
Item was changed:
----- Method: FFIPlugin>>ffiFail: (in category 'callout support') -----
ffiFail: reason
+ <inline: false>
+ "Map the FFI error code into a primitive error code. If reason is negative it encodes one of the
+ standard PrimErr... codes, negated to distinguish it from the FFIError codes. If it is an FFIError...
+ code then add the size of the primitive error table + 2 to disambiguate it from the PrimErr... codes.
+ For historic reasons the FFIError codes range from -1 on up hence adding size + 2 maps them to
+ size of table + 1 on up. This OFFSET IS undone by ExternalFunction class>>externalCallFailedWith:.
+ Thus we can communicate back both PrimErr.. and FFIError codes. Complex but necessary in the ThreadedFFIPlugin."
- <inline: true>
self ffiSetLastError: reason.
+ ^interpreterProxy primitiveFailFor:
+ (reason >= FFINoCalloutAvailable
+ ifTrue: [reason + 2 + (interpreterProxy slotSizeOf: interpreterProxy primitiveErrorTable)]
+ ifFalse: [reason negated])!
- ^interpreterProxy primitiveFail!
Item was changed:
----- Method: FFIPlugin>>ffiFloatValueOf: (in category 'callout support') -----
ffiFloatValueOf: oop
"Support for generic callout. Return a float value that is coerced as C would do."
| oopClass |
+ <returnTypeC:'double'>
- <returnTypeC: 'double'>
oopClass := interpreterProxy fetchClassOf: oop.
oopClass == interpreterProxy classFloat
ifTrue:[^interpreterProxy floatValueOf: oop].
"otherwise try the integer coercions and return its float value"
^(self ffiIntegerValueOf: oop) asFloat!
Item was changed:
----- Method: FFIPlugin>>ffiLoadCalloutAddress: (in category 'symbol loading') -----
ffiLoadCalloutAddress: lit
"Load the address of the foreign function from the given object"
| addressPtr address ptr |
+ <var: #ptr type:'int *'>
- <var: #ptr type: 'int *'>
"Lookup the address"
addressPtr := interpreterProxy fetchPointer: 0 ofObject: lit.
"Make sure it's an external handle"
address := self ffiContentsOfHandle: addressPtr errCode: FFIErrorBadAddress.
interpreterProxy failed ifTrue:[^0].
address = 0 ifTrue:["Go look it up in the module"
(interpreterProxy slotSizeOf: lit) < 5 ifTrue:[^self ffiFail: FFIErrorNoModule].
address := self ffiLoadCalloutAddressFrom: lit.
interpreterProxy failed ifTrue:[^0].
"Store back the address"
ptr := interpreterProxy firstIndexableField: addressPtr.
ptr at: 0 put: address].
^address!
Item was changed:
----- Method: FFIPlugin>>ffiLoadCalloutAddressFrom: (in category 'symbol loading') -----
ffiLoadCalloutAddressFrom: oop
"Load the function address for a call out to an external function"
| module moduleHandle functionName functionLength address |
<inline: false>
"First find and load the module"
+ module := interpreterProxy fetchPointer: externalFunctionInstSize + 1 ofObject: oop.
- module := interpreterProxy fetchPointer: 4 ofObject: oop.
moduleHandle := self ffiLoadCalloutModule: module.
+ interpreterProxy failed ifTrue:
+ [^0]. "failed"
- interpreterProxy failed ifTrue:[^0]. "failed"
"fetch the function name"
+ functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: oop.
+ (interpreterProxy isBytes: functionName) ifFalse:
+ [^self ffiFail: FFIErrorBadExternalFunction].
- functionName := interpreterProxy fetchPointer: 3 ofObject: oop.
- (interpreterProxy isBytes: functionName) ifFalse:[^self ffiFail: FFIErrorBadExternalFunction].
functionLength := interpreterProxy byteSizeOf: functionName.
+ address := interpreterProxy
+ ioLoadSymbol: (self cCoerce: (interpreterProxy firstIndexableField: functionName) to: #int)
- address := interpreterProxy ioLoadSymbol:
- (self cCoerce: (interpreterProxy firstIndexableField: functionName) to:'int')
OfLength: functionLength
FromModule: moduleHandle.
+ (interpreterProxy failed or: [address = 0]) ifTrue:
+ [^self ffiFail: FFIErrorAddressNotFound].
- (interpreterProxy failed or:[address = 0])
- ifTrue:[^self ffiFail: FFIErrorAddressNotFound].
^address!
Item was changed:
----- Method: FFIPlugin>>ffiLoadCalloutModule: (in category 'symbol loading') -----
ffiLoadCalloutModule: module
"Load the given module and return its handle"
| moduleHandlePtr moduleHandle ffiModuleName moduleLength rcvr theClass ptr |
+ <var: #ptr type:'int *'>
- <var: #ptr type: 'int *'>
(interpreterProxy isBytes: module) ifTrue:[
"plain module name"
ffiModuleName := module.
moduleLength := interpreterProxy byteSizeOf: ffiModuleName.
moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength.
interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorModuleNotFound]. "failed"
^moduleHandle].
"Check if the external method is defined in an external library"
rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
theClass := interpreterProxy fetchClassOf: rcvr.
(interpreterProxy includesBehavior: theClass
ThatOf: interpreterProxy classExternalLibrary) ifFalse:[^0].
"external library"
moduleHandlePtr := interpreterProxy fetchPointer: 0 ofObject: rcvr.
moduleHandle := self ffiContentsOfHandle: moduleHandlePtr errCode: FFIErrorBadExternalLibrary.
interpreterProxy failed ifTrue:[^0].
moduleHandle = 0 ifTrue:["need to reload module"
ffiModuleName := interpreterProxy fetchPointer: 1 ofObject: rcvr.
(interpreterProxy isBytes: ffiModuleName) ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary].
moduleLength := interpreterProxy byteSizeOf: ffiModuleName.
moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength.
interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorModuleNotFound]. "failed"
"and store back"
ptr := interpreterProxy firstIndexableField: moduleHandlePtr.
ptr at: 0 put: moduleHandle].
^moduleHandle!
Item was added:
+ ----- Method: FFIPlugin>>ffiLogCallout: (in category 'symbol loading') -----
+ ffiLogCallout: lit
+ "fetch the function name"
+ | functionName |
+ ffiLogEnabled ifTrue:[
+ functionName := interpreterProxy fetchPointer: externalFunctionInstSize ofObject: lit.
+ (interpreterProxy isBytes: functionName) ifFalse:[^nil].
+ self ffiLogCall: (interpreterProxy firstIndexableField: functionName)
+ OfLength: (interpreterProxy byteSizeOf: functionName).
+ ].!
Item was added:
+ ----- Method: FFIPlugin>>ffiLogCallsTo: (in category 'initialize') -----
+ ffiLogCallsTo: fileName
+ "This is a special entry point exposed such that client code can
+ enable and disable logging of FFI calls."
+ | ok |
+ <export: true>
+ <var: #fileName type: 'char*'>
+ fileName == nil ifTrue:[ "disable logging"
+ ok := self ffiLogFileName: nil OfLength: 0.
+ ok ifFalse:[^false].
+ ffiLogEnabled := false.
+ ] ifFalse:[ "enable logging"
+ ok := self ffiLogFileName: fileName OfLength: (self strlen: fileName).
+ ok ifFalse:[^false].
+ ffiLogEnabled := true.
+ ].
+ ^true!
Item was changed:
----- Method: FFIPlugin>>ffiPushSignedLongLongOop: (in category 'callout support') -----
ffiPushSignedLongLongOop: oop
"Push a longlong type (e.g., a 64bit integer).
Note: Coercions from float are *not* supported."
| lowWord highWord length oopClass negative ptr |
+ <var: #ptr type:'unsigned char *'>
- <var: #ptr type: 'unsigned char *'>
oop == interpreterProxy nilObject
ifTrue:[^self ffiPushSignedLong: 0 Long: 0.]. "@@: check this"
oop == interpreterProxy falseObject
ifTrue:[^self ffiPushSignedLong: 0 Long: 0].
oop == interpreterProxy trueObject
ifTrue:[^self ffiPushSignedLong: 0 Long: 1].
(interpreterProxy isIntegerObject: oop) ifTrue:[
lowWord := interpreterProxy integerValueOf: oop.
lowWord < 0
ifTrue:[highWord := -1]
ifFalse:[highWord := 0].
] ifFalse:[
oopClass := interpreterProxy fetchClassOf: oop.
oopClass == interpreterProxy classLargePositiveInteger
ifTrue:[negative := false]
ifFalse:[oopClass == interpreterProxy classLargeNegativeInteger
ifTrue:[negative := true]
ifFalse:[^self ffiFail: FFIErrorCoercionFailed]].
(interpreterProxy isBytes: oop) ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
length := interpreterProxy byteSizeOf: oop.
length > 8 ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
lowWord := highWord := 0.
ptr := interpreterProxy firstIndexableField: oop.
0 to: (length min: 4)-1 do:[:i|
lowWord := lowWord + ((ptr at: i) << (i*8))].
0 to: (length-5) do:[:i|
highWord := highWord + ((ptr at: i+4) << (i*8))].
negative ifTrue:[
lowWord := lowWord bitInvert32.
highWord := highWord bitInvert32.
lowWord = -1 "e.g., will overflow when adding one"
ifTrue:[highWord := highWord + 1].
lowWord := lowWord + 1].
].
^self ffiPushSignedLong: lowWord Long: highWord.!
Item was changed:
----- Method: FFIPlugin>>ffiPushUnsignedLongLongOop: (in category 'callout support') -----
ffiPushUnsignedLongLongOop: oop
"Push a longlong type (e.g., a 64bit integer).
Note: Coercions from float are *not* supported."
| lowWord highWord length ptr |
+ <var: #ptr type:'unsigned char *'>
- <var: #ptr type: 'unsigned char *'>
oop == interpreterProxy nilObject
ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0.]. "@@: check this"
oop == interpreterProxy falseObject
ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0].
oop == interpreterProxy trueObject
ifTrue:[^self ffiPushUnsignedLong: 0 Long: 1].
(interpreterProxy isIntegerObject: oop) ifTrue:[
lowWord := interpreterProxy integerValueOf: oop.
lowWord < 0 ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
highWord := 0.
] ifFalse:[
(interpreterProxy fetchClassOf: oop) = interpreterProxy classLargePositiveInteger
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isBytes: oop) ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
length := interpreterProxy byteSizeOf: oop.
length > 8 ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
lowWord := highWord := 0.
ptr := interpreterProxy firstIndexableField: oop.
0 to: (length min: 4)-1 do:[:i|
lowWord := lowWord + ((ptr at: i) << (i*8))].
0 to: (length-5) do:[:i|
highWord := highWord + ((ptr at: i+4) << (i*8))].
].
^self ffiPushUnsignedLong: lowWord Long: highWord.!
Item was changed:
----- Method: FFIPlugin>>ffiReturnCStringFrom: (in category 'callout support') -----
ffiReturnCStringFrom: cPointer
"Create a Smalltalk string from a zero terminated C string"
| strLen strOop cString strPtr |
+ <var: #cString type:'char *'>
+ <var: #strPtr type:'char *'>
- <var: #cString type: 'char *'>
- <var: #strPtr type: 'char *'>
cPointer = nil ifTrue:[
^interpreterProxy push: interpreterProxy nilObject]. "nil always returs as nil"
cString := self cCoerce: cPointer to:'char *'.
strLen := 0.
[(cString at: strLen) = 0] whileFalse:[strLen := strLen+1].
strOop := interpreterProxy
instantiateClass: interpreterProxy classString
indexableSize: strLen.
strPtr := interpreterProxy firstIndexableField: strOop.
0 to: strLen-1 do:[:i| strPtr at: i put: (cString at: i)].
^interpreterProxy push: strOop!
Item was changed:
+ ----- Method: FFIPlugin>>initialiseModule (in category 'initialize') -----
- ----- Method: FFIPlugin>>initialiseModule (in category 'primitives') -----
initialiseModule
<export: true>
+ self initSurfacePluginFunctionPointers.
+ "By default, disable logging"
+ ffiLogEnabled := false.
+ "Get the instSize of ExternalFunction to know whether it contains a cache of the stackSize,
+ and what the offset of ExternalLibraryFunction's functionName and moduleName slots are."
+ externalFunctionInstSize := interpreterProxy instanceSizeOf: interpreterProxy classExternalFunction.
+ ^1!
- self initSurfacePluginFunctionPointers.!
Item was changed:
----- Method: FFIPlugin>>primitiveCallout (in category 'primitives') -----
primitiveCallout
"IMPORTANT: IF YOU CHANGE THE NAME OF THIS METHOD YOU MUST CHANGE
Interpreter>>primitiveCalloutToFFI
TO REFLECT THE CHANGE."
"Perform a function call to a foreign function.
Only invoked from method containing explicit external call spec."
| lit address flags argTypes litClass nArgs meth |
<export: true>
<inline: false>
self ffiSetLastError: FFIErrorGenericError. "educated guess if we fail silently"
lit := nil.
"Look if the method is itself a callout function"
meth := interpreterProxy primitiveMethod.
(interpreterProxy literalCountOf: meth) > 0 ifFalse:[^interpreterProxy primitiveFail].
lit := interpreterProxy literal: 0 ofMethod: meth.
litClass := interpreterProxy fetchClassOf: lit.
(interpreterProxy includesBehavior: litClass
ThatOf: interpreterProxy classExternalFunction)
ifFalse:[^self ffiFail: FFIErrorNotFunction].
address := self ffiLoadCalloutAddress: lit.
interpreterProxy failed ifTrue:[^0].
"Load and check the other values before we call out"
flags := interpreterProxy fetchInteger: 1 ofObject: lit.
interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorBadArgs].
argTypes := interpreterProxy fetchPointer: 2 ofObject: lit.
"must be array of arg types"
(interpreterProxy isArray: argTypes)
ifFalse:[^self ffiFail: FFIErrorBadArgs].
nArgs := interpreterProxy slotSizeOf: argTypes.
"must be argumentCount+1 arg types"
nArgs = (interpreterProxy methodArgumentCount+1)
ifFalse:[^self ffiFail: FFIErrorBadArgs].
+ self ffiLogCallout: lit.
self ffiInitialize. "announce the execution of an external call"
self ffiCall: address
WithFlags: flags
AndTypes: argTypes.
self ffiCleanup. "cleanup temp allocations"
^0!
Item was changed:
----- Method: FFIPlugin>>primitiveCreateManualSurface (in category 'primitives - surfaces') -----
primitiveCreateManualSurface
"arguments: name(type, stack offset)
width(Integer, 4)
height(Integer, 3)
rowPitch(Integer, 2)
depth(Integer, 1)
isMSB(Boolean, 0)"
| width height rowPitch depth isMSB result |
<export: true>
interpreterProxy methodArgumentCount == 5 ifFalse: [^interpreterProxy primitiveFail].
width := interpreterProxy stackIntegerValue: 4.
height := interpreterProxy stackIntegerValue: 3.
rowPitch := interpreterProxy stackIntegerValue: 2.
depth := interpreterProxy stackIntegerValue: 1.
isMSB := interpreterProxy stackObjectValue: 0.
isMSB := interpreterProxy booleanValueOf: isMSB.
interpreterProxy failed ifTrue: [^nil].
self touch: width; touch: height; touch: rowPitch; touch: depth; touch: isMSB.
result := self cCode: 'createManualSurface(width, height, rowPitch, depth, isMSB)'.
result < 0 ifTrue: [^interpreterProxy primitiveFail].
result := interpreterProxy signed32BitIntegerFor: result.
^interpreterProxy pop: 6 thenPush: result
!
Item was changed:
----- Method: FFIPlugin>>primitiveDestroyManualSurface (in category 'primitives - surfaces') -----
primitiveDestroyManualSurface
"arguments: name(type, stack offset)
surfaceID(Integer, 0)"
| surfaceID result |
<export: true>
interpreterProxy methodArgumentCount == 1 ifFalse: [^interpreterProxy primitiveFail].
surfaceID := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue: [^nil].
result := self destroyManualSurface: surfaceID.
result = 0 ifTrue: [^interpreterProxy primitiveFail].
^interpreterProxy pop: 1
!
Item was changed:
----- Method: FFIPlugin>>primitiveFFIAllocate (in category 'primitives') -----
primitiveFFIAllocate
"Primitive. Allocate an object on the external heap."
| byteSize addr oop ptr |
<export: true>
<inline: false>
+ <var: #ptr type:'int *'>
- <var: #ptr type: 'int *'>
byteSize := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:[^nil].
addr := self ffiAlloc: byteSize.
addr = 0 ifTrue:[^interpreterProxy primitiveFail].
oop := interpreterProxy
instantiateClass: interpreterProxy classExternalAddress
indexableSize: 4.
ptr := interpreterProxy firstIndexableField: oop.
ptr at: 0 put: addr.
interpreterProxy pop: 2.
^interpreterProxy push: oop.
!
Item was changed:
----- Method: FFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') -----
primitiveFFIDoubleAt
"Return a (signed or unsigned) n byte integer from the given byte offset."
| byteOffset rcvr addr floatValue |
<export: true>
<inline: false>
+ <var: #floatValue type:'double '>
- <var: #floatValue type: 'double '>
byteOffset := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^0].
addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
interpreterProxy failed ifTrue:[^0].
self cCode:'((int*)(&floatValue))[0] = ((int*)addr)[0]'.
self cCode:'((int*)(&floatValue))[1] = ((int*)addr)[1]'.
interpreterProxy pop: 2.
^interpreterProxy pushFloat: floatValue
!
Item was changed:
----- Method: FFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') -----
primitiveFFIDoubleAtPut
"Return a (signed or unsigned) n byte integer from the given byte offset."
| byteOffset rcvr addr floatValue floatOop |
<export: true>
<inline: false>
+ <var: #floatValue type:'double '>
- <var: #floatValue type: 'double '>
floatOop := interpreterProxy stackValue: 0.
(interpreterProxy isIntegerObject: floatOop)
ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'double']
ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'double'].
byteOffset := interpreterProxy stackIntegerValue: 1.
rcvr := interpreterProxy stackObjectValue: 2.
interpreterProxy failed ifTrue:[^0].
addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
interpreterProxy failed ifTrue:[^0].
self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'.
self cCode:'((int*)addr)[1] = ((int*)(&floatValue))[1]'.
interpreterProxy pop: 3.
^interpreterProxy push: floatOop!
Item was changed:
----- Method: FFIPlugin>>primitiveFFIFloatAt (in category 'primitives') -----
primitiveFFIFloatAt
"Return a (signed or unsigned) n byte integer from the given byte offset."
| byteOffset rcvr addr floatValue |
<export: true>
<inline: false>
+ <var: #floatValue type:'float '>
- <var: #floatValue type: 'float '>
byteOffset := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^0].
addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
interpreterProxy failed ifTrue:[^0].
self cCode:'((int*)(&floatValue))[0] = ((int*)addr)[0]'.
interpreterProxy pop: 2.
^interpreterProxy pushFloat: floatValue!
Item was changed:
----- Method: FFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') -----
primitiveFFIFloatAtPut
"Return a (signed or unsigned) n byte integer from the given byte offset."
| byteOffset rcvr addr floatValue floatOop |
<export: true>
<inline: false>
+ <var: #floatValue type:'float '>
- <var: #floatValue type: 'float '>
floatOop := interpreterProxy stackValue: 0.
(interpreterProxy isIntegerObject: floatOop)
ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'float']
ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'float'].
byteOffset := interpreterProxy stackIntegerValue: 1.
rcvr := interpreterProxy stackObjectValue: 2.
interpreterProxy failed ifTrue:[^0].
addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
interpreterProxy failed ifTrue:[^0].
self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'.
interpreterProxy pop: 3.
^interpreterProxy push: floatOop!
Item was changed:
----- Method: FFIPlugin>>primitiveFFIFree (in category 'primitives') -----
primitiveFFIFree
"Primitive. Free the object pointed to on the external heap."
| addr oop ptr |
<export: true>
<inline: false>
+ <var: #ptr type:'int *'>
- <var: #ptr type: 'int *'>
oop := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy fetchClassOf: oop) = (interpreterProxy classExternalAddress)
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy byteSizeOf: oop) = 4
ifFalse:[^interpreterProxy primitiveFail].
ptr := interpreterProxy firstIndexableField: oop.
addr := ptr at: 0.
"Don't you dare to free Squeak's memory!!"
(addr = 0 or:[interpreterProxy isInMemory: addr])
ifTrue:[^interpreterProxy primitiveFail].
self ffiFree: addr.
^ptr at: 0 put: 0. "cleanup"
!
Item was changed:
----- Method: FFIPlugin>>primitiveForceLoad (in category 'primitives') -----
primitiveForceLoad
"Primitive. Force loading the receiver (an instance of ExternalLibrary)."
| rcvr theClass moduleHandlePtr moduleHandle ffiModuleName moduleLength ptr |
<export: true>
<inline: false>
+ <var: #ptr type:'int *'>
- <var: #ptr type: 'int *'>
self ffiSetLastError: FFIErrorGenericError. "educated guess if we fail silently"
interpreterProxy methodArgumentCount = 0
ifFalse:[^interpreterProxy primitiveFail].
rcvr := interpreterProxy stackValue: 0.
theClass := interpreterProxy fetchClassOf: rcvr.
(interpreterProxy includesBehavior: theClass
ThatOf: interpreterProxy classExternalLibrary)
ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary].
moduleHandlePtr := interpreterProxy fetchPointer: 0 ofObject: rcvr.
moduleHandle := self ffiContentsOfHandle: moduleHandlePtr errCode: FFIErrorBadExternalLibrary.
interpreterProxy failed ifTrue:[^0].
ffiModuleName := interpreterProxy fetchPointer: 1 ofObject: rcvr.
(interpreterProxy isBytes: ffiModuleName)
ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary].
moduleLength := interpreterProxy byteSizeOf: ffiModuleName.
moduleHandle := interpreterProxy ioLoadModule: (self cCoerce: (interpreterProxy firstIndexableField: ffiModuleName) to:'int') OfLength: moduleLength.
interpreterProxy failed ifTrue:[^self ffiFail: FFIErrorModuleNotFound]. "failed"
"and store back"
ptr := interpreterProxy firstIndexableField: moduleHandlePtr.
ptr at: 0 put: moduleHandle.
^0 "done"!
Item was added:
+ ----- Method: FFIPlugin>>primitiveLogCallsTo (in category 'primitives') -----
+ primitiveLogCallsTo
+ "Enable logging of FFI calls by providing it with a log file name."
+ | logFile ok |
+ <export: true>
+ interpreterProxy methodArgumentCount = 1
+ ifFalse:[^interpreterProxy primitiveFail].
+ logFile := interpreterProxy stackObjectValue: 0.
+ logFile == interpreterProxy nilObject ifTrue:[ "disable logging"
+ ok := self ffiLogFileName: nil OfLength: 0.
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ ffiLogEnabled := false.
+ ] ifFalse:[ "enable logging"
+ (interpreterProxy isBytes: logFile) ifFalse:[^interpreterProxy primitiveFail].
+ ok := self ffiLogFileName: (interpreterProxy firstIndexableField: logFile)
+ OfLength: (interpreterProxy byteSizeOf: logFile).
+ ok ifFalse:[^interpreterProxy primitiveFail].
+ ffiLogEnabled := true.
+ ].
+ ^interpreterProxy pop: 1. "pop arg; return rcvr"
+ !
Item was changed:
----- Method: FFIPlugin>>primitiveSetManualSurfacePointer (in category 'primitives - surfaces') -----
primitiveSetManualSurfacePointer
"Create a 'manual surface' data-structure. See the ExternalForm class in the FFI package for example usage."
"arguments: name(type, stack offset)
surfaceID(Integer, 1)
ptr(uint32, 0)"
| surfaceID ptr result |
<export: true>
+ <var: #ptr type: #'unsigned int'>
- <var: #ptr type: 'unsigned int'>
interpreterProxy methodArgumentCount == 2 ifFalse: [^interpreterProxy primitiveFail].
surfaceID := interpreterProxy stackIntegerValue: 1.
ptr := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
interpreterProxy failed ifTrue: [^nil].
self touch: surfaceID; touch: ptr.
result := self cCode: 'setManualSurfacePointer(surfaceID, (void*)ptr)'.
result = 0 ifTrue: [^interpreterProxy primitiveFail].
^interpreterProxy pop: 2
!
Item was changed:
----- Method: FFTPlugin>>checkedFloatPtrOf: (in category 'private') -----
checkedFloatPtrOf: oop
"Return the first indexable word of oop which is assumed to be variableWordSubclass"
+ <returnTypeC:'float *'>
- <returnTypeC: 'float *'>
interpreterProxy success: (interpreterProxy isWords: oop).
interpreterProxy failed ifTrue:[^0].
^self cCoerce: (interpreterProxy firstIndexableField: oop) to:'float *'!
Item was changed:
----- Method: FFTPlugin>>checkedWordPtrOf: (in category 'private') -----
checkedWordPtrOf: oop
"Return the first indexable word of oop which is assumed to be variableWordSubclass"
+ <returnTypeC:'unsigned int *'>
- <returnTypeC: 'unsigned int *'>
interpreterProxy success: (interpreterProxy isWords: oop).
^self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'unsigned int *'!
Item was changed:
----- Method: FilePlugin class>>requiredMethodNames (in category 'translation') -----
requiredMethodNames
+ "fileValueOf: is called (questionably so) by support code for DropPlugin"
+
+ ^ super requiredMethodNames, #( fileValueOf: )!
- "return the list of method names that should be retained for export or other support reasons"
- "just which methods?"
- ^#( fileValueOf: ) "referenced by DropPlugin support code"!
Item was changed:
+ ----- Method: FilePlugin class>>simulatorClass (in category 'simulation') -----
- ----- Method: FilePlugin class>>simulatorClass (in category 'instance creation') -----
simulatorClass
^FilePluginSimulator!
Item was changed:
----- Method: FilePlugin>>initialiseModule (in category 'initialize-release') -----
initialiseModule
<export: true>
sCCPfn := interpreterProxy ioLoadFunction: 'secCanCreatePathOfSize' From: 'SecurityPlugin'.
sCDPfn := interpreterProxy ioLoadFunction: 'secCanDeletePathOfSize' From: 'SecurityPlugin'.
sCGFTfn := interpreterProxy ioLoadFunction: 'secCanGetFileTypeOfSize' From: 'SecurityPlugin'.
sCLPfn := interpreterProxy ioLoadFunction: 'secCanListPathOfSize' From: 'SecurityPlugin'.
sCSFTfn := interpreterProxy ioLoadFunction: 'secCanSetFileTypeOfSize' From: 'SecurityPlugin'.
sDFAfn := interpreterProxy ioLoadFunction: 'secDisableFileAccess' From: 'SecurityPlugin'.
sCDFfn := interpreterProxy ioLoadFunction: 'secCanDeleteFileOfSize' From: 'SecurityPlugin'.
sCOFfn := interpreterProxy ioLoadFunction: 'secCanOpenFileOfSizeWritable' From: 'SecurityPlugin'.
sCRFfn := interpreterProxy ioLoadFunction: 'secCanRenameFileOfSize' From: 'SecurityPlugin'.
sHFAfn := interpreterProxy ioLoadFunction: 'secHasFileAccess' From: 'SecurityPlugin'.
+ ^self cCode: [self sqFileInit] inSmalltalk: [true]!
- ^self cCode: 'sqFileInit()' inSmalltalk:[true]!
Item was changed:
----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'directory primitives') -----
makeDirEntryName: entryName size: entryNameSize
createDate: createDate modDate: modifiedDate
isDir: dirFlag fileSize: fileSize
| modDateOop createDateOop nameString results stringPtr fileSizeOop |
<var: 'entryName' type: 'char *'>
+ <var: 'stringPtr' type:'char *'>
+ <var: 'fileSize' type:'squeakFileOffsetType '>
- <var: 'stringPtr' type: 'char *'>
- <var: 'fileSize' type: 'squeakFileOffsetType '>
"allocate storage for results, remapping newly allocated
oops in case GC happens during allocation"
interpreterProxy pushRemappableOop:
(interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 5).
interpreterProxy pushRemappableOop:
(interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize)..
interpreterProxy pushRemappableOop:
(interpreterProxy positive32BitIntegerFor: createDate).
interpreterProxy pushRemappableOop:
(interpreterProxy positive32BitIntegerFor: modifiedDate).
interpreterProxy pushRemappableOop:
(interpreterProxy positive64BitIntegerFor: fileSize).
fileSizeOop := interpreterProxy popRemappableOop.
modDateOop := interpreterProxy popRemappableOop.
createDateOop := interpreterProxy popRemappableOop.
nameString := interpreterProxy popRemappableOop.
results := interpreterProxy popRemappableOop.
"copy name into Smalltalk string"
stringPtr := interpreterProxy firstIndexableField: nameString.
0 to: entryNameSize - 1 do: [ :i |
stringPtr at: i put: (entryName at: i).
].
interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
dirFlag
ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
^ results!
Item was changed:
----- Method: FilePlugin>>primitiveDisableFileAccess (in category 'security primitives') -----
primitiveDisableFileAccess
<export: true>
"If the security plugin can be loaded, use it to turn off file access
+ If not, assume it's ok"
+ sDFAfn ~= 0 ifTrue:
+ [self cCode: '((sqInt (*)(void))sDFAfn)()']!
- If not, assume it's ok"
- sDFAfn ~= 0
- ifTrue: [self cCode: ' ((sqInt (*)(void))sDFAfn)()'].
- !
Item was changed:
----- Method: FilePlugin>>primitiveFileRead (in category 'file primitives') -----
primitiveFileRead
-
- | count startIndex array file byteSize arrayIndex bytesRead |
- <var: 'file' type: 'SQFile *'>
- <var: 'arrayIndex' type: 'char *'>
- <var: 'count' type: 'size_t'>
- <var: 'startIndex' type: 'size_t'>
- <var: 'byteSize' type: 'size_t'>
<export: true>
+ | retryCount count startIndex array file elementSize bytesRead |
+ <var: 'file' type: #'SQFile *'>
+ <var: 'count' type: #'size_t'>
+ <var: 'startIndex' type: #'size_t'>
+ <var: 'elementSize' type: #'size_t'>
+ retryCount := 0.
count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
+
+ [array := interpreterProxy stackValue: 2.
+ file := self fileValueOf: (interpreterProxy stackValue: 3).
- array := interpreterProxy stackValue: 2.
- file := self fileValueOf: (interpreterProxy stackValue: 3).
+ (interpreterProxy failed
+ "buffer can be any indexable words or bytes object except CompiledMethod"
+ or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- "buffer can be any indexable words or bytes object except CompiledMethod"
- (interpreterProxy isWordsOrBytes: array)
- ifFalse: [^interpreterProxy primitiveFail].
+ elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
+ (startIndex >= 1
+ and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
- (interpreterProxy isWords: array)
- ifTrue: [byteSize := 4]
- ifFalse: [byteSize := 1].
- ((startIndex >= 1) and:
- [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)])
- ifFalse: [^interpreterProxy primitiveFail].
+ "Note: adjust startIndex for zero-origin indexing"
+ bytesRead := self
+ sqFile: file
+ Read: count * elementSize
+ Into: (self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
+ At: (startIndex - 1) * elementSize.
+ interpreterProxy primitiveFailureCode = PrimErrObjectMayMove
+ and: [(retryCount := retryCount + 1) <= 2] "Two objects, the file and the array can move"] whileTrue:
+ [interpreterProxy
+ tenuringIncrementalGC;
+ primitiveFailFor: PrimNoErr].
+ interpreterProxy failed ifFalse:
+ [interpreterProxy
+ pop: 5 "pop rcvr, file, array, startIndex, count"
+ thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize) "push # of elements read"]!
- arrayIndex := interpreterProxy firstIndexableField: array.
- "Note: adjust startIndex for zero-origin indexing"
- bytesRead := self
- sqFile: file Read: (count * byteSize)
- Into: arrayIndex
- At: ((startIndex - 1) * byteSize).
- interpreterProxy failed ifFalse: [
- interpreterProxy pop: 5 "pop rcvr, file, array, startIndex, count"
- thenPush:(interpreterProxy integerObjectOf: bytesRead // byteSize). "push # of elements read"].!
Item was changed:
----- Method: FilePlugin>>primitiveFileStdioHandles (in category 'file primitives') -----
primitiveFileStdioHandles
"Answer an Array of file handles for standard in, standard out and standard error,
with nil in entries that are unvailable, e.g. because the platform does not provide
standard error, etc. Fail if there are no standard i/o facilities on the platform or
if the security plugin denies access or if memory runs out."
| fileRecords result validMask |
<export: true>
<var: 'fileRecords' declareC: 'SQFile fileRecords[3]'>
sHFAfn ~= 0 ifTrue:
[(self cCode: ' ((sqInt (*)(void))sHFAfn)()' inSmalltalk: [true]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrUnsupported]].
+ self cCode: '' inSmalltalk: [fileRecords := Array new: 3].
+ validMask := self sqFileStdioHandlesInto: fileRecords.
- [^interpreterProxy primitiveFail]].
- validMask := self sqFileStdioHandlesInto: (fileRecords).
validMask = 0 ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrUnsupported].
- [^interpreterProxy primitiveFail].
result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
result = nil ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- [^interpreterProxy primitiveFail].
interpreterProxy pushRemappableOop: result.
0 to: 2 do:
+ [:index|
- [:index| | r |
(validMask bitAnd: (1 << index)) ~= 0 ifTrue:
[result := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize.
result = nil ifTrue:
[interpreterProxy popRemappableOop.
+ ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ interpreterProxy storePointer: index ofObject: interpreterProxy topRemappableOop withValue: result.
+ self
+ cCode:
+ [self mem: (interpreterProxy firstIndexableField: result)
+ cp: (self addressOf: (fileRecords at: index))
+ y: self fileRecordSize]
+ inSmalltalk:
+ [(interpreterProxy firstIndexableField: result)
+ unitSize: self bytesPerWord;
+ at: 0 put: (fileRecords at: index + 1)]]].
+ self isDefined: 'COGMTVM'
+ inSmalltalk: [Smalltalk garbageCollect]
+ comment: 'In the threaded VM ensure the handles are old, so that sqFileReadIntoAt is unaffected by incremental GCs. See platforms/Cross/plugins/FilePlugin/sqFilePluginBasicPrims.c.'
+ ifTrue: [interpreterProxy fullGC].
- ^interpreterProxy primitiveFail].
- r := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: index ofObject: r withValue: result.
- interpreterProxy pushRemappableOop: r.
- self mem: (interpreterProxy firstIndexableField: result)
- cp: (self addressOf: (fileRecords at: index))
- y: self fileRecordSize]].
result := interpreterProxy popRemappableOop.
interpreterProxy pop: 1 thenPush: result!
Item was changed:
FilePlugin subclass: #FilePluginSimulator
+ instanceVariableNames: 'openFiles'
- instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
!FilePluginSimulator commentStamp: 'tpr 5/5/2003 12:02' prior: 0!
File plugin simulation for the VM simulator!
Item was added:
+ ----- Method: FilePluginSimulator>>close (in category 'initialize-release') -----
+ close "close any files that ST may have opened"
+ openFiles do: [:f | f close]!
Item was added:
+ ----- Method: FilePluginSimulator>>fileOpenName:size:write:secure: (in category 'file primitives') -----
+ fileOpenName: nameIndex size: nameSize write: writeFlag secure: secureFlag
+ "Open the named file, possibly checking security. Answer the file oop."
+ | path f index |
+ path := interpreterProxy interpreter asString: nameIndex size: nameSize.
+ f := writeFlag
+ ifTrue: [FileStream fileNamed: path]
+ ifFalse:
+ [(StandardFileStream isAFileNamed: path) ifTrue:
+ [FileStream readOnlyFileNamed: path]].
+ f ifNil: [^interpreterProxy primitiveFail].
+ f binary.
+ index := openFiles size + 1.
+ openFiles at: index put: f.
+ ^interpreterProxy integerObjectOf: index!
Item was changed:
----- Method: FilePluginSimulator>>fileValueOf: (in category 'simulation') -----
fileValueOf: objectPointer
+ | index |
+ index := (interpreterProxy isIntegerObject: objectPointer)
+ ifTrue: [interpreterProxy integerValueOf: objectPointer]
+ ifFalse:
+ [((interpreterProxy isBytes: objectPointer)
+ and: [(interpreterProxy byteSizeOf: objectPointer) = BytesPerWord]) ifFalse:
+ [interpreterProxy primitiveFail.
+ ^nil].
+ interpreterProxy longAt: objectPointer + BaseHeaderSize].
+ ^openFiles at: index!
- ^interpreterProxy fileValueOf: objectPointer!
Item was added:
+ ----- Method: FilePluginSimulator>>initialiseModule (in category 'initialize-release') -----
+ initialiseModule
+ "See FilePluginSimulator>>sqFileStdioHandlesInto:"
+ (openFiles := Dictionary new)
+ at: 0 put: (FakeStdinStream for: interpreterProxy interpreter); "stdin"
+ at: 1 put: Transcript; "stdout"
+ at: 2 put: Transcript. "stderr"
+ ^super initialiseModule!
Item was removed:
- ----- Method: FilePluginSimulator>>oopForPointer: (in category 'simulation') -----
- oopForPointer: pointer
- "This gets implemented by Macros in C, where its types will also be checked.
- oop is the width of a machine word, and pointer is a raw address."
-
- ^ pointer!
Item was added:
+ ----- Method: FilePluginSimulator>>primitiveDirectoryEntry (in category 'simulation') -----
+ primitiveDirectoryEntry
+ ^interpreterProxy interpreter primitiveDirectoryEntry!
Item was changed:
----- Method: FilePluginSimulator>>primitiveDirectoryLookup (in category 'simulation') -----
primitiveDirectoryLookup
+ ^interpreterProxy interpreter primitiveDirectoryLookup!
- ^interpreterProxy primitiveDirectoryLookup!
Item was removed:
- ----- Method: FilePluginSimulator>>primitiveFileDelete (in category 'simulation') -----
- primitiveFileDelete
- ^interpreterProxy primitiveFileDelete !
Item was removed:
- ----- Method: FilePluginSimulator>>primitiveFileOpen (in category 'simulation') -----
- primitiveFileOpen
- ^interpreterProxy primitiveFileOpen!
Item was added:
+ ----- Method: FilePluginSimulator>>sizeof: (in category 'simulation') -----
+ sizeof: objectSymbolOrClass
+ "In the simulator file handles are just integer indices into openFiles and so need only be BytesPerWord big."
+ ^objectSymbolOrClass == #SQFile
+ ifTrue: [self bytesPerWord]
+ ifFalse: [super sizeof: objectSymbolOrClass]!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category 'simulation') -----
sqFile: file Read: count Into: byteArrayIndex At: startIndex
+ | interpreter |
+ interpreter := interpreterProxy interpreter.
+ startIndex to: startIndex + count - 1 do:
+ [ :i |
+ file atEnd ifTrue: [^i - startIndex].
+ interpreter byteAt: byteArrayIndex + i put: file next asInteger].
+ ^count!
- ^interpreterProxy sqFile: file Read: count Into: byteArrayIndex At: startIndex!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:SetPosition: (in category 'simulation') -----
sqFile: file SetPosition: newPosition
+ file position: newPosition!
- ^interpreterProxy sqFile: file SetPosition: newPosition!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:Truncate: (in category 'simulation') -----
sqFile: file Truncate: truncatePosition
+ file truncate: truncatePosition!
- ^interpreterProxy sqFile: file Truncate: truncatePosition!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:Write:From:At: (in category 'simulation') -----
sqFile: file Write: count From: byteArrayIndex At: startIndex
+ | interpreter |
+ interpreter := interpreterProxy interpreter.
+ file isBinary
+ ifTrue:
+ [startIndex to: startIndex + count - 1 do:
+ [ :i | file nextPut: (interpreter byteAt: byteArrayIndex + i)]]
+ ifFalse:
+ [startIndex to: startIndex + count - 1 do:
+ [ :i | | byte |
+ byte := interpreter byteAt: byteArrayIndex + i.
+ file nextPut: (Character value: (byte == 12 "lf" ifTrue: [15"cr"] ifFalse: [byte]))]].
+ ^count!
- ^interpreterProxy sqFile: file Write: count From: byteArrayIndex At: startIndex!
Item was changed:
----- Method: FilePluginSimulator>>sqFileAtEnd: (in category 'simulation') -----
sqFileAtEnd: file
+ ^file atEnd!
- ^interpreterProxy sqFileAtEnd: file!
Item was changed:
----- Method: FilePluginSimulator>>sqFileClose: (in category 'simulation') -----
sqFileClose: file
+ file close!
- ^interpreterProxy sqFileClose: file!
Item was added:
+ ----- Method: FilePluginSimulator>>sqFileDeleteName:Size: (in category 'simulation') -----
+ sqFileDeleteName: nameIndex Size: nameSize
+ | path |
+ path := interpreterProxy interpreter asString: nameIndex size: nameSize.
+ (StandardFileStream isAFileNamed: path) ifFalse:
+ [^interpreterProxy primitiveFail].
+ [FileDirectory deleteFilePath: path]
+ on: Error
+ do: [:ex| interpreterProxy primitiveFail]!
Item was changed:
----- Method: FilePluginSimulator>>sqFileFlush: (in category 'simulation') -----
sqFileFlush: file
+ ^file flush!
- ^interpreterProxy sqFileFlush: file!
Item was changed:
----- Method: FilePluginSimulator>>sqFileGetPosition: (in category 'simulation') -----
sqFileGetPosition: file
+ ^file position!
- ^interpreterProxy sqFileGetPosition: file!
Item was added:
+ ----- Method: FilePluginSimulator>>sqFileRenameOld:Size:New:Size: (in category 'simulation') -----
+ sqFileRenameOld: oldNameIndex Size: oldNameSize New: newNameIndex Size: newNameSize
+ | oldPath newPath |
+ oldPath := FileDirectory default fullNameFor: (interpreterProxy interpreter asString: oldNameIndex size: oldNameSize).
+ newPath := FileDirectory default fullNameFor: (interpreterProxy interpreter asString: newNameIndex size: newNameSize).
+ ((StandardFileStream isAFileNamed: oldPath)
+ and: [(StandardFileStream isAFileNamed: newPath) not]) ifFalse:
+ [^interpreterProxy primitiveFail].
+ [FileDirectory default primRename: oldPath to: newPath]
+ on: Error
+ do: [:ex| interpreterProxy primitiveFail]!
Item was changed:
----- Method: FilePluginSimulator>>sqFileSize: (in category 'simulation') -----
sqFileSize: file
+ ^file size!
- ^interpreterProxy sqFileSize: file!
Item was changed:
----- Method: FilePluginSimulator>>sqFileStdioHandlesInto: (in category 'simulation') -----
+ sqFileStdioHandlesInto: anArray
+ (interpreterProxy transcript ~~ Transcript
+ or: [UIManager default confirm: 'clear transcript?']) ifTrue:
+ [interpreterProxy transcript clear].
+ "See FilePluginSimulator>>initialiseModule"
+ anArray
+ at: 1 put: 0;
+ at: 2 put: 1;
+ at: 3 put: 2.
+ ^7!
- sqFileStdioHandlesInto: aCPointerAddress
- "Implemented in support code for primitiveStdioHandles.
- Answer 0 to fail the primitive in simulation."
- ^0!
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."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #argPtr type:'float *'>
- <var: #rcvrPtr type: 'float *'>
- <var: #argPtr type: 'float *'>
arg := interpreterProxy stackObjectValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: arg).
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: arg.
interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
interpreterProxy failed ifTrue:[^nil].
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')].
- rcvrPtr at: i put: (rcvrPtr at: i) + (argPtr at: i)].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAddScalar (in category 'arithmetic primitives') -----
primitiveAddScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value length |
<export: true>
+ <var: #value type:'double '>
+ <var: #rcvrPtr type:'float *'>
- <var: #value type: 'double '>
- <var: #rcvrPtr type: 'float *'>
value := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
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].
- rcvrPtr at: i put: (rcvrPtr at: i) + value].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAt (in category 'access primitives') -----
primitiveAt
| index rcvr floatValue floatPtr |
<export: true>
+ <var: #floatValue type:'double '>
+ <var: #floatPtr type:'float *'>
- <var: #floatValue type: 'double '>
- <var: #floatPtr type: 'float *'>
index := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy success: (index > 0 and:[index <= (interpreterProxy slotSizeOf: rcvr)]).
interpreterProxy failed ifTrue:[^nil].
floatPtr := interpreterProxy firstIndexableField: rcvr.
floatValue := (floatPtr at: index-1) asFloat.
interpreterProxy pop: 2.
interpreterProxy pushFloat: floatValue.!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAtPut (in category 'access primitives') -----
primitiveAtPut
| value floatValue index rcvr floatPtr |
<export: true>
<var: #floatValue type: 'double '>
+ <var: #floatPtr type:'float *'>
- <var: #floatPtr type: 'float *'>
value := interpreterProxy stackValue: 0.
(interpreterProxy isIntegerObject: value)
ifTrue:[floatValue := (interpreterProxy integerValueOf: value) asFloat]
ifFalse:[floatValue := interpreterProxy floatValueOf: value].
index := interpreterProxy stackIntegerValue: 1.
rcvr := interpreterProxy stackObjectValue: 2.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy success: (index > 0 and:[index <= (interpreterProxy slotSizeOf: rcvr)]).
interpreterProxy failed ifTrue:[^nil].
floatPtr := interpreterProxy firstIndexableField: rcvr.
floatPtr at: index-1 put: (self cCoerce: floatValue to:'float').
interpreterProxy failed ifFalse: [interpreterProxy pop: 3 thenPush: value].!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDivFloatArray (in category 'arithmetic primitives') -----
primitiveDivFloatArray
"Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #argPtr type:'float *'>
- <var: #rcvrPtr type: 'float *'>
- <var: #argPtr type: 'float *'>
arg := interpreterProxy stackObjectValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: arg).
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: arg.
interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
interpreterProxy failed ifTrue:[^nil].
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|
+ ( interpreterProxy intAtPointer:(self cCoerce: (argPtr + i) to: 'char*')) = 0 ifTrue:[^interpreterProxy primitiveFail]].
- ( self intAtPointer:(self cCoerce: (argPtr + i) to: 'char*')) = 0 ifTrue:[^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').
- rcvrPtr at: i put: (rcvrPtr at: i) / (argPtr at: i).
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDivScalar (in category 'arithmetic primitives') -----
primitiveDivScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value inverse length |
<export: true>
+ <var: #value type:'double '>
+ <var: #inverse type:'double '>
+ <var: #rcvrPtr type:'float *'>
- <var: #value type: 'double '>
- <var: #inverse type: 'double '>
- <var: #rcvrPtr type: 'float *'>
value := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
value = 0.0 ifTrue:[^interpreterProxy primitiveFail].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
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.
- rcvrPtr at: i put: (rcvrPtr at: i) * inverse.
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
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."
| rcvr arg rcvrPtr argPtr length result |
<export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #argPtr type:'float *'>
+ <var: #result type:'double '>
- <var: #rcvrPtr type: 'float *'>
- <var: #argPtr type: 'float *'>
- <var: #result type: 'double '>
arg := interpreterProxy stackObjectValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: arg).
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: arg.
interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
interpreterProxy failed ifTrue:[^nil].
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')).
- result := result + ((rcvrPtr at: i) * (argPtr at: i)).
].
interpreterProxy pop: 2. "Pop args + rcvr"
interpreterProxy pushFloat: result. "Return result"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveEqual (in category 'access primitives') -----
primitiveEqual
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #argPtr type:'float *'>
- <var: #rcvrPtr type: 'float *'>
- <var: #argPtr type: 'float *'>
arg := interpreterProxy stackObjectValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: arg).
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: 2.
length := interpreterProxy stSizeOf: arg.
length = (interpreterProxy stSizeOf: rcvr) ifFalse:[^interpreterProxy pushBool: 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 pushBool: false].
].
^interpreterProxy pushBool: true!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveHashArray (in category 'access primitives') -----
primitiveHashArray
| rcvr rcvrPtr length result |
<export: true>
+ <var: #rcvrPtr type:'int *'>
- <var: #rcvrPtr type: 'int *'>
rcvr := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: 'int *'.
result := 0.
0 to: length-1 do:[:i|
result := result + (rcvrPtr at: i).
].
interpreterProxy pop: 1.
^interpreterProxy pushInteger: (result bitAnd: 16r1FFFFFFF)!
Item was added:
+ ----- Method: FloatArrayPlugin>>primitiveLength (in category 'arithmetic primitives') -----
+ primitiveLength
+
+ "Primitive. Compute the length of the argument (sqrt of sum of component squares)."
+
+ | rcvr rcvrPtr length result |
+ <export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #result type:'double '>
+ rcvr := interpreterProxy stackObjectValue: 0.
+ interpreterProxy failed ifTrue:[^nil].
+ interpreterProxy success: (interpreterProxy isWords: rcvr).
+ interpreterProxy failed ifTrue:[^nil].
+ length := interpreterProxy stSizeOf: rcvr.
+ interpreterProxy success: true.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: 'float *'.
+ result := 0.0.
+ 0 to: length-1 do:[:i|
+ result := result + ((self cCoerce: (rcvrPtr at: i) to: 'double') * (self cCoerce: (rcvrPtr at: i) to: 'double')).
+ ].
+ result := self cCode: 'sqrt(result)' inSmalltalk: [result sqrt].
+ interpreterProxy pop: 1 thenPush: (interpreterProxy floatObjectOf: result)!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveMulFloatArray (in category 'arithmetic primitives') -----
primitiveMulFloatArray
"Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #argPtr type:'float *'>
- <var: #rcvrPtr type: 'float *'>
- <var: #argPtr type: 'float *'>
arg := interpreterProxy stackObjectValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: arg).
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: arg.
interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
interpreterProxy failed ifTrue:[^nil].
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').
- rcvrPtr at: i put: (rcvrPtr at: i) * (argPtr at: i).
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveMulScalar (in category 'arithmetic primitives') -----
primitiveMulScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value length |
<export: true>
+ <var: #value type:'double '>
+ <var: #rcvrPtr type:'float *'>
- <var: #value type: 'double '>
- <var: #rcvrPtr type: 'float *'>
value := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
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.
- rcvrPtr at: i put: (rcvrPtr at: i) * value.
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was added:
+ ----- Method: FloatArrayPlugin>>primitiveNormalize (in category 'arithmetic primitives') -----
+ primitiveNormalize
+
+ "Primitive. Normalize the argument (A FloatArray) in place."
+
+ | rcvr rcvrPtr length len |
+ <export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #len type:'double '>
+ rcvr := interpreterProxy stackObjectValue: 0.
+ interpreterProxy failed ifTrue:[^nil].
+ interpreterProxy success: (interpreterProxy isWords: rcvr).
+ interpreterProxy failed ifTrue:[^nil].
+ length := interpreterProxy stSizeOf: rcvr.
+ interpreterProxy success: true.
+ 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')).
+ ].
+ interpreterProxy success: (len > 0.0).
+ interpreterProxy failed ifTrue:[^nil].
+
+ len := self cCode: 'sqrt(len)' inSmalltalk: [len sqrt].
+ 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. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <var: #rcvrPtr type:'float *'>
+ <var: #argPtr type:'float *'>
- <var: #rcvrPtr type: 'float *'>
- <var: #argPtr type: 'float *'>
arg := interpreterProxy stackObjectValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: arg).
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: arg.
interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
interpreterProxy failed ifTrue:[^nil].
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').
- rcvrPtr at: i put: (rcvrPtr at: i) - (argPtr at: i).
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSubScalar (in category 'arithmetic primitives') -----
primitiveSubScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value length |
<export: true>
+ <var: #value type:'double '>
+ <var: #rcvrPtr type:'float *'>
- <var: #value type: 'double '>
- <var: #rcvrPtr type: 'float *'>
value := interpreterProxy stackFloatValue: 0.
rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
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.
- rcvrPtr at: i put: (rcvrPtr at: i) - value.
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSum (in category 'arithmetic primitives') -----
primitiveSum
"Primitive. Find the sum of each float in the receiver, a FloatArray, and stash the result into the argument Float."
| rcvr rcvrPtr length sum |
<export: true>
+ <var: #sum type:'double '>
+ <var: #rcvrPtr type:'float *'>
- <var: #sum type: 'double '>
- <var: #rcvrPtr type: 'float *'>
rcvr := interpreterProxy stackObjectValue: 0.
interpreterProxy failed ifTrue:[^nil].
interpreterProxy success: (interpreterProxy isWords: rcvr).
interpreterProxy failed ifTrue:[^nil].
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').
- sum := sum + (rcvrPtr at: i).
].
interpreterProxy pop: 1 thenPush: (interpreterProxy floatObjectOf: sum)!
Item was added:
+ ----- Method: FloatMathPlugin class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ ^FloatMathPluginSimulator!
Item was added:
+ FloatMathPlugin subclass: #FloatMathPluginSimulator
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-InterpreterSimulation'!
+
+ !FloatMathPluginSimulator commentStamp: '<historical>' prior: 0!
+ Float math plugin simulation for the VM simulator!
Item was added:
+ ----- Method: FloatMathPluginSimulator class>>shouldBeTranslated (in category 'translation') -----
+ shouldBeTranslated
+ "This class should not be translated"
+ ^false!
Item was added:
+ ----- Method: FloatMathPluginSimulator>>isnan: (in category 'float primitives') -----
+ isnan: result
+ ^result isNaN!
Item was added:
+ TestCase subclass: #FloatMathPluginTests
+ instanceVariableNames: 'random'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Tests'!
+
+ !FloatMathPluginTests commentStamp: '<historical>' prior: 0!
+ FloatMathPluginTests buildSuite run.!
Item was added:
+ ----- Method: FloatMathPluginTests>>arcCos: (in category 'math') -----
+ arcCos: f
+ <primitive: 'primitiveArcCos' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>arcCosH: (in category 'math') -----
+ arcCosH: f
+ <primitive: 'primitiveArcCosH' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>arcSin: (in category 'math') -----
+ arcSin: f
+ <primitive: 'primitiveArcSin' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>arcSinH: (in category 'math') -----
+ arcSinH: f
+ <primitive: 'primitiveArcSinH' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>arcTan2:with: (in category 'math') -----
+ arcTan2: value with: arg
+ <primitive: 'primitiveArcTan2' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>arcTan: (in category 'math') -----
+ arcTan: value
+ <primitive: 'primitiveArcTan' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>arcTanH: (in category 'math') -----
+ arcTanH: value
+ <primitive: 'primitiveArcTanH' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>cos: (in category 'math') -----
+ cos: value
+ <primitive: 'primitiveCos' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>cosH: (in category 'math') -----
+ cosH: value
+ <primitive: 'primitiveCosH' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>exp: (in category 'math') -----
+ exp: value
+ <primitive: 'primitiveExp' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>fractionPart: (in category 'math') -----
+ fractionPart: value
+ <primitive: 'primitiveFractionalPart' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>hypot:with: (in category 'math') -----
+ hypot: x with: y
+ <primitive: 'primitiveHypot' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>ln: (in category 'math') -----
+ ln: value
+ <primitive: 'primitiveLogN' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>log10: (in category 'math') -----
+ log10: value
+ <primitive: 'primitiveLog10' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>makeLargeTestData (in category 'running') -----
+ makeLargeTestData
+ "self basicNew makeLargeTestData"
+ self makeTestData: 'sin-large.dat' using:[:f| self sin: f] seed: 432567 rounds: 1000000.
+ self makeTestData: 'log-large.dat' using:[:f| self ln: f abs] seed: 432567 rounds: 1000000.
+ self makeTestData: 'sqrt-large.dat' using:[:f| self sqrt: f abs] seed: 432567 rounds: 1000000.
+ self makeTestData: 'atan-large.dat' using:[:f| self arcTan: f] seed: 432567 rounds: 1000000.
+ self makeTestData: 'exp-large.dat' using:[:f| self exp: f] seed: 432567 rounds: 1000000.
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>makeSmallTestData (in category 'running') -----
+ makeSmallTestData
+ "self basicNew makeSmallTestData"
+ self makeTestData: 'sin-small.dat' using:[:f| self sin: f] seed: 321567 rounds: 10000.
+ self makeTestData: 'log-small.dat' using:[:f| self ln: f abs] seed: 321567 rounds: 10000.
+ self makeTestData: 'sqrt-small.dat' using:[:f| self sqrt: f abs] seed: 321567 rounds: 10000.
+ self makeTestData: 'atan-small.dat' using:[:f| self arcTan: f] seed: 321567 rounds: 10000.
+ self makeTestData: 'exp-small.dat' using:[:f| self exp: f] seed: 321567 rounds: 10000.
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>makeTestData:using:seed:rounds: (in category 'running') -----
+ makeTestData: fileName using: aBlock seed: seed rounds: rounds
+ | bytes out float result |
+ bytes := ByteArray new: 8.
+ out := FileStream newFileNamed: fileName.
+ [
+ out binary.
+ out nextNumber: 4 put: rounds.
+ out nextNumber: 4 put: seed.
+ random := Random seed: seed.
+ float := Float basicNew: 2.
+ 'Creating test data for: ', fileName
+ displayProgressAt: Sensor cursorPoint
+ from: 1 to: rounds during:[:bar|
+ 1 to: rounds do:[:i|
+ i \\ 10000 = 0 ifTrue:[bar value: i].
+ [1 to: 8 do:[:j| bytes at: j put: (random nextInt: 256)-1].
+ float basicAt: 1 put: (bytes unsignedLongAt: 1 bigEndian: true).
+ float basicAt: 2 put: (bytes unsignedLongAt: 5 bigEndian: true).
+ float isNaN] whileTrue.
+ result := aBlock value: float.
+ out nextNumber: 4 put: (result basicAt: 1).
+ out nextNumber: 4 put: (result basicAt: 2).
+ ].
+ ].
+ ] ensure:[out close].
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>md5HashMessage: (in category 'md5') -----
+ md5HashMessage: aStringOrByteArray
+ ^ self md5HashStream: (ReadStream on: aStringOrByteArray asByteArray)
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>md5HashStream: (in category 'md5') -----
+ md5HashStream: aStream
+ | start buffer bytes sz n words hash large |
+ hash := WordArray with: 16r67452301 with: 16rEFCDAB89 with: 16r98BADCFE with: 16r10325476.
+ words := WordArray new: 16.
+ buffer := ByteArray new: 64.
+ start := aStream position.
+ [aStream atEnd] whileFalse: [
+ bytes := aStream nextInto: buffer.
+ (bytes size < 64 or:[aStream atEnd]) ifTrue:[
+ sz := bytes size.
+ buffer replaceFrom: 1 to: sz with: bytes startingAt: 1.
+ buffer from: sz+1 to: buffer size put: 0.
+ sz < 56 ifTrue:[
+ buffer at: sz + 1 put: 128. "trailing bit"
+ ] ifFalse:[
+ "not enough room for the length, so just pad this one, then..."
+ sz < 64 ifTrue:[buffer at: sz + 1 put: 128].
+ 1 to: 16 do:[:i| words at: i put: (buffer unsignedLongAt: i*4-3 bigEndian: false)].
+ self md5Transform: words hash: hash.
+ "process one additional block of padding ending with the length"
+ buffer atAllPut: 0.
+ sz = 64 ifTrue: [buffer at: 1 put: 128].
+ ].
+ "Fill in the final 8 bytes with the 64-bit length in bits."
+ n := (aStream position - start) * 8.
+ 7 to: 0 by: -1 do:[:i| buffer at: (buffer size - i) put: ((n bitShift: 7 - i * -8) bitAnd: 255)].
+ ].
+ 1 to: 16 do:[:i| words at: i put: (buffer unsignedLongAt: i*4-3 bigEndian: false)].
+ self md5Transform: words hash: hash.
+ ].
+ bytes := ByteArray new: 16.
+ bytes unsignedLongAt: 1 put: (hash at: 4) bigEndian: true.
+ bytes unsignedLongAt: 5 put: (hash at: 3) bigEndian: true.
+ bytes unsignedLongAt: 9 put: (hash at: 2) bigEndian: true.
+ bytes unsignedLongAt: 13 put: (hash at: 1) bigEndian: true.
+ large := LargePositiveInteger new: 16.
+ 1 to: 16 do:[:i| large digitAt: i put: (bytes at: i)].
+ ^large normalize!
Item was added:
+ ----- Method: FloatMathPluginTests>>md5Transform:hash: (in category 'md5') -----
+ md5Transform: in hash: hash
+ "This adds the incoming words to the existing hash"
+ | a b c d |
+ <primitive: 'primitiveMD5Transform' module: 'CroquetPlugin'>
+ a := hash at: 1.
+ b := hash at: 2.
+ c := hash at: 3.
+ d := hash at: 4.
+
+ a := self step1: a x: b y: c z: d data: (in at: 1) add: 16rD76AA478 shift: 7.
+ d := self step1: d x: a y: b z: c data: (in at: 2) add: 16rE8C7B756 shift: 12.
+ c := self step1: c x: d y: a z: b data: (in at: 3) add: 16r242070DB shift: 17.
+ b := self step1: b x: c y: d z: a data: (in at: 4) add: 16rC1BDCEEE shift: 22.
+ a := self step1: a x: b y: c z: d data: (in at: 5) add: 16rF57C0FAF shift: 7.
+ d := self step1: d x: a y: b z: c data: (in at: 6) add: 16r4787C62A shift: 12.
+ c := self step1: c x: d y: a z: b data: (in at: 7) add: 16rA8304613 shift: 17.
+ b := self step1: b x: c y: d z: a data: (in at: 8) add: 16rFD469501 shift: 22.
+ a := self step1: a x: b y: c z: d data: (in at: 9) add: 16r698098D8 shift: 7.
+ d := self step1: d x: a y: b z: c data: (in at: 10) add: 16r8B44F7AF shift: 12.
+ c := self step1: c x: d y: a z: b data: (in at: 11) add: 16rFFFF5BB1 shift: 17.
+ b := self step1: b x: c y: d z: a data: (in at: 12) add: 16r895CD7BE shift: 22.
+ a := self step1: a x: b y: c z: d data: (in at: 13) add: 16r6B901122 shift: 7.
+ d := self step1: d x: a y: b z: c data: (in at: 14) add: 16rFD987193 shift: 12.
+ c := self step1: c x: d y: a z: b data: (in at: 15) add: 16rA679438E shift: 17.
+ b := self step1: b x: c y: d z: a data: (in at: 16) add: 16r49B40821 shift: 22.
+
+ a := self step2: a x: b y: c z: d data: (in at: 2) add: 16rF61E2562 shift: 5.
+ d := self step2: d x: a y: b z: c data: (in at: 7) add: 16rC040B340 shift: 9.
+ c := self step2: c x: d y: a z: b data: (in at: 12) add: 16r265E5A51 shift: 14.
+ b := self step2: b x: c y: d z: a data: (in at: 1) add: 16rE9B6C7AA shift: 20.
+ a := self step2: a x: b y: c z: d data: (in at: 6) add: 16rD62F105D shift: 5.
+ d := self step2: d x: a y: b z: c data: (in at: 11) add: 16r02441453 shift: 9.
+ c := self step2: c x: d y: a z: b data: (in at: 16) add: 16rD8A1E681 shift: 14.
+ b := self step2: b x: c y: d z: a data: (in at: 5) add: 16rE7D3FBC8 shift: 20.
+ a := self step2: a x: b y: c z: d data: (in at: 10) add: 16r21E1CDE6 shift: 5.
+ d := self step2: d x: a y: b z: c data: (in at: 15) add: 16rC33707D6 shift: 9.
+ c := self step2: c x: d y: a z: b data: (in at: 4) add: 16rF4D50D87 shift: 14.
+ b := self step2: b x: c y: d z: a data: (in at: 9) add: 16r455A14ED shift: 20.
+ a := self step2: a x: b y: c z: d data: (in at: 14) add: 16rA9E3E905 shift: 5.
+ d := self step2: d x: a y: b z: c data: (in at: 3) add: 16rFCEFA3F8 shift: 9.
+ c := self step2: c x: d y: a z: b data: (in at: 8) add: 16r676F02D9 shift: 14.
+ b := self step2: b x: c y: d z: a data: (in at: 13) add: 16r8D2A4C8A shift: 20.
+
+ a := self step3: a x: b y: c z: d data: (in at: 6) add: 16rFFFA3942 shift: 4.
+ d := self step3: d x: a y: b z: c data: (in at: 9) add: 16r8771F681 shift: 11.
+ c := self step3: c x: d y: a z: b data: (in at: 12) add: 16r6D9D6122 shift: 16.
+ b := self step3: b x: c y: d z: a data: (in at: 15) add: 16rFDE5380C shift: 23.
+ a := self step3: a x: b y: c z: d data: (in at: 2) add: 16rA4BEEA44 shift: 4.
+ d := self step3: d x: a y: b z: c data: (in at: 5) add: 16r4BDECFA9 shift: 11.
+ c := self step3: c x: d y: a z: b data: (in at: 8) add: 16rF6BB4B60 shift: 16.
+ b := self step3: b x: c y: d z: a data: (in at: 11) add: 16rBEBFBC70 shift: 23.
+ a := self step3: a x: b y: c z: d data: (in at: 14) add: 16r289B7EC6 shift: 4.
+ d := self step3: d x: a y: b z: c data: (in at: 1) add: 16rEAA127FA shift: 11.
+ c := self step3: c x: d y: a z: b data: (in at: 4) add: 16rD4EF3085 shift: 16.
+ b := self step3: b x: c y: d z: a data: (in at: 7) add: 16r04881D05 shift: 23.
+ a := self step3: a x: b y: c z: d data: (in at: 10) add: 16rD9D4D039 shift: 4.
+ d := self step3: d x: a y: b z: c data: (in at: 13) add: 16rE6DB99E5 shift: 11.
+ c := self step3: c x: d y: a z: b data: (in at: 16) add: 16r1FA27CF8 shift: 16.
+ b := self step3: b x: c y: d z: a data: (in at: 3) add: 16rC4AC5665 shift: 23.
+
+ a := self step4: a x: b y: c z: d data: (in at: 1) add: 16rF4292244 shift: 6.
+ d := self step4: d x: a y: b z: c data: (in at: 8) add: 16r432AFF97 shift: 10.
+ c := self step4: c x: d y: a z: b data: (in at: 15) add: 16rAB9423A7 shift: 15.
+ b := self step4: b x: c y: d z: a data: (in at: 6) add: 16rFC93A039 shift: 21.
+ a := self step4: a x: b y: c z: d data: (in at: 13) add: 16r655B59C3 shift: 6.
+ d := self step4: d x: a y: b z: c data: (in at: 4) add: 16r8F0CCC92 shift: 10.
+ c := self step4: c x: d y: a z: b data: (in at: 11) add: 16rFFEFF47D shift: 15.
+ b := self step4: b x: c y: d z: a data: (in at: 2) add: 16r85845DD1 shift: 21.
+ a := self step4: a x: b y: c z: d data: (in at: 9) add: 16r6FA87E4F shift: 6.
+ d := self step4: d x: a y: b z: c data: (in at: 16) add: 16rFE2CE6E0 shift: 10.
+ c := self step4: c x: d y: a z: b data: (in at: 7) add: 16rA3014314 shift: 15.
+ b := self step4: b x: c y: d z: a data: (in at: 14) add: 16r4E0811A1 shift: 21.
+ a := self step4: a x: b y: c z: d data: (in at: 5) add: 16rF7537E82 shift: 6.
+ d := self step4: d x: a y: b z: c data: (in at: 12) add: 16rBD3AF235 shift: 10.
+ c := self step4: c x: d y: a z: b data: (in at: 3) add: 16r2AD7D2BB shift: 15.
+ b := self step4: b x: c y: d z: a data: (in at: 10) add: 16rEB86D391 shift: 21.
+
+ a := (a + (hash at: 1)) bitAnd: 16rFFFFFFFF. hash at: 1 put: a.
+ b := (b + (hash at: 2)) bitAnd: 16rFFFFFFFF. hash at: 2 put: b.
+ c := (c + (hash at: 3)) bitAnd: 16rFFFFFFFF. hash at: 3 put: c.
+ d := (d + (hash at: 4)) bitAnd: 16rFFFFFFFF. hash at: 4 put: d.
+
+ ^hash!
Item was added:
+ ----- Method: FloatMathPluginTests>>rotate:by: (in category 'md5') -----
+ rotate: value by: amount
+ "Rotate value left by amount"
+ | lowMask highMask |
+ lowMask := (1 bitShift: 32-amount) - 1.
+ highMask := 16rFFFFFFFF - lowMask.
+ ^((value bitAnd: lowMask) bitShift: amount) +
+ ((value bitAnd: highMask) bitShift: amount-32)!
Item was added:
+ ----- Method: FloatMathPluginTests>>runTest: (in category 'running') -----
+ runTest: aBlock
+ | bytes out float result |
+ bytes := ByteArray new: 8.
+ out := WriteStream on: ByteArray new.
+ float := Float basicNew: 2.
+ 1 to: 10000 do:[:i|
+ [1 to: 8 do:[:j| bytes at: j put: (random nextInt: 256)-1].
+ float basicAt: 1 put: (bytes unsignedLongAt: 1 bigEndian: true).
+ float basicAt: 2 put: (bytes unsignedLongAt: 5 bigEndian: true).
+ float isNaN] whileTrue.
+ result := [aBlock value: float] on: Error do:[:ex|
+ "we convert all errors into NaNs to have a value for testing"
+ ex return: Float nan.
+ ].
+ out nextNumber: 4 put: (result basicAt: 1).
+ out nextNumber: 4 put: (result basicAt: 2).
+ ].
+ ^self md5HashMessage: out contents.!
Item was added:
+ ----- Method: FloatMathPluginTests>>setUp (in category 'running') -----
+ setUp
+ random := Random seed: 253213.!
Item was added:
+ ----- Method: FloatMathPluginTests>>sin: (in category 'math') -----
+ sin: value
+ <primitive: 'primitiveSin' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>sinH: (in category 'math') -----
+ sinH: value
+ <primitive: 'primitiveSinH' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>sqrt: (in category 'math') -----
+ sqrt: value
+ <primitive: 'primitiveSqrt' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>step1:x:y:z:data:add:shift: (in category 'md5') -----
+ step1: w x: x y: y z: z data: data add: add shift: s
+ "First step in MD5 transformation"
+ | f result |
+ f := z bitXor: (x bitAnd: (y bitXor: z)).
+ result := w + f + data + add.
+ result := self rotate: result by: s.
+ ^result + x bitAnd: 16rFFFFFFFF!
Item was added:
+ ----- Method: FloatMathPluginTests>>step2:x:y:z:data:add:shift: (in category 'md5') -----
+ step2: w x: x y: y z: z data: data add: add shift: s
+ "First step in MD5 transformation"
+ | f result |
+ f := y bitXor: (z bitAnd: (x bitXor: y)).
+ result := w + f + data + add.
+ result := self rotate: result by: s.
+ ^result + x bitAnd: 16rFFFFFFFF!
Item was added:
+ ----- Method: FloatMathPluginTests>>step3:x:y:z:data:add:shift: (in category 'md5') -----
+ step3: w x: x y: y z: z data: data add: add shift: s
+ "First step in MD5 transformation"
+ | f result |
+ f := (x bitXor: y) bitXor: z.
+ result := w + f + data + add.
+ result := self rotate: result by: s.
+ ^result + x bitAnd: 16rFFFFFFFF!
Item was added:
+ ----- Method: FloatMathPluginTests>>step4:x:y:z:data:add:shift: (in category 'md5') -----
+ step4: w x: x y: y z: z data: data add: add shift: s
+ "First step in MD5 transformation"
+ | f result |
+ f := y bitXor: (x bitOr: (z bitXor: 16rFFFFFFFF)).
+ result := w + f + data + add.
+ result := self rotate: result by: s.
+ ^result + x bitAnd: 16rFFFFFFFF!
Item was added:
+ ----- Method: FloatMathPluginTests>>tan: (in category 'math') -----
+ tan: value
+ <primitive: 'primitiveTan' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>tanH: (in category 'math') -----
+ tanH: value
+ <primitive: 'primitiveTanH' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>testArcCos (in category 'tests') -----
+ testArcCos
+ | hash |
+ hash := self runTest:[:f| self arcCos: f].
+ self assert: hash = 320603091210691421897131240956682310429!
Item was added:
+ ----- Method: FloatMathPluginTests>>testArcCosH (in category 'tests') -----
+ testArcCosH
+ | hash |
+ hash := self runTest:[:f| self arcCosH: f].
+ self assert: hash = 6724426144112251941037505276242428134!
Item was added:
+ ----- Method: FloatMathPluginTests>>testArcSin (in category 'tests') -----
+ testArcSin
+ | hash |
+ hash := self runTest:[:f| self arcSin: f].
+ self assert: hash = 27372132577303862731837100895783885417!
Item was added:
+ ----- Method: FloatMathPluginTests>>testArcSinH (in category 'tests') -----
+ testArcSinH
+ | hash |
+ hash := self runTest:[:f| self arcSinH: f].
+ self assert: hash = 255911863578190171815115260235896145802!
Item was added:
+ ----- Method: FloatMathPluginTests>>testArcTan (in category 'tests') -----
+ testArcTan
+ | hash |
+ hash := self runTest:[:f| self arcTan: f].
+ self assert: hash = 17311773710959114634056077345168823659!
Item was added:
+ ----- Method: FloatMathPluginTests>>testArcTan2 (in category 'tests') -----
+ testArcTan2
+ | hash |
+ hash := self runTest:[:f| self arcTan2: f with: f].
+ self assert: hash = 287068347279655848752274030373495709564!
Item was added:
+ ----- Method: FloatMathPluginTests>>testArcTanH (in category 'tests') -----
+ testArcTanH
+ | hash |
+ hash := self runTest:[:f| self arcTanH: f].
+ self assert: hash = 295711907369004359459882231908879164929!
Item was added:
+ ----- Method: FloatMathPluginTests>>testAtanData (in category 'data') -----
+ testAtanData
+ self verifyTestData: 'atan-small.dat' using:[:f| self arcTan: f].
+ self verifyTestData: 'atan-large.dat' using:[:f| self arcTan: f].
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>testCos (in category 'tests') -----
+ testCos
+ | hash |
+ hash := self runTest:[:f| self cos: f].
+ self assert: hash = 110207739557966732640546618158077332978!
Item was added:
+ ----- Method: FloatMathPluginTests>>testCosH (in category 'tests') -----
+ testCosH
+ | hash |
+ hash := self runTest:[:f| self cosH: f].
+ self assert: hash = 139309299067563830037108641802292492276!
Item was added:
+ ----- Method: FloatMathPluginTests>>testExp (in category 'tests') -----
+ testExp
+ | hash |
+ hash := self runTest:[:f| self exp: f].
+ self assert: hash = 264681209343177480335132131244505189510!
Item was added:
+ ----- Method: FloatMathPluginTests>>testExpData (in category 'data') -----
+ testExpData
+ self verifyTestData: 'exp-small.dat' using:[:f| self exp: f].
+ self verifyTestData: 'exp-large.dat' using:[:f| self exp: f].
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>testFloatAt (in category 'tests') -----
+ testFloatAt
+ | hash flt |
+ flt := FloatArray new: 1.
+ hash := self runTest:[:f| flt at: 1 put: f. flt at: 1].
+ self assert: hash = 80498428122197125691266588764018905399!
Item was added:
+ ----- Method: FloatMathPluginTests>>testFraction (in category 'tests') -----
+ testFraction
+ | hash |
+ hash := self runTest:[:f| self fractionPart: f].
+ self assert: hash = 320444785026869345695277323179170692004!
Item was added:
+ ----- Method: FloatMathPluginTests>>testHypot (in category 'tests') -----
+ testHypot
+ | hash |
+ hash := self runTest:[:f| self hypot: f with: f+1].
+ self assert: hash = 217113721886532765853628735806816720346!
Item was added:
+ ----- Method: FloatMathPluginTests>>testLog (in category 'tests') -----
+ testLog
+ | hash |
+ hash := self runTest:[:f| self ln: f abs].
+ self assert: hash = 24389651894375564945708989023746058645!
Item was added:
+ ----- Method: FloatMathPluginTests>>testLog10 (in category 'tests') -----
+ testLog10
+ | hash |
+ hash := self runTest:[:f| self log10: f abs].
+ self assert: hash = 135564553959509933253581837789050718785!
Item was added:
+ ----- Method: FloatMathPluginTests>>testLogData (in category 'data') -----
+ testLogData
+ self verifyTestData: 'log-small.dat' using:[:f| self ln: f abs].
+ self verifyTestData: 'log-large.dat' using:[:f| self ln: f abs].
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>testMD5 (in category 'md5') -----
+ testMD5
+ self assert: (self md5HashMessage: 'a') = 16r0CC175B9C0F1B6A831C399E269772661.
+ self assert: (self md5HashMessage: 'abc') = 16r900150983CD24FB0D6963F7D28E17F72.
+ self assert: (self md5HashMessage: 'message digest') = 16rF96B697D7CB7938D525A2F31AAF161D0.
+ self assert: (self md5HashMessage:
+ 'abcdefghijklmnopqrstuvwxyz') = 16rC3FCD3D76192E4007DFB496CCA67E13B.
+ self assert: (self md5HashMessage:
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789') =
+ 16rD174AB98D277D9F5A5611C2C9F419D9F.
+ self assert: (self md5HashMessage:
+ '12345678901234567890123456789012345678901234567890123456789012345678901234567890') =
+ 16r57EDF4A22BE3C955AC49DA2E2107B67A.!
Item was added:
+ ----- Method: FloatMathPluginTests>>testSin (in category 'tests') -----
+ testSin
+ | hash |
+ hash := self runTest:[:f| self sin: f].
+ self assert: hash = 290162321010315440569513182938961037473!
Item was added:
+ ----- Method: FloatMathPluginTests>>testSinData (in category 'data') -----
+ testSinData
+ self verifyTestData: 'sin-small.dat' using:[:f| self sin: f].
+ self verifyTestData: 'sin-large.dat' using:[:f| self sin: f].
+ !
Item was added:
+ ----- Method: FloatMathPluginTests>>testSinH (in category 'tests') -----
+ testSinH
+ | hash |
+ hash := self runTest:[:f| self sinH: f].
+ self assert: hash = 146029709156303766079448006055284064911!
Item was added:
+ ----- Method: FloatMathPluginTests>>testSqrt (in category 'tests') -----
+ testSqrt
+ | hash |
+ hash := self runTest:[:f| self sqrt: f abs].
+ self assert: hash = 112236588358122834093969606123302196127!
Item was added:
+ ----- Method: FloatMathPluginTests>>testSqrtData (in category 'data') -----
+ testSqrtData
+ self verifyTestData: 'sqrt-small.dat' using:[:f| self sqrt: f abs].
+ self verifyTestData: 'sqrt-large.dat' using:[:f| self sqrt: f abs].!
Item was added:
+ ----- Method: FloatMathPluginTests>>testTan (in category 'tests') -----
+ testTan
+ | hash |
+ hash := self runTest:[:f| self tan: f].
+ self assert: hash = 207143885112027702205238433494882679660!
Item was added:
+ ----- Method: FloatMathPluginTests>>testTanH (in category 'tests') -----
+ testTanH
+ | hash |
+ hash := self runTest:[:f| self tanH: f].
+ self assert: hash = 15738508136206638425252880299326548123!
Item was added:
+ ----- Method: FloatMathPluginTests>>testTimesTwoPower (in category 'tests') -----
+ testTimesTwoPower
+ | hash |
+ hash := self runTest:[:f| self timesTwoPower: f with: (random nextInt: 200) - 100].
+ self assert: hash = 278837335583284459890979576373223649870.!
Item was added:
+ ----- Method: FloatMathPluginTests>>timesTwoPower:with: (in category 'math') -----
+ timesTwoPower: f with: arg
+ <primitive: 'primitiveTimesTwoPower' module: 'FloatMathPlugin'>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: FloatMathPluginTests>>verifyTestData:using: (in category 'running') -----
+ verifyTestData: fileName using: aBlock
+ | rounds seed bytes float result in expected count bits |
+ in := [FileStream readOnlyFileNamed: fileName]
+ on: FileDoesNotExistException
+ do:[:ex| ex return: nil].
+ in ifNil:[^nil].
+ count := bits := 0.
+ bytes := ByteArray new: 8.
+ [
+ in binary.
+ rounds := in nextNumber: 4.
+ seed := in nextNumber: 4.
+ random := Random seed: seed.
+ float := Float basicNew: 2.
+ expected := Float basicNew: 2.
+ 'Verifying test data from: ', fileName
+ displayProgressAt: Sensor cursorPoint
+ from: 1 to: rounds during:[:bar|
+ 1 to: rounds do:[:i|
+ i \\ 10000 = 0 ifTrue:[bar value: i].
+ [1 to: 8 do:[:j| bytes at: j put: (random nextInt: 256)-1].
+ float basicAt: 1 put: (bytes unsignedLongAt: 1 bigEndian: true).
+ float basicAt: 2 put: (bytes unsignedLongAt: 5 bigEndian: true).
+ float isNaN] whileTrue.
+ result := aBlock value: float.
+ expected basicAt: 1 put: (in nextNumber: 4).
+ expected basicAt: 2 put: (in nextNumber: 4).
+ ((expected isNaN and:[result isNaN]) or:[expected = result]) ifFalse:[
+ (expected basicAt: 1) = (result basicAt: 1)
+ ifFalse:[self error: 'Verification failure'].
+ count := count + 1.
+ bits := bits + ((expected basicAt: 2) - (result basicAt: 2)) abs.
+ ].
+ ].
+ ].
+ ] ensure:[in close].
+ self assert: count = 0. "all the same"!
Item was changed:
----- Method: GeniePlugin>>cSquaredDistanceFrom:to: (in category 'computation') -----
cSquaredDistanceFrom: aPoint to: bPoint
"arguments are pointer to ints paired as x,y coordinates of points"
| aPointX aPointY bPointX bPointY xDiff yDiff |
+ <var: #aPoint type: #'int *'>
+ <var: #bPoint type: #'int *'>
- self var: #aPoint type: 'int * '.
- self var: #bPoint type: 'int * '.
aPointX := aPoint at: 0.
aPointY := aPoint at: 1.
bPointX := bPoint at: 0.
bPointY := bPoint at: 1.
xDiff := bPointX - aPointX.
yDiff := bPointY - aPointY.
^ xDiff * xDiff + (yDiff * yDiff)!
Item was changed:
----- Method: GeniePlugin>>primSameClassAbsoluteStrokeDistanceMyPoints:otherPoints:myVectors:otherVectors:mySquaredLengths:otherSquaredLengths:myAngles:otherAngles:maxSizeAndReferenceFlag:rowBase:rowInsertRemove:rowInsertRemoveCount: (in category 'computation') -----
primSameClassAbsoluteStrokeDistanceMyPoints: myPointsOop otherPoints: otherPointsOop myVectors: myVectorsOop otherVectors: otherVectorsOop mySquaredLengths: mySquaredLengthsOop otherSquaredLengths: otherSquaredLengthsOop myAngles: myAnglesOop otherAngles: otherAnglesOop maxSizeAndReferenceFlag: maxSizeAndRefFlag rowBase: rowBaseOop rowInsertRemove: rowInsertRemoveOop rowInsertRemoveCount: rowInsertRemoveCountOop
| base insertRemove jLimiT substBase insert remove subst removeBase insertBase insertRemoveCount additionalMultiInsertRemoveCost myPoints otherPoints myVectors otherVectors rowInsertRemoveCount mySquaredLengths otherSquaredLengths myAngles otherAngles rowBase rowInsertRemove otherPointsSize myVectorsSize otherVectorsSize otherSquaredLengthsSize rowBaseSize maxDist maxSize forReference jM1 iM1 iM1T2 jM1T2 |
+ <var: #myPoints type: #'int *'>
+ <var: #otherPoints type: #'int *'>
+ <var: #myVectors type: #'int *'>
+ <var: #otherVectors type: #'int *'>
+ <var: #mySquaredLengths type: #'int *'>
+ <var: #otherSquaredLengths type: #'int *'>
+ <var: #myAngles type: #'int *'>
+ <var: #otherAngles type: #'int *'>
+ <var: #rowBase type: #'int *'>
+ <var: #rowInsertRemove type: #'int *'>
+ <var: #rowInsertRemoveCount type: #'int *'>
- self var: #myPoints type: 'int * '.
- self var: #otherPoints type: 'int * '.
- self var: #myVectors type: 'int * '.
- self var: #otherVectors type: 'int * '.
- self var: #mySquaredLengths type: 'int * '.
- self var: #otherSquaredLengths type: 'int * '.
- self var: #myAngles type: 'int * '.
- self var: #otherAngles type: 'int * '.
- self var: #rowBase type: 'int * '.
- self var: #rowInsertRemove type: 'int * '.
- self var: #rowInsertRemoveCount type: 'int * '.
self
primitive: 'primSameClassAbsoluteStrokeDistanceMyPoints_otherPoints_myVectors_otherVectors_mySquaredLengths_otherSquaredLengths_myAngles_otherAngles_maxSizeAndReferenceFlag_rowBase_rowInsertRemove_rowInsertRemoveCount'
parameters: #(#Oop #Oop #Oop #Oop #Oop #Oop #Oop #Oop #SmallInteger #Oop #Oop #Oop)
receiver: #Oop.
interpreterProxy failed
ifTrue: [self msg: 'failed 1'.
^ nil].
interpreterProxy success: (interpreterProxy isWords: myPointsOop)
& (interpreterProxy isWords: otherPointsOop)
& (interpreterProxy isWords: myVectorsOop)
& (interpreterProxy isWords: otherVectorsOop)
& (interpreterProxy isWords: mySquaredLengthsOop)
& (interpreterProxy isWords: otherSquaredLengthsOop)
& (interpreterProxy isWords: myAnglesOop)
& (interpreterProxy isWords: otherAnglesOop)
& (interpreterProxy isWords: rowBaseOop)
& (interpreterProxy isWords: rowInsertRemoveOop)
& (interpreterProxy isWords: rowInsertRemoveCountOop).
interpreterProxy failed
ifTrue: [self msg: 'failed 2'.
^ nil].
interpreterProxy success: (interpreterProxy is: myPointsOop MemberOf: 'PointArray')
& (interpreterProxy is: otherPointsOop MemberOf: 'PointArray').
interpreterProxy failed
ifTrue: [self msg: 'failed 3'.
^ nil].
myPoints := interpreterProxy firstIndexableField: myPointsOop.
otherPoints := interpreterProxy firstIndexableField: otherPointsOop.
myVectors := interpreterProxy firstIndexableField: myVectorsOop.
otherVectors := interpreterProxy firstIndexableField: otherVectorsOop.
mySquaredLengths := interpreterProxy firstIndexableField: mySquaredLengthsOop.
otherSquaredLengths := interpreterProxy firstIndexableField: otherSquaredLengthsOop.
myAngles := interpreterProxy firstIndexableField: myAnglesOop.
otherAngles := interpreterProxy firstIndexableField: otherAnglesOop.
rowBase := interpreterProxy firstIndexableField: rowBaseOop.
rowInsertRemove := interpreterProxy firstIndexableField: rowInsertRemoveOop.
rowInsertRemoveCount := interpreterProxy firstIndexableField: rowInsertRemoveCountOop.
"Note: myPointsSize and mySquaredLengthsSize variables eliminated to reduce
method temporary variable count for closure-enabled images"
"PointArrays"
"myPointsSize := (interpreterProxy stSizeOf: myPointsOop) bitShift: -1."
otherPointsSize := (interpreterProxy stSizeOf: otherPointsOop) bitShift: -1.
myVectorsSize := (interpreterProxy stSizeOf: myVectorsOop) bitShift: -1.
otherVectorsSize := (interpreterProxy stSizeOf: otherVectorsOop) bitShift: -1.
"IntegerArrays"
"mySquaredLengthsSize := interpreterProxy stSizeOf: mySquaredLengthsOop."
otherSquaredLengthsSize := interpreterProxy stSizeOf: otherSquaredLengthsOop.
rowBaseSize := interpreterProxy stSizeOf: rowBaseOop.
interpreterProxy success: rowBaseSize
= (interpreterProxy stSizeOf: rowInsertRemoveOop) & (rowBaseSize
= (interpreterProxy stSizeOf: rowInsertRemoveCountOop)) & (rowBaseSize > otherVectorsSize).
interpreterProxy failed
ifTrue: [self msg: 'failed 4'.
^ nil].
interpreterProxy success: (interpreterProxy stSizeOf: mySquaredLengthsOop) >= (myVectorsSize - 1)
& (((interpreterProxy stSizeOf: myPointsOop) bitShift: -1) >= myVectorsSize)
& (otherSquaredLengthsSize >= (otherVectorsSize - 1))
& (otherPointsSize >= otherVectorsSize) & ((interpreterProxy stSizeOf: myAnglesOop)
>= (myVectorsSize - 1)) & ((interpreterProxy stSizeOf: otherAnglesOop)
>= (otherVectorsSize - 1)).
interpreterProxy failed
ifTrue: [self msg: 'failed 5'.
^ nil].
"maxSizeAndRefFlag contains the maxium feature size (pixel) and also indicates whether
the reference flag (boolean) is set. Therefore the maximum size is moved to the left
and the reference flag is stored in the LSB.
Note: This is necessary to avoid more than 12 primitive parameters"
forReference := maxSizeAndRefFlag bitAnd: 1.
maxSize := maxSizeAndRefFlag bitShift: -1.
maxDist := 1 bitShift: 29.
forReference
ifTrue: [additionalMultiInsertRemoveCost := 0]
ifFalse: [additionalMultiInsertRemoveCost := maxSize * maxSize bitShift: -10].
"C indices!!!!"
rowBase
at: 0
put: 0.
rowInsertRemove
at: 0
put: 0.
rowInsertRemoveCount
at: 0
put: 2.
insertRemove := 0 - additionalMultiInsertRemoveCost.
jLimiT := otherVectorsSize.
otherPointsSize >= (jLimiT - 1) & (otherSquaredLengthsSize >= (jLimiT - 1))
ifFalse: [^ interpreterProxy primitiveFail].
1
to: jLimiT
do: [:j |
jM1 := j - 1.
insertRemove := insertRemove + ((otherSquaredLengths at: jM1)
+ (self
cSquaredDistanceFrom: (otherPoints + (jM1 bitShift: 1))
to: myPoints) bitShift: -7) + additionalMultiInsertRemoveCost.
rowInsertRemove
at: j
put: insertRemove.
rowBase
at: j
put: insertRemove * j.
rowInsertRemoveCount
at: j
put: j + 1].
insertRemove := (rowInsertRemove at: 0)
- additionalMultiInsertRemoveCost.
1
to: myVectorsSize
do: [:i |
iM1 := i - 1.
iM1T2 := iM1 bitShift: 1.
substBase := rowBase at: 0.
insertRemove := insertRemove + ((mySquaredLengths at: iM1)
+ (self
cSquaredDistanceFrom: (myPoints + iM1T2)
to: otherPoints) bitShift: -7) + additionalMultiInsertRemoveCost.
rowInsertRemove
at: 0
put: insertRemove.
rowBase
at: 0
put: insertRemove * i.
rowInsertRemoveCount
at: 0
put: i + 1.
jLimiT := otherVectorsSize.
1
to: jLimiT
do: [:j |
jM1 := j - 1.
jM1T2 := jM1 bitShift: 1.
removeBase := rowBase at: j.
insertBase := rowBase at: jM1.
remove := (mySquaredLengths at: iM1)
+ (self
cSquaredDistanceFrom: (myPoints + iM1T2)
to: (otherPoints + (j bitShift: 1))) bitShift: -7.
(insertRemove := rowInsertRemove at: j) = 0
ifTrue: [removeBase := removeBase + remove]
ifFalse: [removeBase := removeBase + insertRemove + (remove
* (rowInsertRemoveCount at: j)).
remove := remove + insertRemove].
insert := (otherSquaredLengths at: jM1)
+ (self
cSquaredDistanceFrom: (otherPoints + jM1T2)
to: (myPoints + (i bitShift: 1))) bitShift: -7.
(insertRemove := rowInsertRemove at: jM1) = 0
ifTrue: [insertBase := insertBase + insert]
ifFalse: [insertBase := insertBase + insertRemove + (insert
* (rowInsertRemoveCount at: jM1)).
insert := insert + insertRemove].
forReference
ifTrue: [substBase := maxDist]
ifFalse: [subst := (self
cSquaredDistanceFrom: (otherVectors + jM1T2)
to: (myVectors + iM1T2))
+ (self
cSquaredDistanceFrom: (otherPoints + jM1T2)
to: (myPoints + iM1T2)) * (16
+ (self
cSubstAngleFactorFrom: (otherAngles at: jM1)
to: (myAngles at: iM1))) bitShift: -11.
substBase := substBase + subst].
(substBase <= removeBase
and: [substBase <= insertBase])
ifTrue: [base := substBase.
insertRemove := 0.
insertRemoveCount := 1]
ifFalse: [removeBase <= insertBase
ifTrue: [base := removeBase.
insertRemove := remove + additionalMultiInsertRemoveCost.
insertRemoveCount := (rowInsertRemoveCount at: j)
+ 1]
ifFalse: [base := insertBase.
insertRemove := insert + additionalMultiInsertRemoveCost.
insertRemoveCount := (rowInsertRemoveCount at: jM1)
+ 1]].
substBase := rowBase at: j.
rowBase
at: j
put: (base min: maxDist).
rowInsertRemove
at: j
put: (insertRemove min: maxDist).
rowInsertRemoveCount
at: j
put: insertRemoveCount].
insertRemove := rowInsertRemove at: 0].
^ base asOop: SmallInteger
!
Item was changed:
----- Method: InflatePlugin>>zipDecodeValueFrom:size: (in category 'inflating') -----
zipDecodeValueFrom: table size: tableSize
"Decode the next value in the receiver using the given huffman table."
| bits bitsNeeded tableIndex value index |
+ <var: #table type:'unsigned int *'>
- <var: #table type: 'unsigned int *'>
bitsNeeded := (table at: 0) bitShift: -24. "Initial bits needed"
bitsNeeded > MaxBits ifTrue:[interpreterProxy primitiveFail. ^0].
tableIndex := 2. "First real table"
[true] whileTrue:[
bits := self zipNextBits: bitsNeeded. "Get bits"
index := tableIndex + bits - 1.
index >= tableSize ifTrue:[interpreterProxy primitiveFail. ^0].
value := table at: index. "Lookup entry in table"
(value bitAnd: 16r3F000000) = 0 ifTrue:[^value]. "Check if it is a leaf node"
"Fetch sub table"
tableIndex := value bitAnd: 16rFFFF. "Table offset in low 16 bit"
bitsNeeded := (value bitShift: -24) bitAnd: 255. "Additional bits in high 8 bit"
bitsNeeded > MaxBits ifTrue:[interpreterProxy primitiveFail. ^0]].
^0!
Item was changed:
----- Method: InternetConfigPlugin>>primitiveGetMacintoshFileTypeAndCreatorFrom: (in category 'system primitives') -----
primitiveGetMacintoshFileTypeAndCreatorFrom: aFileName
| oop ptr keyLength creator |
+ <var: #aFile declareC: 'char aFile[256]'>
+ <var: #creator declareC: 'char creator[8]'>
+ <var: #ptr type: 'char *'>
self primitive: 'primitiveGetMacintoshFileTypeAndCreatorFrom'
parameters: #(String).
+
- self var: #aFile declareC: 'char aFile[256]'.
- self var: #creator declareC: 'char creator[8]'.
- self var: #ptr type: 'char *'.
-
keyLength := interpreterProxy byteSizeOf: aFileName cPtrAsOop.
self sqInternetGetMacintoshFileTypeAndCreatorFrom: aFileName keySize: keyLength into: creator.
oop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: 8.
ptr := interpreterProxy firstIndexableField: oop.
0 to: 7 do:[:i|
ptr at: i put: (creator at: i)].
^oop.
!
Item was changed:
----- Method: InternetConfigPlugin>>primitiveGetStringKeyedBy: (in category 'system primitives') -----
primitiveGetStringKeyedBy: aKey
| oop ptr size aString keyLength |
+ <var: #aString declareC: 'char aString[1025]'>
+ <var: #ptr type: 'char *'>
self primitive: 'primitiveGetStringKeyedBy'
parameters: #(String).
- self var: #aString declareC: 'char aString[1025]'.
- self var: #ptr type: 'char *'.
keyLength := interpreterProxy byteSizeOf: aKey cPtrAsOop.
size := self sqInternetConfigurationGetStringKeyedBy: aKey keySize: keyLength into: aString.
oop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
ptr := interpreterProxy firstIndexableField: oop.
0 to: size-1 do:[:i|
ptr at: i put: (aString at: i)].
^oop.
!
Item was added:
+ ----- Method: Interpreter>>is:KindOfClass: (in category 'plugin primitive support') -----
+ is: oop KindOfClass: aClass
+ "Support for external primitives."
+ <api>
+ | oopClass |
+ oopClass := self fetchClassOf: oop.
+ [oopClass = objectMemory nilObj] whileFalse:
+ [oopClass = aClass ifTrue: [^true].
+ oopClass := self superclassOf: oopClass].
+ ^false!
Item was added:
+ ----- Method: InterpreterPrimitives class>>requiredMethodNames (in category 'translation') -----
+ requiredMethodNames
+ "return the list of method names that should be retained for export or other support reasons"
+
+ ^super requiredMethodNames, #(floatArg: integerArg: methodArg: methodReturnValue: objectArg: primitiveMethod)!
Item was changed:
----- Method: InterpreterPrimitives class>>vmProxyMinorVersion (in category 'api version') -----
vmProxyMinorVersion
"Define the VM_PROXY_MINOR version for this VM as used to
define the api in platforms/Cross/vm/sqVirtualMachine.[ch]"
+ ^11!
- ^9!
Item was added:
+ ----- Method: InterpreterPrimitives>>add:HighPriorityTickee: (in category 'FIXME') -----
+ add: ticker HighPriorityTickee: periodms
+ "Declared in Cross/sqVirtualMachine but not implemented in platform support"
+ <export: true>
+ <var: 'ticker' type: 'void *'>
+ <var: 'periodms' type: 'unsigned'>
+ <returnTypeC: 'sqInt'>
+
+ "void (*addHighPriorityTickee)(void (*ticker)(void), unsigned periodms);"
+
+ self flag: #FIXME. "remove this method when platform sources are reconciled"
+ ^true!
Item was added:
+ ----- Method: InterpreterPrimitives>>add:Synchronous:Tickee: (in category 'FIXME') -----
+ add: ticker Synchronous: periodms Tickee: roundms
+ "Declared in Cross/sqVirtualMachine but not implemented in platform support"
+ <export: true>
+ <var: 'ticker' type: 'void *'>
+ <var: 'periodms' type: 'unsigned'>
+ <var: 'roundms' type: 'unsigned'>
+ <returnTypeC: 'sqInt'>
+
+ "void (*addSynchronousTickee)(void (*ticker)(void), unsigned periodms, unsigned roundms);"
+
+ self flag: #FIXME. "remove this method when platform sources are reconciled"
+ ^true!
Item was added:
+ ----- Method: InterpreterPrimitives>>amInVMThread (in category 'FIXME') -----
+ amInVMThread
+ "Declared in Cross/sqVirtualMachine but not implemented in platform support"
+ <export: true>
+ <returnTypeC: 'sqInt'>
+
+ "extern sqInt amInVMThread(void);"
+
+ self flag: #FIXME. "remove this method when platform sources are reconciled"
+ ^true!
Item was added:
+ ----- Method: InterpreterPrimitives>>floatArg: (in category 'plugin primitive support') -----
+ floatArg: index
+ "Like #stackFloatValue: but access method arguments left-to-right"
+ | result oop |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ oop := self methodArg: index.
+ oop = 0 ifTrue:[^0.0]. "methodArg: failed"
+ "N.B. Because Slang always inlines assertClassOf:is:compactClassIndex:
+ (because assertClassOf:is:compactClassIndex: has an inline: pragma) the
+ phrase (self splObj: ClassArray) is expanded in-place and is _not_
+ evaluated if ClassArrayCompactIndex is non-zero."
+ self assertClassOf: oop is: (objectMemory splObj: ClassFloat)
+ compactClassIndex: ClassFloatCompactIndex.
+ self successful ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ objectMemory fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result].
+ ^0.0!
Item was added:
+ ----- Method: InterpreterPrimitives>>integerArg: (in category 'plugin primitive support') -----
+ integerArg: index
+ "Like #stackIntegerValue: but access method arguments left-to-right"
+ | oop |
+ oop := self methodArg: index.
+ oop = 0 ifTrue:[^0.0]. "methodArg: failed"
+ ^self checkedIntegerValueOf: oop!
Item was added:
+ ----- Method: InterpreterPrimitives>>ioUTCMicroseconds (in category 'FIXME') -----
+ ioUTCMicroseconds
+ "Answer the UTC microseconds since the Smalltalk epoch. The value is
+ derived from the Posix epoch (see primitiveUTCMicrosecondClock) with a
+ constant offset corresponding to elapsed microseconds between the two
+ epochs according to RFC 868."
+
+ "Added to Cross/vm/sqVirtualMachine but incompatible with existing timer
+ support in Cross. Implemented here to provide the function not present in
+ the support code. See also primitiveUTCMicrosecondClock."
+
+ | clock offset epochDelta uSecs |
+ <export: true>
+ <returnTypeC: 'usqLong'>
+ <var: #clock type: 'usqLong'>
+ <var: #offset type: 'int'>
+ <var: #epochDelta declareC: 'static usqLong epochDelta= 2177452800000000ULL'>
+
+ self flag: #FIXME. "remove this method when platform sources are reconciled"
+
+ (self cCode: 'ioUtcWithOffset(&clock, &offset)' inSmalltalk: [-1]) = -1
+ ifTrue: [^ self primitiveFail].
+ clock := clock + epochDelta.
+ uSecs := self positive64BitIntegerFor: clock.
+ ^uSecs.
+ !
Item was added:
+ ----- Method: InterpreterPrimitives>>methodArg: (in category 'plugin primitive support') -----
+ methodArg: index
+ "Like #stackValue: but access method arguments left-to-right"
+ index > argumentCount + 1 ifTrue:[
+ self cCode: 'fprintf(stderr,"[VM]: Attempt to access method args beyond range\n")'.
+ self printCallStack.
+ self primitiveFail.
+ ^0].
+ ^self stackValue: argumentCount - index!
Item was added:
+ ----- Method: InterpreterPrimitives>>methodReturnValue: (in category 'plugin primitive support') -----
+ methodReturnValue: oop
+ "Sets the return value for a method. In the CoInterpreter we replace the cumbersome
+ primResult machinery."
+ self pop: argumentCount+1 thenPush: oop.
+ ^0!
Item was added:
+ ----- Method: InterpreterPrimitives>>objectArg: (in category 'plugin primitive support') -----
+ objectArg: index
+ "Like #stackObjectValue: but access method arguments left-to-right"
+ | oop |
+ oop := self methodArg: index.
+ oop = 0 ifTrue:[^0.0]. "methodArg: failed"
+ (objectMemory isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
+ ^oop!
Item was changed:
Object subclass: #InterpreterProxy
+ instanceVariableNames: 'primFailCode remapBuffer stack method argumentCount bb thisSessionID'
- instanceVariableNames: 'successFlag remapBuffer stack method argumentCount bb thisSessionID primFailCode'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
!InterpreterProxy commentStamp: '<historical>' prior: 0!
This class should provide the definition of what interpreter support plugins need and can have access to. Note that the proxy related files platforms - Cross - vm - sqVirtualMachine.[ch] are kept under the SVN tree at www.squeakvm.org .
The main use of the class is to support the vm simulator!
Item was added:
+ ----- Method: InterpreterProxy>>disownVM: (in category 'FFI support') -----
+ disownVM: flags
+ ^self notYetImplementedError!
Item was added:
+ ----- Method: InterpreterProxy>>floatArg: (in category 'stack access') -----
+ floatArg: offset
+ "Like #stackFloatValue: but access method arguments left-to-right"
+ | oop |
+ <returnTypeC: 'double'>
+ oop := self methodArg: offset.
+ (self isFloatObject: oop) ifFalse: [self primitiveFail. ^0.0].
+ ^oop!
Item was added:
+ ----- Method: InterpreterProxy>>instanceSizeOf: (in category 'object access') -----
+ instanceSizeOf: classObj
+ ^classObj instSize!
Item was added:
+ ----- Method: InterpreterProxy>>is:KindOfClass: (in category 'testing') -----
+ is: oop KindOfClass: aClass
+ "InterpreterProxy new is: 42 KindOfClass: Number"
+ ^oop isKindOf: aClass!
Item was added:
+ ----- Method: InterpreterProxy>>isYoung: (in category 'FFI support') -----
+ isYoung: anOop
+ ^self notYetImplementedError!
Item was added:
+ ----- Method: InterpreterProxy>>methodArg: (in category 'stack access') -----
+ methodArg: offset
+ "Like #stackValue: but access method arguments left-to-right"
+ offset > argumentCount + 1 ifTrue:[^self primitiveFail].
+ ^self stackValue: argumentCount - offset!
Item was added:
+ ----- Method: InterpreterProxy>>methodReturnValue: (in category 'stack access') -----
+ methodReturnValue: oop
+ "Sets the return value for a method"
+ self pop: argumentCount+1 thenPush: oop.
+ ^0!
Item was added:
+ ----- Method: InterpreterProxy>>notYetImplementedError (in category 'private') -----
+ notYetImplementedError
+ ^self error: 'not yet implemented in Smalltalk'!
Item was added:
+ ----- Method: InterpreterProxy>>objectArg: (in category 'stack access') -----
+ objectArg: offset
+ "Like #stackObjectValue: but access method arguments left-to-right"
+ | oop |
+ oop := self methodArg: offset.
+ (self isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
+ ^oop!
Item was added:
+ ----- Method: InterpreterProxy>>ownVM: (in category 'FFI support') -----
+ ownVM: flags
+ ^self notYetImplementedError!
Item was added:
+ ----- Method: InterpreterProxy>>primitiveErrorTable (in category 'special objects') -----
+ primitiveErrorTable
+ ^Smalltalk primitiveErrorTable!
Item was changed:
----- Method: InterpreterProxy>>primitiveFail (in category 'other') -----
primitiveFail
+ "Set general (unspecified) primitive failure."
+ self primitiveFailFor: 1!
- (self confirm:'A primitive is failing -- Stop simulation?') ifTrue:[self halt].
- successFlag := false.!
Item was changed:
----- Method: InterpreterProxy>>primitiveFailFor: (in category 'other') -----
primitiveFailFor: reasonCode
+ "Set specific primitive failure.
+ N.B. primitiveFailFor: PrimNoErr is expected to clear the primFailCode."
- "Set specific primitive failure."
(self confirm:'A primitive is failing -- Stop simulation?') ifTrue:[self halt].
+ ^primFailCode := reasonCode!
- primFailCode := reasonCode!
Item was added:
+ ----- Method: InterpreterProxy>>primitiveFailureCode (in category 'other') -----
+ primitiveFailureCode
+ ^primFailCode!
Item was added:
+ ----- Method: InterpreterProxy>>tenuringIncrementalGC (in category 'other') -----
+ tenuringIncrementalGC
+ Smalltalk forceTenuring; garbageCollectMost!
Item was added:
+ ----- Method: InterpreterProxy>>topRemappableOop (in category 'instance creation') -----
+ topRemappableOop
+ "Returns the top of the remappable oop. Useful when writing loops."
+ ^remapBuffer last!
Item was added:
+ ----- Method: LargeIntegersPlugin class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ ^SmartSyntaxPluginSimulator!
Item was added:
+ ----- Method: MiscPrimitivePlugin class>>monticelloDescription (in category 'translation') -----
+ monticelloDescription
+ "Override to include the primitive-supplying classes."
+ "self monticelloDescription"
+ ^super monticelloDescription, '\' withCRs,
+ ((self translatedPrimitives
+ collect: [:pair| CCodeGenerator monticelloDescriptionFor: (Smalltalk classNamed: pair first)])
+ asSet asArray sort reduce: [:a :b| a, '\' withCRs, b])!
Item was added:
+ ----- Method: ObjectMemory>>instanceSizeOf: (in category 'interpreter access') -----
+ instanceSizeOf: classObj
+ <api>
+ "Answer the number of slots in a class. For example the instanceSizeOf:
+ ClassPoint is 2, for the x & y slots. The instance size of non-pointer classes is 0."
+ | classHdr sizeHiBits byteSize |
+ self assert: (self addressCouldBeObj: classObj).
+
+ classHdr := self formatOfClass: classObj. "Low 2 bits are 0"
+
+ "Compute the size of instances of the class (used for fixed field classes only)"
+ sizeHiBits := classHdr >> 9 bitAnd: 16r300.
+ byteSize := (classHdr bitAnd: self sizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
+ ^byteSize - self baseHeaderSize / self bytesPerWord!
Item was added:
+ ----- Method: ObjectMemory>>isYoung: (in category 'interpreter access') -----
+ isYoung: oop
+ <api>
+ ^(self isNonIntegerObject: oop)
+ and: [self oop: oop isGreaterThanOrEqualTo: youngStart]!
Item was added:
+ ----- Method: ObjectMemory>>primitiveErrorTable (in category 'interpreter access') -----
+ primitiveErrorTable
+ <api>
+ ^self splObj: PrimErrTableIndex!
Item was added:
+ ----- Method: ObjectMemory>>tenuringIncrementalGC (in category 'garbage collection') -----
+ tenuringIncrementalGC
+ "Do an incremental GC that tenures all surviving young objects to old space."
+ <api>
+ forceTenureFlag := true.
+ self incrementalGC!
Item was added:
+ ----- Method: ObjectMemory>>topRemappableOop (in category 'interpreter access') -----
+ topRemappableOop
+ <api>
+ "Returns the top of the remappable oop. Useful when writing loops."
+ ^remapBuffer at: remapBufferCount!
Item was changed:
+ ----- Method: RePlugin class>>moduleName (in category 'translation') -----
- ----- Method: RePlugin class>>moduleName (in category 'plugin code generation') -----
moduleName
^'RePlugin'!
Item was changed:
----- Method: RePlugin>>loadRcvrFromStackAt: (in category 'rcvr linkage') -----
loadRcvrFromStackAt: stackInteger
+ <inline:true>
- <inline: true>
rcvr := interpreterProxy stackObjectValue: stackInteger.
!
Item was changed:
----- Method: RePlugin>>primPCREExec (in category 're primitives') -----
primPCREExec
"<rcvr primPCREExec: searchObject>, where rcvr is an object with instance variables:
'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'
Apply the regular expression (stored in <pcrePtr> and <extratr>, generated from calls to primPCRECompile), to smalltalk String searchObject using <matchOptions>. If there is no match, answer nil. Otherwise answer a ByteArray of offsets representing the results of the match."
| searchObject searchBuffer length result matchSpacePtr matchSpaceSize |
<export: true>
+ <var:#searchBuffer type: 'char *'>
+ <var:#matchSpacePtr type: 'int *'>
- <var: #searchBuffer type: 'char *'>
- <var: #matchSpacePtr type: 'int *'>
"Load Parameters"
searchObject := interpreterProxy stackObjectValue: 0.
searchBuffer := interpreterProxy arrayValueOf: searchObject.
length := interpreterProxy byteSizeOf: searchObject.
self loadRcvrFromStackAt: 1.
"Load Instance Variables"
pcrePtr := self rcvrPCREBufferPtr.
extraPtr := self rcvrExtraPtr.
matchFlags := self rcvrMatchFlags.
matchSpacePtr := self rcvrMatchSpacePtr.
matchSpaceSize := self rcvrMatchSpaceSize.
interpreterProxy failed ifTrue:[^ nil].
result := self
cCode: 'pcre_exec((pcre *)pcrePtr, (pcre_extra *)extraPtr,
searchBuffer, length, 0, matchFlags, matchSpacePtr, matchSpaceSize)'.
interpreterProxy pop: 2; pushInteger: result.
"empty call so compiler doesn't bug me about variables not used"
self touch: searchBuffer; touch: matchSpacePtr; touch: matchSpaceSize; touch: length
!
Item was changed:
----- Method: RePlugin>>primPCREExecfromto (in category 're primitives') -----
primPCREExecfromto
"<rcvr primPCREExec: searchObject> from: fromInteger to: toInteger>, where rcvr is an object with instance variables:
'patternStr compileFlags pcrePtr extraPtr errorStr errorOffset matchFlags'
Apply the regular expression (stored in <pcrePtr> and <extratr>, generated from calls to primPCRECompile), to smalltalk String searchObject using <matchOptions>, beginning at offset <fromInteger> and continuing until offset <toInteger>. If there is no match, answer nil. Otherwise answer a ByteArray of offsets representing the results of the match."
| searchObject searchBuffer length result matchSpacePtr matchSpaceSize fromInteger toInteger |
<export: true>
+ <var:#searchBuffer type: 'char *'>
+ <var:#matchSpacePtr type: 'int *'>
- <var: #searchBuffer type: 'char *'>
- <var: #matchSpacePtr type: 'int *'>
"Load Parameters"
toInteger := interpreterProxy stackIntegerValue: 0.
fromInteger := interpreterProxy stackIntegerValue: 1.
searchObject := interpreterProxy stackObjectValue: 2.
searchBuffer := interpreterProxy arrayValueOf: searchObject.
length := interpreterProxy byteSizeOf: searchObject.
self loadRcvrFromStackAt: 3.
"Validate parameters"
interpreterProxy success: (1 <= fromInteger).
interpreterProxy success: (toInteger<=length).
fromInteger := fromInteger - 1. "Smalltalk offsets are 1-based"
interpreterProxy success: (fromInteger<=toInteger).
"adjust length, searchBuffer"
length := toInteger - fromInteger.
searchBuffer := searchBuffer + fromInteger.
"Load Instance Variables"
pcrePtr := self rcvrPCREBufferPtr.
extraPtr := self rcvrExtraPtr.
matchFlags := self rcvrMatchFlags.
matchSpacePtr := self rcvrMatchSpacePtr.
matchSpaceSize := self rcvrMatchSpaceSize.
interpreterProxy failed ifTrue:[^ nil].
result := self
cCode: 'pcre_exec((pcre *)pcrePtr, (pcre_extra *)extraPtr,
searchBuffer, length, 0, matchFlags, matchSpacePtr, matchSpaceSize)'.
interpreterProxy pop: 2; pushInteger: result.
"empty call so compiler doesn't bug me about variables not used"
self touch: searchBuffer; touch: matchSpacePtr; touch: matchSpaceSize; touch: length
!
Item was changed:
----- Method: RePlugin>>rcvrCompileFlags (in category 'rcvr linkage') -----
rcvrCompileFlags
+ <inline:true>
- <inline: true>
^interpreterProxy fetchInteger: 1 ofObject: rcvr.
!
Item was changed:
----- Method: RePlugin>>rcvrExtraPtr (in category 'rcvr linkage') -----
rcvrExtraPtr
|extraObj|
<inline: true>
extraObj := interpreterProxy fetchPointer: 3 ofObject: rcvr.
- (extraObj = (interpreterProxy nilObject))
- ifTrue: [^ self cCode: ' NULL'].
^self
+ cCoerce: (extraObj = interpreterProxy nilObject
+ ifTrue: [nil]
+ ifFalse: [interpreterProxy arrayValueOf: extraObj])
+ to: 'int'!
- cCoerce:(interpreterProxy arrayValueOf: extraObj)
- to: 'int'.!
Item was changed:
----- Method: SecurityPlugin>>primitiveDisableImageWrite (in category 'primitives') -----
primitiveDisableImageWrite
<export: true>
+ self cCode: 'ioDisableImageWrite()'!
- self cCode:'ioDisableImageWrite()'.
- !
Item was added:
+ InterpreterPlugin subclass: #SmartSyntaxPluginSimulator
+ instanceVariableNames: 'actualPlugin signatureMap forMap'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SmartSyntaxPlugins'!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator class>>newFor: (in category 'simulation') -----
+ newFor: anUnsimulatedInterpreterPluginClass
+ ^self new
+ actualPlugin: anUnsimulatedInterpreterPluginClass new;
+ yourself!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator class>>shouldBeTranslated (in category 'simulation') -----
+ shouldBeTranslated
+ ^false!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>actualPlugin (in category 'accessing') -----
+ actualPlugin
+ "Answer the value of actualPlugin"
+
+ ^ actualPlugin!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>actualPlugin: (in category 'accessing') -----
+ actualPlugin: aSmartSyntaxInterpreterPlugin
+ actualPlugin := aSmartSyntaxInterpreterPlugin.
+ actualPlugin simulator: self!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asBooleanValueFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asBooleanValueFrom: anInteger
+ ^[:oop| interpreterProxy booleanValueOf: oop]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asIntegerValueFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asIntegerValueFrom: anInteger
+ ^[:oop| interpreterProxy checkedIntegerValueOf: oop]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asKindOf:from: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asKindOf: aClass from: argIndexOrNil
+ ^[:oop|
+ interpreterProxy success: (interpreterProxy is: oop KindOf: aClass name asString).
+ oop]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asRawOopFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asRawOopFrom: anUndefinedObject
+ ^[:oop| oop]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>computeSignatureFor:from: (in category 'initialize') -----
+ computeSignatureFor: selector from: tuple
+ | signature |
+ self assert: tuple first == #forMap.
+ signature := tuple third collect:
+ [:className|
+ (Smalltalk classNamed: className)
+ ifNil: [self error: 'Argument class' , className, ' does not exist']
+ ifNotNil:
+ [:argClass|
+ argClass
+ ccg: self
+ prolog: true
+ expr: [interpreterProxy primitiveFail]
+ index: nil]].
+ ^signatureMap
+ at: tuple second asSymbol
+ put: { selector.
+ signature.
+ tuple fourth
+ ifNil: [[:oop| oop]]
+ ifNotNil:
+ [:rcvrClassSymbol|
+ (Smalltalk classNamed: rcvrClassSymbol)
+ ifNil: [self error: 'Receiver class' , rcvrClassSymbol, ' does not exist']
+ ifNotNil:
+ [:rcvrClass|
+ rcvrClass
+ ccg: self
+ prolog: false
+ expr: [interpreterProxy primitiveFail]
+ index: nil]] }!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>computeSignatureMap (in category 'initialize') -----
+ computeSignatureMap
+ forMap := true. "true only while we compute the signatureMap"
+ signatureMap := Dictionary new.
+ actualPlugin class selectorsAndMethodsDo:
+ [:s :m|
+ (m messages includesAnyOf: #(primitive:parameters: primitive:parameters:receiver:))
+ ifTrue: [self getPrimitiveSignatureFor: s]
+ ifFalse:
+ [(m pragmaAt: #export:) ifNotNil:
+ [:exportPragma|
+ (exportPragma argumentAt: 1) ifTrue:
+ [self computeSignatureFor: s from: { #forMap. s. #(). nil }]]]].
+ forMap := false!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>doesNotUnderstand: (in category 'message forwarding') -----
+ doesNotUnderstand: aMessage
+ | signature selector parameters result |
+ signature := signatureMap
+ at: aMessage selector
+ ifAbsent: [^super doesNotUnderstand: aMessage].
+ selector := signature first.
+ parameters := signature second.
+ signature third "receiver block" value: (interpreterProxy stackValue: parameters size).
+ interpreterProxy failed ifTrue:
+ [^nil].
+ result := [actualPlugin
+ perform: selector
+ withArguments: (parameters withIndexCollect:
+ [:block :index|
+ block value: (interpreterProxy stackValue: parameters size - index)])]
+ on: Notification
+ do: [:ex|
+ ex tag == #getSimulator
+ ifTrue: [ex resume: self]
+ ifFalse: [ex pass]].
+ interpreterProxy failed ifTrue:
+ [^nil].
+ interpreterProxy
+ pop: interpreterProxy methodArgumentCount + 1
+ thenPush: result.
+ ^nil "SmartSyntaxPluginPrimitives return null"!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>generateCoerceToSmallIntegerObjectFrom:on: (in category 'simulation') -----
+ generateCoerceToSmallIntegerObjectFrom: aSmallInteger on: ignored
+ ^interpreterProxy integerObjectOf: aSmallInteger!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>getPrimitiveSignatureFor: (in category 'initialize') -----
+ getPrimitiveSignatureFor: s
+ "Execute the primitive until the send of #primitive:parameters: or primitive:parameters:receiver:,
+ collect the processed signature and store it in the map"
+ [actualPlugin perform: s withArguments: (1 to: s numArgs) asArray]
+ on: Notification
+ do: [:ex|
+ (ex tag isArray
+ and: [ex tag first == #forMap]) ifTrue:
+ [^self computeSignatureFor: s from: ex tag]].
+ self error: 'can''t find primitive name in ', s!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>initialiseModule (in category 'initialize') -----
+ initialiseModule
+ ^(actualPlugin respondsTo: #initialiseModule) not
+ or: [actualPlugin initialiseModule]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>primitive:parameters: (in category 'simulation') -----
+ primitive: primNameString parameters: argumentClassNames
+ "If initializing, pass back the type signature. If executing, answer nil."
+ ^self primitive: primNameString parameters: argumentClassNames receiver: nil!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>primitive:parameters:receiver: (in category 'simulation') -----
+ primitive: primNameString parameters: argumentClassNames receiver: rcvrClassSymbolOrNil
+ "If initializing, pass back the type signature. If executing, answer the receiver or nil."
+ forMap
+ ifTrue:
+ [Notification new
+ tag: {#forMap. primNameString. argumentClassNames. rcvrClassSymbolOrNil};
+ signal]
+ ifFalse:
+ [^rcvrClassSymbolOrNil ifNotNil:
+ [interpreterProxy stackValue: interpreterProxy methodArgumentCount]]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>respondsTo: (in category 'message forwarding') -----
+ respondsTo: aSelector
+ ^(signatureMap notNil and: [signatureMap includesKey: aSelector])
+ or: [super respondsTo: aSelector]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>setInterpreter: (in category 'initialize') -----
+ setInterpreter: anInterpreterProxy
+ interpreterProxy := anInterpreterProxy.
+ actualPlugin setInterpreter: anInterpreterProxy.
+ self computeSignatureMap!
Item was changed:
----- Method: SocketPlugin>>primitiveHasSocketAccess (in category 'security primitives') -----
primitiveHasSocketAccess
+ | hasAccess |
- | hasAccess |
<export: true>
"If the security plugin can be loaded, use it to check .
+ If not, assume it's ok"
+ hasAccess := sHSAfn = 0
+ or: [self cCode: ' ((int (*) (void)) sHSAfn)()' inSmalltalk:[true]].
- If not, assume it's ok"
- sHSAfn ~= 0
- ifTrue: [hasAccess := self cCode: ' ((int (*) (void)) sHSAfn)()' inSmalltalk:[true]]
- ifFalse: [hasAccess := true].
interpreterProxy pop: 1.
interpreterProxy pushBool: hasAccess!
Item was changed:
----- Method: SocketPlugin>>socketValueOf: (in category 'primitives') -----
socketValueOf: socketOop
"Return a pointer to the first byte of of the socket record within the
+ given Smalltalk object, or nil if socketOop is not a socket record."
+ <returnTypeC: 'SocketPtr'>
- given Smalltalk object, or nil if socketOop is not a socket record."
- | socketIndex |
- <returnTypeC: 'SQSocket *'>
- <var: #socketIndex type: 'void *'>
interpreterProxy success: ((interpreterProxy isBytes: socketOop)
and: [(interpreterProxy byteSizeOf: socketOop)
= self socketRecordSize]).
+ ^interpreterProxy failed
+ ifTrue: [nil]
+ ifFalse: [self cCoerce: (interpreterProxy firstIndexableField: socketOop) to: 'SocketPtr']!
- interpreterProxy failed
- ifTrue: [^ nil]
- ifFalse: [socketIndex := self cCoerce: (interpreterProxy firstIndexableField: socketOop) to: 'void *'.
- ^ self cCode: '(SQSocket *) socketIndex']!
Item was changed:
+ ----- Method: SoundCodecPlugin class>>moduleName (in category 'translation') -----
- ----- Method: SoundCodecPlugin class>>moduleName (in category 'accessing') -----
moduleName
^ 'SoundCodecPrims' "Needs to be the name used for module specification..."
!
Item was added:
+ ----- Method: SoundGenerationPlugin class>>monticelloDescription (in category 'translation') -----
+ monticelloDescription
+ "Override to include the AbstractSound class."
+ "self monticelloDescription"
+ ^super monticelloDescription, '\' withCRs, (CCodeGenerator monticelloDescriptionFor: AbstractSound)!
Item was changed:
----- Method: SoundPlugin>>primitiveSoundGetVolume (in category 'primitives') -----
primitiveSoundGetVolume
"Set the sound input recording level."
+ | left right results |
+ <var: #left type: #double>
+ <var: #right type: #double>
- | left right results |
self primitive: 'primitiveSoundGetVolume'
parameters: #( ).
- self var: #left type: 'double '.
- self var: #right type: 'double '.
left := 0.
right := 0.
self cCode: 'snd_Volume((double *) &left,(double *) &right)'.
interpreterProxy pushRemappableOop: (right asOop: Float).
interpreterProxy pushRemappableOop: (left asOop: Float).
interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2).
results := interpreterProxy popRemappableOop.
interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
^ results!
Item was changed:
----- Method: SoundPlugin>>primitiveSoundRecordSamplesInto:startingAt: (in category 'primitives') -----
primitiveSoundRecordSamplesInto: buf startingAt: startWordIndex
"Record a buffer's worth of 16-bit sound samples."
| bufSizeInBytes samplesRecorded bufPtr byteOffset bufLen |
+ <var: #bufPtr type: #'char*'>
- self var: #bufPtr type: 'char*'.
self primitive: 'primitiveSoundRecordSamples'
parameters: #(WordArray SmallInteger ).
interpreterProxy failed ifFalse:
[bufSizeInBytes := (interpreterProxy slotSizeOf: buf cPtrAsOop) * 4.
interpreterProxy success: (startWordIndex >= 1 and: [startWordIndex - 1 * 2 < bufSizeInBytes])].
interpreterProxy failed ifFalse:[
byteOffset := (startWordIndex - 1) * 2.
bufPtr := (self cCoerce: buf to: 'char*') + byteOffset.
bufLen := bufSizeInBytes - byteOffset.
samplesRecorded := self cCode: 'snd_RecordSamplesIntoAtLength(bufPtr, 0, bufLen)' inSmalltalk:[bufPtr. bufLen. 0].
].
^ samplesRecorded asPositiveIntegerObj!
Item was removed:
- ----- Method: StackInterpreter>>floatArg: (in category 'plugin primitive support') -----
- floatArg: index
- "Like #stackFloatValue: but access method arguments left-to-right"
- | result oop |
- <returnTypeC: #double>
- <var: #result type: #double>
- oop := self methodArg: index.
- oop = 0 ifTrue:[^0.0]. "methodArg: failed"
- "N.B. Because Slang always inlines assertClassOf:is:compactClassIndex:
- (because assertClassOf:is:compactClassIndex: has an inline: pragma) the
- phrase (self splObj: ClassArray) is expanded in-place and is _not_
- evaluated if ClassArrayCompactIndex is non-zero."
- self assertClassOf: oop is: (objectMemory splObj: ClassFloat)
- compactClassIndex: ClassFloatCompactIndex.
- self successful ifTrue:
- [self cCode: '' inSmalltalk: [result := Float new: 2].
- objectMemory fetchFloatAt: oop + self baseHeaderSize into: result.
- ^result].
- ^0.0!
Item was removed:
- ----- Method: StackInterpreter>>integerArg: (in category 'plugin primitive support') -----
- integerArg: index
- "Like #stackIntegerValue: but access method arguments left-to-right"
- | oop |
- oop := self methodArg: index.
- oop = 0 ifTrue:[^0.0]. "methodArg: failed"
- ^self checkedIntegerValueOf: oop!
Item was removed:
- ----- Method: StackInterpreter>>methodArg: (in category 'plugin primitive support') -----
- methodArg: index
- "Like #stackValue: but access method arguments left-to-right"
- index > argumentCount + 1 ifTrue:[
- self cCode: 'fprintf(stderr,"[VM]: Attempt to access method args beyond range\n")'.
- self printCallStack.
- self primitiveFail.
- ^0].
- ^self stackValue: argumentCount - index!
Item was removed:
- ----- Method: StackInterpreter>>methodReturnValue: (in category 'plugin primitive support') -----
- methodReturnValue: oop
- "Sets the return value for a method. In the CoInterpreter we replace the cumbersome
- primResult machinery."
- self pop: argumentCount+1 thenPush: oop.
- ^0!
Item was removed:
- ----- Method: StackInterpreter>>objectArg: (in category 'plugin primitive support') -----
- objectArg: index
- "Like #stackObjectValue: but access method arguments left-to-right"
- | oop |
- oop := self methodArg: index.
- oop = 0 ifTrue:[^0.0]. "methodArg: failed"
- (objectMemory isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
- ^oop!
Item was added:
+ ----- Method: UUIDPlugin class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ ^SmartSyntaxPluginSimulator!
Item was changed:
----- Method: UUIDPlugin>>primitiveMakeUUID (in category 'system primitives') -----
primitiveMakeUUID
| oop location |
<export: true>
<var: #location type: 'char*'>
- interpreterProxy methodArgumentCount = 0
- ifFalse:[^interpreterProxy primitiveFail].
oop := interpreterProxy stackObjectValue: 0.
+ (interpreterProxy failed
+ or: [interpreterProxy methodArgumentCount ~= 0
+ or: [(interpreterProxy isBytes: oop) not
+ or: [(interpreterProxy byteSizeOf: oop) ~= 16]]]) ifTrue:
+ [^interpreterProxy primitiveFail].
- interpreterProxy failed ifTrue:[^nil].
- (interpreterProxy isBytes: oop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy byteSizeOf: oop) = 16
- ifFalse:[^interpreterProxy primitiveFail].
location := interpreterProxy firstIndexableField: oop.
+ self cCode: [self MakeUUID: location]
+ inSmalltalk:
+ [| uuid |
+ uuid := UUID new.
+ 1 to: 16 do:
+ [:i| location at: i - 1 put: (uuid at: i)]].
+ ^oop!
-
- ^self cCode: 'MakeUUID(location)'
- inSmalltalk: [location. interpreterProxy primitiveFail].
- !
Item was changed:
----- Method: VMMaker class>>versionString (in category 'version testing') -----
versionString
"VMMaker versionString"
+ ^'4.12.1'!
- ^'4.11.5'!
1
0
Hello,
I've been working on getting the simulator to work from VMMaker.
Now, I can load my 6505 formatted image inside the simulator and it looks
okay (from what I can inspect).
Then, I am now running the test of the sim:
test
transcript clear.
byteCount := 0.
quitBlock := [^ self].
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self dispatchOn: currentBytecode in: BytecodeTable.
byteCount := byteCount + 1.
byteCount \\ 10000 = 0 ifTrue: [self fullDisplay]].
self externalizeIPandSP.
and I hit an issue:
MNU: isInstanceOfClassFloat: oop.
InterpreterSimulatorLSB(Interpreter)>>floatValueOf:
InterpreterSimulatorLSB(Interpreter)>>loadFloatOrIntFrom:
InterpreterSimulatorLSB(Interpreter)>>primitiveFloatEqual:toArg:
InterpreterSimulatorLSB(Interpreter)>>bytecodePrimEqual
InterpreterSimulatorLSB(InterpreterSimulator)>>dispatchOn:in:
InterpreterSimulatorLSB(InterpreterSimulator)>>test
UndefinedObject>>DoIt
This happens here:
floatValueOf: oop
"Answer the C double precision floating point value of the argument,
or fail if it is not a Float, and answer 0.
Note: May be called by translated primitive code."
| isFloat result |
<returnTypeC: #double>
<var: #result type: #double>
isFloat := self isInstanceOfClassFloat: oop.
isFloat ifTrue:
[self cCode: '' inSmalltalk: [result := Float new: 2].
self fetchFloatAt: oop + BaseHeaderSize into: result.
^result].
self primitiveFail.
^0.0
There is such a method in IntepreterPrimitives, but not in the Interpreter
itself nor parents.
InterpreterPrimitives>>isInstanceOfClassFloat: oop
<inline: true>
"N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
(because is:instanceOf:compactClassIndex: has an inline: pragma) the
phrase (objectMemory splObj: ClassFloat) is expanded in-place and is
_not_ evaluated if oop has a non-zero CompactClassIndex."
^objectMemory
is: oop
instanceOf: (objectMemory splObj: ClassFloat)
compactClassIndex: ClassFloatCompactIndex
Clues?
Phil
7
18
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.285.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.285
Author: eem
Time: 12 April 2013, 3:14:22.998 pm
UUID: cb7737d2-7959-4494-ba87-9be6e6f1226b
Ancestors: VMMaker.oscog-eem.284
Eliminate some excessive use of push/popRemappableOop[:]
in the SocketPlugin. Use addressOf: instead of cCode:.
=============== Diff against VMMaker.oscog-eem.284 ===============
Item was changed:
----- Method: SocketPlugin>>primitiveSocket:getOptions: (in category 'primitives') -----
primitiveSocket: socket getOptions: optionName
| s optionNameStart optionNameSize returnedValue errorCode results |
+ <var: #s type: #SocketPtr>
+ <var: #optionNameStart type: #'char *'>
- <var: #s type: 'SocketPtr'>
- <var: #optionNameStart type: 'char *'>
self primitive: 'primitiveSocketGetOptions'
parameters: #(Oop Oop).
s := self socketValueOf: socket.
interpreterProxy success: (interpreterProxy isBytes: optionName).
+ optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: #'char *'.
- optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'.
optionNameSize := interpreterProxy slotSizeOf: optionName.
interpreterProxy failed ifTrue: [^nil].
returnedValue := 0.
errorCode := self sqSocketGetOptions: s
+ optionNameStart: optionNameStart
+ optionNameSize: optionNameSize
+ returnedValue: (self addressOf: returnedValue).
- optionNameStart: optionNameStart
- optionNameSize: optionNameSize
- returnedValue: (self cCode: '&returnedValue').
+ results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
+ interpreterProxy storePointer: 0 ofObject: results withValue: errorCode asSmallIntegerObj.
+ interpreterProxy storePointer: 1 ofObject: results withValue: returnedValue asSmallIntegerObj.
- interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj.
- interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj.
- interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2).
- results := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
- interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
^ results!
Item was changed:
----- Method: SocketPlugin>>primitiveSocket:receiveUDPDataBuf:start:count: (in category 'primitives') -----
primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count
+ | s elementSize arrayBase bufStart bytesReceived results address port moreFlag |
+ <var: #s type: #SocketPtr>
+ <var: #arrayBase type: #'char *'>
+ <var: #bufStart type: #'char *'>
- | s byteSize arrayBase bufStart bytesReceived results address port moreFlag |
- <var: #s type: 'SocketPtr'>
- <var: #arrayBase type: 'char *'>
- <var: #bufStart type: 'char *'>
self primitive: 'primitiveSocketReceiveUDPDataBufCount'
+ parameters: #(Oop Oop SmallInteger SmallInteger).
- parameters: #(Oop Oop SmallInteger SmallInteger ).
s := self socketValueOf: socket.
"buffer can be any indexable words or bytes object"
interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
(interpreterProxy isWords: array)
+ ifTrue: [elementSize := 4]
+ ifFalse: [elementSize := 1].
- ifTrue: [byteSize := 4]
- ifFalse: [byteSize := 1].
interpreterProxy success: (startIndex >= 1
and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
interpreterProxy failed
ifFalse: ["Note: adjust bufStart for zero-origin indexing"
+ arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *'.
+ bufStart := arrayBase + (startIndex - 1 * elementSize).
+ address := 0.
+ port := 0.
+ moreFlag := 0.
+ bytesReceived := self sqSocket: s
+ ReceiveUDPDataBuf: bufStart
+ Count: count * elementSize
+ address: (self addressOf: address)
+ port: (self addressOf: port)
+ moreFlag: (self addressOf: moreFlag).
+
- arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
- bufStart := arrayBase + (startIndex - 1 * byteSize).
"allocate storage for results, remapping newly allocated
oops in case GC happens during allocation"
- address := 0.
- port := 0.
- moreFlag := 0.
- bytesReceived := self
- sqSocket: s
- ReceiveUDPDataBuf: bufStart
- Count: count * byteSize
- address: (self cCode: '&address')
- port: (self cCode: '&port')
- moreFlag: (self cCode: '&moreFlag').
-
- interpreterProxy pushRemappableOop: port asSmallIntegerObj.
interpreterProxy pushRemappableOop: (self intToNetAddress: address).
+ results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 4.
+ interpreterProxy storePointer: 0 ofObject: results withValue: (bytesReceived // elementSize) asSmallIntegerObj.
- interpreterProxy pushRemappableOop: (bytesReceived // byteSize) asSmallIntegerObj.
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 4).
- results := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
+ interpreterProxy storePointer: 2 ofObject: results withValue: port asSmallIntegerObj.
+ interpreterProxy storePointer: 3 ofObject: results withValue: (moreFlag
+ ifTrue: [interpreterProxy trueObject]
+ ifFalse: [interpreterProxy falseObject]).
- interpreterProxy storePointer: 2 ofObject: results withValue: interpreterProxy popRemappableOop.
- moreFlag
- ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
- ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
].
^ results!
Item was changed:
----- Method: SocketPlugin>>primitiveSocket:setOptions:value: (in category 'primitives') -----
primitiveSocket: socket setOptions: optionName value: optionValue
+ "THIS BADLY NEEDS TO BE REWRITTEN TO TAKE Booleans AND Integers AS WELL AS (OR INSTEAD OF) Strings.
+ It is only used with booleans and integers and parsing these back out of strings in
+ sqSocketSetOptions:optionNameStart:optionNameSize:optionValueStart:optionValueSize:returnedValue:
+ is STUPID."
-
| s optionNameStart optionNameSize optionValueStart optionValueSize returnedValue errorCode results |
+ <var: #s type: #SocketPtr>
+ <var: #optionNameStart type: #'char *'>
+ <var: #optionValueStart type: #'char *'>
- <var: #s type: 'SocketPtr'>
- <var: #optionNameStart type: 'char *'>
- <var: #optionValueStart type: 'char *'>
self primitive: 'primitiveSocketSetOptions'
parameters: #(Oop Oop Oop).
s := self socketValueOf: socket.
interpreterProxy success: (interpreterProxy isBytes: optionName).
+ optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: #'char *'.
- optionNameStart := self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'.
optionNameSize := interpreterProxy slotSizeOf: optionName.
interpreterProxy success: (interpreterProxy isBytes: optionValue).
+ optionValueStart:= self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: #'char *'.
- optionValueStart:= self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: 'char *'.
optionValueSize := interpreterProxy slotSizeOf: optionValue.
interpreterProxy failed ifTrue: [^nil].
returnedValue := 0.
errorCode := self sqSocketSetOptions: s
+ optionNameStart: optionNameStart
+ optionNameSize: optionNameSize
+ optionValueStart: optionValueStart
+ optionValueSize: optionValueSize
+ returnedValue: (self addressOf: returnedValue).
- optionNameStart: optionNameStart
- optionNameSize: optionNameSize
- optionValueStart: optionValueStart
- optionValueSize: optionValueSize
- returnedValue: (self cCode: '&returnedValue').
+ results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
+ interpreterProxy storePointer: 0 ofObject: results withValue: errorCode asSmallIntegerObj.
+ interpreterProxy storePointer: 1 ofObject: results withValue: returnedValue asSmallIntegerObj.
- interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj.
- interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj.
- interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2).
- results := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
- interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
^ results!
1
0
13 Apr '13
Revision: 2720
Author: eliot
Date: 2013-04-12 15:16:14 -0700 (Fri, 12 Apr 2013)
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.285.
Eliminate some excessive use of push/popRemappableOop[:] in the SocketPlugin.
Modified Paths:
--------------
branches/Cog/nscogsrc/plugins/SocketPlugin/SocketPlugin.c
branches/Cog/src/plugins/SocketPlugin/SocketPlugin.c
Property Changed:
----------------
branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
Modified: branches/Cog/nscogsrc/plugins/SocketPlugin/SocketPlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/SocketPlugin/SocketPlugin.c 2013-04-12 19:00:52 UTC (rev 2719)
+++ branches/Cog/nscogsrc/plugins/SocketPlugin/SocketPlugin.c 2013-04-12 22:16:14 UTC (rev 2720)
@@ -1,9 +1,9 @@
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.235 uuid: 954df856-3f83-498c-9735-6cd3777ba9c7
+ SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.285 uuid: cb7737d2-7959-4494-ba87-9be6e6f1226b
from
- SocketPlugin VMMaker.oscog-eem.235 uuid: 954df856-3f83-498c-9735-6cd3777ba9c7
+ SocketPlugin VMMaker.oscog-eem.285 uuid: cb7737d2-7959-4494-ba87-9be6e6f1226b
*/
-static char __buildInfo[] = "SocketPlugin VMMaker.oscog-eem.235 uuid: 954df856-3f83-498c-9735-6cd3777ba9c7 " __DATE__ ;
+static char __buildInfo[] = "SocketPlugin VMMaker.oscog-eem.285 uuid: cb7737d2-7959-4494-ba87-9be6e6f1226b " __DATE__ ;
@@ -181,9 +181,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "SocketPlugin VMMaker.oscog-eem.235 (i)"
+ "SocketPlugin VMMaker.oscog-eem.285 (i)"
#else
- "SocketPlugin VMMaker.oscog-eem.235 (e)"
+ "SocketPlugin VMMaker.oscog-eem.285 (e)"
#endif
;
static void * sCCLOPfn;
@@ -1388,13 +1388,10 @@
return null;
}
returnedValue = 0;
- errorCode = sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(s, optionNameStart, optionNameSize, &returnedValue);
- pushRemappableOop(integerObjectOf(returnedValue));
- pushRemappableOop(integerObjectOf(errorCode));
- pushRemappableOop(instantiateClassindexableSize(classArray(), 2));
- results = popRemappableOop();
- storePointerofObjectwithValue(0, results, popRemappableOop());
- storePointerofObjectwithValue(1, results, popRemappableOop());
+ errorCode = sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(s, optionNameStart, optionNameSize, (&returnedValue));
+ results = instantiateClassindexableSize(classArray(), 2);
+ storePointerofObjectwithValue(0, results, integerObjectOf(errorCode));
+ storePointerofObjectwithValue(1, results, integerObjectOf(returnedValue));
if (failed()) {
return null;
}
@@ -1787,9 +1784,9 @@
sqInt array;
char *arrayBase;
char *bufStart;
- sqInt byteSize;
sqInt bytesReceived;
sqInt count;
+ sqInt elementSize;
sqInt moreFlag;
sqInt port;
sqInt results;
@@ -1812,10 +1809,10 @@
: ((SocketPtr) (firstIndexableField(socket))));
success(isWordsOrBytes(array));
if (isWords(array)) {
- byteSize = 4;
+ elementSize = 4;
}
else {
- byteSize = 1;
+ elementSize = 1;
}
success((startIndex >= 1)
&& ((count >= 0)
@@ -1825,29 +1822,23 @@
/* Note: adjust bufStart for zero-origin indexing */
arrayBase = ((char *) (firstIndexableField(array)));
+ bufStart = arrayBase + ((startIndex - 1) * elementSize);
+ address = 0;
+ port = 0;
+ moreFlag = 0;
/* allocate storage for results, remapping newly allocated
oops in case GC happens during allocation */
- bufStart = arrayBase + ((startIndex - 1) * byteSize);
- address = 0;
- port = 0;
- moreFlag = 0;
- bytesReceived = sqSocketReceiveUDPDataBufCountaddressportmoreFlag(s, bufStart, count * byteSize, &address, &port, &moreFlag);
- pushRemappableOop(integerObjectOf(port));
+ bytesReceived = sqSocketReceiveUDPDataBufCountaddressportmoreFlag(s, bufStart, count * elementSize, (&address), (&port), (&moreFlag));
pushRemappableOop(intToNetAddress(address));
- pushRemappableOop(integerObjectOf((bytesReceived / byteSize)));
- pushRemappableOop(instantiateClassindexableSize(classArray(), 4));
- results = popRemappableOop();
- storePointerofObjectwithValue(0, results, popRemappableOop());
+ results = instantiateClassindexableSize(classArray(), 4);
+ storePointerofObjectwithValue(0, results, integerObjectOf((bytesReceived / elementSize)));
storePointerofObjectwithValue(1, results, popRemappableOop());
- storePointerofObjectwithValue(2, results, popRemappableOop());
- if (moreFlag) {
- storePointerofObjectwithValue(3, results, trueObject());
- }
- else {
- storePointerofObjectwithValue(3, results, falseObject());
- }
+ storePointerofObjectwithValue(2, results, integerObjectOf(port));
+ storePointerofObjectwithValue(3, results, (moreFlag
+ ? trueObject()
+ : falseObject()));
}
if (failed()) {
return null;
@@ -2123,6 +2114,15 @@
return null;
}
+
+/* THIS BADLY NEEDS TO BE REWRITTEN TO TAKE Booleans AND Integers AS WELL AS
+ (OR INSTEAD OF) Strings.
+ It is only used with booleans and integers and parsing these back out of
+ strings in
+
+ sqSocketSetOptions:optionNameStart:optionNameSize:optionValueStart:optionValueSize:returnedValue:
+ is STUPID. */
+
EXPORT(sqInt)
primitiveSocketSetOptions(void)
{
@@ -2160,13 +2160,10 @@
return null;
}
returnedValue = 0;
- errorCode = sqSocketSetOptionsoptionNameStartoptionNameSizeoptionValueStartoptionValueSizereturnedValue(s, optionNameStart, optionNameSize, optionValueStart, optionValueSize, &returnedValue);
- pushRemappableOop(integerObjectOf(returnedValue));
- pushRemappableOop(integerObjectOf(errorCode));
- pushRemappableOop(instantiateClassindexableSize(classArray(), 2));
- results = popRemappableOop();
- storePointerofObjectwithValue(0, results, popRemappableOop());
- storePointerofObjectwithValue(1, results, popRemappableOop());
+ errorCode = sqSocketSetOptionsoptionNameStartoptionNameSizeoptionValueStartoptionValueSizereturnedValue(s, optionNameStart, optionNameSize, optionValueStart, optionValueSize, (&returnedValue));
+ results = instantiateClassindexableSize(classArray(), 2);
+ storePointerofObjectwithValue(0, results, integerObjectOf(errorCode));
+ storePointerofObjectwithValue(1, results, integerObjectOf(returnedValue));
if (failed()) {
return null;
}
Property changes on: branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
___________________________________________________________________
Modified: checkindate
- Fri Apr 12 11:56:58 PDT 2013
+ Fri Apr 12 15:15:32 PDT 2013
Modified: branches/Cog/src/plugins/SocketPlugin/SocketPlugin.c
===================================================================
--- branches/Cog/src/plugins/SocketPlugin/SocketPlugin.c 2013-04-12 19:00:52 UTC (rev 2719)
+++ branches/Cog/src/plugins/SocketPlugin/SocketPlugin.c 2013-04-12 22:16:14 UTC (rev 2720)
@@ -1,9 +1,9 @@
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.235 uuid: 954df856-3f83-498c-9735-6cd3777ba9c7
+ SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.285 uuid: cb7737d2-7959-4494-ba87-9be6e6f1226b
from
- SocketPlugin VMMaker.oscog-eem.235 uuid: 954df856-3f83-498c-9735-6cd3777ba9c7
+ SocketPlugin VMMaker.oscog-eem.285 uuid: cb7737d2-7959-4494-ba87-9be6e6f1226b
*/
-static char __buildInfo[] = "SocketPlugin VMMaker.oscog-eem.235 uuid: 954df856-3f83-498c-9735-6cd3777ba9c7 " __DATE__ ;
+static char __buildInfo[] = "SocketPlugin VMMaker.oscog-eem.285 uuid: cb7737d2-7959-4494-ba87-9be6e6f1226b " __DATE__ ;
@@ -181,9 +181,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "SocketPlugin VMMaker.oscog-eem.235 (i)"
+ "SocketPlugin VMMaker.oscog-eem.285 (i)"
#else
- "SocketPlugin VMMaker.oscog-eem.235 (e)"
+ "SocketPlugin VMMaker.oscog-eem.285 (e)"
#endif
;
static void * sCCLOPfn;
@@ -1388,13 +1388,10 @@
return null;
}
returnedValue = 0;
- errorCode = sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(s, optionNameStart, optionNameSize, &returnedValue);
- pushRemappableOop(integerObjectOf(returnedValue));
- pushRemappableOop(integerObjectOf(errorCode));
- pushRemappableOop(instantiateClassindexableSize(classArray(), 2));
- results = popRemappableOop();
- storePointerofObjectwithValue(0, results, popRemappableOop());
- storePointerofObjectwithValue(1, results, popRemappableOop());
+ errorCode = sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(s, optionNameStart, optionNameSize, (&returnedValue));
+ results = instantiateClassindexableSize(classArray(), 2);
+ storePointerofObjectwithValue(0, results, integerObjectOf(errorCode));
+ storePointerofObjectwithValue(1, results, integerObjectOf(returnedValue));
if (failed()) {
return null;
}
@@ -1787,9 +1784,9 @@
sqInt array;
char *arrayBase;
char *bufStart;
- sqInt byteSize;
sqInt bytesReceived;
sqInt count;
+ sqInt elementSize;
sqInt moreFlag;
sqInt port;
sqInt results;
@@ -1812,10 +1809,10 @@
: ((SocketPtr) (firstIndexableField(socket))));
success(isWordsOrBytes(array));
if (isWords(array)) {
- byteSize = 4;
+ elementSize = 4;
}
else {
- byteSize = 1;
+ elementSize = 1;
}
success((startIndex >= 1)
&& ((count >= 0)
@@ -1825,29 +1822,23 @@
/* Note: adjust bufStart for zero-origin indexing */
arrayBase = ((char *) (firstIndexableField(array)));
+ bufStart = arrayBase + ((startIndex - 1) * elementSize);
+ address = 0;
+ port = 0;
+ moreFlag = 0;
/* allocate storage for results, remapping newly allocated
oops in case GC happens during allocation */
- bufStart = arrayBase + ((startIndex - 1) * byteSize);
- address = 0;
- port = 0;
- moreFlag = 0;
- bytesReceived = sqSocketReceiveUDPDataBufCountaddressportmoreFlag(s, bufStart, count * byteSize, &address, &port, &moreFlag);
- pushRemappableOop(integerObjectOf(port));
+ bytesReceived = sqSocketReceiveUDPDataBufCountaddressportmoreFlag(s, bufStart, count * elementSize, (&address), (&port), (&moreFlag));
pushRemappableOop(intToNetAddress(address));
- pushRemappableOop(integerObjectOf((bytesReceived / byteSize)));
- pushRemappableOop(instantiateClassindexableSize(classArray(), 4));
- results = popRemappableOop();
- storePointerofObjectwithValue(0, results, popRemappableOop());
+ results = instantiateClassindexableSize(classArray(), 4);
+ storePointerofObjectwithValue(0, results, integerObjectOf((bytesReceived / elementSize)));
storePointerofObjectwithValue(1, results, popRemappableOop());
- storePointerofObjectwithValue(2, results, popRemappableOop());
- if (moreFlag) {
- storePointerofObjectwithValue(3, results, trueObject());
- }
- else {
- storePointerofObjectwithValue(3, results, falseObject());
- }
+ storePointerofObjectwithValue(2, results, integerObjectOf(port));
+ storePointerofObjectwithValue(3, results, (moreFlag
+ ? trueObject()
+ : falseObject()));
}
if (failed()) {
return null;
@@ -2123,6 +2114,15 @@
return null;
}
+
+/* THIS BADLY NEEDS TO BE REWRITTEN TO TAKE Booleans AND Integers AS WELL AS
+ (OR INSTEAD OF) Strings.
+ It is only used with booleans and integers and parsing these back out of
+ strings in
+
+ sqSocketSetOptions:optionNameStart:optionNameSize:optionValueStart:optionValueSize:returnedValue:
+ is STUPID. */
+
EXPORT(sqInt)
primitiveSocketSetOptions(void)
{
@@ -2160,13 +2160,10 @@
return null;
}
returnedValue = 0;
- errorCode = sqSocketSetOptionsoptionNameStartoptionNameSizeoptionValueStartoptionValueSizereturnedValue(s, optionNameStart, optionNameSize, optionValueStart, optionValueSize, &returnedValue);
- pushRemappableOop(integerObjectOf(returnedValue));
- pushRemappableOop(integerObjectOf(errorCode));
- pushRemappableOop(instantiateClassindexableSize(classArray(), 2));
- results = popRemappableOop();
- storePointerofObjectwithValue(0, results, popRemappableOop());
- storePointerofObjectwithValue(1, results, popRemappableOop());
+ errorCode = sqSocketSetOptionsoptionNameStartoptionNameSizeoptionValueStartoptionValueSizereturnedValue(s, optionNameStart, optionNameSize, optionValueStart, optionValueSize, (&returnedValue));
+ results = instantiateClassindexableSize(classArray(), 2);
+ storePointerofObjectwithValue(0, results, integerObjectOf(errorCode));
+ storePointerofObjectwithValue(1, results, integerObjectOf(returnedValue));
if (failed()) {
return null;
}
1
0
Hi,
the build scripts generate results/vm-display-null, results/vm-display-X11
etc. Would it be possible to add the *.so extension to all of these in the
build script? That would help the debian/ubuntu packaging which is looking
for extensions.
--
Damien Cassou
http://damiencassou.seasidehosting.st
"Success is the ability to go from one failure to another without losing
enthusiasm."
Winston Churchill
2
5
[commit][2719] Fix numberic option parsing in sqSocketSetOptions...
by commits＠squeakvm.org 12 Apr '13
by commits＠squeakvm.org 12 Apr '13
12 Apr '13
Revision: 2719
Author: eliot
Date: 2013-04-12 12:00:52 -0700 (Fri, 12 Apr 2013)
Log Message:
-----------
Fix numberic option parsing in sqSocketSetOptions... (quite possibly the longest
C function name I've ever seen). The old code only supported 1-digit length
values, so setsockopt(SO_SNDBUF, 4096 didn't do what was expected at all
(attempted to set the buffer size to 909717556, which is little-endian ascii
for '4096', '4096' asByteArray unsignedLongAt: 1 => 909717556).
Modified Paths:
--------------
branches/Cog/platforms/unix/plugins/SocketPlugin/sqUnixSocket.c
Property Changed:
----------------
branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
Property changes on: branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
___________________________________________________________________
Modified: checkindate
- Thu Apr 11 16:36:31 PDT 2013
+ Fri Apr 12 11:56:58 PDT 2013
Modified: branches/Cog/platforms/unix/plugins/SocketPlugin/sqUnixSocket.c
===================================================================
--- branches/Cog/platforms/unix/plugins/SocketPlugin/sqUnixSocket.c 2013-04-11 23:37:17 UTC (rev 2718)
+++ branches/Cog/platforms/unix/plugins/SocketPlugin/sqUnixSocket.c 2013-04-12 19:00:52 UTC (rev 2719)
@@ -29,15 +29,17 @@
*
* Support for BSD-style "accept" primitives contributed by:
* Lex Spoon <lex(a)cc.gatech.edu>
+ *
+ * Raw Socket Support by Andreas Raab, RIP.
+ *
+ * Fix to option parsing in sqSocketSetOptions... by Eliot Miranda, 2013/4/12
*
* Notes:
- * Sockets are completely asynchronous, but the resolver is still
- * synchronous.
+ * Sockets are completely asynchronous, but the resolver is still synchronous.
*
* BUGS:
* Now that the image has real UDP primitives, the TCP/UDP duality in
- * many of the connection-oriented functions should be removed and
- * cremated.
+ * many of the connection-oriented functions should be removed and cremated.
*/
#include "sq.h"
@@ -1335,14 +1337,13 @@
memset((void *)buf, 0, sizeof(buf));
memcpy((void *)buf, optionValue, optionValueSize);
- if (optionValueSize == 1) /* character `1' or `0' */
+ if (optionValueSize <= sizeof(int)
+ && (strtol(buf, &endptr, 0),
+ endptr - buf == optionValueSize)) /* are all option chars digits? */
{
val= strtol(buf, &endptr, 0);
- if (endptr != buf)
- {
memcpy((void *)buf, (void *)&val, sizeof(val));
optionValueSize= sizeof(val);
- }
}
if ((setsockopt(PSP(s)->s, opt->optlevel, opt->optname,
(const void *)buf, optionValueSize)) < 0)
1
0
[commit][2718] Occasionally bizarre interactions cause the heartbeat' s interval timer to
by commits＠squeakvm.org 12 Apr '13
by commits＠squeakvm.org 12 Apr '13
12 Apr '13
Revision: 2718
Author: eliot
Date: 2013-04-11 16:37:17 -0700 (Thu, 11 Apr 2013)
Log Message:
-----------
Occasionally bizarre interactions cause the heartbeat's interval timer to
disable. e.g. on CentOS linux when using PAM to authenticate, a failing authen-
tication sequence disables the interval timer, for reasons unknown (setting
a breakpoint in setitimer doesn't show an actual call). So a work around is
to check the timer as a side-effect of ioRelinquishProcessorForMicroseconds.
Modified Paths:
--------------
branches/Cog/platforms/unix/vm/sqUnixITimerHeartbeat.c
branches/Cog/platforms/unix/vm/sqUnixITimerTickerHeartbeat.c
branches/Cog/platforms/unix/vm/sqUnixMain.c
Property Changed:
----------------
branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
Property changes on: branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
___________________________________________________________________
Modified: checkindate
- Wed Apr 10 17:15:30 PDT 2013
+ Thu Apr 11 16:36:31 PDT 2013
Modified: branches/Cog/platforms/unix/vm/sqUnixITimerHeartbeat.c
===================================================================
--- branches/Cog/platforms/unix/vm/sqUnixITimerHeartbeat.c 2013-04-11 00:17:11 UTC (rev 2717)
+++ branches/Cog/platforms/unix/vm/sqUnixITimerHeartbeat.c 2013-04-11 23:37:17 UTC (rev 2718)
@@ -385,13 +385,26 @@
static stack_t signal_stack;
#endif /* NEED_SIGALTSTACK */
+static void
+setIntervalTimer(long milliseconds)
+{
+ struct itimerval pulse;
+
+ pulse.it_interval.tv_sec = milliseconds / 1000;
+ pulse.it_interval.tv_usec = (milliseconds % 1000) * 1000;
+ pulse.it_value = pulse.it_interval;
+ if (setitimer(THE_ITIMER, &pulse, &pulse)) {
+ perror("ioInitHeartbeat setitimer");
+ exit(1);
+ }
+}
+
void
ioInitHeartbeat()
{
extern sqInt suppressHeartbeatFlag;
int er;
struct sigaction heartbeat_handler_action;
- struct itimerval pulse;
if (suppressHeartbeatFlag) return;
@@ -427,30 +440,57 @@
exit(1);
}
- pulse.it_interval.tv_sec = beatMilliseconds / 1000;
- pulse.it_interval.tv_usec = (beatMilliseconds % 1000) * 1000;
- pulse.it_value = pulse.it_interval;
- if (setitimer(THE_ITIMER, &pulse, &pulse)) {
- perror("ioInitHeartbeat setitimer");
- exit(1);
- }
+ setIntervalTimer(beatMilliseconds);
}
void
ioDisableHeartbeat() /* for debugging */
{
- struct itimerval expire;
+ setIntervalTimer(0);
+}
- expire.it_interval.tv_sec =
- expire.it_interval.tv_usec = 0;
- expire.it_value = expire.it_interval;
- if (setitimer(THE_ITIMER, &expire, 0)) {
- perror("ioDisableHeartbeat setitimer");
- exit(1);
- }
+/* Occasionally bizarre interactions cause the heartbeat's interval timer to
+ * disable. On CentOS linux when using PAM to authenticate, a failing authen-
+ * tication sequence disables the interval timer, for reasons unknown (setting
+ * a breakpoint in setitimer doesn't show an actual call). So a work around is
+ * to check the timer as a side-effect of ioRelinquishProcessorForMicroseconds.
+ */
+void
+checkHeartStillBeats()
+{
+ struct itimerval hb_itimer;
+
+ if (getitimer(THE_ITIMER, &hb_itimer) < 0)
+ perror("getitimer");
+ else if (!hb_itimer.it_interval.tv_sec
+ && !hb_itimer.it_interval.tv_usec)
+ setIntervalTimer(beatMilliseconds);
}
void
+printHeartbeatTimer()
+{
+ struct itimerval hb_itimer;
+ struct sigaction hb_handler_action;
+
+ if (getitimer(THE_ITIMER, &hb_itimer) < 0)
+ perror("getitimer");
+ else
+ printf("heartbeat timer interval s %ld us %ld value s %ld us %ld\n",
+ hb_itimer.it_interval.tv_sec, hb_itimer.it_interval.tv_usec,
+ hb_itimer.it_value.tv_sec, hb_itimer.it_value.tv_usec);
+
+ if (sigaction(ITIMER_SIGNAL, 0, &hb_handler_action) < 0)
+ perror("sigaction");
+ else
+ printf("heartbeat signal handler %p (%s)\n",
+ hb_handler_action.sa_sigaction,
+ hb_handler_action.sa_sigaction == heartbeat_handler
+ ? "heartbeat_handler"
+ : "????");
+}
+
+void
ioSetHeartbeatMilliseconds(int ms)
{
beatMilliseconds = ms;
Modified: branches/Cog/platforms/unix/vm/sqUnixITimerTickerHeartbeat.c
===================================================================
--- branches/Cog/platforms/unix/vm/sqUnixITimerTickerHeartbeat.c 2013-04-11 00:17:11 UTC (rev 2717)
+++ branches/Cog/platforms/unix/vm/sqUnixITimerTickerHeartbeat.c 2013-04-11 23:37:17 UTC (rev 2718)
@@ -515,6 +515,20 @@
static stack_t signal_stack;
#endif /* NEED_SIGALTSTACK */
+static void
+setIntervalTimer(long milliseconds)
+{
+ struct itimerval pulse;
+
+ pulse.it_interval.tv_sec = milliseconds / 1000;
+ pulse.it_interval.tv_usec = (milliseconds % 1000) * 1000;
+ pulse.it_value = pulse.it_interval;
+ if (setitimer(THE_ITIMER, &pulse, &pulse)) {
+ perror("ioInitHeartbeat setitimer");
+ exit(1);
+ }
+}
+
void
ioInitHeartbeat()
{
@@ -522,7 +536,6 @@
int er;
struct timespec halfAMo;
struct sigaction heartbeat_handler_action, ticker_handler_action;
- struct itimerval pulse;
if (suppressHeartbeatFlag) return;
@@ -587,30 +600,57 @@
exit(1);
}
- pulse.it_interval.tv_sec = beatMilliseconds / 1000;
- pulse.it_interval.tv_usec = (beatMilliseconds % 1000) * 1000;
- pulse.it_value = pulse.it_interval;
- if (setitimer(THE_ITIMER, &pulse, &pulse)) {
- perror("ioInitHeartbeat setitimer");
- exit(1);
- }
+ setIntervalTimer(beatMilliseconds);
}
void
ioDisableHeartbeat() /* for debugging */
{
- struct itimerval expire;
+ setIntervalTimer(0);
+}
- expire.it_interval.tv_sec =
- expire.it_interval.tv_usec = 0;
- expire.it_value = expire.it_interval;
- if (setitimer(THE_ITIMER, &expire, 0)) {
- perror("ioDisableHeartbeat setitimer");
- exit(1);
- }
+/* Occasionally bizarre interactions cause the heartbeat's interval timer to
+ * disable. On CentOS linux when using PAM to authenticate, a failing authen-
+ * tication sequence disables the interval timer, for reasons unknown (setting
+ * a breakpoint in setitimer doesn't show an actual call). So a work around is
+ * to check the timer as a side-effect of ioRelinquishProcessorForMicroseconds.
+ */
+void
+checkHeartStillBeats()
+{
+ struct itimerval hb_itimer;
+
+ if (getitimer(THE_ITIMER, &hb_itimer) < 0)
+ perror("getitimer");
+ else if (!hb_itimer.it_interval.tv_sec
+ && !hb_itimer.it_interval.tv_usec)
+ setIntervalTimer(beatMilliseconds);
}
void
+printHeartbeatTimer()
+{
+ struct itimerval hb_itimer;
+ struct sigaction hb_handler_action;
+
+ if (getitimer(THE_ITIMER, &hb_itimer) < 0)
+ perror("getitimer");
+ else
+ printf("heartbeat timer interval s %ld us %ld value s %ld us %ld\n",
+ hb_itimer.it_interval.tv_sec, hb_itimer.it_interval.tv_usec,
+ hb_itimer.it_value.tv_sec, hb_itimer.it_value.tv_usec);
+
+ if (sigaction(ITIMER_SIGNAL, 0, &hb_handler_action) < 0)
+ perror("sigaction");
+ else
+ printf("heartbeat signal handler %p (%s)\n",
+ hb_handler_action.sa_sigaction,
+ hb_handler_action.sa_sigaction == heartbeat_handler
+ ? "heartbeat_handler"
+ : "????");
+}
+
+void
ioSetHeartbeatMilliseconds(int ms)
{
beatMilliseconds = ms;
Modified: branches/Cog/platforms/unix/vm/sqUnixMain.c
===================================================================
--- branches/Cog/platforms/unix/vm/sqUnixMain.c 2013-04-11 00:17:11 UTC (rev 2717)
+++ branches/Cog/platforms/unix/vm/sqUnixMain.c 2013-04-11 23:37:17 UTC (rev 2718)
@@ -544,6 +544,11 @@
#if STACKVM
sqInt ioRelinquishProcessorForMicroseconds(sqInt us)
{
+# if ITIMER_HEARTBEAT
+ extern void checkHeartStillBeats();
+
+ checkHeartStillBeats();
+# endif
dpy->ioRelinquishProcessorForMicroseconds(us);
return 0;
}
1
0
Hi,
Norbert Hartl and I are proud to announce that:
- the pharo-vm package can now be installed on 64bits systems
- the pharo-vm package can now be installed on older Ubuntu releases
Todo list:
--
- clean the package to avoid many warnings
- automate the process of building these packages
- create a server-only version which do not depend on graphical libraries
(like X11 and libGL)
--
Damien Cassou
http://damiencassou.seasidehosting.st
"Success is the ability to go from one failure to another without losing
enthusiasm."
Winston Churchill
3
2
Re: [Seaside] Re: [Pharo-users] [ANN] Pharo VM packages and PPA for Ubuntu (v2)
by Igor Stasenko 11 Apr '13
by Igor Stasenko 11 Apr '13
11 Apr '13
On 11 April 2013 19:16, Sven Van Caekenberghe <sven(a)stfx.eu> wrote:
>
> On 11 Apr 2013, at 16:34, Damien Cassou <damien.cassou(a)gmail.com> wrote:
>
>> Hi,
>>
>> Norbert Hartl and I are proud to announce that:
>>
>> - the pharo-vm package can now be installed on 64bits systems
>> - the pharo-vm package can now be installed on older Ubuntu releases
>
> Great and important work, thanks !
>
+1
Thanks, Damien & Norbert.
>> Todo list:
>> --
>>
>> - clean the package to avoid many warnings
>> - automate the process of building these packages
>> - create a server-only version which do not depend on graphical libraries (like X11 and libGL)
>
> Yes, a pharo-nox version is really important (for me at least).
>
>> --
>> Damien Cassou
>> http://damiencassou.seasidehosting.st
>>
>> "Success is the ability to go from one failure to another without losing enthusiasm."
>> Winston Churchill
>
> --
> Sven Van Caekenberghe
> Proudly supporting Pharo
> http://pharo.org
> http://association.pharo.org
> http://consortium.pharo.org
>
>
>
>
> _______________________________________________
> seaside mailing list
> seaside(a)lists.squeakfoundation.org
> http://lists.squeakfoundation.org/cgi-bin/mailman/listinfo/seaside
--
Best regards,
Igor Stasenko.
1
0