From f904914d6a2968045dd102310078b2041d27621e Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Wed, 7 Feb 2018 10:55:20 +0000 Subject: [PATCH] implemented dictionary printing --- lib/comp.c | 55 ++++++++++--------- lib/debug.c | 2 +- lib/decode.c | 8 +-- lib/dic.c | 124 +++++++++++++++++++++++------------------- lib/exec.c | 11 ++-- lib/gc.c | 8 +-- lib/hcl-prv.h | 26 ++------- lib/hcl.h | 14 ++--- lib/obj.c | 20 ------- lib/print.c | 146 +++++++++++++++++++++++++++++++++++++++++--------- lib/read.c | 6 +-- 11 files changed, 247 insertions(+), 173 deletions(-) diff --git a/lib/comp.c b/lib/comp.c index 367eab5..002a829 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -263,7 +263,7 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1 case HCL_CODE_PUSH_NEGINTLIT: case HCL_CODE_PUSH_CHARLIT: - case HCL_CODE_MAKE_DICTIONARY: /* TODO: don't these need write_long2? */ + case HCL_CODE_MAKE_DIC: /* TODO: don't these need write_long2? */ case HCL_CODE_MAKE_ARRAY: case HCL_CODE_POP_INTO_ARRAY: bc = cmd; @@ -616,7 +616,7 @@ enum COP_COMPILE_IF_OBJECT_LIST_TAIL, COP_COMPILE_ARRAY_LIST, - COP_COMPILE_DICTIONARY_LIST, + COP_COMPILE_DIC_LIST, COP_SUBCOMPILE_ELIF, COP_SUBCOMPILE_ELSE, @@ -624,9 +624,9 @@ enum COP_EMIT_CALL, COP_EMIT_MAKE_ARRAY, - COP_EMIT_MAKE_DICTIONARY, + COP_EMIT_MAKE_DIC, COP_EMIT_POP_INTO_ARRAY, - COP_EMIT_POP_INTO_DICTIONARY, + COP_EMIT_POP_INTO_DIC, COP_EMIT_LAMBDA, COP_EMIT_POP_STACKTOP, @@ -1132,14 +1132,13 @@ static int compile_cons_array_expression (hcl_t* hcl, hcl_oop_t obj) return 0; } -static int compile_cons_dictionary_expression (hcl_t* hcl, hcl_oop_t obj) +static int compile_cons_dic_expression (hcl_t* hcl, hcl_oop_t obj) { /* #{ } */ hcl_ooi_t nargs; hcl_cframe_t* cf; -printf ("XXXXXXXXXXXXXx\n"); - SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_DICTIONARY, HCL_SMOOI_TO_OOP(0)); + SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_DIC, HCL_SMOOI_TO_OOP(0)); nargs = hcl_countcons(hcl, obj); if (nargs > MAX_CODE_PARAM) @@ -1150,11 +1149,11 @@ printf ("XXXXXXXXXXXXXx\n"); } /* redundant cdr check is performed inside compile_object_list() */ - PUSH_SUBCFRAME (hcl, COP_COMPILE_DICTIONARY_LIST, obj); + PUSH_SUBCFRAME (hcl, COP_COMPILE_DIC_LIST, obj); - /* patch the argument count in the operand field of the COP_MAKE_DICTIONARY frame */ + /* patch the argument count in the operand field of the COP_MAKE_DIC frame */ cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DICTIONARY); + HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DIC); cf->operand = HCL_SMOOI_TO_OOP(nargs); return 0; @@ -1412,8 +1411,8 @@ static int compile_object (hcl_t* hcl) if (compile_cons_bytearray_expression (hcl, cf->operand) <= -1) return -1; break; */ - case HCL_CONCODE_DICTIONARY: - if (compile_cons_dictionary_expression(hcl, cf->operand) <= -1) return -1; + case HCL_CONCODE_DIC: + if (compile_cons_dic_expression(hcl, cf->operand) <= -1) return -1; break; /* TODO: QLIST? */ @@ -1598,13 +1597,13 @@ static int compile_array_list (hcl_t* hcl) return 0; } -static int compile_dictionary_list (hcl_t* hcl) +static int compile_dic_list (hcl_t* hcl) { hcl_cframe_t* cf; hcl_oop_t coperand; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_DICTIONARY_LIST); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_DIC_LIST); coperand = cf->operand; @@ -1641,10 +1640,10 @@ static int compile_dictionary_list (hcl_t* hcl) if (!HCL_IS_NIL(hcl, cddr)) { - PUSH_SUBCFRAME (hcl, COP_COMPILE_DICTIONARY_LIST, cddr); + PUSH_SUBCFRAME (hcl, COP_COMPILE_DIC_LIST, cddr); } - PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_DICTIONARY, HCL_SMOOI_TO_OOP(0)); + PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_DIC, HCL_SMOOI_TO_OOP(0)); PUSH_SUBCFRAME(hcl, COP_COMPILE_OBJECT, cadr); } @@ -1978,16 +1977,16 @@ static HCL_INLINE int emit_make_array (hcl_t* hcl) } -static HCL_INLINE int emit_make_dictionary (hcl_t* hcl) +static HCL_INLINE int emit_make_dic (hcl_t* hcl) { hcl_cframe_t* cf; int n; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DICTIONARY); + HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DIC); HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); - n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_DICTIONARY, HCL_OOP_TO_SMOOI(cf->operand)); + n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_DIC, HCL_OOP_TO_SMOOI(cf->operand)); POP_CFRAME (hcl); return n; @@ -2008,15 +2007,15 @@ static HCL_INLINE int emit_pop_into_array (hcl_t* hcl) return n; } -static HCL_INLINE int emit_pop_into_dictionary (hcl_t* hcl) +static HCL_INLINE int emit_pop_into_dic (hcl_t* hcl) { hcl_cframe_t* cf; int n; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_DICTIONARY); + HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_DIC); - n = emit_byte_instruction (hcl, HCL_CODE_POP_INTO_DICTIONARY); + n = emit_byte_instruction (hcl, HCL_CODE_POP_INTO_DIC); POP_CFRAME (hcl); return n; @@ -2178,8 +2177,8 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj) if (compile_array_list(hcl) <= -1) goto oops; break; - case COP_COMPILE_DICTIONARY_LIST: - if (compile_dictionary_list(hcl) <= -1) goto oops; + case COP_COMPILE_DIC_LIST: + if (compile_dic_list(hcl) <= -1) goto oops; break; case COP_EMIT_CALL: @@ -2190,16 +2189,16 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj) if (emit_make_array(hcl) <= -1) goto oops; break; - case COP_EMIT_MAKE_DICTIONARY: - if (emit_make_dictionary(hcl) <= -1) goto oops; + case COP_EMIT_MAKE_DIC: + if (emit_make_dic(hcl) <= -1) goto oops; break; case COP_EMIT_POP_INTO_ARRAY: if (emit_pop_into_array(hcl) <= -1) goto oops; break; - case COP_EMIT_POP_INTO_DICTIONARY: - if (emit_pop_into_dictionary(hcl) <= -1) goto oops; + case COP_EMIT_POP_INTO_DIC: + if (emit_pop_into_dic(hcl) <= -1) goto oops; break; case COP_EMIT_LAMBDA: diff --git a/lib/debug.c b/lib/debug.c index 139e7ad..c7ece60 100644 --- a/lib/debug.c +++ b/lib/debug.c @@ -47,7 +47,7 @@ void hcl_dumpsymtab (hcl_t* hcl) HCL_DEBUG0 (hcl, "--------------------------------------------\n"); } -void hcl_dumpdic (hcl_t* hcl, hcl_oop_set_t dic, const hcl_bch_t* title) +void hcl_dumpdic (hcl_t* hcl, hcl_oop_dic_t dic, const hcl_bch_t* title) { hcl_oow_t i; hcl_oop_cons_t ass; diff --git a/lib/decode.c b/lib/decode.c index 175258e..4d99329 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -503,13 +503,13 @@ int hcl_decode (hcl_t* hcl, hcl_ooi_t start, hcl_ooi_t end) LOG_INST_1 (hcl, "pop_into_array %zu", b1); break; - case HCL_CODE_MAKE_DICTIONARY: + case HCL_CODE_MAKE_DIC: FETCH_PARAM_CODE_TO (hcl, b1); - LOG_INST_1 (hcl, "make_dictionary %zu", b1); + LOG_INST_1 (hcl, "make_dic %zu", b1); break; - case HCL_CODE_POP_INTO_DICTIONARY: - LOG_INST_0 (hcl, "pop_into_dictionary"); + case HCL_CODE_POP_INTO_DIC: + LOG_INST_0 (hcl, "pop_into_dic"); break; /* -------------------------------------------------------- */ diff --git a/lib/dic.c b/lib/dic.c index 2133354..086b105 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -26,6 +26,8 @@ #include "hcl-prv.h" +/*#define SYMBOL_ONLY_KEY */ + static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) { hcl_oop_oop_t newbuc; @@ -71,12 +73,18 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) ass = (hcl_oop_cons_t)oldbuc->slot[--oldsz]; if ((hcl_oop_t)ass != hcl->_nil) { + #if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass)); - key = (hcl_oop_char_t)ass->car; HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); - index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % newsz; + #else + int n; + HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass)); + n = hcl_hashobj(hcl, ass->car, &index); + HCL_ASSERT (hcl, n == 0); /* since it's expanding, the existing in the bucket should always be hashable */ + index %= newsz; + #endif while (newbuc->slot[index] != hcl->_nil) index = (index + 1) % newsz; newbuc->slot[index] = (hcl_oop_t)ass; } @@ -85,7 +93,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) return newbuc; } -static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_char_t key, hcl_oop_t value) +static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_char_t key, hcl_oop_t value) { hcl_ooi_t tally; hcl_oow_t index; @@ -94,17 +102,24 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha /* the system dictionary is not a generic dictionary. * it accepts only a symbol as a key. */ +#if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); +#endif HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally)); HCL_ASSERT (hcl, HCL_IS_ARRAY(hcl,dic->bucket)); +#if defined(SYMBOL_ONLY_KEY) index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket); +#else + if (hcl_hashobj(hcl, key, &index) <= -1) return HCL_NULL; + index %= HCL_OBJ_GET_SIZE(dic->bucket); +#endif /* find */ while (dic->bucket->slot[index] != hcl->_nil) { + #if defined(SYMBOL_ONLY_KEY) ass = (hcl_oop_cons_t)dic->bucket->slot[index]; - HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass)); HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car)); @@ -115,6 +130,21 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha if (value) ass->cdr = value; /* update */ return ass; } + #else + int n; + + ass = (hcl_oop_cons_t)dic->bucket->slot[index]; + HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass)); + + n = hcl_equalobjs(hcl, key, ass->car); + if (n <= -1) return HCL_NULL; + if (n >= 1) + { + /* the value of HCL_NULL indicates no insertion or update. */ + if (value) ass->cdr = value; /* update */ + return ass; + } + #endif index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket); } @@ -123,7 +153,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha { /* when value is HCL_NULL, perform no insertion. * the value of HCL_NULL indicates no insertion or update. */ - hcl_seterrnum (hcl, HCL_ENOENT); + hcl_seterrbfmt (hcl, HCL_ENOENT, "key not found - %O", key); return HCL_NULL; } @@ -151,8 +181,8 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha hcl_oop_oop_t bucket; /* TODO: make the growth policy configurable instead of growing - it just before it gets full. The polcy can be grow it - if it's 70% full */ + it just before it gets full. The polcy can be grow it + if it's 70% full */ /* enlarge the bucket before it gets full to * make sure that it has at least one free slot left @@ -163,8 +193,13 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha dic->bucket = bucket; + #if defined(SYMBOL_ONLY_KEY) /* recalculate the index for the expanded bucket */ index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket); + #else + hcl_hashobj(hcl, key, &index); /* this must succeed as i know 'key' is hashable */ + index %= HCL_OBJ_GET_SIZE(dic->bucket); + #endif while (dic->bucket->slot[index] != hcl->_nil) index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket); @@ -189,75 +224,56 @@ oops: return HCL_NULL; } -static hcl_oop_cons_t lookup (hcl_t* hcl, hcl_oop_set_t dic, const hcl_oocs_t* name) -{ - /* this is special version of hcl_getatsysdic() that performs - * lookup using a plain string specified */ - - hcl_oow_t index; - hcl_oop_cons_t ass; - - HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally)); - HCL_ASSERT (hcl, HCL_IS_ARRAY(hcl,dic->bucket)); - - index = hcl_hashoochars(name->ptr, name->len) % HCL_OBJ_GET_SIZE(dic->bucket); - - while (dic->bucket->slot[index] != hcl->_nil) - { - ass = (hcl_oop_cons_t)dic->bucket->slot[index]; - - HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass)); - HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car)); - - if (name->len == HCL_OBJ_GET_SIZE(ass->car) && - hcl_equaloochars(name->ptr, ((hcl_oop_char_t)ass->car)->slot, name->len)) - { - return ass; - } - - index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket); - } - - /* when value is HCL_NULL, perform no insertion */ - hcl_seterrnum (hcl, HCL_ENOENT); - return HCL_NULL; -} - hcl_oop_cons_t hcl_putatsysdic (hcl_t* hcl, hcl_oop_t key, hcl_oop_t value) { +#if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); +#endif return find_or_upsert (hcl, hcl->sysdic, (hcl_oop_char_t)key, value); } hcl_oop_cons_t hcl_getatsysdic (hcl_t* hcl, hcl_oop_t key) { +#if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); +#endif return find_or_upsert (hcl, hcl->sysdic, (hcl_oop_char_t)key, HCL_NULL); } -hcl_oop_cons_t hcl_lookupsysdic (hcl_t* hcl, const hcl_oocs_t* name) -{ - return lookup (hcl, hcl->sysdic, name); -} - -hcl_oop_cons_t hcl_putatdic (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_t key, hcl_oop_t value) +hcl_oop_cons_t hcl_putatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_oop_t value) { +#if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); +#endif return find_or_upsert (hcl, dic, (hcl_oop_char_t)key, value); } -hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_t key) +hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) { +#if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); +#endif return find_or_upsert (hcl, dic, (hcl_oop_char_t)key, HCL_NULL); } -hcl_oop_cons_t hcl_lookupdic (hcl_t* hcl, hcl_oop_set_t dic, const hcl_oocs_t* name) +hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize) { - return lookup (hcl, dic, name); -} + hcl_oop_dic_t obj; -hcl_oop_set_t hcl_makedic (hcl_t* hcl, hcl_oow_t size) -{ - return (hcl_oop_set_t)hcl_makeset (hcl, size); + obj = (hcl_oop_dic_t)hcl_allocoopobj (hcl, HCL_BRAND_DIC, 2); + if (obj) + { + hcl_oop_oop_t bucket; + + obj->tally = HCL_SMOOI_TO_OOP(0); + + hcl_pushtmp (hcl, (hcl_oop_t*)&obj); + bucket = (hcl_oop_oop_t)hcl_makearray (hcl, inisize); + hcl_poptmp (hcl); + + if (!bucket) obj = HCL_NULL; + else obj->bucket = bucket; + } + + return (hcl_oop_t)obj; } diff --git a/lib/exec.c b/lib/exec.c index 1482c45..5ab0929 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -1842,30 +1842,29 @@ static int execute (hcl_t* hcl) break; } - case HCL_CODE_MAKE_DICTIONARY: + case HCL_CODE_MAKE_DIC: { hcl_oop_t t; FETCH_PARAM_CODE_TO (hcl, b1); - LOG_INST_1 (hcl, "make_dictionary %zu", b1); + LOG_INST_1 (hcl, "make_dic %zu", b1); t = (hcl_oop_t)hcl_makedic (hcl, b1 + 10); if (!t) return -1; HCL_STACK_PUSH (hcl, t); break; } - case HCL_CODE_POP_INTO_DICTIONARY: + case HCL_CODE_POP_INTO_DIC: { hcl_oop_t t1, t2, t3; - LOG_INST_0 (hcl, "pop_into_dictionary"); + LOG_INST_0 (hcl, "pop_into_dic"); t1 = HCL_STACK_GETTOP(hcl); /* value */ HCL_STACK_POP (hcl); t2 = HCL_STACK_GETTOP(hcl); /* key */ HCL_STACK_POP (hcl); t3 = HCL_STACK_GETTOP(hcl); /* dictionary */ -/* TODO: generic dictioanry??? */ - if (!hcl_putatdic (hcl, (hcl_oop_set_t)t3, t2, t1)) return -1; + if (!hcl_putatdic (hcl, (hcl_oop_dic_t)t3, t2, t1)) return -1; break; } diff --git a/lib/gc.c b/lib/gc.c index 3e32985..b3fadee 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -327,7 +327,7 @@ void hcl_gc (hcl_t* hcl) hcl->_large_positive_integer = hcl_moveoop (hcl, hcl->_large_positive_integer); hcl->_large_negative_integer = hcl_moveoop (hcl, hcl->_large_negative_integer); - hcl->sysdic = (hcl_oop_set_t) hcl_moveoop (hcl, (hcl_oop_t)hcl->sysdic); + hcl->sysdic = (hcl_oop_dic_t) hcl_moveoop (hcl, (hcl_oop_t)hcl->sysdic); hcl->processor = (hcl_oop_process_scheduler_t) hcl_moveoop (hcl, (hcl_oop_t)hcl->processor); hcl->nil_process = (hcl_oop_process_t) hcl_moveoop (hcl, (hcl_oop_t)hcl->nil_process); @@ -377,7 +377,7 @@ void hcl_gc (hcl_t* hcl) compact_symbol_table (hcl, old_nil); /* move the symbol table itself */ - hcl->symtab = (hcl_oop_set_t)hcl_moveoop (hcl, (hcl_oop_t)hcl->symtab); + hcl->symtab = (hcl_oop_dic_t)hcl_moveoop (hcl, (hcl_oop_t)hcl->symtab); /* scan the new heap again from the end position of * the previous scan to move referenced objects by @@ -488,13 +488,13 @@ int hcl_ignite (hcl_t* hcl) if (!hcl->symtab) { - hcl->symtab = (hcl_oop_set_t)hcl_makeset (hcl, hcl->option.dfl_symtab_size); + hcl->symtab = (hcl_oop_dic_t)hcl_makedic (hcl, hcl->option.dfl_symtab_size); if (!hcl->symtab) return -1; } if (!hcl->sysdic) { - hcl->sysdic = (hcl_oop_set_t)hcl_makeset (hcl, hcl->option.dfl_sysdic_size); + hcl->sysdic = (hcl_oop_dic_t)hcl_makedic (hcl, hcl->option.dfl_sysdic_size); if (!hcl->sysdic) return -1; } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index b1175f8..0536e87 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -704,8 +704,8 @@ enum hcl_bcode_t BCODE_SEND_MESSAGE_X = 0xF0, /* 240 ## */ /* UNUSED 241 */ - HCL_CODE_MAKE_DICTIONARY = 0xF2, /* 242 */ - HCL_CODE_POP_INTO_DICTIONARY = 0xF3, /* 243 */ + HCL_CODE_MAKE_DIC = 0xF2, /* 242 */ + HCL_CODE_POP_INTO_DIC = 0xF3, /* 243 */ BCODE_SEND_MESSAGE_TO_SUPER_X = 0xF4, /* 244 ## */ /* -------------------------------------- */ @@ -885,35 +885,19 @@ hcl_oop_cons_t hcl_getatsysdic ( hcl_oop_t key ); -hcl_oop_cons_t hcl_lookupsysdic ( - hcl_t* hcl, - const hcl_oocs_t* name -); - hcl_oop_cons_t hcl_putatdic ( hcl_t* hcl, - hcl_oop_set_t dic, + hcl_oop_dic_t dic, hcl_oop_t key, hcl_oop_t value ); hcl_oop_cons_t hcl_getatdic ( hcl_t* hcl, - hcl_oop_set_t dic, + hcl_oop_dic_t dic, hcl_oop_t key ); -hcl_oop_cons_t hcl_lookupdic ( - hcl_t* hcl, - hcl_oop_set_t dic, - const hcl_oocs_t* name -); - -hcl_oop_set_t hcl_makedic ( - hcl_t* hcl, - hcl_oow_t size -); - /* ========================================================================= */ /* proc.c */ /* ========================================================================= */ @@ -1169,7 +1153,7 @@ int hcl_outfmtobj ( /* debug.c */ /* ========================================================================= */ void dump_symbol_table (hcl_t* hcl); -void dump_dictionary (hcl_t* hcl, hcl_oop_set_t dic, const char* title); +void dump_dictionary (hcl_t* hcl, hcl_oop_dic_t dic, const char* title); #if defined(__cplusplus) } diff --git a/lib/hcl.h b/lib/hcl.h index da471fe..9eeff2b 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -493,7 +493,7 @@ struct hcl_trailer_t #define HCL_SET_NAMED_INSTVARS 2 typedef struct hcl_set_t hcl_set_t; -typedef struct hcl_set_t* hcl_oop_set_t; +typedef struct hcl_set_t* hcl_oop_dic_t; struct hcl_set_t { HCL_OBJ_HEADER; @@ -526,7 +526,7 @@ struct hcl_class_t /* [0] - instance methods, MethodDictionary * [1] - class methods, MethodDictionary */ - hcl_oop_set_t mthdic[2]; + hcl_oop_dic_t mthdic[2]; /* indexed part afterwards */ hcl_oop_t slot[1]; /* class instance variables and class variables. */ @@ -954,8 +954,8 @@ struct hcl_t hcl_oop_t _large_negative_integer; /* LargeNegativeInteger */ /* == NEVER CHANGE THE ORDER OF FIELDS ABOVE == */ - hcl_oop_set_t symtab; /* system-wide symbol table. */ - hcl_oop_set_t sysdic; /* system dictionary. */ + hcl_oop_dic_t symtab; /* system-wide symbol table. */ + hcl_oop_dic_t sysdic; /* system dictionary. */ hcl_oop_process_scheduler_t processor; /* instance of ProcessScheduler */ hcl_oop_process_t nil_process; /* instance of Process */ @@ -1309,7 +1309,7 @@ enum HCL_BRAND_SYMBOL_ARRAY, /* special. internal use only */ HCL_BRAND_SYMBOL, HCL_BRAND_STRING, - HCL_BRAND_SET, + HCL_BRAND_DIC, HCL_BRAND_CFRAME,/* compiler frame */ HCL_BRAND_PRIM, @@ -1343,7 +1343,7 @@ enum HCL_CONCODE_XLIST = 0, /* () - executable list */ HCL_CONCODE_ARRAY, /* #() */ HCL_CONCODE_BYTEARRAY, /* #[] */ - HCL_CONCODE_DICTIONARY, /* #{} */ + HCL_CONCODE_DIC, /* #{} */ HCL_CONCODE_QLIST /* '() - quoted list, data list */ }; @@ -1706,7 +1706,7 @@ HCL_EXPORT hcl_oop_t hcl_makestring ( hcl_oow_t len ); -HCL_EXPORT hcl_oop_t hcl_makeset ( +HCL_EXPORT hcl_oop_t hcl_makedic ( hcl_t* hcl, hcl_oow_t inisize /* initial bucket size */ ); diff --git a/lib/obj.c b/lib/obj.c index dd8b645..231013d 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -411,27 +411,7 @@ hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) return hcl_alloccharobj (hcl, HCL_BRAND_STRING, ptr, len); } -hcl_oop_t hcl_makeset (hcl_t* hcl, hcl_oow_t inisize) -{ - hcl_oop_set_t obj; - obj = (hcl_oop_set_t)hcl_allocoopobj (hcl, HCL_BRAND_SET, 2); - if (obj) - { - hcl_oop_oop_t bucket; - - obj->tally = HCL_SMOOI_TO_OOP(0); - - hcl_pushtmp (hcl, (hcl_oop_t*)&obj); - bucket = (hcl_oop_oop_t)hcl_makearray (hcl, inisize); - hcl_poptmp (hcl); - - if (!bucket) obj = HCL_NULL; - else obj->bucket = bucket; - } - - return (hcl_oop_t)obj; -} diff --git a/lib/print.c b/lib/print.c index 61d9fab..9bc33d8 100644 --- a/lib/print.c +++ b/lib/print.c @@ -30,16 +30,23 @@ #define PRINT_STACK_ALIGN 128 -#define PRINT_STACK_ARRAY_END 0 -#define PRINT_STACK_CONS 1 -#define PRINT_STACK_ARRAY 2 +enum +{ + PRINT_STACK_CONS, + PRINT_STACK_ARRAY, + PRINT_STACK_ARRAY_END, + PRINT_STACK_DIC, + PRINT_STACK_DIC_END +}; typedef struct print_stack_t print_stack_t; struct print_stack_t { int type; hcl_oop_t obj; + hcl_oop_t obj2; hcl_oow_t idx; + hcl_oow_t idx2; }; static HCL_INLINE int push (hcl_t* hcl, print_stack_t* info) @@ -262,7 +269,7 @@ next: "(", /*HCL_CONCODE_XLIST */ "#(", /*HCL_CONCODE_ARRAY */ "#[", /*HCL_CONCODE_BYTEARRAY */ - "#{", /*HCL_CONCODE_DICTIONARY */ + "#{", /*HCL_CONCODE_DIC */ "'(" /*HCL_CONCODE_QLIST */ }; @@ -271,7 +278,7 @@ next: ")", /*HCL_CONCODE_XLIST */ ")", /*HCL_CONCODE_ARRAY */ "]", /*HCL_CONCODE_BYTEARRAY */ - "}", /*HCL_CONCODE_DICTIONARY */ + "}", /*HCL_CONCODE_DIC */ ")" /*HCL_CONCODE_QLIST */ }; @@ -340,25 +347,11 @@ next: { hcl_oow_t arridx; - if (brand == HCL_BRAND_ARRAY) - { - if (outbfmt(hcl, mask, "#(") <= -1) return -1; - } - else - { - if (outbfmt(hcl, mask, "|") <= -1) return -1; - } + if (outbfmt(hcl, mask, "#(") <= -1) return -1; if (HCL_OBJ_GET_SIZE(obj) <= 0) { - if (brand == HCL_BRAND_ARRAY) - { - if (outbfmt(hcl, mask, ")") <= -1) return -1; - } - else - { - if (outbfmt(hcl, mask, "|") <= -1) return -1; - } + if (outbfmt(hcl, mask, ")") <= -1) return -1; break; } arridx = 0; @@ -417,6 +410,106 @@ next: break; } + case HCL_BRAND_DIC: + { + hcl_oow_t bucidx, bucsize, buctally; + hcl_oop_dic_t dic; + + if (outbfmt(hcl, mask, "#{") <= -1) return -1; + + dic = (hcl_oop_dic_t)obj; + HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally)); + if (HCL_OOP_TO_SMOOI(dic->tally) <= 0) + { + if (outbfmt(hcl, mask, "}") <= -1) return -1; + break; + } + bucidx = 0; + bucsize = HCL_OBJ_GET_SIZE(dic->bucket); + buctally = 0; + ps.type = PRINT_STACK_DIC; + ps.obj2 = (hcl_oop_t)dic; + + do + { + int x; + + if ((buctally & 1) == 0) + { + while (bucidx < bucsize) + { + /* skip an unoccupied slot in the bucket array */ + obj = dic->bucket->slot[bucidx]; + if (!HCL_IS_NIL(hcl,obj)) break; + bucidx++; + } + + if (bucidx >= bucsize) + { + /* done. scanned the entire bucket */ + if (outbfmt(hcl, mask, "}") <= -1) return -1; + break; + } + + ps.idx = bucidx; /* no increment yet */ + HCL_ASSERT (hcl, ps.idx < bucsize); + HCL_ASSERT (hcl, ps.type == PRINT_STACK_DIC); + + ps.obj = dic->bucket->slot[ps.idx]; + ps.idx2 = buctally + 1; + + x = push (hcl, &ps); + if (x <= -1) return -1; + + HCL_ASSERT (hcl, HCL_IS_CONS(hcl,obj)); + obj = HCL_CONS_CAR(obj); + } + else + { + /* Push what to print next on to the stack */ + ps.idx = bucidx + 1; + if (ps.idx >= bucsize) + { + ps.type = PRINT_STACK_DIC_END; + } + else + { + HCL_ASSERT (hcl, ps.type == PRINT_STACK_DIC); + ps.obj = dic->bucket->slot[ps.idx]; + } + ps.idx2 = buctally + 1; + + x = push (hcl, &ps); + if (x <= -1) return -1; + + HCL_ASSERT (hcl, HCL_IS_CONS(hcl,obj)); + obj = HCL_CONS_CDR(obj); + } + + if (buctally > 0) + { + if (outbfmt(hcl, mask, " ") <= -1) return -1; + } + + /* Jump to the 'next' label so that the object + * pointed to by 'obj' is printed. Once it + * ends, a jump back to the 'resume' label + * is made at the end of this function. */ + goto next; + + resume_dic: + HCL_ASSERT (hcl, ps.type == PRINT_STACK_DIC); + bucidx = ps.idx; + buctally = ps.idx2; + obj = ps.obj; + dic = (hcl_oop_dic_t)ps.obj2; + bucsize = HCL_OBJ_GET_SIZE(dic->bucket); + } + while (1); + + break; + } + case HCL_BRAND_SYMBOL_ARRAY: { hcl_oow_t i; @@ -433,10 +526,6 @@ next: break; } - case HCL_BRAND_SET: - word_index = WORD_SET; - goto print_word; - case HCL_BRAND_CFRAME: word_index = WORD_CFRAME; goto print_word; @@ -490,6 +579,13 @@ done: if (outbfmt(hcl, mask, ")") <= -1) return -1; break; + case PRINT_STACK_DIC: + goto resume_dic; + + case PRINT_STACK_DIC_END: + if (outbfmt(hcl, mask, "}") <= -1) return -1; + break; + default: HCL_DEBUG3 (hcl, "Internal error - unknown print stack type %d at %s:%d\n", (int)ps.type, __FILE__, __LINE__); hcl_seterrbfmt (hcl, HCL_EINTERN, "unknown print stack type %d", (int)ps.type); diff --git a/lib/read.c b/lib/read.c index 0165953..33f5134 100644 --- a/lib/read.c +++ b/lib/read.c @@ -1348,7 +1348,7 @@ done: return (hcl_oop_t)hcl_makearray(hcl, 0); case HCL_CONCODE_BYTEARRAY: return (hcl_oop_t)hcl_makebytearray(hcl, HCL_NULL, 0); - case HCL_CONCODE_DICTIONARY: + case HCL_CONCODE_DIC: return (hcl_oop_t)hcl_makedic(hcl, 100); /* TODO: default dictionary size for empty definition? */ } } @@ -1662,7 +1662,7 @@ static int read_object (hcl_t* hcl) goto start_list; case HCL_IOTOK_DPAREN: flagv = 0; - LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DICTIONARY); + LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DIC); goto start_list; case HCL_IOTOK_QPAREN: flagv = 0; @@ -1716,7 +1716,7 @@ static int read_object (hcl_t* hcl) { HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST */ { HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* ARRAY */ { HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY */ - { HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DICTIONARY */ + { HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC */ { HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN } /* QLIST */ };