| \ ERRORE.FS English error strings 9may93jaw |
\ ERRORE.FS English error strings 9may93jaw |
| |
|
| \ Copyright (C) 1995 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| \ The errors are defined by a linked list, for easy adding |
\ The errors are defined by a linked list, for easy adding |
| \ and deleting. Speed is not neccassary at this point. |
\ and deleting. Speed is not neccassary at this point. |
| |
|
| AVARIABLE ErrLink \ Linked list entry point |
AVariable ErrLink \ Linked list entry point |
| NIL ErrLink ! |
NIL ErrLink ! |
| |
|
| decimal |
decimal |
| \ error numbers between -512 and -2047 are for OS errors and are |
\ error numbers between -512 and -2047 are for OS errors and are |
| \ handled with strerror |
\ handled with strerror |
| |
|
| |
: >stderr ( -- ) |
| |
r> outfile-id >r stderr to outfile-id |
| |
>exec r> to outfile-id ; |
| |
|
| : .error ( n -- ) |
: .error ( n -- ) |
| |
>stderr |
| cr ." Error: " |
cr ." Error: " |
| ErrLink |
ErrLink |
| BEGIN @ dup |
BEGIN @ dup |
| WHILE |
WHILE |
| 2dup cell+ @ = |
2dup cell+ @ = |
| IF 2 cells + count type drop exit THEN |
IF |
| |
2 cells + count type drop EXIT THEN |
| REPEAT |
REPEAT |
| drop |
drop |
| [ has-os [IF] ] |
[ has? os [IF] ] |
| dup -511 -255 within |
dup -511 -255 within |
| IF |
IF |
| 256 + negate strsignal type exit |
256 + negate strsignal type EXIT |
| THEN |
THEN |
| dup -2047 -511 within |
dup -2047 -511 within |
| IF |
IF |
| 512 + negate strerror type exit |
512 + negate strerror type EXIT |
| THEN |
THEN |
| [ [THEN] ] |
[ [THEN] ] |
| . ; |
. ; |
| |
|
