--- gforth/kernel/errore.fs 2007/12/31 18:40:26 1.15 +++ gforth/kernel/errore.fs 2012/08/09 23:58:53 1.19 @@ -1,6 +1,6 @@ \ ERRORE.FS English error strings 9may93jaw -\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2006 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. @@ -38,30 +38,35 @@ decimal 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 -- ) -[ 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