[Vm-dev] VM Maker: BytecodeSets-eem.2.mcz

Clément Bera bera.clement at gmail.com
Mon May 19 19:30:34 UTC 2014


I love that commit. I'm glad you have some time to work on it :-).


2014-05-19 20:52 GMT+02:00 <commits at source.squeak.org>:

>
> Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker:
> http://source.squeak.org/VMMaker/BytecodeSets-eem.2.mcz
>
> ==================== Summary ====================
>
> Name: BytecodeSets-eem.2
> Author: eem
> Time: 19 May 2014, 11:52:50.933 am
> UUID: 913085ca-0802-4f32-8b85-61432bb1c1f5
> Ancestors: BytecodeSets-eem.1
>
> Provide the multiple bytecode set support for
> InstructionStream and CompiledMethod expected by
> Compiler-eem.282/Kernel-eem.852 for
> EncoderForNewsqueakV3
> EncoderForNewsqueakV4
> EncoderForSistaV1
>
> =============== Diff against BytecodeSets-eem.1 ===============
>
> Item was changed:
>   SystemOrganization addCategory: #'BytecodeSets-NewsqueakV3'!
> + SystemOrganization addCategory: #'BytecodeSets-SistaV1'!
>   SystemOrganization addCategory: #'BytecodeSets-NewsqueakV4'!
>
> Item was changed:
>   EncoderForV3PlusClosures subclass: #EncoderForNewsqueakV3
>         instanceVariableNames: ''
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'BytecodeSets-NewsqueakV3'!
> +
> + !EncoderForNewsqueakV3 commentStamp: 'eem 5/17/2014 16:42' prior: 0!
> + An encoder for the Newsqueak V3 bytecode set.  It adds the following
> bytecodes that are part of the first Newspeak bytecode set.
> +
> +       127     01111111 kkkkkkkk               Push Implicit Receiver For
> Selector (self literalAt: kkkkkkkk)
> +       126     01111110 jjjjjjjj kkkkkkkk      Send Selector (self
> literalAt: kkkkkkkk) To Dynamic Superclass With NumArgs jjjjjjjj
> +       139     01000101 kkkkkkkk               Push Explicit Outer
> Receiver For Level (self literalAt: kkkkkkkk)!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV3 class>>bytecodeSize: (in category
> 'instruction stream support') -----
> + bytecodeSize: bytecode
> +       "Answer the number of bytes in the bytecode."
> +       bytecode <= 125 ifTrue:
> +               [^1].
> +       bytecode >= 176 ifTrue:
> +               [^1].
> +       bytecode >= 160 ifTrue: "long jumps"
> +               [^2].
> +       bytecode >= 144 ifTrue: "short jumps"
> +               [^1].
> +       "126, 127 & extensions"
> +       ^#(3 2 2 2 2 2 3 2 2 1 1 1 2 2 3 3 3 4) at: bytecode - 125!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4
> class>>bindingReadScanBlockFor:using: (in category 'compiled method
> support') -----
> + bindingReadScanBlockFor: litVarIndex using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for reads of the value of the binding with zero-relative index
> litVarIndex.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "       16-31           0001 i i i i
>  Push Literal Variable #iiii
> +        *      224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +        *      227             11100011        i i i i i i i i Push
> Literal Variable #iiiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b < 32 and: [b >= 16 and: [b - 16 = litVarIndex]])
> +           or: [b = 227
> +                       and: [scanner followingByte + prevext =
> litVarIndex]]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4
> class>>bindingWriteScanBlockFor:using: (in category 'compiled method
> support') -----
> + bindingWriteScanBlockFor: litVarIndex using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for writes of the value of the binding with zero-relative index
> litVarIndex.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "*      224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +        *      233             11101001        i i i i i i i i Store
> Literal Variable #iiiiiiii (+ Extend A * 256)
> +        *      236             11101100        i i i i i i i i Pop and
> Store Literal Variable #iiiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b = 233 or: [b = 236])
> +          and: [scanner followingByte + prevext = litVarIndex]]!
>
> Item was removed:
> - ----- Method: EncoderForNewsqueakV4 class>>blockReturnCode (in category
> 'bytecode decoding') -----
> - blockReturnCode
> -       "218            11011010                Return Stack Top From
> Block [* return from enclosing block N, N = Extend A]"
> -       ^218!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>bytecodeSize: (in category
> 'instruction stream support') -----
> + bytecodeSize: bytecode
> +       "Answer the number of bytes in the bytecode."
> +       bytecode < 224 ifTrue: [^1].
> +       bytecode < 249 ifTrue: [^2].
> +       ^3!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>createClosureScanBlock (in
> category 'compiled method support') -----
> + createClosureScanBlock
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for block closure creation bytecodes.  ote that with this
> interface we can't answer
> +        true for the extension in front of a push closure bytecode and so
> the interface may
> +        have to change at some point."
> +
> +       "*      224     11100000        aaaaaaaa
>  Extend A (Ext A = Ext A prev * 256 + Ext A)
> +        *      225     11100001        sbbbbbbb
>  Extend B (Ext B = Ext B prev * 256 + Ext B)
> +        **     253     11111101 eei i i kkk    jjjjjjjj        Push
> Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A \\ 16 * 8)
> BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions"
> +       ^[:b| b = 253]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>extensionsAt:in:into: (in
> category 'compiled method support') -----
> + extensionsAt: bcpc in: method into: aTrinaryBlock
> +       "If the bytecode at pc is an extension then evaluate aBinaryBlock
> with the values of extA and extB and number of extension *bytes*.
> +        If the bytecode at pc is not extended then evaluate aBinaryBlock
> with 0 and 0.
> +       224             11100000        aaaaaaaa        Extend A (Ext A =
> Ext A prev * 256 + Ext A)
> +       225             11100001        sbbbbbbb        Extend B (Ext B =
> Ext B prev * 256 + Ext B)"
> +
> +       | scanpc byte extByte extA extB |
> +       scanpc := bcpc.
> +       "There may be an extension (it could be a false positive).  We
> must scan as fast as possible..."
> +       extA := extB := 0.
> +       [byte := method at: scanpc.
> +        byte >= 224 and: [byte <= 225]] whileTrue:
> +               [extByte := method at: scanpc + 1.
> +                scanpc := scanpc + 2.
> +                byte = 224
> +                       ifTrue:
> +                               [extA := (extA bitShift: 8) + extByte]
> +                       ifFalse:
> +                               [extB := (extB = 0 and: [extByte > 127])
> +                                       ifTrue: [extByte - 256]
> +                                       ifFalse: [(extB bitShift: 8) +
> extByte]]].
> +       ^aTrinaryBlock value: extA value: extB value: scanpc - bcpc
> +
> +
> + "Why use
> +       byte >= 224 and: [byte <= 225]
> +  and not
> +       (byte bitAnd: 16rFE) = 16rE0
> +  ?
> +  | n |
> +  n := 100000000.
> +  #(0 224) collect:
> +       [:byte|
> +       { Time millisecondsToRun: [1 to: n do: [:i| (byte >= 224 and:
> [byte <= 225]) ifTrue: []]].
> +          Time millisecondsToRun: [1 to: n do: [:i| (byte bitAnd: 16rFE)
> = 16rE0 ifTrue: []]] }] #(#(297 599) #(702 671))"!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4
> class>>instVarReadScanBlockFor:using: (in category 'compiled method
> support') -----
> + instVarReadScanBlockFor: varIndexCode using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for reads of the inst var with zero-relative index varIndexCode.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "       0-15            0000 i i i i
>  Push Receiver Variable #iiii
> +       *       224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +       *       226             11100010        i i i i i i i i Push
> Receiver Variable #iiiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b < 16 and: [b = varIndexCode])
> +           or: [b = 226
> +                       and: [scanner followingByte + prevext =
> varIndexCode]]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4
> class>>instVarWriteScanBlockFor:using: (in category 'compiled method
> support') -----
> + instVarWriteScanBlockFor: varIndexCode using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for writes of the inst var with zero-relative index varIndexCode.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "       176-183 10110 i i i                             Pop and
> Store Receiver Variable #iii
> +       *       224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +       *       232             11101000        i i i i i i i i Store
> Receiver Variable #iiiiiii (+ Extend A * 256)
> +       *       235             11101011        i i i i i i i i Pop and
> Store Receiver Variable #iiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b >= 176
> +           and: [b < 184
> +           and: [b - 176 = varIndexCode]])
> +          or: [(b = 232 or: [b = 235])
> +                 and: [scanner followingByte + prevext = varIndexCode]]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>interpretJumpIfCondIn: (in
> category 'compiled method support') -----
> + interpretJumpIfCondIn: anInstructionStream
> +       "Double-dispatch through the encoder to select the correct
> conditional jump decoder for the instruction set."
> +       ^anInstructionStream interpretNSV4JumpIfCond!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>interpretJumpIn: (in category
> 'compiled method support') -----
> + interpretJumpIn: anInstructionStream
> +       "Double-dispatch through the encoder to select the correct
> unconditional jump decoder for the instruction set."
> +       ^anInstructionStream interpretNSV4Jump!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isBlockReturnAt:in: (in
> category 'instruction stream support') -----
> + isBlockReturnAt: pc in: method
> +       "Answer whether the bytecode at pc is a return from block."
> +       "218            11011010                Return Stack Top From
> Block [* return from enclosing block N, N = Extend A]"
> +       ^(self nonExtensionBytecodeAt: pc in: method) = 218!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isBranchIfFalseAt:in: (in
> category 'instruction stream support') -----
> + isBranchIfFalseAt: pc in: method
> +       "Answer whether the bytecode at pc is a conditional
> branch-if-false."
> +
> +       "       208-215 11010 i i i                             Pop and
> Jump 0n False iii +1 (i.e., 1 through 8)
> +        *      244             11110100        i i i i i i i i Pop and
> Jump 0n False i i i i i i i i (+ Extend B * 256, where Extend B >= 0)"
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 208 and: [byte <= 215 or: [byte = 244]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isBranchIfTrueAt:in: (in
> category 'instruction stream support') -----
> + isBranchIfTrueAt: pc in: method
> +       "Answer whether the bytecode at pc is a conditional
> branch-if-true."
> +
> +       "       200-207 11001 i i i                             Pop and
> Jump 0n True iii +1 (i.e., 1 through 8)
> +        *      243             11110011        i i i i i i i i Pop and
> Jump 0n True i i i i i i i i (+ Extend B * 256, where Extend B >= 0)"
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 200 and: [byte <= 207 or: [byte = 243]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isExtension: (in category
> 'instruction stream support') -----
> + isExtension: bytecode
> +       "Answer if the bytecode is an extension bytecode, i.e. one that
> extends
> +        the range of the following bytecode."
> +       ^bytecode >= 16rE0 and: [bytecode <= 16rE1]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isJumpAt:in: (in category
> 'instruction stream support') -----
> + isJumpAt: pc in: method
> +       "Answer whether the bytecode at pc is an (unconditional) jump."
> +
> +       "       192-199 11000 i i i                             Jump iii +
> 1 (i.e., 1 through 8)
> +        *      225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        *      242             11110010        i i i i i i i i Jump i i i
> i i i i i (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0,
> a=0, s=1)"
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 192 and: [byte <= 199 or: [byte = 242]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isJustPopAt:in: (in category
> 'instruction stream support') -----
> + isJustPopAt: pc in: method
> +       "Answer whether the bytecode at pc is a pop."
> +
> +       ^(method at: pc) = 220 "220             11011100
>  Pop Stack Top"!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isRealSendAt:in: (in category
> 'instruction stream support') -----
> + isRealSendAt: pc in: method
> +       "Answer whether the bytecode at pc is a real message-send, not
> blockCopy:."
> +
> +       ^self isSendAt: pc in: method!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isReturnAt:in: (in category
> 'instruction stream support') -----
> + isReturnAt: pc in: method
> +       "Answer whether the bytecode at pc is a return from block."
> +       "216            11011000                Return Receiver From
> Message
> +        217            11011001                Return Stack Top From
> Message
> +        218            11011010                Return Stack Top From
> Block [* return from enclosing block N, N = Extend A]"
> +       ^(self nonExtensionBytecodeAt: pc in: method) between: 216 and:
> 218!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isSendAt:in: (in category
> 'instruction stream support') -----
> + isSendAt: pc in: method
> +       "Answer whether the bytecode at pc is a message-send."
> +
> +       "       80-95           0101 i i i i            Send Arithmetic
> Message #iiii
> +               96-111          0110 i i i i            Send Special
> Message #iiii
> +               112-127 0111 i i i i            Send Literal Selector
> #iiii With 0 Arguments
> +               128-143 1000 i i i i            Send Literal Selector
> #iiii With 1 Argument
> +               144-159 1001 i i i i            Send Literal Selector
> #iiii With 2 Arguments
> +               160-175 1010 i i i i            Send To Absent Implicit
> Receiver Literal Selector #iiii With 0 Arguments
> +        *      224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +        *      225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        **     238             11101110        i i i i i j j j Send
> Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8)
> Arguments
> +        **     239             11101111        i i i i i j j j Send To
> Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B *
> 8) Arguments
> +        **     240             11110000        i i i i i j j j Send To
> Absent Implicit Receiver Literal Selector #iiiii (+ Extend A * 32) with jjj
> (+ Extend B * 8) Arguments
> +        **     241             11110001        i i i i i j j j Send To
> Absent Dynamic Superclass Literal Selector #iiiii (+ Extend A * 32) with
> jjj (+ Extend B * 8) Arguments"
> +
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 80
> +         and: [byte <= 175
> +                or: [byte <= 241 and: [byte >= 238]]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isStoreAt:in: (in category
> 'instruction stream support') -----
> + isStoreAt: pc in: method
> +       "Answer whether the bytecode at pc is a store or store-pop."
> +
> +       "       176-183 10110 i i i
>       Pop and Store Receiver Variable #iii
> +               184-191 10111 i i i
>       Pop and Store Temporary Variable #iii
> +        *      224             11100000        aaaaaaaa
>      Extend A (Ext A = Ext A prev * 256 + Ext A)
> +        *      232             11101000        i i i i i i i i
>       Store Receiver Variable #iiiiiii (+ Extend A * 256)
> +        *      233             11101001        i i i i i i i i
>       Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +               234             11101010        i i i i i i i i
>       Store Temporary Variable #iiiiiiii
> +        *      235             11101011        i i i i i i i i
>       Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
> +        *      236             11101100        i i i i i i i i
>       Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +               237             11101101        i i i i i i i i
>       Pop and Store Temporary Variable #iiiiiiii
> +               251             11111011 kkkkkkkk       jjjjjjjj
>  Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
> +               252             11111100 kkkkkkkk       jjjjjjjj
>  Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
> +
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 176
> +         and: [byte <= 191
> +                or: [(byte between: 232 and: 237)
> +                or: [(byte between: 251 and: 252)]]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>isStorePopAt:in: (in category
> 'instruction stream support') -----
> + isStorePopAt: pc in: method
> +       "Answer whether the bytecode at pc is a store-pop."
> +
> +       "       176-183 10110 i i i
>       Pop and Store Receiver Variable #iii
> +               184-191 10111 i i i
>       Pop and Store Temporary Variable #iii
> +        *      224             11100000        aaaaaaaa
>      Extend A (Ext A = Ext A prev * 256 + Ext A)
> +        *      235             11101011        i i i i i i i i
>       Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
> +        *      236             11101100        i i i i i i i i
>       Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +               237             11101101        i i i i i i i i
>       Pop and Store Temporary Variable #iiiiiiii
> +               252             11111100 kkkkkkkk       jjjjjjjj
>  Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
> +
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 176
> +         and: [byte <= 191
> +                or: [(byte between: 235 and: 237)
> +                or: [byte = 252]]]!
>
> Item was removed:
> - ----- Method: EncoderForNewsqueakV4 class>>method:readsField: (in
> category 'scanning') -----
> - method: method readsField: varIndex
> -       "Answer if method loads the instance variable indexed by varIndex.
> -        N.B. Don't assume the compiler uses the most compact encoding
> available.
> -               0-15            0000 i i i i
>  Push Receiver Variable #iiii
> -       *       224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> -       *       226             11100010        i i i i i i i i Push
> Receiver Variable #iiiiiiii (+ Extend A * 256)"
> -       | varIndexCode scanner extension |
> -       varIndexCode := varIndex - 1.
> -       method isReturnField ifTrue:
> -               [^method returnField = varIndexCode].
> -       extension := 0.
> -       ^(scanner := InstructionStream on: method) scanFor:
> -               [:b| | prevext |
> -               prevext := extension.
> -               extension := b = 224 ifTrue: [scanner followingByte
> bitShift: 8] ifFalse: [0].
> -               (b < 16 and: [b = varIndexCode])
> -               or: [b = 226
> -                       and: [scanner followingByte + prevext =
> varIndexCode]]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4
> class>>method:refersInBytecodeToLiteral:specialSelectorIndex: (in category
> 'scanning') -----
> + method: method refersInBytecodeToLiteral: aLiteral specialSelectorIndex:
> specialOrNil
> +       "Answer if method refers to the literal aLiteral in the bytecode,
> as opposed to in its literal frame."
> +
> +       "*      77                      01001101
>      Push false [* 1:true, 2:nil, 3:thisContext, ..., -N:
> pushExplicitOuter: N, N = Extend B]
> +               78                      01001110
>      Push 0
> +               79                      01001111
>      Push 1
> +               80-95           0101 i i i i
>  Send Arithmetic Message #iiii
> +               96-111          0110 i i i i
>  Send Special Message #iiii
> +        *      225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        *      229             11100101        i i i i i i i i Push
> Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768
> = i=0, a=0, s=1)"
> +       | byte extended scanner |
> +       specialOrNil ifNotNil:
> +               [byte := specialOrNil + 79.
> +               ^(InstructionStream on: method) scanFor: [:b| b = byte]].
> +       extended := false.
> +       aLiteral isInteger ifTrue:
> +               [(aLiteral >= -32768 and: [aLiteral <= 32767]) ifFalse:
> [^false].
> +                scanner := InstructionStream on: method.
> +                (aLiteral >= 0 and: [aLiteral <= 255]) ifTrue:
> +                       [aLiteral <= 1 ifTrue:
> +                               [byte := aLiteral + 80.
> +                                ^scanner scanFor: [:b| b = byte]].
> +                        ^scanner scanFor:
> +                               [:b|
> +                               (b = 229
> +                                and: [extended not
> +                                and: [scanner followingByte = aLiteral]])
> +                               or: [extended := b = 225.
> +                                       false]]].
> +                byte := (aLiteral bitShift: -8) bitAnd: 255.
> +               ^scanner scanFor:
> +                       [:b|
> +                       (b = 229
> +                        and: [extended
> +                        and: [scanner followingByte = (aLiteral bitAnd:
> 255)]])
> +                       or: [extended := b = 225 and: [scanner
> followingByte = byte].
> +                               false]]].
> +       byte := #(false true nil) identityIndexOf: aLiteral ifAbsent: 0.
> +       byte = 0 ifTrue:
> +               [^false].
> +       scanner := InstructionStream on: method.
> +       byte = 1 ifTrue:
> +               [^scanner scanFor:
> +                       [:b|
> +                       (b = 77
> +                        and: [extended not])
> +                       or: [extended := b = 225.
> +                               false]]].
> +       byte := byte - 1.
> +       ^scanner scanFor:
> +               [:b|
> +               (b = 77
> +                and: [extended])
> +               or: [extended := b = 225 and: [scanner followingByte =
> byte].
> +                       false]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>nonExtensionBytecodeAt:in:
> (in category 'instruction stream support') -----
> + nonExtensionBytecodeAt: pc in: method
> +       "Answer the actual bytecode at pc in method, skipping past any
> preceeding extensions."
> +       | thePC bytecode |
> +       thePC := pc.
> +       [self isExtension: (bytecode := method at: thePC)] whileTrue:
> +               [thePC := thePC + (self bytecodeSize: bytecode)].
> +       ^bytecode!
>
> Item was removed:
> - ----- Method: EncoderForNewsqueakV4 class>>popCode (in category
> 'bytecode decoding') -----
> - popCode
> -       "220            11011100                Pop Stack Top"
> -       ^220!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>superSendScanBlockUsing: (in
> category 'instruction stream support') -----
> + superSendScanBlockUsing: scanner
> +       "Answer a block argument for InstructionStream>>scanFor:
> +        that answers true for super sends."
> +
> +       "*      224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +        *      225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        **     239             11101111        i i i i i j j j Send To
> Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B *
> 8) Arguments
> +        **     241             11110001        i i i i i j j j Send To
> Absent Dynamic Superclass Literal Selector #iiiii (+ Extend A * 32) with
> jjj (+ Extend B * 8) Arguments"
> +
> +       ^[:instr | instr = 239 or: [instr = 241]]!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4 class>>supportsClosures (in category
> 'compiled method support') -----
> + supportsClosures
> +       "Answer if the instruction set supports closures (contains
> +        closure creation and indirect temp access bytecodes)."
> +
> +       ^true!
>
> Item was changed:
>   ----- Method: EncoderForNewsqueakV4>>genBranchPopFalse: (in category
> 'bytecode generation') -----
>   genBranchPopFalse: distance
> -       | distanceMod256 |
> -       (distance < 0 or: [distance > 32767]) ifTrue:
> -               [^self outOfRangeError: 'distance' index: distance range:
> 0 to: 32767].
>         (distance > 0 and: [distance < 9]) ifTrue:
>                 ["208-215       11010 i i i             Pop and Jump 0n
> False iii +1 (i.e., 1 through 8)"
>                  stream nextPut: 207 + distance.
>                  ^self].
> +       ^self genBranchPopFalseLong: distance!
> -       "244            11110100        i i i i i i i i Pop and Jump 0n
> False i i i i i i i i (+ Extend B * 256)"
> -       distanceMod256 := (distance < 0 or: [distance > 255])
> -                                                               ifTrue:
> -
> [self genUnsignedSingleExtendB: (distance bitShift: -8).
> -
>  distance bitAnd: 255]
> -                                                               ifFalse:
> [distance].
> -       stream
> -               nextPut: 244;
> -               nextPut: distanceMod256!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4>>genBranchPopFalseLong: (in category
> 'bytecode generation') -----
> + genBranchPopFalseLong: distance
> +       "244            11110100        i i i i i i i i Pop and Jump 0n
> False i i i i i i i i (+ Extend B * 256)"
> +       | distanceMod256 |
> +       (distance < 0 or: [distance > 32767]) ifTrue:
> +               [^self outOfRangeError: 'distance' index: distance range:
> 0 to: 32767].
> +       distanceMod256 := (distance < 0 or: [distance > 255])
> +                                                               ifTrue:
> +
> [self genUnsignedSingleExtendB: (distance bitShift: -8).
> +
>  distance bitAnd: 255]
> +                                                               ifFalse:
> [distance].
> +       stream
> +               nextPut: 244;
> +               nextPut: distanceMod256!
>
> Item was changed:
>   ----- Method: EncoderForNewsqueakV4>>genBranchPopTrue: (in category
> 'bytecode generation') -----
>   genBranchPopTrue: distance
> -       | distanceMod256 |
> -       (distance < 0 or: [distance > 32767]) ifTrue:
> -               [^self outOfRangeError: 'distance' index: distance range:
> 0 to: 32767].
>         (distance > 0 and: [distance < 9]) ifTrue:
>                 ["200-207       11001 i i i             Pop and Jump 0n
> True iii +1 (i.e., 1 through 8)"
>                  stream nextPut: 199 + distance.
>                  ^self].
> +       ^self genBranchPopTrueLong: distance!
> -       "243            11110011        i i i i i i i i Pop and Jump 0n
> True i i i i i i i i (+ Extend B * 256)"
> -       distanceMod256 := (distance < 0 or: [distance > 255])
> -                                                               ifTrue:
> -
> [self genUnsignedSingleExtendB: (distance bitShift: -8).
> -
>  distance bitAnd: 255]
> -                                                               ifFalse:
> [distance].
> -       stream
> -               nextPut: 243;
> -               nextPut: distanceMod256!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4>>genBranchPopTrueLong: (in category
> 'bytecode generation') -----
> + genBranchPopTrueLong: distance
> +       "243            11110011        i i i i i i i i Pop and Jump 0n
> True i i i i i i i i (+ Extend B * 256)"
> +       | distanceMod256 |
> +       (distance < 0 or: [distance > 32767]) ifTrue:
> +               [^self outOfRangeError: 'distance' index: distance range:
> 0 to: 32767].
> +       (distance > 0 and: [distance < 9]) ifTrue:
> +               ["200-207       11001 i i i             Pop and Jump 0n
> True iii +1 (i.e., 1 through 8)"
> +                stream nextPut: 199 + distance.
> +                ^self].
> +       distanceMod256 := (distance < 0 or: [distance > 255])
> +                                                               ifTrue:
> +
> [self genUnsignedSingleExtendB: (distance bitShift: -8).
> +
>  distance bitAnd: 255]
> +                                                               ifFalse:
> [distance].
> +       stream
> +               nextPut: 243;
> +               nextPut: distanceMod256!
>
> Item was added:
> + ----- Method: EncoderForNewsqueakV4>>genExt1: (in category 'bytecode
> generation') -----
> + genExt1: aSmallInteger
> +       self shouldBeImplemented!
>
> Item was added:
> + BytecodeEncoder subclass: #EncoderForSistaV1
> +       instanceVariableNames: ''
> +       classVariableNames: ''
> +       poolDictionaries: ''
> +       category: 'BytecodeSets-SistaV1'!
> +
> + !EncoderForSistaV1 commentStamp: 'eem 4/16/2014 14:44' prior: 0!
> + EncoderForSistaV1 encodes a bytecode set for Sista, the Speculative
> Inlining Smalltalk Architecture, a project by Clément Bera and Eliot
> Miranda.  Sista is an optimizer that exists in the Smalltalk image, /not/
> in the VM,  and optimizes by substituting normal bytecoded methods by
> optimized bytecoded methods that may use special bytecodes for which the
> Cogit can generate faster code.  These bytecodes eliminate overheads such
> as bounds checks or polymorphic code (indexing Array, ByteArray, String
> etc).  But the bulk of the optimization performed is in inlining blocks and
> sends for the common path.  This bytecode set therefore differs from a
> normal Smalltalk set in providing a set of inlined primitives that do not
> validate their arguments that the compiler generates only when it can prove
> that the primitives' arguments are valid.
> +
> + The basic scheme is that the Cogit generates code containing performance
> counters.  When these counters trip, a callback into the image is
> performed, at which point Sista analyses some portion of the stack, looking
> at performance data for the methods on the stack, and optimises based on
> the stack and performance data.  Execution then resumes in the optimized
> code.
> +
> + The Sista Cogit (e.g. SistaStackToRegisterMappingCogit) adds counters to
> conditional branches.  Each branch has an executed and a taken count.  On
> execution the executed count is decremented and if the count goes below
> zero the VM sends a message at a special index in the specialObjectsArray
> (as of writing, conditionalCounterTrippedOn:).  Then if the branch is taken
> the taken count is decremented.  The two counter values allow the Sista
> optimizer to collect basic block execution paths and to know what are the
> "hot" paths through execution that are worth agressively optimizing.  Since
> conditional branches are about 1/6 as frequent as sends, and since they can
> be used to determine the hot path through code, they are a better choice to
> count than, for example, method or block entry.
> +
> + The VM provides a primitive that fills an Array with the state of the
> counters, and the state of each linked send in a method.  Tthe optimizer
> obtains the branch and send data for a method via this primitive.
> +
> +
> + This bytecde set encodes a bytecode set for Smalltalk that lifts limits
> on the number of literals and branch distances, and extended push integer
> and push character bytecodes.  Bytecodes are ordered by length to make
> decoding easier.  Bytecodes marked with an * are extensible via a prefix
> bytecode.
> +
> + N.B.  Extension bytecodes can only come before extensible bytecodes, and
> only if valid (one cannot extend a bytecode extensible by Ext A with an Ext
> B).  An extensible bytecode consumes (and zeros) its extension(s).  Hence
> the hidden implicit variables holding extensions are always zero except
> after a valid sequence of extension bytecodes.
> +
> + Instance Variables (inherited)
> +
> + 1 Byte Bytecodes
> +       0-15            0000 iiii                       Push Receiver
> Variable #iiii
> +       16-31           0001 iiii                       Push Literal
> Variable #iiii
> +       32-63           001 iiiii                               Push
> Literal #iiiii
> +       64-71           01000 iii                       Push Temp #iii
> +       72-75           010010 ii                       Push Temp #ii + 8
> +       76                      01001100                        Push
> Receiver
> +       77                      01001101                        Push true
> +       78                      01001110                        Push false
> +       79                      01001111                        Push nil
> +       80                      01010000                        Push 0
> +       81                      01010001                        Push 1
> + *     82                      01010010                        Push
> thisContext, (then e.g. Extend 1 = push thisProcess)
> +       83                      01010011                        Duplicate
> Stack Top
> +       84-87           010101 ii                       UNASSIGNED
> +       88-91           010110 ii                       Return
> Receiver/true/false/nil
> +       92                      01011100                        Return top
> +       93                      01011101
>  BlockReturn nil
> + *     94                      01011110
>  BlockReturn Top [* return from enclosing block N, N = Extend A, then jump
> by Ext B ]
> + *     95                      01011111                        Nop
> +       96-111          0110 iiii                       Send Arithmetic
> Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift:
> #'//' #bitAnd: #bitOr:)
> +       112-119 01110 iii                       Send Special Message #iii
> #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class)
> +       120             01111000                        UNASSIGNED (was:
> blockCopy:)
> +       121             01111001                        Send Special
> Message #value
> +       122-123 0111101 i                       Send Special Message #i
> #(#value: #do:)
> +       124-127 011111 ii                       Send Special Message #ii
> #(#new #new: #x #y))
> +       128-143 1000 iiii                       Send Literal Selector
> #iiii With 0 Argument
> +       144-159 1001 iiii                       Send Literal Selector
> #iiii With 1 Arguments
> +       160-175 1010 iiii                       Send Literal Selector
> #iiii With 2 Arguments
> +       176-183 10110 iii                       Jump iii + 1 (i.e., 1
> through 8)
> +       184-191 10111 iii                       Pop and Jump 0n True iii
> +1 (i.e., 1 through 8)
> +       192-199 11000 iii                       Pop and Jump 0n False iii
> +1 (i.e., 1 through 8)
> +       200-207 11001 iii                       Pop and Store Receiver
> Variable #iii
> +       208-215 11010 iii                       Pop and Store Temporary
> Variable #iii
> +       216             11011000                        Pop Stack Top
> +       217             11011001                        UNASSIGNED
> +       218-219 1101101 i                       UNASSIGNED
> +       220-223 110111 ii                       UNASSIGNED
> +
> + 2 Byte Bytecodes
> + *     224             11100000        aaaaaaaa        Extend A (Ext A =
> Ext A prev * 256 + Ext A)
> + *     225             11100001        bbbbbbbb        Extend B (Ext B =
> Ext B prev * 256 + Ext B)
> + *     226             11100010        iiiiiiii                Push
> Receiver Variable #iiiiiiii (+ Extend A * 256)
> + *     227             11100011        iiiiiiii                Push
> Literal Variable #iiiiiiii (+ Extend A * 256)
> + *     228             11100100        iiiiiiii                Push
> Literal #iiiiiiii (+ Extend A * 256)
> +       229             11100101        iiiiiiii                Push
> Temporary Variable #iiiiiiii
> +       230             11100110        iiiiiiii
>  PushNClosureTemps iiiiiiii
> +       231             11100111        jkkkkkkk        Push (Array new:
> kkkkkkk) (j = 0)
> +                                                                       &
>       Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)
> + *     232             11101000        iiiiiiii                Push
> Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768
> = i=0, a=0, s=1)
> + *     233             11101001        iiiiiiii                Push
> Character #iiiiiiii (+ Extend B * 256)
> + **    234             11101010        iiiiijjj                Send
> Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8)
> Arguments
> + **    235             11101011        iiiiijjj                Send To
> Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B *
> 8) Arguments
> + *     236             11101100        iiiiiiii                Trap On
> Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)
> + *     237             11101101        iiiiiiii                Jump
> #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0,
> a=0, s=1)
> + *     238             11101110        iiiiiiii                Pop and
> Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0)
> + *     239             11101111        iiiiiiii                Pop and
> Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)
> + *     240             11110000        iiiiiiii                Pop and
> Store Receiver Variable #iiiiiii (+ Extend A * 256)
> + *     241             11110001        iiiiiiii                Pop and
> Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +       242             11110010        iiiiiiii                Pop and
> Store Temporary Variable #iiiiiiii
> + *     243             11110011        iiiiiiii                Store
> Receiver Variable #iiiiiii (+ Extend A * 256)
> + *     244             11110100        iiiiiiii                Store
> Literal Variable #iiiiiiii (+ Extend A * 256)
> +       245             11110110        iiiiiiii                Store
> Temporary Variable #iiiiiiii
> +       246-247 1111011 i       xxxxxxxx        UNASSIGNED
> +
> + 3 Byte Bytecodes
> +       248             11111000        iiiiiiii                mjjjjjjj
>              Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined
> primitive, no hard return after execution.
> +       249             11111001        xxxxxxxx        syyyyyyy
>  Reserved for Push Float
> + **    250             11111010        eeiiikkk                jjjjjjjj
>              Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+
> ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions
> +       251             11111011        kkkkkkkk        jjjjjjjj
>      Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
> +       252             11111100        kkkkkkkk        jjjjjjjj
>      Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
> +       253             11111101        kkkkkkkk        jjjjjjjj
>      Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
> +       254-255 1111111i        xxxxxxxx        yyyyyyyy        UNASSIGNED
> +
> + The Call Primitive Bytecode specifies either a primitive in the
> primitive table (m=0) or an inlined primitive (m=1). Non-inlined primtiives
> from the primitive table have index (jjjjjjj * 256) + iiiiiiii and return
> from the method if they succeed.  This bytecode is only valid as the first
> bytecode of a method.  Inline primitives have index (jjjjjjj * 256) +
> iiiiiiii, cannot fail, and do not return when they succeed, yielding a
> result (typically on top of stack after popping their arguments, but
> possibly in a byte data stack, for example for unboxed floating-point
> primitives).
> +
> + We define the following inlined primitives:
> + 0     unchecked SmallInteger #+.  Both arguments are SmallIntegers and
> the result fits in a SmallInteger (* depends on word size)
> + 1     unchecked SmallInteger #-.  Both arguments are SmallIntegers and
> the result fits in a SmallInteger (* depends on word size)
> + 2     unchecked SmallInteger #*.  Both arguments are SmallIntegers and
> the result fits in a SmallInteger (* depends on word size)
> + 3     unchecked SmallInteger #/.  Both arguments are SmallIntegers and
> the result fits in a SmallInteger (* depends on word size)
> + 4     unchecked SmallInteger #//.  Both arguments are SmallIntegers and
> the result fits in a SmallInteger (* depends on word size)
> + 5     unchecked SmallInteger #\\.  Both arguments are SmallIntegers and
> the result fits in a SmallInteger (* depends on word size)
> + 6     unchecked SmallInteger #rem:.  Both arguments are SmallIntegers
> and the result fits in a SmallInteger (* depends on word size)
> +
> + 16    unchecked SmallInteger #bitAnd:.  Both arguments are SmallIntegers
> and the result fits in a SmallInteger (* depends on word size)
> + 17    unchecked SmallInteger #bitOr:.  Both arguments are SmallIntegers
> and the result fits in a SmallInteger (* depends on word size)
> + 18    unchecked SmallInteger #bitXor:.  Both arguments are SmallIntegers
> and the result fits in a SmallInteger (* depends on word size)
> + 19    unchecked SmallInteger #bitShift:.  Both arguments are
> SmallIntegers and the result fits in a SmallInteger (* depends on word size)
> +
> + 32    unchecked SmallInteger #>.  Both arguments are SmallIntegers
> + 33    unchecked SmallInteger #<.  Both arguments are SmallIntegers
> + 34    unchecked SmallInteger #>=.  Both arguments are SmallIntegers
> + 35    unchecked SmallInteger #<=.  Both arguments are SmallIntegers
> + 36    unchecked SmallInteger #=.  Both arguments are SmallIntegers
> + 37    unchecked SmallInteger #!!=.  Both arguments are SmallIntegers
> +
> + 64    unchecked Pointer Object>>at:.          The receiver is guaranteed
> to be a pointer object.  The 0-relative (1-relative?) index is an in-range
> SmallInteger
> + 65    unchecked Byte Object>>at:.                     The receiver is
> guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index
> is an in-range SmallInteger.  The result is a SmallInteger.
> + 66    unchecked Word Object>>at:.                     The receiver is
> guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index
> is an in-range SmallInteger.  The result is a SmallInteger.
> + 67    unchecked DoubleWord Object>>at:.       The receiver is guaranteed
> to be a non-pointer object.  The 0-relative (1-relative?) index is an
> in-range SmallInteger.  The result is a SmallInteger or a
> LargePositiveInteger.
> + 67    unchecked QuadWord Object>>at:.         The receiver is guaranteed
> to be a non-pointer object.  The 0-relative (1-relative?) index is an
> in-range SmallInteger.  The result is a SmallInteger or a
> LargePositiveInteger.
> +
> + 80    unchecked Pointer Object>>at:put:.                      The
> receiver is guaranteed to be a pointer object.  The 0-relative
> (1-relative?) index is an in-range SmallInteger
> + 81    unchecked Byte Object>>at:put:.                 The receiver is
> guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index
> is an in-range SmallInteger.  The argument is a SmallInteger.  The
> primitive stores the least significant 8 bits.
> + 82    unchecked Word Object>>at:put:.                 The receiver is
> guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index
> is an in-range SmallInteger.  The argument is a SmallInteger.  The
> primitive stores the least significant 16 bits.
> + 83    unchecked DoubleWord Object>>at:put:.   The receiver is guaranteed
> to be a non-pointer object.  The 0-relative (1-relative?) index is an
> in-range SmallInteger.  The argument is a SmallInteger.  The primitive
> stores the least significant 32 bits.
> + 83    unchecked QuadWord Object>>at:put:.             The receiver is
> guaranteed to be a non-pointer object.  The 0-relative (1-relative?) index
> is an in-range SmallInteger.  The argument is a SmallInteger.  The
> primitive stores the least significant 64 bits.!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>bindingReadScanBlockFor:using:
> (in category 'compiled method support') -----
> + bindingReadScanBlockFor: litVarIndex using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for reads of the value of the binding with zero-relative index
> litVarIndex.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "       16-31           0001 i i i i
>  Push Literal Variable #iiii
> +        *      224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +        *      227             11100011        i i i i i i i i Push
> Literal Variable #iiiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b < 32 and: [b >= 16 and: [b - 16 = litVarIndex]])
> +           or: [b = 227
> +                       and: [scanner followingByte + prevext =
> litVarIndex]]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>bindingWriteScanBlockFor:using:
> (in category 'compiled method support') -----
> + bindingWriteScanBlockFor: litVarIndex using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for writes of the value of the binding with zero-relative index
> litVarIndex.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "*      224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +        *      241             11110001        iiiiiiii
>  Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +        *      244             11110100        iiiiiiii
>  Store Literal Variable #iiiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b = 241 or: [b = 244])
> +          and: [scanner followingByte + prevext = litVarIndex]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>bytecodeSize: (in category
> 'instruction stream support') -----
> + bytecodeSize: bytecode
> +       "Answer the number of bytes in the bytecode."
> +       bytecode < 224 ifTrue: [^1].
> +       bytecode < 248 ifTrue: [^2].
> +       ^3!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>callPrimitiveCode (in category
> 'bytecode decoding') -----
> + callPrimitiveCode
> +       "Answer the call primitive bytecode, if it exists in the encoder's
> bytecode set, or nil if not.
> +        248    11111000        iiiiiiii        mjjjjjjj        Call
> Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard
> return after execution."
> +       ^248!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>createClosureScanBlock (in
> category 'compiled method support') -----
> + createClosureScanBlock
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for block closure creation bytecodes.  ote that with this
> interface we can't answer
> +        true for the extension in front of a push closure bytecode and so
> the interface may
> +        have to change at some point."
> +
> +       "*      224     11100000        aaaaaaaa
>  Extend A (Ext A = Ext A prev * 256 + Ext A)
> +        *      225             11100001        bbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        **     250             11111010        eeiiikkk
>  jjjjjjjj                Push Closure Num Copied iii (+ExtA//16*8) Num Args
> kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions"
> +       ^[:b| b = 250]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>extensionsAt:in:into: (in
> category 'compiled method support') -----
> + extensionsAt: bcpc in: method into: aTrinaryBlock
> +       "If the bytecode at pc is an extension then evaluate aBinaryBlock
> with the values of extA and extB and number of extension *bytes*.
> +        If the bytecode at pc is not extended then evaluate aBinaryBlock
> with 0 and 0.
> +       224             11100000        aaaaaaaa        Extend A (Ext A =
> Ext A prev * 256 + Ext A)
> +       225             11100001        bbbbbbbb        Extend B (Ext B =
> Ext B prev * 256 + Ext B)"
> +
> +       | scanpc byte extByte extA extB |
> +       scanpc := bcpc.
> +       "There may be an extension (it could be a false positive).  We
> must scan as fast as possible..."
> +       extA := extB := 0.
> +       [byte := method at: scanpc.
> +        byte >= 224 and: [byte <= 225]] whileTrue:
> +               [extByte := method at: scanpc + 1.
> +                scanpc := scanpc + 2.
> +                byte = 224
> +                       ifTrue:
> +                               [extA := (extA bitShift: 8) + extByte]
> +                       ifFalse:
> +                               [extB := (extB = 0 and: [extByte > 127])
> +                                       ifTrue: [extByte - 256]
> +                                       ifFalse: [(extB bitShift: 8) +
> extByte]]].
> +       ^aTrinaryBlock value: extA value: extB value: scanpc - bcpc
> +
> +
> + "Why use
> +       byte >= 224 and: [byte <= 225]
> +  and not
> +       (byte bitAnd: 16rFE) = 16rE0
> +  ?
> +  | n |
> +  n := 100000000.
> +  #(0 224) collect:
> +       [:byte|
> +       { Time millisecondsToRun: [1 to: n do: [:i| (byte >= 224 and:
> [byte <= 225]) ifTrue: []]].
> +          Time millisecondsToRun: [1 to: n do: [:i| (byte bitAnd: 16rFE)
> = 16rE0 ifTrue: []]] }] #(#(297 599) #(702 671))"!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>instVarReadScanBlockFor:using:
> (in category 'compiled method support') -----
> + instVarReadScanBlockFor: varIndexCode using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for reads of the inst var with zero-relative index varIndexCode.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "       0-15            0000 i i i i
>  Push Receiver Variable #iiii
> +       *       224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +       *       226             11100010        i i i i i i i i Push
> Receiver Variable #iiiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b < 16 and: [b = varIndexCode])
> +           or: [b = 226
> +                       and: [scanner followingByte + prevext =
> varIndexCode]]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>instVarWriteScanBlockFor:using:
> (in category 'compiled method support') -----
> + instVarWriteScanBlockFor: varIndexCode using: scanner
> +       "Answer a block argument for InstructionStream>>scanFor: that
> answers true
> +        for writes of the inst var with zero-relative index varIndexCode.
> +        N.B. Don't assume the compiler uses the most compact encoding
> available."
> +
> +       "       200-207 11001 iii                       Pop and Store
> Receiver Variable #iii
> +       *       224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +       *       240             11110000        iiiiiiii
>  Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
> +       *       243             11110011        iiiiiiii
>  Store Receiver Variable #iiiiiii (+ Extend A * 256)"
> +       | extension |
> +       extension := 0.
> +       ^[:b| | prevext |
> +          prevext := extension.
> +          extension := b = 224 ifTrue: [scanner followingByte bitShift:
> 8] ifFalse: [0].
> +          (b >= 200
> +           and: [b < 208
> +           and: [b - 200 = varIndexCode]])
> +          or: [(b = 240 or: [b = 243])
> +                 and: [scanner followingByte + prevext = varIndexCode]]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>interpretJumpIfCondIn: (in
> category 'compiled method support') -----
> + interpretJumpIfCondIn: anInstructionStream
> +       "Double-dispatch through the encoder to select the correct
> conditional jump decoder for the instruction set."
> +       ^anInstructionStream interpretSistaV1JumpIfCond!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>interpretJumpIn: (in category
> 'compiled method support') -----
> + interpretJumpIn: anInstructionStream
> +       "Double-dispatch through the encoder to select the correct
> unconditional jump decoder for the instruction set."
> +       ^anInstructionStream interpretSistaV1Jump!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>interpretNextInstructionFor:in:
> (in category 'instruction stream support') -----
> + interpretNextInstructionFor: aClient in: anInstructionStream
> +       "Double-dispatch through the encoder to select the correct
> instruction set decoder."
> +       ^anInstructionStream interpretNextSistaV1InstructionFor: aClient!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isBlockReturnAt:in: (in category
> 'instruction stream support') -----
> + isBlockReturnAt: pc in: method
> +       "Answer whether the bytecode at pc is a return from block."
> +       "       93                      01011101
>  BlockReturn nil
> +        *      94                      01011110
>  BlockReturn Top [* return from enclosing block N, N = Extend A, then jump
> by Ext B ]"
> +       ^(self nonExtensionBytecodeAt: pc in: method) between: 93 and: 94!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isBranchIfFalseAt:in: (in
> category 'instruction stream support') -----
> + isBranchIfFalseAt: pc in: method
> +       "Answer whether the bytecode at pc is a conditional
> branch-if-false."
> +
> +       "       192-199 11000 iii                               Pop and
> Jump 0n False iii +1 (i.e., 1 through 8)
> +        *      239             11101111        iiiiiiii
>  Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)"
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 192 and: [byte <= 199 or: [byte = 239]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isBranchIfTrueAt:in: (in category
> 'instruction stream support') -----
> + isBranchIfTrueAt: pc in: method
> +       "Answer whether the bytecode at pc is a conditional
> branch-if-true."
> +
> +       "       184-191 10111 iii                               Pop and
> Jump 0n True iii +1 (i.e., 1 through 8)
> +        *      238             11101110        iiiiiiii
>  Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0))"
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 184 and: [byte <= 191 or: [byte = 238]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isExtension: (in category
> 'instruction stream support') -----
> + isExtension: bytecode
> +       "Answer if the bytecode is an extension bytecode, i.e. one that
> extends
> +        the range of the following bytecode."
> +       ^bytecode >= 16rE0 and: [bytecode <= 16rE1]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isJumpAt:in: (in category
> 'instruction stream support') -----
> + isJumpAt: pc in: method
> +       "Answer whether the bytecode at pc is an (unconditional) jump."
> +
> +       "       176-183 10110 iii                               Jump iii +
> 1 (i.e., 1 through 8)
> +        *      225             11100001        bbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        *      237             11101101        iiiiiiii
>  Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 =
> i=0, a=0, s=1)"
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 176 and: [byte <= 183 or: [byte = 237]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isJustPopAt:in: (in category
> 'instruction stream support') -----
> + isJustPopAt: pc in: method
> +       "Answer whether the bytecode at pc is a pop."
> +
> +       ^(method at: pc) = 216 "216             11011000
>      Pop Stack Top"!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isRealSendAt:in: (in category
> 'instruction stream support') -----
> + isRealSendAt: pc in: method
> +       "Answer whether the bytecode at pc is a real message-send, not
> blockCopy:."
> +
> +       ^self isSendAt: pc in: method!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isReturnAt:in: (in category
> 'instruction stream support') -----
> + isReturnAt: pc in: method
> +       "Answer whether the bytecode at pc is a return from block."
> +       "       88-91           010110 ii                       Return
> Receiver/true/false/nil
> +               92                      01011100
>  Return top
> +               93                      01011101
>  BlockReturn nil
> +        *      94                      01011110
>  BlockReturn Top [* return from enclosing block N, N = Extend A, then jump
> by Ext B ]"
> +       ^(self nonExtensionBytecodeAt: pc in: method) between: 88 and: 94!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isSendAt:in: (in category
> 'instruction stream support') -----
> + isSendAt: pc in: method
> +       "Answer whether the bytecode at pc is a message-send."
> +
> +       "       96-111          0110 iiii                       Send
> Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@
> #bitShift: #'//' #bitAnd: #bitOr:)
> +               112-119 01110 iii                       Send Special
> Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class)
> +               120             01111000                        UNASSIGNED
> (was: blockCopy:)
> +               121             01111001                        Send
> Special Message #value
> +               122-123 0111101 i                       Send Special
> Message #i #(#value: #do:)
> +               124-127 011111 ii                       Send Special
> Message #ii #(#new #new: #x #y))
> +               128-143 1000 iiii                       Send Literal
> Selector #iiii With 0 Argument
> +               144-159 1001 iiii                       Send Literal
> Selector #iiii With 1 Arguments
> +               160-175 1010 iiii                       Send Literal
> Selector #iiii With 2 Arguments
> +        **     234             11101010        iiiiijjj        Send
> Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8)
> Arguments
> +        **     235             11101011        iiiiijjj        Send To
> Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B *
> 8) Arguments"
> +
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 96
> +         and: [byte <= 175
> +                or: [byte >= 234 and: [byte <= 235]]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isStoreAt:in: (in category
> 'instruction stream support') -----
> + isStoreAt: pc in: method
> +       "Answer whether the bytecode at pc is a store or store-pop."
> +
> +       "       200-207 11001 iii
>       Pop and Store Receiver Variable #iii
> +               208-215 11010 iii
>       Pop and Store Temporary Variable #iii
> +        *      224             11100000        aaaaaaaa
>      Extend A (Ext A = Ext A prev * 256 + Ext A)
> +        *      240             11110000        iiiiiiii
>              Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
> +        *      241             11110001        iiiiiiii
>              Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +               242             11110010        iiiiiiii
>              Pop and Store Temporary Variable #iiiiiiii
> +        *      243             11110011        iiiiiiii
>              Store Receiver Variable #iiiiiii (+ Extend A * 256)
> +        *      244             11110100        iiiiiiii
>              Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +               245             11110110        iiiiiiii
>              Store Temporary Variable #iiiiiiii
> +
> +               252             11111100        kkkkkkkk        jjjjjjjj
>      Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj
> +               253             11111101        kkkkkkkk        jjjjjjjj
>      Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
> +
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 200
> +         and: [byte <= 215
> +                or: [(byte between: 240 and: 245)
> +                or: [(byte between: 252 and: 253)]]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>isStorePopAt:in: (in category
> 'instruction stream support') -----
> + isStorePopAt: pc in: method
> +       "Answer whether the bytecode at pc is a store or store-pop."
> +
> +       "       200-207 11001 iii
>       Pop and Store Receiver Variable #iii
> +               208-215 11010 iii
>       Pop and Store Temporary Variable #iii
> +        *      224             11100000        aaaaaaaa
>      Extend A (Ext A = Ext A prev * 256 + Ext A)
> +        *      240             11110000        iiiiiiii
>              Pop and Store Receiver Variable #iiiiiii (+ Extend A * 256)
> +        *      241             11110001        iiiiiiii
>              Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
> +               242             11110010        iiiiiiii
>              Pop and Store Temporary Variable #iiiiiiii
> +
> +               253             11111101        kkkkkkkk        jjjjjjjj
>      Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
> +
> +       | byte |
> +       byte := self nonExtensionBytecodeAt: pc in: method.
> +       ^byte >= 200
> +         and: [byte <= 215
> +                or: [(byte between: 240 and: 242)
> +                or: [byte = 253]]]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1
> class>>method:refersInBytecodeToLiteral:specialSelectorIndex: (in category
> 'scanning') -----
> + method: method refersInBytecodeToLiteral: aLiteral specialSelectorIndex:
> specialOrNil
> +       "Answer if method refers to the literal aLiteral in the bytecode,
> as opposed to in its literal frame."
> +
> +       "       77                      01001101
>      Push true
> +               78                      01001110
>      Push false
> +               79                      01001111
>      Push nil
> +               80                      01010000
>      Push 0
> +               81                      01010001
>      Push 1
> +               88-91           010110 ii
> Return Receiver/true/false/nil
> +               93                      01011101
>      BlockReturn nil
> +               96-111          0110 iiii
> Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/
> #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
> +               112-119 01110 iii                               Send
> Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'=='
> class)
> +               120             01111000
>  UNASSIGNED (was: blockCopy:)
> +               121             01111001
>  Send Special Message #value
> +               122-123 0111101 i                               Send
> Special Message #i #(#value: #do:)
> +               124-127 011111 ii                               Send
> Special Message #ii #(#new #new: #x #y))
> +       *       224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +       *       225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +       *       232             11101000        iiiiiiii
>  Push Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g.
> -32768 = i=0, a=0, s=1)
> +       *       233             11101001        iiiiiiii
>  Push Character #iiiiiiii (+ Extend B * 256)
> +               249             11111001        xxxxxxxx        syyyyyyy
>      Reserved for Push Float"
> +       | byte extended scanner |
> +       specialOrNil ifNotNil:
> +               [byte := specialOrNil + 95.
> +               ^(InstructionStream on: method) scanFor: [:b| b = byte]].
> +       extended := false.
> +       aLiteral isInteger ifTrue:
> +               [(aLiteral >= -32768 and: [aLiteral <= 32767]) ifFalse:
> [^false].
> +                scanner := InstructionStream on: method.
> +                (aLiteral >= 0 and: [aLiteral <= 255]) ifTrue:
> +                       [aLiteral <= 1 ifTrue:
> +                               [byte := aLiteral + 80.
> +                                ^scanner scanFor: [:b| b = byte]].
> +                        ^scanner scanFor:
> +                               [:b|
> +                               (b = 232
> +                                and: [extended not
> +                                and: [scanner followingByte = aLiteral]])
> +                               or: [extended := b = 225.
> +                                       false]]].
> +                byte := (aLiteral bitShift: -8) bitAnd: 255.
> +               ^scanner scanFor:
> +                       [:b|
> +                       (b = 232
> +                        and: [extended
> +                        and: [scanner followingByte = (aLiteral bitAnd:
> 255)]])
> +                       or: [extended := b = 225 and: [scanner
> followingByte = byte].
> +                               false]]].
> +       aLiteral isCharacter ifTrue:
> +               [aLiteral asciiValue <= 65535 ifFalse: [^false].
> +                scanner := InstructionStream on: method.
> +                aLiteral asciiValue <= 255 ifTrue:
> +                       [^scanner scanFor:
> +                               [:b|
> +                               (b = 233
> +                                and: [extended not
> +                                and: [scanner followingByte = aLiteral]])
> +                               or: [extended := b = 225.
> +                                       false]]].
> +                byte := (aLiteral bitShift: -8) bitAnd: 255.
> +               ^scanner scanFor:
> +                       [:b|
> +                       (b = 233
> +                        and: [extended
> +                        and: [scanner followingByte = (aLiteral bitAnd:
> 255)]])
> +                       or: [extended := b = 225 and: [scanner
> followingByte = byte].
> +                               false]]].
> +       aLiteral == nil ifTrue:
> +               [^(InstructionStream on: method) scanFor: [:b| b = 79 or:
> [b = 91 or: b = 93]]].
> +       aLiteral == true ifTrue:
> +               [^(InstructionStream on: method) scanFor: [:b| b = 77 or:
> [b = 89]]].
> +       aLiteral == false ifTrue:
> +               [^(InstructionStream on: method) scanFor: [:b| b = 78 or:
> [b = 90]]].
> +
> +       ^false!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>nonExtensionBytecodeAt:in: (in
> category 'instruction stream support') -----
> + nonExtensionBytecodeAt: pc in: method
> +       "Answer the actual bytecode at pc in method, skipping past any
> preceeding extensions."
> +       | thePC bytecode |
> +       thePC := pc.
> +       [self isExtension: (bytecode := method at: thePC)] whileTrue:
> +               [thePC := thePC + (self bytecodeSize: bytecode)].
> +       ^bytecode!
>
> Item was added:
> + ----- Method: EncoderForSistaV1
> class>>pcOfBlockCreationBytecodeForBlockStartingAt:in: (in category
> 'bytecode decoding') -----
> + pcOfBlockCreationBytecodeForBlockStartingAt: startpc in: method
> +       "Answer the pc of the push closure bytecode whose block starts at
> startpc in method.
> +        May need to back up to include extension bytecodes."
> +
> +       "*      224             11100000        aaaaaaaa
>      Extend A (Ext A = Ext A prev * 256 + Ext A)
> +        *      225             11100001        bbbbbbbb
>      Extend B (Ext B = Ext B prev * 256 + Ext B)
> +        **     250             11111010        eeiiikkk
>  jjjjjjjj        Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+
> ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions"
> +       | numExtensions |
> +       self assert: (method at: startpc - 3) = 250.
> +       numExtensions := (method at: startpc - 2) >> 6.
> +       ^startpc - 3 - (numExtensions * 2)!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>pushClosureBytecodeSize (in
> category 'bytecode decoding') -----
> + pushClosureBytecodeSize
> +       "Answer the size of the push closure bytecode.
> +        **     250             11111010        eeiiikkk
>  jjjjjjjj        Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+
> ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions"
> +       ^3!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>superSendScanBlockUsing: (in
> category 'instruction stream support') -----
> + superSendScanBlockUsing: scanner
> +       "Answer a block argument for InstructionStream>>scanFor:
> +        that answers true for super sends."
> +
> +       "*      224             11100000        aaaaaaaa        Extend A
> (Ext A = Ext A prev * 256 + Ext A)
> +        *      225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        **     235             11101011        iiiiijjj
>  Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+
> Extend B * 8) Arguments"
> +
> +       ^[:instr | instr = 235]!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>supportsClosures (in category
> 'compiled method support') -----
> + supportsClosures
> +       "Answer if the instruction set supports closures (contains
> +        closure creation and indirect temp access bytecodes)."
> +
> +       ^true!
>
> Item was added:
> + ----- Method: EncoderForSistaV1 class>>unusedBytecode (in category
> 'bytecode decoding') -----
> + unusedBytecode
> +       "Answer the opcode of a single-byte unused bytecode, if it exists
> in the encoder's bytecode set, or nil if not."
> +       ^223!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genBranchPopFalse: (in category
> 'bytecode generation') -----
> + genBranchPopFalse: distance
> +       (distance > 0 and: [distance < 9]) ifTrue:
> +               ["192-199       11000 iii                       Pop and
> Jump 0n False iii + 1 (i.e., 1 through 8)"
> +                stream nextPut: 191 + distance.
> +                ^self].
> +       ^self genBranchPopFalseLong: distance!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genBranchPopFalseLong: (in category
> 'bytecode generation') -----
> + genBranchPopFalseLong: distance
> +       "239            11101111        iiiiiiii                Pop and
> Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0) "
> +       | distanceMod256 |
> +       (distance < 0 or: [distance > 32767]) ifTrue:
> +               [^self outOfRangeError: 'distance' index: distance range:
> 0 to: 32767].
> +       distanceMod256 := (distance < 0 or: [distance > 255])
> +                                                       ifTrue:
> +                                                               [self
> genUnsignedSingleExtendB: (distance bitShift: -8).
> +                                                                distance
> bitAnd: 255]
> +                                                       ifFalse:
> [distance].
> +       stream
> +               nextPut: 239;
> +               nextPut: distanceMod256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genBranchPopTrue: (in category
> 'bytecode generation') -----
> + genBranchPopTrue: distance
> +       (distance > 0 and: [distance < 9]) ifTrue:
> +               ["184-191       10111 iii                       Pop and
> Jump 0n True iii + 1 (i.e., 1 through 8)"
> +                stream nextPut: 183 + distance.
> +                ^self].
> +       ^self genBranchPopTrueLong: distance!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genBranchPopTrueLong: (in category
> 'bytecode generation') -----
> + genBranchPopTrueLong: distance
> +       "238            11101110        iiiiiiii                Pop and
> Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0)"
> +       | distanceMod256 |
> +       (distance < 0 or: [distance > 32767]) ifTrue:
> +               [^self outOfRangeError: 'distance' index: distance range:
> 0 to: 32767].
> +       (distance > 0 and: [distance < 9]) ifTrue:
> +               ["184-191       10111 iii                       Pop and
> Jump 0n True iii + 1 (i.e., 1 through 8)"
> +                stream nextPut: 183 + distance.
> +                ^self].
> +       distanceMod256 := (distance < 0 or: [distance > 255])
> +                                                       ifTrue:
> +                                                               [self
> genUnsignedSingleExtendB: (distance bitShift: -8).
> +                                                                distance
> bitAnd: 255]
> +                                                       ifFalse:
> [distance].
> +       stream
> +               nextPut: 238;
> +               nextPut: distanceMod256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genCallInlinePrimitive: (in category
> 'bytecode generation') -----
> + genCallInlinePrimitive: primitiveIndex
> +       "248            11111000        i i i i i i i i 1jjjjjjj
>      Call Primitive #iiiiiiii + (jjjjjjj * 256)"
> +       "N.B. We could have made CallPrimitive a 2-byte code taking an
> extension, but that would
> +        complicate the VM's determination of the primitive number and the
> primitive error code
> +        store since the extension, being optional, would make the
> sequence variable length."
> +       (primitiveIndex < 1 or: [primitiveIndex > 32767]) ifTrue:
> +               [self outOfRangeError: 'primitive index' index:
> primitiveIndex range: 1 to: 32767].
> +       stream
> +               nextPut: 248;
> +               nextPut: (primitiveIndex bitAnd: 255);
> +               nextPut: (primitiveIndex bitShift: -8) + 128!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genCallPrimitive: (in category
> 'bytecode generation') -----
> + genCallPrimitive: primitiveIndex
> +       "248            11111000        i i i i i i i i 0jjjjjjj
>      Call Primitive #iiiiiiii + (jjjjjjj * 256)"
> +       "N.B. We could have made CallPrimitive a 2-byte code taking an
> extension, but that would
> +        complicate the VM's determination of the primitive number and the
> primitive error code
> +        store since the extension, being optional, would make the
> sequence variable length."
> +       (primitiveIndex < 1 or: [primitiveIndex > 32767]) ifTrue:
> +               [self outOfRangeError: 'primitive index' index:
> primitiveIndex range: 1 to: 32767].
> +       stream
> +               nextPut: 248;
> +               nextPut: (primitiveIndex bitAnd: 255);
> +               nextPut: (primitiveIndex bitShift: -8)!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genDup (in category 'bytecode
> generation') -----
> + genDup
> +       "83                     01010011                        Duplicate
> Stack Top"
> +       stream nextPut: 83!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genInlineSmallIntegerAdd (in category
> 'in-line primitive generation') -----
> + genInlineSmallIntegerAdd
> +       ^self genCallInlinePrimitive: 0!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genJump: (in category 'bytecode
> generation') -----
> + genJump: distance
> +       (distance > 0 and: [distance < 9]) ifTrue:
> +               ["176-183       10110 iii                       Jump iii +
> 1 (i.e., 1 through 8)"
> +                stream nextPut: 175 + distance.
> +                ^self].
> +       "237            11101101        iiiiiiii                Jump
> #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0,
> a=0, s=1)"
> +       ^self genJumpLong: distance!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genJumpLong: (in category 'bytecode
> generation') -----
> + genJumpLong: distance
> +       "237            11101101        iiiiiiii                Jump
> #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0,
> a=0, s=1)"
> +       (distance between: -32768 and: 32767) ifFalse:
> +               [^self outOfRangeError: 'index' index: distance range:
> -32768 to: 32767].
> +       (distance < 0 or: [distance > 255]) ifTrue:
> +               [self genSignedSingleExtendB: (distance bitShift: -8)].
> +       stream
> +               nextPut: 237;
> +               nextPut: (distance bitAnd: 255)!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genNop (in category 'bytecode
> generation') -----
> + genNop
> +       "95                     01011111                        Nop"
> +       stream nextPut: 95!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPop (in category 'bytecode
> generation') -----
> + genPop
> +       "216            11011000                        Pop Stack Top"
> +       stream nextPut: 216!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushCharacter: (in category
> 'bytecode generation') -----
> + genPushCharacter: aCharacterOrCode
> +       "233            11101001        i i i i i i i i Push Character
> #iiiiiiii (+ Extend B * 256)"
> +       "Why restrict the range to 16 bits when we could encode
> arbitrarily 32-bit Characters?
> +        Well, 16 bits requires 4 bytes (extB + byte, 78 + byte) and so
> beyond this range we
> +        lose space verses a single-byte pushLiteral and a 4 byte
> Character literal on 32-bits.
> +        And generating the same bytecode on 64-bit and 32-bit is
> important if we want to be
> +        able to load binary code from one to the other (e.g. via Fuel)."
> +       | code |
> +       code := aCharacterOrCode isInteger ifTrue: [aCharacterOrCode]
> ifFalse: [aCharacterOrCode asInteger].
> +       (code < 0 or: [code > 65535]) ifTrue:
> +               [^self outOfRangeError: 'character' index: code range: 0
> to: 65535].
> +       (code > 255) ifTrue:
> +               [self genUnsignedSingleExtendB: (code bitShift: -8)].
> +       stream
> +               nextPut: 233;
> +               nextPut: (code bitAnd: 255)!
>
> Item was added:
> + ----- Method:
> EncoderForSistaV1>>genPushClosureCopyNumCopiedValues:numArgs:jumpSize: (in
> category 'bytecode generation') -----
> + genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize:
> jumpSize
> +       "250            11111010 eeiiikkk               jjjjjjjj
>      Push Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A
> \\ 16 * 8) BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions"
> +       "Including numExtensions makes decoding the bytecode quicker since
> it obviates having to scan from the beginning of a method."
> +       | numExtensions numCopiedMod8 numArgsMod8 extA |
> +       (jumpSize < 0 or: [jumpSize > 65535]) ifTrue:
> +               [^self outOfRangeError: 'block size' index: jumpSize
> range: 0 to: 65535].
> +       (numCopied < 0 or: [numCopied > 127]) ifTrue:
> +               [^self outOfRangeError: 'num copied' index: numCopied
> range: 0 to: 127].
> +       (numArgs < 0 or: [numArgs > 127]) ifTrue:
> +               [^self outOfRangeError: 'num args' index: numArgs range: 0
> to: 127].
> +       extA := numExtensions := 0.
> +       (numArgsMod8 := numArgs) > 7 ifTrue:
> +               [extA := numArgs // 8.
> +                numArgsMod8 := numArgsMod8 \\ 8].
> +       (numCopiedMod8 := numCopied) > 7 ifTrue:
> +               [extA := extA + (numCopied // 8 * 16).
> +                numCopiedMod8 := numCopiedMod8 \\ 8].
> +       extA ~= 0 ifTrue:
> +               [self genUnsignedSingleExtendA: extA.
> +                numExtensions := 1].
> +       jumpSize > 255 ifTrue:
> +               [numExtensions := numExtensions + 1.
> +                self genUnsignedSingleExtendB: jumpSize // 256].
> +       stream
> +               nextPut: 250;
> +               nextPut: (numExtensions bitShift: 6) + (numCopiedMod8
> bitShift: 3) + numArgsMod8;
> +               nextPut: (jumpSize bitAnd: 16rFF)!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushConsArray: (in category
> 'bytecode generation') -----
> + genPushConsArray: size
> +       (size < 0 or: [size > 127]) ifTrue:
> +               [^self outOfRangeError: 'size' index: size range: 0 to:
> 127].
> +       "233            11101001        jkkkkkkk        Push (Array new:
> kkkkkkk) (j = 0)
> +                                                                       &
>       Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)"
> +       stream
> +               nextPut: 233;
> +               nextPut: size + 128!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushInstVar: (in category 'bytecode
> generation') -----
> + genPushInstVar: instVarIndex
> +       (instVarIndex between: 0 and: 15) ifTrue:
> +               ["0-15  0000iiii        Push Receiver Variable #iiii"
> +                stream nextPut: 0 + instVarIndex.
> +                ^self].
> +       self genPushInstVarLong: instVarIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushInstVarLong: (in category
> 'bytecode generation') -----
> + genPushInstVarLong: instVarIndex
> +       "226            11100010        i i i i i i i i Push Receiver
> Variable #iiiiiiii (+ Extend A * 256)"
> +       "See also MaybeContextInstanceVariableNode"
> +       (instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue:
> +               [^self outOfRangeError: 'index' index: instVarIndex range:
> 0 to: 65535].
> +       instVarIndex > 255 ifTrue:
> +               [self genUnsignedSingleExtendA: instVarIndex // 256].
> +       stream
> +               nextPut: 226;
> +               nextPut: instVarIndex \\ 256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushInteger: (in category 'bytecode
> generation') -----
> + genPushInteger: anInteger
> +       "80                     01010000
>  Push 0
> +        81                     01010001
>  Push 1
> +        232            11101000        i i i i i i i i Push Integer
> #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0,
> a=0, s=1)"
> +       "Why restrict the range to 16 bits when we could encode
> arbitrarily large integers?
> +        Well, 16 bits requires 4 bytes (extB + byte, 78 + byte) and so
> beyond this range we lose space
> +        verses a single-byte pushLiteral and a 4 byte integer literal on
> 32-bits.  And generating the same
> +        bytecode on 64-bit and 32-bit is important if we want to be able
> to load binary code from one to
> +        the other (e.g. via Fuel)."
> +       anInteger = 0 ifTrue:
> +               [stream nextPut: 80.
> +                ^self].
> +       anInteger = 1 ifTrue:
> +               [stream nextPut: 81.
> +                ^self].
> +       (anInteger < -32768 or: [anInteger > 32767]) ifTrue:
> +               [^self outOfRangeError: 'integer' index: anInteger range:
> -32768 to: 32767].
> +       (anInteger < 0 or: [anInteger > 255]) ifTrue:
> +               [self genSignedSingleExtendB: (anInteger bitShift: -8)].
> +       stream
> +               nextPut: 232;
> +               nextPut: (anInteger bitAnd: 255)!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushLiteral: (in category 'bytecode
> generation') -----
> + genPushLiteral: literalIndex
> +       | extendedIndex |
> +       (literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
> +               [^self outOfRangeError: 'index' index: literalIndex range:
> 0 to: 65536].
> +       literalIndex < 32 ifTrue:
> +               ["32-63         001iiiii        Push Literal #iiiii"
> +                stream nextPut: 32 + literalIndex.
> +                ^self].
> +       "228            11100100        i i i i i i i i Push Literal
> #iiiiiiii (+ Extend A * 256)"
> +       (extendedIndex := literalIndex) > 255 ifTrue:
> +               [self genUnsignedSingleExtendA: extendedIndex // 256.
> +                extendedIndex := extendedIndex \\ 256].
> +       stream
> +               nextPut: 228;
> +               nextPut: extendedIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushLiteralVar: (in category
> 'bytecode generation') -----
> + genPushLiteralVar: literalIndex
> +       | extendedIndex |
> +       (literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
> +               [^self outOfRangeError: 'index' index: literalIndex range:
> 0 to: 65535].
> +       literalIndex < 16 ifTrue:
> +               ["16-31         0001 i i i i            Push Literal
> Variable #iiii"
> +                stream nextPut: 16 + literalIndex.
> +                ^self].
> +       "227            11100011        i i i i i i i i Push Literal
> Variable #iiiiiiii (+ Extend A * 256)"
> +       (extendedIndex := literalIndex) > 255 ifTrue:
> +               [self genUnsignedSingleExtendA: extendedIndex // 256.
> +                extendedIndex := extendedIndex \\ 256].
> +       stream
> +               nextPut: 227;
> +               nextPut: extendedIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushNewArray: (in category 'bytecode
> generation') -----
> + genPushNewArray: size
> +       (size < 0 or: [size > 127]) ifTrue:
> +               [^self outOfRangeError: 'size' index: size range: 0 to:
> 127].
> +       "231            11100111        jkkkkkkk        Push (Array new:
> kkkkkkk) (j = 0)
> +                                                                       &
>       Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)"
> +       stream
> +               nextPut: 231;
> +               nextPut: size!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushReceiver (in category 'bytecode
> generation') -----
> + genPushReceiver
> +       "76                     01001100                Push Receiver"
> +       stream nextPut: 76!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushRemoteTemp:inVectorAt: (in
> category 'bytecode generation') -----
> + genPushRemoteTemp: tempIndex inVectorAt: tempVectorIndex
> +       "251            11111011 kkkkkkkk       jjjjjjjj
>  Push Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
> +       (tempIndex < 0 or: [tempIndex >= 256]) ifTrue:
> +               [^self outOfRangeError: 'remoteTempIndex' index: tempIndex
> range: 0 to: 255].
> +       (tempVectorIndex < 0 or: [tempVectorIndex >= 256]) ifTrue:
> +               [^self outOfRangeError: 'tempVectorIndex' index:
> tempVectorIndex range: 0 to: 255].
> +       stream
> +               nextPut: 251;
> +               nextPut: tempIndex;
> +               nextPut: tempVectorIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushSpecialLiteral: (in category
> 'bytecode generation') -----
> + genPushSpecialLiteral: aLiteral
> +       "77                     01001101                        Push true
> +        78                     01001110                        Push false
> +        79                     01001111                        Push nil
> +        80                     01010000                        Push 0
> +        81                     01010001                        Push 1
> +        232            11101000        iiiiiiii                Push
> Integer #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768
> = i=0, a=0, s=1)"
> +       | index |
> +       aLiteral isInteger ifTrue:
> +               [aLiteral == 0 ifTrue:
> +                       [stream nextPut: 80.
> +                        ^self].
> +                aLiteral == 1 ifTrue:
> +                       [stream nextPut: 81.
> +                        ^self].
> +                ^self genPushInteger: aLiteral].
> +       index := #(false true nil)
> +                                       indexOf: aLiteral
> +                                       ifAbsent: [^self error: 'push
> special literal: ', aLiteral printString,  ' is not one of true false nil'].
> +       stream nextPut: 76 + index!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushTemp: (in category 'bytecode
> generation') -----
> + genPushTemp: tempIndex
> +       (tempIndex < 0 or: [tempIndex > 63]) ifTrue:
> +               [^self outOfRangeError: 'index' index: tempIndex range: 0
> to: 63].
> +       tempIndex < 12 ifTrue:
> +               ["64-71         01000 i i i             Push Temporary
> Variable #iii
> +                  72-75        010010 i i              Push Temporary
> Variable #ii + 8"
> +                stream nextPut: 64 + tempIndex.
> +                ^self].
> +       "229            11100101        i i i i i i i i Push Temporary
> Variable #iiiiiiii"
> +       stream
> +               nextPut: 229;
> +               nextPut: tempIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genPushThisContext (in category
> 'bytecode generation') -----
> + genPushThisContext
> +       "82                     01010010                        Push
> thisContext, (then e.g. Extend 1 = push thisProcess)"
> +       stream nextPut: 82!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genReturnReceiver (in category
> 'bytecode generation') -----
> + genReturnReceiver
> +       "88-91          010110 ii                       Return
> Receiver/true/false/nil"
> +       stream nextPut: 88!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genReturnSpecialLiteral: (in category
> 'bytecode generation') -----
> + genReturnSpecialLiteral: aLiteral
> +       "88-91          010110 ii                       Return
> Receiver/true/false/nil"
> +       | index |
> +       index := #(true false nil) indexOf: aLiteral ifAbsent: 0.
> +       index = 0 ifTrue:
> +               [^self error: 'return special literal: ', aLiteral
> printString,  ' is not one of true false nil'].
> +       stream nextPut: 88 + index!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genReturnTop (in category 'bytecode
> generation') -----
> + genReturnTop
> +       "92             1011100         Return Stack Top From Message"
> +       stream nextPut: 92!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genReturnTopToCaller (in category
> 'bytecode generation') -----
> + genReturnTopToCaller
> +       "93             1011101         Return Stack Top From Block [*
> return from enclosing block N, ExtA]"
> +       "If extended, the least significant bit of the extension
> determines if we return to the caller or not
> +        and the most significant bits determine how many levels of the
> static chain to return from.
> +               ExtA = iiiiiiij
> +               iiiiiii=0,j=0   =>      return to caller
> +               iiiiiii=0,j=1   =>      illegal
> +               iiiiiii=1,j=0   =>      return to outerContext
> +               iiiiiii=1,j=1   =>      return to outerContext
> sender/return from outerContext
> +               iiiiiii=2,j=0   =>      return to outerContext outerContext
> +               iiiiiii=2,j=1   =>      return to outerContext
> outerContext sender/return from outerContext outerContext
> +               etc"
> +
> +       stream nextPut: 93!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genSend:numArgs: (in category 'bytecode
> generation') -----
> + genSend: selectorLiteralIndex numArgs: nArgs
> +       | extendedIndex extendedNArgs |
> +       (selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535])
> ifTrue:
> +               [^self outOfRangeError: 'selectorLiteralIndex' index:
> selectorLiteralIndex range: 0 to: 65535].
> +       (nArgs < 0 or: [nArgs > 31]) ifTrue:
> +               [^self outOfRangeError: 'numArgs' index: nArgs range: 0
> to: 31 "!!!!"].
> +       (selectorLiteralIndex < 16 and: [nArgs < 3]) ifTrue:
> +               ["128-143       1000 iiii                       Send
> Literal Selector #iiii With 0 Argument
> +                 144-159       1001 iiii                       Send
> Literal Selector #iiii With 1 Arguments
> +                 160-175       1010 iiii                       Send
> Literal Selector #iiii With 2 Arguments"
> +                stream nextPut: 128 + (nArgs * 16) + selectorLiteralIndex.
> +                ^self].
> +       (extendedIndex := selectorLiteralIndex) > 31 ifTrue:
> +               [self genUnsignedSingleExtendA: extendedIndex // 32.
> +                extendedIndex := extendedIndex \\ 32].
> +       (extendedNArgs := nArgs) > 7 ifTrue:
> +               [self genUnsignedSingleExtendB: extendedNArgs // 8.
> +                extendedNArgs := extendedNArgs \\ 8].
> +       "234            11101010        i i i i i j j j Send Literal
> Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
> +       stream
> +               nextPut: 238;
> +               nextPut: extendedNArgs + (extendedIndex * 8)!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genSendSpecial:numArgs: (in category
> 'bytecode generation') -----
> + genSendSpecial: specialSelectorIndex numArgs: nArgs
> +       self assert: (specialSelectorIndex between: 1 and: Smalltalk
> specialSelectorSize).
> +       self assert: nArgs = (Smalltalk specialNargsAt:
> specialSelectorIndex).
> +       "Special selector sends.
> +               96-111          0110 iiii                       Send
> Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@
> #bitShift: #'//' #bitAnd: #bitOr:)
> +               112-119 01110 iii                       Send Special
> Message #iii #(#at: #at:put: #size ? ? ? #'==' class ? value value: ? ? ? ?
> ?)"
> +
> +       stream nextPut: specialSelectorIndex + 95!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genSendSuper:numArgs: (in category
> 'bytecode generation') -----
> + genSendSuper: selectorLiteralIndex numArgs: nArgs
> +       | extendedIndex extendedNArgs |
> +       (selectorLiteralIndex < 0 or: [selectorLiteralIndex > 65535])
> ifTrue:
> +               [^self outOfRangeError: 'selectorLiteralIndex' index:
> selectorLiteralIndex range: 0 to: 65535].
> +       (nArgs < 0 or: [nArgs > 31]) ifTrue:
> +               [^self outOfRangeError: 'numArgs' index: nArgs range: 0
> to: 31 "!!!!"].
> +       (extendedIndex := selectorLiteralIndex) > 31 ifTrue:
> +               [self genUnsignedSingleExtendA: extendedIndex // 32.
> +                extendedIndex := extendedIndex \\ 32].
> +       (extendedNArgs := nArgs) > 7 ifTrue:
> +               [self genUnsignedSingleExtendB: extendedNArgs // 8.
> +                extendedNArgs := extendedNArgs \\ 8].
> +       "235            11101011        iiiiijjj                Send To
> Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B *
> 8) Arguments"
> +       stream
> +               nextPut: 235;
> +               nextPut: extendedNArgs + (extendedIndex * 8)!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genSignedSingleExtendB: (in category
> 'bytecode generation') -----
> + genSignedSingleExtendB: extendedIndex
> +       (extendedIndex between: -128 and: 127) ifFalse:
> +               [^self outOfRangeError: 'index' index: extendedIndex
> range: -128 to: 127].
> +       "225            11100001        sbbbbbbb        Extend B (Ext B =
> Ext B prev * 256 + Ext B)"
> +       stream
> +               nextPut: 225;
> +               nextPut: (extendedIndex >= 0 ifTrue: [extendedIndex]
> ifFalse: [extendedIndex + 256]) !
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStoreInstVar: (in category 'bytecode
> generation') -----
> + genStoreInstVar: instVarIndex
> +       "243            11110011        iiiiiiii                Store
> Receiver Variable #iiiiiii (+ Extend A * 256)"
> +       self genStoreInstVarLong: instVarIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStoreInstVarLong: (in category
> 'bytecode generation') -----
> + genStoreInstVarLong: instVarIndex
> +       "243            11110011        iiiiiiii                Store
> Receiver Variable #iiiiiii (+ Extend A * 256)"
> +       (instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue:
> +               [^self outOfRangeError: 'index' index: instVarIndex range:
> 0 to: 65535].
> +       instVarIndex > 255 ifTrue:
> +               [self genUnsignedSingleExtendA: instVarIndex // 256].
> +       stream
> +               nextPut: 243;
> +               nextPut: instVarIndex \\ 256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStoreLiteralVar: (in category
> 'bytecode generation') -----
> + genStoreLiteralVar: literalIndex
> +       "244            11110100        iiiiiiii                Store
> Literal Variable #iiiiiiii (+ Extend A * 256)"
> +       (literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
> +               [^self outOfRangeError: 'index' index: literalIndex range:
> 0 to: 65535].
> +       literalIndex > 255 ifTrue:
> +               [self genUnsignedSingleExtendA: literalIndex // 256].
> +       stream
> +               nextPut: 244;
> +               nextPut: literalIndex \\ 256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStorePopInstVar: (in category
> 'bytecode generation') -----
> + genStorePopInstVar: instVarIndex
> +       "200-207        11001 iii                       Pop and Store
> Receiver Variable #iii
> +        240            11110000        iiiiiiii        Pop and Store
> Receiver Variable #iiiiiii (+ Extend A * 256)"
> +       (instVarIndex < 0 or: [instVarIndex > 7]) ifTrue:
> +               [^self genStorePopInstVarLong: instVarIndex].
> +       stream nextPut: 200 + instVarIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStorePopInstVarLong: (in category
> 'bytecode generation') -----
> + genStorePopInstVarLong: instVarIndex
> +       "240            11110000        iiiiiiii                Pop and
> Store Receiver Variable #iiiiiii (+ Extend A * 256)"
> +       (instVarIndex < 0 or: [instVarIndex > 65535]) ifTrue:
> +               [^self outOfRangeError: 'index' index: instVarIndex range:
> 0 to: 65535].
> +       instVarIndex > 255 ifTrue:
> +               [self genUnsignedSingleExtendA: instVarIndex // 256].
> +       stream
> +               nextPut: 240;
> +               nextPut: instVarIndex \\ 256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStorePopLiteralVar: (in category
> 'bytecode generation') -----
> + genStorePopLiteralVar: literalIndex
> +       "241            11110001        iiiiiiii                Pop and
> Store Literal Variable #iiiiiiii (+ Extend A * 256)"
> +       (literalIndex < 0 or: [literalIndex > 65535]) ifTrue:
> +               [^self outOfRangeError: 'index' index: literalIndex range:
> 0 to: 65535].
> +       literalIndex > 255 ifTrue:
> +               [self genUnsignedSingleExtendA: literalIndex // 256].
> +       stream
> +               nextPut: 241;
> +               nextPut: literalIndex \\ 256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStorePopRemoteTemp:inVectorAt: (in
> category 'bytecode generation') -----
> + genStorePopRemoteTemp: tempIndex inVectorAt: tempVectorIndex
> +       "253            11111101        kkkkkkkk        jjjjjjjj
>      Pop and Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
> +       (tempIndex < 0 or: [tempIndex >= 256]) ifTrue:
> +               [^self outOfRangeError: 'remoteTempIndex' index: tempIndex
> range: 0 to: 255].
> +       (tempVectorIndex < 0 or: [tempVectorIndex >= 256]) ifTrue:
> +               [^self outOfRangeError: 'tempVectorIndex' index:
> tempVectorIndex range: 0 to: 255].
> +       stream
> +               nextPut: 253;
> +               nextPut: tempIndex;
> +               nextPut: tempVectorIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStorePopTemp: (in category 'bytecode
> generation') -----
> + genStorePopTemp: tempIndex
> +       "208-215        11010 iii                       Pop and Store
> Temporary Variable #iii
> +        242            11110010        iiiiiiii        Pop and Store
> Temporary Variable #iiiiiiii"
> +       (tempIndex < 0 or: [tempIndex > 63]) ifTrue:
> +               [^self outOfRangeError: 'index' index: tempIndex range: 0
> to: 63].
> +       tempIndex < 8 ifTrue:
> +               [stream nextPut: 208 + tempIndex.
> +                ^self].
> +       stream
> +               nextPut: 242;
> +               nextPut: tempIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStoreRemoteTemp:inVectorAt: (in
> category 'bytecode generation') -----
> + genStoreRemoteTemp: tempIndex inVectorAt: tempVectorIndex
> +       "252            11111100        kkkkkkkk        jjjjjjjj
>      Store Temp At kkkkkkkk In Temp Vector At: jjjjjjjj"
> +       (tempIndex < 0 or: [tempIndex >= 256]) ifTrue:
> +               [^self outOfRangeError: 'remoteTempIndex' index: tempIndex
> range: 0 to: 255].
> +       (tempVectorIndex < 0 or: [tempVectorIndex >= 256]) ifTrue:
> +               [^self outOfRangeError: 'tempVectorIndex' index:
> tempVectorIndex range: 0 to: 255].
> +       stream
> +               nextPut: 252;
> +               nextPut: tempIndex;
> +               nextPut: tempVectorIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genStoreTemp: (in category 'bytecode
> generation') -----
> + genStoreTemp: tempIndex
> +       "242            11110010        iiiiiiii                Pop and
> Store Temporary Variable #iiiiiiii"
> +       (tempIndex < 0 or: [tempIndex > 63]) ifTrue:
> +               [^self outOfRangeError: 'index' index: tempIndex range: 0
> to: 63].
> +       stream
> +               nextPut: 242;
> +               nextPut: tempIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genUnsignedMultipleExtendA: (in
> category 'bytecode generation') -----
> + genUnsignedMultipleExtendA: extendedIndex
> +       "224            11100000        aaaaaaaa        Extend A (Ext A =
> Ext A prev * 256 + Ext A)"
> +       extendedIndex > 255 ifTrue:
> +               [self genUnsignedMultipleExtendA: extendedIndex // 256].
> +       stream
> +               nextPut: 224;
> +               nextPut: extendedIndex \\ 256!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genUnsignedSingleExtendA: (in category
> 'bytecode generation') -----
> + genUnsignedSingleExtendA: extendedIndex
> +       (extendedIndex between: 0 and: 255) ifFalse:
> +               [^self outOfRangeError: 'index' index: extendedIndex
> range: 0 to: 255].
> +       "224            11100000        aaaaaaaa        Extend A (Ext A =
> Ext A prev * 256 + Ext A)"
> +       stream
> +               nextPut: 224;
> +               nextPut: extendedIndex!
>
> Item was added:
> + ----- Method: EncoderForSistaV1>>genUnsignedSingleExtendB: (in category
> 'bytecode generation') -----
> + genUnsignedSingleExtendB: extendedIndex
> +       (extendedIndex between: 0 and: 255) ifFalse:
> +               [^self outOfRangeError: 'index' index: extendedIndex
> range: 0 to: 255].
> +       "225            11100001        sbbbbbbb        Extend B (Ext B =
> Ext B prev * 256 + Ext B)"
> +       stream
> +               nextPut: 225;
> +               nextPut: extendedIndex!
>
> Item was added:
> + ----- Method: InstructionClient>>pushExplicitOuter: (in category
> '*BytecodeSets-NewsqueakV3-instruction decoding') -----
> + pushExplicitOuter: n
> +       "Push the Active Context's Receiver for an outer send at level n."
> +
> +       self subclassResponsibility!
>
> Item was changed:
>   ----- Method: InstructionPrinter>>pushExplicitOuter: (in category
> '*BytecodeSets-NewsqueakV3-instruction decoding') -----
>   pushExplicitOuter: n
> +       "Print the Push the Active Context's Receiver for an outer send at
> level (method literalAt: litIndex) bytecode."
> -       "Print the Push Active Context's Receiver for an outer send of
> aSymbol on Top Of Stack bytecode."
>
>         self print: 'pushExplicitOuter: ', n asString!
>
> Item was added:
> + ----- Method: InstructionStream>>interpretNSV4Jump (in category
> '*BytecodeSets-NewsqueakV4-decoding') -----
> + interpretNSV4Jump
> +       "If the instruction at pc is an unconditional jump, interpret it,
> advancing the pc,
> +        and answering the jump distance. Otherwise answer nil."
> +
> +       "       192-199 11000 i i i                             Jump iii +
> 1 (i.e., 1 through 8)
> +        *      225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        *      242             11110010        i i i i i i i i Jump i i i
> i i i i i (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0,
> a=0, s=1)"
> +       | method byte nextpc extA extB |
> +       method := self method.
> +       "consume and compute any extensions first."
> +       extA := extB := 0.
> +       nextpc := pc. "must not advance pc unless this is a jump."
> +       [byte := self method at: nextpc.
> +        nextpc := nextpc + 1.
> +        byte >= 224 and: [byte <= 225]] whileTrue:
> +               [| extByte |
> +                extByte := self method at: nextpc.
> +                nextpc := nextpc + 1.
> +                byte = 224
> +                       ifTrue:
> +                               [extA := (extA bitShift: 8) + extByte]
> +                       ifFalse:
> +                               [extB := (extB = 0 and: [extByte > 127])
> +                                                       ifTrue: [extByte -
> 256]
> +                                                       ifFalse: [(extB
> bitShift: 8) + extByte]]].
> +       (byte between: 192 and: 199) ifTrue:
> +               [pc := nextpc.
> +                ^byte - 191].
> +       byte = 242 ifTrue:
> +               [byte := method at: nextpc.
> +                pc := nextpc + 1.
> +                ^(extB bitShift: 8) + byte].
> +       ^nil!
>
> Item was added:
> + ----- Method: InstructionStream>>interpretNSV4JumpIfCond (in category
> '*BytecodeSets-NewsqueakV4-decoding') -----
> + interpretNSV4JumpIfCond
> +       "If the instruction at pc is a conditional jump, interpret it,
> advancing the pc,
> +        and answering the jump distance. Otherwise answer nil."
> +
> +       "       200-207 11001 i i i                             Pop and
> Jump 0n True iii +1 (i.e., 1 through 8)
> +               208-215 11010 i i i                             Pop and
> Jump 0n False iii +1 (i.e., 1 through 8)
> +        *      225             11100001        sbbbbbbb        Extend B
> (Ext B = Ext B prev * 256 + Ext B)
> +        *      243             11110011        i i i i i i i i Pop and
> Jump 0n True i i i i i i i i (+ Extend B * 256, where Extend B >= 0)
> +        *      244             11110100        i i i i i i i i Pop and
> Jump 0n False i i i i i i i i (+ Extend B * 256, where Extend B >= 0)"
> +       | method byte nextpc extA extB |
> +       method := self method.
> +       "consume and compute any extensions first."
> +       extA := extB := 0.
> +       nextpc := pc. "must not advance pc unless this is a jump."
> +       [byte := self method at: nextpc.
> +        nextpc := nextpc + 1.
> +        byte >= 224 and: [byte <= 225]] whileTrue:
> +               [| extByte |
> +                extByte := self method at: nextpc.
> +                nextpc := nextpc + 1.
> +                byte = 224
> +                       ifTrue:
> +                               [extA := (extA bitShift: 8) + extByte]
> +                       ifFalse:
> +                               [extB := (extB = 0 and: [extByte > 127])
> +                                                       ifTrue: [extByte -
> 256]
> +                                                       ifFalse: [(extB
> bitShift: 8) + extByte]]].
> +       (byte between: 200 and: 215) ifTrue:
> +               [pc := nextpc.
> +                ^(byte bitAnd: 7) + 1].
> +       (byte between: 243 and: 244) ifTrue:
> +               [byte := method at: nextpc.
> +                pc := nextpc + 1.
> +                ^(extB bitShift: 8) + byte].
> +       ^nil!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20140519/3e02e656/attachment-0001.htm


More information about the Vm-dev mailing list