commit 59ad81bd09c244622d9d90003ddbd4c72c2fe918
parent 23a89641836e49589484cb368c6cfe39e97b0df5
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 13:51:40 -0400
Add boot.fs
It is appended to the binary in source form and is ran at boot time so that
the kernel bootstraps itself into a usable system.
Diffstat:
| M | Makefile | | | 8 | +++++--- |
| M | README.md | | | 4 | ++-- |
| M | asm.py | | | 13 | +++++++++++++ |
| A | boot.fs | | | 10 | ++++++++++ |
| M | dusk.c | | | 2 | +- |
| D | forth.txt | | | 126 | ------------------------------------------------------------------------------- |
| A | xcomp.txt | | | 134 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
7 files changed, 165 insertions(+), 132 deletions(-)
diff --git a/Makefile b/Makefile
@@ -2,12 +2,14 @@ TARGETS = dusk forth.bin
all: $(TARGETS)
-forth.bin: forth.txt asm.py
- ./asm.py forth.txt > $@
+forth.bin: xcomp.txt asm.py boot.fs
+ ./asm.py xcomp.txt > $@
+ truncate -s 6144 $@ # give some breathing space to here
+ cat boot.fs >> $@
dusk: dusk.c ops.txt
$(CC) $(CFLAGS) dusk.c $(LDFLAGS) -o $@
.PHONY: clean
clean:
- rm -r $(TARGETS)
+ rm -f $(TARGETS) memdump
diff --git a/README.md b/README.md
@@ -107,8 +107,8 @@ To build Dusk OS, you need:
* A C99 compiler
* Python 3
-Run `make` and then run `./dusk`. You'll get a prompt. Look at `forth.txt`
-to have an idea of the vocabyulary available. Type `bye` to quit.
+Run `make` and then run `./dusk`. You'll get a prompt. Look at `xcomp.txt` and
+`boot.fs` to have an idea of the vocabyulary available. Type `bye` to quit.
[1]: http://collapseos.org
[2]: http://collapseos.org/why.html
diff --git a/asm.py b/asm.py
@@ -182,6 +182,12 @@ def _value_():
n = litparse(nextt())
intwr(n)
+def _alias_():
+ newword()
+ callwr(labels[b'lblalias'])
+ off = words[nextt()]
+ intwr(off)
+
def spitnativewords():
for name in ops:
if name.startswith(b'_') or name == b';':
@@ -201,6 +207,11 @@ def _compile_():
def _callop_():
intwr(ops[b'_call_'])
+def _immfind_():
+ name = nextt()
+ off = words[name]
+ litwr(off)
+
special = {
b':': newword,
b'(': _comment_,
@@ -216,9 +227,11 @@ special = {
b'next': _next_,
b'create': _create_,
b'value': _value_,
+ b'alias': _alias_,
b'spitnativewords': spitnativewords,
b'compile': _compile_,
b'callop': _callop_,
+ b'[\']': _immfind_,
}
t = nextt()
diff --git a/boot.fs b/boot.fs
@@ -0,0 +1,10 @@
+: immediate current 1- dup c@ $80 or swap c! ;
+: ['] ' litn ; immediate
+: compile ' litn ['] litcall litcall ; immediate
+: begin here ; immediate
+: again compile (br) , ; immediate
+: until compile (?br) , ; immediate
+: \ begin in< LF = until ; immediate
+\ hello, this is a comment!
+: init prompt rdln$ ;
+init
diff --git a/dusk.c b/dusk.c
@@ -90,7 +90,7 @@ static void _next_() {
}
static void _call_() { pushRS(pc+CELLSIZE); _br_(); }
static void ret() { pc = popRS(); }
-static void execute() { pc = pop(); }
+static void execute() { pushRS(pc); pc = pop(); }
static void bye() { running = 0; }
/* memory */
diff --git a/forth.txt b/forth.txt
@@ -1,126 +0,0 @@
-_br_ lblboot
-lblcell: r> ;
-lblval: r> to? if ! else @ then ;
-spitnativewords
-: current _call_ lblval lblcurrent
-: here _call_ lblval lblhere
-create A ," xxxx"
-value SPC $20 value CR $0d value LF $0a value BS $08
-create in(
-," xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
-value LNSZ 64
-value in> 0
-create 'curword ," xxxxxx"
-: quit _rs0 _br_ lblmain
-: abort _ps0 quit
-: exit r~ ;
-: 2drop drop drop ;
-: 2dup over over ;
-: nip swap drop ;
-: tuck swap over ;
-: rot> rot rot ;
-: leave r> r~ 1 >r >r ;
-: A> A @ ; : >A A ! ;
-: A>r r> A> >r >r ; : r>A r> r> >A >r ;
-: A+ A> 1+ >A ; : A- A> 1- >A ;
-: Ac@ A> c@ ; : Ac! A> c! ;
-: Ac@+ Ac@ A+ ; : Ac!+ Ac! A+ ;
-: c@+ dup 1+ swap c@ ;
-: c!+ tuck c! 1+ ;
-: allot here + to here ;
-: , here ! 4 allot ;
-: c, here c! 1 allot ;
-: = - not ;
-: > swap < ;
-: 0< <<c nip ; : 0>= 0< not ; : >= < not ; : <= > not ;
-: <> ( n n -- l h ) 2dup > if swap then ;
-: min <> drop ; : max <> nip ; : -^ 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 <= ;
-: lntype ( ptr c -- ptr+1 f )
- dup bs? if ( ptr c )
- drop dup in( > if 1- BS emit then spc> BS emit 0
- else ( ptr c ) \ non-BS
- dup SPC < if drop dup in) over - 0 fill 1 else
- tuck emit c!+ dup in) = then then ;
-: rdln S" ok" stype nl> in( begin key lntype until drop nl> ;
-: in<? ( -- c-or-0 )
- in> in) < if in> c@+ swap to in> else 0 then ;
-: in< ( -- c ) in<? ?dup not if
- rdln in( to in> SPC then ;
-: in$ in) to in> 'curword 6 0 fill ;
-: toword ( -- ) begin in< ws? not until ;
-: curword ( -- sa sl ) 'curword 1+ @ 'curword c@ ;
-: _ ( f sa sl -- ) 'curword c!+ tuck ! 4 + c! ;
-: word ( -- sa sl )
- 'curword 5 + c@ if curword else
- toword in> 1- 0 ( sa sl ) begin 1+ in<? ws? until then
- ( sa sl ) 2dup 0 rot> _ ;
-: word! 1 rot> _ ;
-: [c]? ( c a u -- i ) \ Guards A
- ?dup not if 2drop -1 exit then A>r over >r >r >A ( c )
- begin dup Ac@+ = if leave then next ( c )
- A- Ac@ = if A> r> - ( i ) else r~ -1 then r>A ;
-: _ ( sl -- n? f ) \ parse unsigned decimal
- >r 0 begin ( r )
- 10 * Ac@+ ( r c ) '0' - dup 9 > if
- 2drop r~ 0 exit then + next ( r ) 1 ;
-: 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]?
- 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 ;
-: []= ( a1 a2 u -- f ) \ Guards A
- ?dup not if 2drop 1 exit then A>r >r >A ( a1 )
- begin Ac@+ over c@ = not if r~ r>A drop 0 exit then 1+ next
- drop r>A 1 ;
-: S= ( sa1 sl1 sa2 sl2 -- f )
- rot over = if ( same len, s2 s1 l ) []=
- else drop 2drop 0 then ;
-: find ( sa sl -- w? f ) \ Guards A
- A>r >r >A current begin ( w R:sl )
- dup 1- c@ $7f and ( wlen ) r@ = if ( w )
- dup r@ - 5 - A> r@ ( w a1 a2 u )
- []= if ( w ) r~ 1 r>A exit then then
- 5 - ( prev field ) @ ?dup not until r~ 0 r>A ( not found ) ;
-: (wnf) curword stype S" word not found" stype abort ;
-: litn compile (n) , ;
-: entry word tuck move, ( len )
- current , c, here to current ;
-: xtcomp begin word S" ;" S= if compile exit exit then
- curword parse if litn else curword find if
- dup 1- c@ <<c nip ( imm? ) if execute else
- _i_ callop c, , then
- else (wnf) then then
- again ;
-: : entry xtcomp ;
-: stack? scnt 0< if S" stack underflow" stype abort then ;
-: 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 ;
-: run1 ( -- ) \ interpret next word
- word parse not if
- curword find not if (wnf) then execute stack? then ;
-: interpret begin run1 again ;
-lblmain: in$ interpret bye
-: boot lblboot: lblcurrent: S" Dusk OS" stype abort
-lblhere:
diff --git a/xcomp.txt b/xcomp.txt
@@ -0,0 +1,134 @@
+_br_ lblmain
+lblcell: r> ;
+lblval: r> to? if ! else @ then ;
+lblalias: r> to? if ! else @ >r then ;
+spitnativewords
+: current _call_ lblval lblcurrent
+: here _call_ lblval lblhere
+create A ," xxxx"
+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"
+: (br) r> @ >r ;
+: (?br) if r> 4 + >r else r> @ >r then ;
+: quit _rs0 _br_ lblmain
+: abort _ps0 quit
+: exit r~ ;
+: 2drop drop drop ;
+: 2dup over over ;
+: nip swap drop ;
+: tuck swap over ;
+: rot> rot rot ;
+: leave r> r~ 1 >r >r ;
+: A> A @ ; : >A A ! ;
+: A>r r> A> >r >r ; : r>A r> r> >A >r ;
+: A+ A> 1+ >A ; : A- A> 1- >A ;
+: Ac@ A> c@ ; : Ac! A> c! ;
+: Ac@+ Ac@ A+ ; : Ac!+ Ac! A+ ;
+: c@+ dup 1+ swap c@ ;
+: c!+ tuck c! 1+ ;
+: allot here + to here ;
+: , here ! 4 allot ;
+: c, here c! 1 allot ;
+: = - not ;
+: > swap < ;
+: 0< <<c nip ; : 0>= 0< not ; : >= < not ; : <= > not ;
+: <> ( n n -- l h ) 2dup > if swap then ;
+: min <> drop ; : max <> nip ; : -^ 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 <= ;
+: lntype ( ptr c -- ptr+1 f )
+ dup bs? if ( ptr c )
+ drop dup in( > if 1- BS emit then spc> BS emit 0
+ else ( ptr c ) \ non-BS
+ dup SPC < if drop dup in) over - 0 fill 1 else
+ tuck emit c!+ dup in) = then then ;
+: rdln S" ok" stype nl> in( begin key lntype until drop nl> ;
+: rdln<? ( -- c-or-0 )
+ in> in) < if in> c@+ swap to in> else 0 then ;
+: rdln< ( -- c ) rdln<? ?dup not if
+ rdln in( to in> SPC then ;
+: boot< in> c@+ swap to in> ;
+alias in<? boot<
+alias in< boot<
+: rdln$ ['] rdln< to in< ['] rdln<? to in<?
+ in) to in> 'curword 6 0 fill ;
+: toword ( -- ) begin in< ws? not until ;
+: curword ( -- sa sl ) 'curword 1+ @ 'curword c@ ;
+: _ ( f sa sl -- ) 'curword c!+ tuck ! 4 + c! ;
+: word ( -- sa sl )
+ 'curword 5 + c@ if curword else
+ toword in> 1- 0 ( sa sl ) begin 1+ in<? ws? until then
+ ( sa sl ) 2dup 0 rot> _ ;
+: word! 1 rot> _ ;
+: [c]? ( c a u -- i ) \ Guards A
+ ?dup not if 2drop -1 exit then A>r over >r >r >A ( c )
+ begin dup Ac@+ = if leave then next ( c )
+ A- Ac@ = if A> r> - ( i ) else r~ -1 then r>A ;
+: _ ( sl -- n? f ) \ parse unsigned decimal
+ >r 0 begin ( r )
+ 10 * Ac@+ ( r c ) '0' - dup 9 > if
+ 2drop r~ 0 exit then + next ( r ) 1 ;
+: 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]?
+ 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 ;
+: []= ( a1 a2 u -- f ) \ Guards A
+ ?dup not if 2drop 1 exit then A>r >r >A ( a1 )
+ begin Ac@+ over c@ = not if r~ r>A drop 0 exit then 1+ next
+ drop r>A 1 ;
+: S= ( sa1 sl1 sa2 sl2 -- f )
+ rot over = if ( same len, s2 s1 l ) []=
+ else drop 2drop 0 then ;
+: find ( sa sl -- w? f ) \ Guards A
+ A>r >r >A current begin ( w R:sl )
+ dup 1- c@ $7f and ( wlen ) r@ = if ( w )
+ dup r@ - 5 - A> r@ ( w a1 a2 u )
+ []= if ( w ) r~ 1 r>A exit then then
+ 5 - ( prev field ) @ ?dup not until r~ 0 r>A ( not found ) ;
+: (wnf) curword stype S" word not found" stype abort ;
+: ' word find not if (wnf) then ;
+: litn ( n -- ) compile (n) , ;
+: litcall ( n -- ) _i_ callop c, , ;
+: entry word tuck move, ( len )
+ current , c, here to current ;
+: xtcomp begin word S" ;" S= if compile exit exit then
+ curword parse if litn else curword find if
+ dup 1- c@ $80 and ( imm? ) if execute else litcall then
+ else (wnf) then then
+ again ;
+: : entry xtcomp ;
+: stack? scnt 0< if S" stack underflow" stype abort then ;
+: 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 ;
+: run1 ( -- ) \ interpret next word
+ word parse not if
+ curword find not if (wnf) then execute stack? then ;
+: interpret begin run1 again ;
+: prompt lblcurrent: S" Dusk OS" stype ;
+lblmain: 0 'curword 5 + c! interpret bye
+lblhere:
