The Trunk: Kernel-eem.1095.mcz

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

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

Name: Kernel-eem.1095
Author: eem
Time: 13 April 2017, 2:05:29.158689 pm
UUID: 6872c2d8-f3c1-4037-b730-ea2e8fba4ff7
Ancestors: Kernel-eem.1094

Add simulation of directedSuperSend:numArgs:.

Clean up the send simulation machinery a little, using quickSend:to:with:lookupIn: and send:to:with:lookupIn: everywhere and replacing send:to:with:startClass:, & send:to:with:super: each of whose last argument is never used, with send:to:with:.

Nuke the obsolete tryNamedPrimitive template methods.

=============== Diff against Kernel-eem.1094 ===============

Item was added:
+ ----- Method: Context>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
+ directedSuperSend: selector numArgs: numArgs
+ "Simulate the action of bytecodes that send a message with selector, selector,
+ starting the message lookup in the superclass of the class on top of stack.
+ The arguments of the message are found in the next numArgs locations on
+ the stack and the receiver just below them."
+
+ | class receiver arguments |
+ class := self pop.
+ arguments := Array new: numArgs.
+ numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop].
+ receiver := self pop.
+ QuickStep == self ifTrue:
+ [QuickStep := nil.
+ ^self quickSend: selector to: receiver with: arguments lookupIn: class superclass].
+ ^self send: selector to: receiver with: arguments lookupIn: class superclass!

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 :-)"
- 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 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].
- [^self send: arguments first to: receiver with: arguments allButFirst super: false].
  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]].
- ifFalse:
- ["should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs"
- receiver tryPrimitive: primitiveIndex withArgs: arguments]].
 
  ^(self isPrimFailToken: value)
  ifTrue: [value]
  ifFalse: [self push: value]!

Item was changed:
  ----- Method: Context>>jump:if: (in category 'instruction decoding') -----
  jump: distance if: condition
  "Simulate the action of a 'conditional jump' bytecode whose offset is the
+ argument, distance, and whose condition is the argument, condition."
- argument, distance, and whose condition is the argument, condition."
 
  | bool |
  bool := self pop.
+ condition == bool
+ ifTrue: [self jump: distance]
+ ifFalse:
+ [(true == bool or: [false == bool]) ifFalse:
+ [^self send: #mustBeBooleanIn: to: bool with: {self}]]!
- (bool == true or: [bool == false]) ifFalse: [
- ^self
- send: #mustBeBooleanIn:
- to: bool
- with: {self}
- super: false].
- (bool eqv: condition) ifTrue: [self jump: distance]!

Item was added:
+ ----- Method: Context>>quickSend:to:with:lookupIn: (in category 'controlling') -----
+ quickSend: selector to: rcvr with: arguments lookupIn: lookupClass
+ "Send the given selector with arguments in an environment which closely resembles
+ the non-simulating environment, with an interjected unwind-protected block to catch
+ nonlocal returns.  Attention: don't get lost!!  This beautiful method is originally due to
+ Hans-Martin Mosner."
+ | oldSender contextToReturnTo result |
+ contextToReturnTo := self.
+ [oldSender := thisContext sender swapSender: self.
+ result := self object: rcvr perform: selector withArguments: arguments inClass: lookupClass.
+ thisContext sender swapSender: oldSender] ifCurtailed:
+ [contextToReturnTo := thisContext sender receiver. "The block context returning nonlocally"
+ contextToReturnTo pc: contextToReturnTo previousPc. "skip to front of return bytecode causing this unwind"
+ contextToReturnTo willReturnTopFromMethod ifTrue:
+ "If it was a returnTop, push the value to be returned.
+ Otherwise the value is implicit in the bytecode"
+ [contextToReturnTo push: (thisContext sender tempAt: 1)].
+ thisContext swapSender: thisContext home sender. "Make this block return to the method's sender"
+ contextToReturnTo].
+ contextToReturnTo push: result.
+ ^contextToReturnTo!

Item was removed:
- ----- Method: Context>>quickSend:to:with:super: (in category 'controlling') -----
- quickSend: selector to: rcvr with: arguments super: superFlag
- "Send the given selector with arguments in an environment which closely resembles
- the non-simulating environment, with an interjected unwind-protected block to catch
- nonlocal returns.  Attention: don't get lost!!  This beautiful method is due to
- Hans-Martin Mosner.  Eliot Miranda merely added the mirror primitive code."
- | oldSender contextToReturnTo result lookupClass |
- contextToReturnTo := self.
- lookupClass := superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr].
- [oldSender := thisContext sender swapSender: self.
- result := self object: rcvr perform: selector withArguments: arguments inClass: lookupClass.
- thisContext sender swapSender: oldSender] ifCurtailed:
- [contextToReturnTo := thisContext sender receiver. "The block context returning nonlocally"
- contextToReturnTo pc: contextToReturnTo previousPc. "skip to front of return bytecode causing this unwind"
- contextToReturnTo willReturnTopFromMethod ifTrue:
- "If it was a returnTop, push the value to be returned.
- Otherwise the value is implicit in the bytecode"
- [contextToReturnTo push: (thisContext sender tempAt: 1)].
- thisContext swapSender: thisContext home sender. "Make this block return to the method's sender"
- contextToReturnTo].
- contextToReturnTo push: result.
- ^contextToReturnTo!

Item was added:
+ ----- Method: Context>>receiver:tryPrimitive:withArgs: (in category 'private') -----
+ receiver: receiver tryPrimitive: primIndex withArgs: argumentArray
+ "Invoke the primitive with number primIndex, with the receiver and arguments
+ supplied, answering its result, or, if the primiitve fails, the error code."
+
+ <primitive: 118 error: errorCode>
+ ^self class primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: Context>>return:from: (in category 'instruction decoding') -----
  return: value from: aSender
  "For simulation.  Roll back self to aSender and return value from it.  Execute any unwind blocks on the way.  ASSUMES aSender is a sender of self"
 
+ | newTop |
+ aSender isDead ifTrue:
+ [^self send: #cannotReturn: to: self with: {value}].
- | newTop ctxt |
- aSender isDead ifTrue: [
- ^ self send: #cannotReturn: to: self with: {value} super: false].
  newTop := aSender sender.
+ (self findNextUnwindContextUpTo: newTop) ifNotNil:
+ [:unwindProtectCtxt|
+ ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}].
- ctxt := self findNextUnwindContextUpTo: newTop.
- ctxt ifNotNil: [
- ^ self send: #aboutToReturn:through: to: self with: {value. ctxt} super: false].
  self releaseTo: newTop.
  newTop ifNotNil: [newTop push: value].
+ ^newTop!
- ^ newTop
- !

Item was changed:
  ----- Method: Context>>send:super:numArgs: (in category 'instruction decoding') -----
  send: selector super: superFlag numArgs: numArgs
  "Simulate the action of bytecodes that send a message with selector,
  selector. The argument, superFlag, tells whether the receiver of the
  message was specified with 'super' in the source method. The arguments
  of the message are found in the top numArgs locations on the stack and
  the receiver just below them."
 
+ | receiver arguments lookupClass |
- | receiver arguments |
  arguments := Array new: numArgs.
  numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop].
  receiver := self pop.
+ lookupClass := superFlag
+ ifTrue: [method methodClassAssociation value superclass]
+ ifFalse: [self objectClass: receiver].
  QuickStep == self ifTrue:
  [QuickStep := nil.
+ ^self quickSend: selector to: receiver with: arguments lookupIn: lookupClass].
+ ^self send: selector to: receiver with: arguments lookupIn: lookupClass!
- ^self quickSend: selector to: receiver with: arguments super: superFlag].
- ^self send: selector to: receiver with: arguments super: superFlag!

Item was added:
+ ----- Method: Context>>send:to:with: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments
+ "Simulate the action of sending a message with selector arguments to rcvr."
+
+ ^self send: selector to: rcvr with: arguments lookupIn: (self objectClass: rcvr)!

Item was removed:
- ----- Method: Context>>send:to:with:startClass: (in category 'controlling') -----
- send: selector to: rcvr with: args startClass: startClassOrNil
- "Simulate the action of sending a message with selector, selector, and
- arguments, args, to receiver. The argument, startClassOrNil, tells whether
- the selector should be looked up in startClassOrNil or the class of the receiver."
-
- | class meth val ctxt |
- class := startClassOrNil ifNil: [self objectClass: rcvr].
- meth := class lookupSelector: selector.
- meth == nil ifTrue:
- [^self
- send: #doesNotUnderstand:
- to: rcvr
- with: (Array with: (Message selector: selector arguments: args))
- startClass: class].
- (args isArray
- and: [args size = meth numArgs]) ifFalse:
- [^self class primitiveFailTokenFor: nil].
- val := self tryPrimitiveFor: meth receiver: rcvr args: args.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken]]) ifFalse:
- [^val].
- (selector == #doesNotUnderstand:
- and: [class == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood'].
- ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken
- and: [val last notNil
- and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue:
- [ctxt at: ctxt stackPtr put: val last].
- ^ctxt!

Item was removed:
- ----- Method: Context>>send:to:with:super: (in category 'controlling') -----
- send: selector to: rcvr with: arguments super: superFlag
- "Simulate the action of sending a message with selector arguments
- to rcvr. The argument, superFlag, tells whether the receiver of the
- message was specified with 'super' in the source method."
-
- ^self send: selector
- to: rcvr
- with: arguments
- lookupIn: (superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr])!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive (in category 'apply primitives') -----
- tryNamedPrimitive
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive:with: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1 with: arg2
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive:with:with: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1 with: arg2 with: arg3
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: ProtoObject>>tryNamedPrimitive:with:with:with:with:with:with:with: (in category 'apply primitives') -----
- tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
- <primitive:'' module:'' error: errorCode>
- ^Context primitiveFailTokenFor: errorCode!

Item was changed:
  ----- Method: ProtoObject>>tryPrimitive:withArgs: (in category 'apply primitives') -----
  tryPrimitive: primIndex withArgs: argumentArray
+ "Invoke the primitive with number primIndex, answering its result,
+ or, if the primiitve fails, the error code."
- "This method is a template that the Smalltalk simulator uses to
- execute primitives. See Object documentation whatIsAPrimitive."
 
  <primitive: 118 error: errorCode>
  ^Context primitiveFailTokenFor: errorCode!