Author: piumarta Date: 2012-09-12 15:00:41 -0700 (Wed, 12 Sep 2012) New Revision: 2592
Modified: trunk/platforms/unix/src/vm/interp.c trunk/platforms/unix/src/vm/interp.h Log: update to version 4.10.2
Modified: trunk/platforms/unix/src/vm/interp.c =================================================================== --- trunk/platforms/unix/src/vm/interp.c 2012-09-12 21:59:25 UTC (rev 2591) +++ trunk/platforms/unix/src/vm/interp.c 2012-09-12 22:00:41 UTC (rev 2592) @@ -1,5 +1,5 @@ -/* Automatically generated from Squeak on 30 July 2012 4:52:23 pm - by VMMaker 4.9.8 +/* Automatically generated from Squeak on 13 September 2012 6:51:39 am + by VMMaker 4.10.2 */ #if 1 # define SQ_USE_GLOBAL_STRUCT 1 @@ -111,7 +111,9 @@ #define ClassFloat 9 #define ClassInteger 5 #define ClassLargeNegativeInteger 42 +#define ClassLargeNegativeIntegerCompactIndex 4 #define ClassLargePositiveInteger 13 +#define ClassLargePositiveIntegerCompactIndex 5 #define ClassMessage 15 #define ClassMethodContext 10 #define ClassPoint 12 @@ -156,7 +158,7 @@ #define InitialIPIndex 4 #define InstanceSpecificationIndex 2 #define InstructionPointerIndex 1 -#define InterpreterSourceVersion "4.9.8" +#define InterpreterSourceVersion "4.10.2" #define InvokeCallbackSelector 53 #define LargeContextBit 262144 #define LastLinkIndex 1 @@ -393,6 +395,7 @@ sqInt isIndexable(sqInt oop); sqInt isIntegerObject(sqInt objectPointer); sqInt isIntegerValue(sqInt intValue); +sqInt isNegativeIntegerValueOf(sqInt oop); sqInt isPointers(sqInt oop); sqInt isWeak(sqInt oop); sqInt isWords(sqInt oop); @@ -410,6 +413,8 @@ sqInt lookupMethodInDictionary(sqInt dictionary); sqInt lookupMethodNoMNUEtcInClass(sqInt class); sqInt lowestFreeAfter(sqInt chunk); +sqInt magnitude64BitIntegerForneg(usqLong magnitude, sqInt isNegative); +usqLong magnitude64BitValueOf(sqInt oop); sqInt makePointwithxValueyValue(sqInt xValue, sqInt yValue); sqInt mapPointersInObjectsFromto(sqInt memStart, sqInt memEnd); sqInt markAndTrace(sqInt oop); @@ -599,6 +604,9 @@ sqInt primitiveListExternalModule(void); sqInt primitiveLoadImageSegment(void); sqInt primitiveLoadInstVar(void); +#pragma export on +EXPORT(sqInt) primitiveLocalMicrosecondClock(void); +#pragma export off sqInt primitiveLogN(void); sqInt primitiveLowSpaceSemaphore(void); sqInt primitiveMakePoint(void); @@ -658,6 +666,9 @@ EXPORT(sqInt) primitiveQuoLargeIntegers(void); #pragma export off sqInt primitiveRelinquishProcessor(void); +#pragma export on +EXPORT(sqInt) primitiveRemLargeIntegers(void); +#pragma export off sqInt primitiveResponse(void); sqInt primitiveResume(void); #pragma export on @@ -707,6 +718,9 @@ sqInt primitiveTestDisplayDepth(void); sqInt primitiveTimesTwoPower(void); sqInt primitiveTruncated(void); +#pragma export on +EXPORT(sqInt) primitiveUTCMicrosecondClock(void); +#pragma export off sqInt primitiveUnloadModule(void); #pragma export on EXPORT(sqInt) primitiveUtcWithOffset(void); @@ -1160,8 +1174,8 @@ /* 237*/ (void *)primitiveFail, /* 238*/ (void *)primitiveFail, /* 239*/ (void *)primitiveFail, - /* 240*/ (void *)primitiveFail, - /* 241*/ (void *)primitiveFail, + /* 240*/ (void *)primitiveUTCMicrosecondClock, + /* 241*/ (void *)primitiveLocalMicrosecondClock, /* 242*/ (void *)primitiveFail, /* 243*/ (void *)primitiveFail, /* 244*/ (void *)primitiveFail, @@ -13036,6 +13050,60 @@ }
+/* Answer true if integer object is negative. + Fail if object pointed by oop i not an integer. */ + +sqInt isNegativeIntegerValueOf(sqInt oop) { +register struct foo * foo = &fum; + sqInt ok; + sqInt smallInt; + sqInt classOop; + sqInt ccIndex; + sqInt classOop1; + sqInt ccIndex1; + sqInt oop1; + sqInt oop2; + + if ((oop & 1)) { + smallInt = (oop >> 1); + return smallInt < 0; + } + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + /* begin fetchPointer:ofObject: */ + oop1 = foo->specialObjectsOop; + classOop = longAt((oop1 + (BASE_HEADER_SIZE)) + (ClassLargePositiveInteger << (SHIFT_FOR_WORD))); + assert(!((oop & 1))); + ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31; + ok = (ClassLargePositiveIntegerCompactIndex == 0 + ? (ccIndex == 0 + ? ((longAt(oop - (BASE_HEADER_SIZE))) & (ALL_BUT_TYPE_MASK)) == classOop + : 0) + : ClassLargePositiveIntegerCompactIndex == ccIndex); + if (ok) { + return 0; + } + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + /* begin fetchPointer:ofObject: */ + oop2 = foo->specialObjectsOop; + classOop1 = longAt((oop2 + (BASE_HEADER_SIZE)) + (ClassLargeNegativeInteger << (SHIFT_FOR_WORD))); + assert(!((oop & 1))); + ccIndex1 = (((usqInt) (longAt(oop))) >> 12) & 31; + ok = (ClassLargeNegativeIntegerCompactIndex == 0 + ? (ccIndex1 == 0 + ? ((longAt(oop - (BASE_HEADER_SIZE))) & (ALL_BUT_TYPE_MASK)) == classOop1 + : 0) + : ClassLargeNegativeIntegerCompactIndex == ccIndex1); + if (ok) { + return 1; + } + /* begin primitiveFail */ + if (foo->primFailCode == 0) { + foo->primFailCode = 1; + } + return 0; +} + + /* Answer true if the argument has only fields that can hold oops. See comment in formatOf: */
sqInt isPointers(sqInt oop) { @@ -13529,6 +13597,160 @@ }
+/* Return a Large Integer object for the given integer magnitude and sign */ + +sqInt magnitude64BitIntegerForneg(usqLong magnitude, sqInt isNegative) { +register struct foo * foo = &fum; + usqInt highWord; + sqInt i; + sqInt intValue; + sqInt isSmall; + sqInt largeClass; + sqInt newLargeInteger; + sqInt smallVal; + sqInt sz; + sqInt oop; + sqInt oop1; + + isSmall = (isNegative + ? magnitude <= 1073741824 + : magnitude < 1073741824); + if (isSmall) { + smallVal = ((sqInt) magnitude); + if (isNegative) { + smallVal = 0 - smallVal; + } + return ((smallVal << 1) | 1); + } + if (isNegative) { + /* begin fetchPointer:ofObject: */ + oop = foo->specialObjectsOop; + largeClass = longAt((oop + (BASE_HEADER_SIZE)) + (ClassLargeNegativeInteger << (SHIFT_FOR_WORD))); + } else { + /* begin fetchPointer:ofObject: */ + oop1 = foo->specialObjectsOop; + largeClass = longAt((oop1 + (BASE_HEADER_SIZE)) + (ClassLargePositiveInteger << (SHIFT_FOR_WORD))); + } + + /* shift is coerced to usqInt otherwise */ + + highWord = magnitude >> 32; + if (highWord == 0) { + sz = 4; + } else { + sz = 5; + if (!(((highWord = ((usqInt) highWord) >> 8)) == 0)) { + sz += 1; + } + if (!(((highWord = ((usqInt) highWord) >> 8)) == 0)) { + sz += 1; + } + if (!(((highWord = ((usqInt) highWord) >> 8)) == 0)) { + sz += 1; + } + } + newLargeInteger = instantiateClassindexableSize(largeClass, sz); + for (i = 0; i <= (sz - 1); i += 1) { + intValue = (magnitude >> (i * 8)) & 255; + byteAtput((newLargeInteger + (BASE_HEADER_SIZE)) + i, intValue); + } + return newLargeInteger; +} + + +/* Convert the given object into an integer value. + The object may be either a positive SmallInteger or a eight-byte LargeInteger. */ + +usqLong magnitude64BitValueOf(sqInt oop) { +register struct foo * foo = &fum; + sqInt i; + sqInt ok; + sqInt smallIntValue; + sqInt sz; + usqLong value; + sqInt classOop; + sqInt ccIndex; + sqInt classOop1; + sqInt ccIndex1; + sqInt header; + sqInt oop1; + sqInt oop2; + sqInt sz1; + + if ((oop & 1)) { + smallIntValue = (oop >> 1); + if (smallIntValue < 0) { + smallIntValue = 0 - smallIntValue; + } + return ((usqLong) smallIntValue); + } + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + /* begin fetchPointer:ofObject: */ + oop2 = foo->specialObjectsOop; + classOop1 = longAt((oop2 + (BASE_HEADER_SIZE)) + (ClassLargePositiveInteger << (SHIFT_FOR_WORD))); + assert(!((oop & 1))); + ccIndex1 = (((usqInt) (longAt(oop))) >> 12) & 31; + ok = (ClassLargePositiveIntegerCompactIndex == 0 + ? (ccIndex1 == 0 + ? ((longAt(oop - (BASE_HEADER_SIZE))) & (ALL_BUT_TYPE_MASK)) == classOop1 + : 0) + : ClassLargePositiveIntegerCompactIndex == ccIndex1); + if (!(ok)) { + /* begin isClassOfNonImm:equalTo:compactClassIndex: */ + /* begin fetchPointer:ofObject: */ + oop1 = foo->specialObjectsOop; + classOop = longAt((oop1 + (BASE_HEADER_SIZE)) + (ClassLargeNegativeInteger << (SHIFT_FOR_WORD))); + assert(!((oop & 1))); + ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31; + ok = (ClassLargeNegativeIntegerCompactIndex == 0 + ? (ccIndex == 0 + ? ((longAt(oop - (BASE_HEADER_SIZE))) & (ALL_BUT_TYPE_MASK)) == classOop + : 0) + : ClassLargeNegativeIntegerCompactIndex == ccIndex); + if (!(ok)) { + /* begin primitiveFail */ + if (foo->primFailCode == 0) { + foo->primFailCode = 1; + } + return null; + } + } + /* begin lengthOf: */ + header = longAt(oop); + /* begin lengthOf:baseHeader:format: */ + if ((header & TypeMask) == HeaderTypeSizeAndClass) { + sz1 = (longAt(oop - ((BYTES_PER_WORD) * 2))) & (LONG_SIZE_MASK); + } else { + sz1 = header & (SIZE_MASK); + } + sz1 -= header & (SIZE_4_BIT); + if (((((usqInt) header) >> 8) & 15) <= 4) { + sz = ((usqInt) (sz1 - (BASE_HEADER_SIZE))) >> (SHIFT_FOR_WORD); + goto l1; + } + if (((((usqInt) header) >> 8) & 15) < 8) { + sz = ((usqInt) (sz1 - (BASE_HEADER_SIZE))) >> 2; + goto l1; + } else { + sz = (sz1 - (BASE_HEADER_SIZE)) - (((((usqInt) header) >> 8) & 15) & 3); + goto l1; + } +l1: /* end lengthOf:baseHeader:format: */; + if (sz > (sizeof(sqLong))) { + /* begin primitiveFail */ + if (foo->primFailCode == 0) { + foo->primFailCode = 1; + } + return null; + } + value = 0; + for (i = 0; i <= (sz - 1); i += 1) { + value += (((sqLong) (byteAt((oop + (BASE_HEADER_SIZE)) + i)))) << (i * 8); + } + return value; +} + + /* make a Point xValue@yValue. We know both will be integers so no value nor root checking is needed */
@@ -15172,34 +15394,46 @@
EXPORT(sqInt) primitiveAddLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; sqInt oopResult; - sqLong result; + usqLong result; + sqInt resultIsNegative; sqInt sp;
- integerArg = signed64BitValueOf(longAt(foo->stackPointer - (0 * (BYTES_PER_WORD)))); - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); if (!(!foo->primFailCode)) { return null; } - - /* Now check overflow conditions. First is whether rcvr and arg are of the same sign. - If they are we need to check for overflow more carefully. */ - - result = integerRcvr + integerArg; - if (!((integerRcvr ^ integerArg) < 0)) { - if ((integerRcvr ^ result) < 0) { + if (aIsNegative == bIsNegative) { + if (a > (18446744073709551615U - b)) { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; } + return null; } + result = a + b; + resultIsNegative = aIsNegative; + } else { + if (a >= b) { + result = a - b; + resultIsNegative = aIsNegative; + } else { + result = b - a; + resultIsNegative = bIsNegative; + } } - if (!(!foo->primFailCode)) { - return null; - } - oopResult = signed64BitIntegerFor(result); + oopResult = magnitude64BitIntegerForneg(result, resultIsNegative); if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); @@ -15863,14 +16097,16 @@ }
-/* Primitive logical operations for large integers in 64 bit range */ +/* Primitive arithmetic operations for large integers in 64 bit range */
EXPORT(sqInt) primitiveBitShiftLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + sqInt oopRcvr; sqInt oopResult; - sqLong shifted; + usqLong result; + sqInt shift; sqInt sp; sqInt integerPointer;
@@ -15878,48 +16114,50 @@ integerPointer = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); /* begin checkedIntegerValueOf: */ if ((integerPointer & 1)) { - integerArg = (integerPointer >> 1); + shift = (integerPointer >> 1); goto l1; } else { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; } - integerArg = 0; + shift = 0; goto l1; } - integerArg = null; + shift = null; l1: /* end stackIntegerValue: */; - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); - if (!foo->primFailCode) { - if (integerArg >= 0) { - /* begin success: */ - if (!(integerArg < 64)) { - if (!foo->primFailCode) { - foo->primFailCode = 1; - } + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + a = magnitude64BitValueOf(oopRcvr); + if (!(!foo->primFailCode)) { + return null; + } + if (shift >= 0) { + + /* Protect against overflow */ + /* This is to avoid undue (usqInt) cast */ + + result = 18446744073709551615U; + if ((shift >= 64) || (a > (((usqInt) result) >> shift))) { + /* begin primitiveFail */ + if (foo->primFailCode == 0) { + foo->primFailCode = 1; } - shifted = integerRcvr << integerArg; - /* begin success: */ - if (!((shifted >> integerArg) == integerRcvr)) { - if (!foo->primFailCode) { - foo->primFailCode = 1; - } - } + return null; + } + result = a << shift; + } else { + shift = 0 - shift; + if (shift >= 64) { + result = 0; } else { - /* begin success: */ - if (!(integerArg > -64)) { - if (!foo->primFailCode) { - foo->primFailCode = 1; - } - } - shifted = integerRcvr >> (0 - integerArg); + result = ((usqInt) a) >> shift; } + if (aIsNegative && ((result << shift) != a)) { + result += 1; + } } - if (!(!foo->primFailCode)) { - return null; - } - oopResult = signed64BitIntegerFor(shifted); + oopResult = magnitude64BitIntegerForneg(result, aIsNegative); if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); @@ -16876,17 +17114,24 @@
EXPORT(sqInt) primitiveDivLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; sqInt oopResult; - sqLong posArg; - sqLong posRcvr; - sqLong result; + usqLong rem; + usqLong result; sqInt sp;
- integerArg = signed64BitValueOf(longAt(foo->stackPointer - (0 * (BYTES_PER_WORD)))); - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); - if (integerArg == 0) { + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); + if (b == 0) { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; @@ -16895,50 +17140,23 @@ if (!(!foo->primFailCode)) { return null; } - if (integerRcvr > 0) { - if (integerArg > 0) { - result = integerRcvr / integerArg; - } else { + result = a / b; + if (!(a == 0)) { + if (!(bIsNegative == aIsNegative)) {
- /* round negative result toward negative infinity */ + /* Round toward negative infinity */
- posArg = 0 - integerArg; + rem = a % b; + if (!(rem == 0)) {
- /* can overflow! */ + /* This can not overflow, because b > 1, otherwise rem = 0 */
- posRcvr = integerRcvr + (posArg - 1); - if (posRcvr < 0) { - /* begin primitiveFail */ - if (foo->primFailCode == 0) { - foo->primFailCode = 1; - } + result += 1; } - result = 0 - (posRcvr / posArg); } - } else { - posRcvr = 0 - integerRcvr; - if (integerArg > 0) { - - /* round negative result toward negative infinity */ - /* can overflow! */ - - posRcvr += integerArg - 1; - if (posRcvr < 0) { - /* begin primitiveFail */ - if (foo->primFailCode == 0) { - foo->primFailCode = 1; - } - } - result = 0 - (posRcvr / integerArg); - } else { - posArg = 0 - integerArg; - result = posRcvr / posArg; - } } + oopResult = magnitude64BitIntegerForneg(result, bIsNegative != aIsNegative); if (!foo->primFailCode) { - oopResult = signed64BitIntegerFor(result); - } - if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); foo->stackPointer = sp; @@ -17018,25 +17236,34 @@
EXPORT(sqInt) primitiveDivideLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; sqInt oopResult; - sqLong result; + usqLong result; sqInt sp;
- integerArg = signed64BitValueOf(longAt(foo->stackPointer - (0 * (BYTES_PER_WORD)))); - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); - if (!((integerArg != 0) && ((integerRcvr % integerArg) == 0))) { + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); + if (!(!foo->primFailCode)) { + return null; + } + if (!((b != 0) && ((a % b) == 0))) { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; } - } - if (!(!foo->primFailCode)) { return null; } - result = integerRcvr / integerArg; - oopResult = signed64BitIntegerFor(result); + result = a / b; + oopResult = magnitude64BitIntegerForneg(result, aIsNegative != bIsNegative); if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); @@ -20354,6 +20581,45 @@ }
+/* Answer the local microseconds since the Smalltalk epoch. The value is + derived from the Posix epoch (see primitiveUTCMicrosecondClock) with a + constant offset corresponding to elapsed microseconds between the two + epochs according to RFC 868, and with an offset duration corresponding to + the current offset of local time from UTC. */ + +EXPORT(sqInt) primitiveLocalMicrosecondClock(void) { +register struct foo * foo = &fum; + usqLong clock; + static usqLong epochDelta= 2177452800000000ULL; + int offset; + usqLong offsetMillis; + sqInt uSecs; + sqInt sp; + + if ((ioUtcWithOffset(&clock, &offset)) == -1) { + /* begin primitiveFail */ + if (foo->primFailCode == 0) { + foo->primFailCode = 1; + } + return null; + } + + /* adjust for nominal Smalltalk epoch */ + + clock += epochDelta; + offsetMillis = offset; + offsetMillis = offsetMillis * 1000000; + + /* adjust for local time offset */ + + clock += offsetMillis; + uSecs = positive64BitIntegerFor(clock); + /* begin pop:thenPush: */ + longAtput((sp = foo->stackPointer - ((1 - 1) * (BYTES_PER_WORD))), uSecs); + foo->stackPointer = sp; +} + + /* Natural log. */
sqInt primitiveLogN(void) { @@ -20583,15 +20849,23 @@
EXPORT(sqInt) primitiveModLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; sqInt oopResult; - sqLong result; + usqLong result; sqInt sp;
- integerArg = signed64BitValueOf(longAt(foo->stackPointer - (0 * (BYTES_PER_WORD)))); - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); - if (integerArg == 0) { + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); + if (b == 0) { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; @@ -20601,19 +20875,15 @@ return null; }
- /* ensure that the result has the same sign as the integerArg */ + /* Handle remainder of same sign as argument */
- result = integerRcvr % integerArg; - if (integerArg < 0) { - if (result > 0) { - result += integerArg; + result = a % b; + if (!(result == 0)) { + if (!(bIsNegative == aIsNegative)) { + result = b - result; } - } else { - if (result < 0) { - result += integerArg; - } } - oopResult = signed64BitIntegerFor(result); + oopResult = magnitude64BitIntegerForneg(result, bIsNegative); if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); @@ -20763,31 +21033,34 @@
EXPORT(sqInt) primitiveMultiplyLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; sqInt oopResult; - sqInt r; - sqLong result; - sqInt twoToThe64; + usqLong result; sqInt sp;
- integerArg = signed64BitValueOf(longAt(foo->stackPointer - (0 * (BYTES_PER_WORD)))); - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); if (!(!foo->primFailCode)) { return null; } - - /* check for C overflow by seeing if computation is reversible */ - - result = integerRcvr * integerArg; - if ((integerArg == 0) || ((result / integerArg) == integerRcvr)) { - oopResult = signed64BitIntegerFor(result); - } else { + if ((a > 1) && ((b > 1) && (a > (18446744073709551615U / b)))) { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; } + return null; } + result = a * b; + oopResult = magnitude64BitIntegerForneg(result, aIsNegative != bIsNegative); if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); @@ -22260,15 +22533,23 @@
EXPORT(sqInt) primitiveQuoLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; sqInt oopResult; - sqLong result; + usqLong result; sqInt sp;
- integerArg = signed64BitValueOf(longAt(foo->stackPointer - (0 * (BYTES_PER_WORD)))); - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); - if (integerArg == 0) { + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); + if (b == 0) { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; @@ -22277,20 +22558,8 @@ if (!(!foo->primFailCode)) { return null; } - if (integerRcvr > 0) { - if (integerArg > 0) { - result = integerRcvr / integerArg; - } else { - result = 0 - (integerRcvr / (0 - integerArg)); - } - } else { - if (integerArg > 0) { - result = 0 - ((0 - integerRcvr) / integerArg); - } else { - result = (0 - integerRcvr) / (0 - integerArg); - } - } - oopResult = signed64BitIntegerFor(result); + result = a / b; + oopResult = magnitude64BitIntegerForneg(result, bIsNegative != aIsNegative); if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); @@ -22329,6 +22598,45 @@ } }
+ +/* Primitive arithmetic operations for large integers in 64 bit range */ + +EXPORT(sqInt) primitiveRemLargeIntegers(void) { +register struct foo * foo = &fum; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; + sqInt oopResult; + usqLong result; + sqInt sp; + + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); + if (b == 0) { + /* begin primitiveFail */ + if (foo->primFailCode == 0) { + foo->primFailCode = 1; + } + } + if (!(!foo->primFailCode)) { + return null; + } + result = a % b; + oopResult = magnitude64BitIntegerForneg(result, aIsNegative != bIsNegative); + if (!foo->primFailCode) { + /* begin pop:thenPush: */ + longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); + foo->stackPointer = sp; + } +} + sqInt primitiveResponse(void) { register struct foo * foo = &fum; sqInt delta; @@ -24670,49 +24978,46 @@
EXPORT(sqInt) primitiveSubtractLargeIntegers(void) { register struct foo * foo = &fum; - sqLong integerArg; - sqLong integerArgNegated; - sqLong integerRcvr; + usqLong a; + sqInt aIsNegative; + usqLong b; + sqInt bIsNegative; + sqInt oopArg; + sqInt oopRcvr; sqInt oopResult; - sqLong result; + usqLong result; + sqInt resultIsNegative; sqInt sp;
- integerArg = signed64BitValueOf(longAt(foo->stackPointer - (0 * (BYTES_PER_WORD)))); - integerRcvr = signed64BitValueOf(longAt(foo->stackPointer - (1 * (BYTES_PER_WORD)))); + oopArg = longAt(foo->stackPointer - (0 * (BYTES_PER_WORD))); + oopRcvr = longAt(foo->stackPointer - (1 * (BYTES_PER_WORD))); + aIsNegative = isNegativeIntegerValueOf(oopRcvr); + bIsNegative = isNegativeIntegerValueOf(oopArg); + a = magnitude64BitValueOf(oopRcvr); + b = magnitude64BitValueOf(oopArg); if (!(!foo->primFailCode)) { return null; } - if (integerArg == 0) { - result = integerRcvr; - } else { - - /* Reverse the argument so that we can recycle the overflow code from addition. - But the most -ve 64-bit value can overflow, so check; 0 - most -ve = most -ve */ - - integerArgNegated = 0 - integerArg; - if (integerArgNegated == integerArg) { + if (aIsNegative != bIsNegative) { + if (a > (18446744073709551615U - b)) { /* begin primitiveFail */ if (foo->primFailCode == 0) { foo->primFailCode = 1; } return null; } - - /* Now check overflow conditions. First is whether rcvr and arg are of the same sign. - If they are we need to check for overflow more carefully. */ - - result = integerRcvr + integerArgNegated; - if (!((integerRcvr ^ integerArgNegated) < 0)) { - if ((integerRcvr ^ result) < 0) { - /* begin primitiveFail */ - if (foo->primFailCode == 0) { - foo->primFailCode = 1; - } - return null; - } + result = a + b; + resultIsNegative = aIsNegative; + } else { + if (a >= b) { + result = a - b; + resultIsNegative = aIsNegative; + } else { + result = b - a; + resultIsNegative = !aIsNegative; } } - oopResult = signed64BitIntegerFor(result); + oopResult = magnitude64BitIntegerForneg(result, resultIsNegative); if (!foo->primFailCode) { /* begin pop:thenPush: */ longAtput((sp = foo->stackPointer - ((2 - 1) * (BYTES_PER_WORD))), oopResult); @@ -24989,6 +25294,34 @@ }
+/* Answer the UTC microseconds since the Smalltalk epoch. The value is + derived from the Posix epoch (see primitiveUTCMicrosecondClock) with a + constant offset corresponding to elapsed microseconds between the two + epochs according to RFC 868. */ + +EXPORT(sqInt) primitiveUTCMicrosecondClock(void) { +register struct foo * foo = &fum; + usqLong clock; + static usqLong epochDelta= 2177452800000000ULL; + int offset; + sqInt uSecs; + sqInt sp; + + if ((ioUtcWithOffset(&clock, &offset)) == -1) { + /* begin primitiveFail */ + if (foo->primFailCode == 0) { + foo->primFailCode = 1; + } + return null; + } + clock += epochDelta; + uSecs = positive64BitIntegerFor(clock); + /* begin pop:thenPush: */ + longAtput((sp = foo->stackPointer - ((1 - 1) * (BYTES_PER_WORD))), uSecs); + foo->stackPointer = sp; +} + + /* Primitive. Unload the module with the given name. */ /* Reloading of the module will happen *later* automatically, when a function from it is called. This is ensured by invalidating current sessionID. */ @@ -29052,6 +29385,7 @@ {"", "primitiveRootTable", (void*)primitiveRootTable}, {"", "primitiveImageFormatVersion", (void*)primitiveImageFormatVersion}, {"", "dumpImage", (void*)dumpImage}, + {"", "primitiveLocalMicrosecondClock", (void*)primitiveLocalMicrosecondClock}, {"", "callInterpreter", (void*)callInterpreter}, {"", "primitiveDivLargeIntegers", (void*)primitiveDivLargeIntegers}, {"", "primitiveMillisecondClockMask", (void*)primitiveMillisecondClockMask}, @@ -29070,8 +29404,10 @@ {"", "primitiveMultiplyLargeIntegers", (void*)primitiveMultiplyLargeIntegers}, {"", "primitiveIsRoot", (void*)primitiveIsRoot}, {"", "moduleUnloaded", (void*)moduleUnloaded}, + {"", "primitiveUTCMicrosecondClock", (void*)primitiveUTCMicrosecondClock}, + {"", "addGCRoot", (void*)addGCRoot}, {"", "primitiveRootTableAt", (void*)primitiveRootTableAt}, - {"", "addGCRoot", (void*)addGCRoot}, + {"", "primitiveRemLargeIntegers", (void*)primitiveRemLargeIntegers}, {"", "getStackPointer", (void*)getStackPointer}, {"", "primitiveNotEqualLargeIntegers", (void*)primitiveNotEqualLargeIntegers}, {"", "callbackEnter", (void*)callbackEnter},
Modified: trunk/platforms/unix/src/vm/interp.h =================================================================== --- trunk/platforms/unix/src/vm/interp.h 2012-09-12 21:59:25 UTC (rev 2591) +++ trunk/platforms/unix/src/vm/interp.h 2012-09-12 22:00:41 UTC (rev 2592) @@ -1,12 +1,12 @@ -/* Automatically generated from Squeak on 30 July 2012 4:52:16 pm - by VMMaker 4.9.8 +/* Automatically generated from Squeak on 13 September 2012 6:51:36 am + by VMMaker 4.10.2 */
#ifndef HAVE_INTERP_H # define HAVE_INTERP_H #endif
-#define VMMAKER_VERSION "4.9.8" +#define VMMAKER_VERSION "4.10.2" #define VM_PROXY_MAJOR 1 #define VM_PROXY_MINOR 9
vm-dev@lists.squeakfoundation.org