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-10-26 08:17:38 +00:00
parent f4260f6c66
commit ac39c74c0f
26 changed files with 521 additions and 706 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ase/awk/awk_i.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: awk_i.h,v 1.73 2006-10-24 04:48:52 bacon Exp $ * $Id: awk_i.h,v 1.74 2006-10-26 08:17:37 bacon Exp $
*/ */
#ifndef _ASE_AWK_AWKI_H_ #ifndef _ASE_AWK_AWKI_H_

101
ase/lsp/array.c
View File

@ -1,101 +0,0 @@
/*
* $Id: array.c,v 1.11 2006-10-24 04:22:39 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
ase_lsp_array_t* ase_lsp_array_new (ase_size_t capacity)
{
ase_lsp_array_t* array;
ase_assert (capacity > 0);
array = (ase_lsp_array_t*) ase_malloc (sizeof(ase_lsp_array_t));
if (array == ASE_NULL) return ASE_NULL;
array->buffer = (void**) ase_malloc (capacity + 1);
if (array->buffer == ASE_NULL) {
free (array);
return ASE_NULL;
}
array->size = 0;
array->capacity = capacity;
array->buffer[0] = ASE_NULL;
return array;
}
void ase_lsp_array_free (ase_lsp_array_t* array)
{
while (array->size > 0)
free (array->buffer[--array->size]);
ase_assert (array->size == 0);
free (array->buffer);
free (array);
}
int ase_lsp_array_add_item (ase_lsp_array_t* array, void* item)
{
if (array->size >= array->capacity) {
void* new_buffer = (void**)realloc (
array->buffer, array->capacity * 2 + 1);
if (new_buffer == ASE_NULL) return -1;
array->buffer = new_buffer;
array->capacity = array->capacity * 2;
}
array->buffer[array->size++] = item;
array->buffer[array->size] = ASE_NULL;
return 0;
}
int ase_lsp_array_insert (ase_lsp_array_t* array, ase_size_t index, void* value)
{
ase_size_t i;
if (index >= array->capacity) {
void* new_buffer = (void**)realloc (
array->buffer, array->capacity * 2 + 1);
if (new_buffer == ASE_NULL) return -1;
array->buffer = new_buffer;
array->capacity = array->capacity * 2;
}
for (i = array->size; i > index; i--) {
array->buffer[i] = array->buffer[i - 1];
}
array->buffer[index] = value;
array->size = (index > array->size)? index + 1: array->size + 1;
return 0;
}
void ase_lsp_array_delete (ase_lsp_array_t* array, ase_size_t index)
{
ase_assert (index < array->size);
}
void ase_lsp_array_clear (ase_lsp_array_t* array)
{
while (array->size > 0)
free (array->buffer[--array->size]);
ase_assert (array->size == 0);
array->buffer[0] = ASE_NULL;
}
void** ase_lsp_array_yield (ase_lsp_array_t* array, ase_size_t capacity)
{
void** old_buffer, ** new_buffer;
new_buffer = (void**) ase_malloc (capacity + 1);
if (new_buffer == ASE_NULL) return ASE_NULL;
old_buffer = array->buffer;
array->buffer = new_buffer;
array->size = 0;
array->capacity = capacity;
array->buffer[0] = ASE_NULL;
return old_buffer;
}

35
ase/lsp/array.h
View File

@ -1,35 +0,0 @@
/*
* $Id: array.h,v 1.7 2006-10-24 04:22:39 bacon Exp $
*/
#ifndef _ASE_LSP_ARRAY_H_
#define _ASE_LSP_ARRAY_H_
#include <ase/types.h>
struct ase_lsp_array_t
{
void** buffer;
ase_size_t size;
ase_size_t capacity;
};
typedef struct ase_lsp_array_t ase_lsp_array_t;
#ifdef __cplusplus
extern "C" {
#endif
ase_lsp_array_t* ase_lsp_array_new (ase_size_t capacity);
void ase_lsp_array_free (ase_lsp_array_t* array);
int ase_lsp_array_add_item (ase_lsp_array_t* array, void* item);
int ase_lsp_array_insert (ase_lsp_array_t* array, ase_size_t index, void* value);
void ase_lsp_array_delete (ase_lsp_array_t* array, ase_size_t index);
void ase_lsp_array_clear (ase_lsp_array_t* array);
void** ase_lsp_array_yield (ase_lsp_array_t* array, ase_size_t capacity);
#ifdef __cplusplus
}
#endif
#endif

49
ase/lsp/env.c
View File

@ -1,17 +1,19 @@
/* /*
* $Id: env.c,v 1.11 2006-10-25 13:42:30 bacon Exp $ * $Id: env.c,v 1.12 2006-10-26 08:17:37 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
// TODO: make the frame hash accessible.... // TODO: make the frame hash accessible....
ase_lsp_assoc_t* ase_lsp_assoc_new ( static ase_lsp_assoc_t* __new_assoc (
ase_lsp_obj_t* name, ase_lsp_obj_t* value, ase_lsp_obj_t* func) ase_lsp_t* lsp, ase_lsp_obj_t* name,
ase_lsp_obj_t* value, ase_lsp_obj_t* func)
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
assoc = (ase_lsp_assoc_t*) ase_malloc (sizeof(ase_lsp_assoc_t)); assoc = (ase_lsp_assoc_t*)
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_assoc_t));
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
assoc->name = name; assoc->name = name;
@ -22,16 +24,12 @@ ase_lsp_assoc_t* ase_lsp_assoc_new (
return assoc; return assoc;
} }
void ase_lsp_assoc_free (ase_lsp_assoc_t* assoc) ase_lsp_frame_t* ase_lsp_newframe (ase_lsp_t* lsp)
{
ase_free (assoc);
}
ase_lsp_frame_t* ase_lsp_frame_new (void)
{ {
ase_lsp_frame_t* frame; ase_lsp_frame_t* frame;
frame = (ase_lsp_frame_t*) ase_malloc (sizeof(ase_lsp_frame_t)); frame = (ase_lsp_frame_t*)
ASE_LSP_MALLOC (lsp, sizeof(ase_lsp_frame_t));
if (frame == ASE_NULL) return ASE_NULL; if (frame == ASE_NULL) return ASE_NULL;
frame->assoc = ASE_NULL; frame->assoc = ASE_NULL;
@ -40,7 +38,7 @@ ase_lsp_frame_t* ase_lsp_frame_new (void)
return frame; return frame;
} }
void ase_lsp_frame_free (ase_lsp_frame_t* frame) void ase_lsp_freeframe (ase_lsp_t* lsp, ase_lsp_frame_t* frame)
{ {
ase_lsp_assoc_t* assoc, * link; ase_lsp_assoc_t* assoc, * link;
@ -49,18 +47,19 @@ void ase_lsp_frame_free (ase_lsp_frame_t* frame)
while (assoc != ASE_NULL) while (assoc != ASE_NULL)
{ {
link = assoc->link; link = assoc->link;
ase_lsp_assoc_free (assoc); ASE_LSP_FREE (lsp, assoc);
assoc = link; assoc = link;
} }
ase_free (frame); ASE_LSP_FREE (lsp, frame);
} }
ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* name) ase_lsp_assoc_t* ase_lsp_lookupinframe (
ase_lsp_t* lsp, ase_lsp_frame_t* frame, ase_lsp_obj_t* name)
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); ase_lsp_assert (lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
assoc = frame->assoc; assoc = frame->assoc;
while (assoc != ASE_NULL) while (assoc != ASE_NULL)
@ -71,28 +70,30 @@ ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* na
return ASE_NULL; return ASE_NULL;
} }
ase_lsp_assoc_t* ase_lsp_frame_insert_value ( ase_lsp_assoc_t* ase_lsp_insertvalueintoframe (
ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* value) ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_obj_t* name, ase_lsp_obj_t* value)
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); ase_lsp_assert (lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
assoc = ase_lsp_assoc_new (name, value, ASE_NULL); assoc = __new_assoc (lsp, name, value, ASE_NULL);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
assoc->link = frame->assoc; assoc->link = frame->assoc;
frame->assoc = assoc; frame->assoc = assoc;
return assoc; return assoc;
} }
ase_lsp_assoc_t* ase_lsp_frame_insert_func ( ase_lsp_assoc_t* ase_lsp_insertfuncintoframe (
ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* func) ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_obj_t* name, ase_lsp_obj_t* func)
{ {
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_assert (ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM); ase_lsp_assert (lsp, ASE_LSP_TYPE(name) == ASE_LSP_OBJ_SYM);
assoc = ase_lsp_assoc_new (name, ASE_NULL, func); assoc = __new_assoc (lsp, name, ASE_NULL, func);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
assoc->link = frame->assoc; assoc->link = frame->assoc;
frame->assoc = assoc; frame->assoc = assoc;

41
ase/lsp/env.h
View File

@ -1,46 +1,49 @@
/* /*
* $Id: env.h,v 1.9 2006-10-24 04:22:39 bacon Exp $ * $Id: env.h,v 1.10 2006-10-26 08:17:37 bacon Exp $
*/ */
#ifndef _ASE_LSP_ENV_H_ #ifndef _ASE_LSP_ENV_H_
#define _ASE_LSP_ENV_H_ #define _ASE_LSP_ENV_H_
#include <ase/lsp/obj.h> #ifndef _ASE_LSP_LSP_H_
#error Never include this file directly. Include <ase/lsp/lsp.h> instead
#endif
typedef struct ase_lsp_assoc_t ase_lsp_assoc_t;
typedef struct ase_lsp_frame_t ase_lsp_frame_t;
struct ase_lsp_assoc_t struct ase_lsp_assoc_t
{ {
ase_lsp_obj_t* name; // ase_lsp_obj_symbol_t ase_lsp_obj_t* name; /* ase_lsp_obj_symbol_t */
/*ase_lsp_obj_t* value;*/ /*ase_lsp_obj_t* value;*/
ase_lsp_obj_t* value; /* value as a variable */ ase_lsp_obj_t* value; /* value as a variable */
ase_lsp_obj_t* func; /* function definition */ ase_lsp_obj_t* func; /* function definition */
struct ase_lsp_assoc_t* link;
ase_lsp_assoc_t* link;
}; };
struct ase_lsp_frame_t struct ase_lsp_frame_t
{ {
struct ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
struct ase_lsp_frame_t* link; ase_lsp_frame_t* link;
}; };
typedef struct ase_lsp_assoc_t ase_lsp_assoc_t;
typedef struct ase_lsp_frame_t ase_lsp_frame_t;
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
ase_lsp_assoc_t* ase_lsp_assoc_new ( ase_lsp_frame_t* ase_lsp_newframe (ase_lsp_t* lsp);
ase_lsp_obj_t* name, ase_lsp_obj_t* value, ase_lsp_obj_t* func); void ase_lsp_freeframe (ase_lsp_t* lsp, ase_lsp_frame_t* frame);
void ase_lsp_assoc_free (ase_lsp_assoc_t* assoc);
ase_lsp_frame_t* ase_lsp_frame_new (void); ase_lsp_assoc_t* ase_lsp_lookupinframe (
void ase_lsp_frame_free (ase_lsp_frame_t* frame); ase_lsp_t* lsp, ase_lsp_frame_t* frame, ase_lsp_obj_t* name);
ase_lsp_assoc_t* ase_lsp_frame_lookup (ase_lsp_frame_t* frame, ase_lsp_obj_t* name);
ase_lsp_assoc_t* ase_lsp_frame_insert_value ( ase_lsp_assoc_t* ase_lsp_insertvalueintoframe (
ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* value); ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_assoc_t* ase_lsp_frame_insert_func ( ase_lsp_obj_t* name, ase_lsp_obj_t* value);
ase_lsp_frame_t* frame, ase_lsp_obj_t* name, ase_lsp_obj_t* func); ase_lsp_assoc_t* ase_lsp_insertfuncintoframe (
ase_lsp_t* lsp, ase_lsp_frame_t* frame,
ase_lsp_obj_t* name, ase_lsp_obj_t* func);
#ifdef __cplusplus #ifdef __cplusplus
} }

100
ase/lsp/eval.c
View File

@ -1,11 +1,8 @@
/* /*
* $Id: eval.c,v 1.16 2006-10-25 13:42:31 bacon Exp $ * $Id: eval.c,v 1.17 2006-10-26 08:17:37 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp_i.h>
#include <ase/lsp/env.h>
#include <ase/lsp/prim.h>
#include <ase/bas/assert.h>
static ase_lsp_obj_t* make_func ( static ase_lsp_obj_t* make_func (
ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro); ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macro);
@ -16,7 +13,7 @@ static ase_lsp_obj_t* apply (
ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj) ase_lsp_obj_t* ase_lsp_eval (ase_lsp_t* lsp, ase_lsp_obj_t* obj)
{ {
lsp->errnum = ASE_LSP_ERR_NONE; lsp->errnum = ASE_LSP_ENOERR;
if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS) if (ASE_LSP_TYPE(obj) == ASE_LSP_OBJ_CONS)
return eval_cons (lsp, obj); return eval_cons (lsp, obj);
@ -83,7 +80,7 @@ static ase_lsp_obj_t* make_func (ase_lsp_t* lsp, ase_lsp_obj_t* cdr, int is_macr
ase_lsp_makemacro (lsp->mem, formal, body): ase_lsp_makemacro (lsp->mem, formal, body):
ase_lsp_makefunc (lsp->mem, formal, body); ase_lsp_makefunc (lsp->mem, formal, body);
if (func == ASE_NULL) { if (func == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -94,7 +91,7 @@ static ase_lsp_obj_t* eval_cons (ase_lsp_t* lsp, ase_lsp_obj_t* cons)
{ {
ase_lsp_obj_t* car, * cdr; ase_lsp_obj_t* car, * cdr;
ase_assert (ASE_LSP_TYPE(cons) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(cons) == ASE_LSP_OBJ_CONS);
car = ASE_LSP_CAR(cons); car = ASE_LSP_CAR(cons);
cdr = ASE_LSP_CDR(cons); cdr = ASE_LSP_CDR(cons);
@ -176,70 +173,78 @@ static ase_lsp_obj_t* apply (
ase_lsp_obj_t* value; ase_lsp_obj_t* value;
ase_lsp_mem_t* mem; ase_lsp_mem_t* mem;
ase_assert ( ase_lsp_assert (lsp,
ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC || ASE_LSP_TYPE(func) == ASE_LSP_OBJ_FUNC ||
ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO); ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO);
ase_assert (ASE_LSP_TYPE(ASE_LSP_CDR(func)) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp,
ASE_LSP_TYPE(ASE_LSP_CDR(func)) == ASE_LSP_OBJ_CONS);
mem = lsp->mem; mem = lsp->mem;
if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) { if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO)
{
formal = ASE_LSP_MFORMAL (func); formal = ASE_LSP_MFORMAL (func);
body = ASE_LSP_MBODY (func); body = ASE_LSP_MBODY (func);
} }
else { else
{
formal = ASE_LSP_FFORMAL (func); formal = ASE_LSP_FFORMAL (func);
body = ASE_LSP_FBODY (func); body = ASE_LSP_FBODY (func);
} }
// make a new frame. /* make a new frame. */
frame = ase_lsp_frame_new (); frame = ase_lsp_newframe (lsp);
if (frame == ASE_NULL) { if (frame == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
// attach it to the brooding frame list to /* attach it to the brooding frame list to
// make them not to be garbage collected. * make them not to be garbage collected. */
frame->link = mem->brooding_frame; frame->link = mem->brooding_frame;
mem->brooding_frame = frame; mem->brooding_frame = frame;
// evaluate arguments and push them into the frame. /* evaluate arguments and push them into the frame. */
while (formal != mem->nil) { while (formal != mem->nil)
if (actual == mem->nil) { {
if (actual == mem->nil)
{
lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS; lsp->errnum = ASE_LSP_ERR_TOO_FEW_ARGS;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
value = ASE_LSP_CAR(actual); value = ASE_LSP_CAR(actual);
if (ASE_LSP_TYPE(func) != ASE_LSP_OBJ_MACRO) { if (ASE_LSP_TYPE(func) != ASE_LSP_OBJ_MACRO)
{
// macro doesn't evaluate actual arguments. // macro doesn't evaluate actual arguments.
value = ase_lsp_eval (lsp, value); value = ase_lsp_eval (lsp, value);
if (value == ASE_NULL) { if (value == ASE_NULL)
{
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
} }
if (ase_lsp_frame_lookup ( if (ase_lsp_lookupinframe (
frame, ASE_LSP_CAR(formal)) != ASE_NULL) { lsp, frame, ASE_LSP_CAR(formal)) != ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
if (ase_lsp_frame_insert_value ( if (ase_lsp_insertvalueintoframe (
frame, ASE_LSP_CAR(formal), value) == ASE_NULL) { lsp, frame, ASE_LSP_CAR(formal), value) == ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
@ -247,16 +252,18 @@ static ase_lsp_obj_t* apply (
formal = ASE_LSP_CDR(formal); formal = ASE_LSP_CDR(formal);
} }
if (ASE_LSP_TYPE(actual) == ASE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(actual) == ASE_LSP_OBJ_CONS)
{
lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
else if (actual != mem->nil) { else if (actual != mem->nil)
{
lsp->errnum = ASE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
mem->brooding_frame = frame->link; mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
@ -267,24 +274,27 @@ static ase_lsp_obj_t* apply (
// do the evaluation of the body // do the evaluation of the body
value = mem->nil; value = mem->nil;
while (body != mem->nil) { while (body != mem->nil)
{
value = ase_lsp_eval(lsp, ASE_LSP_CAR(body)); value = ase_lsp_eval(lsp, ASE_LSP_CAR(body));
if (value == ASE_NULL) { if (value == ASE_NULL)
{
mem->frame = frame->link; mem->frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
// pop the frame. /* pop the frame. */
mem->frame = frame->link; mem->frame = frame->link;
// destroy the frame. /* destroy the frame. */
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
//if (ASE_LSP_CAR(func) == mem->macro) { //if (ASE_LSP_CAR(func) == mem->macro) {
if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO) { if (ASE_LSP_TYPE(func) == ASE_LSP_OBJ_MACRO)
{
value = ase_lsp_eval(lsp, value); value = ase_lsp_eval(lsp, value);
if (value == ASE_NULL) return ASE_NULL; if (value == ASE_NULL) return ASE_NULL;
} }

19
ase/lsp/lsp.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: lsp.c,v 1.8 2006-10-24 15:31:35 bacon Exp $ * $Id: lsp.c,v 1.9 2006-10-26 08:17:37 bacon Exp $
*/ */
#if defined(__BORLANDC__) #if defined(__BORLANDC__)
@ -20,6 +20,7 @@ ase_lsp_t* ase_lsp_open (
if (syscas == ASE_NULL) return ASE_NULL; if (syscas == ASE_NULL) return ASE_NULL;
if (syscas->malloc == ASE_NULL || if (syscas->malloc == ASE_NULL ||
syscas->realloc == ASE_NULL ||
syscas->free == ASE_NULL) return ASE_NULL; syscas->free == ASE_NULL) return ASE_NULL;
if (syscas->is_upper == ASE_NULL || if (syscas->is_upper == ASE_NULL ||
@ -60,9 +61,9 @@ ase_lsp_t* ase_lsp_open (
else syscas->memcpy (&lsp->syscas, syscas, ase_sizeof(lsp->syscas)); else syscas->memcpy (&lsp->syscas, syscas, ase_sizeof(lsp->syscas));
if (syscas->memset == ASE_NULL) lsp->syscas.memset = ase_lsp_memset; if (syscas->memset == ASE_NULL) lsp->syscas.memset = ase_lsp_memset;
if (ase_lsp_token_open(&lsp->token, 0) == ASE_NULL) if (ase_lsp_name_open(&lsp->token.name, 0, lsp) == ASE_NULL)
{ {
if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); ASE_LSP_FREE (lsp, lsp);
return ASE_NULL; return ASE_NULL;
} }
@ -79,16 +80,16 @@ ase_lsp_t* ase_lsp_open (
lsp->mem = ase_lsp_openmem (lsp, mem_ubound, mem_ubound_inc); lsp->mem = ase_lsp_openmem (lsp, mem_ubound, mem_ubound_inc);
if (lsp->mem == ASE_NULL) if (lsp->mem == ASE_NULL)
{ {
ase_lsp_token_close (&lsp->token); ase_lsp_name_close (&lsp->token.name);
if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); ASE_LSP_FREE (lsp, lsp);
return ASE_NULL; return ASE_NULL;
} }
if (__add_builtin_prims(lsp) == -1) if (__add_builtin_prims(lsp) == -1)
{ {
ase_lsp_closemem (lsp->mem); ase_lsp_closemem (lsp->mem);
ase_lsp_token_close (&lsp->token); ase_lsp_name_close (&lsp->token.name);
if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); ASE_LSP_FREE (lsp, lsp);
return ASE_NULL; return ASE_NULL;
} }
@ -101,8 +102,8 @@ ase_lsp_t* ase_lsp_open (
void ase_lsp_close (ase_lsp_t* lsp) void ase_lsp_close (ase_lsp_t* lsp)
{ {
ase_lsp_closemem (lsp->mem); ase_lsp_closemem (lsp->mem);
ase_lsp_token_close (&lsp->token); ase_lsp_name_close (&lsp->token.name);
if (lsp->__dynamic) ASE_LSP_FREE (lsp, lsp); ASE_LSP_FREE (lsp, lsp);
} }
int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg) int ase_lsp_attach_input (ase_lsp_t* lsp, ase_lsp_io_t input, void* arg)

16
ase/lsp/lsp.dsp
View File

@ -87,10 +87,6 @@ LIB32=link.exe -lib
# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat"
# Begin Source File # Begin Source File
SOURCE=.\array.c
# End Source File
# Begin Source File
SOURCE=.\env.c SOURCE=.\env.c
# End Source File # End Source File
# Begin Source File # Begin Source File
@ -145,20 +141,12 @@ SOURCE=.\print.c
SOURCE=.\read.c SOURCE=.\read.c
# End Source File # End Source File
# Begin Source File
SOURCE=.\token.c
# End Source File
# End Group # End Group
# Begin Group "Header Files" # Begin Group "Header Files"
# PROP Default_Filter "h;hpp;hxx;hm;inl" # PROP Default_Filter "h;hpp;hxx;hm;inl"
# Begin Source File # Begin Source File
SOURCE=.\array.h
# End Source File
# Begin Source File
SOURCE=.\env.h SOURCE=.\env.h
# End Source File # End Source File
# Begin Source File # Begin Source File
@ -187,10 +175,6 @@ SOURCE=.\prim.h
# End Source File # End Source File
# Begin Source File # Begin Source File
SOURCE=.\token.h
# End Source File
# Begin Source File
SOURCE=.\types.h SOURCE=.\types.h
# End Source File # End Source File
# End Group # End Group

15
ase/lsp/lsp_i.h
View File

@ -1,15 +1,17 @@
/* /*
* $Id: lsp_i.h,v 1.1 2006-10-24 15:10:25 bacon Exp $ * $Id: lsp_i.h,v 1.2 2006-10-26 08:17:37 bacon Exp $
*/ */
#ifndef _ASE_LSP_LSPI_H_ #ifndef _ASE_LSP_LSPI_H_
#define _ASE_LSP_LSPI_H_ #define _ASE_LSP_LSPI_H_
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp.h>
#include <ase/lsp/token.h> #include <ase/lsp/env.h>
#include <ase/lsp/obj.h>
#include <ase/lsp/mem.h> #include <ase/lsp/mem.h>
#include <ase/lsp/misc.h> #include <ase/lsp/misc.h>
#include <ase/lsp/prim.h> #include <ase/lsp/prim.h>
#include <ase/lsp/name.h>
#ifdef NDEBUG #ifdef NDEBUG
#define ase_lsp_assert(lsp,expr) ((void)0) #define ase_lsp_assert(lsp,expr) ((void)0)
@ -65,7 +67,13 @@ struct ase_lsp_t
/* for read */ /* for read */
ase_cint_t curc; ase_cint_t curc;
ase_lsp_token_t token; struct
{
int type;
ase_long_t ivalue;
ase_real_t rvalue;
ase_lsp_name_t name;
} token;
/* io functions */ /* io functions */
ase_lsp_io_t input_func; ase_lsp_io_t input_func;
@ -79,7 +87,6 @@ struct ase_lsp_t
/* memory manager */ /* memory manager */
ase_lsp_mem_t* mem; ase_lsp_mem_t* mem;
ase_bool_t __dynamic;
}; };
#endif #endif

3
ase/lsp/makefile.bcc
View File

@ -1,5 +1,4 @@
SRCS = lsp.c name.c token.c array.c mem.c env.c err.c \ SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \
read.c eval.c print.c \
prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c
OBJS = $(SRCS:.c=.obj) OBJS = $(SRCS:.c=.obj)
OUT = aselsp.lib OUT = aselsp.lib

2
ase/lsp/makefile.cl
View File

@ -1,6 +1,6 @@
OUT = aselsp OUT = aselsp
SRCS = lsp.c name.c token.c array.c mem.c env.c err.c read.c eval.c print.c \ SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \
prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c
OBJS = $(SRCS:.c=.obj) OBJS = $(SRCS:.c=.obj)

3
ase/lsp/makefile.in
View File

@ -1,5 +1,4 @@
SRCS = name.c token.c array.c mem.c env.c error.c \ SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \
init.c read.c eval.c print.c \
prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c
OBJS = $(SRCS:.c=.o) OBJS = $(SRCS:.c=.o)
OUT = libaselsp.a OUT = libaselsp.a

51
ase/lsp/mem.c
View File

@ -1,5 +1,5 @@
/* /*
* $Id: mem.c,v 1.14 2006-10-25 13:42:31 bacon Exp $ * $Id: mem.c,v 1.15 2006-10-26 08:17:37 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
@ -18,7 +18,7 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->lsp = lsp; mem->lsp = lsp;
/* create a new root environment frame */ /* create a new root environment frame */
mem->frame = ase_lsp_frame_new (); mem->frame = ase_lsp_newframe (lsp);
if (mem->frame == ASE_NULL) if (mem->frame == ASE_NULL)
{ {
ASE_LSP_FREE (lsp, mem); ASE_LSP_FREE (lsp, mem);
@ -28,13 +28,15 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->brooding_frame = ASE_NULL; mem->brooding_frame = ASE_NULL;
/* create an array to hold temporary objects */ /* create an array to hold temporary objects */
mem->temp_array = ase_lsp_array_new (512); /*
if (mem->temp_array == ASE_NULL) mem->temp_arr = ase_lsp_arr_new (512);
if (mem->temp_arr == ASE_NULL)
{ {
ase_lsp_frame_free (mem->frame); ase_lsp_freeframe (lsp, mem->frame);
ASE_LSP_FREE (lsp, mem); ASE_LSP_FREE (lsp, mem);
return ASE_NULL; return ASE_NULL;
} }
*/
/* initialize object allocation list */ /* initialize object allocation list */
mem->ubound = ubound; mem->ubound = ubound;
@ -69,8 +71,8 @@ ase_lsp_mem_t* ase_lsp_openmem (
mem->macro == ASE_NULL) mem->macro == ASE_NULL)
{ {
ase_lsp_dispose_all (mem); ase_lsp_dispose_all (mem);
ase_lsp_array_free (mem->temp_array); /*ase_lsp_arr_free (mem->temp_arr);*/
ase_lsp_frame_free (mem->frame); ase_lsp_freeframe (lsp, mem->frame);
ASE_LSP_FREE (lsp, mem); ASE_LSP_FREE (lsp, mem);
return ASE_NULL; return ASE_NULL;
} }
@ -83,11 +85,11 @@ void ase_lsp_closemem (ase_lsp_mem_t* mem)
/* dispose of the allocated objects */ /* dispose of the allocated objects */
ase_lsp_dispose_all (mem); ase_lsp_dispose_all (mem);
/* dispose of the temporary object arrays */ /* dispose of the temporary object arrs */
ase_lsp_array_free (mem->temp_array); /*ase_lsp_arr_free (mem->temp_arr);*/
/* dispose of environment frames */ /* dispose of environment frames */
ase_lsp_frame_free (mem->frame); ase_lsp_freeframe (mem->lsp, mem->frame);
/* free the memory */ /* free the memory */
ASE_LSP_FREE (mem->lsp, mem); ASE_LSP_FREE (mem->lsp, mem);
@ -175,7 +177,7 @@ ase_lsp_obj_t* ase_lsp_alloc (ase_lsp_mem_t* mem, int type, ase_size_t size)
ASE_LSP_MARK(obj) = 0; ASE_LSP_MARK(obj) = 0;
ASE_LSP_LOCK(obj) = 0; ASE_LSP_LOCK(obj) = 0;
// insert the object at the head of the used list /* insert the object at the head of the used list */
ASE_LSP_LINK(obj) = mem->used[type]; ASE_LSP_LINK(obj) = mem->used[type];
mem->used[type] = obj; mem->used[type] = obj;
mem->count++; mem->count++;
@ -296,8 +298,8 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
{ {
ase_lsp_frame_t* frame; ase_lsp_frame_t* frame;
ase_lsp_assoc_t* assoc; ase_lsp_assoc_t* assoc;
ase_lsp_array_t* array; /*ase_lsp_arr_t* arr;*/
ase_size_t i; /*ase_size_t i;*/
#if 0 #if 0
ase_dprint0 (ASE_T("marking environment frames\n")); ase_dprint0 (ASE_T("marking environment frames\n"));
@ -353,11 +355,13 @@ static void ase_lsp_markobjsinuse (ase_lsp_mem_t* mem)
#if 0 #if 0
ase_dprint0 (ASE_T("marking termporary objects\n")); ase_dprint0 (ASE_T("marking termporary objects\n"));
#endif #endif
array = mem->temp_array; /*
for (i = 0; i < array->size; i++) arr = mem->temp_arr;
for (i = 0; i < arr->size; i++)
{ {
__mark_obj (mem->lsp, array->buffer[i]); __mark_obj (mem->lsp, arr->buffer[i]);
} }
*/
#if 0 #if 0
ase_dprint0 (ASE_T("marking builtin objects\n")); ase_dprint0 (ASE_T("marking builtin objects\n"));
@ -463,7 +467,7 @@ ase_lsp_obj_t* ase_lsp_makesymobj (
{ {
// if there is a symbol with the same name, it is just used. // if there is a symbol with the same name, it is just used.
if (ase_lsp_strxncmp ( if (ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(obj), ASE_LSP_SYMPTR(obj),
ASE_LSP_SYMLEN(obj), str, len) == 0) return obj; ASE_LSP_SYMLEN(obj), str, len) == 0) return obj;
obj = ASE_LSP_LINK(obj); obj = ASE_LSP_LINK(obj);
} }
@ -474,7 +478,7 @@ ase_lsp_obj_t* ase_lsp_makesymobj (
if (obj == ASE_NULL) return ASE_NULL; if (obj == ASE_NULL) return ASE_NULL;
// fill in the symbol buffer // fill in the symbol buffer
ase_lsp_strncpy (ASE_LSP_SYMVALUE(obj), str, len); ase_lsp_strncpy (ASE_LSP_SYMPTR(obj), str, len);
return obj; return obj;
} }
@ -490,7 +494,7 @@ ase_lsp_obj_t* ase_lsp_makestrobj (
if (obj == ASE_NULL) return ASE_NULL; if (obj == ASE_NULL) return ASE_NULL;
// fill in the string buffer // fill in the string buffer
ase_lsp_strncpy (ASE_LSP_STRVALUE(obj), str, len); ase_lsp_strncpy (ASE_LSP_STRPTR(obj), str, len);
return obj; return obj;
} }
@ -561,7 +565,7 @@ ase_lsp_assoc_t* ase_lsp_lookup (ase_lsp_mem_t* mem, ase_lsp_obj_t* name)
while (frame != ASE_NULL) while (frame != ASE_NULL)
{ {
assoc = ase_lsp_frame_lookup (frame, name); assoc = ase_lsp_lookupinframe (mem->lsp, frame, name);
if (assoc != ASE_NULL) return assoc; if (assoc != ASE_NULL) return assoc;
frame = frame->link; frame = frame->link;
} }
@ -577,8 +581,8 @@ ase_lsp_assoc_t* ase_lsp_setvalue (
assoc = ase_lsp_lookup (mem, name); assoc = ase_lsp_lookup (mem, name);
if (assoc == ASE_NULL) if (assoc == ASE_NULL)
{ {
assoc = ase_lsp_frame_insert_value ( assoc = ase_lsp_insertvalueintoframe (
mem->root_frame, name, value); mem->lsp, mem->root_frame, name, value);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
} }
else assoc->value = value; else assoc->value = value;
@ -594,7 +598,8 @@ ase_lsp_assoc_t* ase_lsp_setfunc (
assoc = ase_lsp_lookup (mem, name); assoc = ase_lsp_lookup (mem, name);
if (assoc == ASE_NULL) if (assoc == ASE_NULL)
{ {
assoc = ase_lsp_frame_insert_func (mem->root_frame, name, func); assoc = ase_lsp_insertfuncintoframe (
mem->lsp, mem->root_frame, name, func);
if (assoc == ASE_NULL) return ASE_NULL; if (assoc == ASE_NULL) return ASE_NULL;
} }
else assoc->func = func; else assoc->func = func;

10
ase/lsp/mem.h
View File

@ -1,13 +1,13 @@
/* /*
* $Id: mem.h,v 1.11 2006-10-25 13:42:31 bacon Exp $ * $Id: mem.h,v 1.12 2006-10-26 08:17:37 bacon Exp $
*/ */
#ifndef _ASE_LSP_MEM_H_ #ifndef _ASE_LSP_MEM_H_
#define _ASE_LSP_MEM_H_ #define _ASE_LSP_MEM_H_
#include <ase/lsp/obj.h> #ifndef _ASE_LSP_LSP_H_
#include <ase/lsp/env.h> #error Never include this file directly. Include <ase/lsp/lsp.h> instead
#include <ase/lsp/array.h> #endif
typedef struct ase_lsp_mem_t ase_lsp_mem_t; typedef struct ase_lsp_mem_t ase_lsp_mem_t;
@ -46,7 +46,7 @@ struct ase_lsp_mem_t
/* /*
* temporary objects * temporary objects
*/ */
ase_lsp_array_t* temp_array; /*ase_lsp_arr_t* temp_arr;*/
}; };

139
ase/lsp/name.c
View File

@ -1,89 +1,101 @@
/* /*
* $Id: name.c,v 1.7 2006-10-25 14:42:40 bacon Exp $ * $Id: name.c,v 1.8 2006-10-26 08:17:37 bacon Exp $
*/ */
#include <ase/lsp/name.h> #include <ase/lsp/lsp_i.h>
ase_lsp_name_t* ase_lsp_name_open ( ase_lsp_name_t* ase_lsp_name_open (
ase_lsp_name_t* name, ase_size_t capacity) ase_lsp_name_t* name, ase_size_t capa, ase_lsp_t* lsp)
{ {
if (capacity == 0) if (capa == 0)
capacity = ase_countof(name->static_buffer) - 1; capa = ase_countof(name->static_buf) - 1;
if (name == ASE_NULL) { if (name == ASE_NULL)
{
name = (ase_lsp_name_t*) name = (ase_lsp_name_t*)
ase_malloc (ase_sizeof(ase_lsp_name_t)); ASE_LSP_MALLOC (lsp, ase_sizeof(ase_lsp_name_t));
if (name == ASE_NULL) return ASE_NULL; if (name == ASE_NULL) return ASE_NULL;
name->__dynamic = ase_true; name->__dynamic = ase_true;
} }
else name->__dynamic = ase_false; else name->__dynamic = ase_false;
if (capacity < ase_countof(name->static_buffer)) { if (capa < ase_countof(name->static_buf))
name->buffer = name->static_buffer; {
name->buf = name->static_buf;
} }
else { else
name->buffer = (ase_char_t*) {
ase_malloc ((capacity + 1) * ase_sizeof(ase_char_t)); name->buf = (ase_char_t*)
if (name->buffer == ASE_NULL) { ASE_LSP_MALLOC (lsp, (capa+1)*ase_sizeof(ase_char_t));
if (name->__dynamic) ase_free (name); if (name->buf == ASE_NULL)
{
if (name->__dynamic) ASE_LSP_FREE (lsp, name);
return ASE_NULL; return ASE_NULL;
} }
} }
name->size = 0; name->size = 0;
name->capacity = capacity; name->capa = capa;
name->buffer[0] = ASE_CHAR('\0'); name->buf[0] = ASE_CHAR('\0');
name->lsp = lsp;
return name; return name;
} }
void ase_lsp_name_close (ase_lsp_name_t* name) void ase_lsp_name_close (ase_lsp_name_t* name)
{ {
if (name->capacity >= ase_countof(name->static_buffer)) { if (name->capa >= ase_countof(name->static_buf))
ase_assert (name->buffer != name->static_buffer); {
ase_free (name->buffer); ase_lsp_assert (name->lsp, name->buf != name->static_buf);
ASE_LSP_FREE (name->lsp, name->buf);
} }
if (name->__dynamic) ase_free (name); if (name->__dynamic) ASE_LSP_FREE (name->lsp, name);
} }
int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c) int ase_lsp_name_addc (ase_lsp_name_t* name, ase_cint_t c)
{ {
if (name->size >= name->capacity) { if (name->size >= name->capa)
/* double the capacity. */ {
ase_size_t new_capacity = name->capacity * 2; /* double the capa. */
ase_size_t new_capa = name->capa * 2;
if (new_capacity >= ase_countof(name->static_buffer)) { if (new_capa >= ase_countof(name->static_buf))
{
ase_char_t* space; ase_char_t* space;
if (name->capacity < ase_countof(name->static_buffer)) { if (name->capa < ase_countof(name->static_buf))
space = (ase_char_t*)ase_malloc ( {
(new_capacity + 1) * ase_sizeof(ase_char_t)); space = (ase_char_t*) ASE_LSP_MALLOC (
name->lsp, (new_capa+1)*ase_sizeof(ase_char_t));
if (space == ASE_NULL) return -1; if (space == ASE_NULL) return -1;
/* don't need to copy up to the terminating null */ /* don't need to copy up to the terminating null */
ase_memcpy (space, name->buffer, ASE_LSP_MEMCPY (name->lsp, space, name->buf,
name->capacity * ase_sizeof(ase_char_t)); name->capa*ase_sizeof(ase_char_t));
} }
else { else
space = (ase_char_t*)ase_realloc (name->buffer, {
(new_capacity + 1) * ase_sizeof(ase_char_t)); space = (ase_char_t*) ASE_LSP_REALLOC (
name->lsp, name->buf,
(new_capa+1)*ase_sizeof(ase_char_t));
if (space == ASE_NULL) return -1; if (space == ASE_NULL) return -1;
} }
name->buffer = space; name->buf = space;
} }
name->capacity = new_capacity; name->capa = new_capa;
} }
name->buffer[name->size++] = c; name->buf[name->size++] = c;
name->buffer[name->size] = ASE_CHAR('\0'); name->buf[name->size] = ASE_CHAR('\0');
return 0; return 0;
} }
int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s) int ase_lsp_name_adds (ase_lsp_name_t* name, const ase_char_t* s)
{ {
while (*s != ASE_CHAR('\0')) { while (*s != ASE_CHAR('\0'))
{
if (ase_lsp_name_addc(name, *s) == -1) return -1; if (ase_lsp_name_addc(name, *s) == -1) return -1;
s++; s++;
} }
@ -94,48 +106,53 @@ 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) void ase_lsp_name_clear (ase_lsp_name_t* name)
{ {
name->size = 0; name->size = 0;
name->buffer[0] = ASE_CHAR('\0'); name->buf[0] = ASE_CHAR('\0');
} }
ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capacity) ase_char_t* ase_lsp_name_yield (ase_lsp_name_t* name, ase_size_t capa)
{ {
ase_char_t* old_buffer, * new_buffer; ase_char_t* old_buf, * new_buf;
if (capacity == 0) if (capa == 0) capa = ase_countof(name->static_buf) - 1;
capacity = ase_countof(name->static_buffer) - 1;
if (name->capacity < ase_countof(name->static_buffer)) { if (name->capa < ase_countof(name->static_buf))
old_buffer = (ase_char_t*) {
ase_malloc((name->capacity + 1) * ase_sizeof(ase_char_t)); old_buf = (ase_char_t*) ASE_LSP_MALLOC (
if (old_buffer == ASE_NULL) return ASE_NULL; name->lsp, (name->capa+1)*ase_sizeof(ase_char_t));
ase_memcpy (old_buffer, name->buffer, if (old_buf == ASE_NULL) return ASE_NULL;
(name->capacity + 1) * ase_sizeof(ase_char_t));
ASE_LSP_MEMCPY (
name->lsp, old_buf, name->buf,
(name->capa+1)*ase_sizeof(ase_char_t));
} }
else old_buffer = name->buffer; else old_buf = name->buf;
if (capacity < ase_countof(name->static_buffer)) { if (capa < ase_countof(name->static_buf))
new_buffer = name->static_buffer; {
new_buf = name->static_buf;
} }
else { else
new_buffer = (ase_char_t*) {
ase_malloc((capacity + 1) * ase_sizeof(ase_char_t)); new_buf = (ase_char_t*) ASE_LSP_MALLOC (
if (new_buffer == ASE_NULL) return ASE_NULL; name->lsp, (capa+1)*ase_sizeof(ase_char_t));
if (new_buf == ASE_NULL) return ASE_NULL;
} }
name->buffer = new_buffer; name->buf = new_buf;
name->size = 0; name->size = 0;
name->capacity = capacity; name->capa = capa;
name->buffer[0] = ASE_CHAR('\0'); name->buf[0] = ASE_CHAR('\0');
return old_buffer; return old_buf;
} }
int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str) int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str)
{ {
ase_char_t* p = name->buffer; ase_char_t* p = name->buf;
ase_size_t index = 0; ase_size_t index = 0;
while (index < name->size) { while (index < name->size)
{
if (*p > *str) return 1; if (*p > *str) return 1;
if (*p < *str) return -1; if (*p < *str) return -1;
index++; p++; str++; index++; p++; str++;

13
ase/lsp/name.h
View File

@ -1,5 +1,5 @@
/* /*
* $Id: name.h,v 1.6 2006-10-25 14:42:40 bacon Exp $ * $Id: name.h,v 1.7 2006-10-26 08:17:37 bacon Exp $
*/ */
#ifndef _ASE_LSP_NAME_H_ #ifndef _ASE_LSP_NAME_H_
@ -10,10 +10,11 @@
struct ase_lsp_name_t struct ase_lsp_name_t
{ {
ase_size_t capacity; ase_size_t capa;
ase_size_t size; ase_size_t size;
ase_char_t* buffer; ase_char_t* buf;
ase_char_t static_buffer[128]; ase_char_t static_buf[128];
ase_lsp_t* lsp;
ase_bool_t __dynamic; ase_bool_t __dynamic;
}; };
@ -24,13 +25,13 @@ extern "C" {
#endif #endif
ase_lsp_name_t* ase_lsp_name_open ( ase_lsp_name_t* ase_lsp_name_open (
ase_lsp_name_t* name, ase_size_t capacity); ase_lsp_name_t* name, ase_size_t capa, ase_lsp_t* lsp);
void ase_lsp_name_close (ase_lsp_name_t* name); 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_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); 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); 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 capacity); 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); int ase_lsp_name_compare (ase_lsp_name_t* name, const ase_char_t* str);
#ifdef __cplusplus #ifdef __cplusplus

14
ase/lsp/obj.h
View File

@ -1,11 +1,13 @@
/* /*
* $Id: obj.h,v 1.8 2006-10-25 13:42:31 bacon Exp $ * $Id: obj.h,v 1.9 2006-10-26 08:17:37 bacon Exp $
*/ */
#ifndef _ASE_LSP_OBJ_H_ #ifndef _ASE_LSP_OBJ_H_
#define _ASE_LSP_OBJ_H_ #define _ASE_LSP_OBJ_H_
#include <ase/lsp/types.h> #ifndef _ASE_LSP_LSP_H_
#error Never include this file directly. Include <ase/lsp/lsp.h> instead
#endif
/* object types */ /* object types */
enum enum
@ -130,16 +132,16 @@ struct ase_lsp_obj_prim_t
#define ASE_LSP_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value) #define ASE_LSP_RVALUE(x) (((ase_lsp_obj_real_t*)x)->value)
#if defined(__BORLANDC__) || defined(_MSC_VER) #if defined(__BORLANDC__) || defined(_MSC_VER)
#define ASE_LSP_SYMVALUE(x) ((ase_char_t*)(((ase_lsp_obj_sym_t*)x) + 1)) #define ASE_LSP_SYMPTR(x) ((ase_char_t*)(((ase_lsp_obj_sym_t*)x) + 1))
#else #else
#define ASE_LSP_SYMVALUE(x) (((ase_lsp_obj_sym_t*)x)->buffer) #define ASE_LSP_SYMPTR(x) (((ase_lsp_obj_sym_t*)x)->buffer)
#endif #endif
#define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_sym_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) #define ASE_LSP_SYMLEN(x) ((((ase_lsp_obj_sym_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1)
#if defined(__BORLANDC__) || defined(_MSC_VER) #if defined(__BORLANDC__) || defined(_MSC_VER)
#define ASE_LSP_STRVALUE(x) ((ase_char_t*)(((ase_lsp_obj_str_t*)x) + 1)) #define ASE_LSP_STRPTR(x) ((ase_char_t*)(((ase_lsp_obj_str_t*)x) + 1))
#else #else
#define ASE_LSP_STRVALUE(x) (((ase_lsp_obj_str_t*)x)->buffer) #define ASE_LSP_STRPTR(x) (((ase_lsp_obj_str_t*)x)->buffer)
#endif #endif
#define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_str_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1) #define ASE_LSP_STRLEN(x) ((((ase_lsp_obj_str_t*)x)->hdr.size - sizeof(ase_lsp_obj_t)) / sizeof(ase_char_t) - 1)

43
ase/lsp/prim.c
View File

@ -1,13 +1,8 @@
/* /*
* $Id: prim.c,v 1.11 2006-10-25 13:42:31 bacon Exp $ * $Id: prim.c,v 1.12 2006-10-26 08:17:37 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp_i.h>
#include <ase/lsp/mem.h>
#include <ase/lsp/prim.h>
#include <ase/bas/string.h>
#include <ase/bas/assert.h>
static int __add_prim (ase_lsp_mem_t* mem, static int __add_prim (ase_lsp_mem_t* mem,
const ase_char_t* name, ase_size_t len, ase_lsp_prim_t prim); const ase_char_t* name, ase_size_t len, ase_lsp_prim_t prim);
@ -15,7 +10,7 @@ static int __add_prim (ase_lsp_mem_t* mem,
int ase_lsp_add_prim ( int ase_lsp_add_prim (
ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim) ase_lsp_t* lsp, const ase_char_t* name, ase_lsp_prim_t prim)
{ {
return __add_prim (lsp->mem, name, ase_strlen(name), prim); return __add_prim (lsp->mem, name, ase_lsp_strlen(name), prim);
} }
int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name) int ase_lsp_remove_prim (ase_lsp_t* lsp, const ase_char_t* name)
@ -32,12 +27,12 @@ static int __add_prim (ase_lsp_mem_t* mem,
n = ase_lsp_makesymobj (mem, name, len); n = ase_lsp_makesymobj (mem, name, len);
if (n == ASE_NULL) return -1; if (n == ASE_NULL) return -1;
ase_lsp_lock (n); ase_lsp_lockobj (mem->lsp, n);
p = ase_lsp_makeprim (mem, prim); p = ase_lsp_makeprim (mem, prim);
if (p == ASE_NULL) return -1; if (p == ASE_NULL) return -1;
ase_lsp_unlock (n); ase_lsp_unlockobj (mem->lsp, n);
if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1; if (ase_lsp_setfunc(mem, n, p) == ASE_NULL) return -1;
@ -56,7 +51,7 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
@ -70,7 +65,7 @@ ase_lsp_obj_t* ase_lsp_prim_eval (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_gc (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 0, 0);
ase_lsp_garbage_collect (lsp->mem); ase_lsp_collectgarbage (lsp->mem);
return lsp->mem->nil; return lsp->mem->nil;
} }
@ -123,7 +118,7 @@ ase_lsp_obj_t* ase_lsp_prim_if (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
@ -162,7 +157,7 @@ ase_lsp_obj_t* ase_lsp_prim_while (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
for (;;) { for (;;) {
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
@ -194,7 +189,7 @@ ase_lsp_obj_t* ase_lsp_prim_car (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
@ -217,7 +212,7 @@ ase_lsp_obj_t* ase_lsp_prim_cdr (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* tmp; ase_lsp_obj_t* tmp;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); tmp = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (tmp == ASE_NULL) return ASE_NULL; if (tmp == ASE_NULL) return ASE_NULL;
@ -241,7 +236,7 @@ ase_lsp_obj_t* ase_lsp_prim_cons (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* car, * cdr, * cons; ase_lsp_obj_t* car, * cdr, * cons;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
car = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); car = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (car == ASE_NULL) return ASE_NULL; if (car == ASE_NULL) return ASE_NULL;
@ -270,7 +265,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p1, * p2; ase_lsp_obj_t* p1, * p2;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 2, 2);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args)); p1 = ase_lsp_eval (lsp, ASE_LSP_CAR(args));
if (p1 == ASE_NULL) return ASE_NULL; if (p1 == ASE_NULL) return ASE_NULL;
@ -284,7 +279,7 @@ ase_lsp_obj_t* ase_lsp_prim_set (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) { if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -301,7 +296,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil; ase_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
while (p != lsp->mem->nil) { while (p != lsp->mem->nil) {
ase_assert (ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS);
p1 = ASE_LSP_CAR(p); p1 = ASE_LSP_CAR(p);
if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM) { if (ASE_LSP_TYPE(p1) != ASE_LSP_OBJ_SYM) {
@ -318,7 +313,7 @@ ase_lsp_obj_t* ase_lsp_prim_setq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (p2 == ASE_NULL) return ASE_NULL; if (p2 == ASE_NULL) return ASE_NULL;
if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) { if (ase_lsp_setvalue (lsp->mem, p1, p2) == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -335,7 +330,7 @@ ase_lsp_obj_t* ase_lsp_prim_quote (ase_lsp_t* lsp, ase_lsp_obj_t* args)
*/ */
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, 1);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
return ASE_LSP_CAR(args); return ASE_LSP_CAR(args);
} }
@ -367,7 +362,7 @@ ase_lsp_obj_t* ase_lsp_prim_defun (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL) if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), fun) == ASE_NULL)
{ {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
return fun; return fun;
@ -397,7 +392,7 @@ ase_lsp_obj_t* ase_lsp_prim_demac (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL) if (ase_lsp_setfunc (lsp->mem, ASE_LSP_CAR(args), mac) == ASE_NULL)
{ {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
return mac; return mac;

53
ase/lsp/prim_compar.c
View File

@ -1,9 +1,8 @@
/* /*
* $Id: prim_compar.c,v 1.5 2006-10-25 13:42:31 bacon Exp $ * $Id: prim_compar.c,v 1.6 2006-10-26 08:17:37 bacon Exp $
*/ */
#include <ase/lsp/prim.h> #include <ase/lsp/lsp_i.h>
#include <ase/bas/assert.h>
ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
@ -57,8 +56,8 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) == 0; ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) == 0;
} }
else else
{ {
@ -71,8 +70,8 @@ ase_lsp_obj_t* ase_lsp_prim_eq (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) == 0; ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) == 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
@ -140,8 +139,8 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) != 0; ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) != 0;
} }
else else
{ {
@ -154,8 +153,8 @@ ase_lsp_obj_t* ase_lsp_prim_ne (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) != 0; ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) != 0;
} }
else else
{ {
@ -224,8 +223,8 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) > 0; ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) > 0;
} }
else else
{ {
@ -238,8 +237,8 @@ ase_lsp_obj_t* ase_lsp_prim_gt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) > 0; ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) > 0;
} }
else else
{ {
@ -308,8 +307,8 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) < 0; ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) < 0;
} }
else else
{ {
@ -322,8 +321,8 @@ ase_lsp_obj_t* ase_lsp_prim_lt (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) < 0; ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) < 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
@ -391,8 +390,8 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) >= 0; ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) >= 0;
} }
else else
{ {
@ -405,8 +404,8 @@ ase_lsp_obj_t* ase_lsp_prim_ge (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) >= 0; ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) >= 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;
@ -474,8 +473,8 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_SYM)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_SYMVALUE(p1), ASE_LSP_SYMLEN(p1), ASE_LSP_SYMPTR(p1), ASE_LSP_SYMLEN(p1),
ASE_LSP_SYMVALUE(p2), ASE_LSP_SYMLEN(p2)) <= 0; ASE_LSP_SYMPTR(p2), ASE_LSP_SYMLEN(p2)) <= 0;
} }
else else
{ {
@ -488,8 +487,8 @@ ase_lsp_obj_t* ase_lsp_prim_le (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR) if (ASE_LSP_TYPE(p2) == ASE_LSP_OBJ_STR)
{ {
res = ase_lsp_strxncmp ( res = ase_lsp_strxncmp (
ASE_LSP_STRVALUE(p1), ASE_LSP_STRLEN(p1), ASE_LSP_STRPTR(p1), ASE_LSP_STRLEN(p1),
ASE_LSP_STRVALUE(p2), ASE_LSP_STRLEN(p2)) <= 0; ASE_LSP_STRPTR(p2), ASE_LSP_STRLEN(p2)) <= 0;
} }
else { else {
lsp->errnum = ASE_LSP_ERR_BAD_VALUE; lsp->errnum = ASE_LSP_ERR_BAD_VALUE;

79
ase/lsp/prim_let.c
View File

@ -1,8 +1,8 @@
/* /*
* $Id: prim_let.c,v 1.6 2006-10-25 13:42:31 bacon Exp $ * $Id: prim_let.c,v 1.7 2006-10-26 08:17:37 bacon Exp $
*/ */
#include <ase/lsp/prim.h> #include <ase/lsp/lsp_i.h>
static ase_lsp_obj_t* __prim_let ( static ase_lsp_obj_t* __prim_let (
ase_lsp_t* lsp, ase_lsp_obj_t* args, int sequential) ase_lsp_t* lsp, ase_lsp_obj_t* args, int sequential)
@ -15,18 +15,21 @@ static ase_lsp_obj_t* __prim_let (
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
// create a new frame // create a new frame
frame = ase_lsp_frame_new (); frame = ase_lsp_newframe (lsp);
if (frame == ASE_NULL) { if (frame == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
//frame->link = lsp->mem->frame; //frame->link = lsp->mem->frame;
if (sequential) { if (sequential)
{
frame->link = lsp->mem->frame; frame->link = lsp->mem->frame;
lsp->mem->frame = frame; lsp->mem->frame = frame;
} }
else { else
{
frame->link = lsp->mem->brooding_frame; frame->link = lsp->mem->brooding_frame;
lsp->mem->brooding_frame = frame; lsp->mem->brooding_frame = frame;
} }
@ -34,72 +37,84 @@ static ase_lsp_obj_t* __prim_let (
assoc = ASE_LSP_CAR(args); assoc = ASE_LSP_CAR(args);
//while (assoc != lsp->mem->nil) { //while (assoc != lsp->mem->nil) {
while (ASE_LSP_TYPE(assoc) == ASE_LSP_OBJ_CONS) { while (ASE_LSP_TYPE(assoc) == ASE_LSP_OBJ_CONS)
{
ase_lsp_obj_t* ass = ASE_LSP_CAR(assoc); ase_lsp_obj_t* ass = ASE_LSP_CAR(assoc);
if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_CONS)
{
ase_lsp_obj_t* n = ASE_LSP_CAR(ass); ase_lsp_obj_t* n = ASE_LSP_CAR(ass);
ase_lsp_obj_t* v = ASE_LSP_CDR(ass); ase_lsp_obj_t* v = ASE_LSP_CDR(ass);
if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYM) { if (ASE_LSP_TYPE(n) != ASE_LSP_OBJ_SYM)
{
lsp->errnum = ASE_LSP_ERR_BAD_ARG; // must be a symbol lsp->errnum = ASE_LSP_ERR_BAD_ARG; // must be a symbol
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
if (v != lsp->mem->nil) { if (v != lsp->mem->nil)
if (ASE_LSP_CDR(v) != lsp->mem->nil) { {
if (ASE_LSP_CDR(v) != lsp->mem->nil)
{
lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; // must be a symbol lsp->errnum = ASE_LSP_ERR_TOO_MANY_ARGS; // must be a symbol
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
if ((v = ase_lsp_eval(lsp, ASE_LSP_CAR(v))) == ASE_NULL) { if ((v = ase_lsp_eval(lsp, ASE_LSP_CAR(v))) == ASE_NULL)
{
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
} }
if (ase_lsp_frame_lookup (frame, n) != ASE_NULL) { if (ase_lsp_lookupinframe (lsp, frame, n) != ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
if (ase_lsp_frame_insert_value(frame, n, v) == ASE_NULL) { if (ase_lsp_insertvalueintoframe (lsp, frame, n, v) == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
} }
else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYM) { else if (ASE_LSP_TYPE(ass) == ASE_LSP_OBJ_SYM)
if (ase_lsp_frame_lookup(frame, ass) != ASE_NULL) { {
if (ase_lsp_lookupinframe (lsp, frame, ass) != ASE_NULL)
{
lsp->errnum = ASE_LSP_ERR_DUP_FORMAL; lsp->errnum = ASE_LSP_ERR_DUP_FORMAL;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
if (ase_lsp_frame_insert_value(frame, ass, lsp->mem->nil) == ASE_NULL) { if (ase_lsp_insertvalueintoframe (lsp, frame, ass, lsp->mem->nil) == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
} }
else { else
{
lsp->errnum = ASE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
@ -110,7 +125,7 @@ static ase_lsp_obj_t* __prim_let (
lsp->errnum = ASE_LSP_ERR_BAD_ARG; lsp->errnum = ASE_LSP_ERR_BAD_ARG;
if (sequential) lsp->mem->frame = frame->link; if (sequential) lsp->mem->frame = frame->link;
else lsp->mem->brooding_frame = frame->link; else lsp->mem->brooding_frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
@ -128,7 +143,7 @@ static ase_lsp_obj_t* __prim_let (
value = ase_lsp_eval (lsp, ASE_LSP_CAR(body)); value = ase_lsp_eval (lsp, ASE_LSP_CAR(body));
if (value == ASE_NULL) { if (value == ASE_NULL) {
lsp->mem->frame = frame->link; lsp->mem->frame = frame->link;
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return ASE_NULL; return ASE_NULL;
} }
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
@ -138,7 +153,7 @@ static ase_lsp_obj_t* __prim_let (
lsp->mem->frame = frame->link; lsp->mem->frame = frame->link;
// destroy the frame // destroy the frame
ase_lsp_frame_free (frame); ase_lsp_freeframe (lsp, frame);
return value; return value;
} }

58
ase/lsp/prim_math.c
View File

@ -1,9 +1,8 @@
/* /*
* $Id: prim_math.c,v 1.9 2006-10-25 13:42:31 bacon Exp $ * $Id: prim_math.c,v 1.10 2006-10-26 08:17:38 bacon Exp $
*/ */
#include <ase/lsp/prim.h> #include <ase/lsp/lsp_i.h>
#include <ase/bas/assert.h>
ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
@ -13,7 +12,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
@ -26,7 +25,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
@ -38,7 +37,7 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
@ -59,13 +58,13 @@ ase_lsp_obj_t* ase_lsp_prim_plus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
ase_assert (body == lsp->mem->nil); ase_lsp_assert (lsp, body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -80,7 +79,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
@ -91,7 +90,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
@ -103,7 +102,7 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
@ -124,13 +123,13 @@ ase_lsp_obj_t* ase_lsp_prim_minus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
ase_assert (body == lsp->mem->nil); ase_lsp_assert (lsp, body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -145,7 +144,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
@ -156,7 +155,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
@ -168,7 +167,7 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
@ -189,13 +188,13 @@ ase_lsp_obj_t* ase_lsp_prim_multiply (ase_lsp_t* lsp, ase_lsp_obj_t* args)
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
ase_assert (body == lsp->mem->nil); ase_lsp_assert (lsp, body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_MEMORY; lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -210,7 +209,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_bool_t realnum = ase_false; ase_bool_t realnum = ase_false;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
@ -221,13 +220,13 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) { if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_INT) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
ivalue = ASE_LSP_IVALUE(tmp); ivalue = ASE_LSP_IVALUE(tmp);
} }
else { else {
if (!realnum) { if (!realnum) {
if (ASE_LSP_IVALUE(tmp) == 0) { if (ASE_LSP_IVALUE(tmp) == 0) {
lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL; return ASE_NULL;
} }
ivalue = ivalue / ASE_LSP_IVALUE(tmp); ivalue = ivalue / ASE_LSP_IVALUE(tmp);
@ -238,7 +237,7 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) { else if (ASE_LSP_TYPE(tmp) == ASE_LSP_OBJ_REAL) {
if (body == args) { if (body == args) {
ase_assert (realnum == ase_false); ase_lsp_assert (lsp, realnum == ase_false);
realnum = ase_true; realnum = ase_true;
rvalue = ASE_LSP_RVALUE(tmp); rvalue = ASE_LSP_RVALUE(tmp);
} }
@ -259,13 +258,14 @@ ase_lsp_obj_t* ase_lsp_prim_divide (ase_lsp_t* lsp, ase_lsp_obj_t* args)
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
ase_assert (body == lsp->mem->nil); ase_lsp_assert (lsp, body == lsp->mem->nil);
tmp = (realnum)? tmp = (realnum)?
ase_lsp_makerealobj (lsp->mem, rvalue): ase_lsp_makerealobj (lsp->mem, rvalue):
ase_lsp_makeintobj (lsp->mem, ivalue); ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) { if (tmp == ASE_NULL)
lsp->errnum = ASE_LSP_ERR_MEMORY; {
lsp->errnum = ASE_LSP_ENOMEM;
return ASE_NULL; return ASE_NULL;
} }
@ -278,7 +278,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
ase_long_t ivalue = 0; ase_long_t ivalue = 0;
ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT); ASE_LSP_PRIM_CHECK_ARG_COUNT (lsp, args, 1, ASE_LSP_PRIM_MAX_ARG_COUNT);
ase_assert (ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS); ase_lsp_assert (lsp, ASE_LSP_TYPE(args) == ASE_LSP_OBJ_CONS);
body = args; body = args;
//while (body != lsp->mem->nil) { //while (body != lsp->mem->nil) {
@ -292,7 +292,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
} }
else { else {
if (ASE_LSP_IVALUE(tmp) == 0) { if (ASE_LSP_IVALUE(tmp) == 0) {
lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL; return ASE_NULL;
} }
ivalue = ivalue % ASE_LSP_IVALUE(tmp); ivalue = ivalue % ASE_LSP_IVALUE(tmp);
@ -305,7 +305,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
else { else {
ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp); ase_long_t tmpi = (ase_long_t)ASE_LSP_RVALUE(tmp);
if (tmpi == 0) { if (tmpi == 0) {
lsp->errnum = ASE_LSP_ERR_DIVIDE_BY_ZERO; lsp->errnum = ASE_LSP_EDIVBYZERO;
return ASE_NULL; return ASE_NULL;
} }
ivalue = ivalue % tmpi; ivalue = ivalue % tmpi;
@ -320,7 +320,7 @@ ase_lsp_obj_t* ase_lsp_prim_modulus (ase_lsp_t* lsp, ase_lsp_obj_t* args)
body = ASE_LSP_CDR(body); body = ASE_LSP_CDR(body);
} }
ase_assert (body == lsp->mem->nil); ase_lsp_assert (lsp, body == lsp->mem->nil);
tmp = ase_lsp_makeintobj (lsp->mem, ivalue); tmp = ase_lsp_makeintobj (lsp->mem, ivalue);
if (tmp == ASE_NULL) if (tmp == ASE_NULL)

8
ase/lsp/prim_prog.c
View File

@ -1,8 +1,8 @@
/* /*
* $Id: prim_prog.c,v 1.3 2006-10-24 04:22:39 bacon Exp $ * $Id: prim_prog.c,v 1.4 2006-10-26 08:17:38 bacon Exp $
*/ */
#include <ase/lsp/prim.h> #include <ase/lsp/lsp_i.h>
ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args) ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
{ {
@ -18,8 +18,8 @@ ase_lsp_obj_t* ase_lsp_prim_prog1 (ase_lsp_t* lsp, ase_lsp_obj_t* args)
if (res == ASE_NULL) { if (res == ASE_NULL) {
/* /*
ase_lsp_array_t* ta = lsp->mem->temp_array; ase_lsp_arr_t* ta = lsp->mem->temp_arr;
ase_lsp_array_insert (ta, ta->size, tmp); ase_lsp_arr_insert (ta, ta->size, tmp);
*/ */
res = tmp; res = tmp;
} }

121
ase/lsp/print.c
View File

@ -1,67 +1,67 @@
/* /*
* $Id: print.c,v 1.15 2006-10-25 13:42:31 bacon Exp $ * $Id: print.c,v 1.16 2006-10-26 08:17:38 bacon Exp $
*/ */
#include <ase/lsp/lsp.h> #include <ase/lsp/lsp_i.h>
#include <ase/bas/stdio.h>
#include <ase/bas/string.h>
#if 0
void ase_lsp_print_debug (ase_lsp_obj_t* obj) void ase_lsp_print_debug (ase_lsp_obj_t* obj)
{ {
switch (ASE_LSP_TYPE(obj)) { switch (ASE_LSP_TYPE(obj)) {
case ASE_LSP_OBJ_NIL: case ASE_LSP_OBJ_NIL:
ase_printf (ASE_TEXT("nil")); ase_printf (ASE_T("nil"));
break; break;
case ASE_LSP_OBJ_TRUE: case ASE_LSP_OBJ_TRUE:
ase_printf (ASE_TEXT("t")); ase_printf (ASE_T("t"));
break; break;
case ASE_LSP_OBJ_INT: case ASE_LSP_OBJ_INT:
ase_printf (ASE_TEXT("%d"), ASE_LSP_IVALUE(obj)); ase_printf (ASE_T("%d"), ASE_LSP_IVALUE(obj));
break; break;
case ASE_LSP_OBJ_REAL: case ASE_LSP_OBJ_REAL:
ase_printf (ASE_TEXT("%f"), ASE_LSP_RVALUE(obj)); ase_printf (ASE_T("%f"), ASE_LSP_RVALUE(obj));
break; break;
case ASE_LSP_OBJ_SYM: case ASE_LSP_OBJ_SYM:
ase_printf (ASE_TEXT("%s"), ASE_LSP_SYMVALUE(obj)); ase_printf (ASE_T("%s"), ASE_LSP_SYMPTR(obj));
break; break;
case ASE_LSP_OBJ_STR: case ASE_LSP_OBJ_STR:
ase_printf (ASE_TEXT("%s"), ASE_LSP_STRVALUE(obj)); ase_printf (ASE_T("%s"), ASE_LSP_STRPTR(obj));
break; break;
case ASE_LSP_OBJ_CONS: case ASE_LSP_OBJ_CONS:
{ {
ase_lsp_obj_t* p = obj; ase_lsp_obj_t* p = obj;
ase_printf (ASE_TEXT("(")); ase_printf (ASE_T("("));
do { do {
ase_lsp_print_debug (ASE_LSP_CAR(p)); ase_lsp_print_debug (ASE_LSP_CAR(p));
p = ASE_LSP_CDR(p); p = ASE_LSP_CDR(p);
if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL) { if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL) {
ase_printf (ASE_TEXT(" ")); ase_printf (ASE_T(" "));
if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) { if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) {
ase_printf (ASE_TEXT(". ")); ase_printf (ASE_T(". "));
ase_lsp_print_debug (p); ase_lsp_print_debug (p);
} }
} }
} while (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); } while (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_NIL && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS);
ase_printf (ASE_TEXT(")")); ase_printf (ASE_T(")"));
} }
break; break;
case ASE_LSP_OBJ_FUNC: case ASE_LSP_OBJ_FUNC:
ase_printf (ASE_TEXT("func")); ase_printf (ASE_T("func"));
break; break;
case ASE_LSP_OBJ_MACRO: case ASE_LSP_OBJ_MACRO:
ase_printf (ASE_TEXT("macro")); ase_printf (ASE_T("macro"));
break; break;
case ASE_LSP_OBJ_PRIM: case ASE_LSP_OBJ_PRIM:
ase_printf (ASE_TEXT("prim")); ase_printf (ASE_T("prim"));
break; break;
default: default:
ase_printf (ASE_TEXT("unknown object type: %d"), ASE_LSP_TYPE(obj)); ase_printf (ASE_T("unknown object type: %d"), ASE_LSP_TYPE(obj));
} }
} }
#endif
#define OUTPUT_STR(lsp,str) \ #define OUTPUT_STR(lsp,str) \
do { \ do { \
if (lsp->output_func(ASE_LSP_IO_DATA, lsp->output_arg, (ase_char_t*)str, ase_strlen(str)) == -1) { \ if (lsp->output_func(ASE_LSP_IO_WRITE, lsp->output_arg, (ase_char_t*)str, ase_lsp_strlen(str)) == -1) { \
lsp->errnum = ASE_LSP_ERR_OUTPUT; \ lsp->errnum = ASE_LSP_ERR_OUTPUT; \
return -1; \ return -1; \
} \ } \
@ -69,7 +69,7 @@ void ase_lsp_print_debug (ase_lsp_obj_t* obj)
#define OUTPUT_STRX(lsp,str,len) \ #define OUTPUT_STRX(lsp,str,len) \
do { \ do { \
if (lsp->output_func(ASE_LSP_IO_DATA, lsp->output_arg, (ase_char_t*)str, len) == -1) { \ if (lsp->output_func(ASE_LSP_IO_WRITE, lsp->output_arg, (ase_char_t*)str, len) == -1) { \
lsp->errnum = ASE_LSP_ERR_OUTPUT; \ lsp->errnum = ASE_LSP_ERR_OUTPUT; \
return -1; \ return -1; \
} \ } \
@ -86,82 +86,103 @@ static int __print (ase_lsp_t* lsp, const ase_lsp_obj_t* obj, ase_bool_t prt_con
switch (ASE_LSP_TYPE(obj)) { switch (ASE_LSP_TYPE(obj)) {
case ASE_LSP_OBJ_NIL: case ASE_LSP_OBJ_NIL:
OUTPUT_STR (lsp, ASE_TEXT("nil")); OUTPUT_STR (lsp, ASE_T("nil"));
break; break;
case ASE_LSP_OBJ_TRUE: case ASE_LSP_OBJ_TRUE:
OUTPUT_STR (lsp, ASE_TEXT("t")); OUTPUT_STR (lsp, ASE_T("t"));
break; break;
case ASE_LSP_OBJ_INT: case ASE_LSP_OBJ_INT:
if (ase_sizeof(ase_long_t) == ase_sizeof(int)) { if (ase_sizeof(ase_long_t) == ase_sizeof(int)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%d"), ASE_LSP_IVALUE(obj)); lsp->syscas.sprintf (
buf, ase_countof(buf),
ASE_T("%d"), ASE_LSP_IVALUE(obj));
} }
else if (ase_sizeof(ase_long_t) == ase_sizeof(long)) { else if (ase_sizeof(ase_long_t) == ase_sizeof(long))
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%ld"), ASE_LSP_IVALUE(obj)); {
lsp->syscas.sprintf (
buf, ase_countof(buf),
ASE_T("%ld"), ASE_LSP_IVALUE(obj));
} }
else if (ase_sizeof(ase_long_t) == ase_sizeof(long long)) { #if defined(__BORLANDC__) || defined(_MSC_VER)
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%lld"), ASE_LSP_IVALUE(obj)); else if (ase_sizeof(ase_long_t) == ase_sizeof(__int64))
{
lsp->syscas.sprintf (
buf, ase_countof(buf),
ASE_T("%I64d"), ASE_LSP_IVALUE(obj));
} }
#else
else if (ase_sizeof(ase_long_t) == ase_sizeof(long long))
{
lsp->syscas.sprintf (
buf, ase_countof(buf),
ASE_T("%lld"), ASE_LSP_IVALUE(obj));
}
#endif
OUTPUT_STR (lsp, buf); OUTPUT_STR (lsp, buf);
break; break;
case ASE_LSP_OBJ_REAL: case ASE_LSP_OBJ_REAL:
if (ase_sizeof(ase_real_t) == ase_sizeof(double)) { if (ase_sizeof(ase_real_t) == ase_sizeof(double)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%f"), lsp->syscas.sprintf (buf, ase_countof(buf), ASE_T("%f"),
(double)ASE_LSP_RVALUE(obj)); (double)ASE_LSP_RVALUE(obj));
} }
else if (ase_sizeof(ase_real_t) == ase_sizeof(long double)) { else if (ase_sizeof(ase_real_t) == ase_sizeof(long double)) {
ase_sprintf (buf, ase_countof(buf), ASE_TEXT("%Lf"), lsp->syscas.sprintf (buf, ase_countof(buf), ASE_T("%Lf"),
(long double)ASE_LSP_RVALUE(obj)); (long double)ASE_LSP_RVALUE(obj));
} }
OUTPUT_STR (lsp, buf); OUTPUT_STR (lsp, buf);
break; break;
case ASE_LSP_OBJ_SYM: case ASE_LSP_OBJ_SYM:
OUTPUT_STR (lsp, ASE_LSP_SYMVALUE(obj)); OUTPUT_STR (lsp, ASE_LSP_SYMPTR(obj));
break; break;
case ASE_LSP_OBJ_STR: case ASE_LSP_OBJ_STR:
OUTPUT_STR (lsp, ASE_LSP_STRVALUE(obj)); OUTPUT_STR (lsp, ASE_LSP_STRPTR(obj));
break; break;
case ASE_LSP_OBJ_CONS: case ASE_LSP_OBJ_CONS:
{ {
const ase_lsp_obj_t* p = obj; const ase_lsp_obj_t* p = obj;
if (prt_cons_par) OUTPUT_STR (lsp, ASE_TEXT("(")); if (prt_cons_par) OUTPUT_STR (lsp, ASE_T("("));
do { do
{
ase_lsp_print (lsp, ASE_LSP_CAR(p)); ase_lsp_print (lsp, ASE_LSP_CAR(p));
p = ASE_LSP_CDR(p); p = ASE_LSP_CDR(p);
if (p != lsp->mem->nil) { if (p != lsp->mem->nil)
OUTPUT_STR (lsp, ASE_TEXT(" ")); {
if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS) { OUTPUT_STR (lsp, ASE_T(" "));
OUTPUT_STR (lsp, ASE_TEXT(". ")); if (ASE_LSP_TYPE(p) != ASE_LSP_OBJ_CONS)
{
OUTPUT_STR (lsp, ASE_T(". "));
ase_lsp_print (lsp, p); ase_lsp_print (lsp, p);
} }
} }
} while (p != lsp->mem->nil && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS); }
if (prt_cons_par) OUTPUT_STR (lsp, ASE_TEXT(")")); while (p != lsp->mem->nil && ASE_LSP_TYPE(p) == ASE_LSP_OBJ_CONS);
if (prt_cons_par) OUTPUT_STR (lsp, ASE_T(")"));
} }
break; break;
case ASE_LSP_OBJ_FUNC: case ASE_LSP_OBJ_FUNC:
/*OUTPUT_STR (lsp, ASE_TEXT("func"));*/ /*OUTPUT_STR (lsp, ASE_T("func"));*/
OUTPUT_STR (lsp, ASE_TEXT("(lambda ")); OUTPUT_STR (lsp, ASE_T("(lambda "));
if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1; if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1;
OUTPUT_STR (lsp, ASE_TEXT(" ")); OUTPUT_STR (lsp, ASE_T(" "));
if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1; if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1;
OUTPUT_STR (lsp, ASE_TEXT(")")); OUTPUT_STR (lsp, ASE_T(")"));
break; break;
case ASE_LSP_OBJ_MACRO: case ASE_LSP_OBJ_MACRO:
/*OUTPUT_STR (lsp, ASE_TEXT("macro"));*/ /*OUTPUT_STR (lsp, ASE_T("macro"));*/
OUTPUT_STR (lsp, ASE_TEXT("(macro ")); OUTPUT_STR (lsp, ASE_T("(macro "));
if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1; if (__print (lsp, ASE_LSP_FFORMAL(obj), ase_true) == -1) return -1;
OUTPUT_STR (lsp, ASE_TEXT(" ")); OUTPUT_STR (lsp, ASE_T(" "));
if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1; if (__print (lsp, ASE_LSP_FBODY(obj), ase_false) == -1) return -1;
OUTPUT_STR (lsp, ASE_TEXT(")")); OUTPUT_STR (lsp, ASE_T(")"));
break; break;
case ASE_LSP_OBJ_PRIM: case ASE_LSP_OBJ_PRIM:
OUTPUT_STR (lsp, ASE_TEXT("prim")); OUTPUT_STR (lsp, ASE_T("prim"));
break; break;
default: default:
ase_sprintf (buf, ase_countof(buf), lsp->syscas.sprintf (buf, ase_countof(buf),
ASE_TEXT("unknown object type: %d"), ASE_LSP_TYPE(obj)); ASE_T("unknown object type: %d"), ASE_LSP_TYPE(obj));
OUTPUT_STR (lsp, buf); OUTPUT_STR (lsp, buf);
} }

91
ase/lsp/read.c
View File

@ -1,14 +1,9 @@
/* /*
* $Id: read.c,v 1.22 2006-10-25 13:42:31 bacon Exp $ * $Id: read.c,v 1.23 2006-10-26 08:17:38 bacon Exp $
*/ */
#include <ase/lsp/lsp_i.h> #include <ase/lsp/lsp_i.h>
#define IS_SPACE(x) ase_isspace(x)
#define IS_DIGIT(x) ase_isdigit(x)
#define IS_ALPHA(x) ase_isalpha(x)
#define IS_ALNUM(x) ase_isalnum(x)
#define IS_IDENT(c) \ #define IS_IDENT(c) \
((c) == ASE_T('+') || (c) == ASE_T('-') || \ ((c) == ASE_T('+') || (c) == ASE_T('-') || \
(c) == ASE_T('*') || (c) == ASE_T('/') || \ (c) == ASE_T('*') || (c) == ASE_T('/') || \
@ -17,21 +12,21 @@
(c) == ASE_T('=') || (c) == ASE_T('_') || \ (c) == ASE_T('=') || (c) == ASE_T('_') || \
(c) == ASE_T('?')) (c) == ASE_T('?'))
#define TOKEN_CLEAR(lsp) ase_lsp_token_clear (&(lsp)->token) #define TOKEN_CLEAR(lsp) ase_lsp_name_clear (&(lsp)->token.name)
#define TOKEN_TYPE(lsp) (lsp)->token.type #define TOKEN_TYPE(lsp) (lsp)->token.type
#define TOKEN_IVALUE(lsp) (lsp)->token.ivalue #define TOKEN_IVALUE(lsp) (lsp)->token.ivalue
#define TOKEN_RVALUE(lsp) (lsp)->token.rvalue #define TOKEN_RVALUE(lsp) (lsp)->token.rvalue
#define TOKEN_SVALUE(lsp) (lsp)->token.name.buffer #define TOKEN_SVALUE(lsp) (lsp)->token.name.buf
#define TOKEN_SLENGTH(lsp) (lsp)->token.name.size #define TOKEN_SLENGTH(lsp) (lsp)->token.name.size
#define TOKEN_ADD_CHAR(lsp,ch) do { \ #define TOKEN_ADD_CHAR(lsp,ch) do { \
if (ase_lsp_token_addc(&(lsp)->token, ch) == -1) { \ if (ase_lsp_name_addc(&(lsp)->token.name, ch) == -1) { \
lsp->errnum = ASE_LSP_ENOMEM; \ lsp->errnum = ASE_LSP_ENOMEM; \
return -1; \ return -1; \
} \ } \
} while (0) } while (0)
#define TOKEN_COMPARE(lsp,str) ase_lsp_token_compare_name (&(lsp)->token, str) #define TOKEN_COMPARE(lsp,str) ase_lsp_name_compare (&(lsp)->token.name, str)
#define TOKEN_END 0 #define TOKEN_END 0
#define TOKEN_INT 1 #define TOKEN_INT 1
@ -82,7 +77,8 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
{ {
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
switch (TOKEN_TYPE(lsp)) { switch (TOKEN_TYPE(lsp))
{
case TOKEN_END: case TOKEN_END:
lsp->errnum = ASE_LSP_ERR_END; lsp->errnum = ASE_LSP_ERR_END;
return ASE_NULL; return ASE_NULL;
@ -109,7 +105,8 @@ static ase_lsp_obj_t* read_obj (ase_lsp_t* lsp)
ase_lsp_lockobj (lsp, obj); ase_lsp_lockobj (lsp, obj);
return obj; return obj;
case TOKEN_IDENT: case TOKEN_IDENT:
ase_assert (lsp->mem->nil != ASE_NULL && lsp->mem->t != ASE_NULL); 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; 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 if (TOKEN_COMPARE(lsp,ASE_T("t")) == 0) obj = lsp->mem->t;
else else
@ -131,13 +128,16 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
ase_lsp_obj_t* obj; ase_lsp_obj_t* obj;
ase_lsp_obj_cons_t* p, * first = ASE_NULL, * prev = ASE_NULL; ase_lsp_obj_cons_t* p, * first = ASE_NULL, * prev = ASE_NULL;
while (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { while (TOKEN_TYPE(lsp) != TOKEN_RPAREN)
if (TOKEN_TYPE(lsp) == TOKEN_END) { {
if (TOKEN_TYPE(lsp) == TOKEN_END)
{
lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected end of input lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected end of input
return ASE_NULL; return ASE_NULL;
} }
if (TOKEN_TYPE(lsp) == TOKEN_DOT) { if (TOKEN_TYPE(lsp) == TOKEN_DOT)
{
if (prev == ASE_NULL) { if (prev == ASE_NULL) {
lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected . lsp->errnum = ASE_LSP_ERR_SYNTAX; // unexpected .
return ASE_NULL; return ASE_NULL;
@ -145,8 +145,10 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
obj = read_obj (lsp); obj = read_obj (lsp);
if (obj == ASE_NULL) { if (obj == ASE_NULL)
if (lsp->errnum == ASE_LSP_ERR_END) { {
if (lsp->errnum == ASE_LSP_ERR_END)
{
//unexpected end of input //unexpected end of input
lsp->errnum = ASE_LSP_ERR_SYNTAX; lsp->errnum = ASE_LSP_ERR_SYNTAX;
} }
@ -155,7 +157,8 @@ static ase_lsp_obj_t* read_list (ase_lsp_t* lsp)
prev->cdr = obj; prev->cdr = obj;
NEXT_TOKEN (lsp); NEXT_TOKEN (lsp);
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN) { if (TOKEN_TYPE(lsp) != TOKEN_RPAREN)
{
lsp->errnum = ASE_LSP_ERR_SYNTAX; // ) expected lsp->errnum = ASE_LSP_ERR_SYNTAX; // ) expected
return ASE_NULL; return ASE_NULL;
} }
@ -239,7 +242,7 @@ static int read_char (ase_lsp_t* lsp)
return -1; return -1;
} }
n = lsp->input_func(ASE_LSP_IO_DATA, lsp->input_arg, &lsp->curc, 1); n = lsp->input_func(ASE_LSP_IO_READ, lsp->input_arg, &lsp->curc, 1);
if (n == -1) if (n == -1)
{ {
lsp->errnum = ASE_LSP_ERR_INPUT; lsp->errnum = ASE_LSP_ERR_INPUT;
@ -252,14 +255,14 @@ static int read_char (ase_lsp_t* lsp)
static int read_token (ase_lsp_t* lsp) static int read_token (ase_lsp_t* lsp)
{ {
ase_assert (lsp->input_func != ASE_NULL); ase_lsp_assert (lsp, lsp->input_func != ASE_NULL);
TOKEN_CLEAR (lsp); TOKEN_CLEAR (lsp);
while (1) while (1)
{ {
// skip white spaces // skip white spaces
while (IS_SPACE(lsp->curc)) NEXT_CHAR (lsp); while (ASE_LSP_ISSPACE(lsp, lsp->curc)) NEXT_CHAR (lsp);
// skip the comments here // skip the comments here
if (lsp->curc == ASE_T(';')) if (lsp->curc == ASE_T(';'))
@ -268,7 +271,8 @@ static int read_token (ase_lsp_t* lsp)
{ {
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} }
while (lsp->curc != ASE_T('\n') && lsp->curc != ASE_CHAR_EOF); while (lsp->curc != ASE_T('\n') &&
lsp->curc != ASE_CHAR_EOF);
} }
else break; else break;
} }
@ -310,7 +314,7 @@ static int read_token (ase_lsp_t* lsp)
{ {
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
if (IS_DIGIT(lsp->curc)) if (ASE_LSP_ISDIGIT(lsp,lsp->curc))
{ {
return read_number (lsp, 1); return read_number (lsp, 1);
} }
@ -324,11 +328,11 @@ static int read_token (ase_lsp_t* lsp)
return 0; return 0;
} }
} }
else if (IS_DIGIT(lsp->curc)) else if (ASE_LSP_ISDIGIT(lsp,lsp->curc))
{ {
return read_number (lsp, 0); return read_number (lsp, 0);
} }
else if (IS_ALPHA(lsp->curc) || IS_IDENT(lsp->curc)) else if (ASE_LSP_ISALPHA(lsp,lsp->curc) || IS_IDENT(lsp->curc))
{ {
return read_ident (lsp); return read_ident (lsp);
} }
@ -354,7 +358,7 @@ static int read_number (ase_lsp_t* lsp, int negative)
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} }
while (IS_DIGIT(lsp->curc)); while (ASE_LSP_ISDIGIT(lsp,lsp->curc));
/* TODO: extend parsing floating point number */ /* TODO: extend parsing floating point number */
if (lsp->curc == ASE_T('.')) if (lsp->curc == ASE_T('.'))
@ -364,7 +368,7 @@ static int read_number (ase_lsp_t* lsp, int negative)
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
rvalue = (ase_real_t)ivalue; rvalue = (ase_real_t)ivalue;
while (IS_DIGIT(lsp->curc)) while (ASE_LSP_ISDIGIT(lsp, lsp->curc))
{ {
rvalue += (ase_real_t)(lsp->curc - ASE_T('0')) * fraction; rvalue += (ase_real_t)(lsp->curc - ASE_T('0')) * fraction;
fraction *= 0.1; fraction *= 0.1;
@ -386,10 +390,12 @@ static int read_number (ase_lsp_t* lsp, int negative)
static int read_ident (ase_lsp_t* lsp) static int read_ident (ase_lsp_t* lsp)
{ {
do { do
{
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (IS_ALNUM(lsp->curc) || IS_IDENT(lsp->curc)); }
while (ASE_LSP_ISALNUM(lsp,lsp->curc) || IS_IDENT(lsp->curc));
TOKEN_TYPE(lsp) = TOKEN_IDENT; TOKEN_TYPE(lsp) = TOKEN_IDENT;
return 0; return 0;
} }
@ -399,20 +405,25 @@ static int read_string (ase_lsp_t* lsp)
int escaped = 0; int escaped = 0;
ase_cint_t code = 0; ase_cint_t code = 0;
do { do
if (lsp->curc == ASE_CHAR_EOF) { {
if (lsp->curc == ASE_CHAR_EOF)
{
TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING; TOKEN_TYPE(lsp) = TOKEN_UNTERM_STRING;
return 0; return 0;
} }
// TODO: // TODO:
if (escaped == 3) { if (escaped == 3)
{
/* \xNN */ /* \xNN */
} }
else if (escaped == 2) { else if (escaped == 2)
{
/* \000 */ /* \000 */
} }
else if (escaped == 1) { else if (escaped == 1)
{
/* backslash + character */ /* backslash + character */
if (lsp->curc == ASE_T('a')) if (lsp->curc == ASE_T('a'))
lsp->curc = ASE_T('\a'); lsp->curc = ASE_T('\a');
@ -428,20 +439,23 @@ static int read_string (ase_lsp_t* lsp)
lsp->curc = ASE_T('\t'); lsp->curc = ASE_T('\t');
else if (lsp->curc == ASE_T('v')) else if (lsp->curc == ASE_T('v'))
lsp->curc = ASE_T('\v'); lsp->curc = ASE_T('\v');
else if (lsp->curc == ASE_T('0')) { else if (lsp->curc == ASE_T('0'))
{
escaped = 2; escaped = 2;
code = 0; code = 0;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
} }
else if (lsp->curc == ASE_T('x')) { else if (lsp->curc == ASE_T('x'))
{
escaped = 3; escaped = 3;
code = 0; code = 0;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
} }
} }
else if (lsp->curc == ASE_T('\\')) { else if (lsp->curc == ASE_T('\\'))
{
escaped = 1; escaped = 1;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
continue; continue;
@ -449,7 +463,8 @@ static int read_string (ase_lsp_t* lsp)
TOKEN_ADD_CHAR (lsp, lsp->curc); TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp); NEXT_CHAR (lsp);
} while (lsp->curc != ASE_T('\"')); }
while (lsp->curc != ASE_T('\"'));
TOKEN_TYPE(lsp) = TOKEN_STRING; TOKEN_TYPE(lsp) = TOKEN_STRING;
NEXT_CHAR (lsp); NEXT_CHAR (lsp);

77
ase/lsp/token.c
View File

@ -1,77 +0,0 @@
/*
* $Id: token.c,v 1.16 2006-10-25 14:42:40 bacon Exp $
*/
#include <ase/lsp/lsp_i.h>
ase_lsp_token_t* ase_lsp_token_open (
ase_lsp_token_t* token, ase_size_t capacity)
{
if (token == ASE_NULL)
{
token = (ase_lsp_token_t*)
ase_malloc (ase_sizeof(ase_lsp_token_t));
if (token == ASE_NULL) return ASE_NULL;
token->__dynamic = ase_true;
}
else token->__dynamic = ase_false;
if (ase_lsp_name_open(&token->name, capacity) == ASE_NULL) {
if (token->__dynamic) ase_free (token);
return ASE_NULL;
}
/*
token->ivalue = 0;
token->fvalue = .0;
*/
token->type = ASE_LSP_TOKEN_END;
return token;
}
void ase_lsp_token_close (ase_lsp_token_t* token)
{
ase_lsp_name_close (&token->name);
if (token->__dynamic) ase_free (token);
}
int ase_lsp_token_addc (ase_lsp_token_t* token, ase_cint_t c)
{
return ase_lsp_name_addc (&token->name, c);
}
int ase_lsp_token_adds (ase_lsp_token_t* token, const ase_char_t* s)
{
return ase_lsp_name_adds (&token->name, s);
}
void ase_lsp_token_clear (ase_lsp_token_t* token)
{
/*
token->ivalue = 0;
token->fvalue = .0;
*/
token->type = ASE_LSP_TOKEN_END;
ase_lsp_name_clear (&token->name);
}
ase_char_t* ase_lsp_token_yield (ase_lsp_token_t* token, ase_size_t capacity)
{
ase_char_t* p;
p = ase_lsp_name_yield (&token->name, capacity);
if (p == ASE_NULL) return ASE_NULL;
/*
token->ivalue = 0;
token->fvalue = .0;
*/
token->type = ASE_LSP_TOKEN_END;
return p;
}
int ase_lsp_token_compare_name (ase_lsp_token_t* token, const ase_char_t* str)
{
return ase_lsp_name_compare (&token->name, str);
}

46
ase/lsp/token.h
View File

@ -1,46 +0,0 @@
/*
* $Id: token.h,v 1.15 2006-10-25 14:42:40 bacon Exp $
*/
#ifndef _ASE_LSP_TOKEN_H_
#define _ASE_LSP_TOKEN_H_
#include <ase/lsp/lsp_i.h>
enum
{
ASE_LSP_TOKEN_END
};
struct ase_lsp_token_t
{
int type;
ase_long_t ivalue;
ase_real_t rvalue;
ase_lsp_name_t name;
ase_bool_t __dynamic;
};
typedef struct ase_lsp_token_t ase_lsp_token_t;
#ifdef __cplusplus
extern "C" {
#endif
ase_lsp_token_t* ase_lsp_token_open (
ase_lsp_token_t* token, ase_size_t capacity);
void ase_lsp_token_close (ase_lsp_token_t* token);
int ase_lsp_token_addc (ase_lsp_token_t* token, ase_cint_t c);
int ase_lsp_token_adds (ase_lsp_token_t* token, const ase_char_t* s);
void ase_lsp_token_clear (ase_lsp_token_t* token);
ase_char_t* ase_lsp_token_yield (ase_lsp_token_t* token, ase_size_t capacity);
int ase_lsp_token_compare_name (ase_lsp_token_t* token, const ase_char_t* str);
#ifdef __cplusplus
}
#endif
#endif