[Vm-dev] VM Maker: VMMaker.oscog-sk.2367.mcz

Sophie Kaleba sophie.kaleba at gmail.com
Mon Apr 23 21:15:19 UTC 2018


2018-04-19 13:33 GMT+02:00 Nicolas Cellier <
nicolas.cellier.aka.nice at gmail.com>:

>
>
>
> 2018-04-19 12:14 GMT+02:00 Sophie Kaleba <sophie.kaleba at gmail.com>:
>
>>
>> Hi,
>>
>> I got a timeout error during the upload because of my slow internet
>> connexion. Hope this won't cause any problem.
>> I finally found time to commit this new primitive! If you spot any
>> mistake, contact me!
>>
>> I have updated the related methods in Squeak (updating previous senders
>> of compare:with:collated so they call this primitive instead) + the tests
>> methods but I can't commit to the repository. I can send the .st files to
>> someone who does have the rights.
>>
>> Sophie
>>
>>
> Hi Sophie,
> you can always commit to the inbox (http://source.squeak.org/inbox/).
>


Hi
Thanks! I will check I did not forget anything and will commit there

Sophie



>
> cheers
>
>
>> 2018-04-19 12:02 GMT+02:00 <commits at source.squeak.org>:
>>
>>>
>>> Sophie Kaleba uploaded a new version of VMMaker to project VM Maker:
>>> http://source.squeak.org/VMMaker/VMMaker.oscog-sk.2367.mcz
>>>
>>> ==================== Summary ====================
>>>
>>> Name: VMMaker.oscog-sk.2367
>>> Author: sk
>>> Time: 19 April 2018, 12:02:35.661622 pm
>>> UUID: 0c2401e3-1450-4f73-8e81-958f50171595
>>> Ancestors: VMMaker.oscog- nice.2366
>>>
>>> ** new primitive to compare strings (slang + JIT)
>>> answers negative smi, 0 or positive smi (instead of 1, 2 or 3 in the
>>> MiscPlugin)
>>>
>>> * Slang (primitiveCompareWith)
>>> order is optionnal.
>>> comparison loop performed in rawCompare: string1 length: strLength1
>>> with: string2 length: strLength2 accessBlock: accessBlock
>>>
>>> * JIT (genPrimitiveStringCompareWith)
>>> the JIT primitive does not take order as parameter (assumed asciiOrder)
>>> quick jump if one of the strings is empty
>>>
>>> =============== Diff against VMMaker.oscog- nice.2366 ===============
>>>
>>> Item was added:
>>> + ----- Method: CogObjectRepresentation>>genPrimitiveStringCompareWith
>>> (in category 'primitive generators') -----
>>> + genPrimitiveStringCompareWith
>>> +       "subclasses override if they can"
>>> +       ^UnimplementedPrimitive!
>>>
>>> Item was added:
>>> + ----- Method: CogObjectRepresentationForSpur
>>> >>genPrimitiveStringCompareWith (in category 'primitive generators')
>>> -----
>>> + genPrimitiveStringCompareWith
>>> +       "primitiveCompareWith:"
>>> +
>>> +       | instr jump jumpAbove jumpIncorrectFormat1 jumpIncorrectFormat2
>>> jumpIncorrectFormat3 jumpIncorrectFormat4 jumpMidFailure jumpSuccess
>>> minSizeReg string1CharOrByteSizeReg string2CharOrByteSizeReg string1Reg
>>> string2Reg |
>>> +
>>> +       <var: #jumpIncorrectFormat1 type: #'AbstractInstruction *'>
>>> +       <var: #jumpIncorrectFormat2 type: #'AbstractInstruction *'>
>>> +       <var: #jumpIncorrectFormat3 type: #'AbstractInstruction *'>
>>> +       <var: #jumpIncorrectFormat4 type: #'AbstractInstruction *'>
>>> +       <var: #jumpAbove type: #'AbstractInstruction *'>
>>> +       <var: #jumpSuccess type: #'AbstractInstruction *'>
>>> +       <var: #jump type: #'AbstractInstruction *'>
>>> +       <var: #jumpMidFailure type: #'AbstractInstruction *'>
>>> +
>>> +       "I redefine those name to ease program comprehension"
>>> +       string1Reg := ReceiverResultReg.
>>> +       string2Reg := Arg0Reg.
>>> +       string1CharOrByteSizeReg := Arg1Reg.
>>> +       string2CharOrByteSizeReg := ClassReg.
>>> +       minSizeReg := SendNumArgsReg.
>>> +
>>> +       "Load arguments in reg"
>>> +       cogit genLoadArgAtDepth: 0 into: string2Reg.
>>> +
>>> +       "checks if string1 is a byteobject and get its size in bytes"
>>> +       self genGetFormatOf: string1Reg into: TempReg.
>>> +       cogit CmpCq: objectMemory firstByteFormat R: TempReg.
>>> +       jumpIncorrectFormat1 := cogit JumpLess: 0.
>>> +       cogit CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
>>> +       jumpIncorrectFormat2 := cogit JumpAboveOrEqual: 0.
>>> +
>>> +       self genGetNumSlotsOf: string1Reg into: string1CharOrByteSizeReg.
>>> +       (cogit LogicalShiftLeftCq: objectMemory shiftForWord R:
>>> string1CharOrByteSizeReg).
>>> +       cogit AndCq: objectMemory wordSize - 1 R: TempReg R: TempReg.
>>> +       cogit SubR: TempReg R: string1CharOrByteSizeReg.
>>> +
>>> +       "checks if string2 is a byteobject and get its size in bytes"
>>> +       self genGetFormatOf: string2Reg into: TempReg.
>>> +       cogit CmpCq: objectMemory firstByteFormat R: TempReg.
>>> +       jumpIncorrectFormat3 := cogit JumpLess: 0.
>>> +       cogit CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
>>> +       jumpIncorrectFormat4 := cogit JumpAboveOrEqual: 0.
>>> +
>>> +       self genGetNumSlotsOf: string2Reg into: string2CharOrByteSizeReg.
>>> +       (cogit LogicalShiftLeftCq: objectMemory shiftForWord R:
>>> string2CharOrByteSizeReg).
>>> +       cogit AndCq: objectMemory wordSize - 1 R: TempReg R: TempReg.
>>> +       cogit SubR: TempReg R: string2CharOrByteSizeReg.
>>> +
>>> +       "Type and number of arguments are correct"
>>> +       "Compute the min"
>>> +       cogit CmpR: string1CharOrByteSizeReg R: string2CharOrByteSizeReg.
>>> +       jumpAbove := cogit JumpBelow: 0.
>>> +       cogit MoveR: string1CharOrByteSizeReg R: minSizeReg.
>>> +       jump := cogit Jump: 0.
>>> +       jumpAbove jmpTarget: (cogit MoveR: string2CharOrByteSizeReg R:
>>> minSizeReg).
>>> +       jump jmpTarget: (cogit CmpCq: 0 R: minSizeReg).
>>> +       jumpSuccess := cogit JumpZero: 0. "if one of the string is
>>> empty, no need to go through the comparing loop"
>>> +
>>> +       "Compare the bytes"
>>> +       cogit MoveCq: objectMemory baseHeaderSize  R: TempReg.
>>> +       cogit AddCq: objectMemory baseHeaderSize R: minSizeReg.
>>> +
>>> +       instr := cogit MoveXbr: TempReg R: string1Reg R:
>>> string1CharOrByteSizeReg.
>>> +       cogit MoveXbr: TempReg R: string2Reg R: string2CharOrByteSizeReg.
>>> +       cogit SubR: string2CharOrByteSizeReg R:
>>> string1CharOrByteSizeReg.
>>> +       jumpMidFailure := cogit JumpNonZero: 0. "the 2 compared
>>> characters are different, exit the loop"
>>> +       cogit AddCq: 1 R: TempReg.
>>> +       cogit CmpR: TempReg R: minSizeReg.
>>> +       cogit JumpNonZero: instr.
>>> +
>>> +       "all bytes from 1 to minSize are equal"
>>> +       self genGetNumBytesOf: string1Reg into: string1CharOrByteSizeReg.
>>> +       self genGetNumBytesOf: string2Reg into: string2CharOrByteSizeReg.
>>> +       jumpSuccess jmpTarget: (cogit SubR: string2CharOrByteSizeReg R:
>>> string1CharOrByteSizeReg).
>>> +       jumpMidFailure  jmpTarget: (cogit MoveR:
>>> string1CharOrByteSizeReg R: ReceiverResultReg).
>>> +       self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
>>> +       cogit genPrimReturn.
>>> +
>>> +       jumpIncorrectFormat4
>>> +               jmpTarget: (jumpIncorrectFormat3
>>> +                       jmpTarget: (jumpIncorrectFormat2
>>> +                               jmpTarget: (jumpIncorrectFormat1
>>> jmpTarget: cogit Label))).
>>> +
>>> +       ^ CompletePrimitive!
>>>
>>> Item was changed:
>>>   ----- Method: Interpreter class>>initializePrimitiveTable (in
>>> category 'initialization') -----
>>> (excessive size, no diff calculated)
>>>
>>> Item was added:
>>> + ----- Method: InterpreterPrimitives>>primitiveCompareWith (in
>>> category 'string primitives') -----
>>> + primitiveCompareWith
>>> +       "<string1> primitiveCompareWith: string2 [collated: order] "
>>> +       <export: true>
>>> +
>>> +       | string1 string2 order strLength1 strLength2 result |
>>> +
>>> +       "1 - fetch the parameters from the stack"
>>> +       (argumentCount = 0 or: [argumentCount > 2]) ifTrue:
>>> +               [^self primitiveFailFor: PrimErrBadNumArgs].
>>> +       argumentCount = 1
>>> +                       ifFalse: "argCount must be 2"
>>> +                               [order := self stackTop.
>>> +                               (objectMemory isBytes: order) ifFalse:
>>> [^self primitiveFailFor: PrimErrBadArgument]].
>>> +       string1 := self stackValue: argumentCount.
>>> +       string2 := self stackValue: argumentCount - 1.
>>> +
>>> +       "2 - check their types - all parameters are ByteObject"
>>> +       ((objectMemory isBytes: string1)
>>> +       and: [objectMemory isBytes: string2 ])
>>> +               ifFalse:
>>> +                       [^self primitiveFailFor: PrimErrBadArgument].
>>> +
>>> +       "3 - compare the strings"
>>> +       strLength1 := objectMemory numBytesOfBytes: string1.
>>> +       strLength2 := objectMemory numBytesOfBytes: string2.
>>> +       result := order
>>> +               ifNil: [self rawCompare: string1 length: strLength1
>>> with: string2 length: strLength2 accessBlock: [:str :index | objectMemory
>>> fetchByte: index ofObject: str ]]
>>> +               ifNotNil:
>>> +                       [self rawCompare: string1 length: strLength1
>>> with: string2 length: strLength2 accessBlock: [:str :index | objectMemory
>>> fetchByte: (objectMemory fetchByte: index ofObject: str) +1 ofObject: order
>>> ]].
>>> +       self pop: argumentCount + 1 thenPush: (objectMemory
>>> integerObjectOf: result)
>>> +
>>> +
>>> +
>>> +
>>> +
>>> +       !
>>>
>>> Item was added:
>>> + ----- Method: InterpreterPrimitives>>rawComp
>>> are:length:with:length:accessBlock: (in category 'string primitives')
>>> -----
>>> + rawCompare: string1 length: strLength1 with: string2 length:
>>> strLength2 accessBlock: accessBlock
>>> +       | c1 c2 min |
>>> +       <inline: true> "needs to be forced else slang does not inline it
>>> by default"
>>> +       min := strLength1 min: strLength2.
>>> +       0 to: min-1 do:
>>> +               [:i | c1 := accessBlock value: string1 value: i.
>>> +                       c2 := accessBlock value: string2 value: i.
>>> +                       c1 = c2 ifFalse: [^c1 - c2]].
>>> +       ^strLength1 - strLength2
>>> +
>>> +
>>> +
>>> +
>>> +       !
>>>
>>> Item was changed:
>>>   ----- Method: SimpleStackBasedCogit class>>initializePrimitiveTableForSqueak
>>> (in category 'class initialization') -----
>>>   initializePrimitiveTableForSqueak
>>>         "Initialize the table of primitive generators.  This does not
>>> include normal primitives implemented in the coInterpreter.
>>>          N.B. primitives that don't have an explicit arg count (the
>>> integer following the generator) may be variadic."
>>>         "SimpleStackBasedCogit initializePrimitiveTableForSqueak"
>>>         MaxCompiledPrimitiveIndex := self objectRepresentationClass
>>> wordSize = 8
>>>
>>>         ifTrue: [555]
>>>
>>>         ifFalse: [222].
>>>         primitiveTable := CArrayAccessor on: (Array new:
>>> MaxCompiledPrimitiveIndex + 1).
>>>         self table: primitiveTable from:
>>>         #(      "Integer Primitives (0-19)"
>>>                 (1 genPrimitiveAdd                              1)
>>>                 (2 genPrimitiveSubtract                 1)
>>>                 (3 genPrimitiveLessThan         1)
>>>                 (4 genPrimitiveGreaterThan              1)
>>>                 (5 genPrimitiveLessOrEqual              1)
>>>                 (6 genPrimitiveGreaterOrEqual   1)
>>>                 (7 genPrimitiveEqual                    1)
>>>                 (8 genPrimitiveNotEqual         1)
>>>                 (9 genPrimitiveMultiply                 1)
>>>                 (10 genPrimitiveDivide                  1)
>>>                 (11 genPrimitiveMod                     1)
>>>                 (12 genPrimitiveDiv                             1)
>>>                 (13 genPrimitiveQuo                     1)
>>>                 (14 genPrimitiveBitAnd                  1)
>>>                 (15 genPrimitiveBitOr                   1)
>>>                 (16 genPrimitiveBitXor                  1)
>>>                 (17 genPrimitiveBitShift                        1)
>>>                 "(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)"
>>>
>>>                 "Float Primitives (38-59)"
>>>                 "(38 genPrimitiveFloatAt)"
>>>                 "(39 genPrimitiveFloatAtPut)"
>>>                 (40 genPrimitiveAsFloat
>>>  0)
>>>                 (41 genPrimitiveFloatAdd
>>> 1)
>>>                 (42 genPrimitiveFloatSubtract                   1)
>>>                 (43 genPrimitiveFloatLessThan                   1)
>>>                 (44 genPrimitiveFloatGreaterThan                1)
>>>                 (45 genPrimitiveFloatLessOrEqual                1)
>>>                 (46 genPrimitiveFloatGreaterOrEqual     1)
>>>                 (47 genPrimitiveFloatEqual
>>> 1)
>>>                 (48 genPrimitiveFloatNotEqual                   1)
>>>                 (49 genPrimitiveFloatMultiply                   1)
>>>                 (50 genPrimitiveFloatDivide
>>>  1)
>>>                 "(51 genPrimitiveTruncated)"
>>>                 "(52 genPrimitiveFractionalPart)"
>>>                 "(53 genPrimitiveExponent)"
>>>                 "(54 genPrimitiveTimesTwoPower)"
>>>                 (55 genPrimitiveFloatSquareRoot         0)
>>>                 "(56 genPrimitiveSine)"
>>>                 "(57 genPrimitiveArctan)"
>>>                 "(58 genPrimitiveLogN)"
>>>                 "(59 genPrimitiveExp)"
>>>
>>>                 "Subscript and Stream Primitives (60-67)"
>>>                 (60 genPrimitiveAt                              1)
>>>                 (61 genPrimitiveAtPut                   2)
>>>                 (62 genPrimitiveSize                    0)
>>>                 (63 genPrimitiveStringAt                1)
>>>                 (64 genPrimitiveStringAtPut             2)
>>>                 "The stream primitives no longer pay their way; normal
>>> Smalltalk code is faster."
>>>                 (65 genFastPrimFail)"was primitiveNext"
>>>                 (66 genFastPrimFail) "was primitiveNextPut"
>>>                 (67 genFastPrimFail) "was primitiveAtEnd"
>>>
>>>                 "StorageManagement Primitives (68-79)"
>>>                 (68 genPrimitiveObjectAt                        1)
>>> "Good for debugger/InstructionStream performance"
>>>                 "(69 primitiveObjectAtPut)"
>>>                 (70 genPrimitiveNew                     0)
>>>                 (71 genPrimitiveNewWithArg      1)
>>>                 "(72 primitiveArrayBecomeOneWay)"               "Blue
>>> Book: primitiveBecome"
>>>                 "(73 primitiveInstVarAt)"
>>>                 "(74 primitiveInstVarAtPut)"
>>>                 (75 genPrimitiveIdentityHash    0)
>>>                 "(76 primitiveStoreStackp)"
>>>        "Blue Book: primitiveAsObject"
>>>                 "(77 primitiveSomeInstance)"
>>>                 "(78 primitiveNextInstance)"
>>>                 (79 genPrimitiveNewMethod       2)
>>>
>>>                 "Control Primitives (80-89)"
>>>                 "(80 primitiveFail)"
>>>                 "Blue Book: primitiveBlockCopy"
>>>                 "(81 primitiveFail)"
>>>                 "Blue Book: primitiveValue"
>>>                 "(82 primitiveFail)"
>>>                 "Blue Book: primitiveValueWithArgs"
>>>                 (83 genPrimitivePerform)
>>>                 "(84 primitivePerformWithArgs)"
>>>                 "(85 primitiveSignal)"
>>>                 "(86 primitiveWait)"
>>>                 "(87 primitiveResume)"
>>>                 "(88 primitiveSuspend)"
>>>                 "(89 primitiveFlushCache)"
>>>
>>>                 "(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 genPrimitiveStringReplace)
>>>                 "(106 primitiveScreenSize)"
>>>                 "(107 primitiveMouseButtons)"
>>>                 "(108 primitiveKbdNext)"
>>>                 "(109 primitiveKbdPeek)"
>>>
>>>
>>>                 "System Primitives (110-119)"
>>>                 (110 genPrimitiveIdentical 1)
>>>                 (111 genPrimitiveClass)                         "Support
>>> both class and Context>>objectClass:"
>>>                 "(112 primitiveBytesLeft)"
>>>                 "(113 primitiveQuit)"
>>>                 "(114 primitiveExitToDebugger)"
>>>                 "(115 primitiveChangeClass)"
>>>         "Blue Book: primitiveOopsLeft"
>>>                 "(116 primitiveFlushCacheByMethod)"
>>>                 "(117 primitiveExternalCall)"
>>>                 "(118 primitiveDoPrimitiveWithArgs)"
>>>                 "(119 primitiveFlushCacheSelective)"
>>>
>>>                 (148 genPrimitiveShallowCopy 0)                 "a.k.a.
>>> clone"
>>>
>>> +               (158 genPrimitiveStringCompareWith 1)
>>>                 (159 genPrimitiveHashMultiply 0)
>>>
>>>                 (169 genPrimitiveNotIdentical 1)
>>>
>>>                 (170 genPrimitiveAsCharacter)
>>>  "SmallInteger>>asCharacter, Character class>>value:"
>>>                 (171 genPrimitiveImmediateAsInteger 0)
>>> "Character>>value SmallFloat64>>asInteger"
>>>
>>>                 "(173 primitiveSlotAt 1)"
>>>                 "(174 primitiveSlotAtPut 2)"
>>>                 (175 genPrimitiveIdentityHash   0)
>>> "Behavior>>identityHash"
>>>
>>>                 "Old closure primitives"
>>>                 "(186 primitiveFail)" "was primitiveClosureValue"
>>>                 "(187 primitiveFail)" "was primitiveClosureValueWithArgs"
>>>
>>>                 "Perform method directly"
>>>                 "(188 primitiveExecuteMethodArgsArray)"
>>>                 "(189 primitiveExecuteMethod)"
>>>
>>>                 "Unwind primitives"
>>>                 "(195 primitiveFindNextUnwindContext)"
>>>                 "(196 primitiveTerminateTo)"
>>>                 "(197 primitiveFindHandlerContext)"
>>>                 (198 genFastPrimFail "primitiveMarkUnwindMethod")
>>>                 (199 genFastPrimFail "primitiveMarkHandlerMethod")
>>>
>>>                 "new closure primitives"
>>>                 "(200 primitiveClosureCopyWithCopiedValues)"
>>>                 (201 genPrimitiveClosureValue   0) "value"
>>>                 (202 genPrimitiveClosureValue   1) "value:"
>>>                 (203 genPrimitiveClosureValue   2) "value:value:"
>>>                 (204 genPrimitiveClosureValue   3) "value:value:value:"
>>>                 (205 genPrimitiveClosureValue   4)
>>> "value:value:value:value:"
>>>                 "(206 genPrimitiveClosureValueWithArgs)"
>>> "valueWithArguments:"
>>>
>>>                 (207 genPrimitiveFullClosureValue)
>>> "value[:value:value:value:] et al"
>>>                 "(208 genPrimitiveFullClosureValueWithArgs)"
>>> "valueWithArguments:"
>>>                 (209 genPrimitiveFullClosureValue)
>>> "valueNoContextSwitch[:value:] et al"
>>>
>>>                 "(210 primitiveContextAt)"
>>>                 "(211 primitiveContextAtPut)"
>>>                 "(212 primitiveContextSize)"
>>>
>>>                 "(218 primitiveDoNamedPrimitiveWithArgs)"
>>>                 "(219 primitiveFail)"   "reserved for Cog primitives"
>>>
>>>                 "(220 primitiveFail)"           "reserved for Cog
>>> primitives"
>>>
>>>                 (221 genPrimitiveClosureValue   0) "valueNoContextSwitch"
>>>                 (222 genPrimitiveClosureValue   1)
>>> "valueNoContextSwitch:"
>>>
>>>                 "SmallFloat primitives (540-559)"
>>>                 (541 genPrimitiveSmallFloatAdd
>>> 1)
>>>                 (542 genPrimitiveSmallFloatSubtract
>>>  1)
>>>                 (543 genPrimitiveSmallFloatLessThan
>>>  1)
>>>                 (544 genPrimitiveSmallFloatGreaterThan          1)
>>>                 (545 genPrimitiveSmallFloatLessOrEqual          1)
>>>                 (546 genPrimitiveSmallFloatGreaterOrEqual
>>>  1)
>>>                 (547 genPrimitiveSmallFloatEqual
>>>         1)
>>>                 (548 genPrimitiveSmallFloatNotEqual
>>>  1)
>>>                 (549 genPrimitiveSmallFloatMultiply
>>>          1)
>>>                 (550 genPrimitiveSmallFloatDivide
>>>        1)
>>>                 "(551 genPrimitiveSmallFloatTruncated
>>>  0)"
>>>                 "(552 genPrimitiveSmallFloatFractionalPart
>>> 0)"
>>>                 "(553 genPrimitiveSmallFloatExponent
>>> 0)"
>>>                 "(554 genPrimitiveSmallFloatTimesTwoPower       1)"
>>>                 (555 genPrimitiveSmallFloatSquareRoot
>>>  0)
>>>                 "(556 genPrimitiveSmallFloatSine
>>>         0)"
>>>                 "(557 genPrimitiveSmallFloatArctan
>>>         0)"
>>>                 "(558 genPrimitiveSmallFloatLogN
>>>         0)"
>>>                 "(559 genPrimitiveSmallFloatExp
>>>  0)"
>>>         )!
>>>
>>> Item was changed:
>>>   ----- Method: StackInterpreter class>>initializePrimitiveTable (in
>>> category 'initialization') -----
>>> (excessive size, no diff calculated)
>>>
>>>
>>
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20180423/732a6c2f/attachment-0001.html>


More information about the Vm-dev mailing list