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

Sophie Kaleba sophie.kaleba at gmail.com
Thu Apr 19 10:14:12 UTC 2018


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

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>>rawCompare: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/20180419/c2e15a5a/attachment-0001.html>


More information about the Vm-dev mailing list