version 1.4, 1999/12/12 20:27:53
|
version 1.5, 1999/12/12 20:39:00
|
Line 33 Defer store-backtrace
|
Line 33 Defer store-backtrace
|
\ inline argument: address of the handler |
\ inline argument: address of the handler |
r> |
r> |
'catch |
'catch |
|
dup dup @ + >r \ recovery address |
sp@ >r |
sp@ >r |
fp@ >r |
fp@ >r |
dup dup @ + >r \ recovery address |
|
lp@ >r |
lp@ >r |
handler @ >r |
handler @ >r |
rp@ handler ! |
rp@ handler ! |
Line 50 Defer store-backtrace
|
Line 50 Defer store-backtrace
|
r> |
r> |
r> handler ! |
r> handler ! |
rdrop \ lp |
rdrop \ lp |
rdrop \ recovery address |
|
rdrop \ fp |
rdrop \ fp |
rdrop \ sp |
rdrop \ sp |
|
rdrop \ recovery address |
>r ; |
>r ; |
|
|
: (recover2) ( ... x -- ... x ) |
|
\ restore sp and fp |
|
r> |
|
r> fp! |
|
r> -rot >r >r sp! drop r> ; |
|
|
|
: recover ( compilation orig -- ; run-time -- ) \ gforth |
: recover ( compilation orig -- ; run-time -- ) \ gforth |
\ !! check using a special tag |
\ !! check using a special tag |
POSTPONE (recover) |
POSTPONE (recover) |
POSTPONE else |
POSTPONE else ; immediate compile-only |
POSTPONE (recover2) ; immediate compile-only |
|
|
|
: endtry ( compilation orig -- ; run-time -- ) \ gforth |
: endtry ( compilation orig -- ; run-time -- ) \ gforth |
POSTPONE then ; immediate compile-only |
POSTPONE then ; immediate compile-only |
Line 78 Defer store-backtrace
|
Line 71 Defer store-backtrace
|
endtry ; |
endtry ; |
is catch |
is catch |
|
|
\ :noname ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception |
|
\ 'catch |
|
\ sp@ >r |
|
\ \ [ has? floating [IF] ] |
|
\ fp@ >r |
|
\ \ [ [THEN] ] |
|
\ \ [ has? glocals [IF] ] |
|
\ lp@ >r |
|
\ \ [ [THEN] ] |
|
\ handler @ >r |
|
\ rp@ handler ! |
|
\ \ [ has? backtrace [IF] ] |
|
\ backtrace-empty on |
|
\ \ [ [THEN] ] |
|
\ execute |
|
\ r> handler ! rdrop |
|
\ \ [ has? floating [IF] ] |
|
\ rdrop |
|
\ \ [ [THEN] ] |
|
\ \ [ has? glocals [IF] ] |
|
\ rdrop |
|
\ \ [ [THEN] ] |
|
\ 0 ; |
|
\ is catch |
|
|
|
:noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception |
:noname ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception |
?DUP IF |
?DUP IF |
[ here forthstart 9 cells + ! ] |
[ here forthstart 9 cells + ! ] |
\ [ has? header [IF] here 9 cells ! [THEN] ] \ entry point for signal handler |
|
\ [ has? backtrace [IF] ] |
|
store-backtrace |
store-backtrace |
\ [ [THEN] ] |
|
\ [ has? interpreter [IF] ] |
|
handler @ ?dup-0=-IF |
handler @ ?dup-0=-IF |
\ [ has? os [IF] ] |
|
cr .error cr |
cr .error cr |
2 (bye) |
2 (bye) |
\ [ [ELSE] ] |
|
quit |
quit |
\ [ [THEN] ] |
|
THEN |
THEN |
\ [ [THEN] ] |
|
rp! |
rp! |
r> handler ! |
r> handler ! |
\ [ has? glocals [IF] ] |
r> lp! |
r> lp! |
r> fp! |
\ [ [THEN] ] |
r> swap >r sp! drop r> |
'throw |
'throw |
THEN ; |
THEN ; |
is throw |
is throw |