David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.260.mcz ==================== Summary ==================== Name: VMMaker-dtl.260 Author: dtl Time: 25 November 2011, 12:41:48.265 pm UUID: 623da38f-a559-4506-af10-c30c6293d9a3 Ancestors: VMMaker-dtl.259 VMMaker 4.7.17 Add InterpreterPrimitives>>primitiveIdentical from oscog. Remove Interpreter>>primitiveEquivalent and replace it with InterpreterPrimitives>>primitiveIdentical in Interpreter class>>initializePrimitiveTable. Update various primitives in InterpreterPrimitives to match oscog. Add primitiveIdentityHash from oscog. Added, Modified, Deleted vs. VMMaker-dtl.259: M Interpreter class>>initializePrimitiveTable D Interpreter>>primitiveEquivalent M InterpreterPrimitives>>primitiveArctan M InterpreterPrimitives>>primitiveEqualLargeIntegers M InterpreterPrimitives>>primitiveExp M InterpreterPrimitives>>primitiveExponent M InterpreterPrimitives>>primitiveFloatDivide M InterpreterPrimitives>>primitiveFloatEqual M InterpreterPrimitives>>primitiveFloatGreaterOrEqual M InterpreterPrimitives>>primitiveFloatGreaterThan M InterpreterPrimitives>>primitiveFloatLessOrEqual M InterpreterPrimitives>>primitiveFloatLessThan M InterpreterPrimitives>>primitiveFloatMultiply M InterpreterPrimitives>>primitiveFloatNotEqual M InterpreterPrimitives>>primitiveFlushExternalPrimitives M InterpreterPrimitives>>primitiveFractionalPart M InterpreterPrimitives>>primitiveGreaterOrEqualLargeIntegers M InterpreterPrimitives>>primitiveGreaterThanLargeIntegers A InterpreterPrimitives>>primitiveIdentical A InterpreterPrimitives>>primitiveIdentityHash M InterpreterPrimitives>>primitiveLessOrEqualLargeIntegers M InterpreterPrimitives>>primitiveLessThanLargeIntegers M InterpreterPrimitives>>primitiveLogN M InterpreterPrimitives>>primitiveMarkHandlerMethod M InterpreterPrimitives>>primitiveMarkUnwindMethod M InterpreterPrimitives>>primitiveMultiplyLargeIntegers M InterpreterPrimitives>>primitiveNotEqualLargeIntegers M InterpreterPrimitives>>primitiveSetDisplayMode M InterpreterPrimitives>>primitiveSine M InterpreterPrimitives>>primitiveSnapshot M InterpreterPrimitives>>primitiveSnapshotEmbedded M InterpreterPrimitives>>primitiveSquareRoot M InterpreterPrimitives>>primitiveTestDisplayDepth M InterpreterPrimitives>>primitiveTimesTwoPower M InterpreterPrimitives>>primitiveTruncated M VMMaker class>>versionString =============== Diff against VMMaker-dtl.259 =============== Item was changed: ----- Method: Interpreter class>>initializePrimitiveTable (in category 'initialization') ----- initializePrimitiveTable "This table generates a C function address table use in primitiveResponse along with dispatchFunctionPointerOn:in:" "NOTE: The real limit here is 2047 because of the method header layout but there is no point in going over the needed size" MaxPrimitiveIndex := 575. PrimitiveTable := Array new: MaxPrimitiveIndex + 1. self table: PrimitiveTable from: #( "Integer Primitives (0-19)" (0 primitiveFail) (1 primitiveAdd) (2 primitiveSubtract) (3 primitiveLessThan) (4 primitiveGreaterThan) (5 primitiveLessOrEqual) (6 primitiveGreaterOrEqual) (7 primitiveEqual) (8 primitiveNotEqual) (9 primitiveMultiply) (10 primitiveDivide) (11 primitiveMod) (12 primitiveDiv) (13 primitiveQuo) (14 primitiveBitAnd) (15 primitiveBitOr) (16 primitiveBitXor) (17 primitiveBitShift) (18 primitiveMakePoint) (19 primitiveFail) "Guard primitive for simulation -- *must* fail" "LargeInteger Primitives (20-39)" (20 primitiveFail) (21 primitiveAddLargeIntegers) (22 primitiveSubtractLargeIntegers) (23 primitiveLessThanLargeIntegers) (24 primitiveGreaterThanLargeIntegers) (25 primitiveLessOrEqualLargeIntegers) (26 primitiveGreaterOrEqualLargeIntegers) (27 primitiveEqualLargeIntegers) (28 primitiveNotEqualLargeIntegers) (29 primitiveMultiplyLargeIntegers) (30 primitiveDivideLargeIntegers) (31 primitiveModLargeIntegers) (32 primitiveDivLargeIntegers) (33 primitiveQuoLargeIntegers) (34 primitiveBitAndLargeIntegers) (35 primitiveBitOrLargeIntegers) (36 primitiveBitXorLargeIntegers) (37 primitiveBitShiftLargeIntegers) (38 primitiveFail) (39 primitiveFail) "Float Primitives (40-59)" (40 primitiveAsFloat) (41 primitiveFloatAdd) (42 primitiveFloatSubtract) (43 primitiveFloatLessThan) (44 primitiveFloatGreaterThan) (45 primitiveFloatLessOrEqual) (46 primitiveFloatGreaterOrEqual) (47 primitiveFloatEqual) (48 primitiveFloatNotEqual) (49 primitiveFloatMultiply) (50 primitiveFloatDivide) (51 primitiveTruncated) (52 primitiveFractionalPart) (53 primitiveExponent) (54 primitiveTimesTwoPower) (55 primitiveSquareRoot) (56 primitiveSine) (57 primitiveArctan) (58 primitiveLogN) (59 primitiveExp) "Subscript and Stream Primitives (60-67)" (60 primitiveAt) (61 primitiveAtPut) (62 primitiveSize) (63 primitiveStringAt) (64 primitiveStringAtPut) (65 primitiveFail) "was primitiveNext which no longer pays its way (normal Smalltalk code is faster)" (66 primitiveFail) "was primitiveNextPut which no longer pays its way (normal Smalltalk code is faster)" (67 primitiveFail) "was primitiveAtEnd which no longer pays its way (normal Smalltalk code is faster)" "StorageManagement Primitives (68-79)" (68 primitiveObjectAt) (69 primitiveObjectAtPut) (70 primitiveNew) (71 primitiveNewWithArg) (72 primitiveArrayBecomeOneWay) "Blue Book: primitiveBecome" (73 primitiveInstVarAt) (74 primitiveInstVarAtPut) (75 primitiveAsOop) (76 primitiveStoreStackp) "Blue Book: primitiveAsObject" (77 primitiveSomeInstance) (78 primitiveNextInstance) (79 primitiveNewMethod) "Control Primitives (80-89)" (80 primitiveBlockCopy) (81 primitiveValue) (82 primitiveValueWithArgs) (83 primitivePerform) (84 primitivePerformWithArgs) (85 primitiveSignal) (86 primitiveWait) (87 primitiveResume) (88 primitiveSuspend) (89 primitiveFlushCache) "Input/Output Primitives (90-109)" (90 primitiveMousePoint) (91 primitiveTestDisplayDepth) "Blue Book: primitiveCursorLocPut" (92 primitiveSetDisplayMode) "Blue Book: primitiveCursorLink" (93 primitiveInputSemaphore) (94 primitiveGetNextEvent) "Blue Book: primitiveSampleInterval" (95 primitiveInputWord) (96 primitiveFail) "primitiveCopyBits" (97 primitiveSnapshot) (98 primitiveStoreImageSegment) (99 primitiveLoadImageSegment) (100 primitivePerformInSuperclass) "Blue Book: primitiveSignalAtTick" (101 primitiveBeCursor) (102 primitiveBeDisplay) (103 primitiveScanCharacters) (104 primitiveFail) "primitiveDrawLoop" (105 primitiveStringReplace) (106 primitiveScreenSize) (107 primitiveMouseButtons) (108 primitiveKbdNext) (109 primitiveKbdPeek) "System Primitives (110-119)" + (110 primitiveIdentical) - (110 primitiveEquivalent) (111 primitiveClass) (112 primitiveBytesLeft) (113 primitiveQuit) (114 primitiveExitToDebugger) (115 primitiveChangeClass) "Blue Book: primitiveOopsLeft" (116 primitiveFlushCacheByMethod) (117 primitiveExternalCall) (118 primitiveDoPrimitiveWithArgs) (119 primitiveFlushCacheSelective) "Squeak 2.2 and earlier use 119. Squeak 2.3 and later use 116. Both are supported for backward compatibility." "Miscellaneous Primitives (120-127)" (120 primitiveCalloutToFFI) (121 primitiveImageName) (122 primitiveNoop) "Blue Book: primitiveImageVolume" (123 primitiveValueUninterruptably) "@@@: Remove this when all VMs have support" (124 primitiveLowSpaceSemaphore) (125 primitiveSignalAtBytesLeft) "Squeak Primitives Start Here" "Squeak Miscellaneous Primitives (128-149)" (126 primitiveDeferDisplayUpdates) (127 primitiveShowDisplayRect) (128 primitiveArrayBecome) (129 primitiveSpecialObjectsOop) (130 primitiveFullGC) (131 primitiveIncrementalGC) (132 primitiveObjectPointsTo) (133 primitiveSetInterruptKey) (134 primitiveInterruptSemaphore) (135 primitiveMillisecondClock) (136 primitiveSignalAtMilliseconds) (137 primitiveSecondsClock) (138 primitiveSomeObject) (139 primitiveNextObject) (140 primitiveBeep) (141 primitiveClipboardText) (142 primitiveVMPath) (143 primitiveShortAt) (144 primitiveShortAtPut) (145 primitiveConstantFill) "NOTE: When removing the obsolete indexed primitives, the following two should go become #primitiveIntegerAt / atPut" (146 primitiveFail) "primitiveReadJoystick" (147 primitiveFail) "primitiveWarpBits" (148 primitiveClone) (149 primitiveGetAttribute) "File Primitives (150-169) - NO LONGER INDEXED" (150 159 primitiveFail) (160 primitiveAdoptInstance) (161 164 primitiveFail) (165 primitiveIntegerAt) "hacked in here for now" (166 primitiveIntegerAtPut) (167 primitiveYield) (168 primitiveCopyObject) (169 primitiveNotIdentical) "Sound Primitives (170-199) - NO LONGER INDEXED" (170 185 primitiveFail) "Old closure primitives" (186 primitiveFail) "was primitiveClosureValue" (187 primitiveFail) "was primitiveClosureValueWithArgs" "Perform method directly" (188 primitiveExecuteMethodArgsArray) (189 primitiveExecuteMethod) "Sound Primitives (continued) - NO LONGER INDEXED" (190 194 primitiveFail) "Unwind primitives" (195 primitiveFindNextUnwindContext) (196 primitiveTerminateTo) (197 primitiveFindHandlerContext) (198 primitiveMarkUnwindMethod) (199 primitiveMarkHandlerMethod) "new closure primitives (were Networking primitives)" (200 primitiveClosureCopyWithCopiedValues) (201 primitiveClosureValue) "value" (202 primitiveClosureValue) "value:" (203 primitiveClosureValue) "value:value:" (204 primitiveClosureValue) "value:value:value:" (205 primitiveClosureValue) "value:value:value:value:" (206 primitiveClosureValueWithArgs) "valueWithArguments:" (207 209 primitiveFail) "reserved for Cog primitives" (210 primitiveAt) "Compatibility with Cog StackInterpreter Context primitives" (211 primitiveAtPut) "Compatibility with Cog StackInterpreter Context primitives" (212 primitiveSize) "Compatibility with Cog StackInterpreter Context primitives" (213 219 primitiveFail) "reserved for Cog primitives" (220 primitiveFail) "reserved for Cog primitives" (221 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch" (222 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch:" (223 229 primitiveFail) "reserved for Cog primitives" (230 primitiveRelinquishProcessor) (231 primitiveForceDisplayUpdate) (232 primitiveFormPrint) (233 primitiveSetFullScreen) (234 primitiveFail) "primBitmapdecompressfromByteArrayat" (235 primitiveFail) "primStringcomparewithcollated" (236 primitiveFail) "primSampledSoundconvert8bitSignedFromto16Bit" (237 primitiveFail) "primBitmapcompresstoByteArray" (238 241 primitiveFail) "serial port primitives" (242 primitiveFail) (243 primitiveFail) "primStringtranslatefromtotable" (244 primitiveFail) "primStringfindFirstInStringinSetstartingAt" (245 primitiveFail) "primStringindexOfAsciiinStringstartingAt" (246 primitiveFail) "primStringfindSubstringinstartingAtmatchTable" (247 primitiveSnapshotEmbedded) (248 primitiveInvokeObjectAsMethod) (249 primitiveArrayBecomeOneWayCopyHash) "VM Implementor Primitives (250-255)" (250 clearProfile) (251 dumpProfile) (252 startProfiling) (253 stopProfiling) (254 primitiveVMParameter) (255 primitiveInstVarsPutFromStack) "Never used except in Disney tests. Remove after 2.3 release." "Quick Push Const Methods" (256 primitivePushSelf) (257 primitivePushTrue) (258 primitivePushFalse) (259 primitivePushNil) (260 primitivePushMinusOne) (261 primitivePushZero) (262 primitivePushOne) (263 primitivePushTwo) "Quick Push Const Methods" (264 519 primitiveLoadInstVar) "These ranges used to be used by obsiolete indexed primitives." (520 529 primitiveFail) (530 539 primitiveFail) (540 549 primitiveFail) (550 559 primitiveFail) (560 569 primitiveFail) "External primitive support primitives" (570 primitiveFlushExternalPrimitives) (571 primitiveUnloadModule) (572 primitiveListBuiltinModule) (573 primitiveListExternalModule) (574 primitiveFail) "reserved for addl. external support prims" "Unassigned Primitives" (575 primitiveFail)). ! Item was removed: - ----- Method: Interpreter>>primitiveEquivalent (in category 'object access primitives') ----- - primitiveEquivalent - "is the receiver the same object as the argument?" - | thisObject otherObject | - otherObject := self popStack. - thisObject := self popStack. - self pushBool: thisObject = otherObject! Item was changed: ----- Method: InterpreterPrimitives>>primitiveArctan (in category 'arithmetic float primitives') ----- primitiveArctan | rcvr | + <var: #rcvr type: #double> - <var: #rcvr type: 'double '> rcvr := self popFloat. self successful ifTrue: [self pushFloat: (self cCode: 'atan(rcvr)' inSmalltalk: [rcvr arcTan])] ifFalse: [self unPop: 1]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveEqualLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveEqualLargeIntegers "Primitive comparison operations for large integers in 64 bit range" | integerRcvr integerArg | <export: true> <var: 'integerRcvr' type: 'sqLong'> <var: 'integerArg' type: 'sqLong'> integerArg := self signed64BitValueOf: (self stackValue: 0). integerRcvr := self signed64BitValueOf: (self stackValue: 1). + self successful ifTrue: + [self pop: 2 thenPushBool: integerRcvr = integerArg]! - self successful ifTrue:[ - self pop: 2. - self pushBool: integerRcvr = integerArg - ]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveExp (in category 'arithmetic float primitives') ----- primitiveExp "Computes E raised to the receiver power." | rcvr | + <var: #rcvr type: #double> - <var: #rcvr type: 'double '> rcvr := self popFloat. self successful ifTrue: [self pushFloat: (self cCode: 'exp(rcvr)' inSmalltalk: [rcvr exp])] ifFalse: [self unPop: 1]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveExponent (in category 'arithmetic float primitives') ----- primitiveExponent "Exponent part of this float." | rcvr frac pwr | + <var: #rcvr type: #double> + <var: #frac type: #double> + <var: #pwr type: #int> - <var: #rcvr type: 'double '> - <var: #frac type: 'double '> - <var: #pwr type: 'int '> rcvr := self popFloat. self successful ifTrue: [ "rcvr = frac * 2^pwr, where frac is in [0.5..1.0)" self cCode: 'frac = frexp(rcvr, &pwr)' inSmalltalk: [pwr := rcvr exponent]. self pushInteger: pwr - 1] + ifFalse: [self unPop: 1]! - ifFalse: [self unPop: 1].! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatDivide (in category 'arithmetic float primitives') ----- primitiveFloatDivide + self primitiveFloatDivide: (self stackValue: 1) byArg: self stackTop! - ^ self primitiveFloatDivide: (self stackValue: 1) byArg: self stackTop! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatEqual (in category 'arithmetic float primitives') ----- primitiveFloatEqual | aBool | aBool := self primitiveFloatEqual: (self stackValue: 1) toArg: self stackTop. + self successful ifTrue: + [self pop: 2 thenPushBool: aBool]! - self successful ifTrue: [self pop: 2. self pushBool: aBool]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatGreaterOrEqual (in category 'arithmetic float primitives') ----- primitiveFloatGreaterOrEqual | aBool | aBool := self primitiveFloatGreaterOrEqual: (self stackValue: 1) toArg: self stackTop. + self successful ifTrue: [self pop: 2 thenPushBool: aBool]! - self successful ifTrue: [self pop: 2. self pushBool: aBool].! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatGreaterThan (in category 'arithmetic float primitives') ----- primitiveFloatGreaterThan | aBool | aBool := self primitiveFloatGreater: (self stackValue: 1) thanArg: self stackTop. + self successful ifTrue: + [self pop: 2 thenPushBool: aBool]! - self successful ifTrue: [self pop: 2. self pushBool: aBool]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatLessOrEqual (in category 'arithmetic float primitives') ----- primitiveFloatLessOrEqual | aBool | aBool := self primitiveFloatLessOrEqual: (self stackValue: 1) toArg: self stackTop. + self successful ifTrue: [self pop: 2 thenPushBool: aBool]! - self successful ifTrue: [self pop: 2. self pushBool: aBool].! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatLessThan (in category 'arithmetic float primitives') ----- primitiveFloatLessThan | aBool | aBool := self primitiveFloatLess: (self stackValue: 1) thanArg: self stackTop. + self successful ifTrue: + [self pop: 2 thenPushBool: aBool]! - self successful ifTrue: [self pop: 2. self pushBool: aBool]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatMultiply (in category 'arithmetic float primitives') ----- primitiveFloatMultiply + self primitiveFloatMultiply: (self stackValue: 1) byArg: self stackTop! - ^ self primitiveFloatMultiply: (self stackValue: 1) byArg: self stackTop! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFloatNotEqual (in category 'arithmetic float primitives') ----- primitiveFloatNotEqual | aBool | aBool := self primitiveFloatEqual: (self stackValue: 1) toArg: self stackTop. + self successful ifTrue: + [self pop: 2 thenPushBool: aBool not]! - self successful ifTrue: [self pop: 2. self pushBool: aBool not]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFlushExternalPrimitives (in category 'plugin primitives') ----- primitiveFlushExternalPrimitives "Primitive. Flush all the existing external primitives in the image thus forcing a reload on next invokation." + self flushExternalPrimitives! - ^self flushExternalPrimitives! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFractionalPart (in category 'arithmetic float primitives') ----- primitiveFractionalPart | rcvr frac trunc | + <var: #rcvr type: #double> + <var: #frac type: #double> + <var: #trunc type: #double> - <var: #rcvr type: 'double '> - <var: #frac type: 'double '> - <var: #trunc type: 'double '> rcvr := self popFloat. self successful ifTrue: [self cCode: 'frac = modf(rcvr, &trunc)' inSmalltalk: [frac := rcvr fractionPart]. self pushFloat: frac] ifFalse: [self unPop: 1]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveGreaterOrEqualLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveGreaterOrEqualLargeIntegers "Primitive comparison operations for large integers in 64 bit range" | integerRcvr integerArg | <export: true> <var: 'integerRcvr' type: 'sqLong'> <var: 'integerArg' type: 'sqLong'> integerArg := self signed64BitValueOf: (self stackValue: 0). integerRcvr := self signed64BitValueOf: (self stackValue: 1). + self successful ifTrue: + [self pop: 2 thenPushBool: integerRcvr >= integerArg]! - self successful ifTrue:[ - self pop: 2. - self pushBool: integerRcvr >= integerArg - ]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveGreaterThanLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveGreaterThanLargeIntegers "Primitive comparison operations for large integers in 64 bit range" | integerRcvr integerArg | <export: true> <var: 'integerRcvr' type: 'sqLong'> <var: 'integerArg' type: 'sqLong'> integerArg := self signed64BitValueOf: (self stackValue: 0). integerRcvr := self signed64BitValueOf: (self stackValue: 1). + self successful ifTrue: + [self pop: 2 thenPushBool: integerRcvr > integerArg]! - self successful ifTrue:[ - self pop: 2. - self pushBool: integerRcvr > integerArg - ]. - ! Item was added: + ----- Method: InterpreterPrimitives>>primitiveIdentical (in category 'object access primitives') ----- + primitiveIdentical + "is the receiver/first argument the same object as the (last) argument?. + pop argumentCount because this can be used as a mirror primitive." + | thisObject otherObject | + otherObject := self stackValue: 1. + thisObject := self stackTop. + self pop: argumentCount + 1 thenPushBool: thisObject = otherObject! Item was added: + ----- Method: InterpreterPrimitives>>primitiveIdentityHash (in category 'object access primitives') ----- + primitiveIdentityHash + | thisReceiver | + thisReceiver := self stackTop. + (self isIntegerObject: thisReceiver) + ifTrue: [self primitiveFail] + ifFalse: [self pop:1 thenPushInteger: (self hashBitsOf: thisReceiver)]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveLessOrEqualLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveLessOrEqualLargeIntegers "Primitive comparison operations for large integers in 64 bit range" | integerRcvr integerArg | <export: true> <var: 'integerRcvr' type: 'sqLong'> <var: 'integerArg' type: 'sqLong'> integerArg := self signed64BitValueOf: (self stackValue: 0). integerRcvr := self signed64BitValueOf: (self stackValue: 1). + self successful ifTrue: + [self pop: 2 thenPushBool: integerRcvr <= integerArg]! - self successful ifTrue:[ - self pop: 2. - self pushBool: integerRcvr <= integerArg - ]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveLessThanLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveLessThanLargeIntegers "Primitive comparison operations for large integers in 64 bit range" | integerRcvr integerArg | <export: true> <var: 'integerRcvr' type: 'sqLong'> <var: 'integerArg' type: 'sqLong'> integerArg := self signed64BitValueOf: (self stackValue: 0). integerRcvr := self signed64BitValueOf: (self stackValue: 1). + self successful ifTrue: + [self pop: 2 thenPushBool: integerRcvr < integerArg]! - self successful ifTrue:[ - self pop: 2. - self pushBool: integerRcvr < integerArg - ]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveLogN (in category 'arithmetic float primitives') ----- primitiveLogN "Natural log." | rcvr | + <var: #rcvr type: #double> - <var: #rcvr type: 'double '> rcvr := self popFloat. self successful ifTrue: [self pushFloat: (self cCode: 'log(rcvr)' inSmalltalk: [rcvr ln])] ifFalse: [self unPop: 1]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveMarkHandlerMethod (in category 'control primitives') ----- primitiveMarkHandlerMethod "Primitive. Mark the method for exception handling. The primitive must fail after marking the context so that the regular code is run." <inline: false> + self primitiveFail! - ^self primitiveFail! Item was changed: ----- Method: InterpreterPrimitives>>primitiveMarkUnwindMethod (in category 'control primitives') ----- primitiveMarkUnwindMethod + "Primitive. Mark the method for exception unwinding. The primitive must fail after marking the context so that the regular code is run. It must also *not* allow a context switch." - "Primitive. Mark the method for exception unwinding. The primitive must fail after marking the context so that the regular code is run." <inline: false> ^self primitiveFail! Item was changed: ----- Method: InterpreterPrimitives>>primitiveMultiplyLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveMultiplyLargeIntegers "Primitive arithmetic operations for large integers in 64 bit range" | integerRcvr integerArg result oopResult | <export: true> <var: 'integerRcvr' type: 'sqLong'> <var: 'integerArg' type: 'sqLong'> <var: 'result' type: 'sqLong'> integerArg := self signed64BitValueOf: (self stackValue: 0). integerRcvr := self signed64BitValueOf: (self stackValue: 1). self successful ifFalse:[^nil]. + result := self + cCode: [integerRcvr * integerArg] + inSmalltalk: + [| twoToThe64 r | + twoToThe64 := 2 raisedTo: 64. + r := integerRcvr * integerArg bitAnd: twoToThe64 - 1. + (r bitAt: 64) = 0 ifTrue: [r] ifFalse: [r - twoToThe64]]. - result := integerRcvr * integerArg. "check for C overflow by seeing if computation is reversible" ((integerArg = 0) or: [(result // integerArg) = integerRcvr]) ifTrue:[oopResult := self signed64BitIntegerFor: result] ifFalse: [self primitiveFail]. + self successful ifTrue:[self pop: 2 thenPush: oopResult]! - self successful ifTrue:[self pop: 2 thenPush: oopResult]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveNotEqualLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveNotEqualLargeIntegers "Primitive comparison operations for large integers in 64 bit range" | integerRcvr integerArg | <export: true> <var: 'integerRcvr' type: 'sqLong'> <var: 'integerArg' type: 'sqLong'> integerArg := self signed64BitValueOf: (self stackValue: 0). integerRcvr := self signed64BitValueOf: (self stackValue: 1). + self successful ifTrue: + [self pop: 2 thenPushBool: integerRcvr ~= integerArg]! - self successful ifTrue:[ - self pop: 2. - self pushBool: integerRcvr ~= integerArg - ]. - ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSetDisplayMode (in category 'I/O primitives') ----- primitiveSetDisplayMode "Set to OS to the requested display mode. See also DisplayScreen setDisplayDepth:extent:fullscreen:" | fsFlag h w d okay | fsFlag := self booleanValueOf: (self stackTop). h := self stackIntegerValue: 1. w := self stackIntegerValue: 2. d := self stackIntegerValue: 3. self successful ifTrue: [okay := self cCode:'ioSetDisplayMode(w, h, d, fsFlag)']. + self successful ifTrue: [self pop: 5 thenPushBool: okay "Pop args+rcvr"]! - self successful ifTrue: [ - self pop: 5. "Pop args+rcvr" - self pushBool: okay].! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSine (in category 'arithmetic float primitives') ----- primitiveSine | rcvr | + <var: #rcvr type: #double> - <var: #rcvr type: 'double '> rcvr := self popFloat. self successful ifTrue: [self pushFloat: (self cCode: 'sin(rcvr)' inSmalltalk: [rcvr sin])] ifFalse: [self unPop: 1]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSnapshot (in category 'system control primitives') ----- primitiveSnapshot + "save a normal snapshot under the same name as it was loaded unless it has been renamed by the last primitiveImageName" - "save a normal snapshot under the same name as it was loaded unless it has been renamed by the last primitiveImageName" <inline: false> + self snapshot: false - ^self snapshot: false ! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSnapshotEmbedded (in category 'system control primitives') ----- primitiveSnapshotEmbedded + "save an embedded snapshot" - "save an embedded snapshot" <inline: false> + self snapshot: true! - ^self snapshot: true! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSquareRoot (in category 'arithmetic float primitives') ----- primitiveSquareRoot | rcvr | + <var: #rcvr type: #double> - <var: #rcvr type: 'double '> rcvr := self popFloat. self success: rcvr >= 0.0. self successful ifTrue: [self pushFloat: (self cCode: 'sqrt(rcvr)' inSmalltalk: [rcvr sqrt])] ifFalse: [self unPop: 1]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveTestDisplayDepth (in category 'I/O primitives') ----- primitiveTestDisplayDepth "Return true if the host OS does support the given display depth." | bitsPerPixel okay| bitsPerPixel := self stackIntegerValue: 0. self successful ifTrue: [okay := self ioHasDisplayDepth: bitsPerPixel]. + self successful ifTrue: [self pop: 2 thenPushBool: okay"Pop arg+rcvr"]! - self successful ifTrue: [ - self pop: 2. "Pop arg+rcvr" - self pushBool: okay].! Item was changed: ----- Method: InterpreterPrimitives>>primitiveTimesTwoPower (in category 'arithmetic float primitives') ----- primitiveTimesTwoPower | rcvr arg | + <var: #rcvr type: #double> - <var: #rcvr type: 'double '> arg := self popInteger. rcvr := self popFloat. self successful ifTrue: [ self pushFloat: (self cCode: 'ldexp(rcvr, arg)' inSmalltalk: [rcvr timesTwoPower: arg]) ] + ifFalse: [ self unPop: 2 ]! - ifFalse: [ self unPop: 2 ].! Item was changed: ----- Method: InterpreterPrimitives>>primitiveTruncated (in category 'arithmetic float primitives') ----- primitiveTruncated | rcvr frac trunc | + <var: #rcvr type: #double> + <var: #frac type: #double> + <var: #trunc type: #double> - <var: #rcvr type: 'double '> - <var: #frac type: 'double '> - <var: #trunc type: 'double '> rcvr := self popFloat. self successful ifTrue: [self cCode: 'frac = modf(rcvr, &trunc)' inSmalltalk: [trunc := rcvr truncated]. self flag: #Dan. "The ranges are INCORRECT if SmallIntegers are wider than 31 bits." self cCode: 'success((-1073741824.0 <= trunc) && (trunc <= 1073741823.0))' inSmalltalk: [self success: (trunc between: SmallInteger minVal and: SmallInteger maxVal)]]. self successful ifTrue: [self cCode: 'pushInteger((sqInt) trunc)' inSmalltalk: [self pushInteger: trunc]] ifFalse: [self unPop: 1]! Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString "VMMaker versionString" + ^'4.7.17'! - ^'4.7.16'! |
Free forum by Nabble | Edit this page |