commit f03106b5b12bb00ae10c0029c5ab5648dbf1cc95
parent 2cd6cab1c1c19db926ebc9b9fd8fe48fea6abc10
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 13:51:40 -0400
Move a bunch of words from kernel to boot.fs
As it is right now, the kernel is pretty much as minimal as it can be.
Diffstat:
2 files changed, 26 insertions(+), 20 deletions(-)
diff --git a/boot.fs b/boot.fs
@@ -1,19 +1,19 @@
: immediate current 1- dup c@ $80 or swap c! ;
: ['] ' litn ; immediate
-: compile ' litn ['] litcall litcall ; immediate
-: [compile] ' litcall ; immediate
+: compile ' litn ['] call, call, ; immediate
+: [compile] ' call, ; immediate
: if [compile] (?br) here 4 allot ; immediate
: then here swap ! ; immediate
: else [compile] (br) here 4 allot here rot ! ; immediate
: begin here ; immediate
: again [compile] (br) , ; immediate
: until [compile] (?br) , ; immediate
+: next [compile] (next) , ; immediate
: \ begin in< LF = until ; immediate
\ hello, this is a comment!
: ," 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
-: foo S" hello" ;
: S= \ sa1 sl1 sa2 sl2 -- f
rot over = if \ same len, s2 s1 l )
[]= else drop 2drop 0 then ;
@@ -21,12 +21,22 @@
begin 2dup word S= until 2drop ;
: ( S" )" waitw ; immediate
( hello, another comment! )
+: <> ( 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 ;
+: .h $f and tbl-0-f + c@ emit ;
+: .x dup >> >> >> >> .h .h ;
+: nl> CR emit LF emit ; : spc> SPC emit ;
: 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 .x spc> S" RS " stype rcnt .x spc>
S" -- " stype stack? psdump ;
+64 value LNSZ
+create in( LNSZ allot
+: in) in( 64 + ;
+: bs? BS over = swap $7f = or ;
: lntype ( ptr c -- ptr+1 f )
dup bs? if ( ptr c )
drop dup in( > if 1- BS emit then spc> BS emit 0
diff --git a/xcomp.txt b/xcomp.txt
@@ -40,15 +40,16 @@ _br_ lblmain
lblcell: r> ;
lblval: r> to? if ! else @ then ;
lblalias: r> to? if ! else @ >r then ;
+
+\ variables
: current _call_ lblval lblcurrent
: here _call_ lblval lblhere
value compiling 0
value SPC $20 value CR $0d value LF $0a value BS $08
-create in(
-," xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
-value LNSZ 64
value in> 6144 \ where boot.fs starts
create 'curword ," xxxxxx"
+
+\ words
: quit _rs0 _br_ lblmain
: abort _ps0 quit
: 2drop drop drop ;
@@ -67,21 +68,13 @@ create 'curword ," xxxxxx"
: = - not ;
: > swap < ;
: 0< <<c nip ; : 0>= 0< not ; : >= < not ; : <= > not ;
-: <> ( n n -- l h ) 2dup > if swap then ;
-: min <> drop ; : max <> nip ; : -^ swap - ;
+: -^ swap - ;
: << <<c drop ;
: >> >>c drop ;
: move ( src dst u -- ) ?dup if
>r >A begin ( src ) c@+ Ac!+ next drop then ;
: move, ( a u -- ) here over allot swap move ;
-: fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ;
-lblhex: ," 0123456789abcdef"
-: .h $f and _i_ lblhex + c@ emit ;
-: .x dup >> >> >> >> .h .h ;
-: nl> CR emit LF emit ; : spc> SPC emit ;
: stype >r begin c@+ emit next drop ;
-: in) in( 64 + ;
-: bs? BS over = swap $7f = or ;
: ws? SPC <= ;
: boot< in> c@+ swap to in> ;
alias in<? boot<
@@ -102,12 +95,13 @@ alias in< boot<
>r 0 begin ( r )
10 * Ac@+ ( r c ) '0' - dup 9 > if
2drop r~ 0 exit then + next ( r ) 1 ;
+create tbl-0-f ," 0123456789abcdef"
: parse ( sa sl -- n? f ) \ *A*
over c@ ''' = if ( sa sl )
3 = if 1+ dup 1+ c@ ''' = if c@ 1 exit then then
drop 0 exit then ( sa sl )
over c@ '$' = if ( sa sl ) 1- >r 1+ >A 0 begin ( r )
- 16 * Ac@+ ( r c ) $20 or _i_ lblhex $10 [c]?
+ 16 * Ac@+ ( r c ) $20 or tbl-0-f $10 [c]?
dup 0< if 2drop r~ 0 exit then + next ( r ) 1 exit then
swap >A dup 1 > Ac@ '-' = and if ( sl )
A+ 1- _ if 0 -^ 1 else 0 then else _ then ;
@@ -124,22 +118,23 @@ alias in< boot<
: (wnf) curword stype S" word not found" stype abort ;
: ' word find not if (wnf) then ;
: litn ( n -- ) _i_ pspushop c, , ;
-: litcall ( n -- ) _i_ callop c, , ;
+: call, ( n -- ) _i_ callop c, , ;
: entry word tuck move, ( len )
current , c, here to current ;
: xtcomp 1 to compiling begin
word parse if litn else curword find if
- dup 1- c@ $80 and ( imm? ) if execute else litcall then
+ dup 1- c@ $80 and ( imm? ) if execute else call, then
else (wnf) then then
compiling not until
_i_ exitop c, ;
: ; 0 to compiling ; immediate
: : entry xtcomp ;
+: create entry _i_ lblcell call, ;
+: value entry _i_ lblval call, , ;
: stack? scnt 0< if S" stack underflow" stype abort then ;
: run1 ( -- ) \ interpret next word
word parse not if
curword find not if (wnf) then execute stack? then ;
-: interpret begin run1 again ;
opwriter r> r>
opwriter >r >r
opwriter r@ r@
@@ -150,6 +145,7 @@ opwriter exit exit
opwriter execute execute
opwriter (br) _br_
opwriter (?br) _cbr_
-lblmain: 0 'curword 5 + c! interpret bye
+opwriter (next) _next_
+lblmain: 0 'curword 5 + c! begin run1 again
: _ lblcurrent: ;
lblhere:
