The Inbox: Kernel-ct.1381.mcz

A new version of Kernel was added to project The Inbox:
http://source.squeak.org/inbox/Kernel-ct.1381.mcz

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

Name: Kernel-ct.1381
Author: ct
Time: 14 March 2021, 7:16:55.476382 pm
UUID: e555dad1-89ad-4143-b0b1-faa06c9044cb
Ancestors: Kernel-mt.1380

Proposal: Revises usage and handling of primitive 19, also known as the simulation guard. Don't use it in #newProcess and variants since they don't involve any actual control logic. Instead, also show a simulation warning when debugging a control primitive (primitiveSignal primitiveWait primitiveResume primitiveSuspend). Improves integration of simulation guard warnings by signaling a Warning on the simulator stack rather than spawning a debugger on the debugged process. This also makes it easier to handle these warnings in a non-interactive context. See http://forum.world.st/Simulation-guard-lt-primitive-19-gt-crashes-the-image-td5127443.html and http://forum.world.st/Please-try-out-Fixes-for-debugger-invocation-during-code-simulation-td5127684.html for more information.

=============== Diff against Kernel-mt.1380 ===============

Item was changed:
  ----- Method: BlockClosure>>newProcess (in category 'scheduling') -----
  newProcess
+ "Answer a Process running the code in the receiver. The process is not scheduled."
- "Answer a Process running the code in the receiver. The process is not
- scheduled."
- <primitive: 19> "Simulation guard"
  ^Process
  forContext:
  [self value.
+ "Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run.  Simply suspend.
+ Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true.  isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most."
- "Since control is now at the bottom there is no need to terminate (which
- runs unwinds) since all unwnds have been run.  Simply suspend.
- Note that we must use this form rather than e.g. Processor suspendActive
- so that isTerminated answers true.  isTerminated requires that if there is a
- suspended context it is the bottom-most, but using a send would result in
- the process's suspendedContext /not/ being the bottom-most."
  Processor activeProcess suspend] asContext
  priority: Processor activePriority!

Item was changed:
  ----- Method: BlockClosure>>newProcessWith: (in category 'scheduling') -----
  newProcessWith: anArray
+ "Answer a Process running the code in the receiver. The receiver's block arguments are bound to the contents of the argument, anArray. The process is not scheduled."
- "Answer a Process running the code in the receiver. The receiver's block
- arguments are bound to the contents of the argument, anArray. The
- process is not scheduled."
- <primitive: 19> "Simulation guard"
  ^Process
  forContext:
  [self valueWithArguments: anArray.
+ "Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run.  Simply suspend.
+ Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true.  isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most."
- "Since control is now at the bottom there is no need to terminate (which
- runs unwinds) since all unwnds have been run.  Simply suspend.
- Note that we must use this form rather than e.g. Processor suspendActive
- so that isTerminated answers true.  isTerminated requires that if there is a
- suspended context it is the bottom-most, but using a send would result in
- the process's suspendedContext /not/ being the bottom-most."
  Processor activeProcess suspend] asContext
  priority: Processor activePriority!

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 or: [primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) ifTrue: [
+ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})]
+ ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]].
+
- primitiveIndex = 19 ifTrue:
- [Processor activeProcess
- debug: self
- title:'Code simulation error'
- full: false].
-
  ((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 = 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:
  ["Transcript
  cr;
  nextPutAll: 'Processor activeProcess ';
  nextPutAll: (Processor activeProcess == receiver owningProcess ifTrue: [#==] ifFalse: [#~~]);
  nextPutAll: ' owner';
  flush."
  value := primitiveIndex = 186
  ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: Processor activeProcess]
  ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: Processor activeProcess].
  ^(self isPrimFailToken: value)
  ifTrue: [value]
  ifFalse: [self push: value]].
 
  primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod:
  CompiledMethod class>>receiver:withArguments:executeMethod:
  VMMirror>>ifFail:object:with:executeMethod: et al"
  [| n args methodArg thisReceiver |
  ((n := arguments size) between: 2 and: 4) ifFalse:
  [^self class primitiveFailTokenFor: #'unsupported operation'].
  ((self objectClass: (args := arguments at: n - 1)) == Array
   and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse:
  [^self class primitiveFailTokenFor: #'bad argument'].
  methodArg numArgs = args size ifFalse:
  [^self class primitiveFailTokenFor: #'bad number of arguments'].
  thisReceiver := arguments at: n - 2 ifAbsent: [receiver].
  methodArg primitive > 0 ifTrue:
  [methodArg isQuick ifTrue:
  [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)].
  ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args].
  ^Context
  sender: self
  receiver: thisReceiver
  method: methodArg
  arguments: args].
 
  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]!