[squeak-dev] The Trunk: Kernel-mt.1381.mczcommits at source.squeak.org commits at source.squeak.orgMon Mar 15 10:19:06 UTC 2021
Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1381.mcz ==================== Summary ==================== Name: Kernel-mt.1381 Author: mt Time: 15 March 2021, 11:19:02.546586 am UUID: 11976771-8ccb-e941-83da-2ae26c3a9f55 Ancestors: Kernel-mt.1380 Fixes for debugger invocation during code simulation. See http://forum.world.st/Please-try-out-Fixes-for-debugger-invocation-during-code-simulation-td5127684.html =============== Diff against Kernel-mt.1380 =============== Item was changed: (PackageInfo named: 'Kernel') preamble: '"below, add code to be run before the loading of this package" + ProcessorScheduler instVarNames at: 2 put: ''genuineProcess''.'! - BlockClosure instVarNames at: 2 put: ''startpcOrMethod'''! Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. + Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! - closureOrNil notNil ifTrue: - [^self cannotReturn: result to: self home sender]. - Processor activeProcess - debug: thisContext - title: 'computation has been terminated' - full: false.! 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: [ + [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: + [| effective | + effective := Processor activeProcess effectiveProcess. + "active == effective" + value := primitiveIndex = 186 + ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] + ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. - ["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]! Item was changed: ----- Method: ObjectTracer>>doesNotUnderstand: (in category 'very few messages') ----- doesNotUnderstand: aMessage + "Present a debugger before proceeding to re-send the message. All external messages (those not caused by the re-send) get trapped here." - "Present a debugger before proceeding to re-send the message" + self flag: #workaround. "ct: After the selection of buttons in the debugger has been refactored, return to a simple Warning here. See: http://forum.world.st/The-Trunk-Kernel-mt-1303-mcz-tp5112200p5112211.html" + Processor + debugWithTitle: ('Object Tracer ({1})' translated format: {self identityHash}) - "All external messages (those not caused by the re-send) get trapped here" - Processor activeProcess - debugWithTitle: 'Object Tracer (', self identityHash, ')' full: false contents: ('On an instance of\ {1} ({2})\\About to perform\ {3}\\Using the following arguments\ {4}' translated withCRs format: { thisContext objectClass: tracedObject. tracedObject identityHash. aMessage selector storeString. aMessage arguments printString}). + - ^ aMessage sendTo: tracedObject! Item was changed: ----- Method: Process>>evaluate:onBehalfOf: (in category 'private') ----- evaluate: aBlock onBehalfOf: aProcess + "Evaluate aBlock setting effectiveProcess to aProcess. Used in the execution simulation machinery to ensure that Processor activeProcess evaluates correctly when debugging, which is also known as process-faithful debugging." + + | oldEffectiveProcess | + aProcess == self ifTrue: [^ aBlock value]. "Optimization" + + oldEffectiveProcess := effectiveProcess. - "Evaluate aBlock setting effectiveProcess to aProcess, and all other variables other than - the scheduling ones to those of aProcess. Used in the execution simulation machinery - to ensure that Processor activeProcess evaluates correctly when debugging." - | range savedVariables | - "range accesses everything after myList, e.g. threadId, effectiveProcess, name, island, env" - range := 5 to: Process instSize. - savedVariables := range collect: [:i| self instVarAt: i]. - range do: - [:i| self instVarAt: i put: (aProcess instVarAt: i)]. effectiveProcess := aProcess. + ^ aBlock ensure: [effectiveProcess := oldEffectiveProcess]! - ^aBlock ensure: - ["write back any assigned-to variables." - range do: - [:i| | v | - ((v := self instVarAt: i) ~~ (aProcess instVarAt: i) - and: [v notNil]) ifTrue: - [aProcess instVarAt: i put: v]]. - "restore old values" - range with: savedVariables do: - [:i :var| self instVarAt: i put: var]]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." | ctxt unwindBlock oldList | self isActiveProcess ifTrue: [ctxt := thisContext. [ctxt := ctxt findNextUnwindContextUpTo: nil. ctxt ~~ nil] whileTrue: [(ctxt tempAt: 2) ifNil: ["N.B. Unlike Context>>unwindTo: we do not set complete (tempAt: 2) to true." unwindBlock := ctxt tempAt: 1. thisContext terminateTo: ctxt. unwindBlock value]]. thisContext terminateTo: nil. self suspend. "If the process is resumed this will provoke a cannotReturn: error. Would self debug: thisContext title: 'Resuming a terminated process' be better?" ^self]. "Always suspend the process first so it doesn't accidentally get woken up. N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. suspendedContext ifNotNil: ["Release any method marked with the <criticalSection> pragma. The argument is whether the process is runnable." self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). "If terminating a process halfways through an unwind, try to complete that unwind block first." (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil: [:outer| (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil: [:inner| "This is an unwind block currently under evaluation" suspendedContext runUntilErrorOrReturnFrom: inner]]. ctxt := self popTo: suspendedContext bottomContext. ctxt == suspendedContext bottomContext ifFalse: + [self debugWithTitle: 'Unwind error during termination' translated full: false]. - [self debug: ctxt title: 'Unwind error during termination']. "Set the context to its endPC for the benefit of isTerminated." ctxt pc: ctxt endPC]! Item was changed: Object subclass: #ProcessorScheduler + instanceVariableNames: 'quiescentProcessLists genuineProcess' - instanceVariableNames: 'quiescentProcessLists activeProcess' classVariableNames: 'BackgroundProcess HighIOPriority LowIOPriority SystemBackgroundPriority SystemRockBottomPriority TimingPriority UserBackgroundPriority UserInterruptPriority UserSchedulingPriority' poolDictionaries: '' category: 'Kernel-Processes'! !ProcessorScheduler commentStamp: '<historical>' prior: 0! My single instance, named Processor, coordinates the use of the physical processor by all Processes requiring service.! Item was changed: ----- Method: ProcessorScheduler>>activePriority (in category 'accessing') ----- activePriority "Answer the priority level of the currently running Process." + ^ self activeProcess priority! - ^activeProcess effectiveProcess priority! Item was changed: ----- Method: ProcessorScheduler>>activeProcess (in category 'accessing') ----- activeProcess + "Answer the active process (from the user's perspective), which can be simulated by the genuinely running process (from the system's perspective). See Process >> #evaluate:onBehalfOf:." - "Answer the currently running Process." + ^genuineProcess effectiveProcess! - ^activeProcess effectiveProcess! Item was changed: ----- Method: ProcessorScheduler>>terminateActive (in category 'process state change') ----- terminateActive "Terminate the process that is currently running." + self activeProcess terminate.! - activeProcess effectiveProcess terminate!
More information about the Squeak-dev mailing list |