needs mem/dict mem/stack
unit mem/alloc

: entry+ ( payloadsz 'dict str -- payload ) rot r! reserveentry r> allot@ ;

8 newstack const s

: alloc[ CURALLOC @! s push alignhere ;
: ]alloc s pop CURALLOC ! ;
: ]sysmem ( -- ) s empty SYSALLOC CURALLOC ! ;
: newallocator ( newhere a u -- alloc ) here# >r over , + , , r> ;

: bindalloc[ ['] alloc[ bind ;
: _run ( alloc -- prevhere ) CURALLOC @! >r here# >r run1 r> r> CURALLOC ! ;

: _compile, ( alloc -- )
  i) S>) @, CURALLOC m) S>) @!, RSP) S>) -!,
  compile alignhere ' execute,
  RSP) S>) @+, CURALLOC m) S>) !, ;
: _ _run drop ;
: bindrun1 ( alloc "name" -- )
  dup ['] _compile, bind> swap ['] _ bind> compiling ;

: ?newhere ( a -- a ) PREVHERE @ ?dup if nip then ;
: _compile@, ( alloc -- )
  0 PREVHERE m) !n, i) S>) @, CURALLOC m) S>) @!, RSP) S>) -!,
  compile here# [compile] >r ' execute, [compile] r>
  RSP) S>) @+, CURALLOC m) S>) !, compile ?newhere ;
: _run@ 0 PREVHERE ! _run ?newhere ;
: bindrun1@ ( alloc "name" -- )
  dup ['] _compile@, bind> swap ['] _run@ bind> compiling ;

: contiguous# ( a a -- a ) over <> ?abort"bindrun1r contiguity break" ;
: _compiler, _compile@, compile contiguous# ;
: _runr _run@ contiguous# ;
: bindrun1r ( alloc "name" -- )
  dup ['] _compiler, bind> swap ['] _runr bind> compiling ;

SYSALLOC bindalloc[ sys[