commit 1be0dad4a1c343191f769b9341170508a187977b
parent 293639aa6cc84f2bbe436036d81a74492dc57dea
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 28 Jun 2022 16:37:45 -0400
Extract a few words from core into other units
It felt crowded in core.fs
Diffstat:
10 files changed, 85 insertions(+), 81 deletions(-)
diff --git a/boot.fs b/boot.fs
@@ -42,7 +42,7 @@ create _ 1 allot
curfd >r
floaded 5 + zfopen to curfd
to' in< @ >r ['] f< to in<
- begin word? ?dup if runword 0 else 1 then until
+ begin maybeword ?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
@@ -645,7 +645,7 @@ defword 'curword', 7, word_curword
ret
; ( -- str-or-0 )
-defword 'word?', 5, word_wordcond
+defword 'maybeword', 9, word_maybeword
; save toptr so that it doesn't mess [inrd], which would be calling a word
; with to semantics
push dword [toptr]
@@ -679,7 +679,7 @@ _word_eof:
; ( -- str-or-0 )
defword 'word', 4, word_word
- call word_wordcond
+ call word_maybeword
test dword [ebp], -1
jnz word_noop
mov ecx, 13
diff --git a/fs/init.fs b/fs/init.fs
@@ -1,8 +1,12 @@
\ Initialization layer. Called at the end of boot.fs
f<< lib/core.fs
+f<< lib/dict.fs
f<< lib/annotate.fs
f<< sys/doc.fs
f<< sys/scratch.fs
+f<< lib/file.fs
+f<< lib/nfmt.fs
+f<< lib/diag.fs
f<< sys/xhere.fs
f<< sys/rdln.fs
: init S" Dusk OS" stype nl> .free rdln$ ;
diff --git a/fs/lib/annotate.fs b/fs/lib/annotate.fs
@@ -1,3 +1,5 @@
+\ Annotations
+\ requires lib/dict
: (annotate) ( w -- w' )
current dup preventry to current >r
dup preventry r@ preventry!
diff --git a/fs/lib/core.fs b/fs/lib/core.fs
@@ -36,10 +36,10 @@
: =><= ( n l h -- f ) over - rot> ( h n l ) - >= ;
\ Emitting
-\ emit all chars of "str"
$20 const SPC $0d const CR $0a const LF
$08 const BS $04 const EOF
: nl> CR emit LF emit ; : spc> SPC emit ;
+\ emit all chars of "str"
: stype ( str -- ) c@+ rtype ;
: ," begin in< dup '"' = if drop exit then c, again ;
: S" ( comp: -- ) ( not-comp: -- str )
@@ -79,78 +79,5 @@ alias else endof immediate
\ Return whether strings s1 and s2 are equal
: s= ( s1 s2 -- f ) over c@ 1+ []= ;
-\ Dictionary
-: preventry ( w -- w ) 5 - @ ;
-: preventry! ( w w -- ) 5 - ! ;
-: wordlen ( w -- len ) 1- c@ $3f and ;
-: wordname[] ( w -- sa sl )
- dup wordlen swap 5 - over - ( sl sa ) swap ;
-
-: word? ( w -- f ) wordname[] if c@ 127 = not else drop 0 then ;
-: (prevword) ( w -- w ) begin dup while dup word? not while preventry repeat then ;
-: prevword ( w -- w ) preventry (prevword) ;
-: lastword ( -- w ) current (prevword) ;
-: .word ( w -- ) wordname[] rtype ;
-: words ( -- )
- lastword begin dup while dup .word spc> prevword repeat drop ;
-
-
-\ Number formatting
-\ hexadecimal
-create _ ," 0123456789abcdef"
-: .xh $f and _ + c@ emit ;
-: .x1 dup 4 rshift .xh .xh ;
-: .x2 dup 8 rshift .x1 .x1 ;
-: .x ( n -- ) dup 16 rshift .x2 .x2 ;
-\ decimal
-: _ 10 /mod ( r q ) ?dup if _ then '0' + emit ;
-: . ( n -- )
- ?dup not if
- '0' emit else
- dup 0< if '-' emit 0 -^ _ else _ then
- then ;
-\ size
-create _ ," KMG"
-: .sz ( size-in-bytes -- )
- 0 begin ( sz lvl )
- swap 1024 /mod ( lvl r q ) ?dup while
- 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
-\ by the linux syscall, and may be removed in the future.
-
-: floaded? ( str -- f )
- floaded begin dup while 2dup 4 +
- s= if 2drop 1 exit then @ repeat 2drop 0 ;
-: .floaded floaded begin dup while dup 4 + stype nl> @ repeat drop ;
-: ?f<< word dup floaded? if drop else fload then ;
-
-\ Diagnostic
-: psdump scnt not if exit then
- scnt >A begin dup .x spc> >r scnt not until
- begin r> scnt A> = until ;
-: .S ( -- )
- S" SP " stype scnt .x1 spc> S" RS " stype rcnt .x1 spc>
- S" -- " stype stack? psdump ;
-: .free
- here ['] 2drop ( first word in boot.fs ) - .sz ." used "
- heremax here - .sz ." free" ;
-
-: dump ( a -- ) \ dump 8 lines of data after "a"
- A>r >A 8 >r begin
- ':' emit A> dup .x spc> ( a )
- 8 >r begin Ac@+ .x1 Ac@+ .x1 spc> next ( a ) >A
- 16 >r begin Ac@+ dup SPC - $5e > if drop '.' then emit next
- nl> next r>A ;
-
\ doc comment placeholder
alias \ \\
diff --git a/fs/lib/diag.fs b/fs/lib/diag.fs
@@ -0,0 +1,17 @@
+\ Diagnostic tools
+: psdump scnt not if exit then
+ scnt >A begin dup .x spc> >r scnt not until
+ begin r> scnt A> = until ;
+: .S ( -- )
+ S" SP " stype scnt .x1 spc> S" RS " stype rcnt .x1 spc>
+ S" -- " stype stack? psdump ;
+: .free
+ here ['] 2drop ( first word in boot.fs ) - .sz ." used "
+ heremax here - .sz ." free" ;
+
+: dump ( a -- ) \ dump 8 lines of data after "a"
+ A>r >A 8 >r begin
+ ':' emit A> dup .x spc> ( a )
+ 8 >r begin Ac@+ .x1 Ac@+ .x1 spc> next ( a ) >A
+ 16 >r begin Ac@+ dup SPC - $5e > if drop '.' then emit next
+ nl> next r>A ;
diff --git a/fs/lib/dict.fs b/fs/lib/dict.fs
@@ -0,0 +1,14 @@
+\ Dictionary
+: preventry ( w -- w ) 5 - @ ;
+: preventry! ( w w -- ) 5 - ! ;
+: wordlen ( w -- len ) 1- c@ $3f and ;
+: wordname[] ( w -- sa sl )
+ dup wordlen swap 5 - over - ( sl sa ) swap ;
+
+: word? ( w -- f ) wordname[] if c@ 127 = not else drop 0 then ;
+: (prevword) ( w -- w ) begin dup while dup word? not while preventry repeat then ;
+: prevword ( w -- w ) preventry (prevword) ;
+: lastword ( -- w ) current (prevword) ;
+: .word ( w -- ) wordname[] rtype ;
+: words ( -- )
+ lastword begin dup while dup .word spc> prevword repeat drop ;
diff --git a/fs/lib/file.fs b/fs/lib/file.fs
@@ -0,0 +1,17 @@
+\ 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
+\ by the linux syscall, and may be removed in the future.
+
+: floaded? ( str -- f )
+ floaded begin dup while 2dup 4 +
+ s= if 2drop 1 exit then @ repeat 2drop 0 ;
+: .floaded floaded begin dup while dup 4 + stype nl> @ repeat drop ;
+: ?f<< word dup floaded? if drop else fload then ;
+
diff --git a/fs/lib/nfmt.fs b/fs/lib/nfmt.fs
@@ -0,0 +1,23 @@
+\ Number formatting
+\ hexadecimal
+create _ ," 0123456789abcdef"
+: .xh $f and _ + c@ emit ;
+: .x1 dup 4 rshift .xh .xh ;
+: .x2 dup 8 rshift .x1 .x1 ;
+\\ print top of stack in hexadecimal
+: .x ( n -- ) dup 16 rshift .x2 .x2 ;
+\ decimal
+: _ 10 /mod ( r q ) ?dup if _ then '0' + emit ;
+: . ( n -- )
+ ?dup not if
+ '0' emit else
+ dup 0< if '-' emit 0 -^ _ else _ then
+ then ;
+\ size
+create _ ," KMG"
+: .sz ( size-in-bytes -- )
+ 0 begin ( sz lvl )
+ swap 1024 /mod ( lvl r q ) ?dup while
+ nip swap 1+ repeat ( lvl sz )
+ . ?dup if 1- _ + c@ emit then 'B' emit ;
+
diff --git a/fs/sys/doc.fs b/fs/sys/doc.fs
@@ -1,6 +1,6 @@
create doc-magic 2 c, 127 c, 'D' c,
-: _ doc-magic entry begin in< dup c, $0a = until ;
+: _ doc-magic entry begin in< dup c, LF = until ;
' _ to \\
: add-doc ( w -- )
@@ -9,12 +9,12 @@ create doc-magic 2 c, 127 c, 'D' c,
: .doc ( w -- )
preventry dup word? not if dup .doc then
dup doc-magic has-name? if
- begin c@+ dup emit $0a = until
+ begin c@+ dup emit LF = until
then drop ;
: doc ' .doc ;
-\\ print top of stack in hexadecimal
-' .x add-doc
+\\ create a new constant
+' const add-doc
