commit 7b2dc813c3077c7929e995c0b0fb3d8fcf712d37
parent 38d27baf56b342e46e6f6728619181b7a5d49958
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 28 Jun 2022 14:43:46 -0400
Simplify I/O structures
Create a new "word?" word, which unlike "word", doesn't block on EOF.
Then, make fload host its own interpret loop.
Diffstat:
9 files changed, 53 insertions(+), 32 deletions(-)
diff --git a/boot.fs b/boot.fs
@@ -30,33 +30,25 @@
1+ c@ ')' = if exit then else drop then
again ; immediate
( hello, another comment! )
-: c@+ dup 1+ swap c@ ;
-: c!+ tuck c! 1+ ;
-\ transform a fstring into a null-terminated string.
-create _ $100 allot
-: tocstr ( str -- a ) c@+ >r _ r@ move 0 _ r> + c! _ ;
: fclose ( fd -- ) 6 ( close ) swap 0 0 ( close fd 0 0 ) lnxcall drop ;
create _ 'C' c, 'a' c, 'n' c, ''' c, 't' c, $20 c, 'o' c, 'p' c, 'e' c, 'n' c,
: zfopen ( zfname -- fd )
5 ( open ) swap 0 0 ( open cstr noflag O_RDONLY ) lnxcall
dup 0< if _ 10 rtype abort then ;
-: fopen ( fname -- fd )
- tocstr zfopen ;
create _ 1 allot
: fread ( fd -- c-or-0 ) 3 ( read ) swap _ 1 lnxcall 1 = if _ c@ else 0 then ;
-create _fds $20 allot \ 8 levels max
-_fds value 'curfd
+0 value curfd \ file descriptor of the file currently being read
+0 value floaded \ address of the current "loaded file" structure
0 value fecho
-: >fd ( fd -- ) 'curfd 4 + tuck ! to 'curfd ;
-: fd@ ( -- fd ) 'curfd @ ;
-: fd~ ( -- ) fd@ fclose 'curfd 4 - to 'curfd ;
-: f< ( -- c-or-0 ) fd@ fread ;
-: fin< f< ?dup not if ( EOF )
- fd~ fd@ not if ['] iin< to in< then $20 then
- fecho if dup emit then ;
-0 value floaded
-: fload here >r floaded , dup c@ 1+ move, 0 c,
- r> dup to floaded 5 + zfopen >fd ['] fin< to in< ;
+: f< ( -- c ) curfd fread fecho if dup emit then ;
+: fload ( fname -- )
+ floaded here to floaded , ( fname )
+ dup c@ 1+ move, 0 c, ( )
+ curfd >r
+ floaded 5 + zfopen to curfd
+ to' in< @ >r ['] f< to in<
+ begin word? ?dup if runword 0 else 1 then until
+ r> to in< curfd fclose r> to curfd ;
: f<< word fload ;
f<< init.fs
diff --git a/dusk.asm b/dusk.asm
@@ -82,6 +82,7 @@ bootsrc: incbin "boot.fs"
rootfspath: db "fs", 0
wnfstr: db " word not found"
uflwstr: db "stack underflow"
+wordexpstr: db "word expected"
SECTION .text
GLOBAL _start
@@ -109,7 +110,7 @@ defword 'noop', 4, word_noop
defword 'main', 4, word_main
sysalias main
-
+
defword 'quit', 4, word_quit
cld
mov dword [toptr], 0
@@ -634,6 +635,7 @@ defword '(wnf)', 5, word_wnf
call _rtype_loop
mov ecx, 15
mov esi, wnfstr
+_errmsg:
call _rtype_loop
jmp word_abort
@@ -642,16 +644,15 @@ defword 'stack?', 6, word_stackcond
jna _ret
mov ecx, 15
mov esi, uflwstr
- call _rtype_loop
- jmp word_abort
+ jmp _errmsg
; ( -- str )
defword 'curword', 7, word_curword
pspush curword
ret
-; ( -- str )
-defword 'word', 4, word_word
+; ( -- str-or-0 )
+defword 'word?', 5, word_wordcond
; save toptr so that it doesn't mess [inrd], which would be calling a word
; with to semantics
push dword [toptr]
@@ -659,6 +660,8 @@ defword 'word', 4, word_word
_word_loop1:
call [inrd] ; ( -- c )
pspop eax
+ cmp eax, 0x05 ; is EOF?
+ jc _word_eof
cmp eax, 0x21 ; is ws?
jc _word_loop1
mov ebx, curword+1
@@ -676,6 +679,19 @@ _word_loop2:
mov [curword], bl
pspush curword
ret
+_word_eof:
+ pop dword [toptr]
+ pspush 0
+ ret
+
+; ( -- str-or-0 )
+defword 'word', 4, word_word
+ call word_wordcond
+ test dword [ebp], -1
+ jnz word_noop
+ mov ecx, 13
+ mov esi, wordexpstr
+ jmp _errmsg
; ( str -- n? f ) esi=sa ecx=sl
_parse_c:
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -4,6 +4,7 @@
?f<< lib/wordtbl.fs
?f<< lib/xdict.fs
?f<< asm.fs
+?f<< cc/io.fs
?f<< cc/vm.fs
?f<< cc/tok.fs
?f<< cc/type.fs
diff --git a/fs/cc/cc1.fs b/fs/cc/cc1.fs
@@ -6,3 +6,4 @@
: cc1, ( -- )
xhere$ xhere[ parseast curunit _debug if dup printast nl> then ]xhere
gennode ;
+: cc1<< ( -- ) ccopen cc1, ccclose ;
diff --git a/fs/cc/io.fs b/fs/cc/io.fs
@@ -0,0 +1,9 @@
+\ C compiler I/O words
+
+0 value ccfd
+: cc< ccfd fread ;
+0 value putback
+: _cc< ( -- c ) putback ?dup if 0 to putback else cc< then ;
+: ccopen word fopen to ccfd ;
+: ccclose ccfd fclose 0 to ccfd ;
+
diff --git a/fs/cc/tok.fs b/fs/cc/tok.fs
@@ -39,10 +39,7 @@ create symbols2 ," <=>===!=&&||++---><<>>+=-=*=/=%=&=^=|=/**///"
: is<<>>? ( c1 c2 -- f )
dup '<' = over '>' = or rot> ( f1 c1 c2 ) = and ( f ) ;
-alias in< cc<
-0 value putback
: _err abort" tokenization error" ;
-: _cc< ( -- c ) putback ?dup if 0 to putback else cc< then ;
\ is c a proper 1st char for an identifier
create _ 6 c, ," AZaz__"
: identifier1st? ( c -- f ) _ rmatch ;
diff --git a/fs/lib/core.fs b/fs/lib/core.fs
@@ -10,6 +10,8 @@
: does> r> ( exit current definition ) current 5 + ! ;
\ Memory
+: c@+ dup 1+ swap c@ ;
+: c!+ tuck c! 1+ ;
: Ac@+ Ac@ A+ ;
: Ac!+ Ac! A+ ;
: fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ;
@@ -103,6 +105,12 @@ create _ ," KMG"
nip swap 1+ repeat ( lvl sz )
. ?dup if 1- _ + c@ emit then 'B' emit ;
+\ File I/O
+\ transform a fstring into a null-terminated string.
+create _ $100 allot
+: tocstr ( str -- a ) c@+ >r _ r@ move 0 _ r> + c! _ ;
+: fopen ( fname -- fd ) tocstr zfopen ;
+
\ Autoloading
\ entries in the floaded list have both a length byte and
\ a nul termination byte. the nul termination is used only
@@ -134,4 +142,3 @@ create _ ," KMG"
\ doc comment placeholder
alias \ \\
-
diff --git a/fs/tests/cc/ast.fs b/fs/tests/cc/ast.fs
@@ -2,8 +2,7 @@
?f<< cc/cc.fs
testbegin
\ Tests for the C compiler AST
-: _parse S" tests/cc/test.c" fopen >fd ['] f< to cc< parseast ;
-_parse
+ccopen tests/cc/test.c parseast ccclose
curunit firstchild dup nodeid AST_FUNCTION #eq ( fnode )
dup ast.func.name S" retconst" s= #
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -2,8 +2,7 @@
?f<< cc/cc.fs
testbegin
\ Tests for the C compiler
-: _cc S" tests/cc/test.c" fopen >fd ['] f< to cc< cc1, ;
-_cc
+cc1<< tests/cc/test.c
retconst 42 #eq
neg -42 #eq
bwnot $ffffffd5 #eq
