fixed the mssing stack finalization is multiple process manipulation primitive functions

bin/hak.c

@@ -303,19 +303,19 @@ typedef void(*signal_handler_t)(int);
 #if defined(_WIN32) || defined(__DOS__) || defined(__OS2__)
 static void handle_sigint (int sig)
 {
-	if (g_hak) hak_abort (g_hak);
+	if (g_hak) hak_abort(g_hak);
 }
 #elif defined(macintosh)
 /* TODO */
 #elif defined(SA_SIGINFO)
 static void handle_sigint (int sig, siginfo_t* siginfo, void* ctx)
 {
-	if (g_hak) hak_abort (g_hak);
+	if (g_hak) hak_abort(g_hak);
 }
 #else
 static void handle_sigint (int sig)
 {
-	if (g_hak) hak_abort (g_hak);
+	if (g_hak) hak_abort(g_hak);
 }
 #endif
 
@@ -328,7 +328,7 @@ static void set_signal (int sig, signal_handler_t handler)
 #else
 	struct sigaction sa;
 
-	memset (&sa, 0, sizeof(sa));
+	memset(&sa, 0, sizeof(sa));
 	/*sa.sa_handler = handler;*/
 #if defined(SA_SIGINFO)
 	sa.sa_flags = SA_SIGINFO;
@@ -336,16 +336,16 @@ static void set_signal (int sig, signal_handler_t handler)
 #else
 	sa.sa_handler = handler;
 #endif
-	sigemptyset (&sa.sa_mask);
+	sigemptyset(&sa.sa_mask);
 
-	sigaction (sig, &sa, NULL);
+	sigaction(sig, &sa, NULL);
 #endif
 }
 
 static void set_signal_to_default (int sig)
 {
 #if defined(_WIN32) || defined(__DOS__) || defined(__OS2__)
-	signal (sig, SIG_DFL);
+	signal(sig, SIG_DFL);
 #elif defined(macintosh)
 	/* TODO: implement this */
 #else
@@ -354,27 +354,27 @@ static void set_signal_to_default (int sig)
 	memset (&sa, 0, sizeof(sa));
 	sa.sa_handler = SIG_DFL;
 	sa.sa_flags = 0;
-	sigemptyset (&sa.sa_mask);
+	sigemptyset(&sa.sa_mask);
 
-	sigaction (sig, &sa, NULL);
+	sigaction(sig, &sa, NULL);
 #endif
 }
 
 static void set_signal_to_ignore (int sig)
 {
 #if defined(_WIN32) || defined(__DOS__) || defined(__OS2__)
-	signal (sig, SIG_IGN);
+	signal(sig, SIG_IGN);
 #elif defined(macintosh)
 	/* TODO: implement this */
 #else
 	struct sigaction sa;
 
-	memset (&sa, 0, sizeof(sa));
+	memset(&sa, 0, sizeof(sa));
 	sa.sa_handler = SIG_IGN;
 	sa.sa_flags = 0;
 	sigemptyset (&sa.sa_mask);
 
-	sigaction (sig, &sa, NULL);
+	sigaction(sig, &sa, NULL);
 #endif
 }
 

bin/main.go

@@ -7,6 +7,7 @@ import (
 	"io"
 	"os"
 	"strings"
+	"time"
 )
 
 /*
@@ -221,11 +222,56 @@ func handle_arguments(param *Param) error {
 	return nil
 }
 
+func start_ticker(x *hak.Hak) func() {
+	var ticker *time.Ticker
+	var ticker_stop chan bool
+	var ticker_done chan bool
+	var stopper func()
+
+	ticker = time.NewTicker(20 * time.Millisecond)
+	ticker_done = make(chan bool)
+	ticker_stop = make(chan bool)
+
+	go func() {
+		for {
+			select {
+				case <- ticker_stop:
+					goto done
+				case <- ticker.C:
+					x.RaiseTick()
+			}
+		}
+
+	done:
+		ticker.Stop()
+		ticker_done <- true
+	}()
+	x.RcvTick(true)
+
+	stopper = func() {
+		x.RcvTick(false)
+		ticker_stop <- true
+		<- ticker_done // wait for the ticker to stop
+
+		// if i don't close the the two channels below, the multiple calls to the
+		// returned stopper function wouldn't cause immediate panic for writing
+		// on a closed channel. but i would still close them as i don't want to
+		// cater for generic use of this function and this function wasn't
+		// written to be generic. i don't care to use any other more advanced
+		// mechanisms. the caller must ensure to call this stopper only once.
+		close(ticker_stop)
+		close(ticker_done)
+	}
+
+	return stopper
+}
+
 func main() {
 
 	var x *hak.Hak = nil
 	var err error = nil
 	var param Param
+	var stop_ticker func()
 
 	var rfh hak.CciFileHandler
 	var sfh hak.UdiFileHandler
@@ -321,7 +367,9 @@ func main() {
 	 * whole of Execute(). */
 	x.Decode()
 
+	stop_ticker = start_ticker(x)
 	err = x.Execute()
+	stop_ticker()
 	if err != nil {
 		//fmt.Printf("ERROR: %s[%d:%d] - %s\n", herr.File, herr.Line, herr.Colm, herr.Msg)
 		fmt.Printf("ERROR: %s\n", err.Error())

hak.go

@@ -482,6 +482,16 @@ func (hak *Hak) Decode() error {
 	return nil
 }
 
+func (hak *Hak) RcvTick(enabled bool) {
+	var i C.int
+	if enabled { i = 1 } else { i = 0 }
+	C.hak_rcvtick(hak.c, i)
+}
+
+func (hak *Hak) RaiseTick() {
+	C.hak_raisetick(hak.c)
+}
+
 func (hak *Hak) get_errmsg() string {
 	return C.GoString(C.hak_geterrbmsg(hak.c))
 }

lib/exec.c

@@ -835,7 +835,7 @@ static void switch_to_process (hak_t* hak, hak_oop_process_t proc, int new_state
 
 	/* the new process must be in the runnable state */
 	HAK_ASSERT(hak, proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_RUNNABLE) ||
-	                 proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_WAITING));
+	                proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_WAITING));
 
 	sleep_active_process(hak, new_state_for_old_active);
 	wake_process(hak, proc);
@@ -1341,7 +1341,6 @@ static void yield_process (hak_t* hak, hak_oop_process_t proc)
 	}
 }
 
-
 static int async_signal_semaphore (hak_t* hak, hak_oop_semaphore_t sem)
 {
 #if 0
@@ -5640,8 +5639,13 @@ hak_pfrc_t hak_pf_process_resume (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 		return HAK_PF_FAILURE;
 	}
 
+	/* [SPECIAL CASE]
+	 * resume_process changes the the active process.
+	 * calling this after resume_process() pollutes a wrong stack. place it here */
+	HAK_STACK_SETRET(hak, nargs, prc);
+
 	resume_process(hak, prc);
-	return  HAK_PF_SUCCESS;
+	return HAK_PF_SUCCESS;
 }
 
 hak_pfrc_t hak_pf_process_suspend (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
@@ -5662,8 +5666,13 @@ hak_pfrc_t hak_pf_process_suspend (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 		prc = hak->processor->active;
 	}
 
+	/* [SPECIAL CASE]
+	 * suspend_process changes the the active process.
+	 * calling this after suspend_process() pollutes a wrong stack. place it here */
+	HAK_STACK_SETRET(hak, nargs, prc);
+
 	suspend_process(hak, prc);
-	return  HAK_PF_SUCCESS;
+	return HAK_PF_SUCCESS;
 }
 
 hak_pfrc_t hak_pf_process_terminate (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
@@ -5684,20 +5693,35 @@ hak_pfrc_t hak_pf_process_terminate (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs
 		prc = hak->processor->active;
 	}
 
+	/* [SPECIAL CASE]
+	 * terminate_process changes the the active process.
+	 * calling this after terminate_process() pollutes a wrong stack. place it here */
+	HAK_STACK_SETRET(hak, nargs, prc);
+
 	terminate_process(hak, prc);
 	return  HAK_PF_SUCCESS;
 }
 
 hak_pfrc_t hak_pf_process_terminate_all (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
+	/* [SPECIAL CASE]
+	 * terminate_all_processes changes the the active process.
+	 * calling this after terminate_all_processes() pollutes a wrong stack. place it here */
+	HAK_STACK_SETRET(hak, nargs, hak->_nil);
+
 	terminate_all_processes(hak);
-	return  HAK_PF_SUCCESS;
+	return HAK_PF_SUCCESS;
 }
 
 hak_pfrc_t hak_pf_process_yield (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
+	/* [SPECIAL CASE]
+	 * yield_process changes the the active process.
+	 * calling this after yield_process() pollutes a wrong stack. place it here */
+	HAK_STACK_SETRET(hak, nargs, hak->_nil);
+
 	yield_process(hak, hak->processor->active);
-	return  HAK_PF_SUCCESS;
+	return HAK_PF_SUCCESS;
 }
 
 /* ------------------------------------------------------------------ */
@@ -5715,7 +5739,22 @@ hak_pfrc_t hak_pf_semaphore_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 		return HAK_PF_FAILURE;
 	}
 
-	sem->count = HAK_SMOOI_TO_OOP(0);
+	if (nargs >= 1)
+	{
+		hak_oop_t tmp;
+		tmp = (hak_oop_semaphore_t)HAK_STACK_GETARG(hak, nargs, 0);
+		if (!HAK_OOP_IS_SMOOI(tmp))
+		{
+			hak_seterrbfmt(hak, HAK_EINVAL, "invalid semaphore count - %O", tmp);
+			return HAK_PF_FAILURE;
+		}
+		sem->count = tmp;
+	}
+	else
+	{
+		sem->count = HAK_SMOOI_TO_OOP(0);
+	}
+
 /* TODO: sem->signal_action? */
 	/* other fields are all set to nil */
 

lib/hak-prv.h

@@ -2272,6 +2272,15 @@ hak_pfrc_t hak_pf_semaphore_group_add_semaphore (hak_t* hak, hak_mod_t* mod, hak
 hak_pfrc_t hak_pf_semaphore_group_remove_semaphore (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
 hak_pfrc_t hak_pf_semaphore_group_wait (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
 
+/* the signal primitives live in prim.c but are registered by the sys module,
+ * which reaches them as sys.sig-getfd, sys.sig-get, sys.sig-set, sys.sig-catch
+ * and sys.sig-uncatch */
+hak_pfrc_t hak_pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
+hak_pfrc_t hak_pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
+hak_pfrc_t hak_pf_system_set_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
+hak_pfrc_t hak_pf_system_catch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
+hak_pfrc_t hak_pf_system_uncatch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
+
 /* ========================================================================= */
 /* std.c                                                                    */
 /* ========================================================================= */

lib/prim.c

@@ -1256,7 +1256,7 @@ hak_pfrc_t hak_pf_object_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 
 /* ------------------------------------------------------------------------- */
 
-static hak_pfrc_t pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+hak_pfrc_t hak_pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
 	hak_ooi_t fd;
 	hak_hnd_t* hnd;
@@ -1275,7 +1275,7 @@ static hak_pfrc_t pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nar
 	return HAK_PF_SUCCESS;
 }
 
-static hak_pfrc_t pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+hak_pfrc_t hak_pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
 	hak_uint8_t sig;
 	int n;
@@ -1289,12 +1289,12 @@ static hak_pfrc_t pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs
 	return HAK_PF_SUCCESS;
 }
 
-/* (system-catch-sig signo)   - route an operating system signal into the
+/* (sys.sig-catch signo)   - route an operating system signal into the signal
- *                              signal descriptor, where hak code can wait for
+ *                           descriptor, where hak code can wait for it with
- *                              it with core.sem-signal-on-input
+ *                           core.sem-signal-on-input
- * (system-uncatch-sig signo) - release it again
+ * (sys.sig-uncatch signo) - release it again
  *
- * Note the difference from system-set-sig, which does not touch the operating
+ * Note the difference from sys.sig-set, which does not touch the operating
  * system at all: that one injects a number into the descriptor directly, as a
  * way for hak code to post a synthetic signal to itself.
  */
@@ -1323,17 +1323,17 @@ static hak_pfrc_t __system_catch_sig (hak_t* hak, hak_ooi_t nargs, int enable)
 	return HAK_PF_SUCCESS;
 }
 
-static hak_pfrc_t pf_system_catch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+hak_pfrc_t hak_pf_system_catch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
 	return __system_catch_sig(hak, nargs, 1);
 }
 
-static hak_pfrc_t pf_system_uncatch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+hak_pfrc_t hak_pf_system_uncatch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
 	return __system_catch_sig(hak, nargs, 0);
 }
 
-static hak_pfrc_t pf_system_set_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+hak_pfrc_t hak_pf_system_set_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
 	hak_oop_t tmp;
 	hak_uint8_t sig;
@@ -1366,11 +1366,10 @@ static pf_t builtin_prims[] =
 	{ 1, HAK_TYPE_MAX(hak_oow_t), pf_scanf,           5,  { 's','c','a','n','f' } },
 	{ 1, HAK_TYPE_MAX(hak_oow_t), pf_sprintf,         7,  { 's','p','r','i','n','t','f' } },
 
-	{ 0, 0,                       pf_system_get_sigfd,   16, { 's','y','s','t','e','m','-','g','e','t','-','s','i','g','f','d' } },
+	/* the signal primitives are registered by the sys module instead - see
-	{ 0, 0,                       pf_system_get_sig,     14,  { 's','y','s','t','e','m','-','g','e','t','-','s','i','g' } },
+	 * pfinfos[] in mod/sys.c. they are reached as sys.sig-getfd, sys.sig-get,
-	{ 1, 1,                       pf_system_set_sig,     14,  { 's','y','s','t','e','m','-','s','e','t','-','s','i','g' } },
+	 * sys.sig-set, sys.sig-catch and sys.sig-uncatch. the implementations stay
-	{ 1, 1,                       pf_system_catch_sig,   16, { 's','y','s','t','e','m','-','c','a','t','c','h','-','s','i','g' } },
+	 * here and are declared in lib/hak-prv.h. */
-	{ 1, 1,                       pf_system_uncatch_sig, 18, { 's','y','s','t','e','m','-','u','n','c','a','t','c','h','-','s','i','g' } },
 
 	{ 0, 0,                       pf_gc,              2,  { 'g','c' } },
 

lib/std.c

@@ -356,7 +356,7 @@
  * about async-signal-safety - the spinlock is built out of atomics and is safe
  * by that measure - but about reentrancy: a signal delivered to the thread
  * that already holds the lock would spin, or block, on a lock that thread can
- * no longer reach the end of. post_sig_to_all_haks() therefore walk the chain without it.
+ * no longer reach the end of. post_sig_to_all_haks() therefore walks the chain without it.
  * -------------------------------------------------------------------------- */
 
 #if defined(USE_THREAD)
@@ -2104,6 +2104,8 @@ kqueue_syserr:
 #elif defined(USE_SELECT)
 #	define MUXEVT_FD(e)   ((e).fd)
 #	define MUXEVT_MASK(e) ((e).events)
+#else
+#	error UNSUPPORTED
 #endif
 
 /* Drop multiplexer events already sitting in the buffer for this descriptor.
@@ -2453,20 +2455,7 @@ static void vm_muxwait (hak_t* hak, const hak_ntime_t* dur, hak_vmprim_muxwait_c
 		{
 			--n;
 
-		#if defined(USE_DEVPOLL)
+			if (MUXEVT_FD(xtn->ev.buf[n]) == xtn->iothr.p[0])
-			if (xtn->ev.buf[n].fd == xtn->iothr.p[0])
-		#elif defined(USE_KQUEUE)
-			if (xtn->ev.buf[n].ident == xtn->iothr.p[0])
-		#elif defined(USE_EPOLL)
-			/*if (xtn->ev.buf[n].data.ptr == (void*)HAK_TYPE_MAX(hak_oow_t))*/
-			if (xtn->ev.buf[n].data.fd == xtn->iothr.p[0])
-		#elif defined(USE_POLL)
-			if (xtn->ev.buf[n].fd == xtn->iothr.p[0])
-		#elif defined(USE_SELECT)
-			if (xtn->ev.buf[n].fd == xtn->iothr.p[0])
-		#else
-		#	error UNSUPPORTED
-		#endif
 			{
 				hak_uint8_t u8;
 				while (read(xtn->iothr.p[0], &u8, HAK_SIZEOF(u8)) > 0)
@@ -2480,21 +2469,15 @@ static void vm_muxwait (hak_t* hak, const hak_ntime_t* dur, hak_vmprim_muxwait_c
 				int revents;
 				hak_ooi_t mask;
 
-			#if defined(USE_DEVPOLL)
+			#if defined(USE_KQUEUE)
-				revents = xtn->ev.buf[n].revents;
-			#elif defined(USE_KQUEUE)
 				revents = 0;
 				/* it's "if .. else if" because kqueue filter is either READ or WRITE. */
 				if (xtn->ev.buf[n].filter == EVFILT_READ) revents |= XPOLLIN;
 				else if (xtn->ev.buf[n].filter == EVFILT_WRITE) revents |= XPOLLOUT;
 				if (xtn->ev.buf[n].flags & EV_EOF) revents |= XPOLLHUP;
 				if (xtn->ev.buf[n].flags & EV_ERROR) revents |= XPOLLERR;
-			#elif defined(USE_EPOLL)
+			#else
-				revents = xtn->ev.buf[n].events;
+				revents = MUXEVT_MASK(xtn->ev.buf[n]);
-			#elif defined(USE_POLL)
-				revents = xtn->ev.buf[n].revents;
-			#elif defined(USE_SELECT)
-				revents = xtn->ev.buf[n].events;
 			#endif
 
 				mask = 0;
@@ -2503,19 +2486,7 @@ static void vm_muxwait (hak_t* hak, const hak_ntime_t* dur, hak_vmprim_muxwait_c
 				if (revents & XPOLLERR) mask |= HAK_SEMAPHORE_IO_MASK_ERROR;
 				if (revents & XPOLLHUP) mask |= HAK_SEMAPHORE_IO_MASK_HANGUP;
 
-			#if defined(USE_DEVPOLL)
+				muxwcb(hak, MUXEVT_FD(xtn->ev.buf[n]), mask);
-				muxwcb(hak, xtn->ev.buf[n].fd, mask);
-			#elif defined(USE_KQUEUE)
-				muxwcb(hak, xtn->ev.buf[n].ident, mask);
-			#elif defined(USE_EPOLL)
-				muxwcb(hak, xtn->ev.buf[n].data.fd, mask);
-			#elif defined(USE_POLL)
-				muxwcb(hak, xtn->ev.buf[n].fd, mask);
-			#elif defined(USE_SELECT)
-				muxwcb(hak, xtn->ev.buf[n].fd, mask);
-			#else
-			#	error UNSUPPORTED
-			#endif
 			}
 		}
 		while (n > 0);
@@ -2864,6 +2835,7 @@ static void dispatch_siginfo (int sig, siginfo_t* si, void* ctx)
 	if (g_sig_state[sig].handler != (hak_uintptr_t)SIG_IGN &&
 	    g_sig_state[sig].handler != (hak_uintptr_t)SIG_DFL)
 	{
+		/* execute the current handler */
 		((sig_handler_t)g_sig_state[sig].handler)(sig);
 	}
 
@@ -2871,6 +2843,9 @@ static void dispatch_siginfo (int sig, siginfo_t* si, void* ctx)
 	    g_sig_state[sig].old_handler != (hak_uintptr_t)SIG_IGN &&
 	    g_sig_state[sig].old_handler != (hak_uintptr_t)SIG_DFL)
 	{
+		/* execute the original remembered handler */
+/* TODO: if the runtime has installed its own signal handler, proably this one must not be called.
+ *       when the runtime registers a single handler, it may optionally request that the previous one should also be invoked? */
 		((void(*)(int, siginfo_t*, void*))g_sig_state[sig].old_handler)(sig, si, ctx);
 	}
 }
@@ -3137,8 +3112,10 @@ static HAK_INLINE void post_sig_to_all_haks (int signo)
 		{
 			xtn_t* xtn = GET_XTN(hak);
 			hak_uint8_t u8;
-			/*hak_abortstd(hak);*/
+
 			u8 = signo & 0xFF;
+			/* write a byte of signal number. vm_getsig() reads this when
+			 * it's invoked by the vm */
 			write(xtn->sigfd.p[1], &u8, HAK_SIZEOF(u8));
 			hak = xtn->next;
 		}
@@ -3535,7 +3512,6 @@ static HAK_INLINE int start_ticker (void)
 				nanosleep(&ts, HAK_NULL);
 			#elif defined(HAVE_USLEEP)
 				usleep(HAK_TICKER_INTERVAL_USECS * 2);
-
 			#else
 			#	error UNDEFINED SLEEP
 			#endif

mod/core.c

@@ -606,6 +606,7 @@ static hak_pfinfo_t pfinfos[] =
 	{ "cons",               { HAK_PFBASE_FUNC, pf_core_cons,                  2,  2 } },
 
 	{ "current-process",    { HAK_PFBASE_FUNC, hak_pf_process_current,        0,  0 } },
+
 	{ "eqk?",               { HAK_PFBASE_FUNC, hak_pf_eqk,                    2,  2 } },
 	{ "eql?",               { HAK_PFBASE_FUNC, hak_pf_eql,                    2,  2 } },
 	{ "eqv?",               { HAK_PFBASE_FUNC, hak_pf_eqv,                    2,  2 } },
@@ -621,8 +622,10 @@ static hak_pfinfo_t pfinfos[] =
 
 	{ "primAt",             { HAK_PFBASE_FUNC, pf_core_prim_at,               2,  2 } },
 	{ "primAtPut",          { HAK_PFBASE_FUNC, pf_core_prim_at_put,           3,  3 } },
+
 	{ "resume",             { HAK_PFBASE_FUNC, hak_pf_process_resume,         1,  1 } },
-	{ "sem-new",            { HAK_PFBASE_FUNC, hak_pf_semaphore_new,          0,  0 } },
+
+	{ "sem-new",            { HAK_PFBASE_FUNC, hak_pf_semaphore_new,          0,  1 } },
 	{ "sem-signal",         { HAK_PFBASE_FUNC, hak_pf_semaphore_signal,       1,  3 } },
 	{ "sem-signal-on-input",  { HAK_PFBASE_FUNC, hak_pf_semaphore_signal_on_input,  2,  2 } },
 	{ "sem-signal-on-output", { HAK_PFBASE_FUNC, hak_pf_semaphore_signal_on_output, 2,  2 } },
@@ -632,13 +635,16 @@ static hak_pfinfo_t pfinfos[] =
 	{ "semgr-new",          { HAK_PFBASE_FUNC, hak_pf_semaphore_group_new,              0,  0 } },
 	{ "semgr-remove",       { HAK_PFBASE_FUNC, hak_pf_semaphore_group_remove_semaphore, 1,  2 } },
 	{ "semgr-wait",         { HAK_PFBASE_FUNC, hak_pf_semaphore_group_wait,             1,  1 } },
+
 	{ "slice",              { HAK_PFBASE_FUNC, pf_core_slice,                 3,  3 } },
 	{ "smooiToChar",        { HAK_PFBASE_FUNC, pf_core_smooi_to_char,         1,  1 } },
 	{ "sqrt",               { HAK_PFBASE_FUNC, hak_pf_number_sqrt,            1,  1 } },
+
 	{ "suspend",            { HAK_PFBASE_FUNC, hak_pf_process_suspend,        0,  1 } },
 	{ "terminate",          { HAK_PFBASE_FUNC, hak_pf_process_terminate,      0,  1 } },
 	{ "terminate-all",      { HAK_PFBASE_FUNC, hak_pf_process_terminate_all,  0,  0 } },
 	{ "yield",              { HAK_PFBASE_FUNC, hak_pf_process_yield,          0,  0 } },
+
 	{ "~=",                 { HAK_PFBASE_FUNC, hak_pf_number_ne,              2,  2 } },
 };
 

mod/sys.c

@@ -31,9 +31,8 @@
 #endif
 
 #include "_sys.h"
-#include <hak-hnd.h>
+#include "../lib/hak-prv.h"
 #include <hak-pio.h>
-#include <hak-str.h>
 #include <stdlib.h>
 #include <signal.h>
 
@@ -735,88 +734,95 @@ static hak_pfrc_t pf_sys_pclose (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 static hak_pfinfo_t pfinfos[] =
 {
 #if defined(SIGABRT)
-	{ "SIGABRT",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGABRT }},
+	{ "SIGABRT",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGABRT }},
 #endif
 #if defined(SIGALRM)
-	{ "SIGALRM",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGALRM }},
+	{ "SIGALRM",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGALRM }},
 #endif
 #if defined(SIGBUS)
-	{ "SIGBUS",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGBUS }},
+	{ "SIGBUS",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGBUS }},
 #endif
 #if defined(SIGCHLD)
-	{ "SIGCHLD",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGCHLD }},
+	{ "SIGCHLD",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGCHLD }},
 #endif
 #if defined(SIGCONT)
-	{ "SIGCONT",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGCONT }},
+	{ "SIGCONT",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGCONT }},
 #endif
 #if defined(SIGFPE)
-	{ "SIGFPE",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGFPE }},
+	{ "SIGFPE",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGFPE }},
 #endif
 #if defined(SIGHUP)
-	{ "SIGHUP",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGHUP }},
+	{ "SIGHUP",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGHUP }},
 #endif
 #if defined(SIGILL)
-	{ "SIGILL",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGILL }},
+	{ "SIGILL",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGILL }},
 #endif
 #if defined(SIGINT)
-	{ "SIGINT",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGINT }},
+	{ "SIGINT",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGINT }},
 #endif
 #if defined(SIGKILL)
-	{ "SIGKILL",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGKILL }},
+	{ "SIGKILL",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGKILL }},
 #endif
 #if defined(SIGPIPE)
-	{ "SIGPIPE",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGPIPE }},
+	{ "SIGPIPE",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGPIPE }},
 #endif
 #if defined(SIGQUIT)
-	{ "SIGQUIT",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGQUIT }},
+	{ "SIGQUIT",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGQUIT }},
 #endif
 #if defined(SIGSEGV)
-	{ "SIGSEGV",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGSEGV }},
+	{ "SIGSEGV",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGSEGV }},
 #endif
 #if defined(SIGSTOP)
-	{ "SIGSTOP",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGSTOP }},
+	{ "SIGSTOP",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGSTOP }},
 #endif
 #if defined(SIGTERM)
-	{ "SIGTERM",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGTERM }},
+	{ "SIGTERM",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGTERM }},
 #endif
 #if defined(SIGTSTP)
-	{ "SIGTSTP",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGTSTP }},
+	{ "SIGTSTP",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGTSTP }},
 #endif
 #if defined(SIGTTIN)
-	{ "SIGTTIN",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGTTIN }},
+	{ "SIGTTIN",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGTTIN }},
 #endif
 #if defined(SIGTTOU)
-	{ "SIGTTOU",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGTTOU }},
+	{ "SIGTTOU",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGTTOU }},
 #endif
 #if defined(SIGURG)
-	{ "SIGURG",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGURG }},
+	{ "SIGURG",        { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGURG }},
 #endif
 #if defined(SIGUSR1)
-	{ "SIGUSR1",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGUSR1 }},
+	{ "SIGUSR1",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGUSR1 }},
 #endif
 #if defined(SIGUSR2)
-	{ "SIGUSR2",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGUSR2 }},
+	{ "SIGUSR2",       { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGUSR2 }},
 #endif
 #if defined(SIGVTALRM)
-	{ "SIGVTALRM",     { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGVTALRM }},
+	{ "SIGVTALRM",     { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGVTALRM }},
 #endif
 #if defined(SIGWINCH)
-	{ "SIGWINCH",      { HAK_PFBASE_CONST_SMOOI, HAK_NULL,          0, (hak_oow_t)(hak_ooi_t)SIGWINCH }},
+	{ "SIGWINCH",      { HAK_PFBASE_CONST_SMOOI, HAK_NULL,            0, (hak_oow_t)(hak_ooi_t)SIGWINCH }},
 #endif
 
-	{ "close",       { HAK_PFBASE_FUNC,        pf_sys_close,        1,  1 } },
+	{ "close",         { HAK_PFBASE_FUNC,        pf_sys_close,        1,  1 } },
-	{ "open",        { HAK_PFBASE_FUNC,        pf_sys_open,         2,  3 } },
+	{ "open",          { HAK_PFBASE_FUNC,        pf_sys_open,         2,  3 } },
-	{ "pclose",      { HAK_PFBASE_FUNC,        pf_sys_pclose,       1,  1 } },
+	{ "pclose",        { HAK_PFBASE_FUNC,        pf_sys_pclose,       1,  1 } },
-	{ "pipe",        { HAK_PFBASE_FUNC,        pf_sys_pipe,         0,  0 } },
+	{ "pipe",          { HAK_PFBASE_FUNC,        pf_sys_pipe,         0,  0 } },
-	{ "pkill",       { HAK_PFBASE_FUNC,        pf_sys_pkill,        1,  1 } },
+	{ "pkill",         { HAK_PFBASE_FUNC,        pf_sys_pkill,        1,  1 } },
-	{ "popen",       { HAK_PFBASE_FUNC,        pf_sys_popen,        1,  2 } },
+	{ "popen",         { HAK_PFBASE_FUNC,        pf_sys_popen,        1,  2 } },
-	{ "pwait",       { HAK_PFBASE_FUNC,        pf_sys_pwait,        1,  1 } },
+	{ "pwait",         { HAK_PFBASE_FUNC,        pf_sys_pwait,        1,  1 } },
-	{ "random",      { HAK_PFBASE_FUNC,        pf_sys_random,       0,  0 } },
+	{ "random",        { HAK_PFBASE_FUNC,        pf_sys_random,       0,  0 } },
-	{ "read",        { HAK_PFBASE_FUNC,        pf_sys_read,         2,  4 } },
+	{ "read",          { HAK_PFBASE_FUNC,        pf_sys_read,         2,  4 } },
-	{ "srandom",     { HAK_PFBASE_FUNC,        pf_sys_srandom,      1,  1 } },
+
-	{ "stime",       { HAK_PFBASE_FUNC,        pf_sys_stime,        1,  1 } },
+	{ "sig-catch",     { HAK_PFBASE_FUNC,        hak_pf_system_catch_sig,   1,  1 } },
-	{ "time",        { HAK_PFBASE_FUNC,        pf_sys_time,         0,  0 } },
+	{ "sig-get",       { HAK_PFBASE_FUNC,        hak_pf_system_get_sig,     0,  0 } },
-	{ "write",       { HAK_PFBASE_FUNC,        pf_sys_write,        2,  4 } }
+	{ "sig-getfd",     { HAK_PFBASE_FUNC,        hak_pf_system_get_sigfd,   0,  0 } },
+	{ "sig-set",       { HAK_PFBASE_FUNC,        hak_pf_system_set_sig,     1,  1 } },
+	{ "sig-uncatch",   { HAK_PFBASE_FUNC,        hak_pf_system_uncatch_sig, 1,  1 } },
+
+	{ "srandom",       { HAK_PFBASE_FUNC,        pf_sys_srandom,      1,  1 } },
+	{ "stime",         { HAK_PFBASE_FUNC,        pf_sys_stime,        1,  1 } },
+	{ "time",          { HAK_PFBASE_FUNC,        pf_sys_time,         0,  0 } },
+	{ "write",         { HAK_PFBASE_FUNC,        pf_sys_write,        2,  4 } }
 };
 
 /* ------------------------------------------------------------------------ */

src/Semaphore.hak

@@ -13,27 +13,35 @@ class[#uncopyable] Semaphore: Object(
 	_grm_next
 ) {
 	fun[#class] new() {
-		return (core.sem-new)
+		return (core.sem-new 0)
+	}
+
+	fun[#class] forMutex() {
+		return (core.sem-new 1)
+	}
+
+	fun signal() {
+		return (core.sem-signal self 0 0)
 	}
 
 	fun signalAfter(secs nsecs) {
-		core.sem-signal self secs nsecs
+		return (core.sem-signal self secs nsecs)
 	}
 
 	fun signalOnInput(handle) {
-		core.sem-signal-on-input self handle
+		return (core.sem-signal-on-input self handle)
 	}
 
 	fun signalOnOutput(handle) {
-		core.sem-signal-on-output self handle
+		return (core.sem-signal-on-output self handle)
 	}
 
 	fun unsignal() {
-		core.sem-unsignal self
+		return (core.sem-unsignal self)
 	}
 
 	fun wait() {
-		core.sem-wait self
+		return (core.sem-wait self)
 	}
 }
 
@@ -52,14 +60,14 @@ class[#uncopyable] SemaphoreGroup: Object(
 	}
 
 	fun add(sem) {
-		core.semgr-add self sem
+		return (core.semgr-add self sem)
 	}
 
 	fun remove(sem) {
-		core.semgr-remove self sem
+		return (core.semgr-remove self sem)
 	}
 
 	fun wait() {
-		core.semgr-wait self
+		return (core.semgr-wait self)
 	}
 }

src/proc.hak

@@ -107,10 +107,10 @@ class ChildGroup(
 			## semaphore on the signal descriptor for the whole group, once.
 			if (not self.shared) {
 				set shared true
-				system-catch-sig sys.SIGCHLD
+				sys.sig-catch sys.SIGCHLD
 				set sigsem (core.sem-new)
 				core.semgr-add self.sg self.sigsem
-				core.sem-signal-on-input self.sigsem (system-get-sigfd)
+				core.sem-signal-on-input self.sigsem (sys.sig-getfd)
 			}
 		} else {
 			## A handle of its own, so a wakeup identifies this child directly.
@@ -180,7 +180,7 @@ class ChildGroup(
 			if self.shared {
 				## the signal descriptor spoke: take the byte, then look at
 				## everyone, since one SIGCHLD may stand for several exits
-				system-get-sig
+				sys.sig-get
 				kid := (self:finished)
 				if (not (nil? kid)) { return kid }
 				## otherwise it was a SIGCHLD for a child of the host
@@ -228,7 +228,7 @@ class ChildGroup(
 		}
 		if self.shared {
 			core.sem-unsignal self.sigsem
-			system-uncatch-sig sys.SIGCHLD
+			sys.sig-uncatch sys.SIGCHLD
 			set shared false
 		}
 	}

t/sig-01.hak

@@ -27,17 +27,17 @@ sys.close (core.basicAt q 0)
 sys.close (core.basicAt q 1)
 
 ## --- catch and uncatch are idempotent ---
-chk (= (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "system-catch-sig returns the signal number"
+chk (= (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-catch returns the signal number"
-chk (= (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "catching an already caught signal is fine"
+chk (= (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "catching an already caught signal is fine"
-chk (= (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "system-uncatch-sig returns the signal number"
+chk (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-uncatch returns the signal number"
-chk (= (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "uncatching an uncaught signal is fine"
+chk (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "uncatching an uncaught signal is fine"
 
 ## --- a real signal reaches hak code, without stalling the coprocesses ---
 ## SIGCHLD is used because a child exiting is something this test can arrange
 ## on its own, with no outside help.
-system-catch-sig sys.SIGCHLD
+sys.sig-catch sys.SIGCHLD
 
-h     := (system-get-sigfd)
+h     := (sys.sig-getfd)
 s     := (core.sem-new)
 tmo   := (core.sem-new)
 sg    := (core.semgr-new)
@@ -58,7 +58,7 @@ fun waiter() {
 	core.sem-unsignal s
 	core.sem-unsignal tmo
 	if (eqv? w tmo) { signo := -2 } \
-	else { signo := (system-get-sig) }
+	else { signo := (sys.sig-get) }
 	core.sem-signal fin
 	return 0
 }
@@ -79,4 +79,4 @@ chk (= ticks 4) "coprocesses ran while a coprocess waited on a signal"
 chk (= signo sys.SIGCHLD) "the signal number came through the signal descriptor"
 chk (= (sys.pwait proc) 4) "and the child's exit status is readable"
 sys.pclose proc
-system-uncatch-sig sys.SIGCHLD
+sys.sig-uncatch sys.SIGCHLD

t/sig-02.hak

@@ -54,8 +54,8 @@ chk (== sys.SIGTERM 15) "SIGTERM is 15"
 
 ## and the constants behave: a routable one can be caught, an unroutable one
 ## cannot, whatever the numbers happen to be here
-chk (== (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is catchable"
+chk (== (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is catchable"
-chk (== (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is uncatchable again"
+chk (== (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is uncatchable again"
 raised := false
-try { system-catch-sig sys.SIGKILL } catch (e) { raised := true }
+try { sys.sig-catch sys.SIGKILL } catch (e) { raised := true }
 chk raised "SIGKILL is refused"

t/sig-5001.err

@@ -1,41 +1,41 @@
 ## signals that cannot be caught
-system-catch-sig sys.SIGKILL ##ERROR: not routable
+sys.sig-catch sys.SIGKILL ##ERROR: not routable
 
 ---
 
-system-catch-sig sys.SIGSTOP ##ERROR: not routable
+sys.sig-catch sys.SIGSTOP ##ERROR: not routable
 
 ---
 
 ## signals that indicate a crash: turning one into a byte on a pipe and
 ## carrying on would hide the fault rather than report it
-system-catch-sig sys.SIGSEGV ##ERROR: not routable
+sys.sig-catch sys.SIGSEGV ##ERROR: not routable
 
 ---
 
-system-catch-sig sys.SIGBUS ##ERROR: not routable
+sys.sig-catch sys.SIGBUS ##ERROR: not routable
 
 ---
 
-system-catch-sig sys.SIGFPE ##ERROR: not routable
+sys.sig-catch sys.SIGFPE ##ERROR: not routable
 
 ---
 
-system-catch-sig sys.SIGILL ##ERROR: not routable
+sys.sig-catch sys.SIGILL ##ERROR: not routable
 
 ---
 
 ## the timer signal hak itself uses to switch processes
-system-catch-sig sys.SIGVTALRM ##ERROR: not routable
+sys.sig-catch sys.SIGVTALRM ##ERROR: not routable
 
 ---
 
-system-catch-sig 0 ##ERROR: 0 not routable
+sys.sig-catch 0 ##ERROR: 0 not routable
 
 ---
 
-system-catch-sig 9999 ##ERROR: 9999 not routable
+sys.sig-catch 9999 ##ERROR: 9999 not routable
 
 ---
 
-system-catch-sig "two" ##ERROR: number not a small integer
+sys.sig-catch "two" ##ERROR: number not a small integer