From Newsgroup: comp.lang.forth

( Display window (stdout) )

Demo Keep script running in spite of faults

Overview

===
FigForth WARNING set to -1 enables (ABORT) as alternative error
handling. The default for (ABORT) is to perform ABORT but it's
acceptable to replace (ABORT) action with custom user action. In the
following demo a custom error handling is assigned to (ABORT) by
action of switch settings. The alternaltive error handling will use
BacForth 'structured cut' to recover from an error (invalid octal
number) and keep the script running.

The _objective_ is to handle errors without halting the script.
Error handling is arranged to log error, make repairs, cease action
of offending script line, and continue running rest of script.
This allows test/demo scripts to include fault handling cases and
continue on with diagnotics and other cases.

Notes:
i. Fig's BACK is redefined for BacForth BACK TRACKING
i. TCF := Threaded Code Fragment, a BacForth concept
i. BacForth employs only L-stack; I added a C-stack for cut
addressing to avoid interactions with L-stack data.
Being virtual stacks it only cost one cell for the stack
and a few words for push and pop operations.
===

-- OX ( "octal_number<bl>" -- current_base_number )
-- Octal number parser. Used to illustrate PRO and CUT actions
: Ox
PRO \ push TCF to L-stack
BASE @ DUP
R> 2>R \ rack BASE value
TMP! \ save BASE value
BACK \ return here on error
2R> >R BASE ! \ restore BASE
STATE @ IF \ snub the compile
'CUT: TRUE ABORT" Snubbed" ;' EVAL
ENDIF
TREK \ resolve BACK
CUT: \ mark BACK for error return
BL WORD \ parse octal number
OCTAL HERE NUMBER DROP [COMPILE] LITERAL
TMP@ BASE ! \ restore BASE
CONT \ control flows to TCF
; IMMEDIATE


Setup

sp! decimal
ERESET \ default error handling
-uabort \ enable user error handling
-ecut \ enable cut action
show abort
ABORT status:
WARNING -1
(ABORT) UABORT
UABORT (ERR_DUMP)
ERRTRACE Disabled
ERRCUT Enabled
--
: boo ." BOO " 42 . ; \ some TCF downstream word
: fault 0 ? ; \ some fault


Interpret

cr i. Ox 644 . boo

420 BOO 42

cr i. Ox 755 . boo

493 BOO 42

cr i. Ox 644 . Ox 755 . boo

420 493 BOO 42

cr i. Ox 644 . hex Ox 755 . boo

420 1ED BOO 2A

i. base? --> 10
( For unbelievers ) i. BASE @ 1 - . --> 9
--
-- Three fault cases
--
i. Ox 972 . boo -->
( continued after fault )
i. Ox 644 . Ox 69 . boo --> 420
( continued after fault )
i. Ox 755 . fault . boo --> 493
( continued after fault )


Compiled

: FOO Ox 644 . boo ;
i. foo --> 420 BOO 42

: BAR hex Ox 49 . boo ; \ compile fails
' BAR see \ BAR has been snubbed
BAR
134597616 HEX
134597620 CUT:
134597624 TRUE
134597628 0BRANCH 32 ==> 134597664
134597636 (") Snubbed
134597648 ABORT_MSG
134597652 ECR
134597656 ERR_ABORTQ
134597660 ERROR
134597664 ;S
i. bar \ snubbed BAR does not halt script -->
i. base? --> 10
( For unbelievers ) i. BASE @ 1 - . --> 9


Create file

sys [ -f /tmp/foo ] && rm /tmp/foo

"/tmp/foo" Ox 755 FCREATE HCLOSE
i. "ls -og /tmp/foo|cut -c1-10" /sys 1 cuu --> -rwxr-xr-x
sys rm /tmp/foo

"/tmp/foo" Ox 644 FCREATE HCLOSE
i. "ls -og /tmp/foo|cut -c1-10" /sys 1 cuu --> -rw-r--r--

-fin-

( Command window (errout) )
"ox" /demo
===
972?
CURRENT and CONTEXT are WRK PREVOC is WRK BASE: 8
Latest: fault HERE : 134597572 UNUSED : 11541
S?: 0 0 134597573
--- CUTTING
===
69?
CURRENT and CONTEXT are WRK PREVOC is WRK BASE: 8
Latest: fault HERE : 134597572 UNUSED : 11541
S?: 6 0 134597574
--- CUTTING
===
fault? MEMORY ACCESS FAULT
CURRENT and CONTEXT are WRK PREVOC is WRK BASE: 10
Latest: fault HERE : 134597572 UNUSED : 11541
S?: empty
--- CUTTING
===
49?
CURRENT and CONTEXT are WRK PREVOC is WRK BASE: 8
Latest: BAR HERE : 134597620 UNUSED : 11529
S?: 4 0 134597622
--- CUTTING

===
bar? ABORTED
CURRENT and CONTEXT are WRK PREVOC is WRK BASE: 16
Latest: BAR HERE : 134597668 UNUSED : 11517
S?: 134597640
--- CUTTING OK

--
me

--- Synchronet 3.22a-Linux NewsLink 1.2

From Newsgroup: comp.lang.forth

sjack <sjack@dontemail.me> wrote:

( Display window (stdout) )

Demo Keep script running in spite of faults

Overview

===
FigForth WARNING set to -1 enables (ABORT) as alternative error
handling. The default for (ABORT) is to perform ABORT but it's
acceptable to replace (ABORT) action with custom user action. In the following demo a custom error handling is assigned to (ABORT) by
action of switch settings. The alternaltive error handling will use
BacForth 'structured cut' to recover from an error (invalid octal
number) and keep the script running.

The beauty of CATCH THROW is that you have an indication of the
exception. For example my QUIT reads from the terminal, until
there is an exception ENDOFPIPE that terminates the session.

If you activate AUTOLOAD a patch is applied to ?ERROR (where system
errors go through). If the errors are 10-12 or 15,16 there is a potential
fix to load a name not find from the library.
So although neither SEE or LOCATE is present in the kernel of ciforth,
starting with the -n option (newby) you can do
SEE LOCATE

and after some whirring you see

: LOCATE
NAME LOCATED
;

There is bound to be read/evaluate/print/loop somewhere in
Forth and QUIT is it, despite the strange name.

Groetjes Albert

--
The glass is half empty. There is no such thing as a free world.
This is the first day of the end of your life.
If you can't beat them, ... too bad.
--- Synchronet 3.22a-Linux NewsLink 1.2

From Newsgroup: comp.lang.forth

Demo Numbers and trys

Numbers

: dnbr ( "numeric<bl>" -- d ) BL WORD HERE NUMBER ;
: nbr ( "numeric<bl>" -- n ) DNBR DROP ;
: dnnbr ( "numeric<bl>" -- d dpl ) DNBR DPL @ ;

i. dnbr 123.45 d. --> 12345
i. nbr 123.45 . --> 12345
i. dnnbr 123.45 dn. --> 123.45

: OX
BASE @ >R
OCTAL NBR [COMPILE] LITERAL
R> BASE ! ; IMMEDIATE

: OY
BASE @ >R
HEX NBR [compile] LITERAL
R> BASE ! ; IMMEDIATE

: DN
BASE @ >R
DECIMAL DNNBR
STATE @ IF REV 3 0 DO [COMPILE] LITERAL LOOP ENDIF
R> BASE ! ; IMMEDIATE

: tcf_end ." TCF_END " 42 . ;

i. Ox 644 . tcf_end --> 420 TCF_END 42
i. Oy abc . tcf_end --> 2748 TCF_END 42
i. Dn 123.45 dn. tcf_end --> 123.45 TCF_END 42
i. hex Dn 1024 dn. tcf_end --> 400 TCF_END 2A
decimal


TRY

DEFER RESET
: TRY
PRO
back
RESET
STATE @ IF '." (?) Stubbed " RDROP ;' EVAL ENDIF
TREK CUT:
CONT ;
--
-errors
{ decimal +voc } {xt} is reset
--
ereset -edump -ecut ' noop ' snapshot !
i. try Ox 755 . tcf_end --> 493 TCF_END 42
i. try Ox 755 . Ox 69 . tcf_end --> 493
69? CUTTING
i. try Ox 755 . Ox 644 . tcf_end --> 493 420 TCF_END 42
--
i. try Oy abc . tcf_end --> 2748 TCF_END 42
i. try Oy 123 . Oy 4o00 . tcf_end --> 291
4o00? CUTTING
i. try Oy 123 . Oy 4000 . tcf_end --> 291 16384 TCF_END 42
--
i. try Dn 12345 dn. tcf_end --> 12345 TCF_END 42
i. try Dn 12345. dn. tcf_end --> 12345. TCF_END 42
i. try Dn 123,45 dn. tcf_end -->
123,45? CUTTING
i. try Dn 123.45 dn. tcf_end --> 123.45 TCF_END 42
--
decimal
--
try : foo ox 755 . ;
i. foo tcf_end --> 493 TCF_END 42
try : bar ox 49 . ;
49? CUTTING
i. bar tcf_end --> (?) Stubbed
--
{fin} +uabort +ecut
..
CURRENT and CONTEXT are WRK PREVOC is WRK BASE: 10
Latest: bar HERE : 134597916 UNUSED : 11455
S?: empty
---

-fin-
OK
--
me

--- Synchronet 3.22a-Linux NewsLink 1.2