lineno management

This commit is contained in:
Koichi Nakamura 2021-01-10 11:22:10 +09:00
parent 6c2ae48504
commit fbe4a77dc4

View file

@ -1727,6 +1727,7 @@ R/O stdin_ file>fam c!
BUFSIZE allot stdin_ file>rbuf ! BUFSIZE allot stdin_ file>rbuf !
stdin_ dup file>rbuf @ swap file>rbeg ! stdin_ dup file>rbuf @ swap file>rbeg !
stdin_ dup file>rbuf @ swap file>rend ! stdin_ dup file>rbuf @ swap file>rend !
s" <stdin>" stdin_ file>name !
\ Read just 1 byte from stdin to c-buffer \ Read just 1 byte from stdin to c-buffer
:noname ( c-addr u obj -- n ) :noname ( c-addr u obj -- n )
@ -1770,7 +1771,10 @@ stdin_ push-inputstream
\ Rewrite existing functions that reads inputs using inputstream. \ Rewrite existing functions that reads inputs using inputstream.
:noname ( -- c ) :noname ( -- c )
inputstreams @ input>file @ key-file inputstreams @ input>file @ key-file dup '\n' = if
\ increment line count
1 inputstreams @ input>lineno +!
then
; &key ! ; &key !
\ Throw UNEXPECTED-EOF-ERROR \ Throw UNEXPECTED-EOF-ERROR
@ -1783,12 +1787,11 @@ stdin_ push-inputstream
\ Read a word from input stream, return address of the string \ Read a word from input stream, return address of the string
\ and error-code. \ and error-code.
:noname ( -- c-addr e ) :noname ( -- c-addr e )
inputstreams @ input>file @
\ skip leading spaces \ skip leading spaces
0 0
begin begin
drop drop
dup key-file \ ( file c ) key
dup bl <> over '\n' <> and dup bl <> over '\n' <> and
until until
dup EOF = if dup EOF = if
@ -1798,12 +1801,12 @@ stdin_ push-inputstream
word-buffer tuck c! word-buffer tuck c!
1+ 1+
begin begin
\ ( file p ) \ ( p )
over key-file key
dup bl = over '\n' = or over EOF = or if dup bl = over '\n' = or over EOF = or if
drop drop
0 swap c! \ store \0 0 swap c! \ store \0
drop word-buffer success word-buffer success
exit exit
then then
over c! over c!
@ -1872,6 +1875,10 @@ stdin_ push-inputstream
?dup if ?dup if
\ lookup error code \ lookup error code
dup QUIT = if throw then dup QUIT = if throw then
'[' emit inputstreams @ input>file @ file>name @ type ':' emit
inputstreams @ input>lineno @ 0 u.r ." ] " emit
error-list @ error-list @
begin ?dup while begin ?dup while
\ ( error-code error-entry ) \ ( error-code error-entry )