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

changed the compiler to support module loading in class definition

Browse Source
This commit is contained in:
hyunghwan.chung 2016-11-29 05:25:08 +00:00
parent 394a21b8d6
commit 7b5fc708f7
14 changed files with 616 additions and 419 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
stix/kernel/Stdio.st
View File

@ -1,6 +1,4 @@
## #class(#byte) Stdio(Object) from 'stdio'. #class(#byte) Stdio(Object) from 'stdio'
#class(#byte) Stdio(Object)
{ {
#method(#class) _newInstSize #method(#class) _newInstSize
{ {

105
stix/lib/comp.c
View File

@ -90,6 +90,7 @@ static struct voca_t
{ 9, { 'e','x','c','e','p','t','i','o','n' } }, { 9, { 'e','x','c','e','p','t','i','o','n' } },
{ 7, { '#','e','x','t','e','n','d' } }, { 7, { '#','e','x','t','e','n','d' } },
{ 5, { 'f','a','l','s','e' } }, { 5, { 'f','a','l','s','e' } },
{ 4, { 'f','r','o','m' } },
{ 9, { '#','h','a','l','f','w','o','r','d' } }, { 9, { '#','h','a','l','f','w','o','r','d' } },
{ 8, { '#','i','n','c','l','u','d','e' } }, { 8, { '#','i','n','c','l','u','d','e' } },
{ 7, { '#','l','i','w','o','r','d' } }, { 7, { '#','l','i','w','o','r','d' } },
@ -126,6 +127,7 @@ enum voca_id_t
VOCA_EXCEPTION, VOCA_EXCEPTION,
VOCA_EXTEND, VOCA_EXTEND,
VOCA_FALSE, VOCA_FALSE,
VOCA_FROM,
VOCA_HALFWORD, VOCA_HALFWORD,
VOCA_INCLUDE, VOCA_INCLUDE,
VOCA_LIWORD, VOCA_LIWORD,
@ -254,9 +256,10 @@ static STIX_INLINE int is_closing_char (stix_ooci_t c)
} }
} }
static STIX_INLINE int is_word (const stix_oocs_t* ucs, voca_id_t id) static STIX_INLINE int is_word (const stix_oocs_t* oocs, voca_id_t id)
{ {
return ucs->len == vocas[id].len && stix_equalchars(ucs->ptr, vocas[id].str, vocas[id].len); return oocs->len == vocas[id].len &&
stix_equaloochars(oocs->ptr, vocas[id].str, vocas[id].len);
} }
static int is_reserved_word (const stix_oocs_t* ucs) static int is_reserved_word (const stix_oocs_t* ucs)
@ -547,7 +550,7 @@ static stix_oop_t string_to_num (stix_t* stix, stix_oocs_t* str, int radixed)
static STIX_INLINE int does_token_name_match (stix_t* stix, voca_id_t id) static STIX_INLINE int does_token_name_match (stix_t* stix, voca_id_t id)
{ {
return TOKEN_NAME_LEN(stix) == vocas[id].len && return TOKEN_NAME_LEN(stix) == vocas[id].len &&
stix_equalchars(TOKEN_NAME_PTR(stix), vocas[id].str, vocas[id].len); stix_equaloochars(TOKEN_NAME_PTR(stix), vocas[id].str, vocas[id].len);
} }
static STIX_INLINE int is_token_symbol (stix_t* stix, voca_id_t id) static STIX_INLINE int is_token_symbol (stix_t* stix, voca_id_t id)
@ -1929,7 +1932,7 @@ static int add_string_literal (stix_t* stix, const stix_oocs_t* str, stix_oow_t*
if (STIX_CLASSOF(stix, lit) == stix->_string && if (STIX_CLASSOF(stix, lit) == stix->_string &&
STIX_OBJ_GET_SIZE(lit) == str->len && STIX_OBJ_GET_SIZE(lit) == str->len &&
stix_equalchars(((stix_oop_char_t)lit)->slot, str->ptr, str->len)) stix_equaloochars(((stix_oop_char_t)lit)->slot, str->ptr, str->len))
{ {
*index = i; *index = i;
return 0; return 0;
@ -2704,7 +2707,7 @@ static int compile_method_primitive (stix_t* stix)
* method-primitive := "<" "primitive:" integer ">" | * method-primitive := "<" "primitive:" integer ">" |
* "<" "exception" ">" * "<" "exception" ">"
*/ */
stix_ooi_t prim_no; stix_ooi_t pfnum;
const stix_ooch_t* ptr, * end; const stix_ooch_t* ptr, * end;
if (!is_token_binary_selector(stix, VOCA_LT)) if (!is_token_binary_selector(stix, VOCA_LT))
@ -2723,20 +2726,20 @@ static int compile_method_primitive (stix_t* stix)
/*TODO: more checks the validity of the primitive number. support number with radix and so on support more extensive syntax. support primitive name, not number*/ /*TODO: more checks the validity of the primitive number. support number with radix and so on support more extensive syntax. support primitive name, not number*/
ptr = TOKEN_NAME_PTR(stix); ptr = TOKEN_NAME_PTR(stix);
end = ptr + TOKEN_NAME_LEN(stix); end = ptr + TOKEN_NAME_LEN(stix);
prim_no = 0; pfnum = 0;
while (ptr < end && is_digitchar(*ptr)) while (ptr < end && is_digitchar(*ptr))
{ {
prim_no = prim_no * 10 + (*ptr - '0'); pfnum = pfnum * 10 + (*ptr - '0');
if (!STIX_OOI_IN_METHOD_PREAMBLE_INDEX_RANGE(prim_no)) if (!STIX_OOI_IN_METHOD_PREAMBLE_INDEX_RANGE(pfnum))
{ {
set_syntax_error (stix, STIX_SYNERR_PRIMNO, TOKEN_LOC(stix), TOKEN_NAME(stix)); set_syntax_error (stix, STIX_SYNERR_PFNUM, TOKEN_LOC(stix), TOKEN_NAME(stix));
return -1; return -1;
} }
ptr++; ptr++;
} }
stix->c->mth.prim_no = prim_no; stix->c->mth.pfnum = pfnum;
break; break;
case STIX_IOTOK_SYMLIT: case STIX_IOTOK_SYMLIT:
@ -2747,11 +2750,12 @@ static int compile_method_primitive (stix_t* stix)
tptr = TOKEN_NAME_PTR(stix) + 1; tptr = TOKEN_NAME_PTR(stix) + 1;
tlen = TOKEN_NAME_LEN(stix) - 1; tlen = TOKEN_NAME_LEN(stix) - 1;
prim_no = stix_getprimno (stix, tptr, tlen); /* attempt get a primitive function number by name */
if (prim_no <= -1) pfnum = stix_getpfnum (stix, tptr, tlen);
if (pfnum <= -1)
{ {
const stix_ooch_t* us; const stix_ooch_t* us;
/* the primitive is not found */ /* the primitive function is not found */
us = stix_findoochar (tptr, tlen, '_'); us = stix_findoochar (tptr, tlen, '_');
if (us > tptr && us < tptr + tlen - 1) if (us > tptr && us < tptr + tlen - 1)
{ {
@ -2761,23 +2765,24 @@ static int compile_method_primitive (stix_t* stix)
if (add_symbol_literal(stix, TOKEN_NAME(stix), 1, &lit_idx) >= 0 && if (add_symbol_literal(stix, TOKEN_NAME(stix), 1, &lit_idx) >= 0 &&
STIX_OOI_IN_METHOD_PREAMBLE_INDEX_RANGE(lit_idx)) STIX_OOI_IN_METHOD_PREAMBLE_INDEX_RANGE(lit_idx))
{ {
stix->c->mth.prim_type = 2; /* named primitive */ stix->c->mth.pftype = 2; /* named primitive */
stix->c->mth.prim_no = lit_idx; stix->c->mth.pfnum = lit_idx;
break; break;
} }
} }
set_syntax_error (stix, STIX_SYNERR_PRIMNO, TOKEN_LOC(stix), TOKEN_NAME(stix)); /* wrong primitive number */
set_syntax_error (stix, STIX_SYNERR_PFID, TOKEN_LOC(stix), TOKEN_NAME(stix));
return -1; return -1;
} }
else if (!STIX_OOI_IN_METHOD_PREAMBLE_INDEX_RANGE(prim_no)) else if (!STIX_OOI_IN_METHOD_PREAMBLE_INDEX_RANGE(pfnum))
{ {
set_syntax_error (stix, STIX_SYNERR_PRIMNO, TOKEN_LOC(stix), TOKEN_NAME(stix)); set_syntax_error (stix, STIX_SYNERR_PFID, TOKEN_LOC(stix), TOKEN_NAME(stix));
return -1; return -1;
} }
stix->c->mth.prim_type = 1; stix->c->mth.pftype = 1;
stix->c->mth.prim_no = prim_no; stix->c->mth.pfnum = pfnum;
break; break;
} }
@ -2791,11 +2796,11 @@ static int compile_method_primitive (stix_t* stix)
{ {
/* TODO: exception handler is supposed to be used by BlockContext on:do:. /* TODO: exception handler is supposed to be used by BlockContext on:do:.
* it needs to check the number of arguments at least */ * it needs to check the number of arguments at least */
stix->c->mth.prim_type = 3; stix->c->mth.pftype = 3;
} }
else if (is_token_word(stix, VOCA_ENSURE)) else if (is_token_word(stix, VOCA_ENSURE))
{ {
stix->c->mth.prim_type = 4; stix->c->mth.pftype = 4;
} }
else else
{ {
@ -2835,7 +2840,8 @@ static int get_variable_info (stix_t* stix, const stix_oocs_t* name, const stix_
dot = stix_findoochar (name->ptr, name->len, '.'); dot = stix_findoochar (name->ptr, name->len, '.');
STIX_ASSERT (dot != STIX_NULL); STIX_ASSERT (dot != STIX_NULL);
if (dot - (const stix_ooch_t*)name->ptr == 4 && stix_equalchars(name->ptr, vocas[VOCA_SELF].str, 4)) if (dot - (const stix_ooch_t*)name->ptr == 4 &&
stix_equaloochars(name->ptr, vocas[VOCA_SELF].str, 4))
{ {
/* the dotted name begins with self. */ /* the dotted name begins with self. */
dot = stix_findoochar (dot + 1, name->len - 5, '.'); dot = stix_findoochar (dot + 1, name->len - 5, '.');
@ -4229,7 +4235,7 @@ static int add_compiled_method (stix_t* stix)
preamble_code = STIX_METHOD_PREAMBLE_NONE; preamble_code = STIX_METHOD_PREAMBLE_NONE;
preamble_index = 0; preamble_index = 0;
if (stix->c->mth.prim_type <= 0) if (stix->c->mth.pftype <= 0)
{ {
/* no primitive is set */ /* no primitive is set */
if (stix->c->mth.code.len <= 0) if (stix->c->mth.code.len <= 0)
@ -4330,24 +4336,24 @@ static int add_compiled_method (stix_t* stix)
} }
} }
} }
else if (stix->c->mth.prim_type == 1) else if (stix->c->mth.pftype == 1)
{ {
preamble_code = STIX_METHOD_PREAMBLE_PRIMITIVE; preamble_code = STIX_METHOD_PREAMBLE_PRIMITIVE;
preamble_index = stix->c->mth.prim_no; preamble_index = stix->c->mth.pfnum;
} }
else if (stix->c->mth.prim_type == 2) else if (stix->c->mth.pftype == 2)
{ {
preamble_code = STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE; preamble_code = STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE;
preamble_index = stix->c->mth.prim_no; preamble_index = stix->c->mth.pfnum;
} }
else if (stix->c->mth.prim_type == 3) else if (stix->c->mth.pftype == 3)
{ {
preamble_code = STIX_METHOD_PREAMBLE_EXCEPTION; preamble_code = STIX_METHOD_PREAMBLE_EXCEPTION;
preamble_index = 0; preamble_index = 0;
} }
else else
{ {
STIX_ASSERT (stix->c->mth.prim_type == 4); STIX_ASSERT (stix->c->mth.pftype == 4);
preamble_code = STIX_METHOD_PREAMBLE_ENSURE; preamble_code = STIX_METHOD_PREAMBLE_ENSURE;
preamble_index = 0; preamble_index = 0;
} }
@ -4404,8 +4410,8 @@ static int compile_method_definition (stix_t* stix)
stix->c->mth.literal_count = 0; stix->c->mth.literal_count = 0;
stix->c->mth.balit_count = 0; stix->c->mth.balit_count = 0;
stix->c->mth.arlit_count = 0; stix->c->mth.arlit_count = 0;
stix->c->mth.prim_type = 0; stix->c->mth.pftype = 0;
stix->c->mth.prim_no = 0; stix->c->mth.pfnum = 0;
stix->c->mth.blk_depth = 0; stix->c->mth.blk_depth = 0;
stix->c->mth.code.len = 0; stix->c->mth.code.len = 0;
@ -4562,9 +4568,11 @@ static int make_defined_class (stix_t* stix)
static int __compile_class_definition (stix_t* stix, int extend) static int __compile_class_definition (stix_t* stix, int extend)
{ {
/* /*
* class-definition := #class class-modifier? "{" class-body "}" * class-definition := #class class-modifier? class-name (class-body | class-module-import)
*
* class-modifier := "(" (#byte | #character | #word | #pointer)? ")" * class-modifier := "(" (#byte | #character | #word | #pointer)? ")"
* class-body := variable-definition* method-definition* * class-body := "{" variable-definition* method-definition* "}"
* class-module-import := from "module-name-string"
* *
* variable-definition := (#dcl | #declare) variable-modifier? variable-list "." * variable-definition := (#dcl | #declare) variable-modifier? variable-list "."
* variable-modifier := "(" (#class | #classinst)? ")" * variable-modifier := "(" (#class | #classinst)? ")"
@ -4573,8 +4581,12 @@ static int __compile_class_definition (stix_t* stix, int extend)
* method-definition := (#mth | #method) method-modifier? method-actual-definition * method-definition := (#mth | #method) method-modifier? method-actual-definition
* method-modifier := "(" (#class | #instance)? ")" * method-modifier := "(" (#class | #instance)? ")"
* method-actual-definition := method-name "{" method-tempraries? method-primitive? method-statements* "}" * method-actual-definition := method-name "{" method-tempraries? method-primitive? method-statements* "}"
*
* NOTE: when extending a class, class-module-import and variable-definition are not allowed.
*/ */
stix_oop_association_t ass; stix_oop_association_t ass;
stix_ooch_t modname[STIX_MOD_NAME_LEN_MAX + 1];
stix_oow_t modnamelen = 0;
if (!extend && TOKEN_TYPE(stix) == STIX_IOTOK_LPAREN) if (!extend && TOKEN_TYPE(stix) == STIX_IOTOK_LPAREN)
{ {
@ -4793,6 +4805,26 @@ static int __compile_class_definition (stix_t* stix, int extend)
} }
} }
if (is_token_word (stix, VOCA_FROM))
{
GET_TOKEN (stix);
if (TOKEN_TYPE(stix) != STIX_IOTOK_STRLIT)
{
set_syntax_error (stix, STIX_SYNERR_STRING, TOKEN_LOC(stix), TOKEN_NAME(stix));
return -1;
}
if (TOKEN_NAME_LEN(stix) < 1 || TOKEN_NAME_LEN(stix) > STIX_MOD_NAME_LEN_MAX)
{
set_syntax_error (stix, STIX_SYNERR_MODNAME, TOKEN_LOC(stix), TOKEN_NAME(stix));
return -1;
}
modnamelen = TOKEN_NAME_LEN(stix);
stix_copyoochars (modname, TOKEN_NAME_PTR(stix), modnamelen);
GET_TOKEN (stix);
}
} }
if (TOKEN_TYPE(stix) != STIX_IOTOK_LBRACE) if (TOKEN_TYPE(stix) != STIX_IOTOK_LBRACE)
@ -4895,6 +4927,11 @@ static int __compile_class_definition (stix_t* stix, int extend)
} }
if (make_defined_class(stix) <= -1) return -1; if (make_defined_class(stix) <= -1) return -1;
if (modnamelen > 0)
{
if (stix_importmod (stix, (stix_oop_t)stix->c->cls.self_oop, modname, modnamelen) <= -1) return -1;
}
} }
while (is_token_symbol(stix, VOCA_MTH) || is_token_symbol(stix, VOCA_METHOD)) while (is_token_symbol(stix, VOCA_MTH) || is_token_symbol(stix, VOCA_METHOD))

4
stix/lib/dic.c
View File

@ -109,7 +109,7 @@ static stix_oop_association_t find_or_upsert (stix_t* stix, stix_oop_set_t dic,
STIX_ASSERT (STIX_CLASSOF(stix,ass->key) == stix->_symbol); STIX_ASSERT (STIX_CLASSOF(stix,ass->key) == stix->_symbol);
if (STIX_OBJ_GET_SIZE(key) == STIX_OBJ_GET_SIZE(ass->key) && if (STIX_OBJ_GET_SIZE(key) == STIX_OBJ_GET_SIZE(ass->key) &&
stix_equalchars (key->slot, ((stix_oop_char_t)ass->key)->slot, STIX_OBJ_GET_SIZE(key))) stix_equaloochars (key->slot, ((stix_oop_char_t)ass->key)->slot, STIX_OBJ_GET_SIZE(key)))
{ {
/* the value of STIX_NULL indicates no insertion or update. */ /* the value of STIX_NULL indicates no insertion or update. */
if (value) ass->value = value; /* update */ if (value) ass->value = value; /* update */
@ -213,7 +213,7 @@ static stix_oop_association_t lookup (stix_t* stix, stix_oop_set_t dic, const st
STIX_ASSERT (STIX_CLASSOF(stix,ass->key) == stix->_symbol); STIX_ASSERT (STIX_CLASSOF(stix,ass->key) == stix->_symbol);
if (name->len == STIX_OBJ_GET_SIZE(ass->key) && if (name->len == STIX_OBJ_GET_SIZE(ass->key) &&
stix_equalchars(name->ptr, ((stix_oop_char_t)ass->key)->slot, name->len)) stix_equaloochars(name->ptr, ((stix_oop_char_t)ass->key)->slot, name->len))
{ {
return ass; return ass;
} }

433
stix/lib/exec.c
View File

@ -1143,7 +1143,7 @@ TODO: overcome this problem
} }
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */
static int prim_dump (stix_t* stix, stix_ooi_t nargs) static int pf_dump (stix_t* stix, stix_ooi_t nargs)
{ {
stix_ooi_t i; stix_ooi_t i;
@ -1198,7 +1198,7 @@ start_over:
} }
} }
static int prim_log (stix_t* stix, stix_ooi_t nargs) static int pf_log (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t msg, level; stix_oop_t msg, level;
stix_oow_t mask; stix_oow_t mask;
@ -1264,7 +1264,7 @@ static int prim_log (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_identical (stix_t* stix, stix_ooi_t nargs) static int pf_identical (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, b; stix_oop_t rcv, arg, b;
@ -1279,7 +1279,7 @@ static int prim_identical (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_not_identical (stix_t* stix, stix_ooi_t nargs) static int pf_not_identical (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, b; stix_oop_t rcv, arg, b;
@ -1294,7 +1294,7 @@ static int prim_not_identical (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_class (stix_t* stix, stix_ooi_t nargs) static int pf_class (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, c; stix_oop_t rcv, c;
@ -1307,7 +1307,7 @@ static int prim_class (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */ return 1; /* success */
} }
static int prim_basic_new (stix_t* stix, stix_ooi_t nargs) static int pf_basic_new (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, obj; stix_oop_t rcv, obj;
@ -1327,7 +1327,7 @@ static int prim_basic_new (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */ return 1; /* success */
} }
static int prim_basic_new_with_size (stix_t* stix, stix_ooi_t nargs) static int pf_basic_new_with_size (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, szoop, obj; stix_oop_t rcv, szoop, obj;
stix_oow_t size; stix_oow_t size;
@ -1362,27 +1362,27 @@ static int prim_basic_new_with_size (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */ return 1; /* success */
} }
static int prim_ngc_new (stix_t* stix, stix_ooi_t nargs) static int pf_ngc_new (stix_t* stix, stix_ooi_t nargs)
{ {
int n; int n;
n = prim_basic_new (stix, nargs); n = pf_basic_new (stix, nargs);
if (n <= 0) return n; if (n <= 0) return n;
return 1; return 1;
} }
static int prim_ngc_new_with_size (stix_t* stix, stix_ooi_t nargs) static int pf_ngc_new_with_size (stix_t* stix, stix_ooi_t nargs)
{ {
int n; int n;
n = prim_basic_new_with_size (stix, nargs); n = pf_basic_new_with_size (stix, nargs);
if (n <= 0) return n; if (n <= 0) return n;
return 1; return 1;
} }
static int prim_ngc_dispose (stix_t* stix, stix_ooi_t nargs) static int pf_ngc_dispose (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
@ -1395,7 +1395,7 @@ static int prim_ngc_dispose (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */ return 1; /* success */
} }
static int prim_shallow_copy (stix_t* stix, stix_ooi_t nargs) static int pf_shallow_copy (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, obj; stix_oop_t rcv, obj;
@ -1411,7 +1411,7 @@ static int prim_shallow_copy (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */ return 1; /* success */
} }
static int prim_basic_size (stix_t* stix, stix_ooi_t nargs) static int pf_basic_size (stix_t* stix, stix_ooi_t nargs)
{ {
/* return the number of indexable fields */ /* return the number of indexable fields */
@ -1435,7 +1435,7 @@ static int prim_basic_size (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_basic_at (stix_t* stix, stix_ooi_t nargs) static int pf_basic_at (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, pos, v; stix_oop_t rcv, pos, v;
stix_oow_t idx; stix_oow_t idx;
@ -1494,7 +1494,7 @@ static int prim_basic_at (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_basic_at_put (stix_t* stix, stix_ooi_t nargs) static int pf_basic_at_put (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, pos, val; stix_oop_t rcv, pos, val;
stix_oow_t idx; stix_oow_t idx;
@ -1585,7 +1585,7 @@ static int prim_basic_at_put (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_context_goto (stix_t* stix, stix_ooi_t nargs) static int pf_context_goto (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
stix_oop_t pc; stix_oop_t pc;
@ -1728,7 +1728,7 @@ static int __block_value (stix_t* stix, stix_oop_context_t rcv_blkctx, stix_ooi_
return 1; return 1;
} }
static int prim_block_value (stix_t* stix, stix_ooi_t nargs) static int pf_block_value (stix_t* stix, stix_ooi_t nargs)
{ {
int x; int x;
stix_oop_context_t rcv_blkctx, blkctx; stix_oop_context_t rcv_blkctx, blkctx;
@ -1749,7 +1749,7 @@ static int prim_block_value (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_block_new_process (stix_t* stix, stix_ooi_t nargs) static int pf_block_new_process (stix_t* stix, stix_ooi_t nargs)
{ {
/* create a new process from a block context. /* create a new process from a block context.
* the receiver must be be a block. * the receiver must be be a block.
@ -1813,7 +1813,7 @@ static int prim_block_new_process (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_process_resume (stix_t* stix, stix_ooi_t nargs) static int pf_process_resume (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
STIX_ASSERT (nargs == 0); STIX_ASSERT (nargs == 0);
@ -1827,7 +1827,7 @@ static int prim_process_resume (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_process_terminate (stix_t* stix, stix_ooi_t nargs) static int pf_process_terminate (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
STIX_ASSERT (nargs == 0); STIX_ASSERT (nargs == 0);
@ -1843,7 +1843,7 @@ static int prim_process_terminate (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_process_yield (stix_t* stix, stix_ooi_t nargs) static int pf_process_yield (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
STIX_ASSERT (nargs == 0); STIX_ASSERT (nargs == 0);
@ -1857,7 +1857,7 @@ static int prim_process_yield (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_process_suspend (stix_t* stix, stix_ooi_t nargs) static int pf_process_suspend (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
STIX_ASSERT (nargs == 0); STIX_ASSERT (nargs == 0);
@ -1871,7 +1871,7 @@ static int prim_process_suspend (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_semaphore_signal (stix_t* stix, stix_ooi_t nargs) static int pf_semaphore_signal (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
STIX_ASSERT (nargs == 0); STIX_ASSERT (nargs == 0);
@ -1885,7 +1885,7 @@ static int prim_semaphore_signal (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_semaphore_wait (stix_t* stix, stix_ooi_t nargs) static int pf_semaphore_wait (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv; stix_oop_t rcv;
STIX_ASSERT (nargs == 0); STIX_ASSERT (nargs == 0);
@ -1899,7 +1899,7 @@ static int prim_semaphore_wait (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_processor_schedule (stix_t* stix, stix_ooi_t nargs) static int pf_processor_schedule (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg; stix_oop_t rcv, arg;
@ -1917,7 +1917,7 @@ static int prim_processor_schedule (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_processor_add_timed_semaphore (stix_t* stix, stix_ooi_t nargs) static int pf_processor_add_timed_semaphore (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, sec, nsec; stix_oop_t rcv, sec, nsec;
stix_oop_semaphore_t sem; stix_oop_semaphore_t sem;
@ -1978,7 +1978,7 @@ static int prim_processor_add_timed_semaphore (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_processor_remove_semaphore (stix_t* stix, stix_ooi_t nargs) static int pf_processor_remove_semaphore (stix_t* stix, stix_ooi_t nargs)
{ {
/* remove a semaphore from processor's signal scheduling */ /* remove a semaphore from processor's signal scheduling */
@ -2008,7 +2008,7 @@ static int prim_processor_remove_semaphore (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_processor_return_to (stix_t* stix, stix_ooi_t nargs) static int pf_processor_return_to (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, ret, ctx; stix_oop_t rcv, ret, ctx;
@ -2038,7 +2038,7 @@ static int prim_processor_return_to (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_add (stix_t* stix, stix_ooi_t nargs) static int pf_integer_add (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2054,7 +2054,7 @@ static int prim_integer_add (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_sub (stix_t* stix, stix_ooi_t nargs) static int pf_integer_sub (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2070,7 +2070,7 @@ static int prim_integer_sub (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_mul (stix_t* stix, stix_ooi_t nargs) static int pf_integer_mul (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2086,7 +2086,7 @@ static int prim_integer_mul (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_quo (stix_t* stix, stix_ooi_t nargs) static int pf_integer_quo (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, quo; stix_oop_t rcv, arg, quo;
@ -2103,7 +2103,7 @@ static int prim_integer_quo (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_rem (stix_t* stix, stix_ooi_t nargs) static int pf_integer_rem (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, quo, rem; stix_oop_t rcv, arg, quo, rem;
@ -2120,7 +2120,7 @@ static int prim_integer_rem (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_quo2 (stix_t* stix, stix_ooi_t nargs) static int pf_integer_quo2 (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, quo; stix_oop_t rcv, arg, quo;
@ -2137,7 +2137,7 @@ static int prim_integer_quo2 (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_rem2 (stix_t* stix, stix_ooi_t nargs) static int pf_integer_rem2 (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, quo, rem; stix_oop_t rcv, arg, quo, rem;
@ -2154,7 +2154,7 @@ static int prim_integer_rem2 (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_negated (stix_t* stix, stix_ooi_t nargs) static int pf_integer_negated (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, res; stix_oop_t rcv, res;
@ -2169,7 +2169,7 @@ static int prim_integer_negated (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_bitat (stix_t* stix, stix_ooi_t nargs) static int pf_integer_bitat (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2185,7 +2185,7 @@ static int prim_integer_bitat (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_bitand (stix_t* stix, stix_ooi_t nargs) static int pf_integer_bitand (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2201,7 +2201,7 @@ static int prim_integer_bitand (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_bitor (stix_t* stix, stix_ooi_t nargs) static int pf_integer_bitor (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2217,7 +2217,7 @@ static int prim_integer_bitor (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_bitxor (stix_t* stix, stix_ooi_t nargs) static int pf_integer_bitxor (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2233,7 +2233,7 @@ static int prim_integer_bitxor (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_bitinv (stix_t* stix, stix_ooi_t nargs) static int pf_integer_bitinv (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, res; stix_oop_t rcv, res;
@ -2248,7 +2248,7 @@ static int prim_integer_bitinv (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_bitshift (stix_t* stix, stix_ooi_t nargs) static int pf_integer_bitshift (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2264,7 +2264,7 @@ static int prim_integer_bitshift (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_eq (stix_t* stix, stix_ooi_t nargs) static int pf_integer_eq (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2280,7 +2280,7 @@ static int prim_integer_eq (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_ne (stix_t* stix, stix_ooi_t nargs) static int pf_integer_ne (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2296,7 +2296,7 @@ static int prim_integer_ne (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_lt (stix_t* stix, stix_ooi_t nargs) static int pf_integer_lt (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2312,7 +2312,7 @@ static int prim_integer_lt (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_gt (stix_t* stix, stix_ooi_t nargs) static int pf_integer_gt (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2328,7 +2328,7 @@ static int prim_integer_gt (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_le (stix_t* stix, stix_ooi_t nargs) static int pf_integer_le (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2344,7 +2344,7 @@ static int prim_integer_le (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_ge (stix_t* stix, stix_ooi_t nargs) static int pf_integer_ge (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, res; stix_oop_t rcv, arg, res;
@ -2360,7 +2360,7 @@ static int prim_integer_ge (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_integer_inttostr (stix_t* stix, stix_ooi_t nargs) static int pf_integer_inttostr (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg, str; stix_oop_t rcv, arg, str;
stix_ooi_t radix; stix_ooi_t radix;
@ -2381,7 +2381,7 @@ static int prim_integer_inttostr (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_ffi_open (stix_t* stix, stix_ooi_t nargs) static int pf_ffi_open (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg; stix_oop_t rcv, arg;
void* handle; void* handle;
@ -2419,7 +2419,7 @@ static int prim_ffi_open (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_ffi_close (stix_t* stix, stix_ooi_t nargs) static int pf_ffi_close (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, arg; stix_oop_t rcv, arg;
void* handle; void* handle;
@ -2443,7 +2443,7 @@ static int prim_ffi_close (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_ffi_call (stix_t* stix, stix_ooi_t nargs) static int pf_ffi_call (stix_t* stix, stix_ooi_t nargs)
{ {
#if defined(USE_DYNCALL) #if defined(USE_DYNCALL)
stix_oop_t rcv, fun, sig, args; stix_oop_t rcv, fun, sig, args;
@ -2623,7 +2623,7 @@ STIX_DEBUG2 (stix, "CALL ERROR %d %d\n", dcGetError (dc), DC_ERROR_UNSUPPORTED_M
#endif #endif
} }
static int prim_ffi_getsym (stix_t* stix, stix_ooi_t nargs) static int pf_ffi_getsym (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_t rcv, hnd, fun; stix_oop_t rcv, hnd, fun;
void* sym; void* sym;
@ -2664,88 +2664,88 @@ STIX_DEBUG0 (stix, "wrong function name...\n");
} }
#define MAX_NARGS STIX_TYPE_MAX(stix_ooi_t) #define MAX_NARGS STIX_TYPE_MAX(stix_ooi_t)
struct prim_t struct pf_t
{ {
stix_ooi_t min_nargs; /* expected number of arguments */ stix_ooi_t min_nargs; /* expected number of arguments */
stix_ooi_t max_nargs; /* expected number of arguments */ stix_ooi_t max_nargs; /* expected number of arguments */
stix_prim_impl_t handler; stix_pfimpl_t handler;
const char* name; /* the name is supposed to be 7-bit ascii only */ const char* name; /* the name is supposed to be 7-bit ascii only */
}; };
typedef struct prim_t prim_t; typedef struct pf_t pf_t;
static prim_t primitives[] = static pf_t pftab[] =
{ {
{ 0, MAX_NARGS, prim_dump, "_dump" }, { 0, MAX_NARGS, pf_dump, "_dump" },
{ 2, MAX_NARGS, prim_log, "_log" }, { 2, MAX_NARGS, pf_log, "_log" },
{ 1, 1, prim_identical, "_identical" }, { 1, 1, pf_identical, "_identical" },
{ 1, 1, prim_not_identical, "_not_identical" }, { 1, 1, pf_not_identical, "_not_identical" },
{ 0, 0, prim_class, "_class" }, { 0, 0, pf_class, "_class" },
{ 0, 0, prim_basic_new, "_basic_new" }, { 0, 0, pf_basic_new, "_basic_new" },
{ 1, 1, prim_basic_new_with_size, "_basic_new_with_size" }, { 1, 1, pf_basic_new_with_size, "_basic_new_with_size" },
{ 0, 0, prim_ngc_new, "_ngc_new" }, { 0, 0, pf_ngc_new, "_ngc_new" },
{ 1, 1, prim_ngc_new_with_size, "_ngc_new_with_size" }, { 1, 1, pf_ngc_new_with_size, "_ngc_new_with_size" },
{ 0, 0, prim_ngc_dispose, "_ngc_dispose" }, { 0, 0, pf_ngc_dispose, "_ngc_dispose" },
{ 0, 0, prim_shallow_copy, "_shallow_copy" }, { 0, 0, pf_shallow_copy, "_shallow_copy" },
{ 0, 0, prim_basic_size, "_basic_size" }, { 0, 0, pf_basic_size, "_basic_size" },
{ 1, 1, prim_basic_at, "_basic_at" }, { 1, 1, pf_basic_at, "_basic_at" },
{ 2, 2, prim_basic_at_put, "_basic_at_put" }, { 2, 2, pf_basic_at_put, "_basic_at_put" },
{ 1, 1, prim_context_goto, "_context_goto" }, { 1, 1, pf_context_goto, "_context_goto" },
{ 0, MAX_NARGS, prim_block_value, "_block_value" }, { 0, MAX_NARGS, pf_block_value, "_block_value" },
{ 0, MAX_NARGS, prim_block_new_process, "_block_new_process" }, { 0, MAX_NARGS, pf_block_new_process, "_block_new_process" },
{ 0, 0, prim_process_resume, "_process_resume" }, { 0, 0, pf_process_resume, "_process_resume" },
{ 0, 0, prim_process_terminate, "_process_terminate" }, { 0, 0, pf_process_terminate, "_process_terminate" },
{ 0, 0, prim_process_yield, "_process_yield" }, { 0, 0, pf_process_yield, "_process_yield" },
{ 0, 0, prim_process_suspend, "_process_suspend" }, { 0, 0, pf_process_suspend, "_process_suspend" },
{ 0, 0, prim_semaphore_signal, "_semaphore_signal" }, { 0, 0, pf_semaphore_signal, "_semaphore_signal" },
{ 0, 0, prim_semaphore_wait, "_semaphore_wait" }, { 0, 0, pf_semaphore_wait, "_semaphore_wait" },
{ 1, 1, prim_processor_schedule, "_processor_schedule" }, { 1, 1, pf_processor_schedule, "_processor_schedule" },
{ 2, 3, prim_processor_add_timed_semaphore, "_processor_add_timed_semaphore" }, { 2, 3, pf_processor_add_timed_semaphore, "_processor_add_timed_semaphore" },
{ 1, 1, prim_processor_remove_semaphore, "_processor_remove_semaphore" }, { 1, 1, pf_processor_remove_semaphore, "_processor_remove_semaphore" },
{ 2, 2, prim_processor_return_to, "_processor_return_to" }, { 2, 2, pf_processor_return_to, "_processor_return_to" },
{ 1, 1, prim_integer_add, "_integer_add" }, { 1, 1, pf_integer_add, "_integer_add" },
{ 1, 1, prim_integer_sub, "_integer_sub" }, { 1, 1, pf_integer_sub, "_integer_sub" },
{ 1, 1, prim_integer_mul, "_integer_mul" }, { 1, 1, pf_integer_mul, "_integer_mul" },
{ 1, 1, prim_integer_quo, "_integer_quo" }, { 1, 1, pf_integer_quo, "_integer_quo" },
{ 1, 1, prim_integer_rem, "_integer_rem" }, { 1, 1, pf_integer_rem, "_integer_rem" },
{ 1, 1, prim_integer_quo2, "_integer_quo2" }, { 1, 1, pf_integer_quo2, "_integer_quo2" },
{ 1, 1, prim_integer_rem2, "_integer_rem2" }, { 1, 1, pf_integer_rem2, "_integer_rem2" },
{ 0, 0, prim_integer_negated, "_integer_negated" }, { 0, 0, pf_integer_negated, "_integer_negated" },
{ 1, 1, prim_integer_bitat, "_integer_bitat" }, { 1, 1, pf_integer_bitat, "_integer_bitat" },
{ 1, 1, prim_integer_bitand, "_integer_bitand" }, { 1, 1, pf_integer_bitand, "_integer_bitand" },
{ 1, 1, prim_integer_bitor, "_integer_bitor" }, { 1, 1, pf_integer_bitor, "_integer_bitor" },
{ 1, 1, prim_integer_bitxor, "_integer_bitxor" }, { 1, 1, pf_integer_bitxor, "_integer_bitxor" },
{ 0, 0, prim_integer_bitinv, "_integer_bitinv" }, { 0, 0, pf_integer_bitinv, "_integer_bitinv" },
{ 1, 1, prim_integer_bitshift, "_integer_bitshift" }, { 1, 1, pf_integer_bitshift, "_integer_bitshift" },
{ 1, 1, prim_integer_eq, "_integer_eq" }, { 1, 1, pf_integer_eq, "_integer_eq" },
{ 1, 1, prim_integer_ne, "_integer_ne" }, { 1, 1, pf_integer_ne, "_integer_ne" },
{ 1, 1, prim_integer_lt, "_integer_lt" }, { 1, 1, pf_integer_lt, "_integer_lt" },
{ 1, 1, prim_integer_gt, "_integer_gt" }, { 1, 1, pf_integer_gt, "_integer_gt" },
{ 1, 1, prim_integer_le, "_integer_le" }, { 1, 1, pf_integer_le, "_integer_le" },
{ 1, 1, prim_integer_ge, "_integer_ge" }, { 1, 1, pf_integer_ge, "_integer_ge" },
{ 1, 1, prim_integer_inttostr, "_integer_inttostr" }, { 1, 1, pf_integer_inttostr, "_integer_inttostr" },
{ 1, 1, prim_ffi_open, "_ffi_open" }, { 1, 1, pf_ffi_open, "_ffi_open" },
{ 1, 1, prim_ffi_close, "_ffi_close" }, { 1, 1, pf_ffi_close, "_ffi_close" },
{ 2, 2, prim_ffi_getsym, "_ffi_getsym" }, { 2, 2, pf_ffi_getsym, "_ffi_getsym" },
{ 3, 3, prim_ffi_call, "_ffi_call" } { 3, 3, pf_ffi_call, "_ffi_call" }
}; };
int stix_getprimno (stix_t* stix, const stix_ooch_t* ptr, stix_oow_t len) int stix_getpfnum (stix_t* stix, const stix_ooch_t* ptr, stix_oow_t len)
{ {
int i; int i;
for (i = 0; i < STIX_COUNTOF(primitives); i++) for (i = 0; i < STIX_COUNTOF(pftab); i++)
{ {
if (stix_compucxbcstr(ptr, len, primitives[i].name) == 0) if (stix_compucxbcstr(ptr, len, pftab[i].name) == 0)
{ {
return i; return i;
} }
@ -2755,175 +2755,6 @@ int stix_getprimno (stix_t* stix, const stix_ooch_t* ptr, stix_oow_t len)
return -1; return -1;
} }
#define MOD_PREFIX "stix_mod_"
#define MOD_PREFIX_LEN 9
static stix_mod_data_t* open_prim_module (stix_t* stix, const stix_ooch_t* name, stix_oow_t namelen)
{
stix_rbt_pair_t* pair;
stix_mod_data_t* mdp;
stix_mod_data_t md;
stix_mod_load_t load = STIX_NULL;
/* maximum module name length is STIX_MOD_NAME_LEN_MAX.
* MOD_PREFIX_LEN for MOD_PREFIX
* 1 for _ at the end when stix_mod_xxx_ is attempted.
* 1 for the terminating '\0'.
*/
stix_ooch_t buf[MOD_PREFIX_LEN + STIX_MOD_NAME_LEN_MAX + 1 + 1];
/* the terminating null isn't needed in buf here */
stix_copybchtooochars (buf, MOD_PREFIX, MOD_PREFIX_LEN);
if (namelen > STIX_COUNTOF(buf) - (MOD_PREFIX_LEN + 1 + 1))
{
/* module name too long */
stix->errnum = STIX_EINVAL; /* TODO: change the error number to something more specific */
return STIX_NULL;
}
stix_copyoochars (&buf[MOD_PREFIX_LEN], name, namelen);
buf[MOD_PREFIX_LEN + namelen] = '\0';
#if defined(STIX_ENABLE_STATIC_MODULE)
/* attempt to find a statically linked module */
/*TODO: CHANGE THIS PART */
/* TODO: binary search ... */
for (n = 0; n < STIX_COUNTOF(static_modtab); n++)
{
if (stix_compoocstr (static_modtab[n].modname, name, name_len....) == 0)
{
load = static_modtab[n].modload;
break;
}
}
if (n >= STIX_COUNTOF(static_modtab))
{
stix->errnum = STIX_ENOENT;
return STIX_NULL;
}
if (load)
{
/* found the module in the staic module table */
STIX_MEMSET (&md, 0, STIX_SIZEOF(md));
stix_copyoochars (md.name, name, namelen);
/* Note md.handle is STIX_NULL for a static module */
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = stix_rbt_insert (stix->modtab, name, namelen, &md, STIX_SIZEOF(md));
if (pair == STIX_NULL)
{
stix->errnum = STIX_ESYSMEM;
return STIX_NULL;
}
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
if (load (&mdp->mod, stix) <= -1)
{
stix_rbt_delete (stix->modtab, segs[0].ptr, segs[0].len);
return STIX_NULL;
}
return mdp;
}
#endif
/* attempt to find an external module */
STIX_MEMSET (&md, 0, STIX_SIZEOF(md));
stix_copyoochars (md.name, name, namelen);
if (stix->vmprim.dl_open && stix->vmprim.dl_getsym && stix->vmprim.dl_close)
{
md.handle = stix->vmprim.dl_open (stix, &buf[MOD_PREFIX_LEN]);
}
if (md.handle == STIX_NULL)
{
STIX_DEBUG2 (stix, "Cannot open a module [%.*S]\n", namelen, name);
stix->errnum = STIX_ENOENT; /* TODO: be more descriptive about the error */
return STIX_NULL;
}
/* attempt to get stix_mod_xxx */
load = stix->vmprim.dl_getsym (stix, md.handle, buf);
if (!load)
{
STIX_DEBUG3 (stix, "Cannot get a module symbol [%S] in [%.*S]\n", buf, namelen, name);
stix->errnum = STIX_ENOENT; /* TODO: be more descriptive about the error */
stix->vmprim.dl_close (stix, md.handle);
return STIX_NULL;
}
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = stix_rbt_insert (&stix->pmtable, (void*)name, namelen, &md, STIX_SIZEOF(md));
if (pair == STIX_NULL)
{
STIX_DEBUG2 (stix, "Cannot register a module [%.*S]\n", namelen, name);
stix->errnum = STIX_ESYSMEM;
stix->vmprim.dl_close (stix, md.handle);
return STIX_NULL;
}
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
if (load (stix, &mdp->mod) <= -1)
{
STIX_DEBUG3 (stix, "Module function [%S] returned failure in [%.*S]\n", buf, namelen, name);
stix->errnum = STIX_ENOENT; /* TODO: proper error code and handling */
stix_rbt_delete (&stix->pmtable, name, namelen);
stix->vmprim.dl_close (stix, mdp->handle);
return STIX_NULL;
}
STIX_DEBUG2 (stix, "Opened a module [%S] - %p\n", mdp->name, mdp->handle);
/* the module loader must ensure to set a proper query handler */
STIX_ASSERT (mdp->mod.query != STIX_NULL);
return mdp;
}
static stix_prim_impl_t query_prim_module (stix_t* stix, const stix_ooch_t* name, stix_oow_t len)
{
stix_rbt_pair_t* pair;
stix_mod_data_t* mdp;
const stix_ooch_t* sep;
stix_oow_t mod_name_len;
stix_prim_impl_t handler;
int n;
sep = stix_findoochar (name, len, '_');
STIX_ASSERT (sep != STIX_NULL);
mod_name_len = sep - name;
pair = stix_rbt_search (&stix->pmtable, name, mod_name_len);
if (pair)
{
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
}
else
{
mdp = open_prim_module (stix, name, mod_name_len);
if (!mdp) return STIX_NULL;
}
done:
if ((handler = mdp->mod.query (stix, &mdp->mod, sep + 1)) == STIX_NULL)
{
/* the primitive function is not found */
STIX_DEBUG3 (stix, "Cannot find a primitive function [%S] in a module [%.*S]\n", sep + 1, mod_name_len, name);
stix->errnum = STIX_ENOENT; /* TODO: proper error code and handling */
return STIX_NULL;
}
STIX_DEBUG4 (stix, "Found a primitive function [%S] in a module [%.*S] - %p\n", sep + 1, mod_name_len, name, handler);
return handler;
}
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */
static int start_method (stix_t* stix, stix_oop_method_t method, stix_oow_t nargs) static int start_method (stix_t* stix, stix_oop_method_t method, stix_oow_t nargs)
{ {
@ -3011,18 +2842,18 @@ static int start_method (stix_t* stix, stix_oop_method_t method, stix_oow_t narg
case STIX_METHOD_PREAMBLE_PRIMITIVE: case STIX_METHOD_PREAMBLE_PRIMITIVE:
{ {
stix_ooi_t prim_no; stix_ooi_t pfnum;
prim_no = STIX_METHOD_GET_PREAMBLE_INDEX(preamble); pfnum = STIX_METHOD_GET_PREAMBLE_INDEX(preamble);
LOG_INST_1 (stix, "preamble_primitive %zd", prim_no); LOG_INST_1 (stix, "preamble_primitive %zd", pf_no);
if (prim_no >= 0 && prim_no < STIX_COUNTOF(primitives) && if (pfnum >= 0 && pfnum < STIX_COUNTOF(pftab) &&
(nargs >= primitives[prim_no].min_nargs && nargs <= primitives[prim_no].max_nargs)) (nargs >= pftab[pfnum].min_nargs && nargs <= pftab[pfnum].max_nargs))
{ {
int n; int n;
stix_pushtmp (stix, (stix_oop_t*)&method); stix_pushtmp (stix, (stix_oop_t*)&method);
n = primitives[prim_no].handler (stix, nargs); n = pftab[pfnum].handler (stix, nargs);
stix_poptmp (stix); stix_poptmp (stix);
if (n <= -1) return -1; /* hard primitive failure */ if (n <= -1) return -1; /* hard primitive failure */
if (n >= 1) break; /* primitive ok */ if (n >= 1) break; /* primitive ok */
@ -3035,34 +2866,34 @@ static int start_method (stix_t* stix, stix_oop_method_t method, stix_oow_t narg
case STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE: case STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE:
{ {
stix_ooi_t prim_name_index; stix_ooi_t pf_name_index;
stix_oop_t name; stix_oop_t name;
stix_prim_impl_t handler; stix_pfimpl_t handler;
stix_oow_t w; stix_oow_t w;
stix_ooi_t sp, nargs, sb; stix_ooi_t /*sp,*/ nargs, sb;
sp = stix->sp; /*sp = stix->sp;*/
nargs = STIX_OOP_TO_SMOOI(method->tmpr_nargs); nargs = STIX_OOP_TO_SMOOI(method->tmpr_nargs);
sb = stix->sp - nargs - 1; /* stack base before receiver and arguments */ sb = stix->sp - nargs - 1; /* stack base before receiver and arguments */
prim_name_index = STIX_METHOD_GET_PREAMBLE_INDEX(preamble); pf_name_index = STIX_METHOD_GET_PREAMBLE_INDEX(preamble);
LOG_INST_1 (stix, "preamble_named_primitive %zd", prim_name_index); LOG_INST_1 (stix, "preamble_named_primitive %zd", pf_name_index);
/* merge two SmallIntegers to get a full pointer */ /* merge two SmallIntegers to get a full pointer */
w = (stix_oow_t)STIX_OOP_TO_SMOOI(method->preamble_data[0]) << (STIX_OOW_BITS / 2) | w = (stix_oow_t)STIX_OOP_TO_SMOOI(method->preamble_data[0]) << (STIX_OOW_BITS / 2) |
(stix_oow_t)STIX_OOP_TO_SMOOI(method->preamble_data[1]); (stix_oow_t)STIX_OOP_TO_SMOOI(method->preamble_data[1]);
handler = (stix_prim_impl_t)w; handler = (stix_pfimpl_t)w;
if (handler) goto exec_handler; if (handler) goto exec_handler;
else else
{ {
STIX_ASSERT (prim_name_index >= 0); STIX_ASSERT (pf_name_index >= 0);
name = method->slot[prim_name_index]; name = method->slot[pf_name_index];
STIX_ASSERT (STIX_ISTYPEOF(stix,name,STIX_OBJ_TYPE_CHAR)); STIX_ASSERT (STIX_ISTYPEOF(stix,name,STIX_OBJ_TYPE_CHAR));
STIX_ASSERT (STIX_OBJ_GET_FLAGS_EXTRA(name)); STIX_ASSERT (STIX_OBJ_GET_FLAGS_EXTRA(name));
STIX_ASSERT (STIX_CLASSOF(stix,name) == stix->_symbol); STIX_ASSERT (STIX_CLASSOF(stix,name) == stix->_symbol);
handler = query_prim_module (stix, ((stix_oop_char_t)name)->slot, STIX_OBJ_GET_SIZE(name)); handler = stix_querymodforpfimpl (stix, ((stix_oop_char_t)name)->slot, STIX_OBJ_GET_SIZE(name));
} }
if (handler) if (handler)
@ -4122,7 +3953,7 @@ return -1;
STIX_ASSERT (b2 >= b1); STIX_ASSERT (b2 >= b1);
/* the block context object created here is used as a base /* the block context object created here is used as a base
* object for block context activation. prim_block_value() * object for block context activation. pf_block_value()
* clones a block context and activates the cloned context. * clones a block context and activates the cloned context.
* this base block context is created with no stack for * this base block context is created with no stack for
* this reason */ * this reason */
@ -4179,7 +4010,7 @@ return -1;
/* the block context object created here is used /* the block context object created here is used
* as a base object for block context activation. * as a base object for block context activation.
* prim_block_value() clones a block * pf_block_value() clones a block
* context and activates the cloned context. * context and activates the cloned context.
* this base block context is created with no * this base block context is created with no
* stack for this reason. */ * stack for this reason. */
@ -4194,7 +4025,7 @@ return -1;
/* [NOTE] /* [NOTE]
* blkctx->sender is left to nil. it is set to the * blkctx->sender is left to nil. it is set to the
* active context before it gets activated. see * active context before it gets activated. see
* prim_block_value(). * pf_block_value().
* *
* blkctx->home is set here to the active context. * blkctx->home is set here to the active context.
* it's redundant to have them pushed to the stack * it's redundant to have them pushed to the stack

4
stix/lib/main.c
View File

@ -516,7 +516,9 @@ static char* syntax_error_msg[] =
"too many block temporaries", "too many block temporaries",
"too many block arguments", "too many block arguments",
"too large block", "too large block",
"wrong primitive number", "wrong primitive function number",
"wrong primitive function identifier",
"wrong module name",
"#include error", "#include error",
"wrong namespace name", "wrong namespace name",
"wrong pool dictionary name", "wrong pool dictionary name",

48
stix/lib/stix-prv.h
View File

@ -405,7 +405,9 @@ enum stix_synerrnum_t
STIX_SYNERR_BLKTMPRFLOOD, /* too many block temporaries */ STIX_SYNERR_BLKTMPRFLOOD, /* too many block temporaries */
STIX_SYNERR_BLKARGFLOOD, /* too many block arguments */ STIX_SYNERR_BLKARGFLOOD, /* too many block arguments */
STIX_SYNERR_BLKFLOOD, /* too large block */ STIX_SYNERR_BLKFLOOD, /* too large block */
STIX_SYNERR_PRIMNO, /* wrong primitive number */ STIX_SYNERR_PFNUM, /* wrong primitive number */
STIX_SYNERR_PFID, /* wrong primitive identifier */
STIX_SYNERR_MODNAME, /* wrong module name */
STIX_SYNERR_INCLUDE, /* #include error */ STIX_SYNERR_INCLUDE, /* #include error */
STIX_SYNERR_NAMESPACE, /* wrong namespace name */ STIX_SYNERR_NAMESPACE, /* wrong namespace name */
STIX_SYNERR_POOLDIC, /* wrong pool dictionary */ STIX_SYNERR_POOLDIC, /* wrong pool dictionary */
@ -557,9 +559,9 @@ struct stix_compiler_t
stix_oow_t arlit_capa; stix_oow_t arlit_capa;
/* 0 for no primitive, 1 for a normal primitive, 2 for a named primitive */ /* 0 for no primitive, 1 for a normal primitive, 2 for a named primitive */
int prim_type; int pftype;
/* primitive number */ /* primitive function number */
stix_ooi_t prim_no; stix_ooi_t pfnum;
/* block depth */ /* block depth */
stix_oow_t blk_depth; stix_oow_t blk_depth;
@ -1236,13 +1238,47 @@ STIX_EXPORT void stix_getsynerr (
/* exec.c */ /* exec.c */
/* ========================================================================= */ /* ========================================================================= */
int stix_getprimno ( int stix_getpfnum (
stix_t* stix, stix_t* stix,
const stix_ooch_t* ptr, const stix_ooch_t* ptr,
stix_oow_t len stix_oow_t len
); );
/* TODO: remove debugging functions */
/* ========================================================================= */
/* stix.c */
/* ========================================================================= */
stix_mod_data_t* stix_openmod (
stix_t* stix,
const stix_ooch_t* name,
stix_oow_t namelen
);
void stix_closemod (
stix_t* stix,
stix_mod_data_t* mdp
);
int stix_importmod (
stix_t* stix,
stix_oop_t _class,
const stix_ooch_t* name,
stix_oow_t len
);
/*
* The stix_querymodforpfimpl() function finds a primitive function in modules
* with a full primitive identifier.
*/
stix_pfimpl_t stix_querymodforpfimpl (
stix_t* stix,
const stix_ooch_t* pfid,
stix_oow_t pfidlen
);
/* TODO: remove the following debugging functions */
/* ========================================================================= */ /* ========================================================================= */
/* debug.c */ /* debug.c */
/* ========================================================================= */ /* ========================================================================= */

15
stix/lib/stix-utl.h
View File

@ -35,6 +35,7 @@ extern "C" {
#if defined(STIX_OOCH_IS_UCH) #if defined(STIX_OOCH_IS_UCH)
# define stix_hashchars(ptr,len) stix_hashuchars(ptr,len) # define stix_hashchars(ptr,len) stix_hashuchars(ptr,len)
# define stix_equaloochars(str1,str2,len) stix_equaluchars(str1,str2,len)
# define stix_compoocbcstr(str1,str2) stix_compucbcstr(str1,str2) # define stix_compoocbcstr(str1,str2) stix_compucbcstr(str1,str2)
# define stix_compoocstr(str1,str2) stix_compucstr(str1,str2) # define stix_compoocstr(str1,str2) stix_compucstr(str1,str2)
# define stix_copyoochars(dst,src,len) stix_copyuchars(dst,src,len) # define stix_copyoochars(dst,src,len) stix_copyuchars(dst,src,len)
@ -44,6 +45,7 @@ extern "C" {
# define stix_countoocstr(str) stix_countucstr(str) # define stix_countoocstr(str) stix_countucstr(str)
#else #else
# define stix_hashchars(ptr,len) stix_hashbchars(ptr,len) # define stix_hashchars(ptr,len) stix_hashbchars(ptr,len)
# define stix_equaloochars(str1,str2,len) stix_equalbchars(str1,str2,len)
# define stix_compoocbcstr(str1,str2) stix_compbcstr(str1,str2) # define stix_compoocbcstr(str1,str2) stix_compbcstr(str1,str2)
# define stix_compoocstr(str1,str2) stix_compbcstr(str1,str2) # define stix_compoocstr(str1,str2) stix_compbcstr(str1,str2)
# define stix_copyoochars(dst,src,len) stix_copybchars(dst,src,len) # define stix_copyoochars(dst,src,len) stix_copybchars(dst,src,len)
@ -69,13 +71,22 @@ STIX_EXPORT stix_oow_t stix_hashuchars (
#define stix_hashbchars(ptr,len) stix_hashbytes(ptr,len) #define stix_hashbchars(ptr,len) stix_hashbytes(ptr,len)
/**
STIX_EXPORT int stix_equalchars ( * The stix_equaluchars() function determines equality of two strings
* of the same length \a len.
*/
STIX_EXPORT int stix_equaluchars (
const stix_uch_t* str1, const stix_uch_t* str1,
const stix_uch_t* str2, const stix_uch_t* str2,
stix_oow_t len stix_oow_t len
); );
STIX_EXPORT int stix_equalbchars (
const stix_bch_t* str1,
const stix_bch_t* str2,
stix_oow_t len
);
STIX_EXPORT int stix_compucstr ( STIX_EXPORT int stix_compucstr (
const stix_uch_t* str1, const stix_uch_t* str1,
const stix_uch_t* str2 const stix_uch_t* str2

286
stix/lib/stix.c
View File

@ -102,8 +102,8 @@ int stix_init (stix_t* stix, stix_mmgr_t* mmgr, stix_oow_t heapsz, const stix_vm
stix->newheap = stix_makeheap (stix, heapsz); stix->newheap = stix_makeheap (stix, heapsz);
if (!stix->newheap) goto oops; if (!stix->newheap) goto oops;
if (stix_rbt_init (&stix->pmtable, mmgr, STIX_SIZEOF(stix_ooch_t), 1) <= -1) goto oops; if (stix_rbt_init (&stix->modtab, mmgr, STIX_SIZEOF(stix_ooch_t), 1) <= -1) goto oops;
stix_rbt_setstyle (&stix->pmtable, stix_getrbtstyle(STIX_RBT_STYLE_INLINE_COPIERS)); stix_rbt_setstyle (&stix->modtab, stix_getrbtstyle(STIX_RBT_STYLE_INLINE_COPIERS));
fill_bigint_tables (stix); fill_bigint_tables (stix);
@ -120,19 +120,16 @@ oops:
return -1; return -1;
} }
static stix_rbt_walk_t unload_primitive_module (stix_rbt_t* rbt, stix_rbt_pair_t* pair, void* ctx) static stix_rbt_walk_t unload_module (stix_rbt_t* rbt, stix_rbt_pair_t* pair, void* ctx)
{ {
stix_t* stix = (stix_t*)ctx; stix_t* stix = (stix_t*)ctx;
stix_mod_data_t* md; stix_mod_data_t* mdp;
md = STIX_RBT_VPTR(pair); mdp = STIX_RBT_VPTR(pair);
if (md->mod.unload) md->mod.unload (stix, &md->mod); STIX_ASSERT (mdp != STIX_NULL);
if (md->handle)
{ mdp->pair = STIX_NULL; /* to prevent stix_closemod() from calling stix_rbt_delete() */
stix->vmprim.dl_close (stix, md->handle); stix_closemod (stix, mdp);
STIX_DEBUG2 (stix, "Closed a module [%S] - %p\n", md->name, md->handle);
md->handle = STIX_NULL;
}
return STIX_RBT_WALK_FORWARD; return STIX_RBT_WALK_FORWARD;
} }
@ -160,8 +157,8 @@ void stix_fini (stix_t* stix)
if (cb->fini) cb->fini (stix); if (cb->fini) cb->fini (stix);
} }
stix_rbt_walk (&stix->pmtable, unload_primitive_module, stix); stix_rbt_walk (&stix->modtab, unload_module, stix); /* unload all modules */
stix_rbt_fini (&stix->pmtable); stix_rbt_fini (&stix->modtab);
/* TOOD: persistency? storing objects to image file? */ /* TOOD: persistency? storing objects to image file? */
stix_killheap (stix, stix->newheap); stix_killheap (stix, stix->newheap);
@ -363,10 +360,9 @@ void stix_freemem (stix_t* stix, void* ptr)
STIX_MMGR_FREE (stix->mmgr, ptr); STIX_MMGR_FREE (stix->mmgr, ptr);
} }
/* -------------------------------------------------------------------------- */ /* -------------------------------------------------------------------------- */
/* TODO: remove RSRS code. so far, i find this not useful */
stix_oop_t stix_makersrc (stix_t* stix, stix_oow_t v) stix_oop_t stix_makersrc (stix_t* stix, stix_oow_t v)
{ {
stix_oop_t imm; stix_oop_t imm;
@ -425,8 +421,264 @@ stix_oow_t stix_getrsrcval (stix_t* stix, stix_oop_t imm)
/* -------------------------------------------------------------------------- */ /* -------------------------------------------------------------------------- */
#define MOD_PREFIX "stix_mod_"
#define MOD_PREFIX_LEN 9
stix_mod_data_t* stix_openmod (stix_t* stix, const stix_ooch_t* name, stix_oow_t namelen)
{
stix_rbt_pair_t* pair;
stix_mod_data_t* mdp;
stix_mod_data_t md;
stix_mod_load_t load = STIX_NULL;
#if defined(STIX_ENABLE_STATIC_MODULE)
int n;
#endif
/* maximum module name length is STIX_MOD_NAME_LEN_MAX.
* MOD_PREFIX_LEN for MOD_PREFIX
* 1 for _ at the end when stix_mod_xxx_ is attempted.
* 1 for the terminating '\0'.
*/
stix_ooch_t buf[MOD_PREFIX_LEN + STIX_MOD_NAME_LEN_MAX + 1 + 1];
/* the terminating null isn't needed in buf here */
stix_copybchtooochars (buf, MOD_PREFIX, MOD_PREFIX_LEN);
if (namelen > STIX_COUNTOF(buf) - (MOD_PREFIX_LEN + 1 + 1))
{
/* module name too long */
stix->errnum = STIX_EINVAL; /* TODO: change the error number to something more specific */
return STIX_NULL;
}
stix_copyoochars (&buf[MOD_PREFIX_LEN], name, namelen);
buf[MOD_PREFIX_LEN + namelen] = '\0';
#if defined(STIX_ENABLE_STATIC_MODULE)
/* attempt to find a statically linked module */
/*TODO: CHANGE THIS PART */
/* TODO: binary search ... */
for (n = 0; n < STIX_COUNTOF(static_modtab); n++)
{
if (stix_compoocstr (static_modtab[n].modname, name, name_len....) == 0)
{
load = static_modtab[n].modload;
break;
}
}
if (n >= STIX_COUNTOF(static_modtab))
{
stix->errnum = STIX_ENOENT;
return STIX_NULL;
}
if (load)
{
/* found the module in the staic module table */
STIX_MEMSET (&md, 0, STIX_SIZEOF(md));
stix_copyoochars (md.name, name, namelen);
/* Note md.handle is STIX_NULL for a static module */
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = stix_rbt_insert (stix->modtab, name, namelen, &md, STIX_SIZEOF(md));
if (pair == STIX_NULL)
{
stix->errnum = STIX_ESYSMEM;
return STIX_NULL;
}
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
if (load (&mdp->mod, stix) <= -1)
{
stix_rbt_delete (stix->modtab, segs[0].ptr, segs[0].len);
return STIX_NULL;
}
return mdp;
}
#endif
/* attempt to find an external module */
STIX_MEMSET (&md, 0, STIX_SIZEOF(md));
stix_copyoochars (md.name, name, namelen);
if (stix->vmprim.dl_open && stix->vmprim.dl_getsym && stix->vmprim.dl_close)
{
md.handle = stix->vmprim.dl_open (stix, &buf[MOD_PREFIX_LEN]);
}
if (md.handle == STIX_NULL)
{
STIX_DEBUG2 (stix, "Cannot open a module [%.*S]\n", namelen, name);
stix->errnum = STIX_ENOENT; /* TODO: be more descriptive about the error */
return STIX_NULL;
}
/* attempt to get stix_mod_xxx where xxx is the module name*/
load = stix->vmprim.dl_getsym (stix, md.handle, buf);
if (!load)
{
STIX_DEBUG3 (stix, "Cannot get a module symbol [%S] in [%.*S]\n", buf, namelen, name);
stix->errnum = STIX_ENOENT; /* TODO: be more descriptive about the error */
stix->vmprim.dl_close (stix, md.handle);
return STIX_NULL;
}
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = stix_rbt_insert (&stix->modtab, (void*)name, namelen, &md, STIX_SIZEOF(md));
if (pair == STIX_NULL)
{
STIX_DEBUG2 (stix, "Cannot register a module [%.*S]\n", namelen, name);
stix->errnum = STIX_ESYSMEM;
stix->vmprim.dl_close (stix, md.handle);
return STIX_NULL;
}
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
if (load (stix, &mdp->mod) <= -1)
{
STIX_DEBUG3 (stix, "Module function [%S] returned failure in [%.*S]\n", buf, namelen, name);
stix->errnum = STIX_ENOENT; /* TODO: proper error code and handling */
stix_rbt_delete (&stix->modtab, name, namelen);
stix->vmprim.dl_close (stix, mdp->handle);
return STIX_NULL;
}
mdp->pair = pair;
STIX_DEBUG2 (stix, "Opened a module [%S] - %p\n", mdp->name, mdp->handle);
/* the module loader must ensure to set a proper query handler */
STIX_ASSERT (mdp->mod.query != STIX_NULL);
return mdp;
}
void stix_closemod (stix_t* stix, stix_mod_data_t* mdp)
{
if (mdp->mod.unload) mdp->mod.unload (stix, &mdp->mod);
if (mdp->handle)
{
stix->vmprim.dl_close (stix, mdp->handle);
STIX_DEBUG2 (stix, "Closed a module [%S] - %p\n", mdp->name, mdp->handle);
mdp->handle = STIX_NULL;
}
if (mdp->pair)
{
/*mdp->pair = STIX_NULL;*/ /* this reset isn't needed as the area will get freed by stix_rbt_delete()) */
stix_rbt_delete (&stix->modtab, mdp->name, stix_countoocstr(mdp->name));
}
}
int stix_importmod (stix_t* stix, stix_oop_t _class, const stix_ooch_t* name, stix_oow_t len)
{
stix_rbt_pair_t* pair;
stix_mod_data_t* mdp;
int r = 0;
pair = stix_rbt_search (&stix->modtab, name, len);
if (pair)
{
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
STIX_ASSERT (mdp != STIX_NULL);
}
else
{
mdp = stix_openmod (stix, name, len);
if (!mdp)
{
r = -1;
goto done;
}
}
if (!mdp->mod.import)
{
STIX_DEBUG1 (stix, "Cannot import module [%S] - importing not supported by the module\n", mdp->name);
stix->errnum = STIX_ENOIMPL;
r = -1;
goto done;
}
if (mdp->mod.import (stix, &mdp->mod, _class) <= -1)
{
STIX_DEBUG1 (stix, "Cannot import module [%S] - module's import() returned failure\n", mdp->name);
r = -1;
goto done;
}
done:
if (!pair)
{
/* clsoe the module if it has been opened in this function. */
stix_closemod (stix, mdp);
}
return r;
}
stix_pfimpl_t stix_querymodforpfimpl (stix_t* stix, const stix_ooch_t* pfid, stix_oow_t pfidlen)
{
/* primitive function identifier
* _funcname
* modname_funcname
*/
stix_rbt_pair_t* pair;
stix_mod_data_t* mdp;
const stix_ooch_t* sep;
stix_oow_t mod_name_len;
stix_pfimpl_t handler;
sep = stix_findoochar (pfid, pfidlen, '_');
if (!sep)
{
/* i'm writing a conservative code here. the compiler should
* guarantee that an underscore is included in an primitive identifer.
* what if the compiler is broken? imagine a buggy compiler rewritten
* in stix itself? */
STIX_DEBUG2 (stix, "Internal error - no underscore in a primitive function identifier [%.*S] - buggy compiler?\n", pfidlen, pfid);
stix->errnum = STIX_EINTERN;
return STIX_NULL;
}
mod_name_len = sep - pfid;
pair = stix_rbt_search (&stix->modtab, pfid, mod_name_len);
if (pair)
{
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
STIX_ASSERT (mdp != STIX_NULL);
}
else
{
mdp = stix_openmod (stix, pfid, mod_name_len);
if (!mdp) return STIX_NULL;
}
if ((handler = mdp->mod.query (stix, &mdp->mod, sep + 1)) == STIX_NULL)
{
/* the primitive function is not found. keep the module open */
STIX_DEBUG2 (stix, "Cannot find a primitive function [%S] in a module [%S]\n", sep + 1, mdp->name);
stix->errnum = STIX_ENOENT; /* TODO: proper error code and handling */
return STIX_NULL;
}
STIX_DEBUG3 (stix, "Found a primitive function [%S] in a module [%S] - %p\n", sep + 1, mdp->name, handler);
return handler;
}
/* -------------------------------------------------------------------------- */
/* add a new primitive method */ /* add a new primitive method */
int stix_addmethod (stix_t* stix, stix_oop_t _class, const stix_ooch_t* name, stix_prim_impl_t func) int stix_addmethod (stix_t* stix, stix_oop_t _class, const stix_ooch_t* name, stix_pfimpl_t func)
{ {
/* NOTE: this function is a subset of add_compiled_method() in comp.c */ /* NOTE: this function is a subset of add_compiled_method() in comp.c */

22
stix/lib/stix.h
View File

@ -721,11 +721,15 @@ struct stix_cb_t
/* ========================================================================= /* =========================================================================
* PRIMITIVE MODULE MANIPULATION * MODULE MANIPULATION
* ========================================================================= */ * ========================================================================= */
#define STIX_MOD_NAME_LEN_MAX 120 #define STIX_MOD_NAME_LEN_MAX 120
typedef int (*stix_prim_impl_t) (stix_t* stix, stix_ooi_t nargs); /* primitive function implementation type */
typedef int (*stix_pfimpl_t) (
stix_t* stix,
stix_ooi_t nargs
);
typedef struct stix_mod_t stix_mod_t; typedef struct stix_mod_t stix_mod_t;
@ -734,7 +738,13 @@ typedef int (*stix_mod_load_t) (
stix_mod_t* mod stix_mod_t* mod
); );
typedef stix_prim_impl_t (*stix_mod_query_t) ( typedef int (*stix_mod_import_t) (
stix_t* stix,
stix_mod_t* mod,
stix_oop_t _class
);
typedef stix_pfimpl_t (*stix_mod_query_t) (
stix_t* stix, stix_t* stix,
stix_mod_t* mod, stix_mod_t* mod,
const stix_uch_t* name const stix_uch_t* name
@ -747,8 +757,9 @@ typedef void (*stix_mod_unload_t) (
struct stix_mod_t struct stix_mod_t
{ {
stix_mod_unload_t unload; stix_mod_import_t import;
stix_mod_query_t query; stix_mod_query_t query;
stix_mod_unload_t unload;
void* ctx; void* ctx;
}; };
@ -756,6 +767,7 @@ struct stix_mod_data_t
{ {
stix_ooch_t name[STIX_MOD_NAME_LEN_MAX + 1]; stix_ooch_t name[STIX_MOD_NAME_LEN_MAX + 1];
void* handle; void* handle;
stix_rbt_pair_t* pair; /* internal backreference to stix->modtab */
stix_mod_t mod; stix_mod_t mod;
}; };
typedef struct stix_mod_data_t stix_mod_data_t; typedef struct stix_mod_data_t stix_mod_data_t;
@ -785,7 +797,7 @@ struct stix_t
stix_vmprim_t vmprim; stix_vmprim_t vmprim;
stix_cb_t* cblist; stix_cb_t* cblist;
stix_rbt_t pmtable; /* primitive module table */ stix_rbt_t modtab; /* primitive module table */
struct struct
{ {

2
stix/lib/sym.c
View File

@ -106,7 +106,7 @@ static stix_oop_t find_or_make_symbol (stix_t* stix, const stix_ooch_t* ptr, sti
STIX_ASSERT (STIX_CLASSOF(stix,symbol) == (stix_oop_t)stix->_symbol); STIX_ASSERT (STIX_CLASSOF(stix,symbol) == (stix_oop_t)stix->_symbol);
if (len == STIX_OBJ_GET_SIZE(symbol) && if (len == STIX_OBJ_GET_SIZE(symbol) &&
stix_equalchars (ptr, symbol->slot, len)) stix_equaloochars (ptr, symbol->slot, len))
{ {
return (stix_oop_t)symbol; return (stix_oop_t)symbol;
} }

14
stix/lib/utl.c
View File

@ -44,7 +44,19 @@ stix_oow_t stix_hashuchars (const stix_uch_t* ptr, stix_oow_t len)
return stix_hashbytes ((const stix_oob_t *)ptr, len * STIX_SIZEOF(*ptr)); return stix_hashbytes ((const stix_oob_t *)ptr, len * STIX_SIZEOF(*ptr));
} }
int stix_equalchars (const stix_uch_t* str1, const stix_uch_t* str2, stix_oow_t len) int stix_equaluchars (const stix_uch_t* str1, const stix_uch_t* str2, stix_oow_t len)
{
stix_oow_t i;
for (i = 0; i < len; i++)
{
if (str1[i] != str2[i]) return 0;
}
return 1;
}
int stix_equalbchars (const stix_bch_t* str1, const stix_bch_t* str2, stix_oow_t len)
{ {
stix_oow_t i; stix_oow_t i;

36
stix/mod/console.c
View File

@ -48,7 +48,7 @@ struct console_t
}; };
/* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */
static int prim_open (stix_t* stix, stix_ooi_t nargs) static int pf_open (stix_t* stix, stix_ooi_t nargs)
{ {
#if defined(_WIN32) #if defined(_WIN32)
HANDLE h; HANDLE h;
@ -123,7 +123,7 @@ static int prim_open (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_close (stix_t* stix, stix_ooi_t nargs) static int pf_close (stix_t* stix, stix_ooi_t nargs)
{ {
#if defined(_WIN32) #if defined(_WIN32)
HANDLE h; HANDLE h;
@ -142,7 +142,7 @@ static int prim_close (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_write (stix_t* stix, stix_ooi_t nargs) static int pf_write (stix_t* stix, stix_ooi_t nargs)
{ {
console_t* con; console_t* con;
stix_oop_char_t oomsg; stix_oop_char_t oomsg;
@ -185,7 +185,7 @@ static int prim_write (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_clear (stix_t* stix, stix_ooi_t nargs) static int pf_clear (stix_t* stix, stix_ooi_t nargs)
{ {
console_t* con; console_t* con;
@ -197,7 +197,7 @@ static int prim_clear (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_setcursor (stix_t* stix, stix_ooi_t nargs) static int pf_setcursor (stix_t* stix, stix_ooi_t nargs)
{ {
console_t* con; console_t* con;
stix_oop_oop_t point; stix_oop_oop_t point;
@ -221,7 +221,7 @@ static int prim_setcursor (stix_t* stix, stix_ooi_t nargs)
#if 0 #if 0
static int prim_setcursorto (stix_t* stix, stix_ooi_t nargs) static int pf_setcursorto (stix_t* stix, stix_ooi_t nargs)
{ {
console_t* con; console_t* con;
stix_oop_oop_t point; stix_oop_oop_t point;
@ -253,21 +253,21 @@ typedef struct fnctab_t fnctab_t;
struct fnctab_t struct fnctab_t
{ {
const stix_bch_t* name; const stix_bch_t* name;
stix_prim_impl_t handler; stix_pfimpl_t handler;
}; };
static fnctab_t fnctab[] = static fnctab_t fnctab[] =
{ {
{ "clear", prim_clear }, { "clear", pf_clear },
{ "close", prim_close }, { "close", pf_close },
{ "open", prim_open }, { "open", pf_open },
{ "setcursor", prim_setcursor }, { "setcursor", pf_setcursor },
{ "write", prim_write }, { "write", pf_write },
}; };
/* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */
static stix_prim_impl_t query (stix_t* stix, stix_mod_t* mod, const stix_ooch_t* name) static stix_pfimpl_t query (stix_t* stix, stix_mod_t* mod, const stix_ooch_t* name)
{ {
int left, right, mid, n; int left, right, mid, n;
@ -311,11 +311,11 @@ int stix_mod_console (stix_t* stix, stix_mod_t* mod)
c = stix_findclass (stix, "Console"); c = stix_findclass (stix, "Console");
if (!c) c = stix_makeclass (stix, "Console", "x y"); <- provides an API to create a simple class if (!c) c = stix_makeclass (stix, "Console", "x y"); <- provides an API to create a simple class
stix_addmethod (stix, c, "open", prim_open); stix_addmethod (stix, c, "open", pf_open);
stix_addmethod (stix, c, "close:", prim_close); stix_addmethod (stix, c, "close:", pf_close);
stix_addmethod (stix, c, "setCursorTo:", prim_setcursor); stix_addmethod (stix, c, "setCursorTo:", pf_setcursor);
stix_addmethod (stix, c, "clear", prim_clear ); stix_addmethod (stix, c, "clear", pf_clear );
stix_addmethod (stix, c, "write", prim_write ); stix_addmethod (stix, c, "write", pf_write );

12
stix/mod/sound.c
View File

@ -29,14 +29,14 @@
#include <stix-utl.h> #include <stix-utl.h>
/* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */
static int prim_open (stix_t* stix, stix_ooi_t nargs) static int pf_open (stix_t* stix, stix_ooi_t nargs)
{ {
printf ("<<<<<<<<<<<SND OPEN>>>>>>>>>>>>>>>>>>\n"); printf ("<<<<<<<<<<<SND OPEN>>>>>>>>>>>>>>>>>>\n");
STIX_STACK_POPS (stix, nargs); STIX_STACK_POPS (stix, nargs);
return 1; return 1;
} }
static int prim_close (stix_t* stix, stix_ooi_t nargs) static int pf_close (stix_t* stix, stix_ooi_t nargs)
{ {
printf ("<<<<<<<<<<<<<<<<<<<<SND CLOSE>>>>>>>>>>>>>>>>>>>>>>\n"); printf ("<<<<<<<<<<<<<<<<<<<<SND CLOSE>>>>>>>>>>>>>>>>>>>>>>\n");
STIX_STACK_POPS (stix, nargs); STIX_STACK_POPS (stix, nargs);
@ -47,19 +47,19 @@ typedef struct fnctab_t fnctab_t;
struct fnctab_t struct fnctab_t
{ {
const stix_bch_t* name; const stix_bch_t* name;
stix_prim_impl_t handler; stix_pfimpl_t handler;
}; };
static fnctab_t fnctab[] = static fnctab_t fnctab[] =
{ {
{ "close", prim_close }, { "close", pf_close },
{ "open", prim_open } { "open", pf_open }
}; };
/* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */
static stix_prim_impl_t query (stix_t* stix, stix_mod_t* mod, const stix_ooch_t* name) static stix_pfimpl_t query (stix_t* stix, stix_mod_t* mod, const stix_ooch_t* name)
{ {
int left, right, mid, n; int left, right, mid, n;

36
stix/mod/stdio.c
View File

@ -38,7 +38,7 @@ struct stdio_t
FILE* fp; FILE* fp;
}; };
static int prim_open (stix_t* stix, stix_ooi_t nargs) static int pf_open (stix_t* stix, stix_ooi_t nargs)
{ {
stix_oop_char_t name; stix_oop_char_t name;
stix_oop_char_t mode; stix_oop_char_t mode;
@ -81,7 +81,7 @@ STIX_DEBUG3 (stix, "opened %s for %s - %p\n", namebuf, modebuf, rcv->fp);
return 1; return 1;
} }
static int prim_close (stix_t* stix, stix_ooi_t nargs) static int pf_close (stix_t* stix, stix_ooi_t nargs)
{ {
stdio_t* rcv; stdio_t* rcv;
@ -97,7 +97,7 @@ STIX_DEBUG1 (stix, "closing %p\n", rcv->fp);
return 1; return 1;
} }
static int prim_puts (stix_t* stix, stix_ooi_t nargs) static int pf_puts (stix_t* stix, stix_ooi_t nargs)
{ {
/* return how many bytes have been written.. */ /* return how many bytes have been written.. */
@ -105,7 +105,7 @@ static int prim_puts (stix_t* stix, stix_ooi_t nargs)
return 1; return 1;
} }
static int prim_newinstsize (stix_t* stix, stix_ooi_t nargs) static int pf_newinstsize (stix_t* stix, stix_ooi_t nargs)
{ {
stix_ooi_t newinstsize = STIX_SIZEOF(stdio_t) - STIX_SIZEOF(stix_obj_t); stix_ooi_t newinstsize = STIX_SIZEOF(stdio_t) - STIX_SIZEOF(stix_obj_t);
STIX_STACK_SETRET (stix, nargs, STIX_SMOOI_TO_OOP(newinstsize)); STIX_STACK_SETRET (stix, nargs, STIX_SMOOI_TO_OOP(newinstsize));
@ -117,20 +117,25 @@ typedef struct fnctab_t fnctab_t;
struct fnctab_t struct fnctab_t
{ {
const stix_bch_t* name; const stix_bch_t* name;
stix_prim_impl_t handler; stix_pfimpl_t handler;
}; };
static fnctab_t fnctab[] = static fnctab_t fnctab[] =
{ {
{ "close", prim_close }, { "close", pf_close },
{ "newInstSize", prim_newinstsize }, { "newInstSize", pf_newinstsize },
{ "open", prim_open }, { "open", pf_open },
{ "puts", prim_puts } { "puts", pf_puts }
}; };
/* ------------------------------------------------------------------------ */ /* ------------------------------------------------------------------------ */
static stix_prim_impl_t query (stix_t* stix, stix_mod_t* mod, const stix_ooch_t* name) static int import (stix_t* stix, stix_mod_t* mod, stix_oop_t _class)
{
return 0;
}
static stix_pfimpl_t query (stix_t* stix, stix_mod_t* mod, const stix_ooch_t* name)
{ {
int left, right, mid, n; int left, right, mid, n;
@ -171,6 +176,7 @@ static void unload (stix_t* stix, stix_mod_t* mod)
int stix_mod_stdio (stix_t* stix, stix_mod_t* mod) int stix_mod_stdio (stix_t* stix, stix_mod_t* mod)
{ {
mod->import = import;
mod->query = query; mod->query = query;
mod->unload = unload; mod->unload = unload;
mod->ctx = STIX_NULL; mod->ctx = STIX_NULL;
@ -183,11 +189,11 @@ int stix_mod_stdio (stix_t* stix, stix_mod_t* mod)
c = stix_findclass (stix, "Console"); c = stix_findclass (stix, "Console");
if (!c) c = stix_makeclass (stix, "Console", "x y"); <- provides an API to create a simple class if (!c) c = stix_makeclass (stix, "Console", "x y"); <- provides an API to create a simple class
stix_addmethod (stix, c, "open", prim_open); stix_addmethod (stix, c, "open", pf_open);
stix_addmethod (stix, c, "close:", prim_close); stix_addmethod (stix, c, "close:", pf_close);
stix_addmethod (stix, c, "setCursorTo:", prim_setcursor); stix_addmethod (stix, c, "setCursorTo:", pf_setcursor);
stix_addmethod (stix, c, "clear", prim_clear ); stix_addmethod (stix, c, "clear", pf_clear );
stix_addmethod (stix, c, "write", prim_write ); stix_addmethod (stix, c, "write", pf_write );