commit b9bc71009d66c1a2225d3c2bc5c607970656ac6a
parent 78e80d03d886cf85ba24331ebb7d56ed13f0ba76
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 2 Jun 2022 09:38:46 -0400
cc: begin asm generation
Test with "./dusk < testcc.fs".
Things are getting exciting!
Diffstat:
5 files changed, 41 insertions(+), 14 deletions(-)
diff --git a/boot.fs b/boot.fs
@@ -25,7 +25,8 @@
: ( S" )" waitw ; immediate
( hello, another comment! )
: stype >r begin c@+ emit next drop ;
-: abort" [compile] S" compile stype compile abort ; immediate
+: ." [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 ;
@@ -45,9 +46,9 @@ current to (psufl)
: .S ( -- )
S" SP " stype scnt .x1 spc> S" RS " stype rcnt .x1 spc>
S" -- " stype stack? psdump ;
-: create entry compile (cell) ;
-: value entry compile (val) , ;
-: alias ' entry compile (alias) , ;
+: create word entry compile (cell) ;
+: value word entry compile (val) , ;
+: alias ' word entry compile (alias) , ;
64 value LNSZ
create in( LNSZ allot
: in) in( 64 + ;
diff --git a/fs/cc1.fs b/fs/cc1.fs
@@ -1,8 +1,31 @@
\ C compiler stage 1
-\ Requires cctok.fs and ccast.fs
+\ Requires cctok.fs, ccast.fs and wordtbl.fs
+: ln" [compile] ." compile nl> ; immediate
+\ Generation words take an AST element as a parameter and write the
+\ corresponding code to here.
+: _err ( elem -- ) printelem abort" unexpected element" ;
+: expectastid ( elem id -- elem )
+ over dup not if _err then astid = not if _err then ;
+: expectclose 0 expectastid nextelem ;
+\ All words below have the same sig: elem -- next-or-0
+: genConstant 4 expectastid ." mov eax,0x" dup intdata .x nl> nextelem ;
+: genReturn
+ 3 expectastid nextelem genConstant
+ ln" sub ebp,4"
+ ln" [ebp],eax"
+ expectclose ;
+: genArguments 6 expectastid nextelem expectclose ;
+: genStatements
+ 5 expectastid nextelem genReturn
+ ln" ret"
+ expectclose ;
+: genFunction
+ 2 expectastid ." new entry: " dup strdata stype nl> nextelem
+ genArguments genStatements ;
+: genUnit ( elem -- ) begin ( elem ) nextelem genFunction ?dup until ;
\ Compiles input coming from the cc< alias (defaulting to in<) and writes the
\ result to here. Aborts on error.
-: cc1, ( -- ) begin nextt dup if stype nl> 1 then not until ;
+: cc1, ( -- ) parseast curunit genUnit ;
diff --git a/fs/ccast.fs b/fs/ccast.fs
@@ -45,6 +45,8 @@ create astidnames ,"
: parentelem ( elem -- parent ) 1+ 1+ @ ;
: nextelem ( elem -- next ) 6 + @ ;
: 'data ( elem -- 'data ) 10 + ;
+: intdata ( elem -- n ) 'data @ ;
+: strdata ( elem -- sa sl ) 'data c@+ ;
: newelem ( flags id -- )
here lastelem 6 + ! here to lastelem c, c, activeelem , 0 ,
lastelem haschildren if lastelem to activeelem then ;
@@ -75,7 +77,8 @@ create astidnames ,"
>r 2dup 1 = not if drop _err then c@ r> = not if _err then 2drop ;
: parseConstant ( ta tl -- ) expectConst Constant ;
-: parseReturn ( -- ) _nextt parseConstant _nextt ';' expectChar SeqClose ;
+: parseReturn ( -- )
+ Return _nextt parseConstant _nextt ';' expectChar SeqClose ;
: parseStatements ( -- )
Statements _nextt '{' expectChar
_nextt S" return" S= if parseReturn else _err then
@@ -89,8 +92,8 @@ create astidnames ,"
: printelem ( elem -- )
dup astid idname stype dup flags ( elem flags )
- dup $04 and if ( int data ) '[' emit over 'data @ .x ']' emit then
- $08 and if ( str data ) '[' emit over 'data c@+ stype ']' emit then
+ dup $04 and if ( int data ) '[' emit over intdata .x ']' emit then
+ $08 and if ( str data ) '[' emit over strdata stype ']' emit then
drop ;
: printast ( elem -- ) 1 swap begin ( lvl elem )
dup astid not if ( seqclose ) swap 1- swap then
diff --git a/testcc.fs b/testcc.fs
@@ -2,9 +2,9 @@
f<< wordtbl.fs
f<< cctok.fs
f<< ccast.fs
+f<< cc1.fs
: opentestc S" test.c" fopen not if abort" can't open" then ;
opentestc
' fin< to cc<
-parseast
-curunit printast
+cc1,
bye
diff --git a/xcomp.txt b/xcomp.txt
@@ -75,8 +75,8 @@ create tbl-0-f ," 0123456789abcdef"
[]= if ( w ) r~ 1 r>A exit then then
prevword ?dup not until r~ 0 r>A ( not found ) ;
: ' word find not if (wnf) then ;
-: entry word tuck move, ( len )
- current , c, here to current ;
+: entry ( sa sl -- )
+ tuck move, ( len ) current , c, here to current ;
: xtcomp 1 to compiling begin
word parse if litn else curword find if
dup immediate? if execute else call, then
@@ -84,7 +84,7 @@ create tbl-0-f ," 0123456789abcdef"
compiling not until
exit, ;
:imm ; 0 to compiling ;
-: : entry xtcomp ;
+: : word entry xtcomp ;
: stack? scnt 0< if (psufl) then ;
: run1 ( -- ) \ interpret next word
to? >r ( save to so that it doesn't mess word/parse/find )
