commit fb6c5301406ddb47d940d85e9afee8f0fce84227
parent a85ebfff270dc517c0a2e852c0a0cc754b31961e
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 5 Jun 2022 07:26:57 -0400
Move string literals to lib/core.fs
Diffstat:
4 files changed, 20 insertions(+), 23 deletions(-)
diff --git a/boot.fs b/boot.fs
@@ -9,41 +9,33 @@
: again compile (br) , ; immediate
: until compile (?br) , ; immediate
: next compile (next) , ; immediate
+: code word entry ;
+: create code compile (cell) ;
+: value code compile (val) , ;
+: alias ' code compile (alias) , ;
: \ begin in< LF = until ; immediate
\ hello, this is a comment!
\ By the way, now that I can talk, it's important to note that
\ up until (wnf) and stack? are defined somewhere below, wnf
\ and stack errors will just silently halts (bye).
-: ," begin in< dup '"' = if drop exit then c, again ;
-: S" compile (br) here 4 allot here ," tuck here -^ swap
- here swap ! swap litn litn ; immediate
: S= \ sa1 sl1 sa2 sl2 -- f
rot over = if \ same len, s2 s1 l )
[]= else drop 2drop 0 then ;
: waitw \ sa sl --
begin 2dup word S= until 2drop ;
-: ( S" )" waitw ; immediate
+create _ ')' c,
+: ( _ 1 waitw ; immediate
( hello, another comment! )
-: stype >r begin c@+ emit next drop ;
-: ." [compile] S" compile stype ; immediate
-: abort" [compile] ." compile abort ; immediate
-: _ curword stype S" word not found" stype abort ;
-current to (wnf)
-: _ S" stack underflow" stype abort ;
-current to (psufl)
: fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ;
: allot0 ( n -- ) here over 0 fill allot ;
-: code word entry ;
-: create code compile (cell) ;
-: value code compile (val) , ;
-: alias ' code compile (alias) , ;
\ transform a fstring into a null-terminated string.
create _ $100 allot
: tocstr ( sa sl -- a ) >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, SPC c, 'o' c, 'p' c, 'e' c, 'n' c,
: fopen ( sa sl -- fd )
tocstr 5 ( open ) swap 0 0 ( open cstr noflag O_RDONLY ) lnxcall
- dup 0< if abort" Can't open" then ;
+ dup 0< if _ 10 stype abort then ;
create _ 1 allot
: fread ( fd -- c-or-0 ) 3 ( read ) swap _ 1 lnxcall 1 = if _ c@ else 0 then ;
diff --git a/dusk.asm b/dusk.asm
@@ -108,8 +108,7 @@ curword: resb 0x20 ; 1b len, then contents
inptr: resd 1 ; in>
iinrd: resd 1 ; iin<
inrd: resd 1 ; in<
-wnf: resd 1 ; (wnf)
-psufl: resd 1 ; (psufl)
+stype: resd 1
resd PS_SZ
ps_top:
resd RS_SZ
@@ -129,8 +128,6 @@ _start:
mov dword [inptr], bootsrc
mov dword [iinrd], word_bootrd
mov dword [inrd], word_iinrd
- mov dword [wnf], word_bye
- mov dword [psufl], word_bye
mov eax, SYSCALL_CHDIR
mov ebx, rootfspath
int 0x80
diff --git a/fs/lib/core.fs b/fs/lib/core.fs
@@ -3,6 +3,12 @@
: <> ( n n -- l h ) 2dup > if swap then ;
: min <> drop ; : max <> nip ;
+: ," begin in< dup '"' = if drop exit then c, again ;
+: S" compile (br) here 4 allot here ," tuck here -^ swap
+ here swap ! swap litn litn ; immediate
+: ." [compile] S" compile stype ; immediate
+: abort" [compile] ." compile abort ; immediate
+
: .xh $f and tbl-0-f + c@ emit ;
: .x1 dup 4 rshift .xh .xh ;
: .x2 dup 8 rshift .x1 .x1 ;
diff --git a/xcomp.txt b/xcomp.txt
@@ -5,8 +5,6 @@ const SPC $20 const CR $0d const LF $0a
const BS $08 const EOF $04
sysval in>
syscell 'curword curword
-alias (wnf)
-alias (psufl)
: 2drop drop drop ;
: 2dup over over ;
@@ -75,6 +73,9 @@ create tbl-0-f ," 0123456789abcdef"
A> over wordname ( w a1 a2 u )
[]= if ( w ) r~ 1 r>A exit then then
prevword ?dup not until r~ 0 r>A ( not found ) ;
+: stype >r begin c@+ emit next drop ;
+create _ ," word not found"
+: (wnf) curword stype _ 15 stype abort ;
: ' word find not if (wnf) then ;
: entry ( sa sl -- )
tuck move, ( len ) current , c, here to current ;
@@ -86,7 +87,8 @@ create tbl-0-f ," 0123456789abcdef"
exit, ;
:imm ; 0 to compiling ;
: : word entry xtcomp ;
-: stack? scnt 0< if (psufl) then ;
+create _ ," stack overflow"
+: stack? scnt 0< if _ 15 stype abort then ;
: run1 ( -- ) \ interpret next word
to? >r ( save to so that it doesn't mess word/parse/find )
word parse if r> if to then else
