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, ','); cm = hcl_find_bchar_in_bcstr(flt, ',');
len = cm? (cm - flt): hcl_count_bcstr(flt); len = cm? (cm - flt): hcl_count_bcstr(flt);
if (hcl_comp_bchars_bcstr(flt, len, "gc") == 0) dbgopt |= HCL_TRAIT_DEBUG_GC; if (len == 0) continue;
else if (hcl_comp_bchars_bcstr(flt, len, "bigint") == 0) dbgopt |= HCL_TRAIT_DEBUG_BIGINT; 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 else
{ {
fprintf (stderr, "ERROR: unknown debug option value - %.*s\n", (int)len, flt); 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" #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[] = static const char* io_type_str[] =
{ {
"input", "input",
@ -563,7 +557,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
//////////////////// ////////////////////
#endif #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 */ /* assign a process id to the process */
alloc_pid (hcl, proc); alloc_pid (hcl, proc);
@ -624,8 +618,8 @@ static HCL_INLINE void wake_process (hcl_t* hcl, hcl_oop_process_t proc)
#endif #endif
/* activate the given process */ /* activate the given process */
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));
proc->state = HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING); proc->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNING);
hcl->processor->active = proc; hcl->processor->active = proc;
LOAD_ACTIVE_SP(hcl); 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); HCL_ASSERT (hcl, hcl->processor->active != proc);
/* the new process must be in the runnable state */ /* the new process must be in the runnable state */
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) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_WAITING)); proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_WAITING));
sleep_active_process (hcl, new_state_for_old_active); sleep_active_process (hcl, new_state_for_old_active);
wake_process (hcl, proc); 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) static HCL_INLINE hcl_oop_process_t find_next_runnable_process (hcl_t* hcl)
{ {
hcl_oop_process_t nrp; 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; nrp = hcl->processor->active->ps.next;
if ((hcl_oop_t)nrp == hcl->_nil) nrp = hcl->processor->runnable.first; if ((hcl_oop_t)nrp == hcl->_nil) nrp = hcl->processor->runnable.first;
return nrp; return nrp;
@ -673,7 +667,7 @@ static HCL_INLINE void switch_to_next_runnable_process (hcl_t* hcl)
{ {
hcl_oop_process_t nrp; hcl_oop_process_t nrp;
nrp = find_next_runnable_process (hcl); 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) 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.prev == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->ps.next == 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, proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED));
HCL_ASSERT (hcl, new_state == PROC_STATE_RUNNABLE || new_state == PROC_STATE_RUNNING); HCL_ASSERT (hcl, new_state == HCL_PROCESS_STATE_RUNNABLE || new_state == HCL_PROCESS_STATE_RUNNING);
#if defined(HCL_DEBUG_VM_PROCESSOR) #if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, 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 suspended_count;
hcl_ooi_t total_count; hcl_ooi_t total_count;
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) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE) || proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED)); proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_SUSPENDED));
HCL_ASSERT (hcl, proc->state != HCL_SMOOI_TO_OOP(new_state)); 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))); 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 #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); suspended_count = HCL_OOP_TO_SMOOI(hcl->processor->suspended.count);
HCL_ASSERT (hcl, suspended_count > 0); 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 (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 */ /* do not chain it to the suspended process list as it's being terminated */
proc->ps.prev = (hcl_oop_process_t)hcl->_nil; 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 else
{ {
/* append to the suspended process list */ /* 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); 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); 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) static void terminate_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) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE)) proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE))
{ {
/* RUNNING/RUNNABLE ---> TERMINATED */ /* RUNNING/RUNNABLE ---> TERMINATED */
#if defined(HCL_DEBUG_VM_PROCESSOR) #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; hcl_oop_process_t nrp;
/* terminating the active process */ /* 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); nrp = find_next_runnable_process(hcl);
STORE_ACTIVE_SP (hcl); /* commit the stack pointer before termination */ 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 */ reset_process_stack_pointers (hcl, proc); /* invalidate the process stack */
proc->current_context = proc->initial_context; /* not needed but just in case */ proc->current_context = proc->initial_context; /* not needed but just in case */
/* a runnable or running process must not be chanined to the /* 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 else
{ {
/* there are other processes to schedule */ /* there are other processes to schedule */
switch_to_process (hcl, nrp, PROC_STATE_TERMINATED); switch_to_process (hcl, nrp, HCL_PROCESS_STATE_TERMINATED);
} }
} }
else else
{ {
/* termiante a runnable process which is not an actively running process */ /* termiante a runnable process which is not an actively running process */
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));
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 */ 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 */ /* when terminated, clear it from the pid table and set the process id to a negative number */
free_pid (hcl, proc); 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 */ /* SUSPENDED ---> TERMINATED */
#if defined(HCL_DEBUG_VM_PROCESSOR) #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))); 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 #endif
/*proc->state = HCL_SMOOI_TO_OOP(PROC_STATE_TERMINATED);*/ /*proc->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_TERMINATED);*/
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 */ reset_process_stack_pointers (hcl, proc); /* invalidate the process stack */
if ((hcl_oop_t)proc->sem != hcl->_nil) 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); free_pid (hcl, proc);
} }
#if 0 #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 */ /* WAITING ---> TERMINATED */
/* TODO: */ /* 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) 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 */ /* SUSPENDED ---> RUNNABLE */
/*HCL_ASSERT (hcl, (hcl_oop_t)proc->ps.prev == hcl->_nil); /*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. /* don't switch to this process. just change the state to RUNNABLE.
* process switching should be triggerd by the process scheduler. */ * 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;*/ /*proc->current_context = proc->initial_context;*/
} }
#if 0 #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 */ /* RUNNABLE ---> RUNNING */
/* TODO: should i allow this? */ /* TODO: should i allow this? */
HCL_ASSERT (hcl, hcl->processor->active != proc); 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 #endif
} }
static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc) static void suspend_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) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE)) proc->state == HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_RUNNABLE))
{ {
/* RUNNING/RUNNABLE ---> SUSPENDED */ /* RUNNING/RUNNABLE ---> SUSPENDED */
@ -1099,8 +1093,8 @@ static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc)
if (nrp == proc) if (nrp == proc)
{ {
/* no runnable process after suspension */ /* no runnable process after suspension */
sleep_active_process (hcl, PROC_STATE_RUNNABLE); sleep_active_process (hcl, HCL_PROCESS_STATE_RUNNABLE);
unchain_from_processor (hcl, proc, PROC_STATE_SUSPENDED); unchain_from_processor (hcl, proc, HCL_PROCESS_STATE_SUSPENDED);
/* the last running/runnable process has been unchained /* the last running/runnable process has been unchained
* from the processor and set to SUSPENDED. the active * 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 * done in unchain_from_processor(). the state of the active
* process is somewhat wrong for a short period of time until * process is somewhat wrong for a short period of time until
* switch_to_process() has changed the active process. */ * 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); 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 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) 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 */ /* RUNNING --> RUNNABLE */
@ -1147,7 +1141,7 @@ static void yield_process (hcl_t* hcl, hcl_oop_process_t proc)
#if defined(HCL_DEBUG_VM_PROCESSOR) #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))); 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 #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 * it uses wake_process() instead of
* switch_to_process() as there is no running * switch_to_process() as there is no running
* process at this moment */ * 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); HCL_ASSERT (hcl, proc == hcl->processor->runnable.first);
#if 0 #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; if (HCL_UNLIKELY(!proc)) return HCL_NULL;
/* skip RUNNABLE and go to RUNNING */ /* 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; hcl->processor->active = proc;
/* do something that resume_process() would do with less overhead */ /* 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)); 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 #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 */ HCL_ASSERT (hcl, proc == hcl->processor->runnable.last); /* resume_process() appends to the runnable list */
#if 0 #if 0
wake_process (hcl, proc); /* switch to running */ 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) 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); HCL_ASSERT (hcl, proc == hcl->processor->runnable.first);
switch_to_process_from_nil (hcl, proc); 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); proc = signal_semaphore(hcl, hcl->sem_gcfin);
if ((hcl_oop_t)proc != hcl->_nil) 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_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. */ 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 */ 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: case HCL_CODE_PUSH_IVAR_7:
b1 = bcode & 0x7; /* low 3 bits */ b1 = bcode & 0x7; /* low 3 bits */
push_ivar: 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); 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); b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff);
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1]); 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: case HCL_CODE_STORE_INTO_IVAR_7:
b1 = bcode & 0x7; /* low 3 bits */ b1 = bcode & 0x7; /* low 3 bits */
store_instvar: 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); 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); b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff);
((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); ((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: case HCL_CODE_POP_INTO_IVAR_7:
b1 = bcode & 0x7; /* low 3 bits */ b1 = bcode & 0x7; /* low 3 bits */
pop_into_ivar: 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); 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); b1 += HCL_OOP_TO_SMOOI(hcl->active_context->home->ivaroff);
((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl); ((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); hcl_popvolat (hcl);
if (HCL_UNLIKELY(!newprc)) return HCL_PF_FAILURE; 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); HCL_STACK_SETRET (hcl, nargs, (hcl_oop_t)newprc);
return HCL_PF_SUCCESS; return HCL_PF_SUCCESS;

319
lib/gc.c
View File

@ -111,6 +111,7 @@ static struct
struct kernel_class_info_t struct kernel_class_info_t
{ {
const hcl_bch_t* name; const hcl_bch_t* name;
int class_brand;
int class_flags; int class_flags;
int class_num_classvars; int class_num_classvars;
@ -137,7 +138,7 @@ static kernel_class_info_t kernel_classes[] =
* SmallIntger * SmallIntger
* -------------------------------------------------------------- */ * -------------------------------------------------------------- */
{ "Apex", { "Apex", 0,
0, 0,
0, 0,
0, 0,
@ -145,7 +146,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_apex) }, HCL_OFFSETOF(hcl_t, c_apex) },
{ "UndefinedObject", { "UndefinedObject", HCL_BRAND_UNDEF,
0, 0,
0, 0,
0, 0,
@ -154,7 +155,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, c_undefobj) }, HCL_OFFSETOF(hcl_t, c_undefobj) },
#define KCI_CLASS 2 /* index to the Class entry in this table */ #define KCI_CLASS 2 /* index to the Class entry in this table */
{ "Class", { "Class", HCL_BRAND_CLASS,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
HCL_CLASS_NAMED_INSTVARS, HCL_CLASS_NAMED_INSTVARS,
@ -172,7 +173,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, _interface) }, HCL_OFFSETOF(hcl_t, _interface) },
#endif #endif
{ "Object", { "Object", 0,
0, 0,
0, 0,
0, 0,
@ -180,7 +181,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_object) }, HCL_OFFSETOF(hcl_t, c_object) },
{ "String", { "String", HCL_BRAND_STRING,
0, 0,
0, 0,
0, 0,
@ -188,7 +189,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_CHAR, HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_string) }, HCL_OFFSETOF(hcl_t, c_string) },
{ "Symbol", { "Symbol", HCL_BRAND_SYMBOL,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
0, 0,
@ -196,7 +197,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_CHAR, HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_symbol) }, HCL_OFFSETOF(hcl_t, c_symbol) },
{ "Array", { "Array", HCL_BRAND_ARRAY,
0, 0,
0, 0,
0, 0,
@ -204,7 +205,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_array) }, HCL_OFFSETOF(hcl_t, c_array) },
{ "ByteArray", { "ByteArray", HCL_BRAND_BYTE_ARRAY,
0, 0,
0, 0,
0, 0,
@ -212,7 +213,10 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_BYTE, HCL_OBJ_TYPE_BYTE,
HCL_OFFSETOF(hcl_t, c_byte_array) }, 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,
0, 0,
HCL_DIC_NAMED_INSTVARS, HCL_DIC_NAMED_INSTVARS,
@ -220,7 +224,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_symtab) }, HCL_OFFSETOF(hcl_t, c_symtab) },
{ "Dictionary", { "Dictionary", HCL_BRAND_DIC,
0, 0,
0, 0,
HCL_DIC_NAMED_INSTVARS, HCL_DIC_NAMED_INSTVARS,
@ -228,7 +232,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_dictionary) }, HCL_OFFSETOF(hcl_t, c_dictionary) },
{ "Cons", { "Cons", HCL_BRAND_CONS,
0, 0,
0, 0,
HCL_CONS_NAMED_INSTVARS, HCL_CONS_NAMED_INSTVARS,
@ -254,7 +258,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, c_pool_dictionary) }, HCL_OFFSETOF(hcl_t, c_pool_dictionary) },
#endif #endif
{ "MethodDictionary", { "MethodDictionary", 0,
0, 0,
0, 0,
HCL_DIC_NAMED_INSTVARS, HCL_DIC_NAMED_INSTVARS,
@ -280,7 +284,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, c_methsig) }, HCL_OFFSETOF(hcl_t, c_methsig) },
#endif #endif
{ "CompiledBlock", { "CompiledBlock", 0,
0, 0,
0, 0,
HCL_BLOCK_NAMED_INSTVARS, HCL_BLOCK_NAMED_INSTVARS,
@ -288,7 +292,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block) }, HCL_OFFSETOF(hcl_t, c_block) },
{ "MethodContext", { "MethodContext", 0,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
HCL_CONTEXT_NAMED_INSTVARS, HCL_CONTEXT_NAMED_INSTVARS,
@ -296,7 +300,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_context) }, HCL_OFFSETOF(hcl_t, c_method_context) },
{ "BlockContext", { "BlockContext", 0,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
HCL_CONTEXT_NAMED_INSTVARS, HCL_CONTEXT_NAMED_INSTVARS,
@ -304,7 +308,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block_context) }, HCL_OFFSETOF(hcl_t, c_block_context) },
{ "Process", { "Process", HCL_BRAND_PROCESS,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
HCL_PROCESS_NAMED_INSTVARS, HCL_PROCESS_NAMED_INSTVARS,
@ -312,7 +316,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process) }, HCL_OFFSETOF(hcl_t, c_process) },
{ "Semaphore", { "Semaphore", HCL_BRAND_SEMAPHORE,
0, 0,
0, 0,
HCL_SEMAPHORE_NAMED_INSTVARS, HCL_SEMAPHORE_NAMED_INSTVARS,
@ -320,7 +324,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore) }, HCL_OFFSETOF(hcl_t, c_semaphore) },
{ "SemaphoreGroup", { "SemaphoreGroup", HCL_BRAND_SEMAPHORE_GROUP,
0, 0,
0, 0,
HCL_SEMAPHORE_GROUP_NAMED_INSTVARS, HCL_SEMAPHORE_GROUP_NAMED_INSTVARS,
@ -328,7 +332,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore_group) }, HCL_OFFSETOF(hcl_t, c_semaphore_group) },
{ "ProcessScheduler", { "ProcessScheduler", HCL_BRAND_PROCESS_SCHEDULER,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
HCL_PROCESS_SCHEDULER_NAMED_INSTVARS, HCL_PROCESS_SCHEDULER_NAMED_INSTVARS,
@ -336,7 +340,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process_scheduler) }, HCL_OFFSETOF(hcl_t, c_process_scheduler) },
{ "Error", { "Error", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
0, 0,
@ -344,7 +348,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_error) }, HCL_OFFSETOF(hcl_t, c_error) },
{ "True", { "True", HCL_BRAND_TRUE,
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL, HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0, 0,
0, 0,
@ -352,7 +356,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_true) }, HCL_OFFSETOF(hcl_t, c_true) },
{ "False", { "False", HCL_BRAND_FALSE,
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL, HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0, 0,
0, 0,
@ -363,7 +367,7 @@ static kernel_class_info_t kernel_classes[] =
/* TOOD: what is a proper spec for Character and SmallInteger? /* 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. * If the fixed part is 0, its instance must be an object of 0 payload fields.
* Does this make sense? */ * Does this make sense? */
{ "Character", { "Character", HCL_BRAND_CHARACTER,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
0, 0,
@ -371,7 +375,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_character) }, HCL_OFFSETOF(hcl_t, c_character) },
{ "SmallInteger", { "SmallInteger", HCL_BRAND_SMOOI,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
0, 0,
@ -379,7 +383,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_integer) }, HCL_OFFSETOF(hcl_t, c_small_integer) },
{ "LargePositiveInteger", { "LargePositiveInteger", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
0, 0,
@ -387,7 +391,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_LIWORD, HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_positive_integer) }, HCL_OFFSETOF(hcl_t, c_large_positive_integer) },
{ "LargeNegativeInteger", { "LargeNegativeInteger", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
0, 0,
@ -395,7 +399,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_LIWORD, HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_negative_integer) }, HCL_OFFSETOF(hcl_t, c_large_negative_integer) },
{ "FixedPointDecimal", { "FixedPointDecimal", HCL_BRAND_FPDEC,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
HCL_FPDEC_NAMED_INSTVARS, HCL_FPDEC_NAMED_INSTVARS,
@ -403,7 +407,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_fixed_point_decimal) }, HCL_OFFSETOF(hcl_t, c_fixed_point_decimal) },
{ "SmallPointer", { "SmallPointer", HCL_BRAND_SMPTR,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
0, 0,
@ -411,7 +415,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_pointer) }, HCL_OFFSETOF(hcl_t, c_small_pointer) },
{ "LargePointer", { "LargePointer", 0,
HCL_CLASS_SELFSPEC_FLAG_LIMITED, HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0, 0,
1, /* #word(1) */ 1, /* #word(1) */
@ -419,7 +423,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_WORD, HCL_OBJ_TYPE_WORD,
HCL_OFFSETOF(hcl_t, c_large_pointer) }, HCL_OFFSETOF(hcl_t, c_large_pointer) },
{ "System", { "System", 0,
0, 0,
5, /* asyncsg, gcfin_sem, gcfin_should_exit, ossig_pid, shr */ 5, /* asyncsg, gcfin_sem, gcfin_should_exit, ossig_pid, shr */
0, 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 */ 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_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 */ 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) 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 /* is it really better to use a flag bit in the header to
* determine that it is an instance of process? */ * determine that it is an instance of process? */
/* if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) */ /* 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; hcl_oop_process_t proc;
@ -622,6 +626,7 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl)
/* stack */ /* stack */
ll = HCL_OOP_TO_SMOOI(proc->sp); ll = HCL_OOP_TO_SMOOI(proc->sp);
HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS)); 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]); for (i = 0; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]);
/* exception stack */ /* exception stack */
@ -1138,7 +1143,7 @@ hcl_oop_t hcl_shallowcopy (hcl_t* hcl, hcl_oop_t oop)
* BOOTSTRAPPER * 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; hcl_oop_class_t c;
#if 0 #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); HCL_OBJ_SET_CLASS (c, (hcl_oop_t)hcl->c_class);
c->spec = HCL_SMOOI_TO_OOP(spec); c->spec = HCL_SMOOI_TO_OOP(spec);
c->selfspec = HCL_SMOOI_TO_OOP(HCL_CLASS_SELFSPEC_MAKE(num_classvars, 0, class_flags)); 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; return c;
} }
@ -1180,16 +1188,25 @@ static int ignite_1 (hcl_t* hcl)
* The instance of Class can have indexed instance variables * The instance of Class can have indexed instance variables
* which are actually class variables. * which are actually class variables.
* -------------------------------------------------------------- */ * -------------------------------------------------------------- */
hcl->c_class = alloc_kernel_class( if (HCL_LIKELY(!hcl->c_class))
hcl, kernel_classes[KCI_CLASS].class_flags, {
kernel_classes[KCI_CLASS].class_num_classvars, hcl->c_class = alloc_kernel_class(
HCL_CLASS_SPEC_MAKE(kernel_classes[KCI_CLASS].class_spec_named_instvars, hcl, kernel_classes[KCI_CLASS].class_flags,
kernel_classes[KCI_CLASS].class_spec_flags, kernel_classes[KCI_CLASS].class_num_classvars,
kernel_classes[KCI_CLASS].class_spec_indexed_type)); HCL_CLASS_SPEC_MAKE(kernel_classes[KCI_CLASS].class_spec_named_instvars,
if (!hcl->c_class) return -1; 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_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_OBJ_SET_CLASS (hcl->c_class, (hcl_oop_t)hcl->c_class);
}
for (i = 0; i < HCL_COUNTOF(kernel_classes); i++) 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, kernel_classes[i].class_num_classvars,
HCL_CLASS_SPEC_MAKE(kernel_classes[i].class_spec_named_instvars, HCL_CLASS_SPEC_MAKE(kernel_classes[i].class_spec_named_instvars,
kernel_classes[i].class_spec_flags, kernel_classes[i].class_spec_flags,
kernel_classes[i].class_spec_indexed_type)); kernel_classes[i].class_spec_indexed_type),
if (!tmp) return -1; 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_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 #if 0
/* an instance of a method class stores byte codes in the trailer space. /* 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 * 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 * the compiler determines the actual size of the trailer space depending
* on the byte codes generated. i should set the following fields to avoid * on the byte codes generated. i should set the following fields to avoid
* confusion at the GC phase. */ * confusion at the GC phase. */
@ -1231,9 +1252,17 @@ static int ignite_2 (hcl_t* hcl)
#endif #endif
/* Create 'true' and 'false objects */ /* Create 'true' and 'false objects */
hcl->_true = hcl_instantiate(hcl, hcl->c_true, HCL_NULL, 0); if (HCL_LIKELY(!hcl->_true))
hcl->_false = hcl_instantiate(hcl, hcl->c_false, HCL_NULL, 0); {
if (HCL_UNLIKELY(!hcl->c_true) || HCL_UNLIKELY(!hcl->c_false)) return -1; 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 #if 0
/* Prevent the object instations in the permspace. /* Prevent the object instations in the permspace.
@ -1256,52 +1285,100 @@ static int ignite_2 (hcl_t* hcl)
hcl->igniting = 0; hcl->igniting = 0;
#endif #endif
/* Create the symbol table */ if (HCL_LIKELY(!hcl->symtab))
tmp = hcl_instantiate(hcl, hcl->c_symtab, HCL_NULL, 0); {
if (HCL_UNLIKELY(!tmp)) return -1; /* Create the symbol table - values in the bucket are limited to symbols only */
hcl->symtab = (hcl_oop_dic_t)tmp; 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); 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. /* It's important to assign the result of hcl_instantiate() to a temporary
* The pointer 'hcl->symtab; can change in hcl_instantiate() and the * variable first and then assign it to hcl->symtab->bucket.
* target address of assignment may get set before hcl_instantiate() * The pointer 'hcl->symtab; can change in hcl_instantiate() and the
* is called. */ * target address of assignment may get set before hcl_instantiate()
tmp = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, hcl->option.dfl_symtab_size); * is called. */
if (HCL_UNLIKELY(!tmp)) return -1; HCL_ASSERT (hcl, hcl->option.dfl_symtab_size > 0);
hcl->symtab->bucket = (hcl_oop_oop_t)tmp; 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 #if 0
/* Create the system dictionary */ /* Create the system dictionary */
tmp = (hcl_oop_t)hcl_makensdic(hcl, hcl->_namespace, hcl->option.dfl_sysdic_size); tmp = (hcl_oop_t)hcl_makensdic(hcl, hcl->_namespace, hcl->option.dfl_sysdic_size);
if (!tmp) return -1; if (!tmp) return -1;
hcl->sysdic = (hcl_oop_nsdic_t)tmp; 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 */ hcl->igniting = old_igniting; /* back to the permspace */
#endif #endif
/* Create a nil process used to simplify nil check in GC. if (HCL_LIKELY(!hcl->nil_process))
* only accessible by VM. not exported via the global dictionary. */ {
tmp = (hcl_oop_t)hcl_instantiate(hcl, hcl->c_process, HCL_NULL, 0); /* Create a nil process used to simplify nil check in GC.
if (HCL_UNLIKELY(!tmp)) return -1; * only accessible by VM. not exported via the global dictionary. */
hcl->nil_process = (hcl_oop_process_t)tmp; tmp = (hcl_oop_t)hcl_instantiate(hcl, hcl->c_process, HCL_NULL, 0);
hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1); if (HCL_UNLIKELY(!tmp)) goto oops;
hcl->nil_process->id = HCL_SMOOI_TO_OOP(-1); hcl->nil_process = (hcl_oop_process_t)tmp;
#if 0 hcl->nil_process->id = HCL_SMOOI_TO_OOP(-1);
hcl->nil_process->perr = HCL_ERROR_TO_OOP(HCL_ENOERR); hcl->nil_process->state = HCL_SMOOI_TO_OOP(HCL_PROCESS_STATE_TERMINATED);
hcl->nil_process->perrmsg = hcl->_nil; #if 0
#endif hcl->nil_process->perr = HCL_ERROR_TO_OOP(HCL_ENOERR);
hcl->nil_process->perrmsg = hcl->_nil;
#endif
/* Create a process scheduler */ /* unusable stack */
tmp = (hcl_oop_t)hcl_instantiate(hcl, hcl->c_process_scheduler, HCL_NULL, 0); hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1);
if (HCL_UNLIKELY(!tmp)) return -1; hcl->nil_process->st = HCL_SMOOI_TO_OOP(-1);
hcl->processor = (hcl_oop_process_scheduler_t)tmp; /* unusable exception stack */
hcl->processor->active = hcl->nil_process; hcl->nil_process->exsp = HCL_SMOOI_TO_OOP(-1);
hcl->processor->total_count = HCL_SMOOI_TO_OOP(0); hcl->nil_process->exst = HCL_SMOOI_TO_OOP(-1);
hcl->processor->runnable.count = HCL_SMOOI_TO_OOP(0); /* unusable class stack */
hcl->processor->suspended.count = HCL_SMOOI_TO_OOP(0); 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; return 0;
oops:
return -1;
} }
#if 0 #if 0
@ -1368,35 +1445,47 @@ static int ignite_3 (hcl_t* hcl)
#endif #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; hcl_oow_t i;
/* make_kernel_classes() creates a chain of classes for initial bootstrapping. /* make_kernel_objs() creates a chain of classes as well as some key objects
* when the objects are loaded from an image file, this function is skipped */ * for initial bootstrapping. when the objects are loaded from an image file,
* this function is skipped */
#if 0 #if 0
hcl->igniting = 1; 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;
#endif #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 #if 0
moo->igniting = 0; if (ignite_3(hcl) <= -1) goto oops;
hcl->igniting = 0;
#endif #endif
return 0; return 0;
oops: oops:
#if 0 #if 0
moo->igniting = 0; hcl>igniting = 0;
#endif #endif
return -1; 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_UNLIKELY(!hcl->heap)) return -1;
} }
if (!hcl->_undef) if (make_kernel_objs(hcl) <= -1) return -1;
{
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 (!hcl->_true) if (!hcl->_true)
{ {
hcl->_true = hcl_maketrue(hcl); hcl->_true = hcl_maketrue(hcl);
if (HCL_UNLIKELY(!hcl->_true)) return -1; if (HCL_UNLIKELY(!hcl->_true)) goto oops;
} }
if (!hcl->_false) if (!hcl->_false)
{ {
hcl->_false = hcl_makefalse(hcl); hcl->_false = hcl_makefalse(hcl);
if (HCL_UNLIKELY(!hcl->_false)) return -1; if (HCL_UNLIKELY(!hcl->_false)) goto oops;
} }
if (!hcl->symtab) if (!hcl->symtab)
{ {
hcl->symtab = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_symtab_size); 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) if (!hcl->sysdic)
{ {
hcl->sysdic = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_sysdic_size); 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 */ /* 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; hcl_oop_t tmp;
tmp = hcl_makesymbol(hcl, syminfo[i].ptr, syminfo[i].len); 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_OBJ_SET_FLAGS_SYNCODE (tmp, syminfo[i].syncode);
*(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset) = tmp; *(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. /* Create a nil process used to simplify nil check in GC.
* only accessible by VM. not exported via the global dictionary. */ * 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); 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 */ /* unusable stack */
hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1); 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) if (!hcl->processor)
{ {
hcl->processor = (hcl_oop_process_scheduler_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS_SCHEDULER, HCL_PROCESS_SCHEDULER_NAMED_INSTVARS); 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->active = hcl->nil_process;
hcl->processor->total_count = HCL_SMOOI_TO_OOP(0); hcl->processor->total_count = HCL_SMOOI_TO_OOP(0);
hcl->processor->runnable.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); 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? */ /* 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; hcl->p.e = hcl->_nil;
return 0; return 0;
oops:
return -1;
} }
int hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name) 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_CHAR] = HCL_BRAND_CHARACTER;
hcl->tagged_brands[HCL_OOP_TAG_ERROR] = HCL_BRAND_ERROR; 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_first = -1;
hcl->proc_map_free_last = -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); if (hcl->vmprim.dl_startup) hcl->vmprim.dl_startup (hcl);
return 0; 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 /* NOTE: you can have HCL_OBJ_SHORT, HCL_OBJ_INT
* HCL_OBJ_LONG, HCL_OBJ_FLOAT, HCL_OBJ_DOUBLE, etc * 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_SHORT,
HCL_OBJ_TYPE_INT, 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 */ 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_process_t;
typedef struct hcl_process_t* hcl_oop_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_semaphore_t;
typedef struct hcl_semaphore_t* hcl_oop_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_semaphore_group_t;
typedef struct hcl_semaphore_group_t* hcl_oop_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 struct hcl_process_t
{ {
HCL_OBJ_HEADER; 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_class_t;
typedef struct hcl_class_t* hcl_oop_class_t; typedef struct hcl_class_t* hcl_oop_class_t;
struct hcl_class_t struct hcl_class_t
@ -866,6 +873,7 @@ struct hcl_class_t
hcl_oop_t nivars; /* SmallInteger. */ hcl_oop_t nivars; /* SmallInteger. */
hcl_oop_t ncvars; /* SmallInteger. */ hcl_oop_t ncvars; /* SmallInteger. */
hcl_oop_t nivars_super; /* SmallInteger */ hcl_oop_t nivars_super; /* SmallInteger */
hcl_oop_t ibrand; /* SmallInteger */
hcl_oop_char_t ivarnames; hcl_oop_char_t ivarnames;
hcl_oop_char_t cvarnames; hcl_oop_char_t cvarnames;
@ -926,6 +934,14 @@ struct hcl_class_t
#define HCL_BRANDOF(hcl,oop) \ #define HCL_BRANDOF(hcl,oop) \
(HCL_OOP_GET_TAG(oop)? ((hcl)->tagged_brands[HCL_OOP_GET_TAG(oop)]): HCL_OBJ_GET_FLAGS_BRAND(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 * The HCL_BYTESOF() macro returns the size of the payload of
* an object in bytes. If the pointer given encodes a numeric value, * 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 * because the 2 high extended bits are used only if the low tag bits
* are 3 */ * are 3 */
int tagged_brands[16]; int tagged_brands[16];
hcl_oop_class_t* tagged_classes[16];
hcl_oop_t* volat_stack[256]; /* stack for temporaries */ hcl_oop_t* volat_stack[256]; /* stack for temporaries */
hcl_oow_t volat_count; hcl_oow_t volat_count;
@ -1934,7 +1952,7 @@ struct hcl_t
* ========================================================================= */ * ========================================================================= */
enum hcl_brand_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_SMPTR,
HCL_BRAND_ERROR, HCL_BRAND_ERROR,
HCL_BRAND_CHARACTER, 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(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_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_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_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_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) #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) 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) 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) 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, &superclass);
hcl_pushvolat (hcl, &ivars_str); hcl_pushvolat (hcl, &ivars_str);
hcl_pushvolat (hcl, &cvars_str); hcl_pushvolat (hcl, &cvars_str);
#if 0
c = (hcl_oop_class_t)hcl_allocoopobj(hcl, HCL_BRAND_CLASS, HCL_CLASS_NAMED_INSTVARS + ncvars); 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); hcl_popvolats (hcl, 3);
if (HCL_UNLIKELY(!c)) 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); hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make class - %js", orgmsg);
return HCL_NULL; 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->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 */ c->selfspec = HCL_SMOOI_TO_OOP(0); /* TODO: fix this - encode ncvars to selfspec??? */
c->superclass = superclass; c->superclass = superclass;
c->nivars = HCL_SMOOI_TO_OOP(nivars); c->nivars = HCL_SMOOI_TO_OOP(nivars);
c->ncvars = HCL_SMOOI_TO_OOP(ncvars); 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) 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; 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) static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_obj_type_t* type, hcl_oow_t* outlen)
{ {
/* TODO: */ /* 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); *outlen = HCL_OOP_TO_SMOOI(_class->nivars_super) + HCL_OOP_TO_SMOOI(_class->nivars);
return 0; 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) 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); 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++; 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); oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, vptr, alloclen);
break; break;
/* TODO: more types... HCL_OBJ_TYPE_INT... HCL_OBJ_TYPE_FLOAT, HCL_OBJ_TYPE_UINT16, etc*/
default: default:
hcl_seterrnum (hcl, HCL_EINTERN); hcl_seterrnum (hcl, HCL_EINTERN);
oop = HCL_NULL; 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_IMMUTABLE(spec)) HCL_OBJ_SET_FLAGS_RDONLY (oop, 1);
if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1); if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
#endif #endif
HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
} }
hcl_popvolats (hcl, tmp_count); hcl_popvolats (hcl, tmp_count);
return oop; return oop;

10
lib/read.c
View File

@ -51,7 +51,7 @@ static struct voca_t
{ 5, { '#','\\','t','a','b' } }, { 5, { '#','\\','t','a','b' } },
{ 6, { '#','\\','v','t','a','b' } }, { 6, { '#','\\','v','t','a','b' } },
{ 4, { 'n','u','l','l' } }, { 3, { 'n','i','l' } },
{ 4, { 't','r','u','e' } }, { 4, { 't','r','u','e' } },
{ 5, { 'f','a','l','s','e' } }, { 5, { 'f','a','l','s','e' } },
{ 4, { 's','e','l','f' } }, { 4, { 's','e','l','f' } },
@ -92,7 +92,7 @@ enum voca_id_t
VOCA_CHAR_TAB, VOCA_CHAR_TAB,
VOCA_CHAR_VTAB, VOCA_CHAR_VTAB,
VOCA_KW_NULL, VOCA_KW_NIL,
VOCA_KW_TRUE, VOCA_KW_TRUE,
VOCA_KW_FALSE, VOCA_KW_FALSE,
VOCA_KW_SELF, 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; hcl_tok_type_t type;
} tab[] = } tab[] =
{ {
{ VOCA_KW_NULL, HCL_TOK_NIL }, { VOCA_KW_NIL, HCL_TOK_NIL },
{ VOCA_KW_TRUE, HCL_TOK_TRUE }, { VOCA_KW_TRUE, HCL_TOK_TRUE },
{ VOCA_KW_FALSE, HCL_TOK_FALSE }, { VOCA_KW_FALSE, HCL_TOK_FALSE },
{ VOCA_KW_SELF, HCL_TOK_SELF }, { 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 */ /* 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_type = HCL_CNODE_NIL;
hcl->c->fake_cnode.nil.cn_tok.ptr = vocas[VOCA_KW_NULL].str; hcl->c->fake_cnode.nil.cn_tok.ptr = vocas[VOCA_KW_NIL].str;
hcl->c->fake_cnode.nil.cn_tok.len = vocas[VOCA_KW_NULL].len; 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.cn_type = HCL_CNODE_CONS;
hcl->c->fake_cnode.cons_to_nil.u.cons.car = &hcl->c->fake_cnode.nil; 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 struct
{ {
int fd; 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 struct
{ {
@ -447,7 +447,9 @@ static hcl_mmgr_t sys_mmgr =
enum logfd_flag_t enum logfd_flag_t
{ {
LOGFD_TTY = (1 << 0), 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) 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); xtn_t* xtn = GET_XTN(hcl);
int logfd; int logfd;
int is_tty;
int force_flush = 0; int force_flush = 0;
if (mask & HCL_LOG_STDERR) logfd = 2; if (mask & HCL_LOG_STDERR)
else if (mask & HCL_LOG_STDOUT) logfd = 1; {
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 else
{ {
logfd = xtn->log.fd; logfd = xtn->log.fd;
if (logfd <= -1) return; if (logfd <= -1) return;
is_tty = !!(xtn->log.fd_flags & LOGFD_TTY);
} }
/* TODO: beautify the log message. /* 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); 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); 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); 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); write_log (hcl, logfd, msg, len);
#endif #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); 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_getcontext(&context);
unw_init_local(&cursor, &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++) for (n = 0; unw_step(&cursor) > 0; n++)
{ {
unw_word_t ip, sp, off; 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_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", "#%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); 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) if (btsyms)
{ {
hcl_oow_t i; 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++) 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); 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) 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); backtrace_stack_frames (hcl);
#if defined(_WIN32) #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) static HCL_INLINE void reset_log_to_default (xtn_t* xtn)
{ {
#if defined(ENABLE_LOG_INITIALLY) #if defined(ENABLE_LOG_INITIALLY)
xtn->log.fd = 2; xtn->log.fd = STDERR_FILENO;
xtn->log.fd_flag = 0; xtn->log.fd_flags = 0;
#if defined(HAVE_ISATTY) #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 #endif
#else #else
xtn->log.fd = -1; xtn->log.fd = -1;
xtn->log.fd_flag = 0; xtn->log.fd_flags = 0;
#endif #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) static void cb_fini (hcl_t* hcl)
{ {
xtn_t* xtn = GET_XTN(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); 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 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 = 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 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 #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_ooi_t tally;
hcl_oow_t index; hcl_oow_t index;
hcl_oop_char_t symbol; hcl_oop_char_t sym;
HCL_ASSERT (hcl, len > 0); HCL_ASSERT (hcl, len > 0);
if (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 */ /* find a matching symbol in the open-addressed symbol table */
while (hcl->symtab->bucket->slot[index] != hcl->_nil) while (hcl->symtab->bucket->slot[index] != hcl->_nil)
{ {
symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[index]; sym = (hcl_oop_char_t)hcl->symtab->bucket->slot[index];
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, symbol)); HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, sym));
if (len == HCL_OBJ_GET_SIZE(symbol) && if (len == HCL_OBJ_GET_SIZE(sym) &&
hcl_equal_oochars (ptr, symbol->slot, len)) 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); 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 */ /* 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); /*sym = (hcl_oop_char_t)hcl_alloccharobj(hcl, HCL_BRAND_SYMBOL, ptr, len);*/
if (symbol) 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_ASSERT (hcl, tally < HCL_SMOOI_MAX);
hcl->symtab->tally = HCL_SMOOI_TO_OOP(tally + 1); 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;
} }
else
return (hcl_oop_t)symbol; {
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) 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; ##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); set v (k:get-a);
if (= v 11) { if (= v 11) {
printf "OK - %d\n" v; printf "OK - %d\n" v;

4
t/run.sh
View File

@ -1,3 +1,5 @@
#!/bin/sh #!/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 exit 0