obj_t make_C_procedure(C_procedure_t code,
obj_t name,
interval_t arg_range,
obj_t env)
{
CHECK_OBJ(env);
proc_flags_t flags = PF_COMPILED_C | PF_ARGS_EVALUATED;
return make_proc(flags, (obj_t)code, name, make_fixnum(arg_range), env);
}
obj_t make_procedure(obj_t body, obj_t arglist, obj_t env)
{
CHECK_OBJ(body);
CHECK_OBJ(arglist);
CHECK_OBJ(env);
return make_proc(PF_ARGS_EVALUATED,
body,
make_uninitialized(),
arglist,
env);
}
obj_t make_special_form_procedure(obj_t body, obj_t env)
{
CHECK_OBJ(body);
CHECK_OBJ(env);
proc_flags_t flags = 0;
return make_proc(flags,
body,
make_uninitialized(),
make_uninitialized(),
env);
}
/* read_symbols -- read symbol table */
static void read_symbols(int dseg) {
int kind; char *name; uchar *addr;
int chksum, nlines;
int nm = 0, np = 0, i;
const char *kname;
modtab = (module *) scratch_alloc(nmods * sizeof(module), FALSE);
proctab = (proc *) scratch_alloc(nprocs * sizeof(proc), FALSE);
for (i = 0; i < nsyms; i++) {
kind = read_int();
name = read_string();
switch (kind) {
case X_MODULE:
kname = "Module";
addr = dmem + read_int();
chksum = read_int();
nlines = read_int();
modtab[nm++] = make_module(name, addr, chksum, nlines);
break;
case X_PROC:
kname = "Proc";
addr = dmem + read_int();
proctab[np++] = make_proc(name, addr);
break;
case X_DATA:
kname = "Data";
addr = dmem + read_int();
make_symbol("data", name, addr);
break;
case X_LINE:
kname = "Line";
addr = imem + read_int();
make_symbol("line", name, addr);
break;
default:
kname = "Unknown"; addr = NULL;
panic("*bad symbol %s", name);
}
#ifdef DEBUG
if (dflag) printf("%s %s = %p\n", kname, name, addr);
#endif
}
if (nm != nmods || np != nprocs)
panic("*symbol counts don't match (mods %d/%d, procs %d/%d)\n",
nm, nmods, np, nprocs);
/* Calculate module lengths */
addr = dmem + dseg;
for (i = nmods-1; i >= 0; i--) {
modtab[i]->m_length = addr - modtab[i]->m_addr;
addr = modtab[i]->m_addr;
#ifdef DEBUG
if (dflag)
printf("Module %s has size %d\n",
modtab[i]->m_name, modtab[i]->m_length);
#endif
}
}
obj_t make_raw_procedure(cont_proc_t code, obj_t name, obj_t env)
{
CHECK_OBJ(env);
proc_flags_t flags = PF_COMPILED_C | PF_RAW | PF_ARGS_EVALUATED;
return make_proc(flags, (obj_t)code, name, make_uninitialized(), env);
}
obj_t make_raw_special_form_procedure(cont_proc_t code, obj_t name, obj_t env)
{
CHECK_OBJ(env);
proc_flags_t flags = PF_COMPILED_C | PF_RAW;
return make_proc(flags, (obj_t)code, name, make_uninitialized(), env);
}
