"Change Set: NotifyFixes-hg Date: 3 October 2001 Author: Henrik Gedenryd A change to Morphic's pre-debug window in 2.9a caused Notifier messages to no longer be displayed at all. Fixed here. Also changes notify: messages to invoke the Warning exception to invoke notifiers, so these can be caught and handled. "! !ObjectTracer methodsFor: 'very few messages' stamp: 'hg 10/2/2001 20:43'! doesNotUnderstand: aMessage "All external messages (those not caused by the re-send) get trapped here" "Present a dubugger before proceeding to re-send the message" Debugger openContext: thisContext label: 'About to perform: ', aMessage selector contents: nil. ^ aMessage sentTo: tracedObject. ! ! !ProtoObject methodsFor: 'system primitives' stamp: 'hg 10/2/2001 20:42'! cannotInterpret: aMessage "Handle the fact that there was an attempt to send the given message to the receiver but a null methodDictionary was encountered while looking up the message selector. Hopefully this is the result of encountering a stub for a swapped out class which induces this exception on purpose." "If this is the result of encountering a swap-out stub, then simulating the lookup in Smalltalk should suffice to install the class properly, and the message may be resent." | handler errorString | (self class lookupSelector: aMessage selector) == nil ifFalse: ["Simulated lookup succeeded -- resend the message." ^ aMessage sentTo: self]. "Could not recover by simulated lookup -- it's an error" errorString _ 'MethodDictionary fault'. (handler _ Processor activeProcess errorHandler) notNil ifTrue: [handler value: errorString value: self] ifFalse: [Debugger openContext: thisContext label: errorString contents: nil]. ^ aMessage sentTo: self! ! !Object methodsFor: 'error handling' stamp: 'hg 10/2/2001 20:43'! cannotInterpret: aMessage "Handle the fact that there was an attempt to send the given message to the receiver but a null methodDictionary was encountered while looking up the message selector. Hopefully this is the result of encountering a stub for a swapped out class which induces this exception on purpose." "If this is the result of encountering a swap-out stub, then simulating the lookup in Smalltalk should suffice to install the class properly, and the message may be resent." | handler errorString | (self class lookupSelector: aMessage selector) == nil ifFalse: ["Simulated lookup succeeded -- resend the message." ^ aMessage sentTo: self]. "Could not recover by simulated lookup -- it's an error" errorString _ 'MethodDictionary fault'. (handler _ Processor activeProcess errorHandler) notNil ifTrue: [handler value: errorString value: self] ifFalse: [Debugger openContext: thisContext label: errorString contents: nil]. ^ aMessage sentTo: self! ! !Object methodsFor: 'error handling' stamp: 'hg 10/2/2001 20:49'! notify: aString "Create and schedule a Notifier with the argument as the message in order to request confirmation before a process can proceed." Warning signal: aString "nil notify: 'confirmation message'"! ! !ContextPart methodsFor: 'private' stamp: 'hg 10/2/2001 20:44'! 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." | value | "Simulation guard" "If successful, push result and return resuming context, else ^ PrimitiveFailToken" (primitiveIndex = 19) ifTrue:[ Debugger openContext: self label:'Code simulation error' contents: nil]. (primitiveIndex = 80 and: [receiver isKindOf: ContextPart]) ifTrue: [^self push: ((BlockContext newForMethod: receiver home method) home: receiver home startpc: pc + 2 nargs: (arguments at: 1))]. (primitiveIndex = 81 and: [receiver isMemberOf: BlockContext]) ifTrue: [^receiver pushArgs: arguments from: self]. primitiveIndex = 83 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: arguments allButFirst super: false]. primitiveIndex = 84 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: (arguments at: 2) super: false]. arguments size > 6 ifTrue: [^ PrimitiveFailToken]. primitiveIndex = 117 ifTrue:[value _ self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse:[value _ receiver tryPrimitive: primitiveIndex withArgs: arguments]. value == PrimitiveFailToken ifTrue: [^ PrimitiveFailToken] ifFalse: [^ self push: value]! ! !Debugger methodsFor: 'initialize' stamp: 'hg 10/2/2001 20:42'! openNotifierContents: msgString label: label "Create and schedule a notifier view with the given label and message. A notifier view shows just the message or the first several lines of the stack, with a menu that allows the user to open a full debugger if so desired." "NOTE: When this method returns, a new process has been scheduled to run the windows, and thus this notifier, but the previous active porcess has not been suspended. The sender will do this." | msg topView p | Sensor flushKeyboard. savedCursor _ Sensor currentCursor. Sensor currentCursor: Cursor normal. msg _ msgString. (label beginsWith: 'Space is low') ifTrue: [msg _ self lowSpaceChoices, msgString]. isolationHead ifNotNil: ["We have already revoked the isolation layer -- now jump to the parent project." msg _ self isolationRecoveryAdvice, msgString. failedProject _ Project current. isolationHead parent enterForEmergencyRecovery]. Smalltalk isMorphic ifTrue: [ self buildMorphicNotifierLabelled: label message: msg. errorWasInUIProcess _ CurrentProjectRefactoring newProcessIfUI: interruptedProcess. ^self ]. Display fullScreen. topView _ self buildMVCNotifierViewLabel: label message: thisContext sender sender shortStack minSize: 350@((14 * 5) + 16 + self optionalButtonHeight). ScheduledControllers activeController ifNil: [p _ Display boundingBox center] ifNotNil: [p _ ScheduledControllers activeController view displayBox center]. topView controller openNoTerminateDisplayAt: (p max: (200@60)). ^ topView! ! !Debugger methodsFor: 'context stack menu' stamp: 'hg 10/2/2001 20:22'! buildMorphicNotifierLabelled: label message: messageString | notifyPane window contentTop extentToUse | self expandStack. window _ (PreDebugWindow labelled: label) model: self. contentTop _ 0.2. extentToUse _ 450 @ 156. "nice and wide to show plenty of the error msg" window addMorph: (self buttonRowForPreDebugWindow: window) frame: (0@0 corner: 1 @ contentTop). Preferences eToyFriendly | messageString notNil ifFalse: [notifyPane _ PluggableListMorph on: self list: #contextStackList selected: #contextStackIndex changeSelected: #debugAt: menu: nil keystroke: nil] ifTrue: [notifyPane _ PluggableTextMorph on: self text: nil accept: nil readSelection: nil menu: #debugProceedMenu:. notifyPane editString: (self preDebugNotifierContentsFrom: messageString); askBeforeDiscardingEdits: false]. window addMorph: notifyPane frame: (0@contentTop corner: 1@1). "window deleteCloseBox. chickened out by commenting the above line out, sw 8/14/2000 12:54" window setBalloonTextForCloseBox. ^ window openInWorldExtent: extentToUse! ! !Debugger class methodsFor: 'class initialization' stamp: 'hg 10/2/2001 20:44'! openContext: aContext label: aString contents: contentsStringOrNil | isolationHead | "Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger." "Simulation guard" ErrorRecursion not & Preferences logDebuggerStackToFile ifTrue: [Smalltalk logError: aString inContext: aContext to: 'SqueakDebug.log']. ErrorRecursion ifTrue: [ErrorRecursion _ false. (isolationHead _ CurrentProjectRefactoring currentIsolationHead) ifNil: [self primitiveError: aString] ifNotNil: [isolationHead revoke]]. ErrorRecursion _ true. self informExistingDebugger: aContext label: aString. (Debugger context: aContext isolationHead: isolationHead) openNotifierContents: contentsStringOrNil label: aString. ErrorRecursion _ false. Processor activeProcess suspend. ! ! !Debugger class methodsFor: 'opening' stamp: 'hg 10/2/2001 20:45'! openInterrupt: aString onProcess: interruptedProcess "Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low." | debugger | "Simulation guard" debugger _ self new. debugger process: interruptedProcess controller: ((Smalltalk isMorphic not and: [ScheduledControllers activeControllerProcess == interruptedProcess]) ifTrue: [ScheduledControllers activeController]) context: interruptedProcess suspendedContext. debugger externalInterrupt: true. Preferences logDebuggerStackToFile ifTrue: [(aString includesSubString: 'Space') & (aString includesSubString: 'low') ifTrue: [ Smalltalk logError: aString inContext: debugger interruptedContext to:'LowSpaceDebug.log']]. ^ debugger openNotifierContents: nil label: aString ! ! !Error methodsFor: 'private' stamp: 'hg 10/2/2001 20:43'! devDefaultAction Debugger openContext: initialContext label: self description contents: nil! ! !MessageNode methodsFor: 'private' stamp: 'hg 10/2/2001 21:08'! checkBlock: node as: nodeName from: encoder node canBeSpecialArgument ifTrue: [^node isMemberOf: BlockNode]. ((node isKindOf: BlockNode) and: [node numberOfArguments > 0]) ifTrue: [^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' must be a 0-argument block'] ifFalse: [^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' must be a block or variable']! ! !MethodContext methodsFor: 'private-exceptions' stamp: 'hg 10/2/2001 20:43'! cannotReturn: result Debugger openContext: thisContext label: 'computation has been terminated' contents: nil! ! !Warning methodsFor: 'exceptionDescription' stamp: 'hg 10/2/2001 21:01'! defaultAction "The user should be notified of the occurrence of an exceptional occurrence and given an option of continuing or aborting the computation. The description of the occurrence should include any text specified as the argument of the #signal: message." Debugger openContext: thisContext label: 'Notification' contents: self messageText, '\\Select Proceed to continue, or close this window to cancel the operation.' withCRs. self resume! !