--- gforth/kernel/errore.fs 2006/03/25 18:37:16 1.13 +++ gforth/kernel/errore.fs 2012/06/23 20:38:01 1.17 @@ -1,12 +1,12 @@ \ ERRORE.FS English error strings 9may93jaw -\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003 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,8 +15,7 @@ \ 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ The errors are defined by a linked list, for easy adding @@ -43,26 +42,31 @@ has? OS [IF] >exec r> to outfile-id ; [THEN] -: .error ( n -- ) -[ has? OS [IF] ] - >stderr -[ [THEN] ] +: 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] ] - ." error " dec. ; + 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