From 5b60fd18f6eb2a5679637249ff4d818675cd57a5 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 4 Mar 2011 01:55:37 +0000 Subject: [PATCH] * fixed a problem of not printing the closing parenthesis if the last CDR is not nil in qse_scm_print(). * separated the syntax bit for a symbol from the type bits --- qse/lib/scm/mem.c | 8 +-- qse/lib/scm/print.c | 136 +++++++++++++++++++++++++------------------- qse/lib/scm/read.c | 2 +- qse/lib/scm/scm.c | 12 ++-- qse/lib/scm/scm.h | 31 +++++----- 5 files changed, 101 insertions(+), 88 deletions(-) diff --git a/qse/lib/scm/mem.c b/qse/lib/scm/mem.c index a8d2e96d..249ffcb9 100644 --- a/qse/lib/scm/mem.c +++ b/qse/lib/scm/mem.c @@ -458,13 +458,7 @@ qse_scm_ent_t* qse_scm_makesyntent ( v = qse_scm_makesyment (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. - * Read the comment in qse_scm_makeprocent() for difference between - * the syntax entity and the procedure entity. - */ - TYPE(v) |= QSE_SCM_ENT_SYNT; + SYNT(v) = 1; SYNT_CODE(v) = code; return v; diff --git a/qse/lib/scm/print.c b/qse/lib/scm/print.c index fc715ecd..8232d73b 100644 --- a/qse/lib/scm/print.c +++ b/qse/lib/scm/print.c @@ -114,7 +114,7 @@ static qse_size_t long_to_str ( return ret; } -static QSE_INLINE push (qse_scm_t* scm, qse_scm_ent_t* obj) +static QSE_INLINE int push (qse_scm_t* scm, qse_scm_ent_t* obj) { qse_scm_ent_t* top; @@ -132,16 +132,25 @@ static QSE_INLINE qse_scm_ent_t* pop (qse_scm_t* scm) return PAIR_CAR(top); } -static int print_entity ( - qse_scm_t* scm, const qse_scm_ent_t* obj, int prt_cons_par) +static QSE_INLINE print_num (qse_scm_t* scm, qse_long_t nval) { - qse_long_t nval; + qse_char_t tmp[QSE_SIZEOF(qse_long_t)*8+2]; + qse_size_t len; -retry: + len = long_to_str (nval, 10, QSE_NULL, tmp, QSE_COUNTOF(tmp)); + OUTPUT_STRX (scm, tmp, len); + return 0; +} + +static int print_entity (qse_scm_t* scm, const qse_scm_ent_t* obj) +{ + const qse_scm_ent_t* cur; + +next: if (IS_SMALLINT(scm,obj)) { - nval = FROM_SMALLINT(scm,obj); - goto printnum; + if (print_num (scm, FROM_SMALLINT(scm,obj)) <= -1) return -1; + goto done; } switch (TYPE(obj)) @@ -160,14 +169,7 @@ retry: case QSE_SCM_ENT_NUM: { - qse_char_t tmp[QSE_SIZEOF(qse_long_t)*8+2]; - qse_size_t len; - - nval = NUM_VALUE(obj); - - printnum: - len = long_to_str (nval, 10, QSE_NULL, tmp, QSE_COUNTOF(tmp)); - OUTPUT_STRX (scm, tmp, len); + if (print_num (scm, NUM_VALUE(obj)) <= -1) return -1; break; } @@ -192,6 +194,9 @@ retry: #endif case QSE_SCM_ENT_SYM: + /* Any needs for special action if SYNT(obj) is true? + * I simply treat the syntax symbol as a normal symbol + * for printing currently. */ OUTPUT_STR (scm, LAB_PTR(SYM_NAME(obj))); break; @@ -204,55 +209,52 @@ retry: case QSE_SCM_ENT_PAIR: { - const qse_scm_ent_t* p = obj; - if (prt_cons_par) OUTPUT_STR (scm, QSE_T("(")); + + OUTPUT_STR (scm, QSE_T("(")); + cur = obj; do { - if (push (scm, PAIR_CDR(p)) <= -1) return -1; - obj = PAIR_CAR(p); - goto retry; + /* Push what to print next on to the stack + * the variable p is */ + if (push (scm, PAIR_CDR(cur)) <= -1) return -1; + + obj = PAIR_CAR(cur); + /* Jump to the 'next' label so that the entity + * pointed to by 'obj' is printed. Once it + * ends, a jump back to the 'resume' label + * is made at the at of this function. */ + goto next; resume: - p = pop (scm); - if (!IS_NIL(scm,p)) + cur = pop (scm); /* Get back the CDR pushed */ + if (IS_NIL(scm,cur)) { - OUTPUT_STR (scm, QSE_T(" ")); - if (IS_SMALLINT(scm,p) || TYPE(p) != QSE_SCM_ENT_PAIR) - { - OUTPUT_STR (scm, QSE_T(". ")); + /* The CDR part points to a NIL entity, which + * indicates the end of a list. break the loop */ + break; + } + if (IS_SMALLINT(scm,cur) || TYPE(cur) != QSE_SCM_ENT_PAIR) + { + /* The CDR part does not point to a pair. */ + OUTPUT_STR (scm, QSE_T(" . ")); - // push resume location - // push .... - if (push (scm, 1) <= -1) return -1; - obj = p; - goto retry; - //qse_scm_print (scm, p); - } + /* Push NIL so that the IS_NIL(scm,p) test in + * the 'if' statement above breaks the loop + * after the jump is maded back to the 'resume' + * label. */ + if (push (scm, scm->nil) <= -1) return -1; + + /* Make a jump to 'next' to print the CDR part */ + obj = cur; + goto next; } + + /* The CDR part points to a pair. proceed to it */ + OUTPUT_STR (scm, QSE_T(" ")); } - while (!IS_NIL(scm,p) && !IS_SMALLINT(scm,p) && TYPE(p) == QSE_SCM_ENT_PAIR); - if (prt_cons_par) OUTPUT_STR (scm, QSE_T(")")); - -#if 0 - do - { - qse_scm_print (scm, PAIR_CAR(p)); - p = PAIR_CDR(p); - if (!IS_NIL(scm,p)) - { - OUTPUT_STR (scm, QSE_T(" ")); - if (TYPE(p) != QSE_SCM_ENT_PAIR) - { - OUTPUT_STR (scm, QSE_T(". ")); - qse_scm_print (scm, p); - } - } - } - while (p != scm->nil && TYPE(p) == QSE_SCM_ENT_PAIR); - if (prt_cons_par) OUTPUT_STR (scm, QSE_T(")")); -#endif - + while (1); + OUTPUT_STR (scm, QSE_T(")")); break; } @@ -262,13 +264,16 @@ retry: #endif default: - QSE_ASSERT (!"should never happen - unknown entity type"); + QSE_ASSERTX ( + 0, + "Unknown entity type - buggy!!" + ); qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL); return -1; } - - /* if the print stack is not empty, we still got more to print */ +done: + /* if the printing stack is not empty, we still got more to print */ if (!IS_NIL(scm,scm->p.s)) goto resume; return 0; @@ -276,10 +281,23 @@ retry: int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj) { + int n; + QSE_ASSERTX ( scm->io.fns.out != QSE_NULL, "Specify output function before calling qse_scm_print()" ); - return print_entity (scm, obj, 1); + n = print_entity (scm, obj); + + /* clear the printing stack if an error has occurred for GC not to keep + * the entities in the stack */ + if (n <= -1) scm->p.s = scm->nil; + + QSE_ASSERTX ( + IS_NIL(scm,scm->p.s), + "The printing stack is not empty after printing - buggy!!" + ); + + return n; } diff --git a/qse/lib/scm/read.c b/qse/lib/scm/read.c index 98c3b030..4eab7585 100644 --- a/qse/lib/scm/read.c +++ b/qse/lib/scm/read.c @@ -107,7 +107,7 @@ static int read_char (qse_scm_t* scm) else scm->r.curloc.colm++; } -qse_printf (QSE_T("[%c]\n"), scm->r.curc); +/*qse_printf (QSE_T("[%c]\n"), scm->r.curc);*/ return 0; } diff --git a/qse/lib/scm/scm.c b/qse/lib/scm/scm.c index c648c9d8..71882557 100644 --- a/qse/lib/scm/scm.c +++ b/qse/lib/scm/scm.c @@ -157,14 +157,14 @@ static qse_scm_t* qse_scm_init ( { static qse_scm_ent_t static_values[3] = { - /* dswcount, mark, atom, type */ + /* dswcount, mark, atom, synt, type */ /* nil */ - { 0, 1, 1, QSE_SCM_ENT_NIL }, + { 0, 1, 1, 0, QSE_SCM_ENT_NIL }, /* f */ - { 0, 1, 1, QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL }, + { 0, 1, 1, 0, QSE_SCM_ENT_T }, /* t */ - { 0, 1, 1, QSE_SCM_ENT_F | QSE_SCM_ENT_BOOL } + { 0, 1, 1, 0, QSE_SCM_ENT_F } }; if (mmgr == QSE_NULL) mmgr = QSE_MMGR_GETDFL(); @@ -188,8 +188,8 @@ static qse_scm_t* qse_scm_init ( /* initialize common values */ scm->nil = &static_values[0]; - scm->f = &static_values[1]; - scm->t = &static_values[2]; + scm->t = &static_values[1]; + scm->f = &static_values[2]; scm->lambda = scm->nil; scm->quote = scm->nil; diff --git a/qse/lib/scm/scm.h b/qse/lib/scm/scm.h index 378047cb..2799d2d9 100644 --- a/qse/lib/scm/scm.h +++ b/qse/lib/scm/scm.h @@ -29,24 +29,22 @@ /* Note that not all these values can be ORed with each other. * each value represents its own type except the following combinations. * - * QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL - * QSE_SCM_ENT_F | QSE_SCM_ENT_BOOL - * QSE_SCM_ENT_SYM | QSE_SCM_ENT_SYNT + * QSE_SCM_ENT_T + * QSE_SCM_ENT_F + * QSE_SCM_ENT_SYM */ enum qse_scm_ent_type_t { QSE_SCM_ENT_NIL = (1 << 0), QSE_SCM_ENT_T = (1 << 1), QSE_SCM_ENT_F = (1 << 2), - QSE_SCM_ENT_BOOL = (1 << 3), - QSE_SCM_ENT_NUM = (1 << 4), - QSE_SCM_ENT_REAL = (1 << 5), - QSE_SCM_ENT_STR = (1 << 6), - QSE_SCM_ENT_NAM = (1 << 7), - QSE_SCM_ENT_SYM = (1 << 8), - QSE_SCM_ENT_PAIR = (1 << 9), - QSE_SCM_ENT_PROC = (1 << 10), - QSE_SCM_ENT_SYNT = (1 << 11) + QSE_SCM_ENT_NUM = (1 << 3), + QSE_SCM_ENT_REAL = (1 << 4), + QSE_SCM_ENT_STR = (1 << 5), + QSE_SCM_ENT_NAM = (1 << 6), + QSE_SCM_ENT_SYM = (1 << 7), + QSE_SCM_ENT_PAIR = (1 << 8), + QSE_SCM_ENT_PROC = (1 << 9) }; @@ -66,7 +64,8 @@ struct qse_scm_ent_t qse_uint32_t dswcount: 2; qse_uint32_t mark: 1; qse_uint32_t atom: 1; - qse_uint32_t type: 28; + qse_uint32_t synt: 1; + qse_uint32_t type: 27; union { @@ -108,8 +107,10 @@ struct qse_scm_ent_t #define DSWCOUNT(v) ((v)->dswcount) #define MARK(v) ((v)->mark) -#define TYPE(v) ((v)->type) #define ATOM(v) ((v)->atom) +#define SYNT(v) ((v)->synt) +#define TYPE(v) ((v)->type) + #define NUM_VALUE(v) ((v)->u.num.val) #define REAL_VALUE(v) ((v)->u.real.val) #define STR_PTR(v) ((v)->u.str.ptr) @@ -118,10 +119,10 @@ struct qse_scm_ent_t #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 SYNT_CODE(v) LAB_CODE(SYM_NAME(v)) #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_enb_t type defines a value block. A value block is allocated