formalize 'THROW with string' & ensure default string is empty

This commit is contained in:
Jesse D. McDonald 2020-10-20 21:56:39 -05:00
parent 96ebc29630
commit d90c8857e2
1 changed files with 13 additions and 8 deletions

View File

@ -43,6 +43,10 @@ DEFER QUIT ( -- <noreturn> )
\ Non-standard system error codes (-4095 ... -256) \ Non-standard system error codes (-4095 ... -256)
-256 CONSTANT EXCP-HEAP-OVERFLOW -256 CONSTANT EXCP-HEAP-OVERFLOW
\ THROWN-STRING holds the address and size of the string passed to FAIL
\ It may also be used to hold context strings for other system exception codes
CREATE THROWN-STRING 0 , 0 ,
\ This is called by THROW when n is nonzero \ This is called by THROW when n is nonzero
\ The initial value (DEFAULT-UNWIND) performs the function of ABORT \ The initial value (DEFAULT-UNWIND) performs the function of ABORT
\ CATCH saves and restores the current target and substitutes its own version \ CATCH saves and restores the current target and substitutes its own version
@ -52,23 +56,24 @@ DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> )
\ If there is no CATCH, perform the function of ABORT (clear data stack and QUIT) \ If there is no CATCH, perform the function of ABORT (clear data stack and QUIT)
\ Absent CATCH, whether a message is displayed depends on the value of n: \ Absent CATCH, whether a message is displayed depends on the value of n:
\ -1 (ABORT) no message \ -1 (ABORT) no message
\ -2 (FAIL) the string passed to FAIL \ -2 (FAIL) the string passed to THROW-STRING
\ otherwise message is implementation-dependent \ otherwise message is implementation-dependent
: THROW ( k*x n -- k*x | i*x n <noreturn> ) : THROW-STRING ( k*x n c-addr u -- k*x | i*x n <noreturn> )
THROWN-STRING 2!
?DUP IF THROW-UNWIND THEN ; ?DUP IF THROW-UNWIND THEN ;
\ Same but without the string (default to zero-length)
: THROW ( k*x n c-addr u -- k*x | i*x n <noreturn> )
0 0 THROW-STRING ;
\ By default, clear the data stack and QUIT without any message \ By default, clear the data stack and QUIT without any message
\ This behavior can be overridden with CATCH \ This behavior can be overridden with CATCH
: ABORT ( i*x -- ) ( R: j*x -- ) EXCP-ABORT THROW ; : ABORT ( i*x -- ) ( R: j*x -- ) EXCP-ABORT THROW ;
\ THROWN-STRING holds the address and size of the string passed to FAIL
\ It may also be used to hold context strings for other system exception codes
CREATE THROWN-STRING 0 , 0 ,
\ Display a message and ABORT \ Display a message and ABORT
\ This behavior can be overridden with CATCH \ This behavior can be overridden with CATCH
: FAIL ( c-addr u -- <none> | <noreturn> ) : FAIL ( c-addr u -- <none> | <noreturn> )
THROWN-STRING 2! EXCP-FAIL THROW ; EXCP-FAIL -ROT THROW-STRING ;
\ If flag is non-zero, display a message and ABORT \ If flag is non-zero, display a message and ABORT
\ This behavior can be overridden with CATCH \ This behavior can be overridden with CATCH
@ -868,7 +873,7 @@ VARIABLE ORDER-FREELIST
\ Same as FIND except that unknown words are reported and result in a call to THROW \ Same as FIND except that unknown words are reported and result in a call to THROW
: FIND-OR-THROW ( c-addr u -- xt 1 | xt -1 ) : FIND-OR-THROW ( c-addr u -- xt 1 | xt -1 )
FIND ?DUP 0= IF THROWN-STRING 2! EXCP-UNDEFINED-WORD THROW THEN ; FIND ?DUP 0= IF EXCP-UNDEFINED-WORD -ROT THROW-STRING THEN ;
\ Read a word from the input (during runtime) and return its execution token \ Read a word from the input (during runtime) and return its execution token
\ Aborts if the word is not found in the current (runtime) search order list \ Aborts if the word is not found in the current (runtime) search order list