--- a/Object.st Tue May 07 18:39:47 2002 +0200
+++ b/Object.st Tue May 07 18:57:28 2002 +0200
@@ -4598,21 +4598,21 @@
exact cause etc.). This helps if segvs occur in primitive code.
Currently (temporary kludge), these are passed as global variables."
- |name here sig ignorable titles actions badContext msg pc addr
+ |name here sig fatal titles actions badContext msg pc addr
action title screen|
"if there has been an ST-signal installed, use it ..."
sig := OperatingSystem operatingSystemSignal:signalNumber.
sig notNil ifTrue:[
- sig raise.
- ^ self.
+ sig raise.
+ ^ self.
].
"/ if handled, raise OSSignalInterruptSignal
OSSignalInterruptSignal isHandled ifTrue:[
- OSSignalInterruptSignal raiseRequestWith:signalNumber.
- ^ self.
+ OSSignalInterruptSignal raiseRequestWith:signalNumber.
+ ^ self.
].
"
@@ -4620,8 +4620,8 @@
"
(signalNumber == 30 "OperatingSystem sigPWR"
or:[signalNumber == 1 "OperatingSystem sigHUP"]) ifTrue:[
- ObjectMemory snapShotOn:'crash.img'.
- ^ self.
+ ObjectMemory snapShotOn:'crash.img'.
+ ^ self.
].
name := OperatingSystem nameForSignal:signalNumber.
@@ -4632,7 +4632,7 @@
(Screen isNil
or:[(screen := Screen current) isNil
or:[(screen := Screen default) isNil]]) ifTrue:[
- ^ self startMiniDebuggerOrExit:'Signal (' , name, ')'.
+ ^ self startMiniDebuggerOrExit:'Signal (' , name, ')'.
].
"ungrab - in case it happened in a box/popupview
@@ -4641,108 +4641,105 @@
"there is a screen. use it to bring up a box asking for what to do ..."
Screen currentScreenQuerySignal answer:screen do:[
- "
- SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
- since the system will retry the faulty instruction, which leads to
- another signal - to avoid frustration, better not offer this option.
- "
- ignorable := (signalNumber ~~ OperatingSystem sigBUS)
- and:[signalNumber ~~ OperatingSystem sigILL
- and:[signalNumber ~~ OperatingSystem sigSEGV]].
-
- ignorable ifFalse:[
- (Debugger isNil or:[here isRecursive]) ifTrue:[
- 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
- ^ self startMiniDebuggerOrExit:'Signal (' , name, ')'.
- ].
- "
- a hard signal - go into debugger immediately
- "
- msg := 'OS-signal: ', name.
-
- "/ the IRQ-PC is passed as low-hi, to avoid the need
- "/ to allocate a LargeInteger in the VM during signal
- "/ time. I know, this is ugly.
-
- InterruptPcLow notNil ifTrue:[
- pc := InterruptPcLow + (InterruptPcHi bitShift:(SmallInteger maxBits + 1 // 2)).
- pc ~~ 0 ifTrue:[
- msg := msg , ' PC=' , (pc printStringRadix:16)
- ].
- ].
- InterruptAddrLow notNil ifTrue:[
- addr := InterruptAddrLow + (InterruptAddrHi bitShift:(SmallInteger maxBits + 1 // 2)).
- addr ~~ 0 ifTrue:[
- msg := msg , ' ADDR=' , (addr printStringRadix:16)
- ].
- ].
- Debugger enter:here withMessage:msg mayProceed:true.
- badContext return.
- ^ nil.
- ].
-
- "if possible, open an option box asking the user what do.
- Otherwise, start a debugger"
- Dialog notNil ifTrue:[
- titles := #('save crash image' 'dump core' 'exit ST/X' 'debug').
- actions := #(save core exit debug).
-
- action := nil.
- title := 'OS Signal caught (' , name, ')'.
- title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs.
-
- "/ if cought while in the scheduler or event dispatcher,
- "/ a modal dialog is not possible ...
- "/ (therefore, abort & return does not makes sense)
-
- Processor activeProcess isSystemProcess ifFalse:[
- titles := #('abort') , titles.
- actions := #(abort), actions.
-
- badContext canReturn ifTrue:[
- titles := #('return') , titles.
- actions := #(return), actions.
- ].
- ].
-
- ignorable ifTrue:[
- titles := titles, #('ignore').
- actions := actions , #(ignore).
- ].
- action := Dialog choose:title
- labels:titles
- values:actions
- default:(ignorable ifTrue:[#ignore] ifFalse:[nil]).
-
- "Dialog may fail (if system process), default action is debug"
- action size == 0 ifTrue:[action := #debug].
- ] ifFalse:[
- action := #debug.
- ].
-
- action == #save ifTrue:[
- ObjectMemory snapShotOn:'crash.img'
- ].
- action == #core ifTrue:[
- Smalltalk fatalAbort
- ].
- action == #exit ifTrue:[
- Smalltalk exit
- ].
- action == #return ifTrue:[
- badContext return
- ].
- action == #abort ifTrue:[
- AbortSignal raise.
- ].
-
- action == #debug ifTrue:[
- Debugger isNil ifTrue:[
- ^ self startMiniDebuggerOrExit:'Signal (' , name, ')'.
- ].
- Debugger enter:here withMessage:('Signal ', name) mayProceed:true.
- ].
- "action == #ignore"
+ "
+ SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
+ since the system will retry the faulty instruction, which leads to
+ another signal - to avoid frustration, better not offer this option.
+ "
+ fatal := OperatingSystem isFatalSignal:signalNumber.
+ fatal ifTrue:[
+ (Debugger isNil or:[here isRecursive]) ifTrue:[
+ 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
+ ^ self startMiniDebuggerOrExit:'Signal (' , name, ')'.
+ ].
+ "
+ a hard signal - go into debugger immediately
+ "
+ msg := 'OS-signal: ', name.
+
+ "/ the IRQ-PC is passed as low-hi, to avoid the need
+ "/ to allocate a LargeInteger in the VM during signal
+ "/ time. I know, this is ugly.
+
+ InterruptPcLow notNil ifTrue:[
+ pc := InterruptPcLow + (InterruptPcHi bitShift:(SmallInteger maxBits + 1 // 2)).
+ pc ~~ 0 ifTrue:[
+ msg := msg , ' PC=' , (pc printStringRadix:16)
+ ].
+ ].
+ InterruptAddrLow notNil ifTrue:[
+ addr := InterruptAddrLow + (InterruptAddrHi bitShift:(SmallInteger maxBits + 1 // 2)).
+ addr ~~ 0 ifTrue:[
+ msg := msg , ' ADDR=' , (addr printStringRadix:16)
+ ].
+ ].
+ Debugger enter:here withMessage:msg mayProceed:false.
+ "unreachable"
+ ^ nil.
+ ].
+
+ "if possible, open an option box asking the user what do.
+ Otherwise, start a debugger"
+ Dialog notNil ifTrue:[
+ titles := #('save crash image' 'dump core' 'exit ST/X' 'debug').
+ actions := #(save core exit debug).
+
+ action := nil.
+ title := 'OS Signal caught (' , name, ')'.
+ title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs.
+
+ "/ if cought while in the scheduler or event dispatcher,
+ "/ a modal dialog is not possible ...
+ "/ (therefore, abort & return does not makes sense)
+
+ Processor activeProcess isSystemProcess ifFalse:[
+ titles := #('abort') , titles.
+ actions := #(abort), actions.
+
+ badContext canReturn ifTrue:[
+ titles := #('return') , titles.
+ actions := #(return), actions.
+ ].
+ ].
+
+ fatal ifFalse:[
+ titles := titles, #('ignore').
+ actions := actions , #(ignore).
+ ].
+ action := Dialog choose:title
+ labels:titles
+ values:actions
+ default:(fatal ifTrue:[nil] ifFalse:[#ignore]).
+
+ "Dialog may fail (if system process), default action is debug"
+ action size == 0 ifTrue:[action := #debug].
+ ] ifFalse:[
+ action := #debug.
+ ].
+
+ action == #save ifTrue:[
+ ObjectMemory snapShotOn:'crash.img'
+ ].
+ action == #core ifTrue:[
+ Smalltalk fatalAbort
+ ].
+ action == #exit ifTrue:[
+ Smalltalk exit
+ ].
+ action == #return ifTrue:[
+ badContext return
+ ].
+ action == #abort ifTrue:[
+ AbortSignal raise.
+ ].
+
+ action == #debug ifTrue:[
+ Debugger isNil ifTrue:[
+ ^ self startMiniDebuggerOrExit:'Signal (' , name, ')'.
+ ].
+ Debugger enter:here withMessage:('Signal ', name) mayProceed:true.
+ ].
+ "action == #ignore"
].
!
@@ -5941,7 +5938,6 @@
"Created: 31.7.1997 / 17:45:20 / cg"
! !
-
!Object methodsFor:'printing & storing'!
basicPrintOn:aStream
@@ -8653,6 +8649,6 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.403 2002-05-07 14:28:29 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.404 2002-05-07 16:57:28 stefan Exp $'
! !
Object initialize!