wmb@MITCH.ENG.SUN.COM (12/11/90)
> What's the best way to code things like xfer protocols that have > goto's jumping from a case inside a while loop to some things > back before the loop started? Or go to one of several error exits? > There is lots of stuff like that in the sz/rz programs. One technique is to factor out the loop into a separate word, and use EXIT to get out. Another techniques it to use a state machine. > State machines? The Forth literature contains many references about the implementation of state machines in Forth. I recommend getting a copy of "A Bibliography of Forth References" ($18 from FIG) as a starting point. Contact FIG at: Forth Interest Group P.O. Box 8231 San Jose, CA 95155 408/277-0668 (Voice) 408/286-8988 (FAX) > How do you get back out of some deeply nested things like longjmp() and > setjmp() do from C? With CATCH and THROW . A writeup follows my signature ... Mitch Bradley, wmb@Eng.Sun.COM Briefly: CATCH ( cfa -- 0 | error-code ) Executes "cfa" (as with EXECUTE) with an error handler installed. Returns 0 normally, or a non-zero error-code if the error handler received a THROW . THROW ( error-code | 0 -- ) Does nothing if argument is 0, otherwise transmits error-code to the nearest dynamically-enclosing error handler. Explicitly: CATCH ( <args-to-cfa> cfa -- <results-from-cfa> 0 ) \ Normal completion ( <args-to-cfa> cfa -- <see-text> error-code ) \ Received "THROW" CATCH is used like EXECUTE . The word "cfa" is EXECUTE'd under the guardianship of an error handler. If "cfa" executes without receiving a THROW (i.e. no error occurs), then the effect of CATCH is the same as " EXECUTE 0 ", i.e. the normal return values from "cfa" are on the stack, underneath a 0 signifying "okay". If the guarding error handler receives a THROW during the execution of "cfa", then the stack depth is restored to the same depth that existed when "cfa" began execution, and the error-code from the THROW is placed on the top of the stack. Note that, while the stack depth is deterministic, the contents of any stack items that may have been consumed at any time during the execution of "cfa" are undefined. Thus, about the only useful thing that can be done with those stack items is to DROP them. The error handler information is stored on the return stack during the entire execution of "cfa", but does not interfere with "cfa"s legal use of the return stack. THROW ( error-code -- <see CATCH> ) If error-code is 0, does nothing. Otherwise, transfers control back to the nearest dynamically-enclosing error handler as follows: Items (return addresses and other numbers) are removed from the return stack until an error handler frame (as installed by CATCH) is located. Removes that error handler frame from the return stack, restores the data stack depth to the depth saved in the handler frame, pushes "error-code" on the data stack, and transfers control to a point just after the CATCH that installed the error handler. The effect is as if CATCH returned with an error code on the stack. Preferred implementation (requires access to the return stack pointer): \ 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 ; Portable Implementation (has a problem): \ 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 ; Note: An intermediate implementation is possible. The "correct" implementation uses both the return stack pointer and the data stack pointer. The "portable" implementation "marks" the return stack with a "magic number", and uses DEPTH to restore the data stack. The "intermediate" implementation would be a "hybrid", using the the return stack pointer technique from the "correct" implementation and the DEPTH technique from the "portable" implementation. This "hybrid" implementation is also "correct", because it avoids the problem with the "portable" implementation. The "hybrid" implementation would be used on a system where the return stack pointer is available, but the data stack pointer is not (e.g. a machine with a stack cache, or a system which uses registers for the top of the stack). Example usage: \ Test/demonstration program for Error Handling Wordset \ Copyright (c) 1989 by Mitch Bradley \ Permission to use, copy, and distribute this code is hereby \ granted, providing that this notice remains attached. \ This program illustrates the use of CATCH and THROW . It shows \ the many ways in which errors may be handled. In particular, they \ may be retried (as with err1 in this example), passed on to higher \ levels, perhaps with some prior processing (as with error 3, and error \ 2 at the RETRIER level), or handled locally (as with error 2 at the \ TEST level). \ Uses Eaker's CASE statement. \ Declare some error numbers variable err1 variable err2 variable err3 : PITCHER ( -- ) \ Throws errors based on keyboard input ." Type 0 for normal exit, 1 for err1, 2 for err2, 3 for err3: " KEY DUP EMIT CR ( char ) CASE ASCII 0 OF ENDOF ASCII 1 OF ERR1 THROW ENDOF ASCII 2 OF ERR2 THROW ENDOF ASCII 3 OF ERR3 THROW ENDOF ENDCASE ; : RETRIER ( -- ) \ Retries error 1, and re-throws others BEGIN ['] PITCHER CATCH ( error# | 0 ) ?DUP WHILE ( error# ) DUP ERR1 = IF DROP ELSE ." Propagating ... " CR THROW THEN ." Sorry, try again" CR REPEAT ." Normal termination of 'retrier'" cr ; : TEST ( -- ) \ Prints message for any error ['] RETRIER CATCH ( error# | 0 ) CASE 0 OF ENDOF ERR2 OF ." test received error 2" cr ENDOF ( default ) DUP THROW ENDCASE ." test completed normally" CR ; \ Replacement for QUIT which uses an error handler. This a a "catchall" \ which handles any errors which haven't been taken care of at a lower \ level. \ It would be sufficient to just say " BEGIN ['] QUIT CATCH DROP AGAIN ", \ except that QUIT clears the return stack. : SAFE-QUIT BEGIN [COMPILE] [ RP0 @ RP! QUERY ['] INTERPRET CATCH ?DUP IF ." Error # " . ELSE ." OK" THEN AGAIN ; SAFE-QUIT TEST