diff --git a/src/spur32.cog.lowcode/cointerp.c b/src/spur32.cog.lowcode/cointerp.c index 890b5c8804..52a53cce1a 100644 --- a/src/spur32.cog.lowcode/cointerp.c +++ b/src/spur32.cog.lowcode/cointerp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -736,6 +736,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -931,7 +932,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -954,6 +954,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -2023,16 +2024,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2237,7 +2238,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2702,7 +2703,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -37543,8 +37544,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -39019,7 +39021,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - sqInt numTemps; + usqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -43225,8 +43227,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -44479,40 +44482,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -48045,6 +48033,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -48380,78 +48390,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -48868,7 +48847,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -48931,19 +48909,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -49690,41 +49658,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -52039,7 +51992,7 @@ primitiveInvokeObjectAsMethod(void) sqInt i; sqInt lookupClassTag; sqInt objFormat; - sqInt runArgs; + usqInt runArgs; sqInt runReceiver; char *sp; char *sp1; @@ -52457,40 +52410,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -55876,40 +55814,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -56181,8 +56104,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -56190,30 +56113,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -57306,15 +57217,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -57327,21 +57238,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -57349,9 +57250,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -58951,26 +58850,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -59494,6 +59373,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -66866,8 +66761,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -66976,8 +66872,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -79925,7 +79822,7 @@ prepareForSnapshot(void) sqInt limit; sqInt newEndOfMemory; sqInt next; - usqInt node; + sqInt node; SpurSegmentInfo *seg; sqInt smallChild; sqInt treeNode; @@ -87335,8 +87232,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -89321,7 +89219,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -89384,17 +89281,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -89561,10 +89453,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.cog.lowcode/cointerp.h b/src/spur32.cog.lowcode/cointerp.h index b9543ca722..902c5173c2 100644 --- a/src/spur32.cog.lowcode/cointerp.h +++ b/src/spur32.cog.lowcode/cointerp.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -137,6 +137,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur32.cog.lowcode/gcc3x-cointerp.c b/src/spur32.cog.lowcode/gcc3x-cointerp.c index 2f04558aec..aa804e129e 100644 --- a/src/spur32.cog.lowcode/gcc3x-cointerp.c +++ b/src/spur32.cog.lowcode/gcc3x-cointerp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -739,6 +739,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -934,7 +935,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -957,6 +957,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -2026,16 +2027,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2240,7 +2241,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2705,7 +2706,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -37552,8 +37553,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -39028,7 +39030,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - sqInt numTemps; + usqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -43234,8 +43236,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -44488,40 +44491,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -48054,6 +48042,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -48389,78 +48399,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -48877,7 +48856,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -48940,19 +48918,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -49699,41 +49667,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -52048,7 +52001,7 @@ primitiveInvokeObjectAsMethod(void) sqInt i; sqInt lookupClassTag; sqInt objFormat; - sqInt runArgs; + usqInt runArgs; sqInt runReceiver; char *sp; char *sp1; @@ -52466,40 +52419,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -55885,40 +55823,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -56190,8 +56113,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -56199,30 +56122,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -57315,15 +57226,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -57336,21 +57247,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -57358,9 +57259,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -58960,26 +58859,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -59503,6 +59382,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -66875,8 +66770,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -66985,8 +66881,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -79934,7 +79831,7 @@ prepareForSnapshot(void) sqInt limit; sqInt newEndOfMemory; sqInt next; - usqInt node; + sqInt node; SpurSegmentInfo *seg; sqInt smallChild; sqInt treeNode; @@ -87344,8 +87241,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -89330,7 +89228,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -89393,17 +89290,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -89570,10 +89462,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.cog/cointerp.c b/src/spur32.cog/cointerp.c index 4a848b97b5..e1fcf09676 100644 --- a/src/spur32.cog/cointerp.c +++ b/src/spur32.cog/cointerp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -727,6 +727,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -921,7 +922,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -942,6 +942,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -1998,16 +1999,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2212,7 +2213,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2677,7 +2678,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -17706,8 +17707,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -19137,7 +19139,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - sqInt numTemps; + usqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -23329,8 +23331,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -24583,40 +24586,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -28146,6 +28134,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28481,78 +28491,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -28969,7 +28948,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -29032,19 +29010,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -29791,41 +29759,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -32555,40 +32508,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -35974,40 +35912,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -36279,8 +36202,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -36288,30 +36211,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -37404,15 +37315,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -37425,21 +37336,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -37447,9 +37348,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39032,26 +38931,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -39561,6 +39440,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -46933,8 +46828,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47043,8 +46939,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -59352,7 +59249,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 1))) < (lengthOf(obj))); contextSize = (sp >> 1); l6: /* end fetchStackPointerOf: */; - numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); + numPointerSlots = CtxtTempFrameStart + contextSize; goto l10; } /* begin numSlotsOf: */ @@ -59382,7 +59279,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((header & 1)); numLiterals = ((header >> 1)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); + numPointerSlots = numLiterals + LiteralStart; l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -67269,8 +67166,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -69251,7 +69149,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -69314,17 +69211,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -69491,10 +69383,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.cog/cointerp.h b/src/spur32.cog/cointerp.h index a768cf4169..ff33cc44b2 100644 --- a/src/spur32.cog/cointerp.h +++ b/src/spur32.cog/cointerp.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -134,6 +134,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur32.cog/cointerpmt.c b/src/spur32.cog/cointerpmt.c index f7378b173e..bdc137aa7f 100644 --- a/src/spur32.cog/cointerpmt.c +++ b/src/spur32.cog/cointerpmt.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -829,6 +829,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -1021,7 +1022,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -1042,6 +1042,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -2111,7 +2112,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, @@ -2120,7 +2121,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2325,7 +2326,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2792,7 +2793,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -18282,8 +18283,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -26895,8 +26897,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -28149,40 +28152,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -31712,6 +31700,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -32047,78 +32057,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -32535,7 +32514,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -32598,19 +32576,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -33345,41 +33313,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -36109,40 +36062,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -39395,40 +39333,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -39700,8 +39623,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -39709,30 +39632,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -40825,15 +40736,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -40846,21 +40757,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -40868,9 +40769,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -42466,26 +42365,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -42995,6 +42874,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -50367,8 +50262,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -50477,8 +50373,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -67187,8 +67084,8 @@ static sqInt getErrorObjectFromPrimFailCode(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; - sqInt clone; - sqInt errObj; + usqInt clone; + usqInt errObj; sqInt fieldIndex; sqInt i; usqInt newObj; @@ -70499,8 +70396,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } /* StackInterpreter>>#pcPreviousTo:inSqueakV3PlusClosuresMethod: */ @@ -72238,7 +72136,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -72301,17 +72198,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -72478,10 +72370,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.cog/cointerpmt.h b/src/spur32.cog/cointerpmt.h index 3f116beb0b..9940311a20 100644 --- a/src/spur32.cog/cointerpmt.h +++ b/src/spur32.cog/cointerpmt.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -135,6 +135,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur32.cog/gcc3x-cointerp.c b/src/spur32.cog/gcc3x-cointerp.c index feced522fc..5bae55e2b4 100644 --- a/src/spur32.cog/gcc3x-cointerp.c +++ b/src/spur32.cog/gcc3x-cointerp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -730,6 +730,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -924,7 +925,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -945,6 +945,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -2001,16 +2002,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2215,7 +2216,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2680,7 +2681,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -17715,8 +17716,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -19146,7 +19148,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - sqInt numTemps; + usqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -23338,8 +23340,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -24592,40 +24595,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -28155,6 +28143,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28490,78 +28500,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -28978,7 +28957,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -29041,19 +29019,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -29800,41 +29768,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -32564,40 +32517,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -35983,40 +35921,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -36288,8 +36211,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -36297,30 +36220,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -37413,15 +37324,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -37434,21 +37345,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -37456,9 +37357,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39041,26 +38940,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -39570,6 +39449,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -46942,8 +46837,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47052,8 +46948,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -59361,7 +59258,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 1))) < (lengthOf(obj))); contextSize = (sp >> 1); l6: /* end fetchStackPointerOf: */; - numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); + numPointerSlots = CtxtTempFrameStart + contextSize; goto l10; } /* begin numSlotsOf: */ @@ -59391,7 +59288,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((header & 1)); numLiterals = ((header >> 1)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); + numPointerSlots = numLiterals + LiteralStart; l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -67278,8 +67175,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -69260,7 +69158,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -69323,17 +69220,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -69500,10 +69392,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.cog/gcc3x-cointerpmt.c b/src/spur32.cog/gcc3x-cointerpmt.c index 188eb3e6aa..9b54555558 100644 --- a/src/spur32.cog/gcc3x-cointerpmt.c +++ b/src/spur32.cog/gcc3x-cointerpmt.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -832,6 +832,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -1024,7 +1025,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -1045,6 +1045,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -2114,7 +2115,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, @@ -2123,7 +2124,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2328,7 +2329,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2795,7 +2796,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -18291,8 +18292,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -26904,8 +26906,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -28158,40 +28161,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -31721,6 +31709,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -32056,78 +32066,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -32544,7 +32523,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -32607,19 +32585,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -33354,41 +33322,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -36118,40 +36071,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -39404,40 +39342,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -39709,8 +39632,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -39718,30 +39641,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -40834,15 +40745,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -40855,21 +40766,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -40877,9 +40778,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -42475,26 +42374,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -43004,6 +42883,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -50376,8 +50271,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -50486,8 +50382,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -67196,8 +67093,8 @@ static sqInt getErrorObjectFromPrimFailCode(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; - sqInt clone; - sqInt errObj; + usqInt clone; + usqInt errObj; sqInt fieldIndex; sqInt i; usqInt newObj; @@ -70508,8 +70405,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } /* StackInterpreter>>#pcPreviousTo:inSqueakV3PlusClosuresMethod: */ @@ -72247,7 +72145,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -72310,17 +72207,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -72487,10 +72379,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.sista/cointerp.c b/src/spur32.sista/cointerp.c index 71f3982aff..457c1d364d 100644 --- a/src/spur32.sista/cointerp.c +++ b/src/spur32.sista/cointerp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -734,6 +734,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -929,7 +930,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -952,6 +952,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -2014,7 +2015,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, @@ -2023,7 +2024,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2228,7 +2229,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2693,7 +2694,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -20596,8 +20597,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -22029,7 +22031,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - sqInt numTemps; + usqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -26324,8 +26326,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -27578,40 +27581,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -31144,6 +31132,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -31479,78 +31489,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -31967,7 +31946,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -32030,19 +32008,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -32789,41 +32757,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -35556,40 +35509,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -38975,40 +38913,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -39280,8 +39203,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -39289,30 +39212,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -40405,15 +40316,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -40426,21 +40337,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -40448,9 +40349,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -42050,26 +41949,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -42593,6 +42472,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -49965,8 +49860,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -50075,8 +49971,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -62442,7 +62339,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 1))) < (lengthOf(obj))); contextSize = (sp >> 1); l6: /* end fetchStackPointerOf: */; - numPointerSlots = CtxtTempFrameStart + contextSize; + numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); goto l10; } /* begin numSlotsOf: */ @@ -62472,7 +62369,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((header & 1)); numLiterals = ((header >> 1)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = numLiterals + LiteralStart; + numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -70380,8 +70277,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -72366,7 +72264,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -72429,17 +72326,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -72606,10 +72498,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.sista/cointerp.h b/src/spur32.sista/cointerp.h index d3abbc637c..e972bdc500 100644 --- a/src/spur32.sista/cointerp.h +++ b/src/spur32.sista/cointerp.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -137,6 +137,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur32.sista/gcc3x-cointerp.c b/src/spur32.sista/gcc3x-cointerp.c index 215b28d06d..089ac82b67 100644 --- a/src/spur32.sista/gcc3x-cointerp.c +++ b/src/spur32.sista/gcc3x-cointerp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -737,6 +737,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -932,7 +933,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -955,6 +955,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -2017,7 +2018,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, @@ -2026,7 +2027,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2231,7 +2232,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2696,7 +2697,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -20605,8 +20606,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -22038,7 +22040,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - sqInt numTemps; + usqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -26333,8 +26335,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -27587,40 +27590,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -31153,6 +31141,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -31488,78 +31498,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -31976,7 +31955,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -32039,19 +32017,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -32798,41 +32766,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -35565,40 +35518,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -38984,40 +38922,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -39289,8 +39212,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -39298,30 +39221,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -40414,15 +40325,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -40435,21 +40346,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -40457,9 +40358,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -42059,26 +41958,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -42602,6 +42481,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -49974,8 +49869,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -50084,8 +49980,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -62451,7 +62348,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 1))) < (lengthOf(obj))); contextSize = (sp >> 1); l6: /* end fetchStackPointerOf: */; - numPointerSlots = CtxtTempFrameStart + contextSize; + numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); goto l10; } /* begin numSlotsOf: */ @@ -62481,7 +62378,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((header & 1)); numLiterals = ((header >> 1)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = numLiterals + LiteralStart; + numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -70389,8 +70286,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -72375,7 +72273,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -72438,17 +72335,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -72615,10 +72507,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur32.stack.lowcode/gcc3x-interp.c b/src/spur32.stack.lowcode/gcc3x-interp.c index 9f4c551744..eab760e5c4 100644 --- a/src/spur32.stack.lowcode/gcc3x-interp.c +++ b/src/spur32.stack.lowcode/gcc3x-interp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -413,6 +413,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -605,7 +606,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -628,6 +628,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -1744,12 +1745,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, /*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1929,7 +1930,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2388,7 +2389,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -25086,40 +25087,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -28262,6 +28248,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28716,78 +28724,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -29167,7 +29144,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -29230,19 +29206,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -30048,41 +30014,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -32438,40 +32389,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -36215,40 +36151,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -36544,8 +36465,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -36553,30 +36474,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -37669,15 +37578,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -37690,21 +37599,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -37712,9 +37611,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39154,26 +39051,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -39697,6 +39574,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -46990,8 +46883,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47100,8 +46994,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -68067,8 +67962,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -70304,7 +70200,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -70367,17 +70262,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -70544,10 +70434,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -80465,8 +80356,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur32.stack.lowcode/interp.c b/src/spur32.stack.lowcode/interp.c index b2627e4370..9c0cd9cdd3 100644 --- a/src/spur32.stack.lowcode/interp.c +++ b/src/spur32.stack.lowcode/interp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -410,6 +410,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -602,7 +603,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -625,6 +625,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -1741,12 +1742,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, /*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1926,7 +1927,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2385,7 +2386,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -25077,40 +25078,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -28253,6 +28239,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28707,78 +28715,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -29158,7 +29135,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -29221,19 +29197,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -30039,41 +30005,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -32429,40 +32380,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -36206,40 +36142,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -36535,8 +36456,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -36544,30 +36465,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -37660,15 +37569,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -37681,21 +37590,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -37703,9 +37602,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39145,26 +39042,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -39688,6 +39565,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -46981,8 +46874,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47091,8 +46985,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -68058,8 +67953,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -70295,7 +70191,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -70358,17 +70253,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -70535,10 +70425,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -80456,8 +80347,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur32.stack/gcc3x-interp.c b/src/spur32.stack/gcc3x-interp.c index 3c6a645010..1958102460 100644 --- a/src/spur32.stack/gcc3x-interp.c +++ b/src/spur32.stack/gcc3x-interp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -410,6 +410,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -602,7 +603,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -623,6 +623,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -1718,12 +1719,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, -/*100*/ 1, 2, 1, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, +/*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1903,7 +1904,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2362,7 +2363,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -12090,40 +12091,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -15266,6 +15252,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -15720,78 +15728,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -16171,7 +16148,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -16234,19 +16210,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -17052,41 +17018,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -19442,40 +19393,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -23219,40 +23155,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -23548,8 +23469,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -23557,30 +23478,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -24673,15 +24582,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -24694,21 +24603,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -24716,9 +24615,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -26158,26 +26055,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -26687,6 +26564,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -33980,8 +33873,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -34090,8 +33984,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -54877,8 +54772,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -57114,7 +57010,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -57177,17 +57072,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -57354,10 +57244,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -67231,8 +67122,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur32.stack/interp.c b/src/spur32.stack/interp.c index 98e50a96e1..4cea8c19c7 100644 --- a/src/spur32.stack/interp.c +++ b/src/spur32.stack/interp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -407,6 +407,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -599,7 +600,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -620,6 +620,7 @@ extern sqInt isMarked(sqInt objOop); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static void NoDbgRegParms setIsMarkedOfto(sqInt objOop, sqInt aBoolean); @@ -1715,12 +1716,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, -/*100*/ 1, 2, 1, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, +/*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1900,7 +1901,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2359,7 +2360,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -12081,40 +12082,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -15257,6 +15243,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -15711,78 +15719,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l1; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l1: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -16162,7 +16139,6 @@ primitiveFloatArrayAtPut(void) float aFloat; sqInt fmt; sqInt index; - sqInt isFloat; sqInt numSlots; sqInt rcvr; double result; @@ -16225,19 +16201,9 @@ primitiveFloatArrayAtPut(void) numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - isFloat = ((!(valueOop & (tagMask())))) - && (((longAt(valueOop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(valueOop + BaseHeaderSize, result); - aFloat = result; - goto l6; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - aFloat = 0.0; - l6: /* end floatValueOf: */; + assert(isFloatInstance(valueOop)); + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); @@ -17043,41 +17009,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -19433,40 +19384,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -23210,40 +23146,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -23539,8 +23460,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -23548,30 +23469,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -24664,15 +24573,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -24685,21 +24594,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l2; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l2: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -24707,9 +24606,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -26149,26 +26046,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -26678,6 +26555,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -33971,8 +33864,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -34081,8 +33975,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -54868,8 +54763,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -57105,7 +57001,6 @@ printOopShortInner(sqInt oop) sqInt classLookupKey; sqInt classOop; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -57168,17 +57063,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - isFloat = ((!(oop & (tagMask())))) - && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l7; - } - f = 0.0; - l7: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -57345,10 +57235,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (((!(oop & (tagMask())))) + && (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -67222,8 +67113,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur32.stack/validImage.c b/src/spur32.stack/validImage.c index 948f3c6428..478bc73f99 100644 --- a/src/spur32.stack/validImage.c +++ b/src/spur32.stack/validImage.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - ImageLeakChecker VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + ImageLeakChecker VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "ImageLeakChecker VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "ImageLeakChecker VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -256,7 +256,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern usqInt floatObjectOf(double aFloat); @@ -267,6 +266,7 @@ static sqInt imageFormatVersion(void); static sqInt NoDbgRegParms initFreeChunkWithBytesat(usqLong numBytes, sqInt address); static void NoDbgRegParms initSegmentBridgeWithBytesat(usqLong numBytes, sqInt address); static sqInt NoDbgRegParms integerObjectOf(sqInt value); +static sqInt NoDbgRegParms isFloatInstance(sqInt oop); static sqInt NoDbgRegParms isImmediateFloat(sqInt oop); static sqInt NoDbgRegParms isIntegerObject(sqInt oop); extern sqInt isIntegerValue(sqInt intValue); @@ -276,6 +276,7 @@ static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static usqInt NoDbgRegParms largeObjectBytesForSlots(sqInt numSlots); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt NoDbgRegParms normalisedFormatForindexableSize(sqInt objOop, sqInt indexableSize); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); @@ -995,7 +996,7 @@ sqInt extraVMMemory; sqInt ffiExceptionResponse; sqInt inIOProcessEvents; struct VirtualMachine* interpreterProxy; -const char *interpreterVersion = "Open Smalltalk ImageChecker VM [ImageLeakChecker VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk ImageChecker VM [ImageLeakChecker VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; char expensiveAsserts = 0; volatile int sendTrace; @@ -1731,26 +1732,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur32BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - sqInt isFloat; - double result; - - isFloat = (isNonImmediate(oop)) - && ((classIndexOf(oop)) == ClassFloatCompactIndex); - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -1978,6 +1959,14 @@ integerObjectOf(sqInt value) return ((((usqInt)value)) << 1) + 1; } + /* Spur32BitMemoryManager>>#isFloatInstance: */ +static sqInt NoDbgRegParms +isFloatInstance(sqInt oop) +{ + return (isNonImmediate(oop)) + && ((classIndexOf(oop)) == ClassFloatCompactIndex); +} + /* Spur32BitMemoryManager>>#isImmediateFloat: */ static sqInt NoDbgRegParms isImmediateFloat(sqInt oop) @@ -2100,6 +2089,22 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur32BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Answer the format for an objOop clone with indexableSize. Needs to work for longFormat and arrayFormat only. */ @@ -5222,7 +5227,7 @@ findStringBeginningWith(char *aCString) if (!(oopisLessThan(obj1, GIV(endOfMemory)))) break; assert((long64At(obj1)) != 0); if (isEnumerableObject(obj1)) { - if (objectequalsStringofSize(obj1, aCString, aCStringStrlen)) { + if (objectbeginsWithStringofSize(obj1, aCString, aCStringStrlen)) { printHex(obj1); /* begin space */ printChar(' '); @@ -12929,8 +12934,9 @@ static sqInt NoDbgRegParms objectequalsStringofSize(sqInt anOop, char *aCString, sqInt aCStringStrlen) { return (isBytes(anOop)) + && ((!(isCompiledMethod(anOop))) && (((numBytesOfBytes(anOop)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(anOop), aCStringStrlen)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), aCStringStrlen)) == 0))); } /* StackInterpreter>>#penultimateLiteralOf: */ @@ -13277,6 +13283,7 @@ printOopShortInner(sqInt oop) double f; char *name; sqInt nameLen; + double result; sqInt target; sqInt theClass1; @@ -13317,9 +13324,12 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((isNonImmediate(oop)) + && ((classIndexOf(oop)) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -13460,10 +13470,11 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (fetchPointerofObject(ClassFloat, GIV(specialObjectsOop)))) { + if ((isNonImmediate(oop)) + && ((classIndexOf(oop)) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } fmt = formatOf(oop); diff --git a/src/spur64.cog.lowcode/cointerp.c b/src/spur64.cog.lowcode/cointerp.c index 7296ba4a96..1413ce361d 100644 --- a/src/spur64.cog.lowcode/cointerp.c +++ b/src/spur64.cog.lowcode/cointerp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -736,6 +736,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -881,6 +882,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -951,7 +953,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -976,6 +977,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2045,7 +2047,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, @@ -2054,7 +2056,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2095,7 +2097,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2258,7 +2260,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2668,7 +2670,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2720,7 +2722,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -37446,8 +37448,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -38788,7 +38791,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - usqInt numTemps; + sqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -42990,8 +42993,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -44158,24 +44162,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -47527,6 +47552,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -47862,46 +47929,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -48373,14 +48481,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -48393,12 +48505,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -48410,7 +48522,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -48425,33 +48537,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -49224,25 +49355,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -51877,24 +52029,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -55225,24 +55398,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -55567,6 +55761,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -56693,8 +56918,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -56702,14 +56927,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -57757,17 +58006,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -57787,7 +58042,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -57795,9 +58071,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -59380,46 +59654,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -60015,6 +60249,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -67450,8 +67720,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -67560,8 +67831,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -73665,8 +73937,8 @@ outOfPlaceBecomeandcopyHashFlag(sqInt obj1, sqInt obj2, sqInt copyHashFlag) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; sqInt classIndex1; - usqInt clone1; - usqInt clone2; + sqInt clone1; + sqInt clone2; sqInt format; sqInt format1; sqInt hash; @@ -80036,7 +80308,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 3))) < (lengthOf(obj))); contextSize = (sp >> 3); l6: /* end fetchStackPointerOf: */; - numPointerSlots = CtxtTempFrameStart + contextSize; + numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); goto l10; } /* begin numSlotsOf: */ @@ -80066,7 +80338,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((((header) & 7) == 1)); numLiterals = ((header >> 3)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = numLiterals + LiteralStart; + numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -80618,7 +80890,7 @@ prepareForSnapshot(void) sqInt limit; sqInt newEndOfMemory; sqInt next; - usqInt node; + sqInt node; SpurSegmentInfo *seg; sqInt smallChild; sqInt treeNode; @@ -87941,8 +88213,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -90141,6 +90414,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -90150,9 +90424,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -90172,7 +90450,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -90212,9 +90490,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -90351,6 +90650,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -90381,10 +90681,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.cog.lowcode/cointerp.h b/src/spur64.cog.lowcode/cointerp.h index c38a9a73e5..59f6bcf8a3 100644 --- a/src/spur64.cog.lowcode/cointerp.h +++ b/src/spur64.cog.lowcode/cointerp.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -139,6 +139,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur64.cog.lowcode/gcc3x-cointerp.c b/src/spur64.cog.lowcode/gcc3x-cointerp.c index 1867bc7b7b..7c72efc915 100644 --- a/src/spur64.cog.lowcode/gcc3x-cointerp.c +++ b/src/spur64.cog.lowcode/gcc3x-cointerp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -739,6 +739,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -884,6 +885,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -954,7 +956,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -979,6 +980,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2048,7 +2050,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, @@ -2057,7 +2059,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2098,7 +2100,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2261,7 +2263,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2671,7 +2673,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2723,7 +2725,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -37455,8 +37457,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -38797,7 +38800,7 @@ printFrameWithSP(char *theFP, char *theSP) usqInt index; sqInt methodField; usqInt numArgs; - usqInt numTemps; + sqInt numTemps; char *rcvrAddress; sqInt rcvrOrClosure; CogBlockMethod * self_in_cmHomeMethod; @@ -42999,8 +43002,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -44167,24 +44171,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -47536,6 +47561,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -47871,46 +47938,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -48382,14 +48490,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -48402,12 +48514,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -48419,7 +48531,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -48434,33 +48546,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -49233,25 +49364,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -51886,24 +52038,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -55234,24 +55407,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -55576,6 +55770,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -56702,8 +56927,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -56711,14 +56936,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -57766,17 +58015,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -57796,7 +58051,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -57804,9 +58080,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -59389,46 +59663,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -60024,6 +60258,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -67459,8 +67729,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -67569,8 +67840,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -73674,8 +73946,8 @@ outOfPlaceBecomeandcopyHashFlag(sqInt obj1, sqInt obj2, sqInt copyHashFlag) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; sqInt classIndex1; - usqInt clone1; - usqInt clone2; + sqInt clone1; + sqInt clone2; sqInt format; sqInt format1; sqInt hash; @@ -80045,7 +80317,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 3))) < (lengthOf(obj))); contextSize = (sp >> 3); l6: /* end fetchStackPointerOf: */; - numPointerSlots = CtxtTempFrameStart + contextSize; + numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); goto l10; } /* begin numSlotsOf: */ @@ -80075,7 +80347,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((((header) & 7) == 1)); numLiterals = ((header >> 3)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = numLiterals + LiteralStart; + numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -80627,7 +80899,7 @@ prepareForSnapshot(void) sqInt limit; sqInt newEndOfMemory; sqInt next; - usqInt node; + sqInt node; SpurSegmentInfo *seg; sqInt smallChild; sqInt treeNode; @@ -87950,8 +88222,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -90150,6 +90423,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -90159,9 +90433,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -90181,7 +90459,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -90221,9 +90499,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -90360,6 +90659,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -90390,10 +90690,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.cog/cointerp.c b/src/spur64.cog/cointerp.c index 5202a8f606..0fe202b484 100644 --- a/src/spur64.cog/cointerp.c +++ b/src/spur64.cog/cointerp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -727,6 +727,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -872,6 +873,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -941,7 +943,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -965,6 +966,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2021,16 +2023,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2071,7 +2073,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2234,7 +2236,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2644,7 +2646,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2696,7 +2698,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -17814,8 +17816,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -23299,8 +23302,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -24467,24 +24471,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -27833,6 +27858,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28168,46 +28235,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -28679,14 +28787,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -28699,12 +28811,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -28716,7 +28828,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -28731,33 +28843,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -29530,25 +29661,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -32180,24 +32332,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -35528,24 +35701,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -35870,6 +36064,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -36996,8 +37221,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -37005,14 +37230,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -38060,17 +38309,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -38090,7 +38345,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -38098,9 +38374,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39666,46 +39940,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -40294,6 +40528,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -47729,8 +47999,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47839,8 +48110,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -64727,8 +64999,8 @@ static sqInt getErrorObjectFromPrimFailCode(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; - usqInt clone; - usqInt errObj; + sqInt clone; + sqInt errObj; sqInt fieldIndex; sqInt i; usqInt newObj; @@ -68087,8 +68359,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -70283,6 +70556,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -70292,9 +70566,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -70314,7 +70592,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -70354,9 +70632,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -70493,6 +70792,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -70523,10 +70823,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.cog/cointerp.h b/src/spur64.cog/cointerp.h index 120d3dcb00..89973e6240 100644 --- a/src/spur64.cog/cointerp.h +++ b/src/spur64.cog/cointerp.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -136,6 +136,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur64.cog/cointerpmt.c b/src/spur64.cog/cointerpmt.c index dd595e865b..306abb3034 100644 --- a/src/spur64.cog/cointerpmt.c +++ b/src/spur64.cog/cointerpmt.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -829,6 +829,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -971,6 +972,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -1041,7 +1043,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -1065,6 +1066,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2134,16 +2136,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2184,7 +2186,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2347,7 +2349,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2757,7 +2759,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2811,7 +2813,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -18390,8 +18392,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -26865,8 +26868,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -28033,24 +28037,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -31399,6 +31424,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -31734,46 +31801,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -32245,14 +32353,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -32265,12 +32377,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -32282,7 +32394,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -32297,33 +32409,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -33084,25 +33215,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -35734,24 +35886,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -38949,24 +39122,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -39291,6 +39485,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -40417,8 +40642,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -40426,14 +40651,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -41481,17 +41730,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -41511,7 +41766,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -41519,9 +41795,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -43100,46 +43374,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -43728,6 +43962,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -51163,8 +51433,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -51273,8 +51544,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -64291,7 +64563,7 @@ prepareForSnapshot(void) sqInt limit; sqInt newEndOfMemory; sqInt next; - usqInt node; + sqInt node; SpurSegmentInfo *seg; sqInt smallChild; sqInt treeNode; @@ -68079,8 +68351,8 @@ static sqInt getErrorObjectFromPrimFailCode(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; - sqInt clone; - sqInt errObj; + usqInt clone; + usqInt errObj; sqInt fieldIndex; sqInt i; usqInt newObj; @@ -71317,8 +71589,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } /* StackInterpreter>>#pcPreviousTo:inSqueakV3PlusClosuresMethod: */ @@ -73270,6 +73543,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -73279,9 +73553,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -73301,7 +73579,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -73341,9 +73619,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -73480,6 +73779,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -73510,10 +73810,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.cog/cointerpmt.h b/src/spur64.cog/cointerpmt.h index 864ad38352..55b13549eb 100644 --- a/src/spur64.cog/cointerpmt.h +++ b/src/spur64.cog/cointerpmt.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -137,6 +137,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur64.cog/gcc3x-cointerp.c b/src/spur64.cog/gcc3x-cointerp.c index f4c75cedfc..fe622a6b00 100644 --- a/src/spur64.cog/gcc3x-cointerp.c +++ b/src/spur64.cog/gcc3x-cointerp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -730,6 +730,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -875,6 +876,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -944,7 +946,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -968,6 +969,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2024,16 +2026,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2074,7 +2076,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2237,7 +2239,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2647,7 +2649,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2699,7 +2701,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -17823,8 +17825,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -23308,8 +23311,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -24476,24 +24480,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -27842,6 +27867,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28177,46 +28244,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -28688,14 +28796,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -28708,12 +28820,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -28725,7 +28837,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -28740,33 +28852,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -29539,25 +29670,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -32189,24 +32341,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -35537,24 +35710,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -35879,6 +36073,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -37005,8 +37230,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -37014,14 +37239,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -38069,17 +38318,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -38099,7 +38354,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -38107,9 +38383,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39675,46 +39949,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -40303,6 +40537,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -47738,8 +48008,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47848,8 +48119,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -64736,8 +65008,8 @@ static sqInt getErrorObjectFromPrimFailCode(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; - usqInt clone; - usqInt errObj; + sqInt clone; + sqInt errObj; sqInt fieldIndex; sqInt i; usqInt newObj; @@ -68096,8 +68368,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -70292,6 +70565,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -70301,9 +70575,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -70323,7 +70601,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -70363,9 +70641,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -70502,6 +70801,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -70532,10 +70832,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.cog/gcc3x-cointerpmt.c b/src/spur64.cog/gcc3x-cointerpmt.c index 2e2adbafc5..06ee992fe6 100644 --- a/src/spur64.cog/gcc3x-cointerpmt.c +++ b/src/spur64.cog/gcc3x-cointerpmt.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreterMT VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -832,6 +832,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -974,6 +975,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -1044,7 +1046,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -1068,6 +1069,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2137,16 +2139,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2187,7 +2189,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2350,7 +2352,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2760,7 +2762,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2814,7 +2816,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog MT VM [CoInterpreterMT VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -18399,8 +18401,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -26874,8 +26877,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -28042,24 +28046,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -31408,6 +31433,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -31743,46 +31810,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -32254,14 +32362,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -32274,12 +32386,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -32291,7 +32403,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -32306,33 +32418,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -33093,25 +33224,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -35743,24 +35895,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -38958,24 +39131,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -39300,6 +39494,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -40426,8 +40651,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -40435,14 +40660,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -41490,17 +41739,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -41520,7 +41775,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -41528,9 +41804,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -43109,46 +43383,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -43737,6 +43971,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -51172,8 +51442,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -51282,8 +51553,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -64300,7 +64572,7 @@ prepareForSnapshot(void) sqInt limit; sqInt newEndOfMemory; sqInt next; - usqInt node; + sqInt node; SpurSegmentInfo *seg; sqInt smallChild; sqInt treeNode; @@ -68088,8 +68360,8 @@ static sqInt getErrorObjectFromPrimFailCode(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt classIndex; - sqInt clone; - sqInt errObj; + usqInt clone; + usqInt errObj; sqInt fieldIndex; sqInt i; usqInt newObj; @@ -71326,8 +71598,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } /* StackInterpreter>>#pcPreviousTo:inSqueakV3PlusClosuresMethod: */ @@ -73279,6 +73552,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -73288,9 +73562,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -73310,7 +73588,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -73350,9 +73628,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -73489,6 +73788,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -73519,10 +73819,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.sista/cointerp.c b/src/spur64.sista/cointerp.c index d59048a037..067f0448e2 100644 --- a/src/spur64.sista/cointerp.c +++ b/src/spur64.sista/cointerp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -734,6 +734,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -879,6 +880,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -949,7 +951,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -974,6 +975,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2036,16 +2038,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2086,7 +2088,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2249,7 +2251,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2659,7 +2661,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2711,7 +2713,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -20629,8 +20631,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -26219,8 +26222,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -27387,24 +27391,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -30756,6 +30781,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -31091,46 +31158,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -31602,14 +31710,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -31622,12 +31734,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -31639,7 +31751,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -31654,33 +31766,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -32453,25 +32584,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -35106,24 +35258,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -38454,24 +38627,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -38796,6 +38990,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -39922,8 +40147,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -39931,14 +40156,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -40986,17 +41235,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -41016,7 +41271,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -41024,9 +41300,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -42609,46 +42883,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -43244,6 +43478,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -50679,8 +50949,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -50789,8 +51060,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -63265,7 +63537,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 3))) < (lengthOf(obj))); contextSize = (sp >> 3); l6: /* end fetchStackPointerOf: */; - numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); + numPointerSlots = CtxtTempFrameStart + contextSize; goto l10; } /* begin numSlotsOf: */ @@ -63295,7 +63567,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((((header) & 7) == 1)); numLiterals = ((header >> 3)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); + numPointerSlots = numLiterals + LiteralStart; l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -71116,8 +71388,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -73316,6 +73589,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -73325,9 +73599,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -73347,7 +73625,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -73387,9 +73665,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -73526,6 +73825,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -73556,10 +73856,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.sista/cointerp.h b/src/spur64.sista/cointerp.h index b1bd5a0570..36f80d7c7c 100644 --- a/src/spur64.sista/cointerp.h +++ b/src/spur64.sista/cointerp.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -139,6 +139,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); extern sqInt instantiateClassindexableSize(sqInt classObj, usqInt nElements); extern sqInt isIntegerValue(sqInt intValue); extern sqInt isMarked(sqInt objOop); +extern double noFailFloatValueOf(sqInt aFloatOop); extern usqInt smallObjectBytesForSlots(sqInt numSlots); extern sqInt remember(sqInt objOop); extern sqInt addressCouldBeObj(sqInt address); diff --git a/src/spur64.sista/gcc3x-cointerp.c b/src/spur64.sista/gcc3x-cointerp.c index f45373b87e..5a80c6338d 100644 --- a/src/spur64.sista/gcc3x-cointerp.c +++ b/src/spur64.sista/gcc3x-cointerp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -737,6 +737,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -882,6 +883,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -952,7 +954,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -977,6 +978,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -2039,16 +2041,16 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-256, /*20*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0x101, 0x101, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0x100, 259, 259, 259, 259, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 259, 3, 3, 0, 3, 3, 3, 3, /*60*/ 0, 0, 0, 0, 0,-256,-256,-256, 0x100, 0x100, 0, 0, 0, 268, 0x100, 0, 0x100, 0, /*78*/ 0, 0, /*80*/ -256,-256,-256, 4, 4, 0, 0x100, 0, 0x200,-256,-256, 0, 0, 0, 0x100,-256, 0,-256, /*98*/ 0, 0, -/*100*/ 260, 0x200, 0x200, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, +/*100*/ 260, 0x200, 0x100, 0x200,-256, 513,-256,-256,-256,-256, 0, 0x100, 0, 0,-256, /*115*/ 0x100, 0, 12, 260, 0, /*120*/ 524, 0x100,-256,-256, 1, 0, 0, 0, 0,-255,-256,-256, 0, 0, 0,-256, 0,-256,-256, /*139*/ 0, -/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0,-256,-256,-256,-256,-256, +/*140*/ -256, 0x100,-256, 0x101, 0x101, 0x101,-256,-256, 12, 0, 3,-256,-256,-256,-256, /*155*/ -256,-256,-256, 0x100, 0x100, /*160*/ 0, 0,-256, 1, 1, 0x100, 0x100,-256, 0x101, 0, 0, 0,-256, 268, 0x100, 0,-256, /*177*/ 0,-256,-256, @@ -2089,7 +2091,7 @@ static signed short primitiveMetadataTable[MaxPrimitiveIndex + 2 /* 584 */] = { /*520*/ -256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256,-256, /*536*/ -256,-256,-256,-256, /*540*/ -256, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 1, 3, 3, 3, 3, 3, 3, -/*560*/ -256,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, +/*560*/ 3,-256,-256,-256,-256,-256,-256,-256, 0x200,-256,-244, 0x100, 0, 0,-256, 0, /*576*/ -256,-256, 0x200,-256, /*580*/ 0, 0, 0 }; @@ -2252,7 +2254,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2662,7 +2664,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2714,7 +2716,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; int displayWidth; int displayDepth; @@ -20638,8 +20640,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((!(pluginName & (tagMask())))) && (((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -26228,8 +26231,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -27396,24 +27400,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -30765,6 +30790,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -31100,46 +31167,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -31611,14 +31719,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -31631,12 +31743,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -31648,7 +31760,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -31663,33 +31775,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -32462,25 +32593,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -35115,24 +35267,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -38463,24 +38636,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -38805,6 +38999,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -39931,8 +40156,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -39940,14 +40165,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -40995,17 +41244,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -41025,7 +41280,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -41033,9 +41309,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -42618,46 +42892,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -43253,6 +43487,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -50688,8 +50958,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -50798,8 +51069,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -63274,7 +63546,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) assert((ReceiverIndex + ((sp >> 3))) < (lengthOf(obj))); contextSize = (sp >> 3); l6: /* end fetchStackPointerOf: */; - numPointerSlots = ((usqInt) (CtxtTempFrameStart + contextSize)); + numPointerSlots = CtxtTempFrameStart + contextSize; goto l10; } /* begin numSlotsOf: */ @@ -63304,7 +63576,7 @@ updatePointersInsavedFirstFieldPointer(sqInt obj, sqInt firstFieldPtr) /* begin literalCountOfMethodHeader: */ assert((((header) & 7) == 1)); numLiterals = ((header >> 3)) & AlternateHeaderNumLiteralsMask; - numPointerSlots = ((usqInt) (numLiterals + LiteralStart)); + numPointerSlots = numLiterals + LiteralStart; l10: /* end numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: */; if ((fmt <= 5 /* lastPointerFormat */) && (numPointerSlots > 0)) { @@ -71125,8 +71397,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -73325,6 +73598,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -73334,9 +73608,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -73356,7 +73634,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -73396,9 +73674,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -73535,6 +73834,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -73565,10 +73865,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/spur64.stack.lowcode/gcc3x-interp.c b/src/spur64.stack.lowcode/gcc3x-interp.c index 6d8034fbae..1e5d549069 100644 --- a/src/spur64.stack.lowcode/gcc3x-interp.c +++ b/src/spur64.stack.lowcode/gcc3x-interp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -413,6 +413,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -565,6 +566,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -624,7 +626,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -649,6 +650,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -1764,12 +1766,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, /*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1790,7 +1792,7 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] /*500*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*520*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*540*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -/*560*/ -1,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, +/*560*/ 0,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, /*580*/ 0, 0, 0 }; static void (*primitiveFunctionPointer)(); @@ -1949,7 +1951,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2359,7 +2361,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2405,7 +2407,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; int displayWidth; int displayDepth; @@ -24831,24 +24833,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -27810,6 +27833,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28264,46 +28329,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -28738,14 +28844,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -28758,12 +28868,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -28775,7 +28885,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -28790,33 +28900,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -29648,25 +29777,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -31924,24 +32074,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -35630,24 +35801,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -35972,6 +36164,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -37122,8 +37345,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -37131,14 +37354,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -38186,17 +38433,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -38216,7 +38469,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -38224,9 +38498,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39669,46 +39941,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -40304,6 +40536,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -47656,8 +47924,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47766,8 +48035,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -68741,8 +69011,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -71092,6 +71363,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -71101,9 +71373,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -71123,7 +71399,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -71163,9 +71439,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -71302,6 +71599,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -71332,10 +71630,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -81033,8 +81333,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur64.stack.lowcode/interp.c b/src/spur64.stack.lowcode/interp.c index f87adf6bf0..f3c5303e60 100644 --- a/src/spur64.stack.lowcode/interp.c +++ b/src/spur64.stack.lowcode/interp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -410,6 +410,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -562,6 +563,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -621,7 +623,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -646,6 +647,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -1761,12 +1763,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, /*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1787,7 +1789,7 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] /*500*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*520*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*540*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -/*560*/ -1,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, +/*560*/ 0,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, /*580*/ 0, 0, 0 }; static void (*primitiveFunctionPointer)(); @@ -1946,7 +1948,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2356,7 +2358,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2402,7 +2404,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; int displayWidth; int displayDepth; @@ -24822,24 +24824,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -27801,6 +27824,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -28255,46 +28320,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -28729,14 +28835,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -28749,12 +28859,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -28766,7 +28876,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -28781,33 +28891,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -29639,25 +29768,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -31915,24 +32065,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -35621,24 +35792,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -35963,6 +36155,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -37113,8 +37336,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -37122,14 +37345,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -38177,17 +38424,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -38207,7 +38460,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -38215,9 +38489,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -39660,46 +39932,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -40295,6 +40527,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -47647,8 +47915,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -47757,8 +48026,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -68732,8 +69002,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -71083,6 +71354,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -71092,9 +71364,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -71114,7 +71390,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -71154,9 +71430,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -71293,6 +71590,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -71323,10 +71621,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -81024,8 +81324,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur64.stack/gcc3x-interp.c b/src/spur64.stack/gcc3x-interp.c index 74c163fc97..3462ef8130 100644 --- a/src/spur64.stack/gcc3x-interp.c +++ b/src/spur64.stack/gcc3x-interp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -410,6 +410,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -562,6 +563,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -621,7 +623,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -645,6 +646,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -1739,12 +1741,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, /*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1765,7 +1767,7 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] /*500*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*520*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*540*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -/*560*/ -1,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, +/*560*/ 0,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, /*580*/ 0, 0, 0 }; static void (*primitiveFunctionPointer)(); @@ -1924,7 +1926,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2334,7 +2336,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2380,7 +2382,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; int displayWidth; int displayDepth; @@ -12054,24 +12056,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -15033,6 +15056,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -15487,46 +15552,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -15961,14 +16067,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -15981,12 +16091,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -15998,7 +16108,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -16013,33 +16123,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -16871,25 +17000,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -19147,24 +19297,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -22853,24 +23024,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -23195,6 +23387,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -24345,8 +24568,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -24354,14 +24577,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -25409,17 +25656,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -25439,7 +25692,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -25447,9 +25721,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -26892,46 +27164,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -27520,6 +27752,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -34872,8 +35140,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -34982,8 +35251,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -55777,8 +56047,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -58128,6 +58399,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -58137,9 +58409,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -58159,7 +58435,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -58199,9 +58475,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -58338,6 +58635,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -58368,10 +58666,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -68025,8 +68325,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur64.stack/interp.c b/src/spur64.stack/interp.c index 4e656b3006..c5e1289ece 100644 --- a/src/spur64.stack/interp.c +++ b/src/spur64.stack/interp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -407,6 +407,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -559,6 +560,7 @@ static void primitiveSizeInBytes(void); static void primitiveSizeInBytesOfInstance(void); static void primitiveSmallFloatAdd(void); static void primitiveSmallFloatArctan(void); +static void primitiveSmallFloatCosine(void); static void primitiveSmallFloatDivide(void); static void primitiveSmallFloatEqual(void); static void primitiveSmallFloatExp(void); @@ -618,7 +620,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -642,6 +643,7 @@ static sqInt NoDbgRegParms isSmallFloatValue(double aFloat); static sqInt NoDbgRegParms isWordsNonImm(sqInt objOop); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); static double NoDbgRegParms smallFloatValueOf(sqInt oop); @@ -1736,12 +1738,12 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] // 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 /*0*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, /*20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, +/*40*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, /*60*/ 0, 0, 0, 0, 0,-1,-1,-1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, /*80*/ -1,-1,-1, 0, 0, 0, 1, 0, 2,-1,-1, 0, 0, 0, 1,-1, 0,-1, 0, 0, /*100*/ 1, 2, 2, 2,-1, 2,-1,-1,-1,-1, 0, 1, 0, 0,-1, 1, 0, 0, 1, 0, /*120*/ 2, 1,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0, 0,-1, 0,-1,-1, 0, -/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0,-1,-1,-1,-1,-1,-1,-1,-1, 1, 1, +/*140*/ -1, 1,-1, 1, 1, 1,-1,-1, 0, 0, 0,-1,-1,-1,-1,-1,-1,-1, 1, 1, /*160*/ 0, 0,-1, 0, 0, 1, 1,-1, 1, 0, 0, 0,-1, 1, 1, 0,-1, 0,-1,-1, /*180*/ 0, 0, 0, 0, 1, 1, 1, 1, 2, 1,-1,-1,-1,-1,-1, 1, 2, 0,-1,-1, /*200*/ 0, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 0,-1, 0,-1,-1, 3,-1, @@ -1762,7 +1764,7 @@ static signed char primitiveAccessorDepthTable[MaxPrimitiveIndex + 2 /* 584 */] /*500*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*520*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /*540*/ -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -/*560*/ -1,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, +/*560*/ 0,-1,-1,-1,-1,-1,-1,-1, 2,-1,-1, 1, 0, 0,-1, 0,-1,-1, 2,-1, /*580*/ 0, 0, 0 }; static void (*primitiveFunctionPointer)(); @@ -1921,7 +1923,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2331,7 +2333,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 557 */ primitiveSmallFloatArctan, /* 558 */ primitiveSmallFloatLogN, /* 559 */ primitiveSmallFloatExp, - /* 560 */ (void (*)(void))0, + /* 560 */ primitiveSmallFloatCosine, /* 561 */ (void (*)(void))0, /* 562 */ (void (*)(void))0, /* 563 */ (void (*)(void))0, @@ -2377,7 +2379,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; int displayWidth; int displayDepth; @@ -12045,24 +12047,45 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -15024,6 +15047,48 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -15478,46 +15543,87 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; + double result; + usqLong rot; + double value; pwr = 0; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 3) | 1)); } @@ -15952,14 +16058,18 @@ static void primitiveFloatArrayAtPut(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT float aFloat; + usqLong bits; sqInt fmt; sqInt index; sqInt numSlots; sqInt rcvr; + double result; + usqLong rot; char *sp; char *sp1; sqInt tagBits; sqLong value; + double value1; sqInt valueOop; /* begin primitiveSpurFloatArrayAtPut */ @@ -15972,12 +16082,12 @@ primitiveFloatArrayAtPut(void) && ((((index) & 7) == 1)))) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadArgument; - goto l7; + goto l11; } if (((rcvr & (tagMask())) != 0)) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - goto l7; + goto l11; } if ( # if IMMUTABILITY @@ -15989,7 +16099,7 @@ primitiveFloatArrayAtPut(void) ) { /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrNoModification; - goto l7; + goto l11; } fmt = (((usqInt)((longAt(rcvr)))) >> (formatShift())) & (formatMask()); index = ((index >> 3)) - 1; @@ -16004,33 +16114,52 @@ primitiveFloatArrayAtPut(void) /* begin pop:thenPush: */ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } if ((fmt >= (firstLongFormat())) && (fmt <= ((firstLongFormat()) + 1))) { numSlots = ((usqInt)((numBytesOf(rcvr)))) >> 2; if ((((usqInt)index)) < numSlots) { /* begin storeFloat32:ofObject:withValue: */ - aFloat = floatValueOf(valueOop); + assert(isFloatInstance(valueOop)); + if ((valueOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(valueOop)); + rot = ((((usqInt)valueOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value1), (&bits), sizeof(value1)); + result = value1; + } + else { + fetchFloatAtinto(valueOop + BaseHeaderSize, result); + } + aFloat = result; singleFloatAtPointerput((rcvr + BaseHeaderSize) + (((sqInt)((usqInt)(index) << 2))), aFloat); /* begin methodReturnValue: */ assert(!((failed()))); /* begin pop:thenPush: */ longAtput((sp1 = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), valueOop); GIV(stackPointer) = sp1; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadIndex; - goto l7; + goto l11; } /* begin primitiveFailFor: */ GIV(primFailCode) = PrimErrBadReceiver; - l7: /* end primitiveSpurFloatArrayAtPut */; + l11: /* end primitiveSpurFloatArrayAtPut */; } @@ -16862,25 +16991,46 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; double trunc; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveFullClosureValue */ @@ -19138,24 +19288,45 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -22844,24 +23015,45 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); } + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -23186,6 +23378,37 @@ primitiveSmallFloatArctan(void) longAtPointerput(GIV(stackPointer), aValue); } + /* InterpreterPrimitives>>#primitiveSmallFloatCosine */ +static void +primitiveSmallFloatCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + usqLong bits; + sqInt oop; + double rcvr; + usqLong rot; + double value; + + /* begin smallFloatValueOf: */ + oop = longAt(GIV(stackPointer)); + /* begin smallFloatBitsOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + rcvr = value; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(rcvr)); + longAtPointerput(GIV(stackPointer), aValue); +} + /* InterpreterPrimitives>>#primitiveSmallFloatDivide */ static void primitiveSmallFloatDivide(void) @@ -24336,8 +24559,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -24345,14 +24568,38 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - double rcvr; + usqLong bits; + double doubleValue; + sqInt rcvr; + double result; + usqLong rot; + double value; - /* begin stackFloatValue: */ - rcvr = floatValueOf(longAt(GIV(stackPointer) + (0 * BytesPerWord))); - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + if ((rcvr & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(rcvr)); + rot = ((((usqInt)rcvr))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + } + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -25400,17 +25647,23 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; + usqLong bits; double rcvr; double result; + double result1; + usqLong rot; char *sp; sqInt twiceMaxExponent; + double value; arg = longAt(GIV(stackPointer)); if (!((((arg) & 7) == 1))) { @@ -25430,7 +25683,28 @@ primitiveTimesTwoPower(void) arg = twiceMaxExponent; } } - rcvr = floatValueOf(longAt(GIV(stackPointer) + (1 * BytesPerWord))); + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result1 = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + } + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -25438,9 +25712,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -26883,46 +27155,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - usqLong bits; - double result; - usqLong rot; - sqInt tagBits; - double value; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - /* begin smallFloatValueOf: */ - assert(isImmediateFloat(oop)); - rot = ((((usqInt)oop))) >> (numTagBits()); - if (rot > 1) { - - /* a.k.a. ~= +/-0.0 */ - rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); - } - /* begin rotateRight: */ - rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); - bits = rot; - memcpy((&value), (&bits), sizeof(value)); - return value; - } - } - else { - if (((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -27511,6 +27743,42 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + usqLong bits; + double result; + usqLong rot; + double value; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(aFloatOop)); + rot = ((((usqInt)aFloatOop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the number of free lists. We use freeListsMask, a bitmap, to avoid reading empty list heads. This should fit in a machine word to end up in a register during free chunk allocation. */ @@ -34863,8 +35131,9 @@ findStringBeginningWith(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj1)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -34973,8 +35242,9 @@ findString(char *aCString) if (isEnumerableObject(obj1)) { if ((((!(obj1 & (tagMask())))) && (((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj1)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj1)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj1), aCStringStrlen)) == 0)))) { printHex(obj1); /* begin space */ printChar(' '); @@ -55768,8 +56038,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((!(anOop & (tagMask())))) && (((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -58119,6 +58390,7 @@ printNameOfClasscount(sqInt classOop, sqInt cnt) static void NoDbgRegParms printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT + usqLong bits; sqInt classLookupKey; sqInt classOop; double f; @@ -58128,9 +58400,13 @@ printOopShortInner(sqInt oop) sqInt objOop; sqInt objOop1; sqInt referent; + double result; + usqLong rot; char *s; + sqInt tagBits; sqInt target; sqInt theClass1; + double value; if (((oop & (tagMask())) != 0)) { if (((oop & (characterTag())) != 0)) { @@ -58150,7 +58426,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -58190,9 +58466,30 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + /* begin smallFloatValueOf: */ + assert(isImmediateFloat(oop)); + rot = ((((usqInt)oop))) >> (numTagBits()); + if (rot > 1) { + + /* a.k.a. ~= +/-0.0 */ + rot += ((sqInt)((usqInt)((smallFloatExponentOffset())) << ((smallFloatMantissaBits()) + 1))); + } + /* begin rotateRight: */ + rot = (rot << 0x3F) + (((((usqInt)rot))) >> 1); + bits = rot; + memcpy((&value), (&bits), sizeof(value)); + result = value; + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -58329,6 +58626,7 @@ printOop(sqInt oop) usqInt numSlots1; usqInt numSlots2; usqInt startIP; + sqInt tagBits; length = 0; if (((oop & (tagMask())) != 0)) { @@ -58359,10 +58657,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : ((longAt(oop)) & (classIndexMask())) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -68016,8 +68316,9 @@ primitiveUnloadModule(void) } if ((((!(moduleName & (tagMask())))) && (((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (formatShift())) & (formatMask())) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/spur64.stack/validImage.c b/src/spur64.stack/validImage.c index 5a839a5cae..0b59d302fc 100644 --- a/src/spur64.stack/validImage.c +++ b/src/spur64.stack/validImage.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - ImageLeakChecker VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + ImageLeakChecker VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "ImageLeakChecker VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "ImageLeakChecker VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -257,7 +257,6 @@ static sqInt NoDbgRegParms allocateSlotsForPinningInOldSpacebytesformatclassInde static sqInt NoDbgRegParms allocateSlotsInOldSpacebytesformatclassIndex(sqInt numSlots, usqInt totalBytes, sqInt formatField, sqInt classIndex); extern sqInt byteSwapped(sqInt w); static usqInt NoDbgRegParms bytesInBody(sqInt objOop); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt fetchClassTagOf(sqInt oop); extern sqInt floatObjectOf(double aFloat); @@ -267,6 +266,7 @@ extern sqInt headerIndicatesAlternateBytecodeSet(sqInt methodHeader); static sqInt NoDbgRegParms initFreeChunkWithBytesat(usqLong numBytes, sqInt address); static void NoDbgRegParms initSegmentBridgeWithBytesat(usqLong numBytes, sqInt address); static sqInt NoDbgRegParms integerObjectOf(sqInt value); +static sqInt NoDbgRegParms isFloatInstance(sqInt oop); static sqInt NoDbgRegParms isImmediateFloat(sqInt oop); static sqInt NoDbgRegParms isIntegerObject(sqInt oop); extern sqInt isIntegerValue(sqInt intValue); @@ -279,6 +279,7 @@ static usqInt NoDbgRegParms largeObjectBytesForSlots(sqInt numSlots); static sqInt NoDbgRegParms lengthOfformat(sqInt objOop, sqInt fmt); static sqInt logBytesPerOop(void); static sqInt maxSlotsForAlloc(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt NoDbgRegParms normalisedFormatForindexableSize(sqInt objOop, sqInt indexableSize); static sqInt numFreeLists(void); static sqInt NoDbgRegParms objectAfterMaybeSlimBridgelimit(sqInt objOop, sqInt limit); @@ -1001,7 +1002,7 @@ sqInt extraVMMemory; sqInt ffiExceptionResponse; sqInt inIOProcessEvents; struct VirtualMachine* interpreterProxy; -const char *interpreterVersion = "Open Smalltalk ImageChecker VM [ImageLeakChecker VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk ImageChecker VM [ImageLeakChecker VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; int displayDepth; int displayHeight; @@ -1743,31 +1744,6 @@ bytesInBody(sqInt objOop) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* Spur64BitMemoryManager>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ - double result; - sqInt tagBits; - - if (((tagBits = oop & (tagMask()))) != 0) { - if (tagBits == (smallFloatTag())) { - return smallFloatValueOf(oop); - } - } - else { - if ((classIndexOf(oop)) == ClassFloatCompactIndex) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - } - return 0.0; -} - - /* Answer the default amount of memory to allocate for the eden space. The actual value can be set via vmParameterAt: and/or a preference in the ini file. @@ -1993,6 +1969,17 @@ integerObjectOf(sqInt value) return ((((usqInt)value)) << (numTagBits())) + 1; } + /* Spur64BitMemoryManager>>#isFloatInstance: */ +static sqInt NoDbgRegParms +isFloatInstance(sqInt oop) +{ + sqInt tagBits; + + return (((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : (classIndexOf(oop)) == ClassFloatCompactIndex); +} + /* Spur64BitMemoryManager>>#isImmediateFloat: */ static sqInt NoDbgRegParms isImmediateFloat(sqInt oop) @@ -2152,6 +2139,27 @@ maxSlotsForAlloc(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* Spur64BitMemoryManager>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + if ((aFloatOop & (tagMask())) != 0) { + result = smallFloatValueOf(aFloatOop); + } + else { + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + } + return result; +} + + /* Answer the format for an objOop clone with indexableSize. Needs to work for longFormat and arrayFormat only. */ @@ -5381,7 +5389,7 @@ findStringBeginningWith(char *aCString) if (!(oopisLessThan(obj1, GIV(endOfMemory)))) break; assert((long64At(obj1)) != 0); if (isEnumerableObject(obj1)) { - if (objectequalsStringofSize(obj1, aCString, aCStringStrlen)) { + if (objectbeginsWithStringofSize(obj1, aCString, aCStringStrlen)) { printHex(obj1); /* begin space */ printChar(' '); @@ -13109,8 +13117,9 @@ static sqInt NoDbgRegParms objectequalsStringofSize(sqInt anOop, char *aCString, sqInt aCStringStrlen) { return (isBytes(anOop)) + && ((!(isCompiledMethod(anOop))) && (((numBytesOfBytes(anOop)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(anOop), aCStringStrlen)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), aCStringStrlen)) == 0))); } /* StackInterpreter>>#penultimateLiteralOf: */ @@ -13457,6 +13466,8 @@ printOopShortInner(sqInt oop) double f; char *name; sqInt nameLen; + double result; + sqInt tagBits; sqInt target; sqInt theClass1; @@ -13478,7 +13489,7 @@ printOopShortInner(sqInt oop) if (((oop & (smallFloatTag())) != 0)) { fprintf(GIV(transcript), "%g(0x%" PRIxSQINT ")", - dbgFloatValueOf(oop), + noFailFloatValueOf(oop), oop); return; } @@ -13504,9 +13515,18 @@ printOopShortInner(sqInt oop) ((void *)target)); return; } - if (isFloatObject(oop)) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : (classIndexOf(oop)) == ClassFloatCompactIndex)) { /* begin printFloat: */ - f = dbgFloatValueOf(oop); + assert(isFloatInstance(oop)); + if ((oop & (tagMask())) != 0) { + result = smallFloatValueOf(oop); + } + else { + fetchFloatAtinto(oop + BaseHeaderSize, result); + } + f = result; fprintf(GIV(transcript), "%g", f); @@ -13617,6 +13637,7 @@ printOop(sqInt oop) sqInt length; usqInt numSlots; usqInt startIP; + sqInt tagBits; length = 0; if (isImmediate(oop)) { @@ -13647,10 +13668,12 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (fetchPointerofObject(ClassFloat, GIV(specialObjectsOop)))) { + if ((((tagBits = oop & (tagMask()))) != 0 + ? tagBits == (smallFloatTag()) + : (classIndexOf(oop)) == ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } fmt = formatOf(oop); diff --git a/src/v3.cog/cointerp.c b/src/v3.cog/cointerp.c index 444edda49f..0775fc4108 100644 --- a/src/v3.cog/cointerp.c +++ b/src/v3.cog/cointerp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -684,6 +684,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -878,7 +879,6 @@ static sqInt checkHeapIntegrity(void); extern sqInt checkOkayOop(usqInt oop); static sqInt NoDbgRegParms checkOopIntegritynamed(sqInt obj, char *name); extern sqInt cloneObject(sqInt obj); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); static sqInt NoDbgRegParms eeInstantiateAndInitializeClassindexableSize(sqInt classPointer, sqInt size); extern sqInt eeInstantiateClassIndexformatnumSlots(sqInt compactClassIndex, sqInt objFormat, sqInt numSlots); @@ -1022,6 +1022,7 @@ static sqInt NoDbgRegParms isCompiledMethodHeader(sqInt objHeader); extern sqInt isCompiledMethod(sqInt oop); static sqInt NoDbgRegParms isContextNonImm(sqInt oop); static sqInt NoDbgRegParms isContext(sqInt oop); +static sqInt NoDbgRegParms isFloatInstance(sqInt oop); extern sqInt isImmediate(sqInt anOop); extern sqInt isIndexable(sqInt oop); extern sqInt isInMemory(sqInt address); @@ -1060,6 +1061,7 @@ static sqInt NoDbgRegParms lowestFreeAfter(sqInt chunk); extern sqInt markAndTrace(sqInt oop); extern sqInt minSlotsForShortening(void); extern sqInt nilObject(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt NoDbgRegParms noFixupFollowFieldofObject(sqInt fieldIndex, sqInt anObject); extern sqInt noShiftCompactClassIndexOfHeader(sqInt header); static sqInt NoDbgRegParms numBytesOfBytes(sqInt objOop); @@ -1808,7 +1810,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2271,7 +2273,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[SqueakV3] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[SqueakV3] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -13836,8 +13838,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((pluginName & 1) == 0) && (((((usqInt)((longAt(pluginName)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -19130,8 +19133,9 @@ primitiveUnloadModule(void) } if ((((moduleName & 1) == 0) && (((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -20412,58 +20416,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -23570,6 +23541,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -23905,114 +23898,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l3; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l3: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -25118,59 +25044,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } @@ -26695,58 +26588,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -29733,58 +29593,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -30047,8 +29874,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -30056,48 +29883,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -31024,17 +30821,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -31047,37 +30842,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -31085,9 +30854,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -32950,44 +32717,6 @@ cloneObject(sqInt obj) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* NewObjectMemory>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - double result; - - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Return the default amount of memory to allocate before doing a scavenge (incremental GC). This default suits Qwaq Forums (specifically loading). The actual value @@ -33855,8 +33584,9 @@ findStringBeginningWith(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -33926,8 +33656,9 @@ findString(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -39099,6 +38830,35 @@ isContext(sqInt oop) && (((((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F) == ClassMethodContextCompactIndex); } + +/* 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>>#isFloatInstance: */ +static sqInt NoDbgRegParms +isFloatInstance(sqInt oop) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt ccIndex; + sqInt classOop; + + /* begin is:instanceOf:compactClassIndex: */ + classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); + if ((oop & 1)) { + return 0; + } + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + assert(!((oop & 1))); + /* begin compactClassIndexOf: */ + ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; + if (ccIndex == 0) { + return ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; + } + return ClassFloatCompactIndex == ccIndex; + return classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); +} + /* ObjectMemory>>#isImmediate: */ sqInt isImmediate(sqInt anOop) @@ -40089,6 +39849,22 @@ nilObject(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* ObjectMemory>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Spur compatibility; in V3 this is a synonym for fetchPointer:ofObject: */ /* ObjectMemory>>#noFixupFollowField:ofObject: */ @@ -47683,8 +47459,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((anOop & 1) == 0) && (((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -49760,12 +49537,9 @@ printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt ccIndex; sqInt ccIndex1; - sqInt ccIndex2; sqInt classLookupKey; sqInt classOop; - sqInt classOop1; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -49809,30 +49583,9 @@ printOopShortInner(sqInt oop) } if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { /* begin printFloat: */ - classOop1 = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l10; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex2 = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex2 == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop1; - goto l10; - } - isFloat = ClassFloatCompactIndex == ccIndex2; - goto l10; - isFloat = classOop1 == (fetchPointerofObject(ccIndex2 - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l10: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l11; - } - f = 0.0; - l11: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -50023,10 +49776,10 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/v3.cog/cointerp.h b/src/v3.cog/cointerp.h index 97761ff959..084a14871e 100644 --- a/src/v3.cog/cointerp.h +++ b/src/v3.cog/cointerp.h @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ @@ -162,6 +162,7 @@ extern sqInt literalCountOf(sqInt methodPointer); extern sqInt markAndTrace(sqInt oop); extern sqInt minSlotsForShortening(void); extern sqInt nilObject(void); +extern double noFailFloatValueOf(sqInt aFloatOop); extern sqInt noShiftCompactClassIndexOfHeader(sqInt header); extern sqInt numBytesOf(sqInt objOop); extern sqInt numSlotsOf(sqInt obj); diff --git a/src/v3.cog/gcc3x-cointerp.c b/src/v3.cog/gcc3x-cointerp.c index 4f91e262c5..30b9a3bf24 100644 --- a/src/v3.cog/gcc3x-cointerp.c +++ b/src/v3.cog/gcc3x-cointerp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -687,6 +687,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -881,7 +882,6 @@ static sqInt checkHeapIntegrity(void); extern sqInt checkOkayOop(usqInt oop); static sqInt NoDbgRegParms checkOopIntegritynamed(sqInt obj, char *name); extern sqInt cloneObject(sqInt obj); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); static sqInt NoDbgRegParms eeInstantiateAndInitializeClassindexableSize(sqInt classPointer, sqInt size); extern sqInt eeInstantiateClassIndexformatnumSlots(sqInt compactClassIndex, sqInt objFormat, sqInt numSlots); @@ -1025,6 +1025,7 @@ static sqInt NoDbgRegParms isCompiledMethodHeader(sqInt objHeader); extern sqInt isCompiledMethod(sqInt oop); static sqInt NoDbgRegParms isContextNonImm(sqInt oop); static sqInt NoDbgRegParms isContext(sqInt oop); +static sqInt NoDbgRegParms isFloatInstance(sqInt oop); extern sqInt isImmediate(sqInt anOop); extern sqInt isIndexable(sqInt oop); extern sqInt isInMemory(sqInt address); @@ -1063,6 +1064,7 @@ static sqInt NoDbgRegParms lowestFreeAfter(sqInt chunk); extern sqInt markAndTrace(sqInt oop); extern sqInt minSlotsForShortening(void); extern sqInt nilObject(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt NoDbgRegParms noFixupFollowFieldofObject(sqInt fieldIndex, sqInt anObject); extern sqInt noShiftCompactClassIndexOfHeader(sqInt header); static sqInt NoDbgRegParms numBytesOfBytes(sqInt objOop); @@ -1811,7 +1813,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -2274,7 +2276,7 @@ sqInt debugCallbackReturns; sqInt suppressHeartbeatFlag; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Cog[SqueakV3] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Cog[SqueakV3] VM [CoInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -13845,8 +13847,9 @@ methodHasPrimitiveInPrimTracePlugin(sqInt aMethodObj) len = strlen(primTracePluginName); ok = (((pluginName & 1) == 0) && (((((usqInt)((longAt(pluginName)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(pluginName)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(pluginName)) == len) - && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0)); + && ((strncmp(primTracePluginName, firstIndexableField(pluginName), len)) == 0))); return ok; } @@ -19139,8 +19142,9 @@ primitiveUnloadModule(void) } if ((((moduleName & 1) == 0) && (((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); @@ -20421,58 +20425,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -23579,6 +23550,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -23914,114 +23907,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l3; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l3: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -25127,59 +25053,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } @@ -26704,58 +26597,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -29742,58 +29602,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -30056,8 +29883,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -30065,48 +29892,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -31033,17 +30830,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -31056,37 +30851,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -31094,9 +30863,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -32959,44 +32726,6 @@ cloneObject(sqInt obj) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* NewObjectMemory>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - double result; - - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Return the default amount of memory to allocate before doing a scavenge (incremental GC). This default suits Qwaq Forums (specifically loading). The actual value @@ -33864,8 +33593,9 @@ findStringBeginningWith(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -33935,8 +33665,9 @@ findString(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -39108,6 +38839,35 @@ isContext(sqInt oop) && (((((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F) == ClassMethodContextCompactIndex); } + +/* 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>>#isFloatInstance: */ +static sqInt NoDbgRegParms +isFloatInstance(sqInt oop) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt ccIndex; + sqInt classOop; + + /* begin is:instanceOf:compactClassIndex: */ + classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); + if ((oop & 1)) { + return 0; + } + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + assert(!((oop & 1))); + /* begin compactClassIndexOf: */ + ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; + if (ccIndex == 0) { + return ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; + } + return ClassFloatCompactIndex == ccIndex; + return classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); +} + /* ObjectMemory>>#isImmediate: */ sqInt isImmediate(sqInt anOop) @@ -40098,6 +39858,22 @@ nilObject(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* ObjectMemory>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Spur compatibility; in V3 this is a synonym for fetchPointer:ofObject: */ /* ObjectMemory>>#noFixupFollowField:ofObject: */ @@ -47692,8 +47468,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((anOop & 1) == 0) && (((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -49769,12 +49546,9 @@ printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt ccIndex; sqInt ccIndex1; - sqInt ccIndex2; sqInt classLookupKey; sqInt classOop; - sqInt classOop1; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -49818,30 +49592,9 @@ printOopShortInner(sqInt oop) } if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { /* begin printFloat: */ - classOop1 = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l10; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex2 = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex2 == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop1; - goto l10; - } - isFloat = ClassFloatCompactIndex == ccIndex2; - goto l10; - isFloat = classOop1 == (fetchPointerofObject(ccIndex2 - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l10: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l11; - } - f = 0.0; - l11: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -50032,10 +49785,10 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ diff --git a/src/v3.stack/gcc3x-interp.c b/src/v3.stack/gcc3x-interp.c index f862f711cf..4ae8b870be 100644 --- a/src/v3.stack/gcc3x-interp.c +++ b/src/v3.stack/gcc3x-interp.c @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -364,6 +364,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -560,7 +561,6 @@ extern sqInt checkOkayOop(usqInt oop); static sqInt NoDbgRegParms checkOopIntegritynamed(sqInt obj, char *name); static void clearLeakMapAndMapAccessibleObjects(void); extern sqInt cloneObject(sqInt obj); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt eeInstantiateClassIndexformatnumSlots(sqInt compactClassIndex, sqInt objFormat, sqInt numSlots); static sqInt NoDbgRegParms eeInstantiateClassindexableSize(sqInt classPointer, sqInt size); @@ -703,6 +703,7 @@ static sqInt NoDbgRegParms isCompiledMethodHeader(sqInt objHeader); extern sqInt isCompiledMethod(sqInt oop); static sqInt NoDbgRegParms isContextNonImm(sqInt oop); static sqInt NoDbgRegParms isContext(sqInt oop); +static sqInt NoDbgRegParms isFloatInstance(sqInt oop); extern sqInt isImmediate(sqInt anOop); extern sqInt isIndexable(sqInt oop); extern sqInt isInMemory(sqInt address); @@ -740,6 +741,7 @@ extern sqInt markAndTrace(sqInt oop); static sqInt NoDbgRegParms methodHeaderOf(sqInt methodObj); extern sqInt minSlotsForShortening(void); extern sqInt nilObject(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt NoDbgRegParms noFixupFollowFieldofObject(sqInt fieldIndex, sqInt anObject); extern sqInt noShiftCompactClassIndexOfHeader(sqInt header); static sqInt NoDbgRegParms numBytesOfBytes(sqInt objOop); @@ -1518,7 +1520,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -1976,7 +1978,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -9206,58 +9208,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -11971,6 +11940,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -12409,114 +12400,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l3; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l3: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -13623,59 +13547,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } @@ -15296,58 +15187,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -18674,58 +18532,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -19012,8 +18837,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -19021,48 +18846,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -19989,17 +19784,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -20012,37 +19805,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -20050,9 +19817,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -21868,44 +21633,6 @@ cloneObject(sqInt obj) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* NewObjectMemory>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - double result; - - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Return the default amount of memory to allocate before doing a scavenge (incremental GC). This default suits Qwaq Forums (specifically loading). The actual value @@ -22604,8 +22331,9 @@ findStringBeginningWith(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -22675,8 +22403,9 @@ findString(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -27808,6 +27537,35 @@ isContext(sqInt oop) && (((((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F) == ClassMethodContextCompactIndex); } + +/* 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>>#isFloatInstance: */ +static sqInt NoDbgRegParms +isFloatInstance(sqInt oop) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt ccIndex; + sqInt classOop; + + /* begin is:instanceOf:compactClassIndex: */ + classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); + if ((oop & 1)) { + return 0; + } + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + assert(!((oop & 1))); + /* begin compactClassIndexOf: */ + ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; + if (ccIndex == 0) { + return ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; + } + return ClassFloatCompactIndex == ccIndex; + return classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); +} + /* ObjectMemory>>#isImmediate: */ sqInt isImmediate(sqInt anOop) @@ -28755,6 +28513,22 @@ nilObject(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* ObjectMemory>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Spur compatibility; in V3 this is a synonym for fetchPointer:ofObject: */ /* ObjectMemory>>#noFixupFollowField:ofObject: */ @@ -36767,8 +36541,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((anOop & 1) == 0) && (((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -39012,12 +38787,9 @@ printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt ccIndex; sqInt ccIndex1; - sqInt ccIndex2; sqInt classLookupKey; sqInt classOop; - sqInt classOop1; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -39061,30 +38833,9 @@ printOopShortInner(sqInt oop) } if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { /* begin printFloat: */ - classOop1 = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l10; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex2 = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex2 == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop1; - goto l10; - } - isFloat = ClassFloatCompactIndex == ccIndex2; - goto l10; - isFloat = classOop1 == (fetchPointerofObject(ccIndex2 - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l10: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l11; - } - f = 0.0; - l11: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -39275,10 +39026,10 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -47544,8 +47295,9 @@ primitiveUnloadModule(void) } if ((((moduleName & 1) == 0) && (((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck(); diff --git a/src/v3.stack/interp.c b/src/v3.stack/interp.c index 9a73ff0fa0..9ab1cb3a55 100644 --- a/src/v3.stack/interp.c +++ b/src/v3.stack/interp.c @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 from - StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 + StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 */ -static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3380 uuid: c077b429-f897-47ad-92b4-563c161255f3 " __DATE__ ; +static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.3382 uuid: 936441c0-8b36-4f43-a893-4c90667b5b58 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -361,6 +361,7 @@ EXPORT(void) primitiveCompareWith(void); static void primitiveConstantFill(void); static void primitiveControlVMProfiling(void); static void primitiveCopyObject(void); +static void primitiveCosine(void); EXPORT(sqInt) primitiveCrashVM(void); EXPORT(sqInt) primitiveDisablePowerManager(void); static void primitiveDiv(void); @@ -557,7 +558,6 @@ extern sqInt checkOkayOop(usqInt oop); static sqInt NoDbgRegParms checkOopIntegritynamed(sqInt obj, char *name); static void clearLeakMapAndMapAccessibleObjects(void); extern sqInt cloneObject(sqInt obj); -static double NoDbgRegParms dbgFloatValueOf(sqInt oop); static sqInt defaultEdenBytes(void); extern sqInt eeInstantiateClassIndexformatnumSlots(sqInt compactClassIndex, sqInt objFormat, sqInt numSlots); static sqInt NoDbgRegParms eeInstantiateClassindexableSize(sqInt classPointer, sqInt size); @@ -700,6 +700,7 @@ static sqInt NoDbgRegParms isCompiledMethodHeader(sqInt objHeader); extern sqInt isCompiledMethod(sqInt oop); static sqInt NoDbgRegParms isContextNonImm(sqInt oop); static sqInt NoDbgRegParms isContext(sqInt oop); +static sqInt NoDbgRegParms isFloatInstance(sqInt oop); extern sqInt isImmediate(sqInt anOop); extern sqInt isIndexable(sqInt oop); extern sqInt isInMemory(sqInt address); @@ -737,6 +738,7 @@ extern sqInt markAndTrace(sqInt oop); static sqInt NoDbgRegParms methodHeaderOf(sqInt methodObj); extern sqInt minSlotsForShortening(void); extern sqInt nilObject(void); +extern double noFailFloatValueOf(sqInt aFloatOop); static sqInt NoDbgRegParms noFixupFollowFieldofObject(sqInt fieldIndex, sqInt anObject); extern sqInt noShiftCompactClassIndexOfHeader(sqInt header); static sqInt NoDbgRegParms numBytesOfBytes(sqInt objOop); @@ -1515,7 +1517,7 @@ static void (*primitiveTable[MaxPrimitiveIndex + 2 /* 584 */])(void) = { /* 147 */ (void (*)(void))0, /* 148 */ primitiveClone, /* 149 */ primitiveGetAttribute, - /* 150 */ (void (*)(void))0, + /* 150 */ primitiveCosine, /* 151 */ (void (*)(void))0, /* 152 */ (void (*)(void))0, /* 153 */ (void (*)(void))0, @@ -1973,7 +1975,7 @@ sqInt debugCallbackInvokes; sqInt debugCallbackReturns; sqInt cannotDeferDisplayUpdates; sqInt checkedPluginName; -const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3380]"; +const char *interpreterVersion = "Open Smalltalk Stack VM [StackInterpreterPrimitives VMMaker.oscog-eem.3382]"; sqInt suppressHeartbeatFlag; char expensiveAsserts = 0; int (*showSurfaceFn)(sqIntptr_t, int, int, int, int); @@ -9197,58 +9199,25 @@ primitiveAllObjects(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes arctan of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveArctan */ static void primitiveArctan(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(atan(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(atan(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -11962,6 +11931,28 @@ primitiveCopyObject(void) } +/* Computes cosine of float receiver; receiver *must* be a float instance. */ + + /* InterpreterPrimitives>>#primitiveCosine */ +static void +primitiveCosine(void) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aValue; + double doubleValue; + sqInt rcvr; + double result; + + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(cos(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); +} + + /* Crash the VM by indirecting through a null pointer. If the sole argument is true crash in this thread, and if it is false crash in a new thread. If the argument is an integer use the method that implies. @@ -12400,114 +12391,47 @@ primitiveExitToDebugger(void) /* Computes E raised to the receiver power. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExp */ static void primitiveExp(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(exp(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(exp(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } -/* Exponent part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Exponent part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveExponent */ static void primitiveExponent(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; + double doubleValue; int pwr; - double rcvr; + sqInt rcvr; double result; pwr = 0; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l3; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l3: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - - /* rcvr = frac * 2^pwr, where frac is in [0.5..1.0) */ - frexp(rcvr, (&pwr)); - longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + frexp(doubleValue, (&pwr)); + longAtPointerput(GIV(stackPointer), (((usqInt)(pwr - 1) << 1) | 1)); } @@ -13614,59 +13538,26 @@ primitiveFormPrint(void) } -/* Fractional part of this float. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Fractional part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveFractionalPart */ static void primitiveFractionalPart(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; double trunc; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(modf(rcvr, (&trunc))); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(modf(rcvr, (&trunc))); + longAtPointerput(GIV(stackPointer), aValue); } @@ -15287,58 +15178,25 @@ primitiveLocalMicrosecondClock(void) } -/* Natural log. - N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 */ +/* Natural log of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveLogN */ static void primitiveLogN(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(log(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(log(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } @@ -18665,58 +18523,25 @@ primitiveSignalAtBytesLeft(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Computes sine of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveSine */ static void primitiveSine(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if (!GIV(primFailCode)) { - /* begin stackTopPut: */ - aValue = floatObjectOf(sin(rcvr)); - longAtPointerput(GIV(stackPointer), aValue); - } + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + /* begin stackTopPut: */ + aValue = floatObjectOf(sin(doubleValue)); + longAtPointerput(GIV(stackPointer), aValue); } /* InterpreterPrimitives>>#primitiveSize */ @@ -19003,8 +18828,8 @@ primitiveSpecialObjectsOop(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 +/* Computes square root of float receiver; receiver *must* be a float + instance. */ /* InterpreterPrimitives>>#primitiveSquareRoot */ @@ -19012,48 +18837,18 @@ static void primitiveSquareRoot(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt aValue; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; - double rcvr; + double doubleValue; + sqInt rcvr; double result; - /* begin stackFloatValue: */ - oop = longAt(GIV(stackPointer) + (0 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - rcvr = result; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end stackFloatValue: */; - if ((!GIV(primFailCode)) - && (rcvr >= 0.0)) { + rcvr = longAt(GIV(stackPointer)); + /* begin noFailFloatValueOf: */ + assert(isFloatInstance(rcvr)); + fetchFloatAtinto(rcvr + BaseHeaderSize, result); + doubleValue = result; + if (doubleValue >= 0.0) { /* begin stackTopPut: */ - aValue = floatObjectOf(sqrt(rcvr)); + aValue = floatObjectOf(sqrt(doubleValue)); longAtPointerput(GIV(stackPointer), aValue); } else { @@ -19980,17 +19775,15 @@ primitiveTestShortenIndexableSize(void) #endif /* TestingPrimitives */ -/* Multiply the receiver by the power of the argument. */ +/* Multiply the receiver by the power of the argument. + Receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTimesTwoPower */ static void primitiveTimesTwoPower(void) { DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt aFloatOop; sqInt arg; - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - sqInt oop; double rcvr; double result; double result1; @@ -20003,37 +19796,11 @@ primitiveTimesTwoPower(void) return; } arg = (arg >> 1); - /* begin floatValueOf: */ - oop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result1); - rcvr = result1; - goto l4; - } - /* begin primitiveFail */ - if (!GIV(primFailCode)) { - GIV(primFailCode) = 1; - } - rcvr = 0.0; - l4: /* end floatValueOf: */; + /* begin noFailFloatValueOf: */ + aFloatOop = longAt(GIV(stackPointer) + (1 * BytesPerWord)); + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result1); + rcvr = result1; result = ldexp(rcvr, ((int) arg)); /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((1) * BytesPerWord)), floatObjectOf(result)); @@ -20041,9 +19808,7 @@ primitiveTimesTwoPower(void) } -/* N.B. IMO we should be able to assume the receiver is a float because this - primitive is specific to floats. eem 2/13/2017 - */ +/* Integral part of float receiver; receiver *must* be a float instance. */ /* InterpreterPrimitives>>#primitiveTruncated */ static void @@ -21859,44 +21624,6 @@ cloneObject(sqInt obj) } -/* Answer the C double precision floating point value of the argument, - or if it is not, answer 0. */ - - /* NewObjectMemory>>#dbgFloatValueOf: */ -static double NoDbgRegParms -dbgFloatValueOf(sqInt oop) -{ DECL_MAYBE_SQ_GLOBAL_STRUCT - sqInt ccIndex; - sqInt classOop; - sqInt isFloat; - double result; - - /* begin is:instanceOf:compactClassIndex: */ - classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l2; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; - goto l2; - } - isFloat = ClassFloatCompactIndex == ccIndex; - goto l2; - isFloat = classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l2: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - return result; - } - return 0.0; -} - - /* Return the default amount of memory to allocate before doing a scavenge (incremental GC). This default suits Qwaq Forums (specifically loading). The actual value @@ -22595,8 +22322,9 @@ findStringBeginningWith(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) - && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) + && (((numBytesOfBytes(obj)) >= aCStringStrlen) + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -22666,8 +22394,9 @@ findString(char *aCString) else { if ((((obj & 1) == 0) && (((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(obj)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(obj)) == aCStringStrlen) - && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0))) { + && ((strncmp(aCString, firstIndexableField(obj), aCStringStrlen)) == 0)))) { printHex(obj); /* begin space */ printChar(' '); @@ -27799,6 +27528,35 @@ isContext(sqInt oop) && (((((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F) == ClassMethodContextCompactIndex); } + +/* 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>>#isFloatInstance: */ +static sqInt NoDbgRegParms +isFloatInstance(sqInt oop) +{ DECL_MAYBE_SQ_GLOBAL_STRUCT + sqInt ccIndex; + sqInt classOop; + + /* begin is:instanceOf:compactClassIndex: */ + classOop = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); + if ((oop & 1)) { + return 0; + } + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + assert(!((oop & 1))); + /* begin compactClassIndexOf: */ + ccIndex = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; + if (ccIndex == 0) { + return ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop; + } + return ClassFloatCompactIndex == ccIndex; + return classOop == (fetchPointerofObject(ccIndex - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); +} + /* ObjectMemory>>#isImmediate: */ sqInt isImmediate(sqInt anOop) @@ -28746,6 +28504,22 @@ nilObject(void) } +/* Answer the C double precision floating point value of the argument, + which *must* be something for which self isFloatInstance: answers true. + Note: May be called by translated primitive code. */ + + /* ObjectMemory>>#noFailFloatValueOf: */ +double +noFailFloatValueOf(sqInt aFloatOop) +{ + double result; + + assert(isFloatInstance(aFloatOop)); + fetchFloatAtinto(aFloatOop + BaseHeaderSize, result); + return result; +} + + /* Spur compatibility; in V3 this is a synonym for fetchPointer:ofObject: */ /* ObjectMemory>>#noFixupFollowField:ofObject: */ @@ -36758,8 +36532,9 @@ objectequalsString(sqInt anOop, char *aCString) len = strlen(aCString); return (((anOop & 1) == 0) && (((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(anOop)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(anOop)) == len) - && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0)); + && ((strncmp(aCString, firstIndexableField(anOop), len)) == 0))); } @@ -39003,12 +38778,9 @@ printOopShortInner(sqInt oop) { DECL_MAYBE_SQ_GLOBAL_STRUCT sqInt ccIndex; sqInt ccIndex1; - sqInt ccIndex2; sqInt classLookupKey; sqInt classOop; - sqInt classOop1; double f; - sqInt isFloat; usqInt n; char *name; sqInt nameLen; @@ -39052,30 +38824,9 @@ printOopShortInner(sqInt oop) } if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { /* begin printFloat: */ - classOop1 = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))); - if ((oop & 1)) { - isFloat = 0; - goto l10; - } - /* begin isClassOfNonImm:equalTo:compactClassIndex: */ - assert(!((oop & 1))); - /* begin compactClassIndexOf: */ - ccIndex2 = (((usqInt)((longAt(oop)))) >> (compactClassFieldLSB())) & 0x1F; - if (ccIndex2 == 0) { - isFloat = ((longAt(oop - BaseHeaderSize)) & AllButTypeMask) == classOop1; - goto l10; - } - isFloat = ClassFloatCompactIndex == ccIndex2; - goto l10; - isFloat = classOop1 == (fetchPointerofObject(ccIndex2 - 1, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(CompactClasses) << (shiftForWord()))))))); - l10: /* end is:instanceOf:compactClassIndex: */; - if (isFloat) { - fetchFloatAtinto(oop + BaseHeaderSize, result); - f = result; - goto l11; - } - f = 0.0; - l11: /* end dbgFloatValueOf: */; + assert(isFloatInstance(oop)); + fetchFloatAtinto(oop + BaseHeaderSize, result); + f = result; fprintf(GIV(transcript), "%g", f); @@ -39266,10 +39017,10 @@ printOop(sqInt oop) ((void *)oop), ((int) length), className); - if (cls == (splObj(ClassFloat))) { + if (isinstanceOfcompactClassIndex(oop, longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (((int)((usqInt)(ClassFloat) << (shiftForWord()))))), ClassFloatCompactIndex)) { fprintf(GIV(transcript), "\n%g\n", - dbgFloatValueOf(oop)); + noFailFloatValueOf(oop)); return; } /* begin formatOf: */ @@ -47535,8 +47286,9 @@ primitiveUnloadModule(void) } if ((((moduleName & 1) == 0) && (((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstByteFormat()))) + && ((!(((((usqInt)((longAt(moduleName)))) >> (instFormatFieldLSB())) & 15) >= (firstCompiledMethodFormat()))) && (((numBytesOfBytes(moduleName)) == moduleLength) - && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0))) { + && ((strncmp("SqueakFFIPrims", firstIndexableField(moduleName), moduleLength)) == 0)))) { primitiveCalloutPointer = ((void *) -1); } forceInterruptCheck();