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

added more code for scm

Browse Source
This commit is contained in:
hyung-hwan
2011-02-22 03:11:21 +00:00
parent f24fe05409
commit 758037fac0
41 changed files with 657 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
qse/lib/Makefile.in
View File

@ -111,6 +111,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@

1
qse/lib/awk/Makefile.in
View File

@ -138,6 +138,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@

1
qse/lib/cmn/Makefile.in
View File

@ -140,6 +140,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@

14
qse/lib/cmn/assert.c
View File

@ -90,6 +90,20 @@ void qse_assert_failed (
qse_sio_puts (QSE_SIO_ERR, QSE_T("=[ASSERTION FAILURE]============================================================\n"));
#if 1
qse_sio_puts (QSE_SIO_ERR, QSE_T(" __ \n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T(" _____ _____ _____ _____| |\n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T("| | | _ | __| |\n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T("| | | | | __|__ |__|\n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T("|_____|_____|__| |_____|__|\n"));
#else
qse_sio_puts (QSE_SIO_ERR, QSE_T(" __ \n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T(" _____ _____ _____ _____ | |\n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T("| | | _ | __| | |\n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T("| | | | | __|__ | |__|\n"));
qse_sio_puts (QSE_SIO_ERR, QSE_T("|_____|_____|__| |_____| |__|\n"));
#endif
qse_sio_puts (QSE_SIO_ERR, QSE_T("FILE "));
qse_sio_puts (QSE_SIO_ERR, file);
qse_sio_puts (QSE_SIO_ERR, QSE_T(" LINE "));

1
qse/lib/cut/Makefile.in
View File

@ -136,6 +136,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@

1
qse/lib/http/Makefile.in
View File

@ -117,6 +117,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@

44
qse/lib/http/http.c
View File

@ -18,7 +18,7 @@
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include <qse/utl/http.h>
#include <qse/http/http.h>
#include <qse/cmn/chr.h>
#include "../cmn/mem.h"
@ -229,11 +229,13 @@ qse_http_t* qse_http_init (qse_http_t* http, qse_mmgr_t* mmgr)
init_buffer (http, &http->reqx.b.raw);
init_buffer (http, &http->reqx.b.tra);
init_buffer (http, &http->reqx.b.pen);
init_buffer (http, &http->req.con);
if (qse_htb_init (&http->req.hdrtab, mmgr, 60, 70, 1, 1) == QSE_NULL)
{
fini_buffer (http, &http->req.con);
fini_buffer (http, &http->reqx.b.pen);
fini_buffer (http, &http->reqx.b.tra);
fini_buffer (http, &http->reqx.b.raw);
return QSE_NULL;
@ -247,6 +249,7 @@ void qse_http_fini (qse_http_t* http)
qse_htb_fini (&http->req.hdrtab);
clear_combined_headers (http);
fini_buffer (http, &http->req.con);
fini_buffer (http, &http->reqx.b.pen);
fini_buffer (http, &http->reqx.b.tra);
fini_buffer (http, &http->reqx.b.raw);
}
@ -993,8 +996,21 @@ int qse_http_feed (qse_http_t* http, const qse_byte_t* req, qse_size_t len)
const qse_byte_t* end = req + len;
const qse_byte_t* ptr = req;
#if 0
if (http->reqx.pending)
{
}
#endif
/* does this goto drop code maintainability? */
if (http->reqx.s.need > 0) goto content_resume;
if (http->reqx.s.need > 0)
{
/* we're in need of as many octets as http->reqx.s.need
* for contents body. make a proper jump to resume
* content handling */
goto content_resume;
}
switch (http->reqx.s.chunk.phase)
{
case GET_CHUNK_LEN:
@ -1099,14 +1115,16 @@ int qse_http_feed (qse_http_t* http, const qse_byte_t* req, qse_size_t len)
}
else
{
/* we need to read as many octets as Content-Length */
/* we need to read as many octets as
* Content-Length */
http->reqx.s.need = http->req.attr.content_length;
}
if (http->reqx.s.need > 0)
{
/* content-length or chunked data length specified */
/* content-length or chunked data length
* specified */
qse_size_t avail;
content_resume:
@ -1230,3 +1248,19 @@ feedme_more:
return 0;
}
int qse_http_addtext (qse_http_t* http, const qse_byte_t* ptr, qse_size_t len)
{
}
int qse_http_addresource (qse_http_t* http, const void* ptr, qse_size_t len)
{
}
int qse_http_addheader (
qse_http_t* http, const qse_byte_t* key, const qse_byte_t* val)
{
}
int qse_http_emit (qse_http_t* http)
{
}

1
qse/lib/scm/Makefile.in
View File

@ -117,6 +117,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@

394
qse/lib/scm/scm.c
View File

@ -22,6 +22,8 @@
QSE_IMPLEMENT_COMMON_FUNCTIONS (scm)
#define IS_NIL(x) ((x) != scm->nil)
static qse_scm_t* qse_scm_init (
qse_scm_t* scm,
qse_mmgr_t* mmgr,
@ -29,9 +31,15 @@ static qse_scm_t* qse_scm_init (
qse_size_t mem_ubound_inc
);
static void qse_scm_fini (qse_scm_t* scm);
static qse_scm_val_t* mkcons (
qse_scm_t* scm, qse_scm_val_t* car, qse_scm_val_t* cdr);
static void qse_scm_fini (
qse_scm_t* scm
);
static qse_scm_ent_t* make_pair_entity (
qse_scm_t* scm,
qse_scm_ent_t* car,
qse_scm_ent_t* cdr
);
qse_scm_t* qse_scm_open (
qse_mmgr_t* mmgr, qse_size_t xtnsize,
@ -71,11 +79,11 @@ void qse_scm_close (qse_scm_t* scm)
static QSE_INLINE void delete_all_value_blocks (qse_scm_t* scm)
{
while (scm->mem.vbl)
while (scm->mem.ebl)
{
qse_scm_vbl_t* vbl = scm->mem.vbl;
scm->mem.vbl = scm->mem.vbl->next;
QSE_MMGR_FREE (scm->mmgr, vbl);
qse_scm_enb_t* enb = scm->mem.ebl;
scm->mem.ebl = scm->mem.ebl->next;
QSE_MMGR_FREE (scm->mmgr, enb);
}
}
@ -83,17 +91,17 @@ static qse_scm_t* qse_scm_init (
qse_scm_t* scm, qse_mmgr_t* mmgr,
qse_size_t mem_ubound, qse_size_t mem_ubound_inc)
{
#if 0
static qse_scm_val_t static_values[3] =
static qse_scm_ent_t static_values[3] =
{
/* dswcount, mark, atom, type */
/* nil */
{ (QSE_SCM_VAL_ATOM | QSE_SCM_VAL_MARK) },
{ 0, 1, 1, QSE_SCM_ENT_NIL },
/* f */
{ (QSE_SCM_VAL_ATOM | QSE_SCM_VAL_MARK) },
{ 0, 1, 1, QSE_SCM_ENT_T },
/* t */
{ (QSE_SCM_VAL_ATOM | QSE_SCM_VAL_MARK) }
{ 0, 1, 1, QSE_SCM_ENT_F }
};
#endif
if (mmgr == QSE_NULL) mmgr = QSE_MMGR_GETDFL();
@ -119,17 +127,15 @@ static qse_scm_t* qse_scm_init (
return QSE_NULL;
}
#if 0
/* initialize common values */
scm->nil = &static_values[0];
scm->f = &static_values[1];
scm->t = &static_values[2];
#endif
scm->f = &static_values[1];
scm->t = &static_values[2];
scm->mem.vbl = QSE_NULL;
scm->mem.ebl = QSE_NULL;
scm->mem.free = scm->nil;
scm->genv = mkcons (scm, scm->nil, scm->nil);
scm->genv = make_pair_entity (scm, scm->nil, scm->nil);
if (scm->genv == QSE_NULL)
{
delete_all_value_blocks (scm);
@ -138,6 +144,8 @@ static qse_scm_t* qse_scm_init (
return QSE_NULL;
}
scm->symtab = scm->nil;
scm->reg.dmp = scm->nil;
scm->reg.env = scm->genv;
@ -186,7 +194,7 @@ int qse_scm_attachio (qse_scm_t* scm, qse_scm_io_t* io)
if (io->out (scm, QSE_SCM_IO_OPEN, &scm->io.arg.out, QSE_NULL, 0) <= -1)
{
if (scm->err.num == QSE_SCM_ENOERR)
qse_scm_seterror (scm,QSE_SCM_EIO, QSE_NULL, QSE_NULL);
qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, QSE_NULL);
io->in (scm, QSE_SCM_IO_CLOSE, &scm->io.arg.in, QSE_NULL, 0);
return -1;
}
@ -199,60 +207,50 @@ int qse_scm_attachio (qse_scm_t* scm, qse_scm_io_t* io)
return 0;
}
static qse_scm_vbl_t* newvbl (qse_scm_t* scm, qse_size_t len)
static qse_scm_enb_t* new_entity_block (qse_scm_t* scm, qse_size_t len)
{
/*
* create a new value block containing as many slots as len
*/
qse_scm_vbl_t* blk;
qse_scm_val_t* v;
qse_scm_enb_t* blk;
qse_scm_ent_t* v;
qse_size_t i;
blk = (qse_scm_vbl_t*) QSE_MMGR_ALLOC (
blk = (qse_scm_enb_t*) QSE_MMGR_ALLOC (
scm->mmgr,
QSE_SIZEOF(qse_scm_vbl_t) +
QSE_SIZEOF(qse_scm_val_t) * len
QSE_SIZEOF(qse_scm_enb_t) +
QSE_SIZEOF(qse_scm_ent_t) * len
);
if (blk == QSE_NULL)
{
scm->err.num = QSE_SCM_ENOMEM;
qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
/* initialize the block fields */
blk->ptr = (qse_scm_val_t*)(blk + 1);
blk->ptr = (qse_scm_ent_t*)(blk + 1);
blk->len = len;
/* chain the value block to the block list */
blk->next = scm->mem.vbl;
scm->mem.vbl = blk;
blk->next = scm->mem.ebl;
scm->mem.ebl = blk;
/* chain each slot to the free slot list */
/* chain each slot to the free slot list using
* the CDR field of an entity */
v = &blk->ptr[0];
for (i = 0; i < len -1; i++)
{
qse_scm_val_t* tmp = v++;
tmp->u.cons.cdr = v;
qse_scm_ent_t* tmp = v++;
PAIR_CDR(tmp) = v;
}
v->u.cons.cdr = scm->mem.free;
PAIR_CDR(v) = scm->mem.free;
scm->mem.free = &blk->ptr[0];
return blk;
};
/* TODO: redefine this ... */
#define IS_ATOM(v) ((v)->flags & (QSE_SCM_VAL_STRING | QSE_SCM_VAL_NUMBER | QSE_SCM_VAL_PROC)
#define IS_MARKED(v) ((v)->mark)
#define SET_MARK(v) ((v)->mark = 1)
#define CLEAR_MARK(v) ((v)->mark = 0)
#define ZERO_DSW_COUNT(v) ((v)->dsw_count = 0)
#define GET_DSW_COUNT(v) ((v)->dsw_count)
#define INC_DSW_COUNT(v) ((v)->dsw_count++)
static void mark (qse_scm_t* scm, qse_scm_val_t* v)
static void mark (qse_scm_t* scm, qse_scm_ent_t* v)
{
/*
* mark values non-recursively with Deutsch-Schorr-Waite(DSW) algorithm
@ -260,24 +258,23 @@ static void mark (qse_scm_t* scm, qse_scm_val_t* v)
* with the help of additional variables.
*/
qse_scm_val_t* parent, * me;
qse_scm_ent_t* parent, * me;
#if 0
/* initialization */
parent = QSE_NULL;
me = v;
SET_MARK (me);
/*if (!IS_ATOM(me))*/ ZERO_DSW_COUNT (me);
MARK(me) = 1;
/*if (!ATOM(me))*/ DSWCOUNT(me) = 0;
while (1)
{
if (IS_ATOM(me) || GET_DSW_COUNT(me) >= 2)
if (ATOM(me) || DSWCOUNT(me) >= QSE_COUNTOF(me->u.ref.ent))
{
/*
* backtrack to the parent node
*/
qse_scm_val_t* child;
qse_scm_ent_t* child;
/* nothing more to backtrack? end of marking */
if (parent == QSE_NULL) return;
@ -289,30 +286,30 @@ static void mark (qse_scm_t* scm, qse_scm_val_t* v)
me = parent;
/* change the parent to the parent of parent */
parent = me->u.cona.val[GET_DSW_COUNT(me)];
parent = me->u.ref.ent[DSWCOUNT(me)];
/* restore the cell contents */
me->u.cona.val[GET_DSW_COUNT(me)] = child;
me->u.ref.ent[DSWCOUNT(me)] = child;
/* increment the counter to indicate that the
* 'count'th field has been processed.
INC_DSW_COUNT (me);
* 'count'th field has been processed. */
DSWCOUNT(me)++;
}
else
{
/*
* move on to an unprocessed child
*/
qse_scm_val_t* child;
qse_scm_ent_t* child;
child = me->u.cona.val[GET_DSW_COUNT(me)];
child = me->u.ref.ent[DSWCOUNT(me)];
/* process the field */
if (child && !ismark(child))
if (child && !MARK(child))
{
/* change the contents of the child chonse
* to point to the current parent */
me->u.cona.val[GET_DSW_COUNT(me)] = parent;
me->u.ref.ent[DSWCOUNT(me)] = parent;
/* link me to the head of parent list */
parent = me;
@ -320,23 +317,23 @@ static void mark (qse_scm_t* scm, qse_scm_val_t* v)
/* let me point to the child chosen */
me = child;
SET_MARK (me);
/*if (!IS_ATOM(me))*/ ZERO_DSW_COUNT (me);
MARK(me) = 1;
/*if (!ATOM(me))*/ DSWCOUNT(me) = 0;
}
else
{
INC_DSW_COUNT (me)
/* increment the count */
DSWCOUNT(me)++;
}
}
}
#endif
}
#if 0
static void mark (qse_scm_t* scm, qse_scm_val_t* v)
static void mark (qse_scm_t* scm, qse_scm_ent_t* v)
{
qse_scm_val_t* t, * p, * q;
qse_scm_ent_t* t, * p, * q;
t = QSE_NULL;
p = v;
@ -389,9 +386,9 @@ E6:
}
#endif
static void gc (qse_scm_t* scm, qse_scm_val_t* x, qse_scm_val_t* y)
static void gc (qse_scm_t* scm, qse_scm_ent_t* x, qse_scm_ent_t* y)
{
//mark (scm, scm->oblist);
//mark (scm, scm->symtab);
mark (scm, scm->genv);
mark (scm, scm->reg.arg);
@ -399,45 +396,276 @@ static void gc (qse_scm_t* scm, qse_scm_val_t* x, qse_scm_val_t* y)
mark (scm, scm->reg.cod);
mark (scm, scm->reg.dmp);
/* mark the temporaries */
mark (scm, x);
mark (scm, y);
/* scan the allocated values */
}
static qse_scm_val_t* mkval (qse_scm_t* scm, qse_scm_val_t* x, qse_scm_val_t* y)
/*
rsr4
the following identifiers are syntatic keywors and should not be
used as variables.
=> do or
and else quasiquote
begin if quote
case lambda set!
cond let unquote
define let* unquote-splicing
delay letrec
however, you can allow for these keywords to be used as variables...
biniding, unbound...
environment.. a set of visible bindings at some point in a program.
type atom cons
number NUMBER Y
string STRING Y
symbol SYMBOL name,NIL
syntax SYNTAX|SYMBOL name,NIL
proc PROC Y
pair PAIR Y
closure
continuation
an atom does not reference any other values.
a symbol can be assoicated with property list
(put 'a 'name "brian")
(put 'a 'city "daegu")
-------------------------
(define a1 'a)
(put a1 'name "brian")
(put a1 'city "daegu")
-------------------------
(get a1 'name)
(get a1 'city)
a procedure is a privimitive routine built-in to scheme.
a closure is an anonymous routine defined with lambda.
both can be bound to a variable in the environment.
a syntax is more primitive than a procedure.
a syntax is created as if it is a symbol but not registerd
into an environment
car cdr
| STR | PTR CHR ARR | -1 |
| PROC | PROCNUM | |
| SYM | REF STR | REF PROP LIST |
| SYN | REF STR | REF PROP LIST |
*/
static qse_scm_ent_t* alloc_entity (
qse_scm_t* scm, qse_scm_ent_t* x, qse_scm_ent_t* y)
{
qse_scm_val_t* v;
/* find a free value slot and return it.
* two parameters x and y are saved from garbage collection */
qse_scm_ent_t* v;
if (scm->mem.free == scm->nil)
{
gc (scm, x, y);
/* if no free slot is available */
gc (scm, x, y); /* perform garbage collection */
if (scm->mem.free == scm->nil)
{
if (newvbl (scm, 1000) == QSE_NULL) return QSE_NULL;
/* if no free slot is available after garbage collection,
* make new value blocks containing more free slots */
/* TODO: make the value block size configurable */
if (new_entity_block (scm, 1000) == QSE_NULL) return QSE_NULL;
QSE_ASSERT (scm->mem.free != scm->nil);
}
}
v = scm->mem.free;
scm->mem.free = v->u.cons.cdr;
scm->mem.free = PAIR_CDR(v);
return v;
}
static qse_scm_val_t* mkcons (
qse_scm_t* scm, qse_scm_val_t* car, qse_scm_val_t* cdr)
static qse_scm_ent_t* make_pair_entity (
qse_scm_t* scm, qse_scm_ent_t* car, qse_scm_ent_t* cdr)
{
qse_scm_val_t* v;
qse_scm_ent_t* v;
v = mkval (scm, car, cdr);
v = alloc_entity (scm, car, cdr);
if (v == QSE_NULL) return QSE_NULL;
#if 0
v->flag = QSE_SCM_VAL_PAIR;
v->u.cons.car = car;
v->u.cons.cdr = car;
#endif
TYPE(v) = QSE_SCM_ENT_PAIR;
ATOM(v) = 0; /* a pair is not an atom as it references other entities */
PAIR_CAR(v) = car;
PAIR_CDR(v) = cdr;
return v;
}
static qse_scm_ent_t* make_string_entity (
qse_scm_t* scm, const qse_char_t* str, qse_size_t len)
{
qse_scm_ent_t* v;
v = alloc_entity (scm, scm->nil, scm->nil);
if (v == QSE_NULL) return QSE_NULL;
TYPE(v) = QSE_SCM_ENT_STR;
ATOM(v) = 1;
/* TODO: allocate a string from internal managed region .
Calling strdup is not an option as it is not managed...
*/
STR_PTR(v) = qse_strxdup (str, len, QSE_MMGR(scm));
if (STR_PTR(v) == QSE_NULL)
{
qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
STR_LEN(v) = len;
return v;
}
static qse_scm_ent_t* make_name_entity (qse_scm_t* scm, const qse_char_t* str)
{
qse_scm_ent_t* v;
v = alloc_entity (scm, scm->nil, scm->nil);
if (v == QSE_NULL) return QSE_NULL;
TYPE(v) = QSE_SCM_ENT_NAM;
ATOM(v) = 1;
/* TODO: allocate a string from internal managed region .
Calling strdup is not an option as it is not managed...
*/
LAB_PTR(v) = qse_strdup (str, QSE_MMGR(scm));
if (LAB_PTR(v) == QSE_NULL)
{
qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
LAB_CODE(v) = 0;
return v;
}
static qse_scm_ent_t* make_symbol_entity (qse_scm_t* scm, const qse_char_t* name)
{
qse_scm_ent_t* pair, * sym, * nam;
/* TODO: use a hash table, red-black tree to maintain symbol table
* The current linear search algo is not performance friendly...
*/
/* find if the symbol already exists by traversing the pair list
* and inspecting the symbol name pointed to by CAR of each pair.
*
* the symbol table is a list of pairs whose CAR points to a symbol
* and CDR is used for chaining.
*
* +-----+-----+
* | | |
* +-----+-----+
* car | | cdr +-----+-----+
* | +----------> | | |
* V +-----+-----+
* +--------+ car |
* | symbol | V
* +--------+ +--------+
* | symbol |
* +--------+
*/
for (pair = scm->symtab; !IS_NIL(pair); pair = PAIR_CDR(pair))
{
sym = PAIR_CAR(pair);
if (qse_strcmp(name, LAB_PTR(SYM_NAME(sym))) == 0) return sym;
}
/* no existing symbol with such a name is found.
* let's create a new symbol. the first step is to create a
* string entity to contain the symbol name */
nam = make_name_entity (scm, name);
if (nam == QSE_NULL) return QSE_NULL;
/* let's allocate the actual symbol entity that references the
* the symbol name entity created above */
sym = alloc_entity (scm, nam, scm->nil);
if (sym == QSE_NULL) return QSE_NULL;
TYPE(sym) = QSE_SCM_ENT_SYM;
ATOM(sym) = 0;
SYM_NAME(sym) = nam;
SYM_PROP(sym) = scm->nil; /* no properties yet */
/* chain the symbol entity to the symbol table for lookups later */
pair = make_pair_entity (scm, sym, scm->symtab);
if (pair == QSE_NULL) return QSE_NULL;
scm->symtab = pair;
return sym;
}
static qse_scm_ent_t* make_syntax_entity (
qse_scm_t* scm, const qse_char_t* name, int code)
{
qse_scm_ent_t* v;
QSE_ASSERTX (code > 0, "Syntax code must be greater than 0");
v = make_symbol_entity (scm, name);
if (v == QSE_NULL) return QSE_NULL;
/* we piggy-back the syntax code to a symbol name.
* the syntax entity is basically a symbol except that the
* code field of its label entity is set to non-zero.
*/
TYPE(v) |= QSE_SCM_ENT_SYNT;
SYNT_CODE(v) = code;
return v;
}
static qse_scm_ent_t* make_proc_entity (
qse_scm_t* scm, const qse_char_t* name, int code)
{
qse_scm_ent_t* sym, * proc, * pair;
/* a procedure entity is a built-in function that
* that can be overridden by a user while a syntax entity
* represents a lower-level syntatic function that can't
* be overriden.
* (define lambda 10) is legal but does not change the
* meaning of lambda when used as a function name.
* (define eval 10) changes the meaning of eval totally.
*/
/* create a symbol containing the name */
sym = make_symbol_entity (scm, name);
if (sym == QSE_NULL) return QSE_NULL;
/* create an actual procecure value which is a number containing
* the opcode for the procedure */
proc = alloc_entity (scm, scm->nil, scm->nil);
if (proc == QSE_NULL) return QSE_NULL;
TYPE(proc) = QSE_SCM_ENT_PROC;
ATOM(proc) = 1;
PROC_CODE(proc) = code;
/* create a pair containing the name symbol and the procedure value */
pair = make_pair_entity (scm, sym, proc);
if (pair == QSE_NULL) return QSE_NULL;
/* link it to the global environment */
pair = make_pair_entity (scm, pair, PAIR_CAR(scm->genv));
if (pair == QSE_NULL) return QSE_NULL;
PAIR_CAR(scm->genv) = pair;
return proc;
}

134
qse/lib/scm/scm.h
View File

@ -40,65 +40,100 @@
#define QSE_SCM_TOUPPER(scm,c) QSE_TOUPPER(c)
#define QSE_SCM_TOLOWER(scm,c) QSE_TOLOWER(c)
#define QSE_SCM_VAL_STRING 1 /* 0000000000000001 */
#define QSE_SCM_VAL_NUMBER 2 /* 0000000000000010 */
#define QSE_SCM_VAL_SYMBOL 4 /* 0000000000000100 */
#define QSE_SCM_VAL_SYNTAX 8 /* 0000000000001000 */
#define QSE_SCM_VAL_PROC 16 /* 0000000000010000 */
#define QSE_SCM_VAL_PAIR 32 /* 0000000000100000 */
#define QSE_SCM_VAL_CLOSURE 64 /* 0000000001000000 */
#define QSE_SCM_VAL_CONTINUATION 128 /* 0000000010000000 */
#define QSE_SCM_VAL_MACRO 256 /* 0000000100000000 */
#define QSE_SCM_VAL_PROMISE 512 /* 0000001000000000 */
#define QSE_SCM_VAL_ATOM 4096 /* 0001000000000000 */ /* only for gc */
typedef struct qse_scm_val_t qse_scm_val_t;
struct qse_scm_val_t
enum qse_scm_ent_type_t
{
qse_uint16_t dsw_count: 2;
qse_uint16_t mark: 1;
qse_uint16_t types: 13;
QSE_SCM_ENT_NIL = (1 << 0),
QSE_SCM_ENT_T = (1 << 1),
QSE_SCM_ENT_F = (1 << 2),
QSE_SCM_ENT_NUM = (1 << 3),
QSE_SCM_ENT_STR = (1 << 4),
QSE_SCM_ENT_NAM = (1 << 5),
QSE_SCM_ENT_SYM = (1 << 6),
QSE_SCM_ENT_PAIR = (1 << 7),
QSE_SCM_ENT_PROC = (1 << 8),
QSE_SCM_ENT_SYNT = (1 << 9)
};
#if 0
#define QSE_SCM_ENT_CLOSURE 64 /* 0000000001000000 */
#define QSE_SCM_ENT_CONTINUATION 128 /* 0000000010000000 */
#define QSE_SCM_ENT_MACRO 256 /* 0000000100000000 */
#define QSE_SCM_ENT_PROMISE 512 /* 0000001000000000 */
#endif
typedef struct qse_scm_ent_t qse_scm_ent_t;
/**
* The qse_scm_ent_t type defines an entity that represents an individual
* value in scheme.
*/
struct qse_scm_ent_t
{
qse_uint16_t dswcount: 2;
qse_uint16_t mark: 1;
qse_uint16_t atom: 1;
qse_uint16_t type: 12;
union
{
struct
{
qse_char_t* ptr;
qse_size_t len;
} str;
qse_long_t val;
} num; /* number */
struct
{
qse_long_t val;
} num;
/* a string doesn't need to be null-terminated
* as the length is remembered */
qse_char_t* ptr;
qse_size_t len;
} str; /* string */
struct
{
qse_char_t* ptr; /* null-terminated string */
int code; /* used for syntax entities only */
} lab; /* label */
struct
{
int code;
} proc;
struct
{
qse_scm_val_t* car;
qse_scm_val_t* cdr;
} cons;
/* arrayed cons. cona must maintain the
* same size as cons */
struct
{
qse_scm_val_t* val[2];
} cona;
qse_scm_ent_t* ent[2];
} ref;
} u;
};
#define DSWCOUNT(v) ((v)->dswcount)
#define MARK(v) ((v)->mark)
#define TYPE(v) ((v)->type)
#define ATOM(v) ((v)->atom)
#define NUM_VALUE(v) ((v)->u.num.val)
#define STR_PTR(v) ((v)->u.str.ptr)
#define STR_LEN(v) ((v)->u.str.len)
#define LAB_PTR(v) ((v)->u.lab.ptr)
#define LAB_CODE(v) ((v)->u.lab.code)
#define SYM_NAME(v) ((v)->u.ref.ent[0])
#define SYM_PROP(v) ((v)->u.ref.ent[1])
#define PAIR_CAR(v) ((v)->u.ref.ent[0])
#define PAIR_CDR(v) ((v)->u.ref.ent[1])
#define PROC_CODE(v) ((v)->u.proc.code)
#define SYNT_CODE(v) LAB_CODE(SYM_NAME(v))
/**
* The qse_scm_vbl_t type defines a value block. A value block is allocated
* The qse_scm_enb_t type defines a value block. A value block is allocated
* when more memory is requested and is chained to existing value blocks.
*/
typedef struct qse_scm_vbl_t qse_scm_vbl_t;
struct qse_scm_vbl_t
typedef struct qse_scm_enb_t qse_scm_enb_t;
struct qse_scm_enb_t
{
qse_scm_val_t* ptr;
qse_scm_ent_t* ptr;
qse_size_t len;
qse_scm_vbl_t* next;
qse_scm_enb_t* next;
};
struct qse_scm_t
@ -144,26 +179,29 @@ struct qse_scm_t
} r;
/* common values */
qse_scm_val_t* nil;
qse_scm_val_t* t;
qse_scm_val_t* f;
qse_scm_ent_t* nil;
qse_scm_ent_t* t;
qse_scm_ent_t* f;
/* global environment */
qse_scm_val_t* genv;
qse_scm_ent_t* genv;
/* symbol table */
qse_scm_ent_t* symtab;
/* registers */
struct
{
qse_scm_val_t* arg; /* function arguments */
qse_scm_val_t* env; /* current environment */
qse_scm_val_t* cod; /* current code */
qse_scm_val_t* dmp; /* stack register for next evaluation */
qse_scm_ent_t* arg; /* function arguments */
qse_scm_ent_t* env; /* current environment */
qse_scm_ent_t* cod; /* current code */
qse_scm_ent_t* dmp; /* stack register for next evaluation */
} reg;
struct
{
qse_scm_vbl_t* vbl; /* value block list */
qse_scm_val_t* free;
qse_scm_enb_t* ebl; /* entity block list */
qse_scm_ent_t* free;
} mem;
};

1
qse/lib/sed/Makefile.in
View File

@ -136,6 +136,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@