[squeak-dev] The Trunk: Kernel-eem.242.mcz

Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.242.mcz

==================== Summary ====================

Name: Kernel-eem.242
Author: eem
Time: 5 September 2009, 4:15:59 am
UUID: 4732bd13-57f5-4cf0-90fb-0f951ea37509
Ancestors: Kernel-laza.241

Second package of eight in closure compiler fixes 9/5/2009.

AdditionalMethodState replaces MethodProperties.  Kernel support for Compiler-eem.78 & Compiler-eem.79.

Add ProtoObject>>withArgs:executeMethod: for compiler's
use indtead of adding a method under #DoIt.

Make doesNotUnderstand: support resume:.  Requires
Exceptions-eem.12.

Speed up instVarNamed: et al using ClassDescription>>instVarIndexFor:ifAbsent:

Speed up Object>>species by using class prim directly.

=============== Diff against Kernel-laza.241 ===============

Item was added:
+ ----- Method: CompiledMethod>>methodClassAssociation (in category 'accessing') -----
+ methodClassAssociation
+ "answer the association to the class that I am installed in, or nil if none."
+ ^self literalAt: self numLiterals!

Item was added:
+ ----- Method: AdditionalMethodState>>includesProperty: (in category 'properties') -----
+ includesProperty: aKey
+ "Test if the property aKey is present."
+
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ propertyOrPragma := self basicAt: i.
+ (propertyOrPragma isVariableBinding
+ and: [propertyOrPragma key == aKey]) ifTrue:
+ [^true]].
+ ^false!

Item was changed:
+ ----- Method: CompiledMethod>>pragmas (in category 'accessing-pragmas & properties') -----
- ----- Method: CompiledMethod>>pragmas (in category 'accessing') -----
  pragmas
+ | selectorOrProperties |
+ ^(selectorOrProperties := self penultimateLiteral) isMethodProperties
+ ifTrue: [selectorOrProperties pragmas]
+ ifFalse: [#()]!
- "Answer an array of the pragmas of the reciever."
-
- ^ self properties pragmas.!

Item was changed:
  ----- Method: CompiledMethod>>methodClass (in category 'accessing') -----
  methodClass
  "answer the class that I am installed in"
- | who |
- self hasNewPropertyFormat ifFalse:
- [^(who := self who first) == #unknown ifFalse: [who]]. "there are some activated old methods"
  ^(self literalAt: self numLiterals) value.!

Item was changed:
  ----- Method: CompiledMethod>>selector: (in category 'accessing') -----
+ selector: aSelector
+ "Set a method's selector.  This is either the penultimate literal,
+ or, if the method has any properties or pragmas, the selector of
+ the MethodProperties stored in the penultimate literal."
+ | penultimateLiteral nl |
+ (penultimateLiteral := self penultimateLiteral) isMethodProperties
+ ifTrue: [penultimateLiteral selector: aSelector]
+ ifFalse: [(nl := self numLiterals) < 2 ifTrue:
+ [self error: 'insufficient literals to hold selector'].
+ self literalAt: nl - 1 put: aSelector]!
- selector: aSymbol
- self properties selector: aSymbol!

Item was changed:
  ----- Method: CompiledMethod>>methodNode (in category 'decompiling') -----
  methodNode
  "Return the parse tree that represents self"
  | aClass source |
  aClass := self methodClass.
+ source := self
+ getSourceFor: (self selector ifNil: [self defaultSelector])
+ in: aClass.
+ ^(aClass parserClass new
+ encoderClass: (self isBlueBookCompiled
+ ifTrue: [EncoderForV3]
+ ifFalse: [EncoderForV3PlusClosures]);
+ parse: source class: aClass)
+ sourceText: source;
+ yourself!
- ^ (source := self getSourceFromFile)
- ifNil: [self decompile]
- ifNotNil: [aClass parserClass new
- encoderClass: (self isBlueBookCompiled
- ifTrue: [EncoderForV3]
- ifFalse: [EncoderForV3PlusClosures]);
- parse: source class: aClass]!

Item was changed:
  ----- Method: CompiledMethod>>properties (in category 'accessing') -----
  properties
  "Answer the method properties of the receiver."
+ | propertiesOrSelector |
+ ^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
+ ifTrue: [propertiesOrSelector]
+ ifFalse: [AdditionalMethodState forMethod: self selector: propertiesOrSelector]!
-
- ^ self literalAt: self numLiterals - 1.!

Item was added:
+ ----- Method: CompiledMethod>>primitiveErrorVariableName (in category 'printing') -----
+ primitiveErrorVariableName
+ "Answer the primitive error code temp name, or nil if none."
+ self primitive > 0 ifTrue:
+ [self pragmas do:
+ [:pragma| | kwds ecIndex |
+ ((kwds := pragma keyword keywords) first = 'primitive:'
+ and: [(ecIndex := kwds indexOf: 'error:') > 0]) ifTrue:
+ [^pragma argumentAt: ecIndex]]].
+ ^nil!

Item was added:
+ ----- Method: MethodProperties>>isEmpty (in category 'testing') -----
+ isEmpty
+ ^(properties isNil or: [properties isEmpty])
+   and: [pragmas isNil or: [pragmas isEmpty]]!

Item was added:
+ ----- Method: AdditionalMethodState>>notEmpty (in category 'testing') -----
+ notEmpty
+ ^self basicSize > 0!

Item was changed:
  ----- Method: CompiledMethod>>decompilerClass (in category 'decompiling') -----
  decompilerClass
+ ^self compilerClass decompilerClass!
- ^ self isClosureCompiled
- ifTrue: [self compilerClass closureDecompilerClass]
- ifFalse: [self compilerClass decompilerClass]!

Item was added:
+ ----- Method: CompiledMethod>>who (in category 'printing') -----
+ who
+ "Answer an Array of the class in which the receiver is defined and the
+ selector to which it corresponds."
+
+ self hasNewPropertyFormat ifTrue:[^{self methodClass. self selector}].
+ self systemNavigation allBehaviorsDo:
+ [:class |
+ (class methodDict keyAtIdentityValue: self ifAbsent: [nil]) ifNotNil:
+ [:sel| ^Array with: class with: sel]].
+ ^Array with: #unknown with: #unknown!

Item was changed:
  ----- Method: CompiledMethod>>setSourcePointer: (in category 'source code management') -----
  setSourcePointer: srcPointer
+ srcPointer = 0 ifTrue: [
+ self at: self size put: 0.
+ ^self].
+ (srcPointer between: 16r1000000 and: 16r4FFFFFF) ifFalse: [self error: 'Source pointer out of range'].
+ self at: self size put: (srcPointer bitShift: -24) + 251.
+ 1 to: 3 do: [:i |
+ self at: self size-i put: ((srcPointer bitShift: (i-3)*8) bitAnd: 16rFF)]!
-
- self setMySourcePointer: srcPointer.
- self embeddedBlockMethods do: [:m |
- m setSourcePointer: srcPointer].
- !

Item was changed:
  ----- Method: Object>>instVarNamed: (in category 'system primitives') -----
  instVarNamed: aString
  "Return the value of the instance variable in me with that name.  Slow and unclean, but very useful. "
 
+ ^ self instVarAt: (self class
+ instVarIndexFor: aString asString
+ ifAbsent: [self error: 'no such inst var'])
- ^ self instVarAt: (self class allInstVarNames indexOf: aString asString)
 
 
  !

Item was added:
+ ----- Method: CompiledMethod>>tempNamesString (in category 'source code management') -----
+ tempNamesString
+ "Decompress the encoded temp names into a schematicTempNames string."
+ | sz flagByte |
+ flagByte := self at: (sz := self size).
+ (flagByte = 0 or: [flagByte > 251]) ifTrue: [^self error: 'not yet implemented'].
+ (flagByte = 251
+ and: [(1 to: 3) allSatisfy: [:i | (self at: self size - i) = 0]]) ifTrue:
+ [^self error: 'not yet implemented'].
+ ^self qDecompressFrom: (flagByte <= 127
+ ifTrue:
+ [ReadStream on: self from: sz - flagByte to: sz - 1]
+ ifFalse:
+ [ReadStream on: self from: sz - (flagByte - 128 * 128 + (self at: sz - 1)) - 1 to: sz - 2])!

Item was changed:
  ----- Method: ClassDescription>>chooseClassVarName (in category 'instance variables') -----
  chooseClassVarName
  "Present the user with a list of class variable names and answer the one selected, or nil if none"
 
+ | lines labelStream allVars index |
- | lines labelStream vars allVars index |
  lines := OrderedCollection new.
  allVars := OrderedCollection new.
  labelStream := WriteStream on: (String new: 200).
  self withAllSuperclasses reverseDo:
+ [:class | | vars |
- [:class |
  vars := class classVarNames asSortedCollection.
  vars do:
  [:var |
  labelStream nextPutAll: var; cr.
  allVars add: var].
  vars isEmpty ifFalse: [lines add: allVars size]].
  labelStream contents isEmpty ifTrue: [^Beeper beep]. "handle nil superclass better"
  labelStream skip: -1 "cut last CR".
  index := (UIManager default chooseFrom: (labelStream contents substrings) lines: lines).
  index = 0 ifTrue: [^ nil].
+ ^ allVars at: index!
- ^ allVars at: index
- !

Item was added:
+ ----- Method: BlockClosure>>isDead (in category 'testing') -----
+ isDead
+ "Has self finished"
+ ^false!

Item was changed:
  ----- Method: ContextPart>>methodNode (in category 'accessing') -----
  methodNode
- self method isBlockMethod ifTrue: [^ self method blockNode].
  ^ self method methodNode.!

Item was changed:
  ----- Method: CompiledMethod>>parserClass (in category 'decompiling') -----
  parserClass
+ ^self methodClass
+ ifNil: [Compiler parserClass]
+ ifNotNil: [:class | class parserClass].!
- ^ self isClosureCompiled
- ifTrue: [self compilerClass closureParserClass]
- ifFalse: [self compilerClass parserClass]!

Item was changed:
  ----- Method: CompiledMethod>>flag (in category 'accessing') -----
  flag
  "Answer the user-level flag bit"
 
+ ^((self header bitShift: -29) bitAnd: 1) = 1!
- ^( (self header bitShift: -29) bitAnd: 1) = 1
- ifTrue: [ true ]
- ifFalse: [ false ]
- !

Item was added:
+ ----- Method: CompiledMethod>>propertyValueAt:ifAbsent: (in category 'accessing-pragmas & properties') -----
+ propertyValueAt: propName ifAbsent: aBlock
+ | propertiesOrSelector |
+ ^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
+ ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: aBlock]
+ ifFalse: [aBlock value]!

Item was changed:
  ----- Method: MethodProperties>>analogousCodeTo: (in category 'testing') -----
  analogousCodeTo: aMethodProperties
  pragmas
  ifNil: [aMethodProperties pragmas notEmpty ifTrue: [^false]]
  ifNotNil:
+ [aMethodProperties pragmas empty ifTrue: [^false].
+ pragmas size ~= aMethodProperties pragmas size ifTrue:
- [pragmas size ~= aMethodProperties pragmas size ifTrue:
  [^false].
  pragmas with: aMethodProperties pragmas do:
  [:mine :others|
  (mine analogousCodeTo: others) ifFalse: [^false]]].
- (self propertiesIsNil and: [aMethodProperties propertiesIsNil]) ifTrue: [^true].
  ^(self hasAtLeastTheSamePropertiesAs: aMethodProperties)
   and: [aMethodProperties hasAtLeastTheSamePropertiesAs: self]!

Item was added:
+ ----- Method: CompiledMethod>>messagesSequence (in category 'scanning') -----
+ messagesSequence
+ "Answer a Set of all the message selectors sent by this method."
+
+ ^Array streamContents:
+ [:str| | scanner |
+ scanner := InstructionStream on: self.
+ scanner scanFor:
+ [:x | | selectorOrSelf |
+ (selectorOrSelf := scanner selectorToSendOrSelf) == scanner ifFalse:
+ [str nextPut: selectorOrSelf].
+ false "keep scanning"]]!

Item was added:
+ ----- Method: MethodContext>>hasMethodReturn (in category 'accessing') -----
+ hasMethodReturn
+ ^closureOrNil hasMethodReturn!

Item was added:
+ ----- Method: CompiledMethod>>propertyValueAt:put: (in category 'accessing-pragmas & properties') -----
+ propertyValueAt: propName put: propValue
+ "Set or add the property with key propName and value propValue.
+ If the receiver does not yet have a method properties create one and replace
+ the selector with it.  Otherwise, either relace propValue in the method properties
+ or replace method properties with one containing the new property."
+ | propertiesOrSelector |
+ (propertiesOrSelector := self penultimateLiteral) isMethodProperties ifFalse:
+ [self penultimateLiteral: ((AdditionalMethodState
+ selector: propertiesOrSelector
+ with: (Association
+ key: propName asSymbol
+ value: propValue))
+ setMethod: self;
+ yourself).
+ ^propValue].
+ (propertiesOrSelector includesProperty: propName) ifTrue:
+ [^propertiesOrSelector at: propName put: propValue].
+ self penultimateLiteral: (propertiesOrSelector
+ copyWith: (Association
+ key: propName asSymbol
+ value: propValue)).
+ ^propValue!

Item was changed:
  ----- Method: CompiledMethod>>literalsDo: (in category 'literals') -----
+ literalsDo: aBlock
+ "Evaluate aBlock for each of the literals referenced by the receiver."
+ 1 to: self numLiterals do:
+ [:index |
+ aBlock value: (self objectAt: index + 1)]!
- literalsDo: aOneArgumentBlock
-
- ^self literals do:aOneArgumentBlock.!

Item was added:
+ ----- Method: AdditionalMethodState>>pragmas (in category 'accessing') -----
+ pragmas
+ "Answer the raw messages comprising my pragmas."
+ | pragmaStream |
+ pragmaStream := WriteStream on: (Array new: self basicSize).
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Message>" |
+ (propertyOrPragma := self basicAt: i) isVariableBinding ifFalse:
+ [pragmaStream nextPut: propertyOrPragma]].
+ ^pragmaStream contents!

Item was added:
+ ----- Method: AdditionalMethodState>>at:ifAbsentPut: (in category 'accessing') -----
+ at: aKey ifAbsentPut: aBlock
+ "Answer the property value or pragma associated with aKey or,
+ if aKey isn't found, answer the result of evaluating aBlock."
+
+ 1 to: self basicSize do:
+ [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ (propertyOrPragma := self basicAt: i) key == aKey ifTrue:
+ [^propertyOrPragma isVariableBinding
+ ifTrue: [propertyOrPragma value]
+ ifFalse: [propertyOrPragma]]].
+ ^method propertyValueAt: aKey put: aBlock value!

Item was added:
+ ----- Method: AdditionalMethodState>>method: (in category 'decompiling') -----
+ method: aMethodNodeOrNil
+ "For decompilation"
+ method := aMethodNodeOrNil!

Item was changed:
  ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'evaluating') -----
  simulateValueWithArguments: anArray caller: aContext
  | newContext sz |
+ (anArray class ~~ Array
+ or: [numArgs ~= anArray size]) ifTrue:
+ [^ContextPart primitiveFailToken].
- numArgs ~= anArray size ifTrue:
- [self numArgsError: anArray size].
  newContext := (MethodContext newForMethod: outerContext method)
  setSender: aContext
  receiver: outerContext receiver
  method: outerContext method
  closure: self
  startpc: startpc.
  sz := self basicSize.
  newContext stackp: sz + numArgs.
  1 to: numArgs do:
  [:i| newContext at: i put: (anArray at: i)].
  1 to: sz do:
  [:i| newContext at: i + numArgs put: (self at: i)].
  ^newContext!

Item was added:
+ ----- Method: AdditionalMethodState>>selector: (in category 'accessing') -----
+ selector: aSymbol
+ selector := aSymbol!

Item was added:
+ ----- Method: AdditionalMethodState>>removeKey: (in category 'properties') -----
+ removeKey: aKey
+ "Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
+
+ ^ self removeKey: aKey ifAbsent: [ self error: 'Property not found' ].!

Item was changed:
  ----- Method: CompiledMethod>>getSourceFor:in: (in category 'source code management') -----
  getSourceFor: selector in: class
  "Retrieve or reconstruct the source code for this method."
+ | flagByte |
- | source flagByte sourceSelector |
  flagByte := self last.
  (flagByte = 0
  or: [flagByte = 251 "some source-less methods have flag = 251, rest = 0"
+ and: [((1 to: 3) allSatisfy: [:i | (self at: self size - i) = 0])]])
+ ifTrue:
+ ["No source pointer -- decompile without temp names"
+ ^ (class decompilerClass new decompile: selector in: class method: self)
+ decompileString].
- and: [((1 to: 3) collect: [:i | self at: self size - i]) = #(0 0 0)]])
- ifTrue: ["No source pointer -- decompile without temp names"
- ^ self decompileString].
  flagByte < 252 ifTrue:
  ["Magic sources -- decompile with temp names"
+ ^ ((class decompilerClass new withTempNames: self tempNamesString)
- ^ ((self decompilerClass new withTempNames: self tempNames)
  decompile: selector in: class method: self)
  decompileString].
 
  "Situation normal;  read the sourceCode from the file"
+ ^self getSourceFromFile ifNil:
+ ["Something really wrong -- decompile blind (no temps)"
+ (class decompilerClass new decompile: selector in: class method: self)
+ decompileString]!
-
- [ source := self getSourceFromFile ] on: Error do: [ :ex |
- "An error can happen here if, for example, the changes file has been truncated by an aborted download.  The present solution is to ignore the error and fall back on the decompiler.  A more thorough solution should probably trigger a systematic invalidation of all source pointers past the end of the changes file.  Consider that, as time goes on, the changes file will eventually grow large enough to cover the lost code, and then instead of falling into this error case, random source code will get returned."
- source := nil ].
-
- source ifNotNil: [
- sourceSelector := Parser parserClass new parseSelector: source.
- ^sourceSelector = selector
- ifTrue: [source]
- ifFalse: [
- self replace: sourceSelector with: selector in: source]].
-
- "Something really wrong -- decompile blind (no temps)"
- ^ self decompileString!

Item was changed:
  ----- Method: CompiledMethod>>endPC (in category 'accessing') -----
  endPC
  "Answer the index of the last bytecode."
+ | size flagByte |
+ "Can't create a zero-sized CompiledMethod so no need to use last for the errorEmptyCollection check.
+ We can reuse size."
+ size := self size.
+ flagByte := self at: size.
- | flagByte |
- flagByte := self last.
  flagByte = 0 ifTrue:
  ["If last byte = 0, may be either 0, 0, 0, 0 or just 0"
+ 1 to: 4 do: [:i | (self at: size - i) = 0 ifFalse: [^size - i]]].
- 1 to: 4 do: [:i | (self at: self size - i) = 0 ifFalse: [^ self size - i]]].
  flagByte < 252 ifTrue:
+ ["Magic sources (temp names encoded in last few bytes)"
+ ^flagByte <= 127
+ ifTrue: [size - flagByte - 1]
+ ifFalse: [size - (flagByte - 128 * 128) - (self at: size - 1) - 2]].
- ["Magic sources (tempnames encoded in last few bytes)"
- ^ self size - self last - 1].
  "Normal 4-byte source pointer"
+ ^size - 4!
- ^ self size - 4!

Item was added:
+ ----- Method: CompiledMethod>>clearFlag (in category 'accessing') -----
+ clearFlag
+ "Clear the user-level flag bit"
+
+ self objectAt: 1 put: (self header bitAnd: (1 << 29) bitInvert)!

Item was changed:
  ----- Method: MethodProperties>>pragmas (in category 'accessing') -----
  pragmas
+ ^pragmas ifNil:[#()]!
- ^ pragmas!

Item was changed:
  ----- Method: CompiledMethod>>hasLiteralThorough: (in category 'literals') -----
+ hasLiteralThorough: literal
+ "Answer true if any literal in this method is literal,
+ even if embedded in array structure."
- hasLiteralThorough: aLiteral
- "Answer true if any literal in this method is literal, even if embedded in array structure or within its pragmas."
 
+ (self penultimateLiteral isMethodProperties
+ and: [self penultimateLiteral hasLiteralThorough: literal]) ifTrue:[^true].
+ 2 to: self numLiterals - 1 "exclude superclass + selector/properties"
+   do:[:index | | lit |
+ ((lit := self objectAt: index) == literal
+ or: [(lit isVariableBinding and: [lit key == literal])
+ or: [lit isArray and: [lit hasLiteral: literal]]]) ifTrue:
+ [^ true]].
+ ^ false !
- | literal |
- self pragmas do: [ :pragma |
- (pragma hasLiteral: aLiteral) ifTrue: [ ^ true ] ].
- 2 to: self numLiterals + 1 do: [ :index |
- literal := self objectAt: index.
- literal == aLiteral  ifTrue: [ ^ true ].
- (literal hasLiteralThorough: aLiteral) ifTrue: [ ^ true ] ].
- ^ false.!

Item was added:
+ ----- Method: AdditionalMethodState>>copyWithout: (in category 'copying') -----
+ copyWithout: aPropertyOrPragma "<Association|Pragma>"
+ "Answer a copy of the receiver which no longer includes aPropertyOrPragma"
+ | bs copy offset |
+ copy := self class new: (bs := self basicSize) - ((self includes: aPropertyOrPragma)
+ ifTrue: [1]
+ ifFalse: [0]).
+ offset := 0.
+ 1 to: bs do:
+ [:i|
+ (self basicAt: i) = aPropertyOrPragma
+ ifTrue: [offset := 1]
+ ifFalse: [copy basicAt: i - offset put: (self basicAt: i)]].
+ ^copy
+ selector: selector;
+ setMethod: method;
+ yourself
+ !

Item was added:
+ ----- Method: CompiledMethod>>penultimateLiteral (in category 'private') -----
+ penultimateLiteral
+ "Answer the penultimate literal of the receiver, which holds either
+ the receiver's selector or its properties (which will hold the selector)."
+ | pIndex |
+ ^(pIndex := self numLiterals - 1) > 0
+ ifTrue: [self literalAt: pIndex]
+ ifFalse: [nil]!

Item was added:
+ ----- Method: AdditionalMethodState>>properties (in category 'accessing') -----
+ properties
+
+ | propertyStream |
+ propertyStream := WriteStream on: (Array new: self basicSize * 2).
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ (propertyOrPragma := self basicAt: i) isVariableBinding ifTrue:
+ [propertyStream nextPut: propertyOrPragma key; nextPut: propertyOrPragma value]].
+ ^IdentityDictionary newFromPairs: propertyStream contents!

Item was changed:
  ----- Method: Pragma>>hasLiteralSuchThat: (in category 'testing') -----
  hasLiteralSuchThat: aBlock
+ "Answer true if litBlock returns true for any literal in the receiver, even if embedded in further array structure.
+ This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"
+ ^(aBlock value: keyword)
+   or: [arguments hasLiteralSuchThat: aBlock]!
- ^ (aBlock value: self keyword)
- or: [ self arguments hasLiteralSuchThat: aBlock ].!

Item was added:
+ ----- Method: CompiledMethod>>blockExtentsToTempsMap (in category 'debugger support') -----
+ blockExtentsToTempsMap
+ "If the receiver has been copied with temp names answer a
+ map from blockExtent to temps map in the same format as
+ BytecodeEncoder>>blockExtentsToTempNamesMap.  if the
+ receiver has not been copied with temps answer nil."
+ ^self holdsTempNames ifTrue:
+ [self mapFromBlockKeys: ((self startpcsToBlockExtents associations asSortedCollection:
+ [:a1 :a2| a1 key < a2 key]) collect:
+ [:assoc| assoc value])
+ toSchematicTemps: self tempNamesString]!

Item was added:
+ ----- Method: AdditionalMethodState>>keysAndValuesDo: (in category 'accessing') -----
+ keysAndValuesDo: aBlock
+ "Enumerate the receiver with all the keys and values."
+
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ (propertyOrPragma := self basicAt: i) isVariableBinding
+ ifTrue: [aBlock value: propertyOrPragma key value: propertyOrPragma value]
+ ifFalse: [aBlock value: propertyOrPragma keyword value: propertyOrPragma]]!

Item was changed:
  ----- Method: Object>>doesNotUnderstand: (in category 'error handling') -----
  doesNotUnderstand: aMessage
+ "Handle the fact that there was an attempt to send the given
+  message to the receiver but the receiver does not understand
+  this message (typically sent from the machine when a message
+ is sent to the receiver and no method is defined for that selector)."
+
- "Handle the fact that there was an attempt to send the given message to the receiver but the receiver does not understand this message (typically sent from the machine when a message is sent to the receiver and no method is defined for that selector)."
  "Testing: (3 activeProcess)"
 
+ | exception resumeValue |
+ (Preferences autoAccessors
+ and: [self tryToDefineVariableAccess: aMessage]) ifTrue:
+ [^aMessage sentTo: self].
+
+ (exception := MessageNotUnderstood new)
- MessageNotUnderstood new
  message: aMessage;
+ receiver: self.
+ resumeValue := exception signal.
+ ^exception reachedDefaultHandler
+ ifTrue: [aMessage sentTo: self]
+ ifFalse: [resumeValue]!
- receiver: self;
- signal.
- ^ aMessage sentTo: self.
- !

Item was added:
+ ----- Method: AdditionalMethodState>>propertyValueAt:ifAbsent: (in category 'properties') -----
+ propertyValueAt: aKey ifAbsent: aBlock
+ "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ propertyOrPragma := self basicAt: i.
+ (propertyOrPragma isVariableBinding
+ and: [propertyOrPragma key == aKey]) ifTrue:
+ [^propertyOrPragma value]].
+ ^aBlock value!

Item was added:
+ Object variableSubclass: #AdditionalMethodState
+ instanceVariableNames: 'method selector'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Kernel-Methods'!
+
+ !AdditionalMethodState commentStamp: '<historical>' prior: 0!
+ I am class holding state for compiled methods. All my instance variables should be actually part of the CompiledMethod itself, but the current implementation of the VM doesn't allow this.  Currently I hold the selector and any pragmas or properties the compiled method has.  Pragmas and properties are stored in indexable fields; pragmas as instances of Pragma, properties as instances of Association.
+
+ I am a reimplementation of much of MethodProperties, but eliminating the explicit properties and pragmas dictionaries.  Hence I answer true to isMethodProperties.!

Item was changed:
  ----- Method: CompiledMethod>>indexOfLiteral: (in category 'literals') -----
  indexOfLiteral: literal
  "Answer the literal index of the argument, literal, or zero if none."
+ 2 to: self numLiterals - 1 "exclude superclass + selector/properties"
+   do:
- | max |
- max := self numLiterals.
- max := self hasNewPropertyFormat
- ifTrue: [max - 1] "exclude superclass + properties"
- ifFalse: [max + 1].
- 2 to: max do:
  [:index |
  literal == (self objectAt: index) ifTrue: [^index - 1]].
  ^0!

Item was added:
+ ----- Method: CompiledMethod>>propertyKeysAndValuesDo: (in category 'accessing-pragmas & properties') -----
+ propertyKeysAndValuesDo: aBlock
+ "Enumerate the receiver with all the keys and values."
+
+ | propertiesOrSelector |
+ (propertiesOrSelector := self penultimateLiteral) isMethodProperties ifTrue:
+ [propertiesOrSelector propertyKeysAndValuesDo: aBlock]!

Item was changed:
  ----- Method: CompiledMethod>>compilerClass (in category 'decompiling') -----
  compilerClass
  ^self methodClass
+ ifNil: [Compiler]
+ ifNotNil: [:class | class compilerClass].!
- ifNil: [self class compilerClass]
- ifNotNilDo: [:class | class compilerClass].!

Item was changed:
  ----- Method: CompiledMethod>>literalStrings (in category 'literals') -----
  literalStrings
+ | litStrs |
+ litStrs := OrderedCollection new: self numLiterals.
+ self literalsDo:
- | lits litStrs |
- lits := self literals.
- litStrs := OrderedCollection new: lits size * 3.
- self literals do:
  [:lit |
  (lit isVariableBinding)
  ifTrue: [litStrs addLast: lit key]
  ifFalse: [(lit isSymbol)
  ifTrue: [litStrs addAll: lit keywords]
  ifFalse: [litStrs addLast: lit printString]]].
  ^ litStrs!

Item was added:
+ ----- Method: CompiledMethod>>penultimateLiteral: (in category 'private') -----
+ penultimateLiteral: anObject
+ "Answer the penultimate literal of the receiver, which holds either
+ the receiver's selector or its properties (which will hold the selector)."
+ | pIndex |
+ (pIndex := self numLiterals - 1) > 0
+ ifTrue: [self literalAt: pIndex put: anObject]
+ ifFalse: [self error: 'insufficient literals']!

Item was added:
+ ----- Method: Message>>analogousCodeTo: (in category 'comparing') -----
+ analogousCodeTo: anObject
+ "For MethodPropertires comparison."
+ ^self class == anObject class
+  and: [selector == anObject selector
+  and: [args = anObject arguments
+  and: [lookupClass == anObject lookupClass]]]!

Item was added:
+ ----- Method: MethodProperties>>propertyValueAt:ifAbsent: (in category 'properties') -----
+ propertyValueAt: aKey ifAbsent: aBlock
+ "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+ ^self at: aKey ifAbsent: aBlock!

Item was changed:
  ----- Method: BlockClosure>>fixTemps (in category 'private') -----
  fixTemps
+ "Fix the values of the temporary variables used in the block that
+ are  ordinarily shared with the method in which the block is defined.
+ This is a no-op for closures, provided for backward-compatibility with
+ old BlockContexts that needed the fixTemps hack to persist."!
- "Fix the values of the temporary variables used in the block that are
- ordinarily shared with the method in which the block is defined.  We
- need to copy the copiedValues, copying anything looking like a remote
- temp vector.  if we accidentally copy an Array that isn't actually an
- indirect temp vector we may break things, so this is a real hack."
-
- 1 to: self numCopiedValues do:
- [:i| | each |
- (each := self at: i) isArray ifTrue:
- [self at: i put: each shallowCopy]]!

Item was added:
+ ----- Method: CompiledMethod>>propertyValueAt: (in category 'accessing-pragmas & properties') -----
+ propertyValueAt: propName
+ | propertiesOrSelector |
+ ^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
+ ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: [nil]]
+ ifFalse: [nil]!

Item was changed:
  ----- Method: CompiledMethod>>hasLiteralSuchThat: (in category 'literals') -----
+ hasLiteralSuchThat: litBlock
+ "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure."
+ (self penultimateLiteral isMethodProperties
+ and: [self penultimateLiteral hasLiteralSuchThat: litBlock]) ifTrue:
+ [^true].
+ 2 to: self numLiterals + 1 do:
+ [:index | | lit |
+ lit := self objectAt: index.
+ ((litBlock value: lit)
+ or: [lit isArray and: [lit hasLiteralSuchThat: litBlock]]) ifTrue:
+ [^true]].
+ ^false!
- hasLiteralSuchThat: aBlock
- "Answer true if aBlock returns true for any literal in this method, even if imbedded in array structure or within its pragmas."
-
- | literal |
- self pragmas do: [ :pragma |
- (pragma hasLiteralSuchThat: aBlock)
- ifTrue: [ ^ true ] ].
- 2 to: self numLiterals + 1 do: [ :index |
- literal := self objectAt: index.
- (aBlock value: literal)
- ifTrue: [ ^ true ].
- (literal hasLiteralSuchThat: aBlock)
- ifTrue: [ ^ true ] ].
- ^ false.!

Item was changed:
  ----- Method: Pragma>>arguments (in category 'accessing-pragma') -----
  arguments
+ "Answer the arguments of the receiving pragma. For a pragma defined as <key1: val1 key2: val2> this will answer #(val1 val2)."
- "Answer the arguments of the recieving pragma. For a pragma defined as <key1: val1 key2: val2> this will answer #(val1 val2)."
 
  ^ arguments!

Item was added:
+ ----- Method: CompiledMethod>>qCompress: (in category 'source code management') -----
+ qCompress: string
+ "A very simple text compression routine designed for method temp names.
+ Most common 11 chars get values 1-11 packed in one 4-bit nibble;
+ the next most common get values 12-15 (2 bits) * 16 plus next nibble;
+ unusual ones get three nibbles, the first being the escape nibble 0.
+ CompiledMethod>>endPC determines the maximum length of encoded
+ output, which means 1 to (251 - 128) * 128 + 127, or 15871 bytes"
+ string isEmpty ifTrue:
+ [^self qCompress: ' '].
+ ^ ByteArray streamContents:
+ [:strm | | ix oddNibble sz |
+ oddNibble := nil.
+ string do:
+ [:char |
+ ix := 'ear tonsilcmbdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345[]()'
+ indexOf: char ifAbsent: 0.
+ (ix = 0
+ ifTrue:
+ [char asInteger > 255 ifTrue: [^nil]. "Could use UTF8 here; too lazy right now"
+ { 0. char asInteger // 16. char asInteger \\ 16 }]
+ ifFalse:
+ [ix <= 11
+ ifTrue: [{ ix }]
+ ifFalse: [{ ix//16+12. ix\\16 }]])
+ do: [:nibble |
+ oddNibble
+ ifNotNil: [strm nextPut: oddNibble*16 + nibble. oddNibble := nil]
+ ifNil: [oddNibble := nibble]]].
+ oddNibble ifNotNil: "4 = 'ear tonsil' indexOf: Character space"
+ [strm nextPut: oddNibble * 16 + 4].
+ (sz := strm position) > ((251 - 128) * 128 + 127) ifTrue:
+ [^nil].
+ sz <= 127
+ ifTrue: [strm nextPut: sz]
+ ifFalse:
+ [strm nextPut: sz \\ 128; nextPut: sz // 128 + 128]]!

Item was changed:
  ----- Method: CompiledMethod>>holdsTempNames (in category 'source code management') -----
  holdsTempNames
  "Are tempNames stored in trailer bytes"
 
  | flagByte |
  flagByte := self last.
  (flagByte = 0 or: [flagByte = 251 "some source-less methods have flag = 251, rest = 0"
+ and: [(1 to: 3) allSatisfy: [:i | (self at: self size - i) = 0]]])
- and: [((1 to: 3) collect: [:i | self at: self size - i]) = #(0 0 0)]])
  ifTrue: [^ false].  "No source pointer & no temp names"
  flagByte < 252 ifTrue: [^ true].  "temp names compressed"
  ^ false "Source pointer"
  !

Item was changed:
  ----- Method: MethodProperties>>addPragma: (in category 'private') -----
  addPragma: aPragma
+ pragmas := self pragmas copyWith: aPragma.!
- pragmas := pragmas copyWith: aPragma.!

Item was added:
+ ----- Method: AdditionalMethodState>>hasLiteralThorough: (in category 'testing') -----
+ hasLiteralThorough: literal
+ "Answer true if any literal in these properties is literal,
+ even if embedded in array structure."
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ propertyOrPragma := self basicAt: i.
+ (propertyOrPragma isVariableBinding
+ ifTrue: [propertyOrPragma key == literal
+ or: [propertyOrPragma value == literal
+ or: [propertyOrPragma value isArray
+ and: [propertyOrPragma value hasLiteral: literal]]]]
+ ifFalse: [propertyOrPragma hasLiteral: literal]) ifTrue:
+ [^true]].
+ ^false!

Item was added:
+ ----- Method: MessageSend>>numArgs (in category 'accessing') -----
+ numArgs
+ "Answer the number of arguments in this message"
+
+ ^arguments size!

Item was added:
+ ----- Method: AdditionalMethodState>>at:put: (in category 'accessing') -----
+ at: aKey put: aValue
+ "Replace the property value or pragma associated with aKey."
+
+ 1 to: self basicSize do:
+ [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ (propertyOrPragma := self basicAt: i) key == aKey ifTrue:
+ [propertyOrPragma isVariableBinding
+ ifTrue: [propertyOrPragma value: aValue]
+ ifFalse: [self basicAt: i put: aValue]]].
+ ^method propertyValueAt: aKey put: aValue!

Item was added:
+ ----- Method: MethodProperties>>pragmas: (in category 'accessing') -----
+ pragmas: anArray
+ pragmas := anArray!

Item was added:
+ ----- Method: MethodProperties>>notEmpty (in category 'testing') -----
+ notEmpty
+ ^(properties notNil and: [properties notEmpty])
+   or: [pragmas notNil and: [pragmas notEmpty]]!

Item was changed:
  ----- Method: CompiledMethod>>selector (in category 'accessing') -----
  selector
+ "Answer a method's selector.  This is either the penultimate literal,
+ or, if the method has any properties or pragmas, the selector of
+ the MethodProperties stored in the penultimate literal."
+ | penultimateLiteral |
+ ^(penultimateLiteral := self penultimateLiteral) isMethodProperties
+ ifTrue: [penultimateLiteral selector]
+ ifFalse: [penultimateLiteral]!
- ^self properties selector.!

Item was added:
+ ----- Method: AdditionalMethodState>>copyWith: (in category 'copying') -----
+ copyWith: aPropertyOrPragma "<Association|Pragma>"
+ "Answer a copy of the receiver which includes aPropertyOrPragma"
+ | bs copy |
+ (Association == aPropertyOrPragma class
+ or: [Pragma == aPropertyOrPragma class]) ifFalse:
+ [self error: self class name, ' instances should hold only Associations or Pragmas.'].
+ copy := self class new: (bs := self basicSize) + 1.
+ 1 to: bs do:
+ [:i|
+ copy basicAt: i put: (self basicAt: i)].
+ copy basicAt: bs + 1 put: aPropertyOrPragma.
+ ^copy
+ selector: selector;
+ setMethod: method;
+ yourself
+ !

Item was added:
+ ----- Method: ProtoObject>>withArgs:executeMethod: (in category 'debugging') -----
+ withArgs: argArray executeMethod: compiledMethod
+ "Execute compiledMethod against the receiver and args in argArray"
+
+ <primitive: 188>
+ self primitiveFailed!

Item was added:
+ ----- Method: AdditionalMethodState>>setMethod: (in category 'accessing') -----
+ setMethod: aMethod
+ method := aMethod.
+ 1 to: self basicSize do:
+ [:i| | propertyOrPragma "<Association|Pragma>" |
+ (propertyOrPragma := self basicAt: i) isVariableBinding ifFalse:
+ [propertyOrPragma setMethod: aMethod]]!

Item was added:
+ ----- Method: AdditionalMethodState>>propertyKeysAndValuesDo: (in category 'properties') -----
+ propertyKeysAndValuesDo: aBlock
+ "Enumerate the receiver with all the keys and values."
+
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ (propertyOrPragma := self basicAt: i) isVariableBinding ifTrue:
+ [aBlock value: propertyOrPragma key value: propertyOrPragma value]]!

Item was added:
+ ----- Method: ContextPart>>isContext (in category 'query') -----
+ isContext
+ ^true!

Item was changed:
  ----- Method: CompiledMethod>>properties: (in category 'accessing') -----
  properties: aMethodProperties
  "Set the method-properties of the receiver to aMethodProperties."
+ self literalAt: self numLiterals - 1
+ put: (aMethodProperties isEmpty
+ ifTrue: [aMethodProperties selector]
+ ifFalse: [aMethodProperties
+ setMethod: self;
+ yourself])!
-
- aMethodProperties pragmas do: [ :each | each setMethod: self ].
- ^ self literalAt: self numLiterals - 1 put: aMethodProperties.!

Item was changed:
  ----- Method: Object>>caseError (in category 'error handling') -----
  caseError
  "Report an error from an in-line or explicit case statement."
 
+ self error: 'Case not found (', self printString, '), and no otherwise clause'!
- self error: 'Case not found, and no otherwise clause'!

Item was added:
+ ----- Method: AdditionalMethodState>>propertyValueAt: (in category 'properties') -----
+ propertyValueAt: aKey
+ "Answer the property value associated with aKey."
+
+ ^ self propertyValueAt: aKey ifAbsent: [ self error: 'Property not found' ].!

Item was added:
+ ----- Method: MethodProperties>>setMethod: (in category 'forward compatibility') -----
+ setMethod: ignored
+ "For forward compatibility wth AdditionalMethodState"!

Item was added:
+ ----- Method: AdditionalMethodState>>hasLiteralSuchThat: (in category 'testing') -----
+ hasLiteralSuchThat: aBlock
+ "Answer true if litBlock returns true for any literal in this array, even if embedded in further array structure.
+ This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ propertyOrPragma := self basicAt: i.
+ (propertyOrPragma isVariableBinding
+ ifTrue: [(aBlock value: propertyOrPragma key)
+ or: [(aBlock value: propertyOrPragma value)
+ or: [propertyOrPragma value isArray
+ and: [propertyOrPragma value hasLiteralSuchThat: aBlock]]]]
+ ifFalse: [propertyOrPragma hasLiteralSuchThat: aBlock]) ifTrue:
+ [^true]].
+ ^false!

Item was changed:
  ----- Method: CompiledMethod>>printOn: (in category 'printing') -----
  printOn: aStream
  "Overrides method inherited from the byte arrayed collection."
 
  self printNameOn: aStream.
+ aStream nextPut: $(; print: self identityHash; nextPutAll: ': ';
+ print: self methodClass; nextPutAll: '>>'; nextPutAll: self selector; nextPut: $).
+ "aStream space; nextPutAll: self identityHashPrintString"
+ !
- aStream space; nextPutAll: self identityHashPrintString!

Item was changed:
  ----- Method: Pragma>>hasLiteral: (in category 'testing') -----
  hasLiteral: aLiteral
+ ^keyword == aLiteral
+   or: [arguments hasLiteral: aLiteral]!
- ^ self keyword == aLiteral
- or: [ self arguments hasLiteral: aLiteral ].!

Item was changed:
  ----- Method: Categorizer class>>allCategory (in category 'class initialization') -----
  allCategory
  "Return a symbol that represents the virtual all methods category."
 
+ ^#'-- all --'!
- ^ '-- all --' asSymbol!

Item was changed:
  Object subclass: #Pragma
  instanceVariableNames: 'method keyword arguments'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Kernel-Methods'!
 
  !Pragma commentStamp: '<historical>' prior: 0!
+ I represent an occurrence of a pragma in a compiled method.  A pragma is a literal message pattern that occurs between angle brackets at the start of a method after any temporaries.  A common example is the primitive pragma:
+ <primitive: 123 errorCode: 'errorCode'>
+ but one can add one's own and use them as metadata attached to a method.  Because pragmas are messages one can browsse senders and implementors and perform them.  One can query a method for its pragmas by sendng it the pragmas message, which answers an Array of instances of me, one for each pragma in the method.
+
+ I can provide information about the defining class, method, its selector, as well as the information about the pragma keyword and its arguments. See the two 'accessing' protocols for details. 'accessing-method' provides information about the method the pragma is found in, while 'accessing-pragma' is about the pragma itself.
- I represent a pragma instance found in a compiled method. I can provide information about the defining class, method, its selector, as well as the information about the pragma keyword and its arguments. See the two 'accessing' protocols for details. 'accessing-method' provides information about the method the pragma is found in, while 'accessing-pragma' is about the pragma itself.
 
+ Instances are retrieved using one of the pragma search methods of the 'finding' protocol on the class side.
+
+ To browse all methods with pragmas in the system evaluate
+ SystemNavigation default browseAllSelect: [:m| m pragmas notEmpty]
+ and to browse all nonprimitive methods with pragmas evaluate
+ SystemNavigation default browseAllSelect: [:m| m primitive isZero and: [m pragmas notEmpty]]!
- Instances are retreived using one of the pragma search methods of the 'finding' protocol on the class side.!

Item was added:
+ ----- Method: CompiledMethod>>removeProperty: (in category 'accessing-pragmas & properties') -----
+ removeProperty: propName
+ "Remove the property propName if it exists.
+ Do _not_ raise an error if the property is missing."
+ | value |
+ value := self propertyValueAt: propName ifAbsent: [^nil].
+ self penultimateLiteral: (self penultimateLiteral copyWithout:
+ (Association
+ key: propName
+ value: value)).
+ ^value!

Item was changed:
  ----- Method: Object>>instVarNamed:put: (in category 'system primitives') -----
  instVarNamed: aString put: aValue
  "Store into the value of the instance variable in me of that name.  Slow and unclean, but very useful. "
 
+ ^self
+ instVarAt: (self class
+ instVarIndexFor: aString asString
+ ifAbsent: [self error: 'no such inst var'])
+ put: aValue
- ^ self instVarAt: (self class allInstVarNames indexOf: aString asString) put: aValue
  !

Item was added:
+ ----- Method: MethodProperties>>hasLiteralSuchThat: (in category 'testing') -----
+ hasLiteralSuchThat: aBlock
+ "Answer true if litBlock returns true for any literal in this array, even if embedded in further array structure.
+ This method is only intended for private use by CompiledMethod hasLiteralSuchThat:"
+ properties ifNil:[^false].
+ properties keysAndValuesDo: [:key :value |
+ ((aBlock value: key)
+ or: [(aBlock value: value)
+ or: [value isArray
+ and: [value hasLiteralSuchThat: aBlock]]]) ifTrue: [^true]].
+ ^false!

Item was added:
+ ----- Method: AdditionalMethodState>>selector (in category 'accessing') -----
+ selector
+ ^selector!

Item was added:
+ ----- Method: CompiledMethod>>tempsSubSequenceFrom: (in category 'debugger support') -----
+ tempsSubSequenceFrom: tempNamesStream
+ ^Array streamContents:
+ [:tsss|
+ [tempNamesStream skipSeparators.
+ tempNamesStream atEnd
+ or: ['[]()' includes: tempNamesStream peek]] whileFalse:
+ [tsss nextPut: (String streamContents:
+ [:s|
+ [s nextPut: tempNamesStream next.
+ tempNamesStream peek
+ ifNil: [true]
+ ifNotNil: [:peek| ' []()' includes: peek]] whileFalse])]]
+
+ "thisContext method tempsSubSequenceFrom: 'les temps perdu(sont n''est pas la)' readStream"
+ "thisContext method tempsSubSequenceFrom: ('les temps perdu(sont n''est pas la)' readStream skipTo: $(; yourself)"!

Item was changed:
  ----- Method: CompiledMethod>>isInstalled (in category 'testing') -----
  isInstalled
+ self methodClass ifNotNil:
+ [:class|
+ self selector ifNotNil:
+ [:selector|
+ ^self == (class methodDict at: selector ifAbsent: [])]].
+ ^false!
- | class selector |
- class := self methodClass ifNil: [^false].
- selector := self selector ifNil: [^false].
- ^self == (class methodDict at: selector ifAbsent: [^false]).!

Item was added:
+ ----- Method: AdditionalMethodState>>isEmpty (in category 'testing') -----
+ isEmpty
+ ^self basicSize = 0!

Item was changed:
  ----- Method: Pragma>>selector (in category 'accessing-method') -----
  selector
+ "Answer the selector of the method containing the pragma.
+ Do not confuse this with the selector of the pragma's message pattern."
- "Answer the selector of the method containing the pragma."
 
+ ^method selector!
- ^ method selector.!

Item was added:
+ ----- Method: AdditionalMethodState>>at: (in category 'accessing') -----
+ at: aKey
+ "Answer the property value or pragma associated with aKey."
+
+ ^self at: aKey ifAbsent: [self error: 'not found']!

Item was added:
+ ----- Method: AdditionalMethodState class>>selector:with: (in category 'instance creation') -----
+ selector: aSelector with: aPropertyOrPragma
+ ^(self basicNew: 1)
+ selector: aSelector;
+ basicAt: 1 put: aPropertyOrPragma;
+ yourself!

Item was changed:
+ ----- Method: MethodProperties>>keysAndValuesDo: (in category 'properties') -----
- ----- Method: MethodProperties>>keysAndValuesDo: (in category 'accessing') -----
  keysAndValuesDo: aBlock
+ "Enumerate the receiver with all the keys and values."
+ ^properties ifNotNil:[properties keysAndValuesDo: aBlock]!
- properties keysAndValuesDo: aBlock!

Item was changed:
  ----- Method: CompiledMethod>>printPrimitiveOn: (in category 'printing') -----
  printPrimitiveOn: aStream
  "Print the primitive on aStream"
  | primIndex primDecl |
+ (primIndex := self primitive) = 0 ifTrue:
+ [^self].
+ primIndex = 120 ifTrue: "External call spec"
+ [^aStream print: (self literalAt: 1); cr].
- primIndex := self primitive.
- primIndex = 0 ifTrue:[^self].
- primIndex = 120 "External call spec"
- ifTrue:[^aStream print: (self literalAt: 1); cr].
  aStream nextPutAll: '<primitive: '.
+ primIndex = 117
+ ifTrue:
+ [primDecl := self literalAt: 1.
+ (primDecl at: 2) asString printOn: aStream.
+ (primDecl at: 1) ifNotNil:
+ [:moduleName|
+ aStream nextPutAll:' module: '.
+ moduleName asString printOn: aStream]]
+ ifFalse:
+ [aStream print: primIndex].
+ self primitiveErrorVariableName ifNotNil:
+ [:primitiveErrorVariableName|
+ aStream nextPutAll: ' error: '; nextPutAll: primitiveErrorVariableName].
- primIndex = 117 ifTrue:[
- primDecl := self literalAt: 1.
- aStream
- nextPut: $';
- nextPutAll: (primDecl at: 2);
- nextPut:$'.
- (primDecl at: 1) notNil ifTrue:[
- aStream
- nextPutAll:' module:';
- nextPut:$';
- nextPutAll: (primDecl at: 1);
- nextPut:$'.
- ].
- ] ifFalse:[aStream print: primIndex].
  aStream nextPut: $>; cr!

Item was changed:
  ----- Method: CompiledMethod>>hasLiteral: (in category 'literals') -----
+ hasLiteral: literal
- hasLiteral: literal
  "Answer whether the receiver references the argument, literal."
+ 2 to: self numLiterals - 1 "exclude superclass + selector/properties"
+  do:[:index |
+ literal == (self objectAt: index) ifTrue: [^true]].
+ ^false!
-
- <primitive: 132>  "a fast primitive operation equivalent to..."
-
- 2 to: self numLiterals + 1 do:
- [:index |
- literal == (self objectAt: index) ifTrue: [^ true]].
- ^ false!

Item was added:
+ ----- Method: Object>>isContext (in category 'testing') -----
+ isContext
+ ^false!

Item was added:
+ ----- Method: AdditionalMethodState>>analogousCodeTo: (in category 'testing') -----
+ analogousCodeTo: aMethodProperties
+ | bs |
+ (bs := self basicSize) ~= aMethodProperties basicSize ifTrue:
+ [^false].
+ 1 to: bs do:
+ [:i|
+ ((self basicAt: i) analogousCodeTo: (aMethodProperties basicAt: i)) ifFalse:
+ [^false]].
+ ^true!

Item was changed:
+ ----- Method: Pragma>>analogousCodeTo: (in category 'comparing') -----
+ analogousCodeTo: anObject
+ ^self class == anObject class
+  and: [keyword == anObject keyword
+  and: [arguments = anObject arguments]]!
- ----- Method: Pragma>>analogousCodeTo: (in category 'testing') -----
- analogousCodeTo: aPragma
- ^ (self arguments = aPragma arguments) &
- (self keyword = aPragma keyword)!

Item was changed:
  ----- Method: Pragma>>message (in category 'accessing-pragma') -----
  message
+ "Answer the message of the receiving pragma."
- "Answer the message of the recieving pragma."
 
  ^ Message selector: self keyword arguments: self arguments. !

Item was added:
+ ----- Method: Pragma class>>for:selector:arguments: (in category 'instance creation') -----
+ for: aMethod selector: aSelector arguments: anArray
+ ^self new
+ setMethod: aMethod;
+ setKeyword: aSelector;
+ setArguments: anArray;
+ yourself!

Item was changed:
  ----- Method: ContextPart>>stackPtr (in category 'private') -----
+ stackPtr  "For use only by the SystemTracer and the Debugger, Inspectors etc"
- stackPtr  "For use only by the SystemTracer"
  ^ stackp!

Item was added:
+ ----- Method: MethodProperties>>hasLiteralThorough: (in category 'testing') -----
+ hasLiteralThorough: literal
+ "Answer true if any literal in this method is literal,
+ even if embedded in array structure."
+ properties ifNil:[^false].
+ properties keysAndValuesDo: [:key :value |
+ key == literal ifTrue: [^true].
+ value == literal ifTrue:[^true].
+ (value class == Array and: [value hasLiteral: literal]) ifTrue: [^ true]].
+ ^false!

Item was changed:
  ----- Method: Pragma>>keyword (in category 'accessing-pragma') -----
  keyword
+ "Answer the keyword of the pragma (the selector of its message pattern).
+ For a pragma defined as <key1: val1 key2: val2> this will answer #key1:key2:."
- "Answer the keyword of the recieving pragma. For a pragma defined as <key1: val1 key2: val2> this will answer #key1:key2."
 
  ^ keyword!

Item was changed:
  ----- Method: CompiledMethod>>startpcsToBlockExtents (in category 'debugger support') -----
  startpcsToBlockExtents
  "Answer a Dictionary of startpc to Interval of blockExtent, using the
  identical numbering scheme described in and orchestrated by
  BlockNode>>analyseArguments:temporaries:rootNode:.  This is
  used in part to find the temp names for any block in a method, as
  needed by the debugger.  The other half is to recompile the method,
+ obtaining the temp names for each block extent.  By indirecting through
- obtainign the temp names for each block extent.  By indirecting through
  the blockExtent instead of using the startpc directly we decouple the
+ debugger's access to temp names from the exact bytecode; insulating
- debugger's access to temp names form the exact bytecode; insulating
  debugging from minor changes in the compiler (e.g. changes in literal
  pooling, adding prefix bytecodes, adding inst vars to CompiledMethod
  in literals towards the end of the literal frame, etc).  If the recompilation
  doesn't produce exactly the same bytecode at exactly the same offset
  no matter; the blockExtents will be the same."
  | index |
  self flag: 'belongs in DebuggerMethodMap'.
  index := 0.
  ^self
  blockExtentsInto: Dictionary new
  from: self initialPC
  to: self endPC
  scanner: (InstructionStream on: self)
  numberer: [| value | value := index. index := index + 2. value]!

Item was changed:
  ----- Method: Object>>species (in category 'private') -----
  species
  "Answer the preferred class for reconstructing the receiver.  For example,
  collections create new collections whenever enumeration messages such as
  collect: or select: are invoked.  The new kind of collection is determined by
  the species of the original collection.  Species and class are not always the
  same.  For example, the species of Interval is Array."
+ <primitive: 111>
-
  ^self class!

Item was added:
+ ----- Method: CompiledMethod>>pragmaAt: (in category 'accessing-pragmas & properties') -----
+ pragmaAt: aKey
+ "Answer the pragma with selector aKey, or nil if none."
+ | propertiesOrSelector |
+ ^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
+ ifTrue: [propertiesOrSelector at: aKey ifAbsent: [nil]]
+ ifFalse: [nil]!

Item was changed:
  ----- Method: MethodContext>>cannotReturn: (in category 'private-exceptions') -----
  cannotReturn: result
 
  closureOrNil notNil ifTrue:
+ [^self cannotReturn: result to: self home sender].
- [^self cannotReturn: result to: sender].
  ToolSet
  debugContext: thisContext
  label: 'computation has been terminated'
  contents: nil!

Item was added:
+ ----- Method: Message>>numArgs (in category 'accessing') -----
+ numArgs
+ "Answer the number of arguments in this message"
+
+ ^args size!

Item was added:
+ ----- Method: CompiledMethod>>removeProperty:ifAbsent: (in category 'accessing-pragmas & properties') -----
+ removeProperty: propName ifAbsent: aBlock
+ "Remove the property propName if it exists.
+ Answer the evaluation of aBlock if the property is missing."
+ | value |
+ value := self propertyValueAt: propName ifAbsent: [^aBlock value].
+ self penultimateLiteral: (self penultimateLiteral copyWithout:
+ (Association
+ key: propName
+ value: value)).
+ ^value!

Item was added:
+ ----- Method: ClassDescription>>instVarIndexFor:ifAbsent: (in category 'instance variables') -----
+ instVarIndexFor: instVarName ifAbsent: aBlock
+ "Answer the index of the named instance variable."
+
+ | index |
+ index := instanceVariables == nil
+ ifTrue: [0]
+ ifFalse: [instanceVariables indexOf: instVarName ifAbsent: [0]].
+ index == 0 ifTrue:
+ [^superclass == nil
+ ifTrue: [aBlock value]
+ ifFalse: [superclass instVarIndexFor: instVarName ifAbsent: aBlock]].
+ ^superclass == nil
+ ifTrue: [index]
+ ifFalse: [index + superclass instSize]!

Item was added:
+ ----- Method: CompiledMethod>>mapFromBlockKeys:toSchematicTemps: (in category 'debugger support') -----
+ mapFromBlockKeys: keys toSchematicTemps: schematicTempNamesString
+ "Decode a schematicTempNamesString that encodes the layout of temp names
+ in a method and any closures/blocks within it, matching keys in keys to
+ vectors of temp names."
+ | map tempNames |
+ map := Dictionary new.
+ tempNames := schematicTempNamesString readStream.
+ keys do:
+ [:key| | tempSequence tempIndex |
+ tempSequence := OrderedCollection new.
+ tempIndex := 0.
+ [(tempNames skipSeparators; peek) ifNil: [true] ifNotNil: [:ch| '[]' includes: ch]] whileFalse:
+ [tempNames peek = $(
+ ifTrue: [tempSequence addAllLast: ((self tempsSubSequenceFrom: (tempNames next; yourself)) withIndexCollect:
+ [:temp :index|
+ { temp. { tempIndex + 1. index } }]).
+ tempNames peek ~= $) ifTrue: [self error: 'parse error'].
+ tempIndex := tempIndex + 1.
+ tempNames next]
+ ifFalse: [tempSequence addAllLast: ((self tempsSubSequenceFrom: tempNames) withIndexCollect:
+ [:temp :index|
+ { temp. tempIndex := tempIndex + 1 }])]].
+ map at: key put: tempSequence asArray.
+ [tempNames peek = $]] whileTrue: [tempNames next].
+ tempNames peek = $[ ifTrue:
+ [tempNames next]].
+ ^map!

Item was added:
+ ----- Method: AdditionalMethodState>>includesKey: (in category 'testing') -----
+ includesKey: aKey
+ "Test if the property aKey or pragma with selector aKey is present."
+
+ 1 to: self basicSize do:
+ [:i |
+ (self basicAt: i) key == aKey ifTrue:
+ [^true]].
+ ^false!

Item was added:
+ ----- Method: CompiledMethod>>copyWithTempsFromMethodNode: (in category 'source code management') -----
+ copyWithTempsFromMethodNode: aMethodNode
+ ^self copyWithTrailerBytes: (self qCompress: aMethodNode schematicTempNamesString)!

Item was added:
+ ----- Method: Pragma>>key (in category 'accessing-pragma') -----
+ key
+ "Answer the keyword of the pragma (the selector of its message pattern).
+ This accessor provides polymorphism with Associations used for properties."
+ ^keyword!

Item was changed:
  ----- Method: CompiledMethod>>scanVeryLongStore:offset: (in category 'scanning') -----
  scanVeryLongStore: extension offset: offset
  "Answer whether the receiver contains a long load with the given offset.
  Note that the constant +32 is the known difference between a
  store and a storePop for instVars, and it will always fail on literal variables,
  but these only use store (followed by pop) anyway."
+ | scanner |
- | scanner ext |
  scanner := InstructionStream on: self.
+ ^scanner scanFor:
+ [:instr | | ext |
+ (instr = 132 and: [(ext := scanner followingByte) = extension
- ^ scanner scanFor:
- [:instr | (instr = 132 and: [(ext := scanner followingByte) = extension
  or: ["might be a store/pop into rcvr"
  ext = (extension+32)]])
+ and: [scanner thirdByte = offset]]!
- and: [scanner thirdByte = offset]]!

Item was changed:
  ----- Method: BlockClosure>>numArgsError: (in category 'error handing') -----
  numArgsError: numArgsForInvocation
 
  | printNArgs |
  printNArgs := [:n| n printString, ' argument', (n = 1 ifTrue: [''] ifFalse:['s'])].
  self error:
  'This block accepts ', (printNArgs value: numArgs),
+ ', but was called with ', (printNArgs value: numArgsForInvocation), '.'!
- ', but was called with ', (printNArgs value: numArgsForInvocation printString), '.'!

Item was changed:
  ----- Method: CompiledMethod>>putSource:fromParseNode:inFile:withPreamble: (in category 'source code management') -----
  putSource: sourceStr fromParseNode: methodNode inFile: fileIndex withPreamble: preambleBlock
  "Store the source code for the receiver on an external file.
  If no sources are available, i.e., SourceFile is nil, then store
  temp names for decompilation at the end of the method.
  If the fileIndex is 1, print on *.sources;  if it is 2, print on *.changes,
  in each case, storing a 4-byte source code pointer at the method end."
 
  | file remoteString |
  (SourceFiles == nil or: [(file := SourceFiles at: fileIndex) == nil]) ifTrue:
+ [^self become: (self copyWithTempsFromMethodNode: methodNode)].
- [^self become: (self copyWithTempNames: methodNode tempNames)].
 
  SmalltalkImage current assureStartupStampLogged.
  file setToEnd.
 
  preambleBlock value: file.  "Write the preamble"
  remoteString := RemoteString newString: sourceStr onFileNumber: fileIndex toFile: file.
  file nextChunkPut: ' '.
  InMidstOfFileinNotification signal ifFalse: [file flush].
  self checkOKToAdd: sourceStr size at: remoteString position.
  self setSourcePosition: remoteString position inFile: fileIndex!

Item was added:
+ ----- Method: AdditionalMethodState>>removeKey:ifAbsent: (in category 'accessing') -----
+ removeKey: aKey ifAbsent: aBlock
+ "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
+
+ 1 to: self basicSize do: [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ propertyOrPragma := self basicAt: i.
+ (propertyOrPragma isVariableBinding
+ ifTrue: [propertyOrPragma key]
+ ifFalse: [propertyOrPragma keyword])
+ == aKey ifTrue:
+ [^method removeProperty: aKey]].
+ ^aBlock value!

Item was added:
+ ----- Method: AdditionalMethodState>>at:ifAbsent: (in category 'accessing') -----
+ at: aKey ifAbsent: aBlock
+ "Answer the property value or pragma associated with aKey or,
+ if aKey isn't found, answer the result of evaluating aBlock."
+
+ 1 to: self basicSize do:
+ [:i |
+ | propertyOrPragma "<Association|Pragma>" |
+ (propertyOrPragma := self basicAt: i) key == aKey ifTrue:
+ [^propertyOrPragma isVariableBinding
+ ifTrue: [propertyOrPragma value]
+ ifFalse: [propertyOrPragma]]].
+ ^aBlock value!

Item was added:
+ ----- Method: AdditionalMethodState>>includes: (in category 'testing') -----
+ includes: aPropertyOrPragma "<Association|Pragma>"
+ "Test if the property or pragma is present."
+
+ 1 to: self basicSize do:
+ [:i |
+ (self basicAt: i) = aPropertyOrPragma ifTrue:
+ [^true]].
+ ^false!

Item was added:
+ ----- Method: MethodProperties>>propertyKeysAndValuesDo: (in category 'properties') -----
+ propertyKeysAndValuesDo: aBlock
+ "Enumerate the receiver with all the keys and values."
+ ^self propertyKeysAndValuesDo: aBlock!

Item was added:
+ ----- Method: AdditionalMethodState class>>forMethod:selector: (in category 'instance creation') -----
+ forMethod: aMethod selector: aSelector
+ ^(self basicNew: 0)
+ selector: aSelector;
+ setMethod: aMethod;
+ yourself!

Item was added:
+ ----- Method: CompiledMethod>>qDecompressFrom: (in category 'source code management') -----
+ qDecompressFrom: input "<ReadStream on: ByteArray> ^<String>"
+ "Decompress strings compressed by qCompress:.
+ Most common 11 chars get values 0-10 packed in one 4-bit nibble;
+ next most common 52 get values 12-15 (2 bits) * 16 plus next nibble;
+ escaped chars get three nibbles"
+ ^ String streamContents:
+ [:strm | | nextNibble nibble peek charTable char |
+ charTable :=  "Character encoding table must match qCompress:"
+ 'ear tonsilcmbdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345[]()'.
+ peek := true.
+ nextNibble := [peek
+ ifTrue: [peek := false. input peek ifNil: [0] ifNotNil: [:b| b // 16]]
+ ifFalse: [peek := true. input next ifNil: [0] ifNotNil: [:b| b \\ 16]]].
+ [input atEnd] whileFalse:
+ [(nibble := nextNibble value) = 0
+ ifTrue: [input atEnd ifFalse:
+ [strm nextPut: (Character value: nextNibble value * 16 + nextNibble value)]]
+ ifFalse:
+ [nibble <= 11
+ ifTrue:
+ [strm nextPut: (charTable at: nibble)]
+ ifFalse:
+ [strm nextPut: (charTable at: nibble-12 * 16 + nextNibble value)]]]]!

Item was changed:
  ----- Method: CompiledMethod>>hasNewPropertyFormat (in category 'testing') -----
  hasNewPropertyFormat
+ "As of the closure compiler all methods have (or better have) the new
+ format where the penultimate literal is either the method's selector
+ or its properties and the ultimate literal is the class association."
+ ^true!
- ^self properties isMethodProperties.!

Item was added:
+ ----- Method: AdditionalMethodState>>isMethodProperties (in category 'testing') -----
+ isMethodProperties
+ ^true!