commit 2365d19d5372db78d1dbe9b0ecc493d8586d00c5
parent 5e9d3b8fcc67f7c8d7f9e00f219fcb03d66444a2
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 13:51:41 -0400
Through (wnf) and (psufl), move a few words from kernel to boot
Diffstat:
5 files changed, 31 insertions(+), 12 deletions(-)
diff --git a/aliases.txt b/aliases.txt
@@ -35,6 +35,7 @@ in< inrd
[c]? findchar
[]= rangeeq
(wnf) wnf
+(psufl) psufl
' apos
; compstop
: docolon
diff --git a/boot.fs b/boot.fs
@@ -10,6 +10,9 @@
: next compile (next) , ; immediate
: \ 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
@@ -20,6 +23,11 @@
begin 2dup word S= until 2drop ;
: ( S" )" waitw ; immediate
( hello, another comment! )
+: stype >r begin c@+ emit next drop ;
+: _ curword stype S" word not found" stype abort ;
+current to (wnf)
+: _ S" stack underflow" stype abort ;
+current to (psufl)
: <> ( n n -- l h ) 2dup > if swap then ;
: min <> drop ; : max <> nip ;
: fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ;
diff --git a/dusk.asm b/dusk.asm
@@ -103,6 +103,8 @@ curword: resb 6
inptr: resd 1
inrd: resd 1
inrdc: resd 1
+wnf: resd 1
+psufl: resd 1
resd RS_SZ
rs_top:
resd PS_SZ
@@ -120,6 +122,8 @@ _start:
mov dword [inptr], bootsrc
mov dword [inrd], word_bootrd
mov dword [inrdc], word_bootrd
+ mov dword [wnf], word_bye
+ mov dword [psufl], word_bye
jmp word_abort
defword 'bye', 3, word_bye, 0
@@ -127,7 +131,10 @@ defword 'bye', 3, word_bye, 0
mov ebx, 0 ; error code
int 0x80
-defword 'quit', 4, word_quit, word_bye
+defword 'noop', 4, word_noop, word_bye
+ ret
+
+defword 'quit', 4, word_quit, word_noop
cld
mov byte [toflag], 0
mov esp, rs_top
@@ -338,6 +345,13 @@ defword 'to', 2, word_to, word_rs2A
mov byte [toflag], 1
ret
+defword 'to?', 3, word_tocond, word_to
+ xor eax, eax
+ mov al, [toflag]
+ pspush eax
+ mov byte [toflag], 0
+ ret
+
defword '1+', 2, word_inc, word_to
inc dword [ebp]
ret
diff --git a/f2asm.py b/f2asm.py
@@ -110,11 +110,6 @@ def strwr():
s = rdstr()
out(f"db '{s}'\n")
-def slitwr():
- s = rdstr()
- out(f'call word_strlit\n')
- out(f'db {len(s)}, `{s}`\n')
-
def _create_():
newword()
out('call word_cellroutine\n')
@@ -144,7 +139,6 @@ special = {
'\\': _lcomment_,
';': exitwr,
',"': strwr,
- 'S"': slitwr,
'if': _if_,
'then': _then_,
'else': _else_,
diff --git a/xcomp.txt b/xcomp.txt
@@ -4,6 +4,8 @@ sysval compiling
const SPC $20 const CR $0d const LF $0a const BS $08
sysval in>
syscell 'curword curword
+alias (wnf)
+alias (psufl)
: 2drop drop drop ;
: 2dup over over ;
@@ -27,7 +29,6 @@ syscell 'curword curword
: move ( src dst u -- ) ?dup if
>r >A begin ( src ) c@+ Ac!+ next drop then ;
: move, ( a u -- ) here over allot swap move ;
-: stype >r begin c@+ emit next drop ;
: ws? SPC <= ;
: boot< in> c@+ swap to in> ;
alias in<?
@@ -72,7 +73,6 @@ 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 ) ;
-: (wnf) curword stype S" word not found" stype abort ;
: ' word find not if (wnf) then ;
: entry word tuck move, ( len )
current , c, here to current ;
@@ -84,8 +84,10 @@ create tbl-0-f ," 0123456789abcdef"
exit, ;
:imm ; 0 to compiling ;
: : entry xtcomp ;
-: stack? scnt 0< if S" stack underflow" stype abort then ;
+: stack? scnt 0< if (psufl) then ;
: run1 ( -- ) \ interpret next word
- word parse not if
- curword find not if (wnf) then execute stack? then ;
+ to? >r ( save to so that it doesn't mess word/parse/find )
+ word parse if r> if to then else
+ curword find not if (wnf) then
+ r> if to then execute stack? then ;
: mainloop 0 'curword 5 + c! begin run1 again ;
