[gforth] / gforth / kernel / errore.fs  

gforth: gforth/kernel/errore.fs


1 : anton 1.1 \ ERRORE.FS English error strings 9may93jaw
2 :    
3 : anton 1.4 \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
4 : anton 1.1
5 :     \ This file is part of Gforth.
6 :    
7 :     \ Gforth is free software; you can redistribute it and/or
8 :     \ modify it under the terms of the GNU General Public License
9 :     \ as published by the Free Software Foundation; either version 2
10 :     \ of the License, or (at your option) any later version.
11 :    
12 :     \ This program is distributed in the hope that it will be useful,
13 :     \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14 :     \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 :     \ GNU General Public License for more details.
16 :    
17 :     \ You should have received a copy of the GNU General Public License
18 :     \ along with this program; if not, write to the Free Software
19 :     \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20 :    
21 :    
22 :     \ The errors are defined by a linked list, for easy adding
23 :     \ and deleting. Speed is not neccassary at this point.
24 :    
25 : pazsan 1.3 AVariable ErrLink \ Linked list entry point
26 : anton 1.1 NIL ErrLink !
27 :    
28 :     decimal
29 :    
30 :     \ error numbers between -256 and -511 represent signals
31 :     \ signals are handled with strsignal
32 :     \ but some signals produce throw-codes > -256, e.g., -28
33 :    
34 :     \ error numbers between -512 and -2047 are for OS errors and are
35 :     \ handled with strerror
36 :    
37 : pazsan 1.3 : >stderr ( -- )
38 :     r> outfile-id >r stderr to outfile-id
39 :     >exec r> to outfile-id ;
40 :    
41 : anton 1.1 : .error ( n -- )
42 : pazsan 1.3 >stderr
43 : anton 1.1 cr ." Error: "
44 :     ErrLink
45 :     BEGIN @ dup
46 :     WHILE
47 :     2dup cell+ @ =
48 : pazsan 1.3 IF
49 :     2 cells + count type drop EXIT THEN
50 : anton 1.1 REPEAT
51 :     drop
52 : jwilke 1.2 [ has? os [IF] ]
53 : anton 1.1 dup -511 -255 within
54 :     IF
55 : pazsan 1.3 256 + negate strsignal type EXIT
56 : anton 1.1 THEN
57 :     dup -2047 -511 within
58 :     IF
59 : pazsan 1.3 512 + negate strerror type EXIT
60 : anton 1.1 THEN
61 :     [ [THEN] ]
62 :     . ;

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help