Language-SIOD
view release on metacpan or search on metacpan
lib/Language/SIOD_in.pm view on Meta::CPAN
# This file was automatically generated by SWIG
package Language::SIOD;
require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
package Language::SIOD;
bootstrap Language::SIOD;
package Language::SIOD;
@EXPORT = qw( obj_gc_mark_set obj_gc_mark_get obj_type_set obj_type_get obj_storage_as_get new_obj delete_obj obj_storage_as_c_file_get obj_storage_as_lisp_array_get obj_storage_as_s_string_get obj_storage_as_u_string_get obj_storage_as_string_get ob...
1;
void init_msubr(char *name, LISP (*fcn)(LISP *,LISP *));
LISP assq(LISP x,LISP alist);
LISP delq(LISP elem,LISP l);
void set_gc_hooks(long type,
LISP (*rel)(LISP),
LISP (*mark)(LISP),
void (*scan)(LISP),
void (*free)(LISP),
long *kind);
LISP gc_relocate(LISP x);
LISP user_gc(LISP args);
LISP gc_status(LISP args);
void set_eval_hooks(long type,LISP (*fcn)(LISP, LISP *, LISP *));
LISP leval(LISP x,LISP env);
LISP symbolconc(LISP args);
void set_print_hooks(long type,void (*fcn)(LISP, struct gen_printio *));
LISP lprin1g(LISP exp,struct gen_printio *f);
LISP lprin1f(LISP exp,FILE *f);
LISP lprint(LISP exp,LISP);
LISP lread(LISP);
required or requested. However, the implementation is not as portable.
</UL>
<P>If you get strange errors on a machine architecture not listed
then you may be forced to use -g1 until you investigate and contact
the author for advise.
<h3>Stop and Copy</h3>
As one can see from the source, garbage collection is really quite an easy
thing. The procedure gc_relocate is about 25 lines of code, and
scan_newspace is about 15.
<P>
The real tricks in handling garbage collection are (in a copying gc):
<OL>
<LI>keeping track of locations containing objects
<LI>parsing the heap (in the space scanning)
</OL>
<P>The procedure gc_protect is called once (e.g. at startup) on each
procedure to call the garbage collector when needed.
<P>Our simple object format makes parsing the heap rather trivial.
In more complex situations one ends up requiring object headers or markers
of some kind to keep track of the actual storage lengths of objects
and what components of objects are lisp pointers.
<P>Because of the usefulness of strings, they were added by default into
SIOD 2.6. The implementation requires a hook that calls the C library
memory free procedure when an object is in oldspace and never
got relocated to newspace. Obviously this slows down the stop-and-sweep
GC, and removes one of the usual advantages it has over mark-and-sweep.
<H3>Mark and Sweep</H3>
In a mark-and-sweep GC the objects are not relocated. Instead
one only has to LOOK at objects which are referenced by the argument
frames and local variables of the underlying (in this case C-coded)
implementation procedures. If a pointer "LOOKS" like it is a valid
lisp object (see the procedure mark_locations_array) then it may be marked,
and the objects it points to may be marked, as being in-use storage which
is not linked into the freelist in the gc_sweep phase.
<P>Another advantage of the mark_and_sweep storage management technique is
that only one heap is required.
evaluator, but the <b>tc_msubr</b> is more powerfull and allows
for a modular tail recursion. The set_eval_hooks function allows for
arbitrary evalution semantics when the first element of a form
evaluates to a new datatype.
<H3>User Type Extension</H3>
If you use them then you must provide some information
to the garbage collector.
To do this you can supply 4 functions,
<OL>
<LI>a user_relocate, takes an object and returns a new copy.
<LI>a user_scan, takes an object and calls relocate on its subparts.
<LI>a user_mark, takes an object and calls gc_mark on its subparts or
it may return one of these to avoid stack growth.
<LI>a user_free, takes an object to hack before it gets onto the freelist.
</OL>
<BLOCKQUOTE><PRE><TT>
set_gc_hooks(type,
user_relocate_fcn,
user_scan_fcn,
user_mark_fcn,
user_free_fcn,
&kind_of_gc);
</TT></PRE></BLOCKQUOTE>
<P>The variable kind_of_gc should be a long.
It will receive 0 for mark-and-sweep, 1 for
stop-and-copy. Therefore set_gc_hooks should be called AFTER process_cla.
You must specify a relocate function with stop-and-copy. The scan
function may be NULL if your user types will not have lisp objects in them.
Under mark-and-sweep the mark function is required but the free function
may be NULL.
<P>You might also want to extend the printer. This is optional.
<BLOCKQUOTE><PRE><TT>
set_print_hooks(type,fcn);
</TT></PRE></BLOCKQUOTE>
siod_wrap.c view on Meta::CPAN
XSRETURN(argvi);
fail:
;
}
croak(Nullch);
}
XS(_wrap_gc_relocate) {
{
LISP arg1 = (LISP) 0 ;
LISP result;
int argvi = 0;
dXSARGS;
if ((items < 1) || (items > 1)) {
SWIG_croak("Usage: gc_relocate(x);");
}
{
if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_obj,0) < 0) {
SWIG_croak("Type error in argument 1 of gc_relocate. Expected _p_obj");
}
}
result = (LISP)gc_relocate(arg1);
ST(argvi) = sv_newmortal();
SWIG_MakePtr(ST(argvi++), (void *) result, SWIGTYPE_p_obj, SWIG_SHADOW|SWIG_OWNER);
XSRETURN(argvi);
fail:
;
}
croak(Nullch);
}
siod_wrap.c view on Meta::CPAN
{"Language::SIOD::init_subr_2n", _wrap_init_subr_2n},
{"Language::SIOD::init_subr_3", _wrap_init_subr_3},
{"Language::SIOD::init_subr_4", _wrap_init_subr_4},
{"Language::SIOD::init_subr_5", _wrap_init_subr_5},
{"Language::SIOD::init_lsubr", _wrap_init_lsubr},
{"Language::SIOD::init_fsubr", _wrap_init_fsubr},
{"Language::SIOD::init_msubr", _wrap_init_msubr},
{"Language::SIOD::assq", _wrap_assq},
{"Language::SIOD::delq", _wrap_delq},
{"Language::SIOD::set_gc_hooks", _wrap_set_gc_hooks},
{"Language::SIOD::gc_relocate", _wrap_gc_relocate},
{"Language::SIOD::user_gc", _wrap_user_gc},
{"Language::SIOD::gc_status", _wrap_gc_status},
{"Language::SIOD::set_eval_hooks", _wrap_set_eval_hooks},
{"Language::SIOD::leval", _wrap_leval},
{"Language::SIOD::symbolconc", _wrap_symbolconc},
{"Language::SIOD::set_print_hooks", _wrap_set_print_hooks},
{"Language::SIOD::lprin1g", _wrap_lprin1g},
{"Language::SIOD::lprin1f", _wrap_lprin1f},
{"Language::SIOD::lprint", _wrap_lprint},
{"Language::SIOD::lread", _wrap_lread},
extern LISP sym_t;
extern long siod_verbose_level;
extern char *siod_lib;
extern long nointerrupt;
extern long interrupt_differed;
extern long errjmp_ok;
extern LISP unbound_marker;
struct user_type_hooks
{LISP (*gc_relocate)(LISP);
void (*gc_scan)(LISP);
LISP (*gc_mark)(LISP);
void (*gc_free)(LISP);
void (*prin1)(LISP,struct gen_printio *);
LISP (*leval)(LISP, LISP *, LISP *);
long (*c_sxhash)(LISP,long);
LISP (*fast_print)(LISP,LISP);
LISP (*fast_read)(int,LISP);
LISP (*equal)(LISP,LISP);};
LISP leval_quote(LISP args,LISP env);
LISP leval_tenv(LISP args,LISP env);
int flush_ws(struct gen_readio *f,char *eoferr);
int f_getc(FILE *f);
void f_ungetc(int c, FILE *f);
LISP lreadr(struct gen_readio *f);
LISP lreadparen(struct gen_readio *f);
LISP arglchk(LISP x);
void init_storage_a1(long type);
void init_storage_a(void);
LISP array_gc_relocate(LISP ptr);
void array_gc_scan(LISP ptr);
LISP array_gc_mark(LISP ptr);
void array_gc_free(LISP ptr);
void array_prin1(LISP ptr,struct gen_printio *f);
long array_sxhaxh(LISP,long);
LISP array_fast_print(LISP,LISP);
LISP array_fast_read(int,LISP);
LISP array_equal(LISP,LISP);
long array_sxhash(LISP,long);
gc_protect(location);}
void scan_registers(void)
{struct gc_protected *reg;
LISP *location;
long j,n;
for(reg = protected_registers; reg; reg = (*reg).next)
{location = (*reg).location;
n = (*reg).length;
for(j=0;j<n;++j)
location[j] = gc_relocate(location[j]);}}
void __stdcall init_storage(void)
{long j;
LISP stack_start;
if (stack_start_ptr == NULL)
stack_start_ptr = &stack_start;
init_storage_1();
init_storage_a();
set_gc_hooks(tc_c_file,0,0,0,file_gc_free,&j);
set_print_hooks(tc_c_file,file_prin1);}
return(x);}
void set_gc_hooks(long type,
LISP (*rel)(LISP),
LISP (*mark)(LISP),
void (*scan)(LISP),
void (*free)(LISP),
long *kind)
{struct user_type_hooks *p;
p = get_user_type_hooks(type);
p->gc_relocate = rel;
p->gc_scan = scan;
p->gc_mark = mark;
p->gc_free = free;
*kind = gc_kind_copying;}
LISP gc_relocate(LISP x)
{LISP nw;
struct user_type_hooks *p;
if EQ(x,NIL) return(NIL);
if ((*x).gc_mark == 1) return(CAR(x));
switch TYPE(x)
{case tc_flonum:
case tc_cons:
case tc_symbol:
case tc_closure:
case tc_subr_0:
case tc_subr_5:
case tc_lsubr:
case tc_fsubr:
case tc_msubr:
if ((nw = heap) >= heap_end) gc_fatal_error();
heap = nw+1;
memcpy(nw,x,sizeof(struct obj));
break;
default:
p = get_user_type_hooks(TYPE(x));
if (p->gc_relocate)
nw = (*p->gc_relocate)(x);
else
{if ((nw = heap) >= heap_end) gc_fatal_error();
heap = nw+1;
memcpy(nw,x,sizeof(struct obj));}}
(*x).gc_mark = 1;
CAR(x) = nw;
return(nw);}
LISP get_newspace(void)
{LISP newspace;
heap_end = heap + heap_size;
return(newspace);}
void scan_newspace(LISP newspace)
{LISP ptr;
struct user_type_hooks *p;
for(ptr=newspace; ptr < heap; ++ptr)
{switch TYPE(ptr)
{case tc_cons:
case tc_closure:
CAR(ptr) = gc_relocate(CAR(ptr));
CDR(ptr) = gc_relocate(CDR(ptr));
break;
case tc_symbol:
VCELL(ptr) = gc_relocate(VCELL(ptr));
break;
case tc_flonum:
case tc_subr_0:
case tc_subr_1:
case tc_subr_2:
case tc_subr_2n:
case tc_subr_3:
case tc_subr_4:
case tc_subr_5:
case tc_lsubr:
static LISP sym_plists = NIL;
static LISP bashnum = NIL;
static LISP sym_e = NIL;
static LISP sym_f = NIL;
void init_storage_a1(long type)
{long j;
struct user_type_hooks *p;
set_gc_hooks(type,
array_gc_relocate,
array_gc_mark,
array_gc_scan,
array_gc_free,
&j);
set_print_hooks(type,array_prin1);
p = get_user_type_hooks(type);
p->fast_print = array_fast_print;
p->fast_read = array_fast_read;
p->equal = array_equal;
p->c_sxhash = array_sxhash;}
void init_storage_a(void)
{gc_protect(&bashnum);
bashnum = newcell(tc_flonum);
init_storage_a1(tc_string);
init_storage_a1(tc_double_array);
init_storage_a1(tc_long_array);
init_storage_a1(tc_lisp_array);
init_storage_a1(tc_byte_array);}
LISP array_gc_relocate(LISP ptr)
{LISP nw;
if ((nw = heap) >= heap_end) gc_fatal_error();
heap = nw+1;
memcpy(nw,ptr,sizeof(struct obj));
return(nw);}
void array_gc_scan(LISP ptr)
{long j;
if TYPEP(ptr,tc_lisp_array)
for(j=0;j < ptr->storage_as.lisp_array.dim; ++j)
ptr->storage_as.lisp_array.data[j] =
gc_relocate(ptr->storage_as.lisp_array.data[j]);}
LISP array_gc_mark(LISP ptr)
{long j;
if TYPEP(ptr,tc_lisp_array)
for(j=0;j < ptr->storage_as.lisp_array.dim; ++j)
gc_mark(ptr->storage_as.lisp_array.data[j]);
return(NIL);}
void array_gc_free(LISP ptr)
{switch (ptr->type)
( run in 2.279 seconds using v1.01-cache-2.11-cpan-71847e10f99 )