<div dir="ltr"><div class="gmail_default" style="font-size:small">Hi Marcel, Hi All,<br></div><div class="gmail_default" style="font-size:small"><br></div><div class="gmail_default" style="font-size:small">  please review Kernel-eem.1411 and Compiler-eem.460 in inbox as proposed solutions for the self flag: #todo issue in CompiledCode>>#allLiteralsDo: et al.</div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Fri, Jul 12, 2019 at 12:59 AM <<a href="mailto:commits@source.squeak.org">commits@source.squeak.org</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left-width:1px;border-left-style:solid;border-left-color:rgb(204,204,204);padding-left:1ex">Marcel Taeumel uploaded a new version of Kernel to project The Trunk:<br>
<a href="http://source.squeak.org/trunk/Kernel-mt.1244.mcz" rel="noreferrer" target="_blank">http://source.squeak.org/trunk/Kernel-mt.1244.mcz</a><br>
<br>
==================== Summary ====================<br>
<br>
Name: Kernel-mt.1244<br>
Author: mt<br>
Time: 12 July 2019, 9:59:41.866568 am<br>
UUID: d585f898-09cc-094b-98ed-a74204c82019<br>
Ancestors: Kernel-mt.1243<br>
<br>
Refactoring of #literalsDo: - Step 2 of 3. <br>
<br>
For more information, see <a href="http://forum.world.st/Please-Review-Refactoring-for-literalsDo-etc-tp5099756p5100896.html" rel="noreferrer" target="_blank">http://forum.world.st/Please-Review-Refactoring-for-literalsDo-etc-tp5099756p5100896.html</a>.<br>
<br>
=============== Diff against Kernel-mt.1243 ===============<br>
<br>
Item was removed:<br>
- ----- Method: AdditionalMethodState>>hasLiteralSuchThat: (in category 'testing') -----<br>
- hasLiteralSuchThat: aBlock<br>
-       "Answer true if litBlock returns true for any literal in this array, even if embedded in further array structure.<br>
-        This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"<br>
-       1 to: self basicSize do: [:i |<br>
-               | propertyOrPragma "<Association|Pragma>" |<br>
-               propertyOrPragma := self basicAt: i.<br>
-               (propertyOrPragma isVariableBinding<br>
-                       ifTrue: [(aBlock value: propertyOrPragma key)<br>
-                                       or: [(aBlock value: propertyOrPragma value)<br>
-                                       or: [propertyOrPragma value isArray<br>
-                                               and: [propertyOrPragma value hasLiteralSuchThat: aBlock]]]]<br>
-                       ifFalse: [propertyOrPragma hasLiteralSuchThat: aBlock]) ifTrue:<br>
-                       [^true]].<br>
-       ^false!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledBlock>>allLiterals (in category 'literals') -----<br>
- allLiterals<br>
-       ^self homeMethod allLiterals!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledBlock>>allSubLiterals (in category 'literals') -----<br>
- allSubLiterals<br>
-       | literalsExceptOuter unfoldedSubLiterals |<br>
-       literalsExceptOuter := self literals allButLast.<br>
-       unfoldedSubLiterals := literalsExceptOuter<br>
-                                                               select: [:lit| lit isCompiledCode]<br>
-                                                               thenCollect: [:blockMethod| blockMethod allSubLiterals].<br>
-       unfoldedSubLiterals ifEmpty:<br>
-               [^literalsExceptOuter].<br>
-       ^literalsExceptOuter, (unfoldedSubLiterals fold: [:a :b| a, b])!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledBlock>>codeLiteralsDo: (in category 'literals') -----<br>
+ codeLiteralsDo: aBlock<br>
+       "Overwritten to not cause infinite loop."<br>
+ <br>
+       aBlock value: self.<br>
+ <br>
+       self literalsDo: [:literal |<br>
+               (literal isCompiledCode and: [literal ~~ self outerCode]) ifTrue: [<br>
+                       literal codeLiteralsDo: aBlock]].!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledBlock>>hasLiteral: (in category 'literals') -----<br>
- hasLiteral: literal<br>
-       "Answer whether the receiver references the argument, literal."<br>
-       2 to: self numLiterals do: "exclude outerCode"<br>
-               [:index | | lit |<br>
-               lit := self objectAt: index.<br>
-               (lit literalEqual: literal) ifTrue:<br>
-                       [^true].<br>
-               (lit isCompiledCode and: [lit hasLiteral: literal]) ifTrue:<br>
-                       [^true]].<br>
-       ^false!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledBlock>>hasLiteralSuchThat: (in category 'literals') -----<br>
- hasLiteralSuchThat: litBlock<br>
-       "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure."<br>
-       2 to: self numLiterals do: "exclude outerCode"<br>
-               [:index | | lit |<br>
-               lit := self objectAt: index.<br>
-               ((litBlock value: lit)<br>
-               or: [(lit isArray or: [lit isCompiledCode]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue:<br>
-                       [^true]].<br>
-       ^false!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledCode>>allLiterals (in category 'literals') -----<br>
  allLiterals<br>
+       "Skip compiled-code objects. Keep literal arrays, bindings, etc."<br>
+       <br>
+       ^ Array streamContents: [:result |<br>
+               self allLiteralsDo: [:literal | result nextPut: literal]]!<br>
-       self subclassResponsibility!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>allLiteralsDo: (in category 'literals') -----<br>
+ allLiteralsDo: aBlock<br>
+       "Enumerate all literals thoroughly. Follow nested instances of CompiledCode. Do not treat compiled code as literals here."<br>
+       <br>
+       self codeLiteralsDo: [:compiledCode | compiledCode literalsDo: [:literal |<br>
+               literal isCompiledCode ifFalse: [literal allLiteralsDo: aBlock] ]].<br>
+ <br>
+       "Enumerate special selectors."<br>
+       self flag: #todo.<br>
+       <br>
+       "Enumerate special literals such as true and false."<br>
+       self flag: #todo.!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>codeLiterals (in category 'literals') -----<br>
+ codeLiterals<br>
+ <br>
+       ^ Array streamContents: [:stream |<br>
+               self codeLiteralsDo: [:compiledCode | stream nextPut: compiledCode]]!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>codeLiteralsDo: (in category 'literals') -----<br>
+ codeLiteralsDo: aBlock<br>
+       "Enumerate all literals that represent instances of CompiledCode. This is especially required for SistaV1."<br>
+       <br>
+       aBlock value: self.<br>
+       <br>
+       self literalsDo: [:literal | literal isCompiledCode ifTrue: [<br>
+               literal codeLiteralsDo: aBlock]].!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>hasLiteral: (in category 'literals') -----<br>
+ hasLiteral: aLiteral<br>
+       "Since we cannot enumerate this code's special literals, we have to overwrite this method to invoke the encoder scanner explicitely."<br>
+ <br>
+       | scanBlock |<br>
+       (super hasLiteral: aLiteral) ifTrue: [^ true].<br>
+ <br>
+       scanBlock := self class<br>
+               scanBlocksForLiteral: aLiteral<br>
+               do: [:primaryScanner :secondaryScanner |<br>
+                       "E.g., scanner for SistaV1 or scanner for V3PlusClosures"<br>
+                       self signFlag ifTrue: [secondaryScanner] ifFalse: [primaryScanner]].<br>
+       <br>
+       self codeLiteralsDo: [:compiledCode |<br>
+               (compiledCode scanFor: scanBlock) ifTrue: [^ true]].<br>
+ <br>
+       ^ false!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>hasMethodReturn (in category 'testing') -----<br>
+ hasMethodReturn<br>
+       "Answer whether the receiver has a method-return ('^') in its code."<br>
+ <br>
+       | scanner |<br>
+       self codeLiteralsDo: [:compiledCode | <br>
+               scanner := InstructionStream on: compiledCode.<br>
+               (scanner scanFor: [:x | (scanner willReturn<br>
+                               and: [scanner willBlockReturn not])<br>
+                               "and: [scanner willReturnTopFromMethod not]" "-> Not supported in EncoderForSistaV1"])<br>
+                       ifTrue: [^ true]].<br>
+       ^ false!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>isQuick (in category 'testing') -----<br>
+ isQuick<br>
+ <br>
+       self subclassResponsibility.!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledCode>>literals (in category 'literals') -----<br>
  literals<br>
+       <br>
+       ^ Array streamContents: [:result |<br>
+               self literalsDo: [:lit | result nextPut: lit]]!<br>
-       "Answer an Array of the literals referenced by the receiver."<br>
-       | literals numberLiterals |<br>
-       literals := Array new: (numberLiterals := self numLiterals).<br>
-       1 to: numberLiterals do:<br>
-               [:index |<br>
-               literals at: index put: (self objectAt: index + 1)].<br>
-       ^literals!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>literalsDo: (in category 'literals') -----<br>
+ literalsDo: aBlock<br>
+       "Evaluate aBlock for each of the literals referenced by the receiver. Note that this (raw) enumeration addresses *all* objects stored *after* the method header and *before* the first byte code. If you require a deep and meaningful enumeration of literals use #allLiteralsDo: or #codeLiteralsDo:."<br>
+       <br>
+       1 to: self numLiterals do: [:index |<br>
+               aBlock value: (self literalAt: index)].!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledCode>>messages (in category 'scanning') -----<br>
  messages<br>
        "Answer a Set of all the message selectors sent by this method."<br>
<br>
+       | result |<br>
+       result := Set new.<br>
+       self messagesDo: [:selector | result add: selector].<br>
+       ^ result!<br>
-       | encoderClass scanner aSet |<br>
-       encoderClass := self encoderClass.<br>
-       aSet := Set new.<br>
-       scanner := InstructionStream on: self.<br>
-       scanner scanFor: [ :x | <br>
-               | selector |<br>
-               (selector := encoderClass selectorToSendOrItselfFor: scanner in: self at: scanner pc) == scanner<br>
-                       ifFalse:<br>
-                               [aSet add: selector]<br>
-                       ifTrue:<br>
-                               [(encoderClass blockMethodOrNilFor: scanner in: self at: scanner pc) ifNotNil:<br>
-                                       [:blockMethod| aSet addAll: blockMethod messages]].<br>
-               false "keep scanning" ].<br>
-       ^aSet!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>messagesDo: (in category 'scanning') -----<br>
+ messagesDo: workBlock<br>
+       "Evaluate aBlock with all the message selectors sent by me. Duplicate sends possible."<br>
+ <br>
+       | scanner selector  |<br>
+       self isQuick ifTrue: [^ self].<br>
+       <br>
+       self codeLiteralsDo: [:compiledCode | <br>
+               scanner := InstructionStream on: compiledCode.<br>
+               scanner scanFor: [ :x | <br>
+                       (selector := scanner selectorToSendOrSelf) == scanner<br>
+                               ifFalse: [workBlock value: selector].<br>
+                       false "keep scanning" ] ].!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledCode>>messagesDo:encoderClass:visitedSet: (in category 'private') -----<br>
- messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet<br>
-       "The inner engine for messagesDo:"<br>
- <br>
-       | scanner |<br>
-       scanner := InstructionStream on: self.<br>
-       scanner scanFor: [ :x | <br>
-               | selector |<br>
-               (selector := encoderClass selectorToSendOrItselfFor: scanner in: self at: scanner pc) == scanner<br>
-                       ifFalse:<br>
-                               [(visitedSet ifAbsentAdd: selector) ifTrue:<br>
-                                       [aBlock value: selector]]<br>
-                       ifTrue:<br>
-                               [(encoderClass blockMethodOrNilFor: scanner in: self at: scanner pc) ifNotNil:<br>
-                                       [:blockMethod|<br>
-                                        blockMethod messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet]].<br>
-               false "keep scanning" ]!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledCode>>refersTo:bytecodeScanner:thorough: (in category 'literals') -----<br>
- refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough<br>
-       "Answer if the receiver refers to the literal.  If the scan block is non-nil, then<br>
-        use it to find the literal in bytecode.  If thorough is true, dive down into<br>
-        literal arrays and method properties to locate references to the literal there-in."<br>
-       2 to: (self isCompiledBlock<br>
-                       ifTrue: [self numLiterals] "exclude outerCode or methodClass"<br>
-                       ifFalse: [self numLiterals - 1]) "exclude selector/properties and methodClass"<br>
-          do: [:i| | lit |<br>
-               lit := self objectAt: i.<br>
-               (literal == lit or: [literal literalEqual: lit]) ifTrue: [^true]. "== for Float bindingOf: #NaN since NaN ~= NaN"<br>
-               lit isCompiledCode<br>
-                       ifTrue:<br>
-                               [(lit refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough) ifTrue:<br>
-                                       [^true]]<br>
-                       ifFalse:<br>
-                               [thorough ifTrue:<br>
-                                       [lit isVariableBinding<br>
-                                               ifTrue:<br>
-                                                       [literal == lit key ifTrue: [^true]]<br>
-                                               ifFalse:<br>
-                                                       [(lit isArray<br>
-                                                          and: [(lit hasLiteral: literal)<br>
-                                                               or: [literal isVariableBinding<br>
-                                                                       and: [literal key isSymbol<br>
-                                                                       and: [lit hasLiteral: literal key]]]]) ifTrue:<br>
-                                                               [^true]]]]].<br>
-       scanBlockOrNil ifNotNil:<br>
-               [(self scanFor: scanBlockOrNil) ifTrue:<br>
-                       [^true]].<br>
-       ^false!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledCode>>refersTo:primaryBytecodeScanner:secondaryBytecodeScanner:thorough: (in category 'literals') -----<br>
- refersTo: literal primaryBytecodeScanner: primaryScanBlockOrNil secondaryBytecodeScanner: secondaryScanBlockOrNil thorough: thorough<br>
-       "Answer if the receiver refers to the literal.  If the scan blocks are non-nil, then<br>
-        use them to find the literal in bytecode.  If thorough is true, dive down into<br>
-        literal arrays and method properties to locate references to the literal there-in."<br>
-       ^self<br>
-               refersTo: literal<br>
-               bytecodeScanner: (self signFlag<br>
-                                                       ifTrue: [secondaryScanBlockOrNil]<br>
-                                                       ifFalse: [primaryScanBlockOrNil])<br>
-               thorough: thorough!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledCode>>scanFor: (in category 'scanning') -----<br>
  scanFor: byteOrClosure<br>
        "Answer whether the receiver contains the argument as a bytecode, if it is a number,<br>
         or evaluates to true if a block.  If a block it can take from one to four bytes."<br>
        | s end |<br>
        ^(s := InstructionStream on: self)<br>
                scanFor: (byteOrClosure isBlock<br>
                                        ifTrue: [byteOrClosure numArgs caseOf: {<br>
                                                        [1] -> [byteOrClosure].<br>
                                                        [2] -> [[:byte| byteOrClosure value: byte value: s secondByte]].<br>
                                                        [3] -> [end := self endPC - 2.<br>
                                                                        [:byte|<br>
                                                                        s pc <= end<br>
                                                                        and: [byteOrClosure<br>
                                                                                        value: byte<br>
                                                                                        value: s secondByte<br>
                                                                                        value: s thirdByte]]].<br>
                                                        [4] -> [end := self endPC - 3.<br>
                                                                        [:byte|<br>
                                                                        s pc <= end<br>
                                                                        and: [byteOrClosure<br>
                                                                                        value: byte<br>
                                                                                        value: s secondByte<br>
                                                                                        value: s thirdByte<br>
                                                                                        value: s fourthByte]]] }]<br>
                                        ifFalse: [[:instr | instr = byteOrClosure]])<br>
  "<br>
+ SystemNavigation default browseAllSelect: [:m | m scanFor: 134]<br>
- Smalltalk browseAllSelect: [:m | m scanFor: 134]<br>
  "!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>sendsMessage: (in category 'testing') -----<br>
+ sendsMessage: aSelector <br>
+       <br>
+       self messagesDo: [:selector |<br>
+               selector = aSelector ifTrue: [^ true]].<br>
+       ^ false!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>sendsSelector: (in category 'testing') -----<br>
+ sendsSelector: aSelector <br>
+ <br>
+       self flag: #todo. "mt: Deprecate? AST/Refactoring project needs it..."<br>
+       ^ self sendsMessage: aSelector!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledCode>>sendsToSuper (in category 'testing') -----<br>
+ sendsToSuper<br>
+       "Answer whether the receiver sends any message to super."<br>
+ <br>
+       | scanner |<br>
+       self codeLiteralsDo: [:compiledCode | <br>
+               scanner := InstructionStream on: compiledCode.<br>
+               (scanner scanFor: (self encoderClass superSendScanBlockUsing: scanner))<br>
+                       ifTrue: [^ true]].<br>
+       ^ false!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>allLiterals (in category 'literals') -----<br>
- allLiterals<br>
-       | literals unfoldedSubLiterals |<br>
-       literals := self literals.<br>
-       unfoldedSubLiterals := literals<br>
-                                                               select: [:lit| lit isCompiledCode]<br>
-                                                               thenCollect: [:blockMethod| blockMethod allSubLiterals].<br>
-       unfoldedSubLiterals ifEmpty:<br>
-               [^literals].<br>
-       ^literals, (unfoldedSubLiterals fold: [:a :b| a, b])!<br>
<br>
Item was added:<br>
+ ----- Method: CompiledMethod>>allLiteralsDo: (in category 'literals') -----<br>
+ allLiteralsDo: aBlock<br>
+       "Overwritten to skip certain (raw) literals."<br>
+               <br>
+       " Exclude method selector (or properties) and the method's class."<br>
+       1 to: self numLiterals - 2 do: [:index |<br>
+               (self literalAt: index) allLiteralsDo: aBlock].<br>
+ <br>
+       "Enumerate method selector only through additional method state."<br>
+       self penultimateLiteral isMethodProperties<br>
+               ifTrue: [self penultimateLiteral allLiteralsDo: aBlock].<br>
+       <br>
+       "Enumerate special selectors."<br>
+       self flag: #todo.<br>
+       <br>
+       "Enumerate special literals such as true and false."<br>
+       self flag: #todo.!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>hasLiteral: (in category 'literals') -----<br>
- hasLiteral: literal<br>
-       "Answer whether the receiver references the argument, literal."<br>
-       2 to: self numLiterals - 1 do: "exclude selector/properties & methodClass"<br>
-               [:index | | lit |<br>
-               lit := self objectAt: index.<br>
-               (lit literalEqual: literal) ifTrue:<br>
-                       [^true].<br>
-               (lit isCompiledCode and: [lit hasLiteral: literal]) ifTrue:<br>
-                       [^true]].<br>
-       ^false!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>hasLiteralSuchThat: (in category 'literals') -----<br>
- hasLiteralSuchThat: litBlock<br>
-       "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure."<br>
-       (self penultimateLiteral isMethodProperties<br>
-        and: [self penultimateLiteral hasLiteralSuchThat: litBlock]) ifTrue:<br>
-               [^true].<br>
-       2 to: self numLiterals + 1 do:<br>
-               [:index | | lit |<br>
-               lit := self objectAt: index.<br>
-               ((litBlock value: lit)<br>
-               or: [(lit isArray or: [lit isCompiledCode]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue:<br>
-                       [^true]].<br>
-       ^false!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>hasLiteralThorough: (in category 'literals') -----<br>
- hasLiteralThorough: literal<br>
-       "Answer true if any literal in this method is literal,<br>
-       even if embedded in array structure."<br>
- <br>
-       (self penultimateLiteral isMethodProperties<br>
-        and: [self penultimateLiteral hasLiteralThorough: literal]) ifTrue:[^true].<br>
-       2 to: self numLiterals - 1 "exclude superclass + selector/properties"<br>
-          do:[:index | | lit |<br>
-               (((lit := self objectAt: index) literalEqual: literal)<br>
-                or: [(lit isVariableBinding and: [lit key == literal])<br>
-                or: [lit isArray and: [lit hasLiteral: literal]]]) ifTrue:<br>
-                       [^ true]].<br>
-       ^ false !<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>literalsDo: (in category 'literals') -----<br>
- literalsDo: aBlock<br>
-       "Evaluate aBlock for each of the literals referenced by the receiver."<br>
-       1 to: self numLiterals do:<br>
-               [:index |<br>
-               aBlock value: (self objectAt: index + 1)]!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>messages (in category 'scanning') -----<br>
- messages<br>
-       "Answer a Set of all the message selectors sent by this method."<br>
- <br>
-       | scanner aSet |<br>
-       aSet := Set new.<br>
-       scanner := InstructionStream on: self.<br>
-       scanner scanFor: [ :x | <br>
-               | selector |<br>
-               (selector := scanner selectorToSendOrSelf) == scanner ifFalse: [<br>
-                       aSet add: selector ].<br>
-               false "keep scanning" ].<br>
-       ^aSet!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>messagesDo: (in category 'scanning') -----<br>
- messagesDo: aBlock<br>
-       "Evaluate aBlock exactly once with all the message selectors sent by me."<br>
- <br>
-       self isQuick ifFalse:<br>
-               [self messagesDo: aBlock<br>
-                       encoderClass: self encoderClass<br>
-                       visitedSet: IdentitySet new]!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledMethod>>messagesSequence (in category 'scanning') -----<br>
  messagesSequence<br>
-       "Answer a Set of all the message selectors sent by this method."<br>
<br>
+       self flag: #todo. "mt: Better change #messages to return an array instead of a set?"<br>
+       ^ self messages asArray!<br>
-       ^Array streamContents:<br>
-               [:str| | scanner |<br>
-               scanner := InstructionStream on: self.<br>
-               scanner scanFor: <br>
-                       [:x | | selectorOrSelf |<br>
-                       (selectorOrSelf := scanner selectorToSendOrSelf) == scanner ifFalse:<br>
-                               [str nextPut: selectorOrSelf].<br>
-                       false   "keep scanning"]]!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledMethod>>objectForDataStream: (in category 'file in/out') -----<br>
  objectForDataStream: refStrm<br>
+       "Reconfigure pragma. Example: #(#FFTPlugin #primitiveFFTTransformData 0 0). See FFT >> #pluginTransformData:."<br>
+ <br>
+       self primitive = 117 ifTrue: [(self literalAt: 1) at: 4 put: 0].!<br>
-       <br>
-       self primitive = 117 ifTrue: [self literals first at: 4 put: 0].<br>
- !<br>
<br>
Item was changed:<br>
  ----- Method: CompiledMethod>>readsField: (in category 'scanning') -----<br>
  readsField: varIndex <br>
+       "Answer whether the receiver loads the instance variable indexed by the argument."<br>
+ <br>
-       "Answer whether the receiver loads the instance variable indexed by the  argument."<br>
        | varIndexCode scanner |<br>
        varIndexCode := varIndex - 1.<br>
+       self isQuick ifTrue: [^ self isReturnField and: [self returnField = varIndexCode]].<br>
+       <br>
+       self codeLiteralsDo: [:compiledCode | <br>
+               scanner := InstructionStream on: compiledCode.<br>
+               (scanner scanFor: (self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner))<br>
+                       ifTrue: [^ true]].<br>
+ <br>
+       ^ false!<br>
-       self isQuick ifTrue:<br>
-               [^self isReturnField and: [self returnField = varIndexCode]].<br>
-       scanner := InstructionStream on: self.<br>
-       ^scanner scanFor:(self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner)!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledMethod>>readsRef: (in category 'scanning') -----<br>
  readsRef: variableBinding <br>
        "Answer whether the receiver reads the value of the argument."<br>
        "eem 5/24/2008 Rewritten to no longer assume the compler uses the<br>
         most compact encoding available (for EncoderForLongFormV3 support)."<br>
+       <br>
        | litIndex scanner |<br>
+       (litIndex := self indexOfLiteral: variableBinding) = 0<br>
+               ifTrue: [^false].<br>
+       <br>
+       self codeLiteralsDo: [:compiledCode | <br>
+               scanner := InstructionStream on: compiledCode.<br>
+               (scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner))<br>
+                       ifTrue: [^ true]].<br>
+       <br>
+       ^ false!<br>
-       (litIndex := self indexOfLiteral: variableBinding) = 0 ifTrue:<br>
-               [^false].<br>
-       scanner := InstructionStream on: self.<br>
-       ^scanner scanFor: (self encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner)!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>refersToLiteral: (in category 'literals') -----<br>
- refersToLiteral:aLiteral<br>
- <br>
-       ^self hasLiteral: aLiteral.!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>sendsSelector: (in category 'literals') -----<br>
- sendsSelector: aSelector <br>
-       | scanner |<br>
-       scanner := InstructionStream on: self.<br>
-       scanner scanFor: <br>
-               [:x | <br>
-                scanner selectorToSendOrSelf == aSelector ifTrue:<br>
-                       [^true].<br>
-                false  "keep scanning"].<br>
-       ^false!<br>
<br>
Item was removed:<br>
- ----- Method: CompiledMethod>>sendsToSuper (in category 'scanning') -----<br>
- sendsToSuper<br>
-       "Answer whether the receiver sends any message to super."<br>
-       | scanner |<br>
-       scanner := InstructionStream on: self.<br>
-       ^scanner scanFor: (self encoderClass superSendScanBlockUsing: scanner)!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledMethod>>writesField: (in category 'scanning') -----<br>
  writesField: varIndex<br>
+       "Answer whether the receiver stores into the instance variable indexed by the argument."<br>
-       "Answer whether the receiver stores into the instance variable indexed<br>
-        by the argument."<br>
<br>
+       | varIndexCode scanner |<br>
+       self isQuick ifTrue: [^ false].<br>
+       varIndexCode := varIndex - 1.<br>
+       <br>
+       self codeLiteralsDo: [:compiledCode | <br>
+               scanner := InstructionStream on: compiledCode.<br>
+               (scanner scanFor: (self encoderClass instVarWriteScanBlockFor: varIndex - 1 using: scanner))<br>
+                       ifTrue: [^ true]].<br>
+       <br>
+       ^ false!<br>
-       | scanner |<br>
-       self isQuick ifTrue: [^false].<br>
-       scanner := InstructionStream on: self.<br>
-       ^scanner scanFor: (self encoderClass instVarWriteScanBlockFor: varIndex - 1 using: scanner)!<br>
<br>
Item was changed:<br>
  ----- Method: CompiledMethod>>writesRef: (in category 'scanning') -----<br>
  writesRef: variableBinding <br>
        "Answer whether the receiver writes the value of the argument."<br>
        "eem 5/24/2008 Rewritten to no longer assume the compler uses the<br>
         most compact encoding available (for EncoderForLongFormV3 support)."<br>
+       <br>
        | litIndex scanner |<br>
+       (litIndex := self indexOfLiteral: variableBinding) = 0<br>
+               ifTrue: [^ false].<br>
+       <br>
+       self codeLiteralsDo: [:compiledCode | <br>
+               scanner := InstructionStream on: compiledCode.<br>
+               (scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner))<br>
+                       ifTrue: [^ true]].<br>
+ <br>
+       ^ false!<br>
-       (litIndex := self indexOfLiteral: variableBinding) = 0 ifTrue:<br>
-               [^false].<br>
-       scanner := InstructionStream on: self.<br>
-       ^scanner scanFor: (self encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner)!<br>
<br>
Item was removed:<br>
- ----- Method: Pragma>>hasLiteralSuchThat: (in category 'testing') -----<br>
- hasLiteralSuchThat: aBlock<br>
-       "Answer true if litBlock returns true for any literal in the receiver, even if embedded in further array structure.<br>
-        This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"<br>
-       ^(aBlock value: keyword)<br>
-          or: [arguments hasLiteralSuchThat: aBlock]!<br>
<br>
<br>
</blockquote></div><br clear="all"><div><br></div>-- <br><div dir="ltr" class="gmail_signature"><div dir="ltr"><div><span style="font-size:small;border-collapse:separate"><div>_,,,^..^,,,_<br></div><div>best, Eliot</div></span></div></div></div>