[gforth] / gforth / kernel / errore.fs  

gforth: gforth/kernel/errore.fs


1 : anton 1.1 \ ERRORE.FS English error strings 9may93jaw
2 :    
3 : anton 1.11 \ Copyright (C) 1995,1996,1997,1998,1999,2000 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 : anton 1.10 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20 : anton 1.1
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 : jwilke 1.7 require ./io.fs
26 :     require ./nio.fs
27 :    
28 : pazsan 1.3 AVariable ErrLink \ Linked list entry point
29 : anton 1.1 NIL ErrLink !
30 :    
31 :     decimal
32 :    
33 :     \ error numbers between -256 and -511 represent signals
34 :     \ signals are handled with strsignal
35 :     \ but some signals produce throw-codes > -256, e.g., -28
36 :    
37 :     \ error numbers between -512 and -2047 are for OS errors and are
38 :     \ handled with strerror
39 :    
40 : pazsan 1.5 has? OS [IF]
41 : pazsan 1.3 : >stderr ( -- )
42 :     r> outfile-id >r stderr to outfile-id
43 :     >exec r> to outfile-id ;
44 : pazsan 1.5 [ELSE]
45 :     : >stderr ;
46 :     [THEN]
47 : pazsan 1.3
48 : anton 1.1 : .error ( n -- )
49 : pazsan 1.3 >stderr
50 : anton 1.1 ErrLink
51 :     BEGIN @ dup
52 :     WHILE
53 :     2dup cell+ @ =
54 : pazsan 1.3 IF
55 :     2 cells + count type drop EXIT THEN
56 : anton 1.1 REPEAT
57 :     drop
58 : jwilke 1.2 [ has? os [IF] ]
59 : anton 1.1 dup -511 -255 within
60 :     IF
61 : pazsan 1.3 256 + negate strsignal type EXIT
62 : anton 1.1 THEN
63 :     dup -2047 -511 within
64 :     IF
65 : pazsan 1.3 512 + negate strerror type EXIT
66 : anton 1.1 THEN
67 :     [ [THEN] ]
68 : anton 1.8 ." error " dec. ;

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help