commit 41f4b9b1767dcb8b3586727620afe7062e6c2e30
parent 03a6b7eb0ca125020da60ec25891cd279da1d189
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 9 Oct 2022 15:06:53 -0400
cc: write temporary data to CC-specific scratchpads
This removes the need for sys/xhere, which was removed. This also open the door
for more fine-grained choices between temporary and permanent data, which will
be useful for data structures that would be persistent in memory.
Diffstat:
9 files changed, 44 insertions(+), 60 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -8,6 +8,12 @@
?f<< cc/macro.fs
?f<< cc/type.fs
+\ When compiling a C unit, we need to keep its whole AST in memory at once and
+\ this can be a little big. For reference, the AST for app/cos/cvm.c requires
+\ 32 KB of memory.
+32 $400 * Scratchpad :new structbind Scratchpad _pad
+0 to _pad allowrollover
+
: _err ( -- ) abort" ast error" ;
: _assert ( f -- ) not if _err then ;
@@ -17,9 +23,9 @@
\ This dictionary below contain global symbols of the current unit
create symbols 0 , 0 c, \ this is a dict link
-: addSymbol ( node name -- ) symbols swap entry , ;
+: addSymbol ( node name -- ) symbols swap _pad :entry _pad :, ;
: findSymbol ( name -- node-or-0 ) symbols find dup if @ then ;
-: ccast$ 0 symbols ! ;
+: ccast$ _pad :reset 0 to curunit 0 symbols ! ;
\ Unary operators
7 const UOPSCNT
@@ -82,6 +88,7 @@ create bopsprectbl BOPSCNT nc,
0 value curstatic \ is current definition "static"?
extends Node struct[ ASTNode
+ : :new SZ _pad :[ Node :new _pad :] drop ;
]struct
extends ASTNode struct[ Declare
@@ -90,7 +97,7 @@ extends ASTNode struct[ Declare
: :new ( ctype -- node )
AST_DECLARE ASTNode :new ( ctype node )
- swap ( ctype ) , curstatic ( flags ) , ;
+ swap ( ctype ) _pad :, curstatic ( flags ) _pad :, ;
: :name ctype CType name ;
\ Number of bytes required to hold this variable declaration in memory.
@@ -128,7 +135,7 @@ extends ASTNode struct[ Declarations
extends ASTNode struct[ FuncSig
sfield rettype
- : :new ( type -- node ) AST_FUNCSIG ASTNode :new swap , ;
+ : :new ( type -- node ) AST_FUNCSIG ASTNode :new swap _pad :, ;
]struct
extends ASTNode struct[ Function
@@ -138,7 +145,7 @@ extends ASTNode struct[ Function
: :new ( name -- node )
AST_FUNCTION ASTNode :new ( name node )
- 0 ( address ) , curstatic ( flags ) , swap s, ;
+ 0 ( address ) _pad :, curstatic ( flags ) _pad :, swap _pad :s, ;
: :sig ( self -- anode ) firstchild dup id AST_FUNCSIG = _assert ;
: :stmts ( self -- snode ) :sig nextsibling dup id AST_STATEMENTS = _assert ;
@@ -151,7 +158,7 @@ extends ASTNode struct[ Function
extends ASTNode struct[ Constant
sfield value
- : :new ( n -- node ) AST_CONSTANT ASTNode :new swap , ;
+ : :new ( n -- node ) AST_CONSTANT ASTNode :new swap _pad :, ;
]struct
\ Result of the last "identfind" call
@@ -159,7 +166,7 @@ extends ASTNode struct[ Constant
extends ASTNode struct[ Ident
SZ &+ name
- : :new ( name -- node ) AST_IDENT ASTNode :new swap s, ;
+ : :new ( name -- node ) AST_IDENT ASTNode :new swap _pad :s, ;
: :finddecl ( self -- dnode-or-fnode-or-0 )
dup name dup rot AST_FUNCTION swap Node :findparent ( name name fnode )
@@ -169,7 +176,7 @@ extends ASTNode struct[ Ident
extends ASTNode struct[ Op
sfield opid
- : :new ( opid id -- node ) Node :new swap , ;
+ : :new ( opid id -- node ) ASTNode :new swap _pad :, ;
]struct
struct+[ ASTNode
@@ -221,7 +228,7 @@ extends ASTNode struct[ StrLit
extends ASTNode struct[ Arrow
SZ &+ name
- : :new AST_ARROW ASTNode :new swap s, ;
+ : :new AST_ARROW ASTNode :new swap _pad :s, ;
]struct
\ Macro shortcuts
@@ -344,8 +351,8 @@ alias noop parseFactor ( tok -- node ) \ forward declaration
else ( tok ) parseExpression nextt ')' expectChar then
endof
'"' of isChar?^ ( )
- StrLit :new here 0 c, ['] ," with-stdin<
- here over - 1- swap c! ( node )
+ StrLit :new $100 _pad :[ here 0 c, ['] ," with-stdin<
+ here over - 1- swap c! _pad :] drop ( node )
endof
S" pspop" of s= ( )
nextt '(' expectChar nextt ')' expectChar
@@ -515,4 +522,5 @@ current to parseStatement
: newparseunit ( -- unit ) AST_UNIT ASTNode :new dup to curunit ;
: parseast ( -- )
newparseunit
- begin ( unode ) nextt? ?dup while over swap parseUnit repeat drop ;
+ begin ( unode ) nextt? ?dup while over swap parseUnit repeat drop
+ _debug if nl> ." used pad space for AST: " _pad :usedsz .x nl> then ;
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -1,5 +1,4 @@
\ C compiler
-require sys/xhere.fs
1 value _debug
?f<< /cc/vm/vm.fs
?f<< /cc/ttr.fs
@@ -11,13 +10,13 @@ require sys/xhere.fs
\ Compiles input coming from the stdin alias and writes the
\ result to here. Aborts on error.
: cc1, ( -- )
- cctypes$ ccast$ xhere$ xhere[
+ cctypes$ ccast$
parseast _debug if curunit printast nl> then
curunit trnode _debug if curunit printast nl> then
- ]xhere curunit gennode ;
+ curunit gennode ;
: :cfunc
- cctypes$ ccast$ xhere$ xhere[ newparseunit nextt parseUnit ]xhere
+ cctypes$ ccast$ newparseunit nextt parseUnit
curunit Node firstchild dup _assert ( node )
_debug if dup printast nl> then
dup trnode _debug if dup printast nl> then gennode ;
diff --git a/fs/cc/tok.fs b/fs/cc/tok.fs
@@ -1,9 +1,9 @@
\ C compiler tokenization
-\ Throughout the CC code, "tok" means a Token structure, which is:
-\ TODO: actually implement this. As of now, tok is the string that was read.
-\ 1b token type id
-\ xb string having been read
+\ Many tokens can be used at once, but they are not supposed to be kept in the
+\ long term. When the name needs to be kept around, it must be copied elsewhere.
+\ For this reason, our token pad is small.
+$400 Scratchpad :new structbind Scratchpad _pad
64 const MAXTOKSZ
0 const TOK_KEYWORD
@@ -60,7 +60,7 @@ create _ 10 c, ," 09AZaz__$$"
( c ) else ( EOF ) drop 0 then ;
: _writesym ( c3? c2? c1 len -- str )
- 4 syspad :allot dup >r ( c3? c2? c1 len a )
+ 4 _pad :allot dup >r ( c3? c2? c1 len a )
over >r c!+ ( c a ) begin c!+ next drop r> ( str ) ;
\ Returns the next token as a string or 0 when there's no more token to consume.
@@ -88,7 +88,7 @@ create _ 10 c, ," 09AZaz__$$"
endof
of ident-or-lit? \ identifier or number literal
[ -4 [rcnt] ! ] \ V1=c
- MAXTOKSZ syspad :allot dup >r >r \ V2=tok V3=a
+ MAXTOKSZ _pad :allot dup >r >r \ V2=tok V3=a
0 8b to!+ V3 ( len placeholder ) V1 begin ( c )
8b to!+ V3 stdin dup ident-or-lit? not until StdIn IO :putback
r> ( a ) r> ( a tok ) tuck 1+ - ( tok len ) over c!
diff --git a/fs/lib/scratch.fs b/fs/lib/scratch.fs
@@ -12,14 +12,16 @@
struct[ Scratchpad
sfield size
sfield ptr
+ sfield allowrollover
SZ &+ :buf(
: :reset ( self -- ) dup :buf( swap to ptr ;
- : :new ( size -- pad ) here over , 0 , swap allot dup :reset ;
+ : :new ( size -- pad ) here over , 0 , 1 , swap allot dup :reset ;
: :)buf ( self -- a ) dup :buf( swap size + ;
- : :usedsz dup ptr over :buf( - ;
+ : :usedsz dup ptr swap :buf( - ;
: :allot ( n self -- a )
- dup >r ptr over + r@ :)buf >= if r@ :reset then
+ dup >r ptr over + r@ :)buf >= if
+ r@ allowrollover not if abort" pad limit exceeded!" then r@ :reset then
r@ ptr swap to+ r> ptr ( a ) ;
: :move ( src u self -- a )
@@ -35,6 +37,13 @@ struct[ Scratchpad
: :[ ( size self -- ) dup ptr to _ptr :allot to@! here to _here ;
\ Stop writing to the scratch area and restore here
\ Returns the address of the beginning of the written area
- : :] ( self -- a ) drop _here to here _ptr ;
-
+ : :] ( self -- a )
+ here over ptr > if abort" scratchpad :[ overflow" then
+ _here to@! here swap to ptr _ptr ;
+
+ : :, ( n self -- ) CELLSZ swap :allot ! ;
+ : :s, ( str self -- ) swap c@+ rot :[]>str drop ;
+ : :entry ( 'dict name self -- )
+ \ meta + len + prev + align = 12
+ over c@ 12 + over :[ rot> entry :] drop ;
]struct
diff --git a/fs/sys/scratch.fs b/fs/sys/scratch.fs
@@ -7,4 +7,4 @@
\ these cursor live in the system scratchpad, they'd be overwritten by faster-
\ paced data.
-$4000 Scratchpad :new structbind Scratchpad syspad
+$1000 Scratchpad :new structbind Scratchpad syspad
diff --git a/fs/sys/xhere.fs b/fs/sys/xhere.fs
@@ -1,29 +0,0 @@
-\ Extra "here" space
-\ This subsystem is a preallocated buffer for transitionary data. It's very
-\ similar to lib/scratch, but for written (with "," words) data. Unlike the
-\ sratchpad, this is not a rolling buffer. You're expected to know when you
-\ start using it, and when you stop.
-
-\ You initialize it with here$, and then activate it with here[. From that
-\ moment, everything you write is temporary. You return to your regular "here"
-\ with ]here. This also save/restore sysdict so that words created in xhere
-\ don't pollute the actual sysdict after we go back to "regular here".
-
-\ This is used, for example, as a temporary space for the C compiler AST.
-\ Without xhere, this data is written to here and permanently uses system
-\ memory.
-
-48 1024 * const XHERESZ
-1024 const XHEREWARN
-
-create _buf XHERESZ allot
-_buf value _ptr
-0 value _oldhere
-0 value _oldsysdict
-
-: xhere$ _buf to _ptr ;
-: xhere[ here to _oldhere sysdict @ to _oldsysdict _ptr to here ;
-: ]xhere
- here to _ptr _oldhere to here _oldsysdict sysdict !
- _ptr XHEREWARN + _buf XHERESZ + > if
- ." Running out of xhere space!" nl> then ;
diff --git a/fs/xcomp/init.fs b/fs/xcomp/init.fs
@@ -3,6 +3,5 @@
f<< sys/scratch.fs
f<< lib/nfmt.fs
f<< lib/diag.fs
-f<< sys/xhere.fs
f<< sys/rdln.fs
: init S" Dusk OS\n" stype .free rdln$ stdio$ quit ;
diff --git a/fs/xcomp/pc/inittest.fs b/fs/xcomp/pc/inittest.fs
@@ -2,7 +2,6 @@ com$ ' >com to emit
f<< sys/scratch.fs
f<< lib/nfmt.fs
f<< lib/diag.fs
-f<< sys/xhere.fs
' bye to abort
f<< tests/all.fs
: init bye ;
diff --git a/testcvm.fs b/testcvm.fs
@@ -1,3 +1,2 @@
f<< /app/cos/cvm.fs
-nl> syspad :usedsz .x nl>
bye
