refactored exception handling code a little
This commit is contained in:
parent
0988fc99f8
commit
de965baab7
@ -1,10 +1,3 @@
|
||||
#class Exception(Apex)
|
||||
{
|
||||
#dcl signalContext handlerContext messageText.
|
||||
|
||||
## To be extended below.
|
||||
}
|
||||
|
||||
#class(#pointer) Context(Apex)
|
||||
{
|
||||
#dcl sender ip sp ntmprs.
|
||||
@ -14,133 +7,10 @@
|
||||
^self.sender
|
||||
}
|
||||
|
||||
#method isExceptionContext
|
||||
{
|
||||
^false
|
||||
}
|
||||
|
||||
#method isEnsureContext
|
||||
{
|
||||
^false
|
||||
}
|
||||
|
||||
#method ensureBlock
|
||||
{
|
||||
^nil
|
||||
}
|
||||
|
||||
#method findExceptionContext
|
||||
{
|
||||
| ctx |
|
||||
ctx := self.
|
||||
[ ctx notNil ] whileTrue: [
|
||||
(ctx isExceptionContext) ifTrue: [^ctx].
|
||||
ctx := ctx sender.
|
||||
].
|
||||
^nil
|
||||
}
|
||||
|
||||
#method findEnsureContextAbove: sentinel
|
||||
{
|
||||
| ctx |
|
||||
ctx := self.
|
||||
[ ctx notNil and: [ctx ~~ sentinel] ] whileTrue: [
|
||||
(ctx isEnsureContext) ifTrue: [^ctx].
|
||||
ctx := ctx sender.
|
||||
].
|
||||
^nil
|
||||
}
|
||||
|
||||
|
||||
#method hasSender: context
|
||||
{
|
||||
| s |
|
||||
(self == context) ifTrue: [^false].
|
||||
s := self.sender.
|
||||
[ s isNil ] whileFalse: [
|
||||
(s == context) ifTrue: [^true].
|
||||
s := s sender.
|
||||
].
|
||||
^false
|
||||
}
|
||||
|
||||
#method isDead
|
||||
{
|
||||
^self.ip < 0
|
||||
}
|
||||
|
||||
#method terminate
|
||||
{
|
||||
self.sender := nil.
|
||||
self.ip = -1;
|
||||
}
|
||||
|
||||
#method terminateTo: prevctx
|
||||
{
|
||||
| ctx sctx |
|
||||
(self hasSender: prevctx) ifTrue: [
|
||||
ctx := self.sender.
|
||||
[ctx ~~ prevctx] whileTrue: [
|
||||
sctx := ctx sender.
|
||||
ctx terminate.
|
||||
ctx := sctx.
|
||||
]
|
||||
].
|
||||
self.sender := prevctx.
|
||||
}
|
||||
|
||||
#method resume: retval through: context
|
||||
{
|
||||
| ctx |
|
||||
self isDead ifTrue: ["TODO: cannot return" 'CANNOT RETURN' dump.].
|
||||
|
||||
ctx := context.
|
||||
[ ctx notNil ] whileTrue: [
|
||||
| donepos |
|
||||
donepos := ctx basicSize - 1.
|
||||
|
||||
(ctx basicAt: donepos) ifFalse: [
|
||||
| ensblk |
|
||||
ctx basicAt: donepos put: true.
|
||||
ensblk := ctx ensureBlock.
|
||||
thisContext terminateTo: ctx.
|
||||
ensblk value.
|
||||
].
|
||||
|
||||
ctx := ctx findEnsureContextAbove: self.
|
||||
].
|
||||
|
||||
thisContext terminateTo: self.
|
||||
^retval
|
||||
}
|
||||
|
||||
#method unwindTo: context return: retval
|
||||
{
|
||||
## -------------------------------------------------------------------
|
||||
## <<private>>
|
||||
## private: called by VM upon unwinding
|
||||
## -------------------------------------------------------------------
|
||||
|
||||
| ctx stop |
|
||||
ctx := self.
|
||||
stop := false.
|
||||
[stop] whileFalse: [
|
||||
| eb |
|
||||
eb := ctx ensureBlock.
|
||||
(eb notNil) ifTrue: [
|
||||
| donepos |
|
||||
donepos := ctx basicSize - 1.
|
||||
(ctx basicAt: donepos) ifFalse: [
|
||||
ctx basicAt: donepos put: true.
|
||||
eb value.
|
||||
].
|
||||
].
|
||||
stop := (ctx == context).
|
||||
ctx := ctx sender.
|
||||
].
|
||||
|
||||
^retval
|
||||
}
|
||||
}
|
||||
|
||||
#class(#pointer) MethodContext(Context)
|
||||
@ -188,104 +58,6 @@
|
||||
{
|
||||
^self.method
|
||||
}
|
||||
|
||||
#method isExceptionContext
|
||||
{
|
||||
## 10 - STIX_METHOD_PREAMBLE_EXCEPTION in VM.
|
||||
^self.method preambleCode == 10.
|
||||
}
|
||||
|
||||
#method isEnsureContext
|
||||
{
|
||||
## 10 - STIX_METHOD_PREAMBLE_ENSURE in VM.
|
||||
^self.method preambleCode == 11
|
||||
}
|
||||
|
||||
#method ensureBlock
|
||||
{
|
||||
## TODO: change 8 to a constant when stix is enhanced to support constant definition
|
||||
(self.method preambleCode == 11) ifFalse: [^nil].
|
||||
^self basicAt: 8.
|
||||
}
|
||||
|
||||
|
||||
#method findExceptionHandlerFor: exception_class
|
||||
{
|
||||
## find an exception handler block for a given exception class.
|
||||
##
|
||||
## for this to work, self must be an exception handler context.
|
||||
## For a single on:do: call,
|
||||
## self class specNumInstVars must return 8.
|
||||
## basicAt: 8 must be the on: argument.
|
||||
## basicAt: 9 must be the do: argument
|
||||
|
||||
(self isExceptionContext) ifTrue: [
|
||||
| bound exc |
|
||||
## NOTE: if on:do: has a temporary varible, bound must be adjusted to reflect it.
|
||||
bound := self basicSize - 1.
|
||||
## TODO: change 8 to a constant when stix is enhanced to support constant definition
|
||||
## or calcuate the minimum size using the class information.
|
||||
8 to: bound by: 2 do: [ :i |
|
||||
exc := self basicAt: i.
|
||||
((exception_class == exc) or: [exception_class inheritsFrom: exc]) ifTrue: [^self basicAt: (i + 1)].
|
||||
]
|
||||
].
|
||||
^nil.
|
||||
}
|
||||
|
||||
#method handleException: exception
|
||||
{
|
||||
## -------------------------------------------------------------------
|
||||
## <<private>>
|
||||
## called by Exception>>signal.
|
||||
## this method only exists in the MethodContext and UndefinedObject.
|
||||
## the caller must make sure that the receiver object is
|
||||
## a method context or nil. Exception>>signal invokes this method
|
||||
## only for an exception context which is a method context. it
|
||||
## invokes it for nil when no exception context is found.
|
||||
## -------------------------------------------------------------------
|
||||
|
||||
| excblk retval actpos |
|
||||
|
||||
## position of the temporary variable 'active' in MethodContext>>on:do.
|
||||
## for this code to work, it must be the last temporary variable in the method.
|
||||
actpos := (self basicSize) - 1.
|
||||
|
||||
excblk := self findExceptionHandlerFor: (exception class).
|
||||
(excblk isNil or: [(self basicAt: actpos) not]) ifTrue: [
|
||||
## self is an exception context but doesn't have a matching
|
||||
## exception handler or the exception context is already
|
||||
## in the middle of evaluation.
|
||||
^(self.sender findExceptionContext) handleException: exception.
|
||||
].
|
||||
|
||||
exception handlerContext: self.
|
||||
|
||||
## -------------------------------------------------------------------
|
||||
## if an exception occurs within an exception handler block,
|
||||
## the search will reach this context again as the exception block
|
||||
## is evaluated before actual unwinding. set the temporary variable
|
||||
## in the exception context to mask out this context from the search
|
||||
## list.
|
||||
## -------------------------------------------------------------------
|
||||
self basicAt: actpos put: false.
|
||||
[ retval := excblk value: exception ] ensure: [
|
||||
self basicAt: actpos put: true
|
||||
].
|
||||
|
||||
##(self.sender isNil) ifTrue: [ "TODO: CANNOT RETURN" ].
|
||||
|
||||
## -------------------------------------------------------------------
|
||||
## return to self.sender which is a caller of the exception context (on:do:)
|
||||
## pass the first ensure context between thisContext and self.sender.
|
||||
##
|
||||
## [ [Exception signal: 'xxx'] ensure: [20] ] on: Exception do: [:ex | ...]
|
||||
##
|
||||
## -------------------------------------------------------------------
|
||||
##^self.sender resume: retval through: (thisContext findEnsureContextAbove: self.sender).
|
||||
thisContext unwindTo: self.sender return: nil.
|
||||
Processor return: retval to: self.sender.
|
||||
}
|
||||
}
|
||||
|
||||
#class(#pointer) BlockContext(Context)
|
||||
@ -472,207 +244,8 @@
|
||||
|
||||
#method restart
|
||||
{
|
||||
ip := source pc.
|
||||
}
|
||||
|
||||
|
||||
#method on: anException do: anExceptionBlock
|
||||
{
|
||||
| exception_active |
|
||||
<exception>
|
||||
|
||||
"thisContext isExceptionContext dump.
|
||||
(thisContext basicSize) dump.
|
||||
(thisContext basicAt: 8) dump. ## this should be anException
|
||||
(thisContext basicAt: 9) dump. ## this should be anExceptionBlock
|
||||
(thisContext basicAt: 10) dump. ## this should be handlerActive
|
||||
'on:do: ABOUT TO EVALUE THE RECEIVER BLOCK' dump."
|
||||
|
||||
exception_active := true.
|
||||
^self value.
|
||||
}
|
||||
|
||||
#method on: exc1 do: blk1 on: exc2 do: blk2
|
||||
{
|
||||
| exception_active |
|
||||
<exception>
|
||||
exception_active := true.
|
||||
^self value.
|
||||
}
|
||||
|
||||
#method ensure: aBlock
|
||||
{
|
||||
| retval done |
|
||||
<ensure>
|
||||
|
||||
done := false.
|
||||
retval := self value.
|
||||
|
||||
## the temporary variable 'done' may get changed
|
||||
## during evaluation for exception handling.
|
||||
done ifFalse: [
|
||||
done := true.
|
||||
aBlock value.
|
||||
].
|
||||
^retval
|
||||
}
|
||||
|
||||
#method ifCurtailed: aBlock
|
||||
{
|
||||
| v ok |
|
||||
|
||||
ok := false.
|
||||
[ v := self value. ok := true. ] ensure: [ ok ifFalse: [aBlock value] ].
|
||||
^v.
|
||||
ip := self.source pc.
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
##
|
||||
## TODO: is it better to inherit from Object???
|
||||
## or treat Exception specially like UndefinedObject or Class???
|
||||
##
|
||||
#extend Exception
|
||||
{
|
||||
#method(#class) signal
|
||||
{
|
||||
^self new signal
|
||||
}
|
||||
|
||||
#method(#class) signal: text
|
||||
{
|
||||
^self new signal: text
|
||||
}
|
||||
|
||||
#method handlerContext: context
|
||||
{
|
||||
self.handlerContext := context.
|
||||
}
|
||||
|
||||
#method messageText
|
||||
{
|
||||
^self.messageText
|
||||
}
|
||||
|
||||
#method __signal
|
||||
{
|
||||
self.signalContext := thisContext.
|
||||
((thisContext sender) findExceptionContext) handleException: self.
|
||||
}
|
||||
|
||||
#method signal
|
||||
{
|
||||
| excctx excblk retval actpos |
|
||||
|
||||
self.signalContext := thisContext.
|
||||
excctx := (thisContext sender) findExceptionContext.
|
||||
[excctx notNil] whileTrue: [
|
||||
excblk := excctx findExceptionHandlerFor: (self class).
|
||||
(excblk notNil and:
|
||||
[actpos := excctx basicSize - 1. excctx basicAt: actpos]) ifTrue: [
|
||||
self.handlerContext := excctx.
|
||||
excctx basicAt: actpos put: false.
|
||||
[ retval := excblk value: self ] ensure: [
|
||||
excctx basicAt: actpos put: true
|
||||
].
|
||||
|
||||
thisContext unwindTo: (excctx sender) return: nil.
|
||||
Processor return: retval to: (excctx sender).
|
||||
].
|
||||
excctx := (excctx sender) findExceptionContext.
|
||||
].
|
||||
|
||||
## -----------------------------------------------------------------
|
||||
## FATAL ERROR - no exception handler.
|
||||
## -----------------------------------------------------------------
|
||||
##thisContext unwindTo: nil return: nil.
|
||||
thisContext unwindTo: (Processor activeProcess initialContext) return: nil.
|
||||
('### EXCEPTION NOT HANDLED #### ', self class name, ' - ', self messageText) dump.
|
||||
## TODO: debug the current process???? "
|
||||
Processor activeProcess terminate.
|
||||
}
|
||||
|
||||
#method signal: text
|
||||
{
|
||||
self.messageText := text.
|
||||
^self signal.
|
||||
}
|
||||
|
||||
#method pass
|
||||
{
|
||||
## pass the exception to the outer context
|
||||
((self.handlerContext sender) findExceptionContext) handleException: self.
|
||||
}
|
||||
|
||||
#method return: value
|
||||
{
|
||||
(self.handlerContext notNil) ifTrue: [
|
||||
Processor return: value to: self.handlerContext.
|
||||
].
|
||||
}
|
||||
|
||||
#method retry
|
||||
{
|
||||
## TODO: verify if return:to: causes unnecessary stack growth.
|
||||
(self.handlerContext notNil) ifTrue: [
|
||||
self.handlerContext pc: 0.
|
||||
Processor return: self to: self.handlerContext.
|
||||
].
|
||||
}
|
||||
|
||||
#method resume: value
|
||||
{
|
||||
## TODO: verify if return:to: causes unnecessary stack growth.
|
||||
## is this correct???
|
||||
(self.signalContext notNil and: [self.handlerContext notNil]) ifTrue: [
|
||||
| ctx |
|
||||
ctx := self.signalContext sender.
|
||||
self.signalContext := nil.
|
||||
self.handlerContext := nil.
|
||||
Processor return: value to: ctx.
|
||||
].
|
||||
}
|
||||
|
||||
#method resume
|
||||
{
|
||||
^self resume: nil.
|
||||
}
|
||||
}
|
||||
|
||||
#class NoSuchMessageException(Exception)
|
||||
{
|
||||
}
|
||||
|
||||
#class PrimitiveFailureException(Exception)
|
||||
{
|
||||
}
|
||||
|
||||
#extend Apex
|
||||
{
|
||||
#method(#class) primitiveFailed
|
||||
{
|
||||
## TODO: implement this
|
||||
## experimental backtrace...
|
||||
| ctx |
|
||||
ctx := thisContext.
|
||||
[ctx notNil] whileTrue: [
|
||||
(ctx class == MethodContext)
|
||||
ifTrue: [ (ctx method owner name, '>>', ctx method name) dump ].
|
||||
## TODO: include blockcontext???
|
||||
ctx := ctx sender.
|
||||
].
|
||||
'------ END OF BACKTRACE -----------' dump.
|
||||
PrimitiveFailureException signal: 'PRIMITIVE FAILED'.
|
||||
}
|
||||
|
||||
#method(#class) cannotInstantiate
|
||||
{
|
||||
Exception signal: 'Cannot instantiate'.
|
||||
}
|
||||
|
||||
#method(#class) doesNotUnderstand: messageSymbol
|
||||
{
|
||||
## TODO: implement this properly
|
||||
NoSuchMessageException signal: (messageSymbol, ' not understood by ', (self name)).
|
||||
}
|
||||
}
|
||||
|
369
stix/kernel/Except.st
Normal file
369
stix/kernel/Except.st
Normal file
@ -0,0 +1,369 @@
|
||||
|
||||
|
||||
##
|
||||
## TODO: is it better to inherit from Object???
|
||||
## or treat Exception specially like UndefinedObject or Class???
|
||||
##
|
||||
#class Exception(Apex)
|
||||
{
|
||||
#dcl signalContext handlerContext messageText.
|
||||
|
||||
#method(#class) signal
|
||||
{
|
||||
^self new signal
|
||||
}
|
||||
|
||||
#method(#class) signal: text
|
||||
{
|
||||
^self new signal: text
|
||||
}
|
||||
|
||||
#method handlerContext: context
|
||||
{
|
||||
self.handlerContext := context.
|
||||
}
|
||||
|
||||
#method messageText
|
||||
{
|
||||
^self.messageText
|
||||
}
|
||||
|
||||
#method __signal
|
||||
{
|
||||
self.signalContext := thisContext.
|
||||
((thisContext sender) findExceptionContext) handleException: self.
|
||||
}
|
||||
|
||||
#method signal
|
||||
{
|
||||
| excctx excblk retval actpos |
|
||||
|
||||
self.signalContext := thisContext.
|
||||
excctx := (thisContext sender) findExceptionContext.
|
||||
[excctx notNil] whileTrue: [
|
||||
excblk := excctx findExceptionHandlerFor: (self class).
|
||||
(excblk notNil and:
|
||||
[actpos := excctx basicSize - 1. excctx basicAt: actpos]) ifTrue: [
|
||||
self.handlerContext := excctx.
|
||||
excctx basicAt: actpos put: false.
|
||||
[ retval := excblk value: self ] ensure: [
|
||||
excctx basicAt: actpos put: true
|
||||
].
|
||||
|
||||
thisContext unwindTo: (excctx sender) return: nil.
|
||||
Processor return: retval to: (excctx sender).
|
||||
].
|
||||
excctx := (excctx sender) findExceptionContext.
|
||||
].
|
||||
|
||||
## -----------------------------------------------------------------
|
||||
## FATAL ERROR - no exception handler.
|
||||
## -----------------------------------------------------------------
|
||||
##thisContext unwindTo: nil return: nil.
|
||||
thisContext unwindTo: (Processor activeProcess initialContext) return: nil.
|
||||
('### EXCEPTION NOT HANDLED #### ', self class name, ' - ', self messageText) dump.
|
||||
## TODO: debug the current process???? "
|
||||
Processor activeProcess terminate.
|
||||
}
|
||||
|
||||
#method signal: text
|
||||
{
|
||||
self.messageText := text.
|
||||
^self signal.
|
||||
}
|
||||
|
||||
#method pass
|
||||
{
|
||||
## pass the exception to the outer context
|
||||
((self.handlerContext sender) findExceptionContext) handleException: self.
|
||||
}
|
||||
|
||||
#method return: value
|
||||
{
|
||||
(self.handlerContext notNil) ifTrue: [
|
||||
Processor return: value to: self.handlerContext.
|
||||
].
|
||||
}
|
||||
|
||||
#method retry
|
||||
{
|
||||
## TODO: verify if return:to: causes unnecessary stack growth.
|
||||
(self.handlerContext notNil) ifTrue: [
|
||||
self.handlerContext pc: 0.
|
||||
Processor return: self to: self.handlerContext.
|
||||
].
|
||||
}
|
||||
|
||||
#method resume: value
|
||||
{
|
||||
## TODO: verify if return:to: causes unnecessary stack growth.
|
||||
## is this correct???
|
||||
(self.signalContext notNil and: [self.handlerContext notNil]) ifTrue: [
|
||||
| ctx |
|
||||
ctx := self.signalContext sender.
|
||||
self.signalContext := nil.
|
||||
self.handlerContext := nil.
|
||||
Processor return: value to: ctx.
|
||||
].
|
||||
}
|
||||
|
||||
#method resume
|
||||
{
|
||||
^self resume: nil.
|
||||
}
|
||||
}
|
||||
|
||||
##============================================================================
|
||||
#extend Context
|
||||
{
|
||||
#method isExceptionContext
|
||||
{
|
||||
^false
|
||||
}
|
||||
|
||||
#method isEnsureContext
|
||||
{
|
||||
^false
|
||||
}
|
||||
|
||||
#method ensureBlock
|
||||
{
|
||||
^nil
|
||||
}
|
||||
|
||||
#method findExceptionContext
|
||||
{
|
||||
| ctx |
|
||||
ctx := self.
|
||||
[ ctx notNil ] whileTrue: [
|
||||
(ctx isExceptionContext) ifTrue: [^ctx].
|
||||
ctx := ctx sender.
|
||||
].
|
||||
^nil
|
||||
}
|
||||
|
||||
#method unwindTo: context return: retval
|
||||
{
|
||||
## -------------------------------------------------------------------
|
||||
## <<private>>
|
||||
## private: called by VM upon unwinding
|
||||
## -------------------------------------------------------------------
|
||||
|
||||
| ctx stop |
|
||||
ctx := self.
|
||||
stop := false.
|
||||
[stop] whileFalse: [
|
||||
| eb |
|
||||
eb := ctx ensureBlock.
|
||||
(eb notNil) ifTrue: [
|
||||
| donepos |
|
||||
donepos := ctx basicSize - 1.
|
||||
(ctx basicAt: donepos) ifFalse: [
|
||||
ctx basicAt: donepos put: true.
|
||||
eb value.
|
||||
].
|
||||
].
|
||||
stop := (ctx == context).
|
||||
ctx := ctx sender.
|
||||
].
|
||||
|
||||
^retval
|
||||
}
|
||||
}
|
||||
|
||||
##============================================================================
|
||||
#extend MethodContext
|
||||
{
|
||||
#method isExceptionContext
|
||||
{
|
||||
## 10 - STIX_METHOD_PREAMBLE_EXCEPTION in VM.
|
||||
^self.method preambleCode == 10.
|
||||
}
|
||||
|
||||
#method isEnsureContext
|
||||
{
|
||||
## 10 - STIX_METHOD_PREAMBLE_ENSURE in VM.
|
||||
^self.method preambleCode == 11
|
||||
}
|
||||
|
||||
#method ensureBlock
|
||||
{
|
||||
## TODO: change 8 to a constant when stix is enhanced to support constant definition
|
||||
(self.method preambleCode == 11) ifFalse: [^nil].
|
||||
^self basicAt: 8.
|
||||
}
|
||||
|
||||
|
||||
#method findExceptionHandlerFor: exception_class
|
||||
{
|
||||
## find an exception handler block for a given exception class.
|
||||
##
|
||||
## for this to work, self must be an exception handler context.
|
||||
## For a single on:do: call,
|
||||
## self class specNumInstVars must return 8.
|
||||
## basicAt: 8 must be the on: argument.
|
||||
## basicAt: 9 must be the do: argument
|
||||
|
||||
(self isExceptionContext) ifTrue: [
|
||||
| bound exc |
|
||||
## NOTE: if on:do: has a temporary varible, bound must be adjusted to reflect it.
|
||||
bound := self basicSize - 1.
|
||||
## TODO: change 8 to a constant when stix is enhanced to support constant definition
|
||||
## or calcuate the minimum size using the class information.
|
||||
8 to: bound by: 2 do: [ :i |
|
||||
exc := self basicAt: i.
|
||||
((exception_class == exc) or: [exception_class inheritsFrom: exc]) ifTrue: [^self basicAt: (i + 1)].
|
||||
]
|
||||
].
|
||||
^nil.
|
||||
}
|
||||
|
||||
#method handleException: exception
|
||||
{
|
||||
## -------------------------------------------------------------------
|
||||
## <<private>>
|
||||
## called by Exception>>signal.
|
||||
## this method only exists in the MethodContext and UndefinedObject.
|
||||
## the caller must make sure that the receiver object is
|
||||
## a method context or nil. Exception>>signal invokes this method
|
||||
## only for an exception context which is a method context. it
|
||||
## invokes it for nil when no exception context is found.
|
||||
## -------------------------------------------------------------------
|
||||
|
||||
| excblk retval actpos |
|
||||
|
||||
## position of the temporary variable 'active' in MethodContext>>on:do.
|
||||
## for this code to work, it must be the last temporary variable in the method.
|
||||
actpos := (self basicSize) - 1.
|
||||
|
||||
excblk := self findExceptionHandlerFor: (exception class).
|
||||
(excblk isNil or: [(self basicAt: actpos) not]) ifTrue: [
|
||||
## self is an exception context but doesn't have a matching
|
||||
## exception handler or the exception context is already
|
||||
## in the middle of evaluation.
|
||||
^(self.sender findExceptionContext) handleException: exception.
|
||||
].
|
||||
|
||||
exception handlerContext: self.
|
||||
|
||||
## -------------------------------------------------------------------
|
||||
## if an exception occurs within an exception handler block,
|
||||
## the search will reach this context again as the exception block
|
||||
## is evaluated before actual unwinding. set the temporary variable
|
||||
## in the exception context to mask out this context from the search
|
||||
## list.
|
||||
## -------------------------------------------------------------------
|
||||
self basicAt: actpos put: false.
|
||||
[ retval := excblk value: exception ] ensure: [
|
||||
self basicAt: actpos put: true
|
||||
].
|
||||
|
||||
##(self.sender isNil) ifTrue: [ "TODO: CANNOT RETURN" ].
|
||||
|
||||
## -------------------------------------------------------------------
|
||||
## return to self.sender which is a caller of the exception context (on:do:)
|
||||
## pass the first ensure context between thisContext and self.sender.
|
||||
##
|
||||
## [ [Exception signal: 'xxx'] ensure: [20] ] on: Exception do: [:ex | ...]
|
||||
##
|
||||
## -------------------------------------------------------------------
|
||||
thisContext unwindTo: self.sender return: nil.
|
||||
Processor return: retval to: self.sender.
|
||||
}
|
||||
}
|
||||
|
||||
##============================================================================
|
||||
#extend BlockContext
|
||||
{
|
||||
#method on: anException do: anExceptionBlock
|
||||
{
|
||||
| exception_active |
|
||||
<exception>
|
||||
|
||||
"thisContext isExceptionContext dump.
|
||||
(thisContext basicSize) dump.
|
||||
(thisContext basicAt: 8) dump. ## this should be anException
|
||||
(thisContext basicAt: 9) dump. ## this should be anExceptionBlock
|
||||
(thisContext basicAt: 10) dump. ## this should be handlerActive
|
||||
'on:do: ABOUT TO EVALUE THE RECEIVER BLOCK' dump."
|
||||
|
||||
exception_active := true.
|
||||
^self value.
|
||||
}
|
||||
|
||||
#method on: exc1 do: blk1 on: exc2 do: blk2
|
||||
{
|
||||
| exception_active |
|
||||
<exception>
|
||||
exception_active := true.
|
||||
^self value.
|
||||
}
|
||||
|
||||
#method ensure: aBlock
|
||||
{
|
||||
| retval done |
|
||||
<ensure>
|
||||
|
||||
done := false.
|
||||
retval := self value.
|
||||
|
||||
## the temporary variable 'done' may get changed
|
||||
## during evaluation for exception handling.
|
||||
done ifFalse: [
|
||||
done := true.
|
||||
aBlock value.
|
||||
].
|
||||
^retval
|
||||
}
|
||||
|
||||
#method ifCurtailed: aBlock
|
||||
{
|
||||
| v ok |
|
||||
|
||||
ok := false.
|
||||
[ v := self value. ok := true. ] ensure: [ ok ifFalse: [aBlock value] ].
|
||||
^v.
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
##============================================================================
|
||||
#class NoSuchMessageException(Exception)
|
||||
{
|
||||
}
|
||||
|
||||
#class PrimitiveFailureException(Exception)
|
||||
{
|
||||
}
|
||||
|
||||
#extend Apex
|
||||
{
|
||||
#method(#class) primitiveFailed
|
||||
{
|
||||
## TODO: implement this
|
||||
## experimental backtrace...
|
||||
| ctx |
|
||||
ctx := thisContext.
|
||||
[ctx notNil] whileTrue: [
|
||||
(ctx class == MethodContext)
|
||||
ifTrue: [ (ctx method owner name, '>>', ctx method name) dump ].
|
||||
## TODO: include blockcontext???
|
||||
ctx := ctx sender.
|
||||
].
|
||||
'------ END OF BACKTRACE -----------' dump.
|
||||
PrimitiveFailureException signal: 'PRIMITIVE FAILED'.
|
||||
}
|
||||
|
||||
#method(#class) cannotInstantiate
|
||||
{
|
||||
Exception signal: 'Cannot instantiate'.
|
||||
}
|
||||
|
||||
#method(#class) doesNotUnderstand: messageSymbol
|
||||
{
|
||||
## TODO: implement this properly
|
||||
NoSuchMessageException signal: (messageSymbol, ' not understood by ', (self name)).
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -283,6 +283,7 @@
|
||||
}
|
||||
|
||||
#include 'Context.st'.
|
||||
#include 'Except.st'.
|
||||
#include 'Process.st'.
|
||||
|
||||
#class FFI(Object)
|
||||
|
@ -128,6 +128,8 @@
|
||||
#endif
|
||||
|
||||
|
||||
#define __PRIMITIVE_NAME__ (&__FUNCTION__[5])
|
||||
|
||||
/* ------------------------------------------------------------------------- */
|
||||
static STIX_INLINE void vm_gettime (stix_t* stix, stix_ntime_t* now)
|
||||
{
|
||||
@ -1495,12 +1497,10 @@ static int prim_basic_at_put (stix_t* stix, stix_ooi_t nargs)
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int prim_context_goto (stix_t* stix, stix_ooi_t nargs)
|
||||
{
|
||||
stix_oop_t rcv;
|
||||
stix_oop_t pc;
|
||||
stix_oow_t pcw;
|
||||
|
||||
/* this primivie provides the similar functionality to MethodContext>>pc:
|
||||
* except that it pops the receiver and arguments and doesn't push a
|
||||
@ -1509,21 +1509,20 @@ static int prim_context_goto (stix_t* stix, stix_ooi_t nargs)
|
||||
|
||||
STIX_ASSERT (nargs == 1);
|
||||
|
||||
|
||||
rcv = STIX_STACK_GET(stix, stix->sp - 1);
|
||||
if (STIX_CLASSOF(stix, rcv) != stix->_method_context)
|
||||
{
|
||||
#if defined(STIX_DEBUG_VM_EXEC)
|
||||
STIX_DEBUG0 (stix, "prim_context_goto: PRIMITVE RECEIVER IS NOT A METHOD CONTEXT\n");
|
||||
#endif
|
||||
STIX_LOG2 (stix, STIX_LOG_PRIMITIVE | STIX_LOG_ERROR,
|
||||
"Error(%hs) - invalid receiver, not a method context- %O\n", __PRIMITIVE_NAME__, rcv);
|
||||
return 0;
|
||||
}
|
||||
|
||||
pc = STIX_STACK_GET(stix, stix->sp);
|
||||
if (!STIX_OOP_IS_SMOOI(pc) || STIX_OOP_TO_SMOOI(pc) < 0)
|
||||
{
|
||||
#if defined(STIX_DEBUG_VM_EXEC)
|
||||
STIX_DEBUG0 (stix, "prim_context_goto: PRIMITVE ARGUMENT IS INVALID\n");
|
||||
#endif
|
||||
STIX_LOG1 (stix, STIX_LOG_PRIMITIVE | STIX_LOG_ERROR,
|
||||
"Error(%hs) - invalid pc\n", __PRIMITIVE_NAME__);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -1560,9 +1559,8 @@ static int __block_value (stix_t* stix, stix_ooi_t rcv_blkctx_offset, stix_ooi_t
|
||||
if (STIX_CLASSOF(stix, rcv_blkctx) != stix->_block_context)
|
||||
{
|
||||
/* the receiver must be a block context */
|
||||
#if defined(STIX_DEBUG_VM_EXEC)
|
||||
STIX_DEBUG0 (stix, "PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
|
||||
#endif
|
||||
STIX_LOG2 (stix, STIX_LOG_PRIMITIVE | STIX_LOG_ERROR,
|
||||
"Error(%hs) - invalid receiver, not a block context- %O\n", __PRIMITIVE_NAME__, rcv_blkctx);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -1573,20 +1571,17 @@ STIX_DEBUG0 (stix, "PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
|
||||
* you can't send 'value' again to reactivate it.
|
||||
* For example, [thisContext value] value. */
|
||||
STIX_ASSERT (STIX_OBJ_GET_SIZE(rcv_blkctx) > STIX_CONTEXT_NAMED_INSTVARS);
|
||||
#if defined(STIX_DEBUG_VM_EXEC)
|
||||
STIX_DEBUG0 (stix, "PRIM REVALUING AN BLOCKCONTEXT\n");
|
||||
#endif
|
||||
STIX_LOG2 (stix, STIX_LOG_PRIMITIVE | STIX_LOG_ERROR,
|
||||
"Error(%hs) - re-valuing of a block context - %O\n", __PRIMITIVE_NAME__, rcv_blkctx);
|
||||
return 0;
|
||||
}
|
||||
STIX_ASSERT (STIX_OBJ_GET_SIZE(rcv_blkctx) == STIX_CONTEXT_NAMED_INSTVARS);
|
||||
|
||||
if (STIX_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs) != actual_arg_count /* nargs */)
|
||||
{
|
||||
/* the number of argument doesn't match */
|
||||
#if defined(STIX_DEBUG_VM_EXEC)
|
||||
/* TODO: better handling of primitive failure */
|
||||
STIX_DEBUG0 (stix, "PRIM BlockContext value FAIL - NARGS MISMATCH\n");
|
||||
#endif
|
||||
STIX_LOG4 (stix, STIX_LOG_PRIMITIVE | STIX_LOG_ERROR,
|
||||
"Error(%hs) - wrong number of arguments to a block context %O - expecting %zd, got %zd\n",
|
||||
__PRIMITIVE_NAME__, rcv_blkctx, STIX_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs), actual_arg_count);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -1866,9 +1861,9 @@ static int prim_processor_add_timed_semaphore (stix_t* stix, stix_ooi_t nargs)
|
||||
{
|
||||
/* soft error - cannot represent the expiry time in
|
||||
* a small integer. */
|
||||
STIX_LOG2 (stix, STIX_LOG_IC | STIX_LOG_ERROR,
|
||||
"Error - time (%ld) out of range(0 - %zd) when adding a timed semaphore\n",
|
||||
(unsigned long int)ft.sec, (stix_ooi_t)STIX_SMOOI_MAX);
|
||||
STIX_LOG3 (stix, STIX_LOG_PRIMITIVE | STIX_LOG_ERROR,
|
||||
"Error(%hs) - time (%ld) out of range(0 - %zd) when adding a timed semaphore\n",
|
||||
__PRIMITIVE_NAME__, (unsigned long int)ft.sec, (stix_ooi_t)STIX_SMOOI_MAX);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
@ -94,6 +94,7 @@ static int ignite_1 (stix_t* stix)
|
||||
STIX_ASSERT (stix->_nil != STIX_NULL);
|
||||
STIX_ASSERT (STIX_OBJ_GET_CLASS(stix->_nil) == STIX_NULL);
|
||||
|
||||
STIX_ASSERT (stix->_class == STIX_NULL);
|
||||
/* --------------------------------------------------------------
|
||||
* Class
|
||||
* The instance of Class can have indexed instance variables
|
||||
|
@ -815,7 +815,7 @@ number:
|
||||
else if (flagc & FLAGC_SIGN) tmp++;
|
||||
else if (flagc & FLAGC_SPACE) tmp++;
|
||||
|
||||
numlen = nbufp - nbuf;
|
||||
numlen = (int)((const stix_bch_t*)nbufp - (const stix_bch_t*)nbuf);
|
||||
if ((flagc & FLAGC_DOT) && precision > numlen)
|
||||
{
|
||||
/* extra zeros for precision specified */
|
||||
|
@ -885,15 +885,16 @@ struct stix_t
|
||||
|
||||
enum stix_log_mask_t
|
||||
{
|
||||
STIX_LOG_DEBUG = (1 << 0),
|
||||
STIX_LOG_INFO = (1 << 1),
|
||||
STIX_LOG_WARN = (1 << 2),
|
||||
STIX_LOG_ERROR = (1 << 3),
|
||||
STIX_LOG_FATAL = (1 << 4),
|
||||
STIX_LOG_DEBUG = (1 << 0),
|
||||
STIX_LOG_INFO = (1 << 1),
|
||||
STIX_LOG_WARN = (1 << 2),
|
||||
STIX_LOG_ERROR = (1 << 3),
|
||||
STIX_LOG_FATAL = (1 << 4),
|
||||
|
||||
STIX_LOG_MNEMONIC = (1 << 8), /* bytecode mnemonic */
|
||||
STIX_LOG_GC = (1 << 9),
|
||||
STIX_LOG_IC = (1 << 10) /* instruction cycle, fetch-decode-execute */
|
||||
STIX_LOG_MNEMONIC = (1 << 8), /* bytecode mnemonic */
|
||||
STIX_LOG_GC = (1 << 9),
|
||||
STIX_LOG_IC = (1 << 10), /* instruction cycle, fetch-decode-execute */
|
||||
STIX_LOG_PRIMITIVE = (1 << 11)
|
||||
};
|
||||
typedef enum stix_log_mask_t stix_log_mask_t;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user