--- gforth/prims2x.fs 2006/01/27 10:43:52 1.161 +++ gforth/prims2x.fs 2007/02/24 14:45:53 1.166 @@ -1,6 +1,6 @@ \ converts primitives to, e.g., C code -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -55,6 +55,12 @@ \ for backwards compatibility, jaw require compat/strcomp.fs +[undefined] outfile-execute [if] + : outfile-execute ( ... xt file-id -- ... ) + \ unsafe replacement + outfile-id >r to outfile-id execute r> to outfile-id ; +[then] + warnings off \ redefinitions of kernel words not present in gforth-0.6.1 @@ -138,15 +144,13 @@ $12340000 immarg ! over - type cr line-start @ rawinput @ over - typewhite ." ^" cr ; +: print-error { addr u -- } + filename 2@ type ." :" line @ 0 .r ." : " addr u type cr + print-error-line ; + : ?print-error { f addr u -- } f ?not? if - outfile-id >r try - stderr to outfile-id - filename 2@ type ." :" line @ 0 .r ." : " addr u type cr - print-error-line - 0 - recover endtry - r> to outfile-id throw + addr u ['] print-error stderr outfile-execute 1 (bye) \ abort endif ; @@ -505,8 +509,8 @@ defer inst-stream-f ( -- stack ) ." vm_two" r@ item-stack-type-name type ." 2" r@ item-type @ print-type-prefix ." (" - r@ item-in-index r@ item-stack @ 2dup ." (Cell)" stack-read - ." , " -1 under+ ." (Cell)" stack-read + r@ item-in-index r@ item-stack @ 2dup stack-read + ." , " -1 under+ stack-read ." , " r@ item-name 2@ type ." )" cr rdrop ;