Path: utzoo!utgpu!news-server.csri.toronto.edu!clyde.concordia.ca!uunet!decwrl!ucbvax!MITCH.ENG.SUN.COM!wmb
From: wmb@MITCH.ENG.SUN.COM (Mitch Bradley)
Newsgroups: comp.lang.forth
Subject: Re: CATCH and THROW
Message-ID: <9008040311.AA18353@ucbvax.Berkeley.EDU>
Date: 3 Aug 90 17:28:19 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Reply-To: Mitch Bradley <wmb%MITCH.ENG.SUN.COM@SCFVM.GSFC.NASA.GOV>
Organization: The Internet
Lines: 86

> Can anyone post the source of CATCH and THROW for F-PC?

The "canonical" version should work just fine in F-PC, since it
implements SP@, SP!, RP@, and RP! in the same was as F83.

Here it is:

\ CATCH/THROW Error Handling Wordset
\ by Mitch Bradley
\

\ This implementation uses the non-standard words SP@ , SP! , RP@ , and
\ RP! .  These words, or their equivalents, are present in most systems.
\ Another implementation which does not use those non-standard words
\ follows this implementation.

\ Thanks to Don Colburn and Dean Sanderson for implementation suggestions.

VARIABLE HANDLER  \ Most recent error handler (should be a USER variable)

: CATCH  ( cfa -- error# | 0 )
   			( cfa )  \ Return address is already on the stack
   SP@ >R		( cfa )  \ Save data stack pointer
   EXCEPTION @ >R	( cfa )  \ Previous handler
   RP@ HANDLER !	( cfa )  \ Set current handler to this one
   EXECUTE		( )      \ Execute the word passed in on the stack
   R> HANDLER !		( )    	 \ Restore previous handler
   R> DROP		( )      \ Discard saved stack pointer
   0   			( 0 )    \ Signify normal completion
;

: THROW  ( ??? error# -- ??? error# ) \ Returns in saved context
   ?DUP  IF
      HANDLER @ RP!	( err# )      \ Return to saved return stack context
      R> HANDLER !	( err# )      \ Restore previous handler

      \ Remember error# on return stack before changing data stack pointer

      R> SWAP >R	( saved-sp )  \ err# is on return stack
      SP! R>		( err# )      \ Change stack pointer

      \ This return will return to the caller of catch, because the return
      \ stack has been restored to the state that existed when CATCH began
      \ execution .
   THEN
;

\ This is a portable implementation which does not use any non-standard
\ words.  This implementation has a problem: if the return stack happens
\ to contain a number which is the same as MAGIC# , then the wrong error
\ frame would be found.  This problem can be minimized by choosing a
\ magic number which is unlikely to appear on the return stack, or by
\ placing 2 different magic numbers on the return stack instead of just 1.

6775 CONSTANT MAGIC#

: CATCH  ( cfa -- error# | 0 )
                      ( cfa )     \ Return address is already on the stack
   DEPTH >R           ( cfa )     \ Save data stack size
   MAGIC# >R          ( cfa )     \ "magic" number to mark return stack
   EXECUTE            ( )         \ Execute the word passed in on the stack
   R> R> 2DROP  0     ( 0 )       \ Drop handler and signify normal completion
;

: THROW  ( ??? error# -- ??? error# )  \ Returns in saved context
   ?DUP  IF
      BEGIN  R>  MAGIC# =  UNTIL      ( err# )    \ Unwind return stack frame

      \ Remember err# on return stack before changing data stack depth

      R> SWAP >R >R                   ( return-stack: err# depth )

      \ The following code sets the stack depth to a known depth
      \ without using any nonstandard words (such as perhapse "sp!")
      \ The desired depth is kept on the return stack during the process.

      BEGIN  DEPTH R@  >  WHILE  NIP  REPEAT    \ Remove any extra items
                                                \ Depth is now <= correct depth
      BEGIN  DEPTH R@  <  WHILE  0    REPEAT    \ Add items if necessary
      R> DROP  R>                     ( err# )  \ Discard old depth

      \ This return will return to the caller of catch, because the return
      \ stack has been restored to the state that existed when CATCH began
      \ execution .
   THEN
;