--- a/DeviceWorkstation.st Mon May 10 17:05:00 2004 +0200
+++ b/DeviceWorkstation.st Mon May 10 17:11:37 2004 +0200
@@ -567,9 +567,9 @@
"an error in the devices low level code (typically Xlib or XtLib)
This is invoked via
- XError->errorInterrupt:#DisplayError->registeredErrorInterruptHandlers
+ XError->errorInterrupt:#DisplayError->registeredErrorInterruptHandlers
or
- XError->errorInterrupt:#DisplayIOError->registeredErrorInterruptHandlers
+ XError->errorInterrupt:#DisplayIOError->registeredErrorInterruptHandlers
looks if a signal handler for DeviceErrorSignal is present,
and - if so raises the signal.
@@ -578,25 +578,25 @@
investigate errors as required.
However, io-errors are always delivered as a signal raise."
- |badId badResource msg theDevice theSignal p signalHolder|
+ |badResource msg theDevice theSignal p signalHolder|
'DeviceWorkstation [info]: errorInterrupt: ' infoPrint. errID infoPrintCR.
errID notNil ifTrue:[
- "/
- "/ timeoutError passes the device;
- "/ the others pass the devicesID
- "/
- errID == #DisplayIOTimeoutError ifTrue:[
- theDevice := aParameter.
- "/ 'device timeout error' printCR.
- ] ifFalse:[
- AllScreens do:[:aDisplayDevice |
- aDisplayDevice id = aParameter ifTrue:[
- theDevice := aDisplayDevice.
- ]
- ]
- ]
+ "/
+ "/ timeoutError passes the device;
+ "/ the others pass the devicesID
+ "/
+ errID == #DisplayIOTimeoutError ifTrue:[
+ theDevice := aParameter.
+ "/ 'device timeout error' printCR.
+ ] ifFalse:[
+ AllScreens do:[:aDisplayDevice |
+ aDisplayDevice id = aParameter ifTrue:[
+ theDevice := aDisplayDevice.
+ ]
+ ]
+ ]
].
'DeviceWorkstation [info]: device: ' infoPrint. theDevice infoPrintCR.
@@ -605,97 +605,98 @@
signalHolder := theDevice ? self.
errID == #DisplayIOError ifTrue:[
- "/ always raises an exception
- msg := 'Display I/O Error'.
- badResource := theDevice.
- theSignal := signalHolder deviceIOErrorSignal.
- ] ifFalse:[
- errID == #DisplayIOTimeoutError ifTrue:[
- "/ always raises an exception for the current process
- msg := 'Display I/O timeout Error'.
- badResource := theDevice.
- theSignal := signalHolder deviceIOTimeoutErrorSignal
- ] ifFalse:[
- theSignal := signalHolder deviceErrorSignal.
- "/ only raises an exception if handled
-
- "/ that will become instance-specific information in
- "/ the near future ...
-
- badId := self resourceIdOfLastError.
- badId ~~ 0 ifTrue:[
- badResource := self resourceOfId:badId.
- ].
- msg := 'Display error: ' , (self lastErrorString).
-
- theSignal isHandled ifFalse:[
- ErrorPrinting ifTrue:[
- ('DeviceWorkstation [error]: ' , msg) errorPrintCR
- ].
- ^ self
- ]
- ]
- ].
-
-
- "/ interrupt that displays dispatch process
- "/ and force it to shutdown
-
- theDevice notNil ifTrue:[
- "/ DiplayIOTimeoutError is a synchronous event, that should hit the process
- "/ that caused the timeout.
-
- errID ~~ #DisplayIOTimeoutError ifTrue:[
- p := theDevice dispatchProcess.
- (p notNil and:[p ~~ Processor activeProcess]) ifTrue:[
- 'DeviceWorkstation [info]: interrupting: ' infoPrint. p displayString infoPrintCR.
- p interruptWith:[
- 'DeviceWorkstation [warning]: raising - exception' errorPrintCR.
- theSignal mayProceed ifTrue:[
- theSignal raiseRequestWith:badResource errorString:msg.
- ] ifFalse:[
- theSignal raiseWith:badResource errorString:msg.
- ].
- 'DeviceWorkstation [warning]: broken connection' errorPrintCR.
- theDevice brokenConnection.
- 'DeviceWorkstation [warning]: stopping dispatch' errorPrintCR.
- theDevice stopDispatch.
- ].
- ^ self.
-"/ Processor reschedule.
-"/ AbortSignal raise.
- ].
- ].
- ].
+ "always raises an exception"
+ theSignal := signalHolder deviceIOErrorSignal.
+ msg := 'Display I/O Error'.
+ badResource := theDevice.
+ ] ifFalse:[errID == #DisplayIOTimeoutError ifTrue:[
+ "always raises an exception for the current process"
+ theSignal := signalHolder deviceIOTimeoutErrorSignal.
+ msg := 'Display I/O timeout Error'.
+ badResource := theDevice.
+ ] ifFalse:[ "errID == #DisplayError"
+ "only raises an exception if handled"
+ theSignal := signalHolder deviceErrorSignal.
+ theDevice notNil ifTrue:[
+ "/ #resourceIdOfLastError will become instance-specific information in
+ "/ the near future ...
+ badResource := theDevice resourceOfId:self resourceIdOfLastError.
+ ].
+ msg := 'Display error: ' , self lastErrorString, badResource printString.
+ ]].
+
+
+ "interrupt that displays dispatch process
+ and force it to shutdown"
+
+ "DiplayIOTimeoutError is a synchronous event, that should hit the process
+ that caused the timeout."
+
+ (errID ~~ #DisplayIOTimeoutError and:[theDevice notNil]) ifTrue:[
+ p := theDevice dispatchProcess.
+ (p notNil and:[p ~~ Processor activeProcess]) ifTrue:[
+ 'DeviceWorkstation [info]: interrupting: ' infoPrint. p displayString infoPrintCR.
+ p interruptWith:[
+ errID == #DisplayError ifTrue:[
+ "unhandled display errors are ignored"
+ theSignal isHandled ifFalse:[
+ ErrorPrinting ifTrue:[
+ ('DeviceWorkstation [error]: ' , msg) errorPrintCR
+ ].
+ ^ self
+ ]
+ ].
+ 'DeviceWorkstation [warning]: raising - exception' errorPrintCR.
+ theSignal mayProceed ifTrue:[
+ theSignal raiseRequestWith:badResource errorString:msg.
+ ] ifFalse:[
+ theSignal raiseWith:badResource errorString:msg.
+ ].
+ 'DeviceWorkstation [warning]: broken connection' errorPrintCR.
+ theDevice brokenConnection.
+ 'DeviceWorkstation [warning]: stopping dispatch' errorPrintCR.
+ theDevice stopDispatch.
+ ].
+ ^ self.
+"/ Processor reschedule.
+"/ AbortSignal raise.
+ ].
+ ].
+
+ "If we come here, this is a DiplayIOTimeoutError, we don't know
+ the display device or we are running on top of the dispatchProcess"
(theSignal isHandled or:[theSignal handlerBlock notNil]) ifTrue:[
-"/ 'DeviceWorkstation [info]: interrupting current process: ' infoPrint.
+ 'DeviceWorkstation [info]: raising signal in current process' infoPrintCR.
"/ Processor activeProcess displayString infoPrintCR.
-
- 'DeviceWorkstation [info]: raising signal in current process' infoPrintCR.
- theSignal mayProceed ifTrue:[
- theSignal raiseRequestWith:badResource errorString:msg.
- ] ifFalse:[
- theSignal raiseWith:badResource errorString:msg.
- ].
+ theSignal mayProceed ifTrue:[
+ theSignal raiseRequestWith:badResource errorString:msg.
+ ] ifFalse:[
+ theSignal raiseWith:badResource errorString:msg.
+ ].
+ ].
+
+ errID == #DisplayError ifTrue:[
+ "unhandled display errors are ignored"
+ ^ self.
].
theDevice notNil ifTrue:[
- "/ 'broken connection' printCR.
- 'DeviceWorkstation [info]: sending #brokenConnection' infoPrintCR.
- theDevice brokenConnection.
- theDevice dispatchProcess == Processor activeProcess ifTrue:[
- "/ I am running in the dispatch process
- "/ and nobody handles theSignal, so abort the dispatcher
-
- 'DeviceWorkstation [info]: raising abortSignal' infoPrintCR.
- AbortSignal raise.
- ] ifFalse:[
- "/ Some other process (probably not even guilty - like someone doing a draw after a change) ...
- "/ ... see if we can unwind out of the drawing operation
- 'DeviceWorkstation [info]: should unwind the draw operation' infoPrintCR.
- thisContext fullPrintAll.
- ]
+ 'DeviceWorkstation [info]: sending #brokenConnection' infoPrintCR.
+ theDevice brokenConnection.
+ theDevice dispatchProcess == Processor activeProcess ifTrue:[
+ "I am running in the dispatch process
+ and nobody handles theSignal, so abort the dispatcher"
+
+ 'DeviceWorkstation [info]: raising AbortOperationRequest' infoPrintCR.
+ AbortOperationRequest raise.
+ ] ifFalse:[
+ "Some other process (probably not even guilty - like someone doing a draw after a change) ...
+ ... see if we can unwind out of the drawing operation"
+
+ 'DeviceWorkstation [info]: should unwind the draw operation' infoPrintCR.
+ thisContext fullPrintAll.
+ ]
].
'DeviceWorkstation [info]: proceeding after error' infoPrintCR.
@@ -729,44 +730,6 @@
"return the resource id responsible for the last error"
^ self subclassResponsibility
-!
-
-resourceOfId:id
- "{ Pragma: +optSpace }"
-
- "search thru all device stuff for a resource.
- Needed for error handling"
-
- Form allInstancesDo:[:f |
- f id == id ifTrue:[^ f]
- ].
-
- self allInstancesDo:[:aDisplay |
- aDisplay allViewsDo:[:aView |
- aView id == id ifTrue:[^ aView].
- aView gcId == id ifTrue:[^ aView]
- ].
-
-"/ |views|
-"/ views := aDisplay knownViews.
-"/ views notNil ifTrue:[
-"/ views do:[:v |
-"/ v id == id ifTrue:[^ v].
-"/ v gcId == id ifTrue:[^ v]
-"/ ].
-"/ ].
- ].
-
- Color allInstancesDo:[:c |
- c colorId == id ifTrue:[^ c]
- ].
-
- Font allInstancesDo:[:f |
- f fontId == id ifTrue:[^ f]
- ].
- ^ nil
-
- "Modified: 24.4.1996 / 19:36:15 / cg"
! !
!DeviceWorkstation class methodsFor:'queries'!
@@ -1570,22 +1533,22 @@
searchId := self realRootWindowId.
- "/ this is required, since X raises a bad error, when we come
+ "/ this is required, since X raises an error, when we come
"/ along with an illegal id (which happens, if a view from another
"/ screen-device is picked ...)
self class deviceErrorSignal handle:[:ex |
- ^ nil
+ ^ nil
] do:[
- n := 0.
- [searchId notNil] whileTrue:[
- n := n + 1.
- n > 1000 ifTrue:[
- self halt:'oops - endless view hierarchy'.
- ^ nil
- ].
- foundId := searchId.
- searchId := self viewIdFromPoint:aScreenPoint in:searchId.
- ]
+ n := 0.
+ [searchId notNil] whileTrue:[
+ n := n + 1.
+ n > 1000 ifTrue:[
+ self error:'endless view hierarchy'.
+ ^ nil
+ ].
+ foundId := searchId.
+ searchId := self viewIdFromPoint:aScreenPoint in:searchId.
+ ]
].
^ foundId
!
@@ -3701,6 +3664,47 @@
^ nil
].
^ super primitiveFailed
+!
+
+resourceOfId:id
+ "{ Pragma: +optSpace }"
+
+ "search thru all device stuff for a resource.
+ Needed for error handling.
+
+ Since id may be an ExternalAddress, do not compare with =="
+
+ self allViewsDo:[:aView |
+ aView id = id ifTrue:[^ aView].
+ aView gcId = id ifTrue:[^ aView]
+ ].
+
+ Form allInstancesDo:[:f |
+ (f id = id and:[f device == self]) ifTrue:[^ f]
+ ].
+
+ Font allInstancesDo:[:f |
+ (f fontId = id and:[f device == self]) ifTrue:[^ f]
+ ].
+
+ Color allInstancesDo:[:c |
+ (c colorId = id and:[c device == self]) ifTrue:[^ c].
+ ].
+
+ "KLUDGE: XWorkstation stores all IDs in ExternalAddresses,
+ only colorId is stored as SmallInteger,
+ But resourceOfLastError returns an ExternalAddress even for colors."
+
+ (id respondsTo:#address) ifTrue:[
+ |colorId|
+
+ colorId := id address.
+ Color allInstancesDo:[:c |
+ (c colorId = colorId and:[c device == self]) ifTrue:[^ c].
+ ].
+ ].
+
+ ^ nil
! !
!DeviceWorkstation methodsFor:'event forwarding'!
@@ -4224,11 +4228,11 @@
"/ is available or #eventPending returns true
fd isNil ifTrue:[
- "no fd -- so have to check for input also"
- checkBlock := [self eventPending].
+ "no fd -- so have to check for input also"
+ checkBlock := [self eventPending].
] ifFalse:[
- "there is a fd, so checkblock has to check only the internal queue"
- checkBlock := [self eventQueued].
+ "there is a fd, so checkblock has to check only the internal queue"
+ checkBlock := [self eventQueued].
].
"/ handle all incoming events from the device, sitting on a semaphore.
@@ -4240,26 +4244,30 @@
Processor signal:eventSema onInput:fd orCheck:checkBlock.
-
DeviceIOErrorSignal handle:[:ex |
- "/ test for handlerBlock until the signal is changed to be classed based.
- ex signal handlerBlock notNil ifTrue:[
- ex defaultAction.
- ] ifFalse:[
- 'DeviceWorkstation [warning]: stop dispatch due to I/O error' errorPrintCR.
- self brokenConnection.
- ].
- ex return.
+ "test for handlerBlock until the signal is changed to be classed based"
+ ex signal handlerBlock notNil ifTrue:[
+ ex defaultAction.
+ ] ifFalse:[
+ (self == self class default and:[AllScreens size == 1]) ifTrue:[
+ 'DeviceWorkstation [error]: I/O error for default display - writing crash.img and exiting' errorPrintCR.
+ ObjectMemory snapShotOn:'crash.img'.
+ Smalltalk exit.
+ ].
+ 'DeviceWorkstation [warning]: stop dispatch due to I/O error' errorPrintCR.
+ self brokenConnection.
+ ].
+ ex return.
] do:[
- self initializeDeviceResources.
- [
- self dispatchLoop
- ] ifCurtailed:[
- self cleanupAfterDispatch.
- self emergencyCloseConnection.
- ].
- self cleanupAfterDispatch.
- self close.
+ self initializeDeviceResources.
+ [
+ self dispatchLoop
+ ] ifCurtailed:[
+ self cleanupAfterDispatch.
+ self emergencyCloseConnection.
+ ].
+ self cleanupAfterDispatch.
+ self close.
].
!
@@ -7394,7 +7402,7 @@
!DeviceWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.462 2004-04-07 08:42:24 werner Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.463 2004-05-10 15:11:37 stefan Exp $'
! !
DeviceWorkstation initialize!