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

wip - full oop - ignition ok - able to create bootstrapping classes. - able to instantiate objects
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-03-08 00:23:52 +09:00
parent 874d0c7962
commit 9cd1f90d5d
11 changed files with 443 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
bin/main.c
View File

@ -264,8 +264,9 @@ static int handle_dbgopt (hcl_t* hcl, const hcl_bch_t* str)
cm = hcl_find_bchar_in_bcstr(flt, ',');
len = cm? (cm - flt): hcl_count_bcstr(flt);
if (hcl_comp_bchars_bcstr(flt, len, "gc") == 0) dbgopt |= HCL_TRAIT_DEBUG_GC;
else if (hcl_comp_bchars_bcstr(flt, len, "bigint") == 0) dbgopt |= HCL_TRAIT_DEBUG_BIGINT;
if (len == 0) continue;
else if (hcl_comp_bchars_bcstr(flt, len, "gc") == 0) dbgopt |= HCL_TRAIT_DEBUG_GC;
else if (hcl_comp_bchars_bcstr(flt, len, "bigint") == 0) dbgopt |= HCL_TRAIT_DEBUG_BIGINT;
else
{
fprintf (stderr, "ERROR: unknown debug option value - %.*s\n", (int)len, flt);

102
lib/exec.c
View File

@ -25,12 +25,6 @@
#include "hcl-prv.h"
#define PROC_STATE_RUNNING 3
#define PROC_STATE_WAITING 2
#define PROC_STATE_RUNNABLE 1
#define PROC_STATE_SUSPENDED 0
#define PROC_STATE_TERMINATED -1
static const char* io_type_str[] =
{
"input",
@ -563,7 +557,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
////////////////////
#endif
proc->state = HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED);
proc->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED);
/* assign a process id to the process */
alloc_pid (hcl, proc);
@ -624,8 +618,8 @@ static HCL_INLINE void wake_process (hcl_t* hcl, hcl_oop_process_t proc)
#endif
/* activate the given process */
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
proc->state = HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING);
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE));
proc->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING);
hcl->processor->active = proc;
LOAD_ACTIVE_SP(hcl);
@ -644,8 +638,8 @@ static void switch_to_process (hcl_t* hcl, hcl_oop_process_t proc, int new_state
HCL_ASSERT (hcl, hcl->processor->active != proc);
/* the new process must be in the runnable state */
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_WAITING));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE) ||
proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_WAITING));
sleep_active_process (hcl, new_state_for_old_active);
wake_process (hcl, proc);
@ -663,7 +657,7 @@ static HCL_INLINE void switch_to_process_from_nil (hcl_t* hcl, hcl_oop_process_t
static HCL_INLINE hcl_oop_process_t find_next_runnable_process (hcl_t* hcl)
{
hcl_oop_process_t nrp;
HCL_ASSERT (hcl, hcl->processor->active->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING));
HCL_ASSERT (hcl, hcl->processor->active->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING));
nrp = hcl->processor->active->ps.next;
if ((hcl_oop_t)nrp == hcl->_nil) nrp = hcl->processor->runnable.first;
return nrp;
@ -673,7 +667,7 @@ static HCL_INLINE void switch_to_next_runnable_process (hcl_t* hcl)
{
hcl_oop_process_t nrp;
nrp = find_next_runnable_process (hcl);
if (nrp != hcl->processor->active) switch_to_process (hcl, nrp, PROC_STATE_RUNNABLE);
if (nrp != hcl->processor->active) switch_to_process (hcl, nrp, HCL_PROCESS_STATE_RUNNABLE);
}
static HCL_INLINE void chain_into_processor (hcl_t* hcl, hcl_oop_process_t proc, int new_state)
@ -686,8 +680,8 @@ static HCL_INLINE void chain_into_processor (hcl_t* hcl, hcl_oop_process_t proc,
/*HCL_ASSERT (hcl, (hcl_oop_t)proc->ps.prev == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->ps.next == hcl->_nil);*/
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED));
HCL_ASSERT (hcl, new_state == PROC_STATE_RUNNABLE || new_state == PROC_STATE_RUNNING);
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED));
HCL_ASSERT (hcl, new_state == HCL_PROCESS_STATE_RUNNABLE || new_state == HCL_PROCESS_STATE_RUNNING);
#if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG,
@ -720,9 +714,9 @@ static HCL_INLINE void unchain_from_processor (hcl_t* hcl, hcl_oop_process_t pro
hcl_ooi_t suspended_count;
hcl_ooi_t total_count;
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING) ||
proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE) ||
proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED));
HCL_ASSERT (hcl, proc->state != HCL_SMOOI_TO_OOP(new_state));
@ -730,7 +724,7 @@ static HCL_INLINE void unchain_from_processor (hcl_t* hcl, hcl_oop_process_t pro
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - process[%zd] %hs->%hs in unchain_from_processor\n", HCL_OOP_TO_SMOOI(proc->id), proc_state_to_string(HCL_OOP_TO_SMOOI(proc->state)), proc_state_to_string(HCL_OOP_TO_SMOOI(new_state)));
#endif
if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED))
if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED))
{
suspended_count = HCL_OOP_TO_SMOOI(hcl->processor->suspended.count);
HCL_ASSERT (hcl, suspended_count > 0);
@ -748,7 +742,7 @@ static HCL_INLINE void unchain_from_processor (hcl_t* hcl, hcl_oop_process_t pro
if (runnable_count == 0) hcl->processor->active = hcl->nil_process;
}
if (new_state == PROC_STATE_TERMINATED)
if (new_state == HCL_PROCESS_STATE_TERMINATED)
{
/* do not chain it to the suspended process list as it's being terminated */
proc->ps.prev = (hcl_oop_process_t)hcl->_nil;
@ -761,7 +755,7 @@ static HCL_INLINE void unchain_from_processor (hcl_t* hcl, hcl_oop_process_t pro
else
{
/* append to the suspended process list */
HCL_ASSERT (hcl, new_state == PROC_STATE_SUSPENDED);
HCL_ASSERT (hcl, new_state == HCL_PROCESS_STATE_SUSPENDED);
suspended_count = HCL_OOP_TO_SMOOI(hcl->processor->suspended.count);
HCL_APPEND_TO_OOP_LIST (hcl, &hcl->processor->suspended, hcl_oop_process_t, proc, ps);
@ -921,8 +915,8 @@ static HCL_INLINE void reset_process_stack_pointers (hcl_t* hcl, hcl_oop_process
static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc)
{
if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE))
if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING) ||
proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE))
{
/* RUNNING/RUNNABLE ---> TERMINATED */
#if defined(HCL_DEBUG_VM_PROCESSOR)
@ -934,13 +928,13 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc)
hcl_oop_process_t nrp;
/* terminating the active process */
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING));
nrp = find_next_runnable_process(hcl);
STORE_ACTIVE_SP (hcl); /* commit the stack pointer before termination */
unchain_from_processor (hcl, proc, PROC_STATE_TERMINATED);
unchain_from_processor (hcl, proc, HCL_PROCESS_STATE_TERMINATED);
reset_process_stack_pointers (hcl, proc); /* invalidate the process stack */
proc->current_context = proc->initial_context; /* not needed but just in case */
/* a runnable or running process must not be chanined to the
@ -968,29 +962,29 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc)
else
{
/* there are other processes to schedule */
switch_to_process (hcl, nrp, PROC_STATE_TERMINATED);
switch_to_process (hcl, nrp, HCL_PROCESS_STATE_TERMINATED);
}
}
else
{
/* termiante a runnable process which is not an actively running process */
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
unchain_from_processor (hcl, proc, PROC_STATE_TERMINATED);
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE));
unchain_from_processor (hcl, proc, HCL_PROCESS_STATE_TERMINATED);
reset_process_stack_pointers (hcl, proc); /* invalidate the process stack */
}
/* when terminated, clear it from the pid table and set the process id to a negative number */
free_pid (hcl, proc);
}
else if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED))
else if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED))
{
/* SUSPENDED ---> TERMINATED */
#if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - process[%zd] %hs->TERMINATED in terminate_process\n", HCL_OOP_TO_SMOOI(proc->id), proc_state_to_string(HCL_OOP_TO_SMOOI(proc->state)));
#endif
/*proc->state = HCL_SMOOI_TO_OOP(PROC_STATE_TERMINATED);*/
unchain_from_processor (hcl, proc, PROC_STATE_TERMINATED);
/*proc->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_TERMINATED);*/
unchain_from_processor (hcl, proc, HCL_PROCESS_STATE_TERMINATED);
reset_process_stack_pointers (hcl, proc); /* invalidate the process stack */
if ((hcl_oop_t)proc->sem != hcl->_nil)
@ -1026,7 +1020,7 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc)
free_pid (hcl, proc);
}
#if 0
else if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_WAITING))
else if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_WAITING))
{
/* WAITING ---> TERMINATED */
/* TODO: */
@ -1052,7 +1046,7 @@ static void terminate_all_processes (hcl_t* hcl)
static void resume_process (hcl_t* hcl, hcl_oop_process_t proc)
{
if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED))
if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED))
{
/* SUSPENDED ---> RUNNABLE */
/*HCL_ASSERT (hcl, (hcl_oop_t)proc->ps.prev == hcl->_nil);
@ -1064,24 +1058,24 @@ static void resume_process (hcl_t* hcl, hcl_oop_process_t proc)
/* don't switch to this process. just change the state to RUNNABLE.
* process switching should be triggerd by the process scheduler. */
chain_into_processor (hcl, proc, PROC_STATE_RUNNABLE);
chain_into_processor (hcl, proc, HCL_PROCESS_STATE_RUNNABLE);
/*proc->current_context = proc->initial_context;*/
}
#if 0
else if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE))
else if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE))
{
/* RUNNABLE ---> RUNNING */
/* TODO: should i allow this? */
HCL_ASSERT (hcl, hcl->processor->active != proc);
switch_to_process (hcl, proc, PROC_STATE_RUNNABLE);
switch_to_process (hcl, proc, HCL_PROCESS_STATE_RUNNABLE);
}
#endif
}
static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc)
{
if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE))
if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING) ||
proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE))
{
/* RUNNING/RUNNABLE ---> SUSPENDED */
@ -1099,8 +1093,8 @@ static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc)
if (nrp == proc)
{
/* no runnable process after suspension */
sleep_active_process (hcl, PROC_STATE_RUNNABLE);
unchain_from_processor (hcl, proc, PROC_STATE_SUSPENDED);
sleep_active_process (hcl, HCL_PROCESS_STATE_RUNNABLE);
unchain_from_processor (hcl, proc, HCL_PROCESS_STATE_SUSPENDED);
/* the last running/runnable process has been unchained
* from the processor and set to SUSPENDED. the active
@ -1117,21 +1111,21 @@ static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc)
* done in unchain_from_processor(). the state of the active
* process is somewhat wrong for a short period of time until
* switch_to_process() has changed the active process. */
unchain_from_processor (hcl, proc, PROC_STATE_SUSPENDED);
unchain_from_processor (hcl, proc, HCL_PROCESS_STATE_SUSPENDED);
HCL_ASSERT (hcl, hcl->processor->active != hcl->nil_process);
switch_to_process (hcl, nrp, PROC_STATE_SUSPENDED);
switch_to_process (hcl, nrp, HCL_PROCESS_STATE_SUSPENDED);
}
}
else
{
unchain_from_processor (hcl, proc, PROC_STATE_SUSPENDED);
unchain_from_processor (hcl, proc, HCL_PROCESS_STATE_SUSPENDED);
}
}
}
static void yield_process (hcl_t* hcl, hcl_oop_process_t proc)
{
if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING))
if (proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING))
{
/* RUNNING --> RUNNABLE */
@ -1147,7 +1141,7 @@ static void yield_process (hcl_t* hcl, hcl_oop_process_t proc)
#if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - process[%zd] %hs->RUNNABLE in yield_process\n", HCL_OOP_TO_SMOOI(proc->id), proc_state_to_string(HCL_OOP_TO_SMOOI(proc->state)));
#endif
switch_to_process (hcl, nrp, PROC_STATE_RUNNABLE);
switch_to_process (hcl, nrp, HCL_PROCESS_STATE_RUNNABLE);
}
}
}
@ -1803,7 +1797,7 @@ static void _signal_io_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem)
* it uses wake_process() instead of
* switch_to_process() as there is no running
* process at this moment */
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc == hcl->processor->runnable.first);
#if 0
@ -2580,7 +2574,7 @@ static hcl_oop_process_t start_initial_process (hcl_t* hcl, hcl_oop_context_t ct
if (HCL_UNLIKELY(!proc)) return HCL_NULL;
/* skip RUNNABLE and go to RUNNING */
chain_into_processor(hcl, proc, PROC_STATE_RUNNING);
chain_into_processor(hcl, proc, HCL_PROCESS_STATE_RUNNING);
hcl->processor->active = proc;
/* do something that resume_process() would do with less overhead */
@ -2702,7 +2696,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl)
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - switching to a process[%zd] while no process is active - total runnables %zd\n", HCL_OOP_TO_SMOOI(proc->id), HCL_OOP_TO_SMOOI(hcl->processor->runnable.count));
#endif
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc == hcl->processor->runnable.last); /* resume_process() appends to the runnable list */
#if 0
wake_process (hcl, proc); /* switch to running */
@ -2813,7 +2807,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl)
if (hcl->processor->active == hcl->nil_process && (hcl_oop_t)proc != hcl->_nil)
{
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc == hcl->processor->runnable.first);
switch_to_process_from_nil (hcl, proc);
}
@ -2857,7 +2851,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl)
proc = signal_semaphore(hcl, hcl->sem_gcfin);
if ((hcl_oop_t)proc != hcl->_nil)
{
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc == hcl->processor->runnable.first);
hcl->_system->cvar[2] = hcl->_true; /* set gcfin_should_exit in System to true. if the postion of the class variable changes, the index must get changed, too. */
switch_to_process_from_nil (hcl, proc); /* sechedule the gc finalizer process */
@ -3338,7 +3332,7 @@ static int execute (hcl_t* hcl)
case HCL_CODE_PUSH_IVAR_7:
b1 = bcode & 0x7; /* low 3 bits */
push_ivar:
LOG_INST_2 (hcl, "push_ivar %zu ; [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
LOG_INST_2 (hcl, "push_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff);
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1]);
@ -3359,7 +3353,7 @@ static int execute (hcl_t* hcl)
case HCL_CODE_STORE_INTO_IVAR_7:
b1 = bcode & 0x7; /* low 3 bits */
store_instvar:
LOG_INST_2 (hcl, "store_into_ivar %zu ; [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
LOG_INST_2 (hcl, "store_into_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff);
((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl);
@ -3379,7 +3373,7 @@ static int execute (hcl_t* hcl)
case HCL_CODE_POP_INTO_IVAR_7:
b1 = bcode & 0x7; /* low 3 bits */
pop_into_ivar:
LOG_INST_2 (hcl, "pop_into_ivar %zu ; [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
LOG_INST_2 (hcl, "pop_into_ivar %zu ## [%zd]", b1, HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff));
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff);
((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl);
@ -4832,7 +4826,7 @@ hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!newprc)) return HCL_PF_FAILURE;
chain_into_processor (hcl, newprc, PROC_STATE_RUNNABLE);
chain_into_processor (hcl, newprc, HCL_PROCESS_STATE_RUNNABLE);
HCL_STACK_SETRET (hcl, nargs, (hcl_oop_t)newprc);
return HCL_PF_SUCCESS;

319
lib/gc.c
View File

@ -111,6 +111,7 @@ static struct
struct kernel_class_info_t
{
const hcl_bch_t* name;
int class_brand;
int class_flags;
int class_num_classvars;
@ -137,7 +138,7 @@ static kernel_class_info_t kernel_classes[] =
* SmallIntger
* -------------------------------------------------------------- */
{ "Apex",
{ "Apex", 0,
0,
0,
0,
@ -145,7 +146,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_apex) },
{ "UndefinedObject",
{ "UndefinedObject", HCL_BRAND_UNDEF,
0,
0,
0,
@ -154,7 +155,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, c_undefobj) },
#define KCI_CLASS 2 /* index to the Class entry in this table */
{ "Class",
{ "Class", HCL_BRAND_CLASS,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CLASS_NAMED_INSTVARS,
@ -172,7 +173,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, _interface) },
#endif
{ "Object",
{ "Object", 0,
0,
0,
0,
@ -180,7 +181,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_object) },
{ "String",
{ "String", HCL_BRAND_STRING,
0,
0,
0,
@ -188,7 +189,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_string) },
{ "Symbol",
{ "Symbol", HCL_BRAND_SYMBOL,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
@ -196,7 +197,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_symbol) },
{ "Array",
{ "Array", HCL_BRAND_ARRAY,
0,
0,
0,
@ -204,7 +205,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_array) },
{ "ByteArray",
{ "ByteArray", HCL_BRAND_BYTE_ARRAY,
0,
0,
0,
@ -212,7 +213,10 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_BYTE,
HCL_OFFSETOF(hcl_t, c_byte_array) },
{ "SymbolTable",
/* A special incarnation of a dictionary that allows only a symbol as a value.
* The value in bucket is a symbol while the value in a normal dictionary is a
* pair(cons) that contains a key and a value. */
{ "SymbolTable", HCL_BRAND_DIC, /* TODO: make this a special child class of Dictionary?? */
0,
0,
HCL_DIC_NAMED_INSTVARS,
@ -220,7 +224,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_symtab) },
{ "Dictionary",
{ "Dictionary", HCL_BRAND_DIC,
0,
0,
HCL_DIC_NAMED_INSTVARS,
@ -228,7 +232,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_dictionary) },
{ "Cons",
{ "Cons", HCL_BRAND_CONS,
0,
0,
HCL_CONS_NAMED_INSTVARS,
@ -254,7 +258,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, c_pool_dictionary) },
#endif
{ "MethodDictionary",
{ "MethodDictionary", 0,
0,
0,
HCL_DIC_NAMED_INSTVARS,
@ -280,7 +284,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, c_methsig) },
#endif
{ "CompiledBlock",
{ "CompiledBlock", 0,
0,
0,
HCL_BLOCK_NAMED_INSTVARS,
@ -288,7 +292,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block) },
{ "MethodContext",
{ "MethodContext", 0,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,
@ -296,7 +300,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_context) },
{ "BlockContext",
{ "BlockContext", 0,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,
@ -304,7 +308,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block_context) },
{ "Process",
{ "Process", HCL_BRAND_PROCESS,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_PROCESS_NAMED_INSTVARS,
@ -312,7 +316,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process) },
{ "Semaphore",
{ "Semaphore", HCL_BRAND_SEMAPHORE,
0,
0,
HCL_SEMAPHORE_NAMED_INSTVARS,
@ -320,7 +324,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore) },
{ "SemaphoreGroup",
{ "SemaphoreGroup", HCL_BRAND_SEMAPHORE_GROUP,
0,
0,
HCL_SEMAPHORE_GROUP_NAMED_INSTVARS,
@ -328,7 +332,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore_group) },
{ "ProcessScheduler",
{ "ProcessScheduler", HCL_BRAND_PROCESS_SCHEDULER,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_PROCESS_SCHEDULER_NAMED_INSTVARS,
@ -336,7 +340,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process_scheduler) },
{ "Error",
{ "Error", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
@ -344,7 +348,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_error) },
{ "True",
{ "True", HCL_BRAND_TRUE,
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0,
0,
@ -352,7 +356,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_true) },
{ "False",
{ "False", HCL_BRAND_FALSE,
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0,
0,
@ -363,7 +367,7 @@ static kernel_class_info_t kernel_classes[] =
/* TOOD: what is a proper spec for Character and SmallInteger?
* If the fixed part is 0, its instance must be an object of 0 payload fields.
* Does this make sense? */
{ "Character",
{ "Character", HCL_BRAND_CHARACTER,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
@ -371,7 +375,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_character) },
{ "SmallInteger",
{ "SmallInteger", HCL_BRAND_SMOOI,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
@ -379,7 +383,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_integer) },
{ "LargePositiveInteger",
{ "LargePositiveInteger", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
@ -387,7 +391,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_positive_integer) },
{ "LargeNegativeInteger",
{ "LargeNegativeInteger", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
@ -395,7 +399,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_negative_integer) },
{ "FixedPointDecimal",
{ "FixedPointDecimal", HCL_BRAND_FPDEC,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_FPDEC_NAMED_INSTVARS,
@ -403,7 +407,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_fixed_point_decimal) },
{ "SmallPointer",
{ "SmallPointer", HCL_BRAND_SMPTR,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
@ -411,7 +415,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_pointer) },
{ "LargePointer",
{ "LargePointer", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
1, /* #word(1) */
@ -419,7 +423,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_WORD,
HCL_OFFSETOF(hcl_t, c_large_pointer) },
{ "System",
{ "System", 0,
0,
5, /* asyncsg, gcfin_sem, gcfin_should_exit, ossig_pid, shr */
0,
@ -585,9 +589,9 @@ static HCL_INLINE void gc_ms_mark_object (hcl_t* hcl, hcl_oop_t oop)
if (!HCL_OOP_IS_POINTER(oop) || HCL_OBJ_GET_FLAGS_MOVED(oop)) return; /* non-pointer or already marked */
HCL_OBJ_SET_FLAGS_MOVED(oop, 1); /* mark */
HCL_ASSERT (hcl, hcl->gci.stack.len < hcl->gci.stack.capa);
HCL_ASSERT (hcl, hcl->gci.stack.len < hcl->gci.stack.capa);
hcl->gci.stack.ptr[hcl->gci.stack.len++] = oop; /* push */
if (hcl->gci.stack.len > hcl->gci.stack.max) hcl->gci.stack.max = hcl->gci.stack.len;
if (hcl->gci.stack.len > hcl->gci.stack.max) hcl->gci.stack.max = hcl->gci.stack.len;
}
static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl)
@ -607,7 +611,7 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl)
/* is it really better to use a flag bit in the header to
* determine that it is an instance of process? */
/* if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) */
if (HCL_OBJ_GET_FLAGS_BRAND(oop) == HCL_BRAND_PROCESS)
if (HCL_OBJ_GET_FLAGS_BRAND(oop) == HCL_BRAND_PROCESS) /* TODO: use a class or make this a special bit???*/
{
hcl_oop_process_t proc;
@ -622,6 +626,7 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl)
/* stack */
ll = HCL_OOP_TO_SMOOI(proc->sp);
HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS));
for (i = 0; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]);
/* exception stack */
@ -1138,7 +1143,7 @@ hcl_oop_t hcl_shallowcopy (hcl_t* hcl, hcl_oop_t oop)
* BOOTSTRAPPER
* ----------------------------------------------------------------------- */
static hcl_oop_class_t alloc_kernel_class (hcl_t* hcl, int class_flags, hcl_oow_t num_classvars, hcl_oow_t spec)
static hcl_oop_class_t alloc_kernel_class (hcl_t* hcl, int class_flags, hcl_oow_t num_classvars, hcl_oow_t spec, int ibrand)
{
hcl_oop_class_t c;
#if 0
@ -1159,6 +1164,9 @@ static hcl_oop_class_t alloc_kernel_class (hcl_t* hcl, int class_flags, hcl_oow_
HCL_OBJ_SET_CLASS (c, (hcl_oop_t)hcl->c_class);
c->spec = HCL_SMOOI_TO_OOP(spec);
c->selfspec = HCL_SMOOI_TO_OOP(HCL_CLASS_SELFSPEC_MAKE(num_classvars, 0, class_flags));
c->nivars = HCL_SMOOI_TO_OOP(0); /* TODO: encode it into spec? */
c->nivars_super = HCL_SMOOI_TO_OOP(0); /* TODO: encode it into spec? */
c->ibrand = HCL_SMOOI_TO_OOP(ibrand);
return c;
}
@ -1180,16 +1188,25 @@ static int ignite_1 (hcl_t* hcl)
* The instance of Class can have indexed instance variables
* which are actually class variables.
* -------------------------------------------------------------- */
hcl->c_class = alloc_kernel_class(
hcl, kernel_classes[KCI_CLASS].class_flags,
kernel_classes[KCI_CLASS].class_num_classvars,
HCL_CLASS_SPEC_MAKE(kernel_classes[KCI_CLASS].class_spec_named_instvars,
kernel_classes[KCI_CLASS].class_spec_flags,
kernel_classes[KCI_CLASS].class_spec_indexed_type));
if (!hcl->c_class) return -1;
if (HCL_LIKELY(!hcl->c_class))
{
hcl->c_class = alloc_kernel_class(
hcl, kernel_classes[KCI_CLASS].class_flags,
kernel_classes[KCI_CLASS].class_num_classvars,
HCL_CLASS_SPEC_MAKE(kernel_classes[KCI_CLASS].class_spec_named_instvars,
kernel_classes[KCI_CLASS].class_spec_flags,
kernel_classes[KCI_CLASS].class_spec_indexed_type),
kernel_classes[KCI_CLASS].class_brand);
if (HCL_UNLIKELY(!hcl->c_class))
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to allocate %hs - %js", kernel_classes[KCI_CLASS].name, orgmsg);
return -1;
}
HCL_ASSERT (hcl, HCL_OBJ_GET_CLASS(hcl->c_class) == HCL_NULL);
HCL_OBJ_SET_CLASS (hcl->c_class, (hcl_oop_t)hcl->c_class);
HCL_ASSERT (hcl, HCL_OBJ_GET_CLASS(hcl->c_class) == HCL_NULL);
HCL_OBJ_SET_CLASS (hcl->c_class, (hcl_oop_t)hcl->c_class);
}
for (i = 0; i < HCL_COUNTOF(kernel_classes); i++)
{
@ -1202,17 +1219,21 @@ static int ignite_1 (hcl_t* hcl)
kernel_classes[i].class_num_classvars,
HCL_CLASS_SPEC_MAKE(kernel_classes[i].class_spec_named_instvars,
kernel_classes[i].class_spec_flags,
kernel_classes[i].class_spec_indexed_type));
if (!tmp) return -1;
kernel_classes[i].class_spec_indexed_type),
kernel_classes[i].class_brand);
if (HCL_UNLIKELY(!tmp))
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to allocate %hs - %js", kernel_classes[i].name, orgmsg);
return -1;
}
*(hcl_oop_class_t*)((hcl_uint8_t*)hcl + kernel_classes[i].offset) = tmp;
}
HCL_OBJ_SET_CLASS (hcl->_nil, (hcl_oop_t)hcl->c_undefobj);
#if 0
/* an instance of a method class stores byte codes in the trailer space.
* unlike other classes with trailer size set, the size of the trailer
* space is not really determined by the traailer size set in the class.
* space is not really determined by the trailer size set in the class.
* the compiler determines the actual size of the trailer space depending
* on the byte codes generated. i should set the following fields to avoid
* confusion at the GC phase. */
@ -1231,9 +1252,17 @@ static int ignite_2 (hcl_t* hcl)
#endif
/* Create 'true' and 'false objects */
hcl->_true = hcl_instantiate(hcl, hcl->c_true, HCL_NULL, 0);
hcl->_false = hcl_instantiate(hcl, hcl->c_false, HCL_NULL, 0);
if (HCL_UNLIKELY(!hcl->c_true) || HCL_UNLIKELY(!hcl->c_false)) return -1;
if (HCL_LIKELY(!hcl->_true))
{
hcl->_true = hcl_instantiate(hcl, hcl->c_true, HCL_NULL, 0);
if (HCL_UNLIKELY(!hcl->_true)) goto oops;
}
if (HCL_LIKELY(!hcl->_false))
{
hcl->_false = hcl_instantiate(hcl, hcl->c_false, HCL_NULL, 0);
if (HCL_UNLIKELY(!hcl->_false)) goto oops;
}
#if 0
/* Prevent the object instations in the permspace.
@ -1256,52 +1285,100 @@ static int ignite_2 (hcl_t* hcl)
hcl->igniting = 0;
#endif
/* Create the symbol table */
tmp = hcl_instantiate(hcl, hcl->c_symtab, HCL_NULL, 0);
if (HCL_UNLIKELY(!tmp)) return -1;
hcl->symtab = (hcl_oop_dic_t)tmp;
if (HCL_LIKELY(!hcl->symtab))
{
/* Create the symbol table - values in the bucket are limited to symbols only */
tmp = hcl_instantiate(hcl, hcl->c_symtab, HCL_NULL, 0);
if (HCL_UNLIKELY(!tmp)) goto oops;
hcl->symtab = (hcl_oop_dic_t)tmp;
hcl->symtab->tally = HCL_SMOOI_TO_OOP(0);
}
hcl->symtab->tally = HCL_SMOOI_TO_OOP(0);
/* It's important to assign the result of hcl_instantiate() to a temporary
* variable first and then assign it to hcl->symtab->bucket.
* The pointer 'hcl->symtab; can change in hcl_instantiate() and the
* target address of assignment may get set before hcl_instantiate()
* is called. */
tmp = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, hcl->option.dfl_symtab_size);
if (HCL_UNLIKELY(!tmp)) return -1;
hcl->symtab->bucket = (hcl_oop_oop_t)tmp;
if (HCL_LIKELY(hcl->symtab->bucket == hcl->_nil))
{
/* It's important to assign the result of hcl_instantiate() to a temporary
* variable first and then assign it to hcl->symtab->bucket.
* The pointer 'hcl->symtab; can change in hcl_instantiate() and the
* target address of assignment may get set before hcl_instantiate()
* is called. */
HCL_ASSERT (hcl, hcl->option.dfl_symtab_size > 0);
tmp = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, hcl->option.dfl_symtab_size);
if (HCL_UNLIKELY(!tmp)) goto oops; /* TODO: delete hcl->symtab instad of this separate initialization of the bucket??? */
hcl->symtab->bucket = (hcl_oop_oop_t)tmp;
}
#if 0
/* Create the system dictionary */
tmp = (hcl_oop_t)hcl_makensdic(hcl, hcl->_namespace, hcl->option.dfl_sysdic_size);
if (!tmp) return -1;
hcl->sysdic = (hcl_oop_nsdic_t)tmp;
#else
if (HCL_LIKELY(!hcl->sysdic))
{
tmp = hcl_instantiate(hcl, hcl->c_dictionary, HCL_NULL, 0);
if (HCL_UNLIKELY(!tmp)) goto oops;
hcl->sysdic = (hcl_oop_dic_t)tmp;
hcl->sysdic->tally = HCL_SMOOI_TO_OOP(0);
}
if (HCL_LIKELY(hcl->sysdic->bucket == hcl->_nil))
{
/* It's important to assign the result of hcl_instantiate() to a temporary
* variable first and then assign it to hcl->symtab->bucket.
* The pointer 'hcl->symtab; can change in hcl_instantiate() and the
* target address of assignment may get set before hcl_instantiate()
* is called. */
tmp = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, hcl->option.dfl_sysdic_size);
if (HCL_UNLIKELY(!tmp)) goto oops;
hcl->sysdic->bucket = (hcl_oop_oop_t)tmp;
}
#endif
#if 0
hcl->igniting = old_igniting; /* back to the permspace */
#endif
/* Create a nil process used to simplify nil check in GC.
* only accessible by VM. not exported via the global dictionary. */
tmp = (hcl_oop_t)hcl_instantiate(hcl, hcl->c_process, HCL_NULL, 0);
if (HCL_UNLIKELY(!tmp)) return -1;
hcl->nil_process = (hcl_oop_process_t)tmp;
hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->id = HCL_SMOOI_TO_OOP(-1);
#if 0
hcl->nil_process->perr = HCL_ERROR_TO_OOP(HCL_ENOERR);
hcl->nil_process->perrmsg = hcl->_nil;
#endif
if (HCL_LIKELY(!hcl->nil_process))
{
/* Create a nil process used to simplify nil check in GC.
* only accessible by VM. not exported via the global dictionary. */
tmp = (hcl_oop_t)hcl_instantiate(hcl, hcl->c_process, HCL_NULL, 0);
if (HCL_UNLIKELY(!tmp)) goto oops;
hcl->nil_process = (hcl_oop_process_t)tmp;
hcl->nil_process->id = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_TERMINATED);
#if 0
hcl->nil_process->perr = HCL_ERROR_TO_OOP(HCL_ENOERR);
hcl->nil_process->perrmsg = hcl->_nil;
#endif
/* Create a process scheduler */
tmp = (hcl_oop_t)hcl_instantiate(hcl, hcl->c_process_scheduler, HCL_NULL, 0);
if (HCL_UNLIKELY(!tmp)) return -1;
hcl->processor = (hcl_oop_process_scheduler_t)tmp;
hcl->processor->active = hcl->nil_process;
hcl->processor->total_count = HCL_SMOOI_TO_OOP(0);
hcl->processor->runnable.count = HCL_SMOOI_TO_OOP(0);
hcl->processor->suspended.count = HCL_SMOOI_TO_OOP(0);
/* unusable stack */
hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->st = HCL_SMOOI_TO_OOP(-1);
/* unusable exception stack */
hcl->nil_process->exsp = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->exst = HCL_SMOOI_TO_OOP(-1);
/* unusable class stack */
hcl->nil_process->clsp = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->clst = HCL_SMOOI_TO_OOP(-1);
}
if (HCL_LIKELY(!hcl->processor))
{
/* Create a process scheduler */
tmp = (hcl_oop_t)hcl_instantiate(hcl, hcl->c_process_scheduler, HCL_NULL, 0);
if (HCL_UNLIKELY(!tmp)) goto oops;
hcl->processor = (hcl_oop_process_scheduler_t)tmp;
hcl->processor->active = hcl->nil_process;
hcl->processor->total_count = HCL_SMOOI_TO_OOP(0);
hcl->processor->runnable.count = HCL_SMOOI_TO_OOP(0);
hcl->processor->suspended.count = HCL_SMOOI_TO_OOP(0);
}
return 0;
oops:
return -1;
}
#if 0
@ -1368,35 +1445,47 @@ static int ignite_3 (hcl_t* hcl)
#endif
static int make_kernel_classes (hcl_t* hcl)
static int make_kernel_objs (hcl_t* hcl)
{
hcl_oop_class_t c;
hcl_oow_t i;
/* make_kernel_classes() creates a chain of classes for initial bootstrapping.
* when the objects are loaded from an image file, this function is skipped */
/* make_kernel_objs() creates a chain of classes as well as some key objects
* for initial bootstrapping. when the objects are loaded from an image file,
* this function is skipped */
#if 0
hcl->igniting = 1;
hcl->_nil = moo_allocbytes(hcl, MOO_SIZEOF(hcl_obj_t));
if (HCL_UNLIKELY(!hcl->_nil)) goto oops;
hcl->_nil->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(moo_oop_t), 0, 1, hcl->igniting, 0, 0, 0, 0, 0);
hcl->_nil->_size = 0;
hcl->igniting = 1;
#endif
if (HCL_LIKELY(!hcl->_undef))
{ /* TODO: create it as nogc */
hcl->_undef = hcl_makeundef(hcl);
if (HCL_UNLIKELY(!hcl->_undef)) goto oops;
}
if (ignite_1(hcl) <= -1 || ignite_2(hcl) <= -1 /*|| ignite_3(hcl)*/) goto oops;
if (HCL_LIKELY(!hcl->_nil))
{ /* TODO: create it as nogc? */
hcl->_nil = hcl_makenil(hcl);
if (HCL_UNLIKELY(!hcl->_nil)) goto oops;
}
if (ignite_1(hcl) <= -1) goto oops;
/* ready to set the class of object created prior to class creation in ignite_1() */
HCL_OBJ_SET_CLASS (hcl->_nil, (hcl_oop_t)hcl->c_undefobj);
HCL_OBJ_SET_CLASS (hcl->_undef, (hcl_oop_t)hcl->c_undefobj);
if (ignite_2(hcl) <= -1) goto oops;
#if 0
moo->igniting = 0;
if (ignite_3(hcl) <= -1) goto oops;
hcl->igniting = 0;
#endif
return 0;
oops:
#if 0
moo->igniting = 0;
hcl>igniting = 0;
#endif
return -1;
}
@ -1411,40 +1500,29 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
if (HCL_UNLIKELY(!hcl->heap)) return -1;
}
if (!hcl->_undef)
{
hcl->_undef = hcl_makeundef(hcl);
if (HCL_UNLIKELY(!hcl->_undef)) return -1;
}
if (!hcl->_nil)
{
hcl->_nil = hcl_makenil(hcl);
if (HCL_UNLIKELY(!hcl->_nil)) return -1;
}
if (make_kernel_objs(hcl) <= -1) return -1;
if (!hcl->_true)
{
hcl->_true = hcl_maketrue(hcl);
if (HCL_UNLIKELY(!hcl->_true)) return -1;
if (HCL_UNLIKELY(!hcl->_true)) goto oops;
}
if (!hcl->_false)
{
hcl->_false = hcl_makefalse(hcl);
if (HCL_UNLIKELY(!hcl->_false)) return -1;
if (HCL_UNLIKELY(!hcl->_false)) goto oops;
}
if (!hcl->symtab)
{
hcl->symtab = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_symtab_size);
if (HCL_UNLIKELY(!hcl->symtab)) return -1;
if (HCL_UNLIKELY(!hcl->symtab)) goto oops;
}
if (!hcl->sysdic)
{
hcl->sysdic = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_sysdic_size);
if (HCL_UNLIKELY(!hcl->sysdic)) return -1;
if (HCL_UNLIKELY(!hcl->sysdic)) goto oops;
}
/* symbol table available now. symbols can be created */
@ -1453,7 +1531,7 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
hcl_oop_t tmp;
tmp = hcl_makesymbol(hcl, syminfo[i].ptr, syminfo[i].len);
if (HCL_UNLIKELY(!tmp)) return -1;
if (HCL_UNLIKELY(!tmp)) goto oops;
HCL_OBJ_SET_FLAGS_SYNCODE (tmp, syminfo[i].syncode);
*(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset) = tmp;
@ -1464,7 +1542,7 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
/* Create a nil process used to simplify nil check in GC.
* only accessible by VM. not exported via the global dictionary. */
hcl->nil_process = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS);
if (HCL_UNLIKELY(!hcl->nil_process)) return -1;
if (HCL_UNLIKELY(!hcl->nil_process)) goto oops;
/* unusable stack */
hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1);
@ -1480,7 +1558,7 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
if (!hcl->processor)
{
hcl->processor = (hcl_oop_process_scheduler_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS_SCHEDULER, HCL_PROCESS_SCHEDULER_NAMED_INSTVARS);
if (HCL_UNLIKELY(!hcl->processor)) return -1;
if (HCL_UNLIKELY(!hcl->processor)) goto oops;
hcl->processor->active = hcl->nil_process;
hcl->processor->total_count = HCL_SMOOI_TO_OOP(0);
hcl->processor->runnable.count = HCL_SMOOI_TO_OOP(0);
@ -1490,13 +1568,14 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
hcl->sp = HCL_OOP_TO_SMOOI(hcl->processor->active->sp);
}
if (make_kernel_classes(hcl) <= -1) return -1;
/* TODO: move this initialization to hcl_init? */
if (hcl_brewcode(hcl, &hcl->code) <= -1) return -1;
if (hcl_brewcode(hcl, &hcl->code) <= -1) goto oops;
hcl->p.e = hcl->_nil;
return 0;
oops:
return -1;
}
int hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name)

10
lib/hcl.c
View File

@ -172,9 +172,19 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, const hcl_vmprim_t* vmprim)
hcl->tagged_brands[HCL_OOP_TAG_CHAR] = HCL_BRAND_CHARACTER;
hcl->tagged_brands[HCL_OOP_TAG_ERROR] = HCL_BRAND_ERROR;
hcl->tagged_classes[HCL_OOP_TAG_SMOOI] = &hcl->c_small_integer;
hcl->tagged_classes[HCL_OOP_TAG_SMPTR] = &hcl->c_small_pointer;
hcl->tagged_classes[HCL_OOP_TAG_CHAR] = &hcl->c_character;
hcl->tagged_classes[HCL_OOP_TAG_ERROR] = &hcl->c_error;
hcl->proc_map_free_first = -1;
hcl->proc_map_free_last = -1;
/* hcl_execute() resets 'sp' to -1 when it initializes the initial context.
* set it to -1 here in case hcl_gc() is called before a call to hcl_execute() */
hcl->sp = -1;
hcl->ip = 0;
if (hcl->vmprim.dl_startup) hcl->vmprim.dl_startup (hcl);
return 0;

31
lib/hcl.h
View File

@ -302,7 +302,7 @@ enum hcl_obj_type_t
/* NOTE: you can have HCL_OBJ_SHORT, HCL_OBJ_INT
* HCL_OBJ_LONG, HCL_OBJ_FLOAT, HCL_OBJ_DOUBLE, etc
* type type field being 6 bits long, you can have up to 64 different types.
* type field being 6 bits long, you can have up to 64 different types.
HCL_OBJ_TYPE_SHORT,
HCL_OBJ_TYPE_INT,
@ -674,18 +674,25 @@ struct hcl_context_t
hcl_oop_t slot[1]; /* arguments, return variables, local variables, other arguments, etc */
};
#define HCL_PROCESS_NAMED_INSTVARS 15
#define HCL_PROCESS_NAMED_INSTVARS (15)
typedef struct hcl_process_t hcl_process_t;
typedef struct hcl_process_t* hcl_oop_process_t;
#define HCL_SEMAPHORE_NAMED_INSTVARS 11
#define HCL_SEMAPHORE_NAMED_INSTVARS (11)
typedef struct hcl_semaphore_t hcl_semaphore_t;
typedef struct hcl_semaphore_t* hcl_oop_semaphore_t;
#define HCL_SEMAPHORE_GROUP_NAMED_INSTVARS 8
#define HCL_SEMAPHORE_GROUP_NAMED_INSTVARS (8)
typedef struct hcl_semaphore_group_t hcl_semaphore_group_t;
typedef struct hcl_semaphore_group_t* hcl_oop_semaphore_group_t;
#define HCL_PROCESS_STATE_RUNNING (3)
#define HCL_PROCESS_STATE_WAITING (2)
#define HCL_PROCESS_STATE_RUNNABLE (1)
#define HCL_PROCESS_STATE_SUSPENDED (0)
#define HCL_PROCESS_STATE_TERMINATED (-1)
struct hcl_process_t
{
HCL_OBJ_HEADER;
@ -850,7 +857,7 @@ struct hcl_process_scheduler_t
};
#define HCL_CLASS_NAMED_INSTVARS 9
#define HCL_CLASS_NAMED_INSTVARS 10
typedef struct hcl_class_t hcl_class_t;
typedef struct hcl_class_t* hcl_oop_class_t;
struct hcl_class_t
@ -866,6 +873,7 @@ struct hcl_class_t
hcl_oop_t nivars; /* SmallInteger. */
hcl_oop_t ncvars; /* SmallInteger. */
hcl_oop_t nivars_super; /* SmallInteger */
hcl_oop_t ibrand; /* SmallInteger */
hcl_oop_char_t ivarnames;
hcl_oop_char_t cvarnames;
@ -926,6 +934,14 @@ struct hcl_class_t
#define HCL_BRANDOF(hcl,oop) \
(HCL_OOP_GET_TAG(oop)? ((hcl)->tagged_brands[HCL_OOP_GET_TAG(oop)]): HCL_OBJ_GET_FLAGS_BRAND(oop))
/**
* The HCL_CLASSOF() macro return the class of an object including a numeric
* object encoded into a pointer.
*/
#define HCL_CLASSOF(hcl,oop) \
(HCL_OOP_GET_TAG(oop)? ((hcl_oop_t)(*(hcl)->tagged_classes[HCL_OOP_GET_TAG(oop)])): HCL_OBJ_GET_CLASS(oop))
/**
* The HCL_BYTESOF() macro returns the size of the payload of
* an object in bytes. If the pointer given encodes a numeric value,
@ -1739,6 +1755,8 @@ struct hcl_t
* because the 2 high extended bits are used only if the low tag bits
* are 3 */
int tagged_brands[16];
hcl_oop_class_t* tagged_classes[16];
hcl_oop_t* volat_stack[256]; /* stack for temporaries */
hcl_oow_t volat_count;
@ -1934,7 +1952,7 @@ struct hcl_t
* ========================================================================= */
enum hcl_brand_t
{
HCL_BRAND_SMOOI = 1, /* never used as a small integer is encoded in an object pointer */
HCL_BRAND_SMOOI = 1, /* never used because a small integer is encoded in an object pointer */
HCL_BRAND_SMPTR,
HCL_BRAND_ERROR,
HCL_BRAND_CHARACTER,
@ -2034,6 +2052,7 @@ typedef enum hcl_concode_t hcl_concode_t;
#define HCL_IS_CONS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONS)
#define HCL_IS_CONS_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == (concode))
#define HCL_IS_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_ARRAY)
/*#define HCL_IS_ARRAY(hcl,v) (HCL_CLASSOF(hcl,v) == hcl->c_array) TODO: change to check the class instead?? remove brands?? */
#define HCL_IS_BYTEARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BYTE_ARRAY)
#define HCL_IS_DIC(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_DIC)
#define HCL_IS_PRIM(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PRIM)

97
lib/obj.c
View File

@ -256,12 +256,34 @@ hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow
hcl_oop_t hcl_makeundef (hcl_t* hcl)
{
return hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0);
hcl_oop_t o;
o = hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0);
if (HCL_LIKELY(o))
{
HCL_OBJ_SET_FLAGS_KERNEL(o, 1);
}
else
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make undef - %js", orgmsg);
}
return o;
}
hcl_oop_t hcl_makenil (hcl_t* hcl)
{
return hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0);
hcl_oop_t o;
o = hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0);
if (HCL_LIKELY(o))
{
HCL_OBJ_SET_FLAGS_KERNEL(o, 1);
}
else
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make nil - %js", orgmsg);
}
return o;
}
hcl_oop_t hcl_maketrue (hcl_t* hcl)
@ -407,7 +429,11 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl
hcl_pushvolat (hcl, &superclass);
hcl_pushvolat (hcl, &ivars_str);
hcl_pushvolat (hcl, &cvars_str);
#if 0
c = (hcl_oop_class_t)hcl_allocoopobj(hcl, HCL_BRAND_CLASS, HCL_CLASS_NAMED_INSTVARS + ncvars);
#else
c = (hcl_oop_class_t)hcl_instantiate(hcl, hcl->c_class, HCL_NULL, ncvars);
#endif
hcl_popvolats (hcl, 3);
if (HCL_UNLIKELY(!c))
{
@ -415,12 +441,14 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make class - %js", orgmsg);
return HCL_NULL;
}
HCL_OBJ_SET_CLASS (c, (hcl_oop_t)hcl->c_class);
c->spec = HCL_SMOOI_TO_OOP(0); /* TODO: fix this */
c->selfspec = HCL_SMOOI_TO_OOP(0); /* TODO: fix this */
c->spec = HCL_SMOOI_TO_OOP(0); /* TODO: fix this - encode nivars and nivars_super to spec??? */
c->selfspec = HCL_SMOOI_TO_OOP(0); /* TODO: fix this - encode ncvars to selfspec??? */
c->superclass = superclass;
c->nivars = HCL_SMOOI_TO_OOP(nivars);
c->ncvars = HCL_SMOOI_TO_OOP(ncvars);
c->ibrand = HCL_SMOOI_TO_OOP(HCL_BRAND_INSTANCE); /* TODO: really need ibrand??? */
if ((hcl_oop_t)superclass != hcl->_nil)
{
@ -439,6 +467,7 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl
return (hcl_oop_t)c;
}
#if 0
static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_obj_type_t* type, hcl_oow_t* outlen)
{
/* TODO: */
@ -447,6 +476,62 @@ static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_obj_t
*outlen = HCL_OOP_TO_SMOOI(_class->nivars_super) + HCL_OOP_TO_SMOOI(_class->nivars);
return 0;
}
#else
static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t num_flexi_fields, hcl_obj_type_t* type, hcl_oow_t* outlen)
{
hcl_oow_t spec;
hcl_oow_t num_fixed_fields;
hcl_obj_type_t indexed_type;
HCL_ASSERT (hcl, HCL_OOP_IS_POINTER(_class));
HCL_ASSERT (hcl, HCL_CLASSOF(hcl, _class) == (hcl_oop_t)hcl->c_class);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(_class->spec));
spec = HCL_OOP_TO_SMOOI(_class->spec);
num_fixed_fields = HCL_CLASS_SPEC_NAMED_INSTVARS(spec);
HCL_ASSERT (hcl, num_fixed_fields <= HCL_MAX_NAMED_INSTVARS);
if (HCL_CLASS_SPEC_IS_INDEXED(spec))
{
indexed_type = HCL_CLASS_SPEC_INDEXED_TYPE(spec);
/* the number of the fixed fields for a non-pointer object are supported.
* the fixed fields of a pointer object holds named instance variables
* and a non-pointer object is facilitated with the fixed fields of the size
* specified in the class description like #byte(5), #word(10).
*
* when it comes to spec decoding, there is no difference between a pointer
* object and a non-pointer object */
if (num_flexi_fields > HCL_MAX_INDEXED_INSTVARS(num_fixed_fields))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "number of flexi-fields(%zu) too big for a class %O", num_flexi_fields, _class);
return -1;
}
}
else
{
/* named instance variables only. treat it as if it is an
* indexable class with no variable data */
indexed_type = HCL_OBJ_TYPE_OOP;
if (num_flexi_fields > 0)
{
hcl_seterrbfmt (hcl, HCL_EPERM, "flexi-fields(%zu) disallowed for a class %O", num_flexi_fields, _class);
return -1;
}
}
HCL_ASSERT (hcl, num_fixed_fields + num_flexi_fields <= HCL_OBJ_SIZE_MAX);
*type = indexed_type;
/* TODO: THIS PART IS WRONG.. nivars_super and nivars should be encoded to the spec.... */
*outlen = num_fixed_fields + num_flexi_fields + HCL_OOP_TO_SMOOI(_class->nivars_super) + HCL_OOP_TO_SMOOI(_class->nivars);
return 0;
}
#endif
hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, hcl_oow_t vlen)
{
@ -457,7 +542,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
HCL_ASSERT (hcl, hcl->_nil != HCL_NULL);
if (decode_spec(hcl, _class, &type, &alloclen) <= -1) return HCL_NULL;
if (decode_spec(hcl, _class, vlen, &type, &alloclen) <= -1) return HCL_NULL;
hcl_pushvolat (hcl, (hcl_oop_t*)&_class); tmp_count++;
@ -522,6 +607,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, vptr, alloclen);
break;
/* TODO: more types... HCL_OBJ_TYPE_INT... HCL_OBJ_TYPE_FLOAT, HCL_OBJ_TYPE_UINT16, etc*/
default:
hcl_seterrnum (hcl, HCL_EINTERN);
oop = HCL_NULL;
@ -539,6 +625,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
if (HCL_CLASS_SPEC_IS_IMMUTABLE(spec)) HCL_OBJ_SET_FLAGS_RDONLY (oop, 1);
if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
#endif
HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
}
hcl_popvolats (hcl, tmp_count);
return oop;

10
lib/read.c
View File

@ -51,7 +51,7 @@ static struct voca_t
{ 5, { '#','\\','t','a','b' } },
{ 6, { '#','\\','v','t','a','b' } },
{ 4, { 'n','u','l','l' } },
{ 3, { 'n','i','l' } },
{ 4, { 't','r','u','e' } },
{ 5, { 'f','a','l','s','e' } },
{ 4, { 's','e','l','f' } },
@ -92,7 +92,7 @@ enum voca_id_t
VOCA_CHAR_TAB,
VOCA_CHAR_VTAB,
VOCA_KW_NULL,
VOCA_KW_NIL,
VOCA_KW_TRUE,
VOCA_KW_FALSE,
VOCA_KW_SELF,
@ -436,7 +436,7 @@ static hcl_tok_type_t classify_ident_token (hcl_t* hcl, const hcl_oocs_t* v)
hcl_tok_type_t type;
} tab[] =
{
{ VOCA_KW_NULL, HCL_TOK_NIL },
{ VOCA_KW_NIL, HCL_TOK_NIL },
{ VOCA_KW_TRUE, HCL_TOK_TRUE },
{ VOCA_KW_FALSE, HCL_TOK_FALSE },
{ VOCA_KW_SELF, HCL_TOK_SELF },
@ -3489,8 +3489,8 @@ static int init_compiler (hcl_t* hcl)
/* initialize the internal cons to represent a cell pointing to `null` in the `car` part */
hcl->c->fake_cnode.nil.cn_type = HCL_CNODE_NIL;
hcl->c->fake_cnode.nil.cn_tok.ptr = vocas[VOCA_KW_NULL].str;
hcl->c->fake_cnode.nil.cn_tok.len = vocas[VOCA_KW_NULL].len;
hcl->c->fake_cnode.nil.cn_tok.ptr = vocas[VOCA_KW_NIL].str;
hcl->c->fake_cnode.nil.cn_tok.len = vocas[VOCA_KW_NIL].len;
hcl->c->fake_cnode.cons_to_nil.cn_type = HCL_CNODE_CONS;
hcl->c->fake_cnode.cons_to_nil.u.cons.car = &hcl->c->fake_cnode.nil;

58
lib/std.c
View File

@ -306,7 +306,7 @@ struct xtn_t
struct
{
int fd;
int fd_flag; /* bitwise OR'ed fo logfd_flag_t bits */
int fd_flags; /* bitwise OR'ed fo logfd_flag_t bits */
struct
{
@ -447,7 +447,9 @@ static hcl_mmgr_t sys_mmgr =
enum logfd_flag_t
{
LOGFD_TTY = (1 << 0),
LOGFD_OPENED_HERE = (1 << 1)
LOGFD_OPENED_HERE = (1 << 1),
LOGFD_STDERR_TTY = (1 << 2),
LOGFD_STDOUT_TTY = (1 << 3)
};
static int write_all (int fd, const hcl_bch_t* ptr, hcl_oow_t len)
@ -551,14 +553,24 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
xtn_t* xtn = GET_XTN(hcl);
int logfd;
int is_tty;
int force_flush = 0;
if (mask & HCL_LOG_STDERR) logfd = 2;
else if (mask & HCL_LOG_STDOUT) logfd = 1;
if (mask & HCL_LOG_STDERR)
{
logfd = STDERR_FILENO;
is_tty = !!(xtn->log.fd_flags & LOGFD_STDERR_TTY);
}
else if (mask & HCL_LOG_STDOUT)
{
logfd = STDOUT_FILENO;
is_tty = !!(xtn->log.fd_flags & LOGFD_STDOUT_TTY);
}
else
{
logfd = xtn->log.fd;
if (logfd <= -1) return;
is_tty = !!(xtn->log.fd_flags & LOGFD_TTY);
}
/* TODO: beautify the log message.
@ -621,7 +633,7 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
write_log (hcl, logfd, ts, tslen);
}
if (logfd == xtn->log.fd && (xtn->log.fd_flag & LOGFD_TTY))
if (is_tty)
{
if (mask & HCL_LOG_FATAL) write_log (hcl, logfd, "\x1B[1;31m", 7);
else if (mask & HCL_LOG_ERROR) write_log (hcl, logfd, "\x1B[1;32m", 7);
@ -675,7 +687,7 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
write_log (hcl, logfd, msg, len);
#endif
if (logfd == xtn->log.fd && (xtn->log.fd_flag & LOGFD_TTY))
if (is_tty)
{
if (mask & (HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN)) write_log (hcl, logfd, "\x1B[0m", 4);
}
@ -958,7 +970,7 @@ static void backtrace_stack_frames (hcl_t* hcl)
unw_getcontext(&context);
unw_init_local(&cursor, &context);
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG, "[BACKTRACE]\n");
hcl_logbfmt (hcl, HCL_LOG_STDERR | HCL_LOG_UNTYPED | HCL_LOG_DEBUG, "[BACKTRACE]\n");
for (n = 0; unw_step(&cursor) > 0; n++)
{
unw_word_t ip, sp, off;
@ -972,7 +984,7 @@ static void backtrace_stack_frames (hcl_t* hcl)
hcl_copy_bcstr (symbol, HCL_COUNTOF(symbol), "<unknown>");
}
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG,
hcl_logbfmt (hcl, HCL_LOG_STDERR | HCL_LOG_UNTYPED | HCL_LOG_DEBUG,
"#%02d ip=0x%*p sp=0x%*p %hs+0x%zu\n",
n, HCL_SIZEOF(void*) * 2, (void*)ip, HCL_SIZEOF(void*) * 2, (void*)sp, symbol, (hcl_oow_t)off);
}
@ -990,11 +1002,11 @@ static void backtrace_stack_frames (hcl_t* hcl)
if (btsyms)
{
hcl_oow_t i;
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG, "[BACKTRACE]\n");
hcl_logbfmt (hcl, HCL_LOG_STDERR | HCL_LOG_UNTYPED | HCL_LOG_DEBUG, "[BACKTRACE]\n");
for (i = 0; i < btsize; i++)
{
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG, " %hs\n", btsyms[i]);
hcl_logbfmt (hcl, HCL_LOG_STDERR | HCL_LOG_UNTYPED | HCL_LOG_DEBUG, " %hs\n", btsyms[i]);
}
free (btsyms);
}
@ -1008,7 +1020,7 @@ static void backtrace_stack_frames (hcl_t* hcl)
static void _assertfail (hcl_t* hcl, const hcl_bch_t* expr, const hcl_bch_t* file, hcl_oow_t line)
{
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_FATAL, "ASSERTION FAILURE: %hs at %hs:%zu\n", expr, file, line);
hcl_logbfmt (hcl, HCL_LOG_STDERR | HCL_LOG_UNTYPED | HCL_LOG_FATAL, "ASSERTION FAILURE: %hs at %hs:%zu\n", expr, file, line);
backtrace_stack_frames (hcl);
#if defined(_WIN32)
@ -2810,21 +2822,23 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
static HCL_INLINE void reset_log_to_default (xtn_t* xtn)
{
#if defined(ENABLE_LOG_INITIALLY)
xtn->log.fd = 2;
xtn->log.fd_flag = 0;
xtn->log.fd = STDERR_FILENO;
xtn->log.fd_flags = 0;
#if defined(HAVE_ISATTY)
if (isatty(xtn->log.fd)) xtn->log.fd_flag |= LOGFD_TTY;
if (isatty(xtn->log.fd)) xtn->log.fd_flags |= LOGFD_TTY;
#endif
#else
xtn->log.fd = -1;
xtn->log.fd_flag = 0;
xtn->log.fd_flags = 0;
#endif
if (isatty(STDERR_FILENO)) xtn->log.fd_flags |= LOGFD_STDERR_TTY;
if (isatty(STDOUT_FILENO)) xtn->log.fd_flags |= LOGFD_STDOUT_TTY;
}
static void cb_fini (hcl_t* hcl)
{
xtn_t* xtn = GET_XTN(hcl);
if ((xtn->log.fd_flag & LOGFD_OPENED_HERE) && xtn->log.fd >= 0) close (xtn->log.fd);
if ((xtn->log.fd_flags & LOGFD_OPENED_HERE) && xtn->log.fd >= 0) close (xtn->log.fd);
reset_log_to_default (xtn);
}
@ -2851,12 +2865,18 @@ static void cb_opt_set (hcl_t* hcl, hcl_option_t id, const void* value)
}
else
{
if ((xtn->log.fd_flag & LOGFD_OPENED_HERE) && xtn->log.fd >= 0) close (xtn->log.fd);
if ((xtn->log.fd_flags & LOGFD_OPENED_HERE) && xtn->log.fd >= 0) close (xtn->log.fd);
xtn->log.fd = fd;
xtn->log.fd_flag = LOGFD_OPENED_HERE;
xtn->log.fd_flags &= ~LOGFD_TTY;
xtn->log.fd_flags |= LOGFD_OPENED_HERE;
#if defined(HAVE_ISATTY)
if (isatty(xtn->log.fd)) xtn->log.fd_flag |= LOGFD_TTY;
if (isatty(xtn->log.fd))
{
xtn->log.fd_flags |= LOGFD_TTY;
if (fd == STDERR_FILENO) xtn->log.fd_flags |= LOGFD_STDERR_TTY;
else if (fd == STDOUT_FILENO) xtn->log.fd_flags |= LOGFD_STDOUT_TTY;
}
#endif
}
}

27
lib/sym.c
View File

@ -84,7 +84,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow
{
hcl_ooi_t tally;
hcl_oow_t index;
hcl_oop_char_t symbol;
hcl_oop_char_t sym;
HCL_ASSERT (hcl, len > 0);
if (len <= 0)
@ -100,13 +100,13 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow
/* find a matching symbol in the open-addressed symbol table */
while (hcl->symtab->bucket->slot[index] != hcl->_nil)
{
symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[index];
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, symbol));
sym = (hcl_oop_char_t)hcl->symtab->bucket->slot[index];
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, sym));
if (len == HCL_OBJ_GET_SIZE(symbol) &&
hcl_equal_oochars (ptr, symbol->slot, len))
if (len == HCL_OBJ_GET_SIZE(sym) &&
hcl_equal_oochars (ptr, sym->slot, len))
{
return (hcl_oop_t)symbol;
return (hcl_oop_t)sym;
}
index = (index + 1) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
@ -158,15 +158,20 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow
}
/* create a new symbol since it isn't found in the symbol table */
symbol = (hcl_oop_char_t)hcl_alloccharobj(hcl, HCL_BRAND_SYMBOL, ptr, len);
if (symbol)
/*sym = (hcl_oop_char_t)hcl_alloccharobj(hcl, HCL_BRAND_SYMBOL, ptr, len);*/
sym = (hcl_oop_char_t)hcl_instantiate(hcl, hcl->c_symbol, ptr, len);
if (HCL_LIKELY(sym))
{
HCL_ASSERT (hcl, tally < HCL_SMOOI_MAX);
hcl->symtab->tally = HCL_SMOOI_TO_OOP(tally + 1);
hcl->symtab->bucket->slot[index] = (hcl_oop_t)symbol;
hcl->symtab->bucket->slot[index] = (hcl_oop_t)sym;
}
return (hcl_oop_t)symbol;
else
{
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make symbol - %.*js - %js", len, ptr, orgmsg);
}
return (hcl_oop_t)sym;
}
hcl_oop_t hcl_makesymbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len)

4
t/fun-01.hcl
View File

@ -44,7 +44,9 @@ defclass A | a b c | {
##defun get-c() c;
};
set k (A:newInstance 11 22 33);
k := (A:newInstance 11 22 33);
##set k (A:newInstance 11 22 33);
set v (k:get-a);
if (= v 11) {
printf "OK - %d\n" v;

4
t/run.sh
View File

@ -1,3 +1,5 @@
#!/bin/sh
$@ 2>&1 | grep -E ^ERROR: && exit 1
## use a subshell to execute the actual program in case the
## program crashes or exits without an error message.
($@ 2>&1 || echo "ERROR: exited with $?") | grep -E '^ERROR:' && exit 1
exit 0