[gforth] / gforth / kernel / errore.fs  

gforth: gforth/kernel/errore.fs


1 : anton 1.1 \ ERRORE.FS English error strings 9may93jaw
2 :    
3 : anton 1.14 \ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2006 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 : anton 1.15 \ as published by the Free Software Foundation, either version 3
10 : anton 1.1 \ 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 : anton 1.15 \ along with this program. If not, see http://www.gnu.org/licenses/.
19 : anton 1.1
20 :    
21 :     \ The errors are defined by a linked list, for easy adding
22 :     \ and deleting. Speed is not neccassary at this point.
23 :    
24 : jwilke 1.7 require ./io.fs
25 :     require ./nio.fs
26 :    
27 : pazsan 1.3 AVariable ErrLink \ Linked list entry point
28 : anton 1.1 NIL ErrLink !
29 :    
30 :     decimal
31 :    
32 :     \ error numbers between -256 and -511 represent signals
33 :     \ signals are handled with strsignal
34 :     \ but some signals produce throw-codes > -256, e.g., -28
35 :    
36 :     \ error numbers between -512 and -2047 are for OS errors and are
37 :     \ handled with strerror
38 :    
39 : pazsan 1.5 has? OS [IF]
40 : pazsan 1.3 : >stderr ( -- )
41 :     r> outfile-id >r stderr to outfile-id
42 :     >exec r> to outfile-id ;
43 : pazsan 1.5 [THEN]
44 : pazsan 1.3
45 : anton 1.1 : .error ( n -- )
46 : pazsan 1.13 [ has? OS [IF] ]
47 : pazsan 1.3 >stderr
48 : pazsan 1.13 [ [THEN] ]
49 : anton 1.1 ErrLink
50 :     BEGIN @ dup
51 :     WHILE
52 :     2dup cell+ @ =
53 : pazsan 1.3 IF
54 :     2 cells + count type drop EXIT THEN
55 : anton 1.1 REPEAT
56 :     drop
57 : jwilke 1.2 [ has? os [IF] ]
58 : anton 1.1 dup -511 -255 within
59 :     IF
60 : pazsan 1.3 256 + negate strsignal type EXIT
61 : anton 1.1 THEN
62 :     dup -2047 -511 within
63 :     IF
64 : pazsan 1.3 512 + negate strerror type EXIT
65 : anton 1.1 THEN
66 :     [ [THEN] ]
67 : anton 1.8 ." error " dec. ;

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help