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

added qse_getprimno() and added experimental code for foreign function interface

Browse Source
This commit is contained in:
hyunghwan.chung 2015-10-03 15:29:03 +00:00
parent 5449e89292
commit 353d3bd2fe
6 changed files with 359 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
stix/lib/Stix.st
View File

@ -14,40 +14,45 @@
#method(#class) dump
{
<primitive: 0>
<primitive: #dump>
}
#method dump
{
<primitive: 0>
<primitive: #dump>
}
#method(#class) new
{
<primitive: 1>
## <primitive: 1>
<primitive: #new>
}
#method(#class) new: anInteger
{
<primitive: 2>
## <primitive: 2>
<primitive: #new:>
}
#method basicSize
{
<primitive: 3>
## <primitive: 3>
<primitive: #basicSize>
^0
}
#method basicAt: anInteger
{
<primitive: 4>
## <primitive: 4>
<primitive: #basicAt:>
## self error: 'out of range'.
}
#method basicAt: anInteger put: anObject
{
<primitive: 5>
## <primitive: 5>
<primitive: #basicAt:put:>
## self error: 'out of range'.
}
@ -393,3 +398,63 @@
#dcl owner preamble ntmprs nargs code source.
}
#class FFI(Object)
{
#dcl name handle funcs.
#method(#class) new: aString
{
^self new open: aString.
}
#method open: aString
{
self.funcs := Dictionary new.
self.name := aString.
self.handle := self privateOpen: self.name.
}
#method close
{
self privateClose: self.handle.
self.handle := nil.
}
#method call: aFunctionName withArgs: anArgArray
{
| f |
f := self.funcs at: aFunctionName.
f isNil ifTrue: [
f := self privateGetSymbol: aFunctionName in: self.handle.
f isNil ifTrue: [ self error: 'No such function' ].
self.funcs at: aFunctionName put: f.
].
^self privateCall: f withArgs: anArgArray.
}
#method privateOpen: aString
{
<primitive: #ffiOpen>
## throw an exception here.
}
#method privateClose: aHandle
{
<primitive: #ffiClose>
}
#method privateCall: aFFISym withArgs: anArgArray
{
<primitive: #ffiCall>
}
#method privateGetSymbol: aString in: aHandle
{
<primitive: #ffiGetSym>
}
}

69
stix/lib/comp.c
View File

@ -165,6 +165,7 @@ static STIX_INLINE int is_spacechar (stix_uci_t c)
}
}
static STIX_INLINE int is_alphachar (stix_uci_t c)
{
/* TODO: support full unicode */
@ -217,6 +218,16 @@ static STIX_INLINE int is_binselchar (stix_uci_t c)
}
}
static STIX_INLINE int is_leadidentchar (stix_uci_t c)
{
return is_alphachar(c) || c == '_';
}
static STIX_INLINE int is_identchar (stix_uci_t c)
{
return is_alnumchar(c) || c == '_';
}
static STIX_INLINE int is_closing_char (stix_uci_t c)
{
switch (c)
@ -717,7 +728,7 @@ static int get_ident (stix_t* stix, stix_uci_t char_read_ahead)
ADD_TOKEN_CHAR (stix, c);
GET_CHAR_TO (stix, c);
}
while (is_alnumchar(c));
while (is_identchar(c));
if (c == ':')
{
@ -726,7 +737,7 @@ static int get_ident (stix_t* stix, stix_uci_t char_read_ahead)
stix->c->tok.type = STIX_IOTOK_KEYWORD;
GET_CHAR_TO (stix, c);
if (stix->c->in_array && is_alphachar(c))
if (stix->c->in_array && is_leadidentchar(c))
{
/* when reading an array literal, read as many characters as
* would compose a normal keyword symbol literal */
@ -735,7 +746,7 @@ static int get_ident (stix_t* stix, stix_uci_t char_read_ahead)
ADD_TOKEN_CHAR (stix, c);
GET_CHAR_TO (stix, c);
}
while (is_alnumchar(c));
while (is_identchar(c));
if (c == ':') goto read_more_kwsym;
else
@ -757,7 +768,7 @@ static int get_ident (stix_t* stix, stix_uci_t char_read_ahead)
read_more_seg:
GET_CHAR_TO (stix, c);
if (is_alphachar(c))
if (is_leadidentchar(c))
{
stix->c->tok.type = STIX_IOTOK_IDENT_DOTTED;
@ -767,7 +778,7 @@ static int get_ident (stix_t* stix, stix_uci_t char_read_ahead)
ADD_TOKEN_CHAR (stix, c);
GET_CHAR_TO (stix, c);
}
while (is_alnumchar(c));
while (is_identchar(c));
if (c == '.') goto read_more_seg;
}
@ -1281,14 +1292,14 @@ retry:
}
while (is_binselchar(c));
}
else if (is_alphachar(c))
else if (is_leadidentchar(c))
{
do
{
ADD_TOKEN_CHAR (stix, c);
GET_CHAR_TO (stix, c);
}
while (is_alnumchar(c));
while (is_identchar(c));
if (c == ':')
{
@ -1297,14 +1308,14 @@ retry:
ADD_TOKEN_CHAR (stix, c);
GET_CHAR_TO (stix, c);
if (is_alphachar(c))
if (is_leadidentchar(c))
{
do
{
ADD_TOKEN_CHAR (stix, c);
GET_CHAR_TO (stix, c);
}
while (is_alnumchar(c));
while (is_identchar(c));
if (c == ':') goto read_more_word;
else
@ -1328,7 +1339,7 @@ retry:
read_more_seg:
GET_CHAR_TO (stix, c);
if (is_alphachar(c))
if (is_leadidentchar(c))
{
ADD_TOKEN_CHAR (stix, '.');
do
@ -1336,7 +1347,7 @@ retry:
ADD_TOKEN_CHAR (stix, c);
GET_CHAR_TO (stix, c);
}
while (is_alnumchar(c));
while (is_identchar(c));
if (c == '.') goto read_more_seg;
}
@ -1411,7 +1422,7 @@ retry:
*/
default:
if (is_alphachar(c))
if (is_leadidentchar(c))
{
if (get_ident(stix, STIX_UCI_EOF) <= -1) return -1;
}
@ -2555,13 +2566,10 @@ static int compile_method_primitive (stix_t* stix)
* <some-other-modifier: xxxx>
*/
GET_TOKEN (stix); /* TODO: only integer */
if (stix->c->tok.type != STIX_IOTOK_NUMLIT)
GET_TOKEN (stix);
switch (stix->c->tok.type)
{
set_syntax_error (stix, STIX_SYNERR_INTEGER, &stix->c->tok.loc, &stix->c->tok.name);
return -1;
}
case STIX_IOTOK_NUMLIT: /* TODO: allow only an integer */
/*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 = stix->c->tok.name.ptr;
end = ptr + stix->c->tok.name.len;
@ -2579,6 +2587,28 @@ static int compile_method_primitive (stix_t* stix)
}
stix->c->mth.prim_no = prim_no;
break;
case STIX_IOTOK_SYMLIT:
prim_no = stix_getprimno (stix, &stix->c->tok.name);
if (prim_no <= -1)
{
set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name);
return -1;
}
else if (!STIX_OOI_IN_PREAMBLE_INDEX_RANGE(prim_no))
{
set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name);
return -1;
}
stix->c->mth.prim_no = prim_no;
break;
default:
set_syntax_error (stix, STIX_SYNERR_INTEGER, &stix->c->tok.loc, &stix->c->tok.name);
return -1;
}
GET_TOKEN (stix);
if (!is_token_binary_selector(stix, VOCA_GT))
@ -2610,7 +2640,6 @@ static int get_variable_info (stix_t* stix, const stix_ucs_t* name, const stix_i
stix_oop_association_t ass;
const stix_uch_t* dot;
dot = stix_findchar (name->ptr, name->len, '.');
STIX_ASSERT (dot != STIX_NULL);
if (dot - name->ptr == 4 && stix_equalchars(name->ptr, vocas[VOCA_SELF].str, 4))
@ -3298,7 +3327,6 @@ static int compile_expression_primary (stix_t* stix, const stix_ucs_t* ident, co
if (ident)
{
/* the caller has read the identifier and the next word */
handle_ident:
if (get_variable_info(stix, ident, ident_loc, ident_dotted, &var) <= -1) return -1;
@ -3370,6 +3398,7 @@ printf ("\tpush object %d\n", (int)index);
switch (stix->c->tok.type)
{
case STIX_IOTOK_IDENT_DOTTED:
ident_dotted = 1;
case STIX_IOTOK_IDENT:
ident = &stix->c->tok.name;
ident_loc = &stix->c->tok.loc;

205
stix/lib/exec.c
View File

@ -26,6 +26,8 @@
#include "stix-prv.h"
#include <dlfcn.h> /* TODO: remove this. make dlXXX calls to callbacks */
/* TODO: context's stack overflow check in various part of this file */
/* TOOD: determine the right stack size */
#define CONTEXT_STACK_SIZE 96
@ -355,6 +357,8 @@ TODO: overcome this problem
return activate_new_method (stix, mth);
}
/* ------------------------------------------------------------------------- */
static int primitive_dump (stix_t* stix, stix_ooi_t nargs)
{
stix_ooi_t i;
@ -447,7 +451,6 @@ static int primitive_basic_size (stix_t* stix, stix_ooi_t nargs)
stix_oop_t rcv;
STIX_ASSERT (nargs == 0);
rcv = ACTIVE_STACK_GETTOP(stix);
ACTIVE_STACK_SETTOP(stix, STIX_OOP_FROM_SMINT(STIX_OBJ_GET_SIZE(rcv)));
/* TODO: use LargeInteger if the size is very big */
@ -846,6 +849,155 @@ static int primitive_integer_gt (stix_t* stix, stix_ooi_t nargs)
return 0;
}
static int primitive_ffi_open (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, arg;
void* handle;
STIX_ASSERT (nargs == 1);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
arg = ACTIVE_STACK_GET(stix, stix->sp);
if (STIX_OBJ_GET_FLAGS_TYPE(arg) != STIX_OBJ_TYPE_CHAR)
{
/* TODO: more info on error */
return 0;
}
{ ///////////////////////
/* TODO: grow buffer */
stix_bch_t bcs[128];
stix_size_t ucslen, bcslen;
bcslen = STIX_COUNTOF(bcs);
ucslen = STIX_OBJ_GET_SIZE(arg);
if (stix_ucstoutf8 (((stix_oop_char_t)arg)->slot, &ucslen, bcs, &bcslen) <= -1)
{
/* TODO: more info on error */
return 0;
}
bcs[bcslen] = '\0';
handle = dlopen (bcs, RTLD_NOW);
if (!handle)
{
/* TODO: more info on error */
return 0;
}
} ///////////////////////
ACTIVE_STACK_POP (stix);
/* TODO: how to hold an address? as an integer???? or a byte array? */
ACTIVE_STACK_SETTOP (stix, STIX_OOP_FROM_SMINT(handle));
return 1;
}
static int primitive_ffi_close (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, arg;
void* handle;
STIX_ASSERT (nargs == 1);
STIX_ASSERT (nargs == 1);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
arg = ACTIVE_STACK_GET(stix, stix->sp);
if (!STIX_OOP_IS_SMINT(arg))
{
/* TODO: more info on error */
return 0;
}
ACTIVE_STACK_POP (stix);
handle = STIX_OOP_TO_SMINT(arg); /* TODO: how to store void* ??? */
dlclose (handle);
return 1;
}
static int primitive_ffi_call (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, fun, arr;
STIX_ASSERT (nargs == 2);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 2);
fun = ACTIVE_STACK_GET(stix, stix->sp - 1);
arr = ACTIVE_STACK_GET(stix, stix->sp);
if (!STIX_OOP_IS_SMINT(fun)) /* TODO: how to store pointer */
{
/* TODO: more info on error */
return 0;
}
if (STIX_CLASSOF(arr) != stix->_array) /* TODO: check if arr is a kind of array??? */
{
/* TODO: more info on error */
return 0;
}
return 1;
}
static int primitive_ffi_getsym (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, hnd, nam;
void* handle, * sym;
STIX_ASSERT (nargs == 2);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 2);
nam = ACTIVE_STACK_GET(stix, stix->sp - 1);
hnd = ACTIVE_STACK_GET(stix, stix->sp);
if (!STIX_OOP_IS_SMINT(hnd)) /* TODO: how to store pointer */
{
/* TODO: more info on error */
return 0;
}
if (STIX_OBJ_GET_FLAGS_TYPE(nam) != STIX_OBJ_TYPE_CHAR)
{
/* TODO: more info on error */
return 0;
}
{ ///////////////////////
/* TODO: grow buffer */
stix_bch_t bcs[128];
stix_size_t ucslen, bcslen;
bcslen = STIX_COUNTOF(bcs);
ucslen = STIX_OBJ_GET_SIZE(nam);
if (stix_ucstoutf8 (((stix_oop_char_t)nam)->slot, &ucslen, bcs, &bcslen) <= -1)
{
/* TODO: more info on error */
return 0;
}
bcs[bcslen] = '\0';
sym = dlsym (handle, bcs);
if (!sym)
{
/* TODO: more info on error */
return 0;
}
} ///////////////////////
ACTIVE_STACK_POPS (stix, 2);
/* TODO: how to hold an address? as an integer???? or a byte array? */
ACTIVE_STACK_SETTOP (stix, STIX_OOP_FROM_SMINT(sym));
return 1;
}
typedef int (*primitive_handler_t) (stix_t* stix, stix_ooi_t nargs);
@ -853,27 +1005,50 @@ struct primitive_t
{
stix_ooi_t nargs; /* expected number of arguments */
primitive_handler_t handler;
/* stix_ucs_t name; */
const char* name; /* the name is supposed to be 7-bit ascii only */
};
typedef struct primitive_t primitive_t;
static primitive_t primitives[] =
{
/* 0 */ { -1, primitive_dump },
/* 1 */ { 0, primitive_new },
/* 2 */ { 1, primitive_new_with_size },
/* 3 */ { 0, primitive_basic_size },
/* 4 */ { 1, primitive_basic_at },
/* 5 */ { 2, primitive_basic_at_put },
/* 6 */ { -1, primitive_block_value },
/* 7 */ { 1, primitive_integer_add },
/* 8 */ { 1, primitive_integer_sub },
/* 9 */ { 1, primitive_integer_mul },
/* 10 */ { 1, primitive_integer_eq },
/* 11 */ { 1, primitive_integer_lt },
/* 12 */ { 1, primitive_integer_gt }
{ -1, primitive_dump, "dump" }, /* 0 */
{ 0, primitive_new, "new" }, /* 1 */
{ 1, primitive_new_with_size, "new:" }, /* 2 */
{ 0, primitive_basic_size, "basicSize" }, /* 3 */
{ 1, primitive_basic_at, "basicAt:" }, /* 4 */
{ 2, primitive_basic_at_put, "basicAt:put:" }, /* 5 */
{ -1, primitive_block_value, "blockValue" }, /* 6 */
{ 1, primitive_integer_add, "integerAdd:" }, /* 7 */
{ 1, primitive_integer_sub, "integerSub:" }, /* 8 */
{ 1, primitive_integer_mul, "integerMul:" }, /* 9 */
{ 1, primitive_integer_eq, "integerEq:" }, /* 10 */
{ 1, primitive_integer_lt, "integerLt:" }, /* 11 */
{ 1, primitive_integer_gt, "integerGt:" }, /* 12 */
{ 1, primitive_ffi_open, "ffiOpen" },
{ 1, primitive_ffi_close, "ffiClose" },
{ 2, primitive_ffi_call, "ffiCall" },
{ 2, primitive_ffi_getsym, "ffiGetSym" }
};
int stix_getprimno (stix_t* stix, const stix_ucs_t* name)
{
int i;
for (i = 0; i < STIX_COUNTOF(primitives); i++)
{
if (stix_equalchars2(name, primitives[i].name))
{
return i;
}
}
stix->errnum = STIX_ENOENT;
return -1;
}
/* ------------------------------------------------------------------------- */
int stix_execute (stix_t* stix)
{
stix_byte_t bcode;

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

@ -856,6 +856,11 @@ int stix_equalchars (
stix_size_t len
);
int stix_equalchars2 (
const stix_ucs_t* str1,
const char* str2
);
void stix_copychars (
stix_uch_t* dst,
const stix_uch_t* src,
@ -1065,6 +1070,13 @@ void stix_getsynerr (
stix_synerr_t* synerr
);
/* ========================================================================= */
/* exec.c */
/* ========================================================================= */
int stix_getprimno (
stix_t* stix,
const stix_ucs_t* name
);
/* TODO: remove debugging functions */
/* ========================================================================= */

15
stix/lib/stix.c
View File

@ -214,6 +214,21 @@ int stix_equalchars (const stix_uch_t* str1, const stix_uch_t* str2, stix_size_t
return 1;
}
int stix_equalchars2 (const stix_ucs_t* str1, const char* str2)
{
const stix_uch_t* ptr, * end;
ptr = str1->ptr;
end = str1->ptr + str1->len;
while (ptr < end && *ptr == *str2 && *str2 != '\0')
{
ptr++;
str2++;
}
return ptr >= end && *str2 == '\0';
}
void stix_copychars (stix_uch_t* dst, const stix_uch_t* src, stix_size_t len)
{
stix_size_t i;

9
stix/lib/test-005.st
View File

@ -195,7 +195,7 @@
}
## ----------------------------------------------------------------------
#method(#class) main
#method(#class) main22
{
|a b c d e f g h i j k sum |
@ -224,6 +224,13 @@
[self getTen] value dump.
}
#method(#class) main
{
| ffi |
ffi := FFI new: 'libc.so.6'.
ffi call: #printf withArgs: #((str '%d') (int 10) (long 20)).
ffi close.
}
}