The Trunk: Kernel-eem.1138.mcz

Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.1138.mcz

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

Name: Kernel-eem.1138
Author: eem
Time: 7 January 2018, 8:52:41.778375 pm
UUID: fd3ba881-0f7c-4ef3-a5a5-6b132f9d01fc
Ancestors: Kernel-eem.1137

Implement homeMethod; I find "method method" painful to write (too Bowieesque for code).
Move pcPreviousTo: up to CompiledCode.
Make CompiledCode>>= accept non-identical outerCode instances in the last literal (outerCode in a CompiledBlock).
Simulate FullBlockClosure>>value[:*] in the Debugger.

=============== Diff against Kernel-eem.1136 ===============

Item was added:
+ ----- Method: CompiledBlock>>holdsTempNames (in category 'source code management') -----
+ holdsTempNames
+ ^self outerCode holdsTempNames!

Item was added:
+ ----- Method: CompiledBlock>>homeMethod (in category 'accessing') -----
+ homeMethod
+ "answer the compiled method that I am installed in, or nil if none."
+ ^self outerCode homeMethod!

Item was changed:
  ----- Method: CompiledCode>>= (in category 'comparing') -----
  = method
  "Answer whether the receiver implements the same code as the argument, method.
  Here ``same code'' means that if the receiver's source is compiled with the same
  compiler it should produce the same sequence of bytecodes and literals, same
  trailer and same properties.  Hence this definition of #= (only one of many plausible
  definitions) can be used to quickly identify changes in the compiler's output."
  | numLits |
  self == method ifTrue:
  [^true].
  method isCompiledCode ifFalse: [^false].
  self size = method size ifFalse: [^false].
  self header = method header ifFalse: [^false]. "N.B. includes numLiterals comparison."
  self initialPC to: self endPC do:
  [:i | (self at: i) = (method at: i) ifFalse: [^false]].
  numLits := self numLiterals.
  1 to: numLits do:
  [:i| | lit1 lit2 |
  lit1 := self literalAt: i.
  lit2 := method literalAt: i.
  (lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
  [(i = 1 and: [#(117 120) includes: self primitive])
  ifTrue:
  [lit1 isArray
  ifTrue:
  [(lit2 isArray and: [(lit1 first: 2) = (lit2 first: 2)]) ifFalse:
  [^false]]
  ifFalse: "ExternalLibraryFunction"
  [(lit1 analogousCodeTo: lit2) ifFalse:
  [^false]]]
  ifFalse:
  [i = (numLits - 1)
  ifTrue: "properties"
  [(self properties analogousCodeTo: method properties)
  ifFalse: [^false]]
  ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
+ "last literal of CompiledBlock is outerMethod and may not be unique."
+ [(self isCompiledBlock
+  and: [lit1 isCompiledCode
+  and: [lit2 isCompiledCode]]) ifTrue:
+ [^true].
+ (i = numLits
- [(i = numLits
  and: [lit1 isVariableBinding
  and: [lit2 isVariableBinding
  and: [lit1 key == lit2 key
  and: [lit1 value == lit2 value]]]]) ifFalse:
  [^false]]]]].
  ^true!

Item was added:
+ ----- Method: CompiledCode>>homeMethod (in category 'accessing') -----
+ homeMethod
+ "Answer the home method associated with the receiver."
+
+ ^self subclassResponsibility!

Item was added:
+ ----- Method: CompiledCode>>pcPreviousTo: (in category 'scanning') -----
+ pcPreviousTo: thePC
+ "Answer the pc of the bytecode before the bytecode at thePC."
+ | pc prevPc byte encoderClass |
+ thePC > self endPC ifTrue: [^self endPC].
+ pc := self initialPC.
+ encoderClass := self encoderClass.
+ [pc < thePC] whileTrue:
+ [byte := self at: (prevPc := pc).
+ [pc := pc + (encoderClass bytecodeSize: byte).
+  encoderClass isExtension: byte] whileTrue:
+ [byte := self at: pc]].
+ ^prevPc!

Item was added:
+ ----- Method: CompiledMethod>>homeMethod (in category 'accessing') -----
+ homeMethod
+ "Answer the home method associated with the receiver.
+ This is polymorphic with closure, CompiledBlock, Context etc"
+
+ ^self!

Item was removed:
- ----- Method: CompiledMethod>>pcPreviousTo: (in category 'scanning') -----
- pcPreviousTo: thePC
- "Answer the pc of the bytecode before the bytecode at thePC."
- | pc prevPc byte encoderClass |
- thePC > self endPC ifTrue: [^self endPC].
- pc := self initialPC.
- encoderClass := self encoderClass.
- [pc < thePC] whileTrue:
- [byte := self at: (prevPc := pc).
- [pc := pc + (encoderClass bytecodeSize: byte).
-  encoderClass isExtension: byte] whileTrue:
- [byte := self at: pc]].
- ^prevPc!

Item was changed:
  ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') -----
  doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
  "Simulate a primitive method whose index is primitiveIndex.  The simulated receiver and
  arguments are given as arguments to this message. If successful, push result and return
  resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
  execution needs to be intercepted and simulated to avoid execution running away."
 
  | value |
  "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
  the debugger from entering various run-away activities such as spawning a new
  process, etc.  Injudicious use results in the debugger not being able to debug
  interesting code, such as the debugger itself.  Hence use primitive 19 with care :-)"
  "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
  primitiveIndex = 19 ifTrue:
  [ToolSet
  debugContext: self
  label:'Code simulation error'
  contents: nil].
 
  ((primitiveIndex between: 201 and: 222)
  and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
+ [(primitiveIndex = 206
+  or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:"
+ [^receiver simulateValueWithArguments: arguments first caller: self].
+ ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]"
+  or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]"
+ [^receiver simulateValueWithArguments: arguments caller: self]].
- [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
-  or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^receiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^receiver simulateValueWithArguments: arguments first caller: self]].
 
  primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
  [^self send: arguments first to: receiver with: arguments allButFirst].
  primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
  [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
  primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
  [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
 
  "Mutex>>primitiveEnterCriticalSection
  Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
  (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
  [| effective |
  effective := Processor activeProcess effectiveProcess.
  "active == effective"
  value := primitiveIndex = 186
  ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
  ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
  ^(self isPrimFailToken: value)
  ifTrue: [value]
  ifFalse: [self push: value]].
 
  primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
  [((self objectClass: (arguments at: 1)) == Array
   and: [(self objectClass: (arguments at: 2)) includesBehavior: CompiledMethod]) ifFalse:
  [^self class primitiveFailTokenFor: #'bad argument'].
  (arguments at: 2) numArgs = (arguments at: 1) size ifFalse:
  [^self class primitiveFailTokenFor: #'bad number of arguments'].
  (arguments at: 2) primitive > 0 ifTrue:
  [(arguments at: 2) isQuick ifTrue:
  [^self push: (receiver withArgs: (arguments at: 1) executeMethod: (arguments at: 2))].
  ^self doPrimitive: (arguments at: 2) primitive method: (arguments at: 2) receiver: receiver args: (arguments at: 1)].
  ^Context
  sender: self
  receiver: receiver
  method: (arguments at: 2)
  arguments: (arguments at: 1)].
 
  primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM"
  [(arguments size = 3
   and: [(self objectClass: arguments second) == SmallInteger
   and: [(self objectClass: arguments last) == Array]]) ifTrue:
  [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last].
  (arguments size = 2
  and: [(self objectClass: arguments first) == SmallInteger
  and: [(self objectClass: arguments last) == Array]]) ifFalse:
  [^self class primitiveFailTokenFor: nil].
  ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
 
  value := primitiveIndex = 120 "FFI method"
  ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
  ifFalse:
  [primitiveIndex = 117 "named primitives"
  ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
  ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)"
  [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
 
  ^(self isPrimFailToken: value)
  ifTrue: [value]
  ifFalse: [self push: value]!