# SPDX-License-Identifier: BSD-2-Clause function _gc_mark_cell(n, dot_filename, d) { # logg_dbg("_gc_mark_cell", n, d) _MARK[n] = 1 if(dot_filename) print " n" n " [fillcolor=green];" >>dot_filename return 1 } function _gc_mark_list(lis, dot_filename, d, i) { while(!_is_null(lis)) { i += _gc_mark_cell(lis, dot_filename, d) if(!_is_literal(_car(lis))) { if(_TYPE[_car(lis)] == "(") { i += _gc_mark_list(_car(lis), dot_filename, d+1) } else { i += _gc_mark_cell(_car(lis), dot_filename, d) } } if(_is_literal(_cdr(lis))) { if(_is_null(_cdr(lis))) { lis = _nil() } else { # pair logg_dbg("_gc_mark_list", "cdr is a literal. pair?", d) i += _gc_mark_cell(_cdr(lis), dot_filename, d) lis = _nil() } } else { if(_TYPE[_cdr(lis)] == "(") { # move along lis lis = _cdr(lis) } else { # a pair with a non-literal logg_dbg("_gc_mark_list", "cdr " _cdr(lis) " is not a cons. pair?", d) i += _gc_mark_cell(_cdr(lis), dot_filename, d) } } } return i } function _gc_sweep(dot_filename, ngcd) { for(i in _TYPE) { if(i+0!=i) continue # no string keys please if(!(i in _MARK)) { t = _TYPE[i] if(t == "s") { delete _STRING[i] if(dot_filename) print " n" i " [fillcolor=lightpink]" >>dot_filename } else if(t == "(") { delete _CAR[i] delete _CDR[i] if(dot_filename) print " n" i " [fillcolor=lightcyan2]" >>dot_filename } else if(t == "'") { name = _SYM_NUMBERS[i] delete _SYM_NUMBERS[i] delete _SYM_NAMES[name] if(dot_filename) print " n" i " [fillcolor=orange1]" >>dot_filename } else { if(dot_filename) print " n" i " [fillcolor=oldlace]" >>dot_filename } delete _TYPE[i] ngcd += 1 } } return ngcd } function _gc_dot(envs, mark_filename, sweep_filename, i, t, name, ngcd, nmarks) { # y'know... the envs given had better add up to everything, not # just globals and not just one stack of envs. hmm delete _MARK ngcd = 0 logg_dbg("_gc", "marking") # at one point i had a more generic fix for this, but then it # unaccountably broke? this will work. for(i=1; i<=_symbol("%no-gc%"); i++) _MARK[i]=1 if(mark_filename) print "" >mark_filename if(sweep_filename) print "" >sweep_filename nmarks = _gc_mark_list(envs, mark_filename, 0) logg_dbg("_gc", "sweeping") ngcd = _gc_sweep(sweep_filename) # _dump("post-gc") return _cons(_cons(_symbol("marks"), _cons(_number(nmarks), _nil())), _cons(_cons(_symbol("marked"), _cons(_number(length(_MARK)), _nil())), _cons(_cons(_symbol("collected"), _cons(_number(ngcd), _nil())), _nil()))) } function _gc(envs) { return _gc_dot(envs) }