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 2005-09-18 08:10:50 +00:00
parent 84badb1a49
commit 5615eb8208
10 changed files with 431 additions and 251 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
ase/lsp/array.h
View File

@ -1,5 +1,5 @@
/*
* $Id: array.h,v 1.4 2005-05-28 13:34:26 bacon Exp $
* $Id: array.h,v 1.5 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LSP_ARRAY_H_
@ -7,26 +7,26 @@
#include <xp/types.h>
struct xp_lisp_array_t
struct xp_lsp_array_t
{
void** buffer;
xp_size_t size;
xp_size_t capacity;
};
typedef struct xp_lisp_array_t xp_lisp_array_t;
typedef struct xp_lsp_array_t xp_lsp_array_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lisp_array_t* xp_lisp_array_new (xp_size_t capacity);
void xp_lisp_array_free (xp_lisp_array_t* array);
int xp_lisp_array_add_item (xp_lisp_array_t* array, void* item);
int xp_lisp_array_insert (xp_lisp_array_t* array, xp_size_t index, void* value);
void xp_lisp_array_delete (xp_lisp_array_t* array, xp_size_t index);
void xp_lisp_array_clear (xp_lisp_array_t* array);
void** xp_lisp_array_yield (xp_lisp_array_t* array, xp_size_t capacity);
xp_lsp_array_t* xp_lsp_array_new (xp_size_t capacity);
void xp_lsp_array_free (xp_lsp_array_t* array);
int xp_lsp_array_add_item (xp_lsp_array_t* array, void* item);
int xp_lsp_array_insert (xp_lsp_array_t* array, xp_size_t index, void* value);
void xp_lsp_array_delete (xp_lsp_array_t* array, xp_size_t index);
void xp_lsp_array_clear (xp_lsp_array_t* array);
void** xp_lsp_array_yield (xp_lsp_array_t* array, xp_size_t capacity);
#ifdef __cplusplus
}

32
ase/lsp/env.h
View File

@ -1,5 +1,5 @@
/*
* $Id: env.h,v 1.3 2005-05-28 13:34:26 bacon Exp $
* $Id: env.h,v 1.4 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LSP_ENV_H_
@ -7,33 +7,33 @@
#include <xp/lsp/object.h>
struct xp_lisp_assoc_t
struct xp_lsp_assoc_t
{
xp_lisp_obj_t* name; // xp_lisp_obj_symbol_t
xp_lisp_obj_t* value;
struct xp_lisp_assoc_t* link;
xp_lsp_obj_t* name; // xp_lsp_obj_symbol_t
xp_lsp_obj_t* value;
struct xp_lsp_assoc_t* link;
};
struct xp_lisp_frame_t
struct xp_lsp_frame_t
{
struct xp_lisp_assoc_t* assoc;
struct xp_lisp_frame_t* link;
struct xp_lsp_assoc_t* assoc;
struct xp_lsp_frame_t* link;
};
typedef struct xp_lisp_assoc_t xp_lisp_assoc_t;
typedef struct xp_lisp_frame_t xp_lisp_frame_t;
typedef struct xp_lsp_assoc_t xp_lsp_assoc_t;
typedef struct xp_lsp_frame_t xp_lsp_frame_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lisp_assoc_t* xp_lisp_assoc_new (xp_lisp_obj_t* name, xp_lisp_obj_t* value);
void xp_lisp_assoc_free (xp_lisp_assoc_t* assoc);
xp_lsp_assoc_t* xp_lsp_assoc_new (xp_lsp_obj_t* name, xp_lsp_obj_t* value);
void xp_lsp_assoc_free (xp_lsp_assoc_t* assoc);
xp_lisp_frame_t* xp_lisp_frame_new (void);
void xp_lisp_frame_free (xp_lisp_frame_t* frame);
xp_lisp_assoc_t* xp_lisp_frame_lookup (xp_lisp_frame_t* frame, xp_lisp_obj_t* name);
xp_lisp_assoc_t* xp_lisp_frame_insert (xp_lisp_frame_t* frame, xp_lisp_obj_t* name, xp_lisp_obj_t* value);
xp_lsp_frame_t* xp_lsp_frame_new (void);
void xp_lsp_frame_free (xp_lsp_frame_t* frame);
xp_lsp_assoc_t* xp_lsp_frame_lookup (xp_lsp_frame_t* frame, xp_lsp_obj_t* name);
xp_lsp_assoc_t* xp_lsp_frame_insert (xp_lsp_frame_t* frame, xp_lsp_obj_t* name, xp_lsp_obj_t* value);
#ifdef __cplusplus
}

43
ase/lsp/lsp.h
View File

@ -1,5 +1,5 @@
/*
* $Id: lsp.h,v 1.3 2005-09-18 03:57:26 bacon Exp $
* $Id: lsp.h,v 1.4 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LSP_LSP_H_
@ -21,27 +21,30 @@
// NOTICE: the function of xp_lsp_creader_t must return -1 on error
// and 0 on success. the first argument must be set to
// XP_LISP_END_CHAR at the end of input.
// XP_LSP_END_CHAR at the end of input.
typedef int (*xp_lsp_creader_t) (xp_cint_t*, void*);
#define XP_LISP_ERR(lsp) ((lsp)->error)
#define XP_LISP_ERR_NONE 0
#define XP_LISP_ERR_ABORT 1
#define XP_LISP_ERR_END 2
#define XP_LISP_ERR_MEM 3
#define XP_LISP_ERR_READ 4
#define XP_LISP_ERR_SYNTAX 5
#define XP_LISP_ERR_BAD_ARG 6
#define XP_LISP_ERR_WRONG_ARG 7
#define XP_LISP_ERR_TOO_FEW_ARGS 8
#define XP_LISP_ERR_TOO_MANY_ARGS 9
#define XP_LISP_ERR_UNDEF_FUNC 10
#define XP_LISP_ERR_BAD_FUNC 11
#define XP_LISP_ERR_DUP_FORMAL 12
#define XP_LISP_ERR_BAD_SYMBOL 13
#define XP_LISP_ERR_UNDEF_SYMBOL 14
#define XP_LISP_ERR_EMPTY_BODY 15
#define XP_LISP_ERR_BAD_VALUE 16
#define XP_LSP_ERR(lsp) ((lsp)->error)
enum
{
XP_LSP_ERR_NONE = 0,
XP_LSP_ERR_ABORT,
XP_LSP_ERR_END,
XP_LSP_ERR_MEM,
XP_LSP_ERR_READ,
XP_LSP_ERR_SYNTAX,
XP_LSP_ERR_BAD_ARG,
XP_LSP_ERR_WRONG_ARG,
XP_LSP_ERR_TOO_FEW_ARGS,
XP_LSP_ERR_TOO_MANY_ARGS,
XP_LSP_ERR_UNDEF_FUNC,
XP_LSP_ERR_BAD_FUNC,
XP_LSP_ERR_DUP_FORMAL,
XP_LSP_ERR_BAD_SYMBOL,
XP_LSP_ERR_UNDEF_SYMBOL,
XP_LSP_ERR_EMPTY_BODY,
XP_LSP_ERR_BAD_VALUE
};
/*
* STRUCT: xp_lsp_t

90
ase/lsp/memory.h
View File

@ -1,5 +1,5 @@
/*
* $Id: memory.h,v 1.5 2005-05-28 13:34:26 bacon Exp $
* $Id: memory.h,v 1.6 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LSP_MEM_H_
@ -9,7 +9,7 @@
#include <xp/lsp/env.h>
#include <xp/lsp/array.h>
struct xp_lisp_mem_t
struct xp_lsp_mem_t
{
/*
* object allocation list
@ -17,81 +17,81 @@ struct xp_lisp_mem_t
xp_size_t ubound; // upper bounds of the maximum number of objects
xp_size_t ubound_inc; // increment of the upper bounds
xp_size_t count; // the number of objects currently allocated
xp_lisp_obj_t* used[XP_LISP_TYPE_COUNT];
xp_lisp_obj_t* free[XP_LISP_TYPE_COUNT];
xp_lisp_obj_t* locked;
xp_lsp_obj_t* used[XP_LSP_TYPE_COUNT];
xp_lsp_obj_t* free[XP_LSP_TYPE_COUNT];
xp_lsp_obj_t* locked;
/*
* commonly accessed objects
*/
xp_lisp_obj_t* nil; // xp_lisp_obj_nil_t
xp_lisp_obj_t* t; // xp_lisp_obj_true_t
xp_lisp_obj_t* quote; // xp_lisp_obj_symbol_t
xp_lisp_obj_t* lambda; // xp_lisp_obj_symbol_t
xp_lisp_obj_t* macro; // xp_lisp_obj_symbol_t
xp_lsp_obj_t* nil; // xp_lsp_obj_nil_t
xp_lsp_obj_t* t; // xp_lsp_obj_true_t
xp_lsp_obj_t* quote; // xp_lsp_obj_symbol_t
xp_lsp_obj_t* lambda; // xp_lsp_obj_symbol_t
xp_lsp_obj_t* macro; // xp_lsp_obj_symbol_t
/*
* run-time environment frame
*/
xp_lisp_frame_t* frame;
xp_lsp_frame_t* frame;
// pointer to a global-level frame
xp_lisp_frame_t* root_frame;
xp_lsp_frame_t* root_frame;
// pointer to an interim frame not yet added to "frame"
xp_lisp_frame_t* brooding_frame;
xp_lsp_frame_t* brooding_frame;
/*
* temporary objects
*/
xp_lisp_array_t* temp_array;
xp_lsp_array_t* temp_array;
};
typedef struct xp_lisp_mem_t xp_lisp_mem_t;
typedef struct xp_lsp_mem_t xp_lsp_mem_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lisp_mem_t* xp_lisp_mem_new (xp_size_t ubound, xp_size_t ubound_inc);
void xp_lisp_mem_free (xp_lisp_mem_t* mem);
xp_lsp_mem_t* xp_lsp_mem_new (xp_size_t ubound, xp_size_t ubound_inc);
void xp_lsp_mem_free (xp_lsp_mem_t* mem);
int xp_lisp_add_prims (xp_lisp_mem_t* mem);
int xp_lsp_add_prims (xp_lsp_mem_t* mem);
xp_lisp_obj_t* xp_lisp_allocate (xp_lisp_mem_t* mem, int type, xp_size_t size);
void xp_lisp_dispose (xp_lisp_mem_t* mem, xp_lisp_obj_t* prev, xp_lisp_obj_t* obj);
void xp_lisp_dispose_all (xp_lisp_mem_t* mem);
void xp_lisp_garbage_collect (xp_lisp_mem_t* mem);
xp_lsp_obj_t* xp_lsp_allocate (xp_lsp_mem_t* mem, int type, xp_size_t size);
void xp_lsp_dispose (xp_lsp_mem_t* mem, xp_lsp_obj_t* prev, xp_lsp_obj_t* obj);
void xp_lsp_dispose_all (xp_lsp_mem_t* mem);
void xp_lsp_garbage_collect (xp_lsp_mem_t* mem);
void xp_lisp_lock (xp_lisp_obj_t* obj);
void xp_lisp_unlock (xp_lisp_obj_t* obj);
void xp_lisp_unlock_all (xp_lisp_obj_t* obj);
void xp_lsp_lock (xp_lsp_obj_t* obj);
void xp_lsp_unlock (xp_lsp_obj_t* obj);
void xp_lsp_unlock_all (xp_lsp_obj_t* obj);
// object creation of standard types
xp_lisp_obj_t* xp_lisp_make_nil (xp_lisp_mem_t* mem);
xp_lisp_obj_t* xp_lisp_make_true (xp_lisp_mem_t* mem);
xp_lisp_obj_t* xp_lisp_make_int (xp_lisp_mem_t* mem, xp_lisp_int_t value);
xp_lisp_obj_t* xp_lisp_make_float (xp_lisp_mem_t* mem, xp_lisp_real_t value);
xp_lisp_obj_t* xp_lisp_make_symbol (xp_lisp_mem_t* mem, const xp_char_t* str, xp_size_t len);
xp_lisp_obj_t* xp_lisp_make_string (xp_lisp_mem_t* mem, const xp_char_t* str, xp_size_t len);
xp_lisp_obj_t* xp_lisp_make_cons (xp_lisp_mem_t* mem, xp_lisp_obj_t* car, xp_lisp_obj_t* cdr);
xp_lisp_obj_t* xp_lisp_make_func (xp_lisp_mem_t* mem, xp_lisp_obj_t* formal, xp_lisp_obj_t* body);
xp_lisp_obj_t* xp_lisp_make_macro (xp_lisp_mem_t* mem, xp_lisp_obj_t* formal, xp_lisp_obj_t* body);
xp_lisp_obj_t* xp_lisp_make_prim (xp_lisp_mem_t* mem, void* impl);
xp_lsp_obj_t* xp_lsp_make_nil (xp_lsp_mem_t* mem);
xp_lsp_obj_t* xp_lsp_make_true (xp_lsp_mem_t* mem);
xp_lsp_obj_t* xp_lsp_make_int (xp_lsp_mem_t* mem, xp_lsp_int_t value);
xp_lsp_obj_t* xp_lsp_make_float (xp_lsp_mem_t* mem, xp_lsp_real_t value);
xp_lsp_obj_t* xp_lsp_make_symbol (xp_lsp_mem_t* mem, const xp_char_t* str, xp_size_t len);
xp_lsp_obj_t* xp_lsp_make_string (xp_lsp_mem_t* mem, const xp_char_t* str, xp_size_t len);
xp_lsp_obj_t* xp_lsp_make_cons (xp_lsp_mem_t* mem, xp_lsp_obj_t* car, xp_lsp_obj_t* cdr);
xp_lsp_obj_t* xp_lsp_make_func (xp_lsp_mem_t* mem, xp_lsp_obj_t* formal, xp_lsp_obj_t* body);
xp_lsp_obj_t* xp_lsp_make_macro (xp_lsp_mem_t* mem, xp_lsp_obj_t* formal, xp_lsp_obj_t* body);
xp_lsp_obj_t* xp_lsp_make_prim (xp_lsp_mem_t* mem, void* impl);
// frame lookup
xp_lisp_assoc_t* xp_lisp_lookup (xp_lisp_mem_t* mem, xp_lisp_obj_t* name);
xp_lisp_assoc_t* xp_lisp_set (xp_lisp_mem_t* mem, xp_lisp_obj_t* name, xp_lisp_obj_t* value);
xp_lsp_assoc_t* xp_lsp_lookup (xp_lsp_mem_t* mem, xp_lsp_obj_t* name);
xp_lsp_assoc_t* xp_lsp_set (xp_lsp_mem_t* mem, xp_lsp_obj_t* name, xp_lsp_obj_t* value);
// cons operations
xp_size_t xp_lisp_cons_len (xp_lisp_mem_t* mem, xp_lisp_obj_t* obj);
int xp_lisp_probe_args (xp_lisp_mem_t* mem, xp_lisp_obj_t* obj, xp_size_t* len);
xp_size_t xp_lsp_cons_len (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj);
int xp_lsp_probe_args (xp_lsp_mem_t* mem, xp_lsp_obj_t* obj, xp_size_t* len);
// symbol and string operations
int xp_lisp_comp_symbol (xp_lisp_obj_t* obj, const xp_char_t* str);
int xp_lisp_comp_symbol2 (xp_lisp_obj_t* obj, const xp_char_t* str, xp_size_t len);
int xp_lisp_comp_string (xp_lisp_obj_t* obj, const xp_char_t* str);
int xp_lisp_comp_string2 (xp_lisp_obj_t* obj, const xp_char_t* str, xp_size_t len);
void xp_lisp_copy_string (xp_char_t* dst, const xp_char_t* str);
void xp_lisp_copy_string2 (xp_char_t* dst, const xp_char_t* str, xp_size_t len);
int xp_lsp_comp_symbol (xp_lsp_obj_t* obj, const xp_char_t* str);
int xp_lsp_comp_symbol2 (xp_lsp_obj_t* obj, const xp_char_t* str, xp_size_t len);
int xp_lsp_comp_string (xp_lsp_obj_t* obj, const xp_char_t* str);
int xp_lsp_comp_string2 (xp_lsp_obj_t* obj, const xp_char_t* str, xp_size_t len);
void xp_lsp_copy_string (xp_char_t* dst, const xp_char_t* str);
void xp_lsp_copy_string2 (xp_char_t* dst, const xp_char_t* str, xp_size_t len);
#ifdef __cplusplus
}

146
ase/lsp/name.c Normal file
View File

@ -0,0 +1,146 @@
/*
* $Id: name.c,v 1.1 2005-09-18 08:10:50 bacon Exp $
*/
#include <xp/stx/name.h>
#include <xp/stx/misc.h>
xp_stx_name_t* xp_stx_name_open (
xp_stx_name_t* name, xp_word_t capacity)
{
if (capacity == 0)
capacity = xp_countof(name->static_buffer) - 1;
if (name == XP_NULL) {
name = (xp_stx_name_t*)
xp_malloc (xp_sizeof(xp_stx_name_t));
if (name == XP_NULL) return XP_NULL;
name->__malloced = xp_true;
}
else name->__malloced = xp_false;
if (capacity < xp_countof(name->static_buffer)) {
name->buffer = name->static_buffer;
}
else {
name->buffer = (xp_char_t*)
xp_malloc ((capacity + 1) * xp_sizeof(xp_char_t));
if (name->buffer == XP_NULL) {
if (name->__malloced) xp_free (name);
return XP_NULL;
}
}
name->size = 0;
name->capacity = capacity;
name->buffer[0] = XP_CHAR('\0');
return name;
}
void xp_stx_name_close (xp_stx_name_t* name)
{
if (name->capacity >= xp_countof(name->static_buffer)) {
xp_assert (name->buffer != name->static_buffer);
xp_free (name->buffer);
}
if (name->__malloced) xp_free (name);
}
int xp_stx_name_addc (xp_stx_name_t* name, xp_cint_t c)
{
if (name->size >= name->capacity) {
/* double the capacity. */
xp_size_t new_capacity = name->capacity * 2;
if (new_capacity >= xp_countof(name->static_buffer)) {
xp_char_t* space;
if (name->capacity < xp_countof(name->static_buffer)) {
space = (xp_char_t*)xp_malloc (
(new_capacity + 1) * xp_sizeof(xp_char_t));
if (space == XP_NULL) return -1;
/* don't need to copy up to the terminating null */
xp_memcpy (space, name->buffer,
name->capacity * xp_sizeof(xp_char_t));
}
else {
space = (xp_char_t*)xp_realloc (name->buffer,
(new_capacity + 1) * xp_sizeof(xp_char_t));
if (space == XP_NULL) return -1;
}
name->buffer = space;
}
name->capacity = new_capacity;
}
name->buffer[name->size++] = c;
name->buffer[name->size] = XP_CHAR('\0');
return 0;
}
int xp_stx_name_adds (xp_stx_name_t* name, const xp_char_t* s)
{
while (*s != XP_CHAR('\0')) {
if (xp_stx_name_addc(name, *s) == -1) return -1;
s++;
}
return 0;
}
void xp_stx_name_clear (xp_stx_name_t* name)
{
name->size = 0;
name->buffer[0] = XP_CHAR('\0');
}
xp_char_t* xp_stx_name_yield (xp_stx_name_t* name, xp_word_t capacity)
{
xp_char_t* old_buffer, * new_buffer;
if (capacity == 0)
capacity = xp_countof(name->static_buffer) - 1;
if (name->capacity < xp_countof(name->static_buffer)) {
old_buffer = (xp_char_t*)
xp_malloc((name->capacity + 1) * xp_sizeof(xp_char_t));
if (old_buffer == XP_NULL) return XP_NULL;
xp_memcpy (old_buffer, name->buffer,
(name->capacity + 1) * xp_sizeof(xp_char_t));
}
else old_buffer = name->buffer;
if (capacity < xp_countof(name->static_buffer)) {
new_buffer = name->static_buffer;
}
else {
new_buffer = (xp_char_t*)
xp_malloc((capacity + 1) * xp_sizeof(xp_char_t));
if (new_buffer == XP_NULL) return XP_NULL;
}
name->buffer = new_buffer;
name->size = 0;
name->capacity = capacity;
name->buffer[0] = XP_CHAR('\0');
return old_buffer;
}
int xp_stx_name_compare (xp_stx_name_t* name, const xp_char_t* str)
{
xp_char_t* p = name->buffer;
xp_word_t index = 0;
while (index < name->size) {
if (*p > *str) return 1;
if (*p < *str) return -1;
index++; p++; str++;
}
return (*str == XP_CHAR('\0'))? 0: -1;
}

39
ase/lsp/name.h Normal file
View File

@ -0,0 +1,39 @@
/*
* $Id: name.h,v 1.1 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LSP_NAME_H_
#define _XP_LSP_NAME_H_
#include <xp/lsp/lsp.h>
struct xp_lsp_name_t
{
xp_word_t capacity;
xp_word_t size;
xp_char_t* buffer;
xp_char_t static_buffer[128];
xp_bool_t __malloced;
};
typedef struct xp_lsp_name_t xp_lsp_name_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lsp_name_t* xp_lsp_name_open (
xp_lsp_name_t* name, xp_word_t capacity);
void xp_lsp_name_close (xp_lsp_name_t* name);
int xp_lsp_name_addc (xp_lsp_name_t* name, xp_cint_t c);
int xp_lsp_name_adds (xp_lsp_name_t* name, const xp_char_t* s);
void xp_lsp_name_clear (xp_lsp_name_t* name);
xp_char_t* xp_lsp_name_yield (xp_lsp_name_t* name, xp_word_t capacity);
int xp_lsp_name_compare (xp_lsp_name_t* name, const xp_char_t* str);
#ifdef __cplusplus
}
#endif
#endif

156
ase/lsp/object.h
View File

@ -1,151 +1,151 @@
/*
* $Id: object.h,v 1.5 2005-05-28 13:34:26 bacon Exp $
* $Id: object.h,v 1.6 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LISP_OBJECT_H_
#define _XP_LISP_OBJECT_H_
#ifndef _XP_LSP_OBJECT_H_
#define _XP_LSP_OBJECT_H_
#include <xp/lsp/types.h>
// object types
enum
{
XP_LISP_OBJ_NIL = 0,
XP_LISP_OBJ_TRUE,
XP_LISP_OBJ_INT,
XP_LISP_OBJ_FLOAT,
XP_LISP_OBJ_SYMBOL,
XP_LISP_OBJ_STRING,
XP_LISP_OBJ_CONS,
XP_LISP_OBJ_FUNC,
XP_LISP_OBJ_MACRO,
XP_LISP_OBJ_PRIM,
XP_LSP_OBJ_NIL = 0,
XP_LSP_OBJ_TRUE,
XP_LSP_OBJ_INT,
XP_LSP_OBJ_FLOAT,
XP_LSP_OBJ_SYMBOL,
XP_LSP_OBJ_STRING,
XP_LSP_OBJ_CONS,
XP_LSP_OBJ_FUNC,
XP_LSP_OBJ_MACRO,
XP_LSP_OBJ_PRIM,
XP_LISP_TYPE_COUNT // the number of lisp object types
XP_LSP_TYPE_COUNT // the number of lsp object types
};
#define XP_LISP_OBJ_HEADER \
#define XP_LSP_OBJ_HEADER \
xp_uint32_t type: 24; \
xp_uint32_t mark: 4; \
xp_uint32_t lock: 4; \
xp_size_t size; \
struct xp_lisp_obj_t* link
struct xp_lsp_obj_t* link
struct xp_lisp_obj_t
struct xp_lsp_obj_t
{
XP_LISP_OBJ_HEADER;
XP_LSP_OBJ_HEADER;
};
struct xp_lisp_obj_nil_t
struct xp_lsp_obj_nil_t
{
XP_LISP_OBJ_HEADER;
XP_LSP_OBJ_HEADER;
};
struct xp_lisp_obj_true_t
struct xp_lsp_obj_true_t
{
XP_LISP_OBJ_HEADER;
XP_LSP_OBJ_HEADER;
};
struct xp_lisp_obj_int_t
struct xp_lsp_obj_int_t
{
XP_LISP_OBJ_HEADER;
xp_lisp_int_t value;
XP_LSP_OBJ_HEADER;
xp_lsp_int_t value;
};
struct xp_lisp_obj_float_t
struct xp_lsp_obj_float_t
{
XP_LISP_OBJ_HEADER;
xp_lisp_real_t value;
XP_LSP_OBJ_HEADER;
xp_lsp_real_t value;
};
struct xp_lisp_obj_symbol_t
struct xp_lsp_obj_symbol_t
{
XP_LISP_OBJ_HEADER;
XP_LSP_OBJ_HEADER;
#ifdef __BORLANDC__
#else
xp_char_t buffer[0];
#endif
};
struct xp_lisp_obj_string_t
struct xp_lsp_obj_string_t
{
XP_LISP_OBJ_HEADER;
XP_LSP_OBJ_HEADER;
#ifdef __BORLANDC__
#else
xp_char_t buffer[0];
#endif
};
struct xp_lisp_obj_cons_t
struct xp_lsp_obj_cons_t
{
XP_LISP_OBJ_HEADER;
struct xp_lisp_obj_t* car;
struct xp_lisp_obj_t* cdr;
XP_LSP_OBJ_HEADER;
struct xp_lsp_obj_t* car;
struct xp_lsp_obj_t* cdr;
};
struct xp_lisp_obj_func_t
struct xp_lsp_obj_func_t
{
XP_LISP_OBJ_HEADER;
struct xp_lisp_obj_t* formal;
struct xp_lisp_obj_t* body;
XP_LSP_OBJ_HEADER;
struct xp_lsp_obj_t* formal;
struct xp_lsp_obj_t* body;
};
struct xp_lisp_obj_macro_t
struct xp_lsp_obj_macro_t
{
XP_LISP_OBJ_HEADER;
struct xp_lisp_obj_t* formal;
struct xp_lisp_obj_t* body;
XP_LSP_OBJ_HEADER;
struct xp_lsp_obj_t* formal;
struct xp_lsp_obj_t* body;
};
struct xp_lisp_obj_prim_t
struct xp_lsp_obj_prim_t
{
XP_LISP_OBJ_HEADER;
void* impl; // xp_lisp_prim_t
XP_LSP_OBJ_HEADER;
void* impl; // xp_lsp_prim_t
};
typedef struct xp_lisp_obj_t xp_lisp_obj_t;
typedef struct xp_lisp_obj_nil_t xp_lisp_obj_nil_t;
typedef struct xp_lisp_obj_true_t xp_lisp_obj_true_t;
typedef struct xp_lisp_obj_int_t xp_lisp_obj_int_t;
typedef struct xp_lisp_obj_float_t xp_lisp_obj_float_t;
typedef struct xp_lisp_obj_symbol_t xp_lisp_obj_symbol_t;
typedef struct xp_lisp_obj_string_t xp_lisp_obj_string_t;
typedef struct xp_lisp_obj_cons_t xp_lisp_obj_cons_t;
typedef struct xp_lisp_obj_func_t xp_lisp_obj_func_t;
typedef struct xp_lisp_obj_macro_t xp_lisp_obj_macro_t;
typedef struct xp_lisp_obj_prim_t xp_lisp_obj_prim_t;
typedef struct xp_lsp_obj_t xp_lsp_obj_t;
typedef struct xp_lsp_obj_nil_t xp_lsp_obj_nil_t;
typedef struct xp_lsp_obj_true_t xp_lsp_obj_true_t;
typedef struct xp_lsp_obj_int_t xp_lsp_obj_int_t;
typedef struct xp_lsp_obj_float_t xp_lsp_obj_float_t;
typedef struct xp_lsp_obj_symbol_t xp_lsp_obj_symbol_t;
typedef struct xp_lsp_obj_string_t xp_lsp_obj_string_t;
typedef struct xp_lsp_obj_cons_t xp_lsp_obj_cons_t;
typedef struct xp_lsp_obj_func_t xp_lsp_obj_func_t;
typedef struct xp_lsp_obj_macro_t xp_lsp_obj_macro_t;
typedef struct xp_lsp_obj_prim_t xp_lsp_obj_prim_t;
// header access
#define XP_LISP_TYPE(x) (((xp_lisp_obj_t*)x)->type)
#define XP_LISP_SIZE(x) (((xp_lisp_obj_t*)x)->size)
#define XP_LISP_MARK(x) (((xp_lisp_obj_t*)x)->mark)
#define XP_LISP_LOCK(x) (((xp_lisp_obj_t*)x)->lock)
#define XP_LISP_LINK(x) (((xp_lisp_obj_t*)x)->link)
#define XP_LSP_TYPE(x) (((xp_lsp_obj_t*)x)->type)
#define XP_LSP_SIZE(x) (((xp_lsp_obj_t*)x)->size)
#define XP_LSP_MARK(x) (((xp_lsp_obj_t*)x)->mark)
#define XP_LSP_LOCK(x) (((xp_lsp_obj_t*)x)->lock)
#define XP_LSP_LINK(x) (((xp_lsp_obj_t*)x)->link)
// value access
#define XP_LISP_IVALUE(x) (((xp_lisp_obj_int_t*)x)->value)
#define XP_LISP_FVALUE(x) (((xp_lisp_obj_float_t*)x)->value)
#define XP_LSP_IVALUE(x) (((xp_lsp_obj_int_t*)x)->value)
#define XP_LSP_FVALUE(x) (((xp_lsp_obj_float_t*)x)->value)
#ifdef __BORLANDC__
#define XP_LISP_SYMVALUE(x) ((xp_char_t*)(((xp_lisp_obj_symbol_t*)x) + 1))
#define XP_LSP_SYMVALUE(x) ((xp_char_t*)(((xp_lsp_obj_symbol_t*)x) + 1))
#else
#define XP_LISP_SYMVALUE(x) (((xp_lisp_obj_symbol_t*)x)->buffer)
#define XP_LSP_SYMVALUE(x) (((xp_lsp_obj_symbol_t*)x)->buffer)
#endif
#define XP_LISP_SYMLEN(x) ((((xp_lisp_obj_symbol_t*)x)->size - sizeof(xp_lisp_obj_t)) / sizeof(xp_char_t) - 1)
#define XP_LSP_SYMLEN(x) ((((xp_lsp_obj_symbol_t*)x)->size - sizeof(xp_lsp_obj_t)) / sizeof(xp_char_t) - 1)
#ifdef __BORLANDC__
#define XP_LISP_STRVALUE(x) ((xp_char_t*)(((xp_lisp_obj_string_t*)x) + 1))
#define XP_LSP_STRVALUE(x) ((xp_char_t*)(((xp_lsp_obj_string_t*)x) + 1))
#else
#define XP_LISP_STRVALUE(x) (((xp_lisp_obj_string_t*)x)->buffer)
#define XP_LSP_STRVALUE(x) (((xp_lsp_obj_string_t*)x)->buffer)
#endif
#define XP_LISP_STRLEN(x) ((((xp_lisp_obj_string_t*)x)->size - sizeof(xp_lisp_obj_t)) / sizeof(xp_char_t) - 1)
#define XP_LSP_STRLEN(x) ((((xp_lsp_obj_string_t*)x)->size - sizeof(xp_lsp_obj_t)) / sizeof(xp_char_t) - 1)
#define XP_LISP_CAR(x) (((xp_lisp_obj_cons_t*)x)->car)
#define XP_LISP_CDR(x) (((xp_lisp_obj_cons_t*)x)->cdr)
#define XP_LISP_FFORMAL(x) (((xp_lisp_obj_func_t*)x)->formal)
#define XP_LISP_FBODY(x) (((xp_lisp_obj_func_t*)x)->body)
#define XP_LISP_MFORMAL(x) (((xp_lisp_obj_macro_t*)x)->formal)
#define XP_LISP_MBODY(x) (((xp_lisp_obj_macro_t*)x)->body)
#define XP_LISP_PIMPL(x) ((xp_lisp_pimpl_t)(((xp_lisp_obj_prim_t*)x)->impl))
#define XP_LSP_CAR(x) (((xp_lsp_obj_cons_t*)x)->car)
#define XP_LSP_CDR(x) (((xp_lsp_obj_cons_t*)x)->cdr)
#define XP_LSP_FFORMAL(x) (((xp_lsp_obj_func_t*)x)->formal)
#define XP_LSP_FBODY(x) (((xp_lsp_obj_func_t*)x)->body)
#define XP_LSP_MFORMAL(x) (((xp_lsp_obj_macro_t*)x)->formal)
#define XP_LSP_MBODY(x) (((xp_lsp_obj_macro_t*)x)->body)
#define XP_LSP_PIMPL(x) ((xp_lsp_pimpl_t)(((xp_lsp_obj_prim_t*)x)->impl))
#endif

106
ase/lsp/token.c
View File

@ -1,93 +1,77 @@
/*
* $Id: token.c,v 1.10 2005-05-28 13:34:26 bacon Exp $
* $Id: token.c,v 1.11 2005-09-18 08:10:50 bacon Exp $
*/
#include <xp/lsp/token.h>
#include <xp/bas/memory.h>
#include <xp/bas/assert.h>
xp_lisp_token_t* xp_lisp_token_new (xp_size_t capacity)
xp_lsp_token_t* xp_lsp_token_open (
xp_lsp_token_t* token, xp_word_t capacity)
{
xp_lisp_token_t* token;
xp_assert (capacity > 0);
token = (xp_lisp_token_t*)xp_malloc (xp_sizeof(xp_lisp_token_t));
if (token == XP_NULL) return XP_NULL;
token->buffer = (xp_char_t*)xp_malloc ((capacity + 1) * xp_sizeof(xp_char_t));
if (token->buffer == XP_NULL) {
xp_free (token);
if (token == XP_NULL) {
token = (xp_lsp_token_t*)
xp_malloc (xp_sizeof(xp_lsp_token_t));
if (token == XP_NULL) return XP_NULL;
token->__malloced = xp_true;
}
else token->__malloced = xp_false;
if (xp_lsp_name_open(&token->name, capacity) == XP_NULL) {
if (token->__malloced) xp_free (token);
return XP_NULL;
}
/*
token->ivalue = 0;
token->fvalue = .0;
token->size = 0;
token->capacity = capacity;
token->buffer[0] = XP_CHAR('\0');
*/
token->type = XP_LSP_TOKEN_END;
return token;
}
void xp_lisp_token_free (xp_lisp_token_t* token)
void xp_lsp_token_close (xp_lsp_token_t* token)
{
xp_free (token->buffer);
xp_free (token);
xp_lsp_name_close (&token->name);
if (token->__malloced) xp_free (token);
}
int xp_lisp_token_addc (xp_lisp_token_t* token, xp_cint_t c)
int xp_lsp_token_addc (xp_lsp_token_t* token, xp_cint_t c)
{
if (token->size >= token->capacity) {
// double the capacity.
xp_char_t* new_buffer = (xp_char_t*)xp_realloc (
token->buffer, (token->capacity * 2 + 1) * xp_sizeof(xp_char_t));
if (new_buffer == XP_NULL) return -1;
token->buffer = new_buffer;
token->capacity = token->capacity * 2;
}
token->buffer[token->size++] = c;
token->buffer[token->size] = XP_CHAR('\0');
return 0;
return xp_lsp_name_addc (&token->name, c);
}
void xp_lisp_token_clear (xp_lisp_token_t* token)
int xp_lsp_token_adds (xp_lsp_token_t* token, const xp_char_t* s)
{
token->ivalue = 0;
token->fvalue = .0;
token->size = 0;
token->buffer[0] = XP_CHAR('\0');
return xp_lsp_name_adds (&token->name, s);
}
xp_char_t* xp_lisp_token_yield (xp_lisp_token_t* token, xp_size_t capacity)
void xp_lsp_token_clear (xp_lsp_token_t* token)
{
xp_char_t* old_buffer, * new_buffer;
new_buffer = (xp_char_t*)xp_malloc((capacity + 1) * xp_sizeof(xp_char_t));
if (new_buffer == XP_NULL) return XP_NULL;
/*
token->ivalue = 0;
token->fvalue = .0;
*/
old_buffer = token->buffer;
token->buffer = new_buffer;
token->size = 0;
token->capacity = capacity;
token->buffer[0] = XP_CHAR('\0');
return old_buffer;
token->type = XP_LSP_TOKEN_END;
xp_lsp_name_clear (&token->name);
}
int xp_lisp_token_compare (xp_lisp_token_t* token, const xp_char_t* str)
xp_char_t* xp_lsp_token_yield (xp_lsp_token_t* token, xp_word_t capacity)
{
xp_char_t* p = token->buffer;
xp_size_t index = 0;
xp_char_t* p;
while (index < token->size) {
if (*p > *str) return 1;
if (*p < *str) return -1;
index++; p++; str++;
}
p = xp_lsp_name_yield (&token->name, capacity);
if (p == XP_NULL) return XP_NULL;
return (*str == XP_CHAR('\0'))? 0: -1;
/*
token->ivalue = 0;
token->fvalue = .0;
*/
token->type = XP_LSP_TOKEN_END;
return p;
}
int xp_lsp_token_compare_name (xp_lsp_token_t* token, const xp_char_t* str)
{
return xp_lsp_name_compare (&token->name, str);
}

44
ase/lsp/token.h
View File

@ -1,36 +1,44 @@
/*
* $Id: token.h,v 1.7 2005-05-28 13:34:26 bacon Exp $
* $Id: token.h,v 1.8 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LSP_TOKEN_H_
#define _XP_LSP_TOKEN_H_
#include <xp/lsp/types.h>
#include <xp/lsp/lsp.h>
#include <xp/lsp/name.h>
struct xp_lisp_token_t
enum
{
int type;
xp_lisp_int_t ivalue;
xp_lisp_real_t fvalue;
xp_size_t capacity;
xp_size_t size;
xp_char_t* buffer;
XP_LSP_TOKEN_END
};
typedef struct xp_lisp_token_t xp_lisp_token_t;
struct xp_lsp_token_t
{
int type;
xp_lsp_int_t ivalue;
xp_lsp_real_t fvalue;
xp_lsp_name_t name;
xp_bool_t __malloced;
};
typedef struct xp_lsp_token_t xp_lsp_token_t;
#ifdef __cplusplus
extern "C" {
#endif
xp_lisp_token_t* xp_lisp_token_new (xp_size_t capacity);
void xp_lisp_token_free (xp_lisp_token_t* token);
int xp_lisp_token_addc (xp_lisp_token_t* token, xp_cint_t c);
void xp_lisp_token_clear (xp_lisp_token_t* token);
xp_char_t* xp_lisp_token_yield (xp_lisp_token_t* token, xp_size_t capacity);
int xp_lisp_token_compare (xp_lisp_token_t* token, const xp_char_t* str);
xp_lsp_token_t* xp_lsp_token_open (
xp_lsp_token_t* token, xp_word_t capacity);
void xp_lsp_token_close (xp_lsp_token_t* token);
int xp_lsp_token_addc (xp_lsp_token_t* token, xp_cint_t c);
int xp_lsp_token_adds (xp_lsp_token_t* token, const xp_char_t* s);
void xp_lsp_token_clear (xp_lsp_token_t* token);
xp_char_t* xp_lsp_token_yield (xp_lsp_token_t* token, xp_word_t capacity);
int xp_lsp_token_compare_name (xp_lsp_token_t* token, const xp_char_t* str);
#ifdef __cplusplus
}

6
ase/lsp/types.h
View File

@ -1,5 +1,5 @@
/*
* $Id: types.h,v 1.6 2005-05-28 13:34:26 bacon Exp $
* $Id: types.h,v 1.7 2005-09-18 08:10:50 bacon Exp $
*/
#ifndef _XP_LSP_TYPES_H_
@ -8,7 +8,7 @@
#include <xp/types.h>
#include <xp/macros.h>
typedef xp_long_t xp_lisp_int_t;
typedef xp_real_t xp_lisp_real_t;
typedef xp_long_t xp_lsp_int_t;
typedef xp_real_t xp_lsp_real_t;
#endif