7 files changed, 32 insertions(+), 6 deletions(-)

M fs/comp/c/egen.fs
M fs/comp/c/gen.fs
M fs/comp/c/type.fs
M fs/doc/lib/alloc.txt
M fs/lib/alloc.fs
M fs/lib/arena.fs
M fs/lib/malloc.fs

@@ 17,6 17,8 @@ require /sys/scratch.fs
 \ allocate a new arena in the middle of the function (this might fail if a
 \ single function allocates more than ARENASZ bytes of literals).
 Arena :new structbind Arena _litarena
+: egenreserve _litarena :reserve ;
+
 \ Maximum size in bytes that a single literal can have
 $400 const MAXLITSZ
 

@@ 36,11 36,11 @@ require /sys/scratch.fs
 \ declaration) and consume tokens until that element is finished parsing. That
 \ element is written to memory at "here".
 : cparse ( tok -- )
-  cctypereserve 0 to curstatic
+  typereserve egenreserve 0 to curstatic lockhere
   dup S" static" s= if drop nextt 1 to curstatic then
   parseType _assert ( type )
   ';' readChar? if \ Only a type on a line is fine, carry on
-    drop exit then to nexttputback
+    drop unlockhere exit then to nexttputback
   parseDeclarator ( cdecl )
   curstatic if dup CDecl :static! then
   _ccdebug if ." parsing: " dup printtype nl> then


@@ 50,4 50,4 @@ require /sys/scratch.fs
         ." complete: " dup printtype nl> CDecl offset here over - spit nl>
         else drop then
       else parseFunctionProto then
-    else parseGlobalDecl then ( ) ;
+    else parseGlobalDecl then ( ) unlockhere ;

@@ 15,7 15,7 @@ Arena :new const _parena \ Permanent
 Arena :new const _tarena \ Temporary
 
 \ Call this in between code gen so that we don't have untimely block allocs.
-: cctypereserve _parena Arena :reserve _tarena Arena :reserve ;
+: typereserve _parena Arena :reserve _tarena Arena :reserve ;
 
 : _err ( -- ) abort" type error" ;
 : _assert ( f -- ) not if _err then ;

@@ 76,3 76,21 @@ Allocator API can be exposed to C by loading lib/alloc.h, which add these
 functions:
 
 int alloc_allot(unsigned int n, int self) --> :allot
+
+## Locking HERE
+
+There are cases where you're writing stuff to HERE which needs to stay
+contiguous at the same time as you're using words which might, or might not use
+dynamic allocation mechanism in a way that will result in an allocation to HERE
+that conflicts with your current work.
+
+This will generally corrupt your memory and cause bugs that are difficult to
+identify.
+
+To protect yourself from bugs that are difficult to pinpoint, you can "lock
+HERE" before you begin your operation. Then, any dynamic allocator that is about
+to allocate to HERE will check the lock and abort if it's taken. The API is:
+
+lockhere ( -- ) Take the lock
+unlockhere ( -- ) Release the lock
+herefree# ( -- ) If the lock is taken, abort with message

@@ 1,3 1,8 @@
+0 value _locked
+: herefree# _locked if 0 to _locked abort" allocating to locked HERE!" then ;
+: lockhere herefree# 1 to _locked ;
+: unlockhere 0 to _locked ;
+
 \ TODO: add the concept of "max allocation unit" to abort when we're allocating
 \ chunks that are too big. I got burned while working on asm/uxntal.c, chasing
 \ what I thought was a tricky memory corruption bug, but it just so happened


@@ 34,3 39,4 @@ struct[ Allocator
   : :, ( n self -- a ) CELLSZ swap :allot tuck ! ;
   : :s, ( str self -- a ) swap c@+ rot :[]>str ;
 ]struct
+

@@ 6,7 6,7 @@ struct[ ArenaBuf
   sfield nextbuf
   SZ &+ buf
   : :)buf buf ARENASZ + ;
-  : :new ( -- buf ) here 0 , ARENASZ allot ;
+  : :new ( -- buf ) herefree# here 0 , ARENASZ allot ;
   : :next dup nextbuf ?dup not if :new tuck swap to nextbuf else nip then ;
 ]struct
 

@@ 4,7 4,7 @@ struct[ _Buf
   sfield used
   SZ &+ buf
   : :)buf bi buf | size + ;
-  : :new ( sz -- buf ) here 0 , over , 0 , swap allot ;
+  : :new ( sz -- buf ) herefree# here 0 , over , 0 , swap allot ;
   \ Find an unused buffer with a size >= "sz".
   : :find ( sz self -- buf-or-0 ) swap >r \ V1=sz
     begin dup while ( buf )