\ 20-04-2007 ~mOleg для SPF4.18
\ Copyright [C] 2007 mOleg mininoleg@yahoo.com
\ вложенные обработчики ошибок.

\ для подключения лишь уникальных слов:
REQUIRE ?: devel\~moleg\lib\util\ifcolon.f

?: ADDR 4 ;  ?: A@ @ ; ?: A! ! ; ?: IS [COMPILE] TO ; IMMEDIATE

\ ---------------------------------------------------------------------------

        \ количество возможных обработчиков на стеке состояний.
        0x10 VALUE #err-handlers

  \ создали стек ошибок
  USER-CREATE ERRORS  #err-handlers CELLS USER-ALLOT

  \ указатель на текущую ошибку
  USER-VALUE cur-err-h

\ при выходе все обработчики выталкиваются из стека и исполняются.
\ В самом низу стека обработчиков ошибок находится неудаляемый базовый
\ обработчик.

\ текущий обработчик ошибок хранится по адресу addr
: err-handler ( --> addr ) cur-err-h ADDR * ERRORS + ;

\ добавивить реакцию в текущий список обработчиков
: ON-ERROR   ( 'cfa --> )
             cur-err-h 1 + #err-handlers MIN TO cur-err-h
             err-handler A! ;

\ вытолкнуть обработчик из стека
\ самый первый обработчик не выталкивается никогда
: EXIT-ERROR ( --> ) cur-err-h 1 - 0 MAX TO cur-err-h ;

\ при возникновении ошибки ее надо обработать согласно установленному
\ порядку обработчиков.
: IS-ERROR ( err-num --> )
           BEGIN cur-err-h WHILE
                 err-handler A@ EXECUTE
                 EXIT-ERROR
           REPEAT
           err-handler A@ EXECUTE ;

\ настройка обработчика - должна выполняться один раз на поток:
        ' ERROR2 err-handler !
        ' IS-ERROR IS ERROR

\EOF -- тестовая секция -----------------------------------------------------

: 1st-err ." first error handler: " ." error number - " DUP . CR ;
: 2st-err ." second error handler " CR ;

' 1st-err ON-ERROR
' 2st-err ON-ERROR

adfasdf  \ это ошибка 8)
\ после отработки ошибок в стеке обработчиков остается лишь один системный