+ EXECUTION TOKENS ----------------------------------------------------------------------
+
+ Standard FORTH defines a concept called an 'execution token' (or 'xt') which is very
+ similar to a function pointer in C. We map the execution token to a codeword address.
+
+ execution token of DOUBLE is the address of this codeword
+ |
+ V
+ +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+
+ | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT |
+ +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+
+ len pad codeword ^
+
+ There is one assembler primitive for execution tokens, EXECUTE ( xt -- ), which runs them.
+
+ You can make an execution token for an existing word the long way using >CFA,
+ ie: WORD [foo] FIND >CFA will push the xt for foo onto the stack where foo is the
+ next word in input. So a very slow way to run DOUBLE might be:
+
+ : DOUBLE DUP + ;
+ : SLOW WORD FIND >CFA EXECUTE ;
+ 5 SLOW DOUBLE . CR \ prints 10
+
+ We also offer a simpler and faster way to get the execution token of any word FOO:
+
+ ['] FOO
+
+ (Exercises for readers: (1) What is the difference between ['] FOO and ' FOO?
+ (2) What is the relationship between ', ['] and LIT?)
+
+ More useful is to define anonymous words and/or to assign xt's to variables.
+
+ To define an anonymous word (and push its xt on the stack) use :NONAME ... ; as in this
+ example:
+
+ :NONAME ." anon word was called" CR ; \ pushes xt on the stack
+ DUP EXECUTE EXECUTE \ executes the anon word twice
+
+ Stack parameters work as expected:
+
+ :NONAME ." called with parameter " . CR ;
+ DUP
+ 10 SWAP EXECUTE \ prints 'called with parameter 10'
+ 20 SWAP EXECUTE \ prints 'called with parameter 20'
+
+ Notice that the above code has a memory leak: the anonymous word is still compiled
+ into the data segment, so even if you lose track of the xt, the word continues to
+ occupy memory. A good way to keep track of the xt and thus avoid the memory leak is
+ to assign it to a CONSTANT, VARIABLE or VALUE:
+
+ 0 VALUE ANON
+ :NONAME ." anon word was called" CR ; TO ANON
+ ANON EXECUTE
+ ANON EXECUTE
+
+ Another use of :NONAME is to create an array of functions which can be called quickly
+ (think: fast switch statement). This example is adapted from the ANS FORTH standard:
+
+ 10 CELLS ALLOT CONSTANT CMD-TABLE
+ : SET-CMD CELLS CMD-TABLE + ! ;
+ : CALL-CMD CELLS CMD-TABLE + @ EXECUTE ;
+
+ :NONAME ." alternate 0 was called" CR ; 0 SET-CMD
+ :NONAME ." alternate 1 was called" CR ; 1 SET-CMD
+ \ etc...
+ :NONAME ." alternate 9 was called" CR ; 9 SET-CMD
+
+ 0 CALL-CMD
+ 1 CALL-CMD
+)
+
+: :NONAME
+ 0 0 CREATE ( create a word with no name - we need a dictionary header because ; expects it )
+ HERE @ ( current HERE value is the address of the codeword, ie. the xt )
+ DOCOL , ( compile DOCOL (the codeword) )
+ ] ( go into compile mode )
+;
+
+: ['] IMMEDIATE
+ ' LIT , ( compile LIT )
+;
+
+(
+ EXCEPTIONS ----------------------------------------------------------------------
+
+ Amazingly enough, exceptions can be implemented directly in FORTH, in fact rather easily.
+
+ The general usage is as follows:
+
+ : FOO ( n -- ) THROW ;
+
+ : TEST-EXCEPTIONS
+ 25 ['] FOO CATCH \ execute 25 FOO, catching any exception
+ ?DUP IF
+ ." called FOO and it threw exception number: "
+ . CR
+ DROP \ we have to drop the argument of FOO (25)
+ THEN
+ ;
+ \ prints: called FOO and it threw exception number: 25
+
+ CATCH runs an execution token and detects whether it throws any exception or not. The
+ stack signature of CATCH is rather complicated:
+
+ ( a_n-1 ... a_1 a_0 xt -- r_m-1 ... r_1 r_0 0 ) if xt did NOT throw an exception
+ ( a_n-1 ... a_1 a_0 xt -- ?_n-1 ... ?_1 ?_0 e ) if xt DID throw exception 'e'
+
+ where a_i and r_i are the (arbitrary number of) argument and return stack contents
+ before and after xt is EXECUTEd. Notice in particular the case where an exception
+ is thrown, the stack pointer is restored so that there are n of _something_ on the
+ stack in the positions where the arguments a_i used to be. We don't really guarantee
+ what is on the stack -- perhaps the original arguments, and perhaps other nonsense --
+ it largely depends on the implementation of the word that was executed.
+
+ THROW, ABORT and a few others throw exceptions.
+
+ Exception numbers are non-zero integers. By convention the positive numbers can be used
+ for app-specific exceptions and the negative numbers have certain meanings defined in
+ the ANS FORTH standard. (For example, -1 is the exception thrown by ABORT).
+
+ 0 THROW does nothing. This is the stack signature of THROW:
+
+ ( 0 -- )
+ ( * e -- ?_n-1 ... ?_1 ?_0 e ) the stack is restored to the state from the corresponding CATCH
+
+ The implementation hangs on the definitions of CATCH and THROW and the state shared
+ between them.
+
+ Up to this point, the return stack has consisted merely of a list of return addresses,
+ with the top of the return stack being the return address where we will resume executing
+ when the current word EXITs. However CATCH will push a more complicated 'exception stack
+ frame' on the return stack. The exception stack frame records some things about the
+ state of execution at the time that CATCH was called.
+
+ When called, THROW walks up the return stack (the process is called 'unwinding') until
+ it finds the exception stack frame. It then uses the data in the exception stack frame
+ to restore the state allowing execution to continue after the matching CATCH. (If it
+ unwinds the stack and doesn't find the exception stack frame then it prints a message
+ and drops back to the prompt, which is also normal behaviour for so-called 'uncaught
+ exceptions').
+
+ This is what the exception stack frame looks like. (As is conventional, the return stack
+ is shown growing downwards from higher to lower memory addresses).
+
+ +------------------------------+
+ | return address from CATCH | Notice this is already on the
+ | | return stack when CATCH is called.
+ +------------------------------+
+ | original parameter stack |
+ | pointer |
+ +------------------------------+ ^
+ | exception stack marker | |
+ | (EXCEPTION-MARKER) | | Direction of stack
+ +------------------------------+ | unwinding by THROW.
+ |
+ |
+
+ The EXCEPTION-MARKER marks the entry as being an exception stack frame rather than an
+ ordinary return address, and it is this which THROW "notices" as it is unwinding the
+ stack. (If you want to implement more advanced exceptions such as TRY...WITH then
+ you'll need to use a different value of marker if you want the old and new exception stack
+ frame layouts to coexist).
+
+ What happens if the executed word doesn't throw an exception? It will eventually
+ return and call EXCEPTION-MARKER, so EXCEPTION-MARKER had better do something sensible
+ without us needing to modify EXIT. This nicely gives us a suitable definition of
+ EXCEPTION-MARKER, namely a function that just drops the stack frame and itself
+ returns (thus "returning" from the original CATCH).
+
+ One thing to take from this is that exceptions are a relatively lightweight mechanism
+ in FORTH.
+)
+
+: EXCEPTION-MARKER
+ RDROP ( drop the original parameter stack pointer )
+ 0 ( there was no exception, this is the normal return path )
+;
+
+: CATCH ( xt -- exn? )
+ DSP@ 4+ >R ( save parameter stack pointer (+4 because of xt) on the return stack )
+ ' EXCEPTION-MARKER 4+ ( push the address of the RDROP inside EXCEPTION-MARKER ... )
+ >R ( ... on to the return stack so it acts like a return address )
+ EXECUTE ( execute the nested function )
+;
+
+: THROW ( n -- )
+ ?DUP IF ( only act if the exception code <> 0 )
+ RSP@ ( get return stack pointer )
+ BEGIN
+ DUP R0 4- < ( RSP < R0 )
+ WHILE
+ DUP @ ( get the return stack entry )
+ ' EXCEPTION-MARKER 4+ = IF ( found the EXCEPTION-MARKER on the return stack )
+ 4+ ( skip the EXCEPTION-MARKER on the return stack )
+ RSP! ( restore the return stack pointer )
+
+ ( Restore the parameter stack. )
+ DUP DUP DUP ( reserve some working space so the stack for this word
+ doesn't coincide with the part of the stack being restored )
+ R> ( get the saved parameter stack pointer | n dsp )
+ 4- ( reserve space on the stack to store n )
+ SWAP OVER ( dsp n dsp )
+ ! ( write n on the stack )
+ DSP! EXIT ( restore the parameter stack pointer, immediately exit )
+ THEN
+ 4+
+ REPEAT
+
+ ( No matching catch - print a message and restart the INTERPRETer. )
+ DROP
+
+ CASE
+ 0 1- OF ( ABORT )
+ ." ABORTED" CR
+ ENDOF
+ ( default case )
+ ." UNCAUGHT THROW "
+ DUP . CR
+ ENDCASE
+ QUIT
+ THEN
+;
+
+: ABORT ( -- )
+ 0 1- THROW
+;
+
+( Print a stack trace by walking up the return stack. )
+: PRINT-STACK-TRACE
+ RSP@ ( start at caller of this function )
+ BEGIN
+ DUP R0 4- < ( RSP < R0 )
+ WHILE
+ DUP @ ( get the return stack entry )
+ CASE
+ ' EXCEPTION-MARKER 4+ OF ( is it the exception stack frame? )
+ ." CATCH ( DSP="
+ 4+ DUP @ U. ( print saved stack pointer )
+ ." ) "
+ ENDOF
+ ( default case )
+ DUP
+ CFA> ( look up the codeword to get the dictionary entry )
+ ?DUP IF ( and print it )
+ 2DUP ( dea addr dea )
+ ID. ( print word from dictionary entry )
+ [ CHAR + ] LITERAL EMIT
+ SWAP >DFA 4+ - . ( print offset )
+ THEN
+ ENDCASE
+ 4+ ( move up the stack )
+ REPEAT
+ DROP
+ CR
+;
+
+(
git.annexia.org / jonesforth.git / commitdiff