4 files changed, 18 insertions(+), 3 deletions(-)

M fs/comp/lisp/compile.fs
M fs/doc/mem/cons.txt
M fs/mem/cons.fs
M fs/tests/comp/lisp.fs

@@ 77,7 77,7 @@ envtop value envtail
 : arg, ( ctx -- ) \ ctx is a (type . offset-or-lit)
   decons swap if
     +{>psoff} dup, ?dup if PSP) swap cells +) @, then
-    else litn then
+    else dup iscons? if dup leak then litn then
   +{>psoff !#1} ;
 : funcall, ( ctx -- ) \ ctx is ( type . ((type . callarg) argctx ...) )
   cdr decons tuck length >r >r begin ( argsctx ) \ V1=argscnt V2=callctx

@@ 12,11 12,12 @@ can't free any space, we're out of memory.
 ## Top level references
 
 To perform garbage collection, one has to keep track of the cons reference. We
-have 3 possible source of references:
+have 4 possible sources of references:
 
 1. Parameter stack
 2. Return stack
 3. "consref" moustaches [lib/bm]
+4. Cons leaked with "leak"
 
 The underlying idea is that we have this pool of a specific size and at a
 specific address. If any number in PS or RS corresponds to this range and is

@@ 38,13 38,20 @@ code iscons? ( a -- f ) \ Preserves A
 
 variable consrefLL
 : consref value consrefLL lladd }addr , ;
-: leak ( cons -- ) here# swap , consrefLL lladd , ;
+
+CONSCNT 32 / const LEAKMAXCNT
+create leaked LEAKMAXCNT cells allot0
+0 value leakcnt
+: leak ( cons -- )
+  leakcnt LEAKMAXCNT = ?abort"out of cons leak space"
+  leaked leakcnt cells + ! +{>leakcnt !#1} ;
 
 :~ ( a u -- ) for @+ ?markusedall next drop ;
 : gc ( -- )
   keeplist KEEPLISTCNT 0 fill
   scnt ps[] ~
   rcnt rs[] ~
+  leaked leakcnt ~
   consrefLL begin llnext ?dup while ( ll )
     dup ll>data @ @ ?markusedall repeat ;
 

@@ 98,4 98,11 @@ lisp (defun fib (n) (_fib n 0 1)) drop
 3 fib 2 #eq
 5 fib 5 #eq
 9 fib 34 #eq
+
+\ test that compiled quotes cons references are properly leaked
+lisp. (defun foo () '(1 2 3))
+lisp (equal (foo) '(1 2 3)) #true
+: fillcons CONSCNT for 0 0 cons drop next ;
+fillcons
+lisp (equal (foo) '(1 2 3)) #true
 testend