--- gforth/kernel/errore.fs 1998/08/29 20:46:14 1.3 +++ gforth/kernel/errore.fs 2012/08/09 23:58:53 1.19 @@ -1,12 +1,12 @@ \ ERRORE.FS English error strings 9may93jaw -\ Copyright (C) 1995 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2006,2007 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,13 +15,15 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ The errors are defined by a linked list, for easy adding \ and deleting. Speed is not neccassary at this point. +require ./io.fs +require ./nio.fs + AVariable ErrLink \ Linked list entry point NIL ErrLink ! @@ -34,29 +36,37 @@ decimal \ error numbers between -512 and -2047 are for OS errors and are \ handled with strerror +has? OS [IF] : >stderr ( -- ) - r> outfile-id >r stderr to outfile-id + r> outfile-id >r debug-fid to outfile-id >exec r> to outfile-id ; +[THEN] -: .error ( n -- ) - >stderr - cr ." Error: " +: error$ ( n -- addr u ) \ gforth + \G converts an error to a string ErrLink BEGIN @ dup WHILE 2dup cell+ @ = IF - 2 cells + count type drop EXIT THEN + 2 cells + count rot drop EXIT THEN REPEAT drop [ has? os [IF] ] dup -511 -255 within IF - 256 + negate strsignal type EXIT + 256 + negate strsignal EXIT THEN dup -2047 -511 within IF - 512 + negate strerror type EXIT + 512 + negate strerror EXIT THEN [ [THEN] ] - . ; + base @ >r decimal + s>d tuck dabs <# #s rot sign s" error #" holds #> r> base ! ; + +: .error ( n -- ) +[ has? OS [IF] ] + >stderr +[ [THEN] ] + error$ type ; \ No newline at end of file