hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
hyung-hwan 2006-11-02 10:12:01 +00:00
parent af9751f5b7
commit 93c5c9c071
8 changed files with 124 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
ase/lsp/lsp.c
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.c,v 1.15 2006-10-30 03:34:41 bacon Exp $
* $Id: lsp.c,v 1.16 2006-11-02 10:12:01 bacon Exp $
*/
#if defined(__BORLANDC__)
@ -70,7 +70,7 @@ ase_lsp_t* ase_lsp_open (
lsp->errnum = ASE_LSP_ENOERR;
lsp->opt_undef_symbol = 1;
//lsp->opt_undef_symbol = 0;
/*lsp->opt_undef_symbol = 0;*/
lsp->curc = ASE_CHAR_EOF;
lsp->input_func = ASE_NULL;
@ -94,7 +94,7 @@ ase_lsp_t* ase_lsp_open (
return ASE_NULL;
}
lsp->max_eval_depth = 0; // TODO: put restriction here....
lsp->max_eval_depth = 0; /* TODO: put restriction here.... */
lsp->cur_eval_depth = 0;
return lsp;
@ -113,7 +113,8 @@ int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg)
ASE_LSP_ASSERT (lsp, lsp->input_func == ASE_NULL);
if (input(ASE_LSP_IO_OPEN, arg, ASE_NULL, 0) == -1) {
if (input(ASE_LSP_IO_OPEN, arg, ASE_NULL, 0) == -1)
{
/* TODO: set error number */
return -1;
}
@ -126,8 +127,11 @@ int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg)
int ase_lsp_detach_input (ase_lsp_t* lsp)
{
if (lsp->input_func != ASE_NULL) {
if (lsp->input_func(ASE_LSP_IO_CLOSE, lsp->input_arg, ASE_NULL, 0) == -1) {
if (lsp->input_func != ASE_NULL)
{
if (lsp->input_func (
ASE_LSP_IO_CLOSE, lsp->input_arg, ASE_NULL, 0) == -1)
{
/* TODO: set error number */
return -1;
}
@ -145,7 +149,8 @@ int ase_lsp_attach_output (ase_lsp_t* lsp, ase_lsp_io_t output, void* arg)
ASE_LSP_ASSERT (lsp, lsp->output_func == ASE_NULL);
if (output(ASE_LSP_IO_OPEN, arg, ASE_NULL, 0) == -1) {
if (output(ASE_LSP_IO_OPEN, arg, ASE_NULL, 0) == -1)
{
/* TODO: set error number */
return -1;
}
@ -158,7 +163,8 @@ int ase_lsp_detach_output (ase_lsp_t* lsp)
{
if (lsp->output_func != ASE_NULL)
{
if (lsp->output_func(ASE_LSP_IO_CLOSE, lsp->output_arg, ASE_NULL, 0) == -1)
if (lsp->output_func (
ASE_LSP_IO_CLOSE, lsp->output_arg, ASE_NULL, 0) == -1)
{
/* TODO: set error number */
return -1;
@ -175,27 +181,28 @@ static int __add_builtin_prims (ase_lsp_t* lsp)
#define ADD_PRIM(mem,name,name_len,pimpl,min_args,max_args) \
if (ase_lsp_addprim(mem,name,name_len,pimpl,min_args,max_args) == -1) return -1;
#define MAX_ARGS ASE_TYPE_MAX(ase_size_t)
ADD_PRIM (lsp, ASE_T("exit"), 4, ase_lsp_prim_exit, 0, 0);
ADD_PRIM (lsp, ASE_T("eval"), 4, ase_lsp_prim_eval, 1, 1);
ADD_PRIM (lsp, ASE_T("prog1"), 5, ase_lsp_prim_prog1, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("progn"), 5, ase_lsp_prim_progn, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("prog1"), 5, ase_lsp_prim_prog1, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("progn"), 5, ase_lsp_prim_progn, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("gc"), 2, ase_lsp_prim_gc, 0, 0);
ADD_PRIM (lsp, ASE_T("cond"), 4, ase_lsp_prim_cond, 0, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("if"), 2, ase_lsp_prim_if, 2, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("while"), 5, ase_lsp_prim_while, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("cond"), 4, ase_lsp_prim_cond, 0, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("if"), 2, ase_lsp_prim_if, 2, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("while"), 5, ase_lsp_prim_while, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("car"), 3, ase_lsp_prim_car, 1, 1);
ADD_PRIM (lsp, ASE_T("cdr"), 3, ase_lsp_prim_cdr, 1, 1);
ADD_PRIM (lsp, ASE_T("cons"), 4, ase_lsp_prim_cons, 2, 2);
ADD_PRIM (lsp, ASE_T("set"), 3, ase_lsp_prim_set, 2, 2);
ADD_PRIM (lsp, ASE_T("setq"), 4, ase_lsp_prim_setq, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("setq"), 4, ase_lsp_prim_setq, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("quote"), 5, ase_lsp_prim_quote, 1, 1);
ADD_PRIM (lsp, ASE_T("defun"), 5, ase_lsp_prim_defun, 3, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("demac"), 5, ase_lsp_prim_demac, 3, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("let"), 3, ase_lsp_prim_let, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("let*"), 4, ase_lsp_prim_letx, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("defun"), 5, ase_lsp_prim_defun, 3, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("demac"), 5, ase_lsp_prim_demac, 3, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("let"), 3, ase_lsp_prim_let, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("let*"), 4, ase_lsp_prim_letx, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("="), 1, ase_lsp_prim_eq, 2, 2);
ADD_PRIM (lsp, ASE_T("/="), 2, ase_lsp_prim_ne, 2, 2);
@ -204,13 +211,11 @@ static int __add_builtin_prims (ase_lsp_t* lsp)
ADD_PRIM (lsp, ASE_T(">="), 2, ase_lsp_prim_ge, 2, 2);
ADD_PRIM (lsp, ASE_T("<="), 2, ase_lsp_prim_le, 2, 2);
ADD_PRIM (lsp, ASE_T("+"), 1, ase_lsp_prim_plus, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("-"), 1, ase_lsp_prim_minus, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("*"), 1, ase_lsp_prim_mul, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("/"), 1, ase_lsp_prim_div, 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("%"), 1, ase_lsp_prim_mod , 1, ASE_TYPE_MAX(ase_size_t));
ADD_PRIM (lsp, ASE_T("+"), 1, ase_lsp_prim_plus, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("-"), 1, ase_lsp_prim_minus, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("*"), 1, ase_lsp_prim_mul, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("/"), 1, ase_lsp_prim_div, 1, MAX_ARGS);
ADD_PRIM (lsp, ASE_T("%"), 1, ase_lsp_prim_mod , 1, MAX_ARGS);
return 0;
}

139
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.c,v 1.22 2006-11-02 06:46:31 bacon Exp $
* $Id: mem.c,v 1.23 2006-11-02 10:12:01 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -27,17 +27,6 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->root_frame = mem->frame;
mem->brooding_frame = ASE_NULL;
/* create an array to hold temporary objects */
/*
mem->temp_arr = ase_lsp_arr_new (512);
if (mem->temp_arr == ASE_NULL)
{
ase_lsp_freeframe (lsp, mem->frame);
ASE_LSP_FREE (lsp, mem);
return ASE_NULL;
}
*/
/* initialize object allocation list */
mem->ubound = ubound;
mem->ubound_inc = ubound_inc;
@ -47,7 +36,7 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->used[i] = ASE_NULL;
mem->free[i] = ASE_NULL;
}
mem->locked = ASE_NULL;
mem->read = ASE_NULL;
/* when "ubound" is too small, the garbage collection can
* be performed while making the common objects. */
@ -58,11 +47,11 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->macro = ASE_NULL;
/* initialize common object pointers */
mem->nil = ase_lsp_makenil (mem);
mem->t = ase_lsp_maketrue (mem);
mem->quote = ase_lsp_makesymobj (mem, ASE_T("quote"), 5);
mem->lambda = ase_lsp_makesymobj (mem, ASE_T("lambda"), 6);
mem->macro = ase_lsp_makesymobj (mem, ASE_T("macro"), 5);
mem->nil = ase_lsp_makenil (mem);
mem->t = ase_lsp_maketrue (mem);
mem->quote = ase_lsp_makesym (mem, ASE_T("quote"), 5);
mem->lambda = ase_lsp_makesym (mem, ASE_T("lambda"), 6);
mem->macro = ase_lsp_makesym (mem, ASE_T("macro"), 5);
if (mem->nil == ASE_NULL ||
mem->t == ASE_NULL ||
@ -71,12 +60,17 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->macro == ASE_NULL)
{
ase_lsp_dispose_all (mem);
/*ase_lsp_arr_free (mem->temp_arr);*/
ase_lsp_freeframe (lsp, mem->frame);
ASE_LSP_FREE (lsp, mem);
return ASE_NULL;
}
ASE_LSP_PERM(mem->nil) = 1;
ASE_LSP_PERM(mem->t) = 1;
ASE_LSP_PERM(mem->quote) = 1;
ASE_LSP_PERM(mem->lambda) = 1;
ASE_LSP_PERM(mem->macro) = 1;
return mem;
}
@ -85,9 +79,6 @@ void ase_lsp_closemem (ase_lsp_mem_t* mem)
/* dispose of the allocated objects */
ase_lsp_dispose_all (mem);
/* dispose of the temporary object arrs */
/*ase_lsp_arr_free (mem->temp_arr);*/
/* dispose of environment frames */
ase_lsp_freeframe (mem->lsp, mem->frame);
@ -95,27 +86,6 @@ void ase_lsp_closemem (ase_lsp_mem_t* mem)
ASE_LSP_FREE (mem->lsp, mem);
}
static int __add_prim (
ase_lsp_mem_t* mem, const ase_char_t* name, ase_size_t name_len,
ase_lsp_prim_t pimpl, ase_size_t min_args, ase_size_t max_args)
{
ase_lsp_obj_t* n, * p;
n = ase_lsp_makesymobj (mem, name, name_len);
if (n == ASE_NULL) return -1;
ase_lsp_lockobj (mem->lsp, n);
p = ase_lsp_makeprim (mem, pimpl, min_args, max_args);
if (p == ASE_NULL) return -1;
ase_lsp_unlockobj (mem->lsp, n);
if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1;
return 0;
}
ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size)
{
ase_lsp_obj_t* obj;
@ -139,6 +109,7 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size)
ASE_LSP_TYPE(obj) = type;
ASE_LSP_SIZE(obj) = size;
ASE_LSP_MARK(obj) = 0;
ASE_LSP_PERM(obj) = 0;
ASE_LSP_LOCK(obj) = 0;
/* insert the object at the head of the used list */
@ -159,8 +130,8 @@ void ase_lsp_dispose (
ASE_LSP_ASSERT (mem->lsp, obj != ASE_NULL);
ASE_LSP_ASSERT (mem->lsp, mem->count > 0);
// TODO: push the object to the free list for more
// efficient memory management
/* TODO: push the object to the free list for more
* efficient memory management */
if (prev == ASE_NULL)
mem->used[ASE_LSP_TYPE(obj)] = ASE_LSP_LINK(obj);
@ -220,50 +191,57 @@ static void __mark_obj (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
}
/*
* ase_lsp_lockobj and ase_lsp_unlockallobjs are just called by ase_lsp_read.
* ase_lsp_lockobj and ase_lsp_deepunlockobj are just called by ase_lsp_read.
*/
void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
ASE_LSP_ASSERTX (lsp, obj != ASE_NULL,
"an object pointer should not be ASE_NULL");
ASE_LSP_LOCK(obj)++;
if (ASE_LSP_PERM(obj) == 0) ASE_LSP_LOCK(obj)++;
}
void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
ASE_LSP_ASSERTX (lsp, obj != ASE_NULL,
"an object pointer should not be ASE_NULL");
if (ASE_LSP_PERM(obj) != 0) return;
ASE_LSP_ASSERTX (lsp, ASE_LSP_LOCK(obj) > 0,
"the lock count should be greater than zero to be unlocked");
ASE_LSP_LOCK(obj)--;
}
void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
void ase_lsp_deepunlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{
ASE_LSP_ASSERTX (lsp, obj != ASE_NULL,
"an object pointer should not be ASE_NULL");
ASE_LSP_ASSERTX (lsp, ASE_LSP_LOCK(obj) > 0,
"the lock count should be greater than zero to be unlocked");
ASE_LSP_LOCK(obj)--;
if (ASE_LSP_PERM(obj) == 0)
{
ASE_LSP_ASSERTX (lsp, ASE_LSP_LOCK(obj) > 0,
"the lock count should be greater than zero to be unlocked");
ASE_LSP_LOCK(obj)--;
}
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
{
ase_lsp_unlockallobjs (lsp, ASE_LSP_CAR(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_CDR(obj));
ase_lsp_deepunlockobj (lsp, ASE_LSP_CAR(obj));
ase_lsp_deepunlockobj (lsp, ASE_LSP_CDR(obj));
}
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_FUNC)
{
ase_lsp_unlockallobjs (lsp, ASE_LSP_FFORMAL(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_FBODY(obj));
ase_lsp_deepunlockobj (lsp, ASE_LSP_FFORMAL(obj));
ase_lsp_deepunlockobj (lsp, ASE_LSP_FBODY(obj));
}
else if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_MACRO)
{
ase_lsp_unlockallobjs (lsp, ASE_LSP_MFORMAL(obj));
ase_lsp_unlockallobjs (lsp, ASE_LSP_MBODY(obj));
ase_lsp_deepunlockobj (lsp, ASE_LSP_MFORMAL(obj));
ase_lsp_deepunlockobj (lsp, ASE_LSP_MBODY(obj));
}
}
static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
static void __mark_objs_in_use (ase_lsp_mem_t* mem)
{
ase_lsp_frame_t* frame;
ase_lsp_assoc_t* assoc;
@ -297,7 +275,7 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
ase_dprint0 (ASE_T("marking interim frames\n"));
#endif
// mark objects in the interim frames
/* mark objects in the interim frames */
frame = mem->brooding_frame;
while (frame != ASE_NULL) {
@ -316,26 +294,13 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
frame = frame->link;
}
/*
ase_dprint0 (ASE_T("marking the locked object\n"));
if (mem->locked != ASE_NULL) __mark_obj (mem->lsp, mem->locked);
*/
#if 0
ase_dprint0 (ASE_T("marking termporary objects\n"));
#endif
/*
arr = mem->temp_arr;
for (i = 0; i < arr->size; i++)
{
__mark_obj (mem->lsp, arr->buffer[i]);
}
*/
/* ase_dprint0 (ASE_T("marking the read object\n"));*/
if (mem->read != ASE_NULL) __mark_obj (mem->lsp, mem->read);
#if 0
ase_dprint0 (ASE_T("marking builtin objects\n"));
#endif
// mark common objects
/* mark common objects */
if (mem->t != ASE_NULL) __mark_obj (mem->lsp, mem->t);
if (mem->nil != ASE_NULL) __mark_obj (mem->lsp, mem->nil);
if (mem->quote != ASE_NULL) __mark_obj (mem->lsp, mem->quote);
@ -343,7 +308,7 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
if (mem->macro != ASE_NULL) __mark_obj (mem->lsp, mem->macro);
}
static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem)
static void __sweep_unmarked_objs (ase_lsp_mem_t* mem)
{
ase_lsp_obj_t* obj, * prev, * next;
ase_size_t i;
@ -351,10 +316,8 @@ static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem)
/* scan all the allocated objects and get rid of unused objects */
for (i = 0; i < ASE_LSP_TYPE_COUNT; i++)
{
//for (i = ASE_LSP_TYPE_COUNT; i > 0; /*i--*/) {
prev = ASE_NULL;
obj = mem->used[i];
//obj = mem->used[--i];
#if 0
ase_dprint1 (ASE_T("sweeping objects of type: %u\n"), i);
@ -363,9 +326,15 @@ static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem)
{
next = ASE_LSP_LINK(obj);
if (ASE_LSP_LOCK(obj) == 0 && ASE_LSP_MARK(obj) == 0)
if (ASE_LSP_LOCK(obj) == 0 &&
ASE_LSP_MARK(obj) == 0 &&
ASE_LSP_PERM(obj) == 0)
{
/* dispose of unused objects */
if (i == ASE_LSP_OBJ_INT)
xp_printf (ASE_T("disposing....%d [%d]\n"), i, ASE_LSP_IVAL(obj));
else
xp_printf (ASE_T("disposing....%d\n"), i);
ase_lsp_dispose (mem, prev, obj);
}
else
@ -382,9 +351,8 @@ static void ase_lsp_sweepunmarkedobjs (ase_lsp_mem_t* mem)
void ase_lsp_collectgarbage (ase_lsp_mem_t* mem)
{
xp_printf (ASE_T("collecting garbage...\n"));
ase_lsp_markobjsinuse (mem);
ase_lsp_sweepunmarkedobjs (mem);
__mark_objs_in_use (mem);
__sweep_unmarked_objs (mem);
}
ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem)
@ -429,7 +397,7 @@ ase_lsp_obj_t* ase_lsp_makerealobj (ase_lsp_mem_t* mem, ase_real_t value)
return obj;
}
ase_lsp_obj_t* ase_lsp_makesymobj (
ase_lsp_obj_t* ase_lsp_makesym (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len)
{
ase_lsp_obj_t* obj;
@ -456,7 +424,7 @@ ase_lsp_obj_t* ase_lsp_makesymobj (
return obj;
}
ase_lsp_obj_t* ase_lsp_makestrobj (
ase_lsp_obj_t* ase_lsp_makestr (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len)
{
ase_lsp_obj_t* obj;
@ -505,7 +473,8 @@ ase_lsp_obj_t* ase_lsp_makemacro (
{
ase_lsp_obj_t* obj;
obj = ase_lsp_alloc (mem, ASE_LSP_OBJ_MACRO, ase_sizeof(ase_lsp_obj_macro_t));
obj = ase_lsp_alloc (mem,
ASE_LSP_OBJ_MACRO, ase_sizeof(ase_lsp_obj_macro_t));
if (obj == ASE_NULL) return ASE_NULL;
ASE_LSP_MFORMAL(obj) = formal;

16
ase/lsp/mem.h
View File

@ -1,5 +1,5 @@
/*
* $Id: mem.h,v 1.15 2006-11-02 06:46:31 bacon Exp $
* $Id: mem.h,v 1.16 2006-11-02 10:12:01 bacon Exp $
*/
#ifndef _ASE_LSP_MEM_H_
@ -21,14 +21,14 @@ struct ase_lsp_mem_t
ase_size_t count; /* the number of objects currently allocated */
ase_lsp_obj_t* used[ASE_LSP_TYPE_COUNT];
ase_lsp_obj_t* free[ASE_LSP_TYPE_COUNT];
ase_lsp_obj_t* locked;
ase_lsp_obj_t* read;
/* commonly accessed objects */
ase_lsp_obj_t* nil; /* ase_lsp_obj_nil_t */
ase_lsp_obj_t* t; /* ase_lsp_obj_true_t */
ase_lsp_obj_t* quote; /* ase_lsp_obj_symbol_t */
ase_lsp_obj_t* lambda; /* ase_lsp_obj_symbol_t */
ase_lsp_obj_t* macro; /* ase_lsp_obj_symbol_t */
ase_lsp_obj_t* quote; /* ase_lsp_obj_sym_t */
ase_lsp_obj_t* lambda; /* ase_lsp_obj_sym_t */
ase_lsp_obj_t* macro; /* ase_lsp_obj_sym_t */
/* run-time environment frame */
ase_lsp_frame_t* frame;
@ -53,7 +53,7 @@ void ase_lsp_collectgarbage (ase_lsp_mem_t* mem);
void ase_lsp_lockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_unlockallobjs (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
void ase_lsp_deepunlockobj (ase_lsp_t* lsp, ase_lsp_obj_t* obj);
/* object creation of standard types */
ase_lsp_obj_t* ase_lsp_makenil (ase_lsp_mem_t* mem);
@ -61,9 +61,9 @@ ase_lsp_obj_t* ase_lsp_maketrue (ase_lsp_mem_t* mem);
ase_lsp_obj_t* ase_lsp_makeintobj (ase_lsp_mem_t* mem, ase_long_t value);
ase_lsp_obj_t* ase_lsp_makerealobj (ase_lsp_mem_t* mem, ase_real_t value);
ase_lsp_obj_t* ase_lsp_makesymobj (
ase_lsp_obj_t* ase_lsp_makesym (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len);
ase_lsp_obj_t* ase_lsp_makestrobj (
ase_lsp_obj_t* ase_lsp_makestr (
ase_lsp_mem_t* mem, const ase_char_t* str, ase_size_t len);
ase_lsp_obj_t* ase_lsp_makecons (

41
ase/lsp/name.c
View File

@ -1,5 +1,5 @@
/*
* $Id: name.c,v 1.10 2006-10-29 13:00:39 bacon Exp $
* $Id: name.c,v 1.11 2006-11-02 10:12:01 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -55,7 +55,7 @@ int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c)
{
if (name->size >= name->capa)
{
/* double the capa. */
/* double the capacity */
ase_size_t new_capa = name->capa * 2;
if (new_capa >= ase_countof(name->static_buf))
@ -108,43 +108,6 @@ void ase_lsp_name_clear (ase_lsp_name_t* name)
name->buf[0] = ASE_CHAR('\0');
}
ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capa)
{
ase_char_t* old_buf, * new_buf;
if (capa == 0) capa = ase_countof(name->static_buf) - 1;
if (name->capa < ase_countof(name->static_buf))
{
old_buf = (ase_char_t*) ASE_LSP_MALLOC (
name->lsp, (name->capa+1)*ase_sizeof(ase_char_t));
if (old_buf == ASE_NULL) return ASE_NULL;
ASE_LSP_MEMCPY (
name->lsp, old_buf, name->buf,
(name->capa+1)*ase_sizeof(ase_char_t));
}
else old_buf = name->buf;
if (capa < ase_countof(name->static_buf))
{
new_buf = name->static_buf;
}
else
{
new_buf = (ase_char_t*) ASE_LSP_MALLOC (
name->lsp, (capa+1)*ase_sizeof(ase_char_t));
if (new_buf == ASE_NULL) return ASE_NULL;
}
name->buf = new_buf;
name->size = 0;
name->capa = capa;
name->buf[0] = ASE_CHAR('\0');
return old_buf;
}
int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str)
{
ase_char_t* p = name->buf;

3
ase/lsp/name.h
View File

@ -1,5 +1,5 @@
/*
* $Id: name.h,v 1.7 2006-10-26 08:17:37 bacon Exp $
* $Id: name.h,v 1.8 2006-11-02 10:12:01 bacon Exp $
*/
#ifndef _ASE_LSP_NAME_H_
@ -31,7 +31,6 @@ void ase_lsp_name_close (ase_lsp_name_t* name);
int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c);
int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s);
void ase_lsp_name_clear (ase_lsp_name_t* name);
ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capa);
int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str);
#ifdef __cplusplus

16
ase/lsp/obj.h
View File

@ -1,5 +1,5 @@
/*
* $Id: obj.h,v 1.14 2006-11-02 06:46:31 bacon Exp $
* $Id: obj.h,v 1.15 2006-11-02 10:12:01 bacon Exp $
*/
#ifndef _ASE_LSP_OBJ_H_
@ -41,7 +41,8 @@ typedef struct ase_lsp_obj_prim_t ase_lsp_obj_prim_t;
struct ase_lsp_objhdr_t
{
ase_uint32_t type: 8;
ase_uint32_t mark: 8;
ase_uint32_t mark: 4;
ase_uint32_t perm: 4;
ase_uint32_t lock: 16;
ase_size_t size;
ase_lsp_obj_t* link;
@ -120,11 +121,12 @@ struct ase_lsp_obj_prim_t
};
/* header access */
#define ASE_LSP_TYPE(x) (((ase_lsp_obj_t*)x)->hdr.type)
#define ASE_LSP_SIZE(x) (((ase_lsp_obj_t*)x)->hdr.size)
#define ASE_LSP_MARK(x) (((ase_lsp_obj_t*)x)->hdr.mark)
#define ASE_LSP_LOCK(x) (((ase_lsp_obj_t*)x)->hdr.lock)
#define ASE_LSP_LINK(x) (((ase_lsp_obj_t*)x)->hdr.link)
#define ASE_LSP_TYPE(x) (((ase_lsp_obj_t*)x)->hdr.type)
#define ASE_LSP_SIZE(x) (((ase_lsp_obj_t*)x)->hdr.size)
#define ASE_LSP_MARK(x) (((ase_lsp_obj_t*)x)->hdr.mark)
#define ASE_LSP_PERM(x) (((ase_lsp_obj_t*)x)->hdr.perm)
#define ASE_LSP_LOCK(x) (((ase_lsp_obj_t*)x)->hdr.lock)
#define ASE_LSP_LINK(x) (((ase_lsp_obj_t*)x)->hdr.link)
/* value access */
#define ASE_LSP_IVAL(x) (((ase_lsp_obj_int_t*)x)->value)

4
ase/lsp/prim.c
View File

@ -1,5 +1,5 @@
/*
* $Id: prim.c,v 1.16 2006-10-30 03:34:41 bacon Exp $
* $Id: prim.c,v 1.17 2006-11-02 10:12:01 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -27,7 +27,7 @@ static int __add_prim (ase_lsp_mem_t* mem,
{
ase_lsp_obj_t* n, * p;
n = ase_lsp_makesymobj (mem, name, name_len);
n = ase_lsp_makesym (mem, name, name_len);
if (n == ASE_NULL) return -1;
ase_lsp_lockobj (mem->lsp, n);

33
ase/lsp/read.c
View File

@ -1,5 +1,5 @@
/*
* $Id: read.c,v 1.28 2006-11-02 06:46:31 bacon Exp $
* $Id: read.c,v 1.29 2006-11-02 10:12:01 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
@ -64,13 +64,10 @@ ase_lsp_obj_t* ase_lsp_read (ase_lsp_t* lsp)
lsp->errnum = ASE_LSP_ENOERR;
NEXT_TOKEN (lsp);
if (lsp->mem->locked != ASE_NULL)
{
ase_lsp_unlockallobjs (lsp, lsp->mem->locked);
lsp->mem->locked = ASE_NULL;
}
lsp->mem->locked = read_obj (lsp);
return lsp->mem->locked;
lsp->mem->read = read_obj (lsp);
if (lsp->mem->read != ASE_NULL)
ase_lsp_deepunlockobj (lsp, lsp->mem->read);
return lsp->mem->read;
}
static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
@ -104,7 +101,7 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
return obj;
case TOKEN_STRING:
obj = ase_lsp_makestrobj (
obj = ase_lsp_makestr (
lsp->mem, TOKEN_SVAL(lsp), TOKEN_SLEN(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (lsp, obj);
@ -113,15 +110,21 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
case TOKEN_IDENT:
ASE_LSP_ASSERT (lsp,
lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL);
if (TOKEN_COMPARE(lsp,ASE_T("nil")) == 0) obj = lsp->mem->nil;
else if (TOKEN_COMPARE(lsp,ASE_T("t")) == 0) obj = lsp->mem->t;
if (TOKEN_COMPARE(lsp,ASE_T("nil")) == 0)
{
obj = lsp->mem->nil;
}
else if (TOKEN_COMPARE(lsp,ASE_T("t")) == 0)
{
obj = lsp->mem->t;
}
else
{
obj = ase_lsp_makesymobj (
obj = ase_lsp_makesym (
lsp->mem, TOKEN_SVAL(lsp), TOKEN_SLEN(lsp));
if (obj == ASE_NULL) lsp->errnum = ASE_LSP_ENOMEM;
ase_lsp_lockobj (lsp, obj);
}
ase_lsp_lockobj (lsp, obj);
return obj;
}
@ -178,7 +181,7 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
{
if (lsp->errnum == ASE_LSP_ERR_END)
{
// unexpected end of input
/* unexpected end of input */
lsp->errnum = ASE_LSP_ERR_SYNTAX;
}
return ASE_NULL;
@ -234,7 +237,7 @@ static ase_lsp_obj_t* read_quote (ase_lsp_t* lsp)
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL;
}
ase_lsp_lockobj (lsp, cons);
ase_lsp_lockobj (lsp, cons);
return cons;
}