| \ for backwards compatibility, jaw |
\ for backwards compatibility, jaw |
| require compat/strcomp.fs |
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 |
warnings off |
| |
|
| \ redefinitions of kernel words not present in gforth-0.6.1 |
\ redefinitions of kernel words not present in gforth-0.6.1 |
| over - type cr |
over - type cr |
| line-start @ rawinput @ over - typewhite ." ^" 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 -- } |
: ?print-error { f addr u -- } |
| f ?not? if |
f ?not? if |
| outfile-id >r try |
addr u ['] print-error stderr outfile-execute |
| 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 |
|
| 1 (bye) \ abort |
1 (bye) \ abort |
| endif ; |
endif ; |
| |
|
