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

added some builtin modules, but without many functions in them

Browse Source
This commit is contained in:
hyung-hwan
2018-02-15 15:36:15 +00:00
parent 2a0551df2d
commit 270a762e32
20 changed files with 1312 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
lib/Makefile.am
View File

@ -5,7 +5,12 @@ CPPFLAGS_ALL_COMMON = \
-I$(abs_srcdir) \
-I$(includedir)
if ENABLE_STATIC_MODULE
LDFLAGS_ALL_COMMON = -L$(abs_builddir)/../mod -L$(abs_builddir) -L$(libdir)
else
LDFLAGS_ALL_COMMON = -L$(abs_builddir) -L$(libdir)
endif
##################################################
# MAIN LIBRARY
@ -60,13 +65,29 @@ libhcl_la_SOURCES = \
libhcl_la_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
libhcl_la_LDFLAGS = $(LDFLAGS_LIB_COMMON)
libhcl_la_LIBADD = $(LIBADD_LIB_COMMON)
libhcl_la_DEPENDENCIES =
if ENABLE_STATIC_MODULE
libhcl_la_LIBADD += -lhcl-arr
libhcl_la_DEPENDENCIES += $(abs_builddir)/../mod/libhcl-arr.la
libhcl_la_LIBADD += -lhcl-dic
libhcl_la_DEPENDENCIES += $(abs_builddir)/../mod/libhcl-dic.la
libhcl_la_LIBADD += -lhcl-str
libhcl_la_DEPENDENCIES += $(abs_builddir)/../mod/libhcl-str.la
endif
bin_PROGRAMS = hcl
hcl_SOURCES = main.c
hcl_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
hcl_LDFLAGS = $(LDFLAGS_LIB_COMMON)
hcl_LDADD = $(LIBADD_LIB_COMMON) -lhcl #-ldyncall_s
if ENABLE_STATIC_MODULE
hcl_DEPENDENCIES = libhcl.la
endif
install-data-hook:

15
lib/Makefile.in
View File

@ -88,7 +88,13 @@ PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
@ENABLE_STATIC_MODULE_TRUE@am__append_1 = -lhcl-arr -lhcl-dic \
@ENABLE_STATIC_MODULE_TRUE@ -lhcl-str
@ENABLE_STATIC_MODULE_TRUE@am__append_2 = $(abs_builddir)/../mod/libhcl-arr.la \
@ENABLE_STATIC_MODULE_TRUE@ $(abs_builddir)/../mod/libhcl-dic.la \
@ENABLE_STATIC_MODULE_TRUE@ $(abs_builddir)/../mod/libhcl-str.la
bin_PROGRAMS = hcl$(EXEEXT)
@ENABLE_STATIC_MODULE_FALSE@hcl_DEPENDENCIES = $(am__DEPENDENCIES_2)
subdir = lib
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_cxx_namespace.m4 \
@ -136,7 +142,6 @@ am__installdirs = "$(DESTDIR)$(pkglibdir)" "$(DESTDIR)$(bindir)" \
LTLIBRARIES = $(pkglib_LTLIBRARIES)
am__DEPENDENCIES_1 =
am__DEPENDENCIES_2 = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1)
libhcl_la_DEPENDENCIES = $(am__DEPENDENCIES_2)
am_libhcl_la_OBJECTS = libhcl_la-bigint.lo libhcl_la-comp.lo \
libhcl_la-debug.lo libhcl_la-decode.lo libhcl_la-dic.lo \
libhcl_la-err.lo libhcl_la-exec.lo libhcl_la-gc.lo \
@ -376,7 +381,8 @@ CPPFLAGS_ALL_COMMON = \
-I$(abs_srcdir) \
-I$(includedir)
LDFLAGS_ALL_COMMON = -L$(abs_builddir) -L$(libdir)
@ENABLE_STATIC_MODULE_FALSE@LDFLAGS_ALL_COMMON = -L$(abs_builddir) -L$(libdir)
@ENABLE_STATIC_MODULE_TRUE@LDFLAGS_ALL_COMMON = -L$(abs_builddir)/../mod -L$(abs_builddir) -L$(libdir)
##################################################
# MAIN LIBRARY
@ -424,12 +430,13 @@ libhcl_la_SOURCES = \
libhcl_la_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
libhcl_la_LDFLAGS = $(LDFLAGS_LIB_COMMON)
libhcl_la_LIBADD = $(LIBADD_LIB_COMMON)
libhcl_la_LIBADD = $(LIBADD_LIB_COMMON) $(am__append_1)
libhcl_la_DEPENDENCIES = $(am__append_2)
hcl_SOURCES = main.c
hcl_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
hcl_LDFLAGS = $(LDFLAGS_LIB_COMMON)
hcl_LDADD = $(LIBADD_LIB_COMMON) -lhcl #-ldyncall_s
hcl_DEPENDENCIES = libhcl.la
@ENABLE_STATIC_MODULE_TRUE@hcl_DEPENDENCIES = libhcl.la
all: hcl-cfg.h
$(MAKE) $(AM_MAKEFLAGS) all-am

2
lib/bigint.c
View File

@ -281,7 +281,7 @@ int hcl_inttoooi (hcl_t* hcl, hcl_oop_t x, hcl_ooi_t* i)
hcl_oow_t w;
int n;
n = hcl_inttooow (hcl, x, &w);
n = hcl_inttooow(hcl, x, &w);
if (n < 0)
{
HCL_ASSERT (hcl, HCL_TYPE_MAX(hcl_ooi_t) + HCL_TYPE_MIN(hcl_ooi_t) == -1); /* assume 2's complement */

19
lib/comp.c
View File

@ -1378,6 +1378,8 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj)
}
else
{
hcl_oop_cons_t sdc;
if (HCL_BRANDOF(hcl, cdr) != HCL_BRAND_CONS)
{
/* (funname . 10) */
@ -1388,10 +1390,25 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj)
nargs = hcl_countcons(hcl, cdr);
if (nargs > MAX_CODE_PARAM)
{
/* TODO: change to syntax error */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) parameters in function call - %O", nargs, obj);
return -1;
}
sdc = hcl_getatsysdic(hcl, car);
if (sdc)
{
hcl_oop_word_t sdv;
sdv = (hcl_oop_word_t)HCL_CONS_CDR(sdc);
if (HCL_IS_PRIM(hcl, sdv))
{
if (nargs < sdv->slot[1] || nargs > sdv->slot[2])
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
"parameters count(%zd) mismatch in function call - %O - expecting %zu-%zu parameters", nargs, obj, sdv->slot[1], sdv->slot[2]);
return -1;
}
}
};
}
/* redundant cdr check is performed inside compile_object_list() */
PUSH_SUBCFRAME (hcl, COP_COMPILE_ARGUMENT_LIST, cdr);

16
lib/exec.c
View File

@ -158,7 +158,7 @@ static HCL_INLINE int prepare_to_alloc_pid (hcl_t* hcl)
#if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_FATAL, "Processor - too many processes\n");
#endif
hcl_seterrnum (hcl, HCL_EPFULL);
hcl_seterrbfmt (hcl, HCL_EPFULL, "maximum number(%zd) of processes reached", HCL_SMOOI_MAX);
return -1;
}
@ -227,7 +227,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
stksize = HCL_TYPE_MAX(hcl_oow_t) - HCL_PROCESS_NAMED_INSTVARS;
hcl_pushtmp (hcl, (hcl_oop_t*)&c);
proc = (hcl_oop_process_t)hcl_allocoopobj (hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize);
proc = (hcl_oop_process_t)hcl_allocoopobj (hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize);
hcl_poptmp (hcl);
if (!proc) return HCL_NULL;
@ -348,6 +348,7 @@ static HCL_INLINE int chain_into_processor (hcl_t* hcl, hcl_oop_process_t proc,
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_FATAL, "Processor - too many process\n");
#endif
hcl_seterrnum (hcl, HCL_EPFULL);
hcl_seterrbfmt (hcl, HCL_EPFULL, "maximum number(%zd) of processes reached", HCL_SMOOI_MAX);
return -1;
}
@ -1878,10 +1879,6 @@ static int execute (hcl_t* hcl)
break;
}
/* TODO:
case HCL_CODE_MAKE_BYTEARRAY:
case HCL_CODE_POP_INTO_BYTEARRAY:
*/
/* -------------------------------------------------------- */
case BCODE_DUP_STACKTOP:
@ -2011,16 +2008,13 @@ static int execute (hcl_t* hcl)
case HCL_CODE_RETURN_FROM_BLOCK:
LOG_INST_0 (hcl, "return_from_block");
/*
// HCL_ASSERT(HCL_CLASSOF(hcl, hcl->active_context) == hcl->_block_context);
*/
HCL_ASSERT(hcl, HCL_IS_CONTEXT(hcl, hcl->active_context));
if (hcl->active_context == hcl->processor->active->initial_context)
{
/* the active context to return from is an initial context of
* the active process. this process must have been created
* over a block using the newProcess method. let's terminate
* the process. */
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
terminate_process (hcl, hcl->processor->active);
}
@ -2197,7 +2191,7 @@ oops:
/* TODO: anything to do here? */
if (hcl->processor->active != hcl->nil_process)
{
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TERMINATING ACTIVE PROCESS ... = %zu\n", inst_counter);
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TERMINATING ACTIVE PROCESS ... = %zd\n", HCL_OOP_TO_SMOOI(hcl->processor->active->id));
terminate_process (hcl, hcl->processor->active);
}
return -1;

16
lib/hcl.c
View File

@ -402,8 +402,6 @@ void hcl_freemem (hcl_t* hcl, void* ptr)
}
/* -------------------------------------------------------------------------- */
#define MOD_PREFIX "hcl_mod_"
@ -411,13 +409,9 @@ void hcl_freemem (hcl_t* hcl, void* ptr)
#if defined(HCL_ENABLE_STATIC_MODULE)
/*#include "../mod/_array.h"*/
static int hcl_mod_fake (hcl_t* hcl, hcl_mod_t* mod)
{
hcl_seterrbfmt (hcl, HCL_EPERM, "not allowed to load ___fake___ module");
return -1;
}
#include "../mod/_arr.h"
#include "../mod/_dic.h"
#include "../mod/_str.h"
static struct
{
@ -426,7 +420,9 @@ static struct
}
static_modtab[] =
{
{ "___fake___", hcl_mod_fake },
{ "arr", hcl_mod_arr },
{ "dic", hcl_mod_dic },
{ "str", hcl_mod_str }
};
#endif

1
lib/hcl.h
View File

@ -1250,6 +1250,7 @@ typedef enum hcl_concode_t hcl_concode_t;
#define HCL_IS_PBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT)
#define HCL_IS_NBIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT)
#define HCL_IS_BIGINT(hcl,v) (HCL_OOP_IS_POINTER(v) && (HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PBIGINT || HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_NBIGINT))
#define HCL_IS_STRING(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_STRING)
#define HCL_CONS_CAR(v) (((hcl_cons_t*)(v))->car)
#define HCL_CONS_CDR(v) (((hcl_cons_t*)(v))->cdr)

57
lib/prim.c
View File

@ -98,7 +98,7 @@ start_over:
static hcl_pfrc_t pf_log (hcl_t* hcl, hcl_ooi_t nargs)
{
/* TODO: accept log level */
hcl_oop_t msg, level;
hcl_oop_t msg;
hcl_oow_t mask;
hcl_ooi_t k;
@ -421,58 +421,3 @@ int hcl_addbuiltinprims (hcl_t* hcl)
return 0;
}
/* ------------------------------------------------------------------------- */
static hcl_pfrc_t pf_hello (hcl_t* hcl, hcl_ooi_t nargs)
{
return pf_log(hcl, nargs);
}
static int walker (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_cons_t pair, void* ctx)
{
HCL_DEBUG2 (hcl, "walker ===> %O =====> %O\n", HCL_CONS_CAR(pair), HCL_CONS_CDR(pair));
return 0;
}
static hcl_pfrc_t pf_walk (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_oop_t arg;
arg = HCL_STACK_GETARG(hcl, nargs, 0);
if (!HCL_IS_DIC(hcl,arg))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not a dictionary - %O", arg);
return HCL_PF_FAILURE;
}
hcl_walkdic (hcl, (hcl_oop_dic_t)arg, walker, HCL_NULL);
HCL_STACK_SETRET (hcl, nargs, hcl->_true);
return HCL_PF_SUCCESS;
}
static hcl_pfinfo_t pfinfos[] =
{
{ { 'h','e','l','l','o','\0' }, 0, { pf_hello, 1, 1 } },
{ { 'w','a','l','k','\0' }, 0, { pf_walk, 1, 1 } }
};
/* ------------------------------------------------------------------------ */
static hcl_pfbase_t* query (hcl_t* hcl, hcl_mod_t* mod, const hcl_ooch_t* name, hcl_oow_t namelen)
{
return hcl_findpfbase (hcl, pfinfos, HCL_COUNTOF(pfinfos), name, namelen);
}
static void unload (hcl_t* hcl, hcl_mod_t* mod)
{
}
int hcl_mod_fake_test (hcl_t* hcl, hcl_mod_t* mod)
{
mod->query = query;
mod->unload = unload;
mod->ctx = HCL_NULL;
return 0;
}