refactored the ticker code using a global variable. - hawk_raise_gtick().

also implemented the instance_specific tick - hawk_raise_tick()

Makefile.am

@@ -4,7 +4,7 @@ ACLOCAL_AMFLAGS = -I m4
 gosrcdir = $(datadir)/hak/go
 gosrc_DATA = go.mod hak.go hak-inst.go hak-cb.go
 
-EXTRA_DIST = t t/test-bi.hak
+EXTRA_DIST = t t/test-bi.hak src
 
 SUBDIRS =
 

Makefile.in

@@ -386,7 +386,7 @@ AUTOMAKE_OPTION = foreign
 ACLOCAL_AMFLAGS = -I m4
 gosrcdir = $(datadir)/hak/go
 gosrc_DATA = go.mod hak.go hak-inst.go hak-cb.go
-EXTRA_DIST = t t/test-bi.hak
+EXTRA_DIST = t t/test-bi.hak src
 SUBDIRS = $(am__append_1) $(am__append_2)
 DIST_SUBDIRS = $(SUBDIRS) pas
 all: all-recursive

bin/hak.c

@@ -360,6 +360,24 @@ static void set_signal_to_default (int sig)
 #endif
 }
 
+static void set_signal_to_ignore (int sig)
+{
+#if defined(_WIN32) || defined(__DOS__) || defined(__OS2__)
+	signal (sig, SIG_IGN);
+#elif defined(macintosh)
+	/* TODO: implement this */
+#else
+	struct sigaction sa;
+
+	memset (&sa, 0, sizeof(sa));
+	sa.sa_handler = SIG_IGN;
+	sa.sa_flags = 0;
+	sigemptyset (&sa.sa_mask);
+
+	sigaction (sig, &sa, NULL);
+#endif
+}
+
 /* ========================================================================= */
 
 static void print_info (void)
@@ -464,7 +482,10 @@ static hak_oop_t execute_in_interactive_mode (hak_t* hak)
 	hak_decode (hak, hak_getcode(hak), 0, hak_getbclen(hak));
 	HAK_LOG0 (hak, HAK_LOG_MNEMONIC, "------------------------------------------\n");
 	g_hak = hak;
-	/*setup_tick ();*/
+
+	hak_catch_termreq();
+	hak_start_ticker();
+	hak_rcvtick(hak, 1);
 
 	retv = hak_execute(hak);
 
@@ -490,7 +511,11 @@ static hak_oop_t execute_in_interactive_mode (hak_t* hak)
 		}
 		*/
 	}
-	/*cancel_tick();*/
+
+	hak_rcvtick(hak, 0);
+	hak_stop_ticker();
+	hak_uncatch_termreq();
+
 	g_hak = HAK_NULL;
 
 	return retv;
@@ -503,8 +528,10 @@ static hak_oop_t execute_in_batch_mode(hak_t* hak, int verbose)
 	hak_decode(hak, hak_getcode(hak), 0, hak_getbclen(hak));
 	HAK_LOG3(hak, HAK_LOG_MNEMONIC, "BYTECODES bclen=%zu lflen=%zu ngtmprs=%zu\n", hak_getbclen(hak), hak_getlflen(hak), hak_getngtmprs(hak));
 	g_hak = hak;
-	/*setup_tick ();*/
 
+	hak_catch_termreq();
+	hak_start_ticker();
+	hak_rcvtick(hak, 1);
 
 /* TESTING */
 #if 0
@@ -531,10 +558,15 @@ static hak_oop_t execute_in_batch_mode(hak_t* hak, int verbose)
 	if (!retv) print_error(hak, "execute");
 	else if (verbose) hak_logbfmt(hak, HAK_LOG_STDERR, "EXECUTION OK - EXITED WITH %O\n", retv);
 
+	hak_rcvtick(hak, 0);
+	hak_stop_ticker();
+	hak_uncatch_termreq();
+
 	/*cancel_tick();*/
 	g_hak = HAK_NULL;
 	/*hak_dumpsymtab (hak);*/
 
+
 	return retv;
 }
 
@@ -808,7 +840,7 @@ static int feed_loop (hak_t* hak, xtn_t* xtn, int verbose)
 	}
 	fclose (fp);
 
-	if (!is_tty && hak_getbclen(hak) > 0) execute_in_batch_mode (hak, verbose);
+	if (!is_tty && hak_getbclen(hak) > 0) execute_in_batch_mode(hak, verbose);
 	return 0;
 
 oops:
@@ -996,7 +1028,7 @@ int main (int argc, char* argv[])
 	hakcb.vm_startup = vm_startup;
 	hakcb.vm_cleanup = vm_cleanup;
 	/*hakcb.vm_checkbc = vm_checkbc;*/
-	hak_regcb (hak, &hakcb);
+	hak_regcb(hak, &hakcb);
 
 	if (logopt && handle_logopt(hak, logopt) <= -1) goto oops;
 
@@ -1037,9 +1069,21 @@ int main (int argc, char* argv[])
 		goto oops;
 	}
 
+
 	/* -- from this point onward, any failure leads to jumping to the oops label
 	 * -- instead of returning -1 immediately. --*/
 	set_signal(SIGINT, handle_sigint);
+#if defined(SIGPIPE)
+	/* Writing to a pipe whose reader has gone - `hak foo.hak | head -1', or a
+	 * child spawned by sys.popen exiting early - raises SIGPIPE, which kills
+	 * the process by default before write() ever returns EPIPE. Ignore it here
+	 * so the failing write reports an error the script can act on instead.
+	 *
+	 * This belongs to the application, not to the library: the disposition is
+	 * process-wide, and a program that would rather die quietly on a broken
+	 * pipe is making a legitimate choice that hak must not overrule. */
+	set_signal_to_ignore(SIGPIPE);
+#endif
 
 #if 0
 // TODO: change the option name
@@ -1056,12 +1100,18 @@ int main (int argc, char* argv[])
 	if (feed_loop(hak, xtn, verbose) <= -1) goto oops;
 
 	set_signal_to_default(SIGINT);
+#if defined(SIGPIPE)
+	set_signal_to_default(SIGPIPE);
+#endif
 	hak_close(hak);
 
 	return 0;
 
 oops:
 	set_signal_to_default(SIGINT); /* harmless to call multiple times without set_signal() */
+#if defined(SIGPIPE)
+	set_signal_to_default(SIGPIPE);
+#endif
 	if (hak) hak_close(hak);
 	return -1;
 }

lib/Makefile.am

@@ -55,7 +55,9 @@ pkginclude_HEADERS = \
 	hak-htb.h \
 	hak-opt.h \
 	hak-pac1.h \
+	hak-hnd.h \
 	hak-pio.h \
+	hak-spl.h \
 	hak-rbt.h \
 	hak-str.h \
 	hak-upac.h \
@@ -80,6 +82,7 @@ libhak_la_SOURCES = \
 	gc.c \
 	hak.c \
 	heap.c \
+	hnd.c \
 	htb.c \
 	mb8.c \
 	number.c \

lib/Makefile.in

@@ -155,12 +155,13 @@ am_libhak_la_OBJECTS = libhak_la-bigint.lo libhak_la-chr.lo \
 	libhak_la-debug.lo libhak_la-decode.lo libhak_la-dic.lo \
 	libhak_la-err.lo libhak_la-exec.lo libhak_la-fmt.lo \
 	libhak_la-gc.lo libhak_la-hak.lo libhak_la-heap.lo \
-	libhak_la-htb.lo libhak_la-mb8.lo libhak_la-number.lo \
-	libhak_la-obj.lo libhak_la-opt.lo libhak_la-pio.lo \
-	libhak_la-prim.lo libhak_la-print.lo libhak_la-rbt.lo \
-	libhak_la-read.lo libhak_la-std.lo libhak_la-str.lo \
-	libhak_la-sym.lo libhak_la-utf16.lo libhak_la-utf8.lo \
-	libhak_la-utl.lo libhak_la-xchg.lo libhak_la-xma.lo
+	libhak_la-hnd.lo libhak_la-htb.lo libhak_la-mb8.lo \
+	libhak_la-number.lo libhak_la-obj.lo libhak_la-opt.lo \
+	libhak_la-pio.lo libhak_la-prim.lo libhak_la-print.lo \
+	libhak_la-rbt.lo libhak_la-read.lo libhak_la-std.lo \
+	libhak_la-str.lo libhak_la-sym.lo libhak_la-utf16.lo \
+	libhak_la-utf8.lo libhak_la-utl.lo libhak_la-xchg.lo \
+	libhak_la-xma.lo
 libhak_la_OBJECTS = $(am_libhak_la_OBJECTS)
 AM_V_lt = $(am__v_lt_@AM_V@)
 am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
@@ -206,16 +207,17 @@ am__depfiles_remade = ./$(DEPDIR)/libhak_la-bigint.Plo \
 	./$(DEPDIR)/libhak_la-err.Plo ./$(DEPDIR)/libhak_la-exec.Plo \
 	./$(DEPDIR)/libhak_la-fmt.Plo ./$(DEPDIR)/libhak_la-gc.Plo \
 	./$(DEPDIR)/libhak_la-hak.Plo ./$(DEPDIR)/libhak_la-heap.Plo \
-	./$(DEPDIR)/libhak_la-htb.Plo ./$(DEPDIR)/libhak_la-mb8.Plo \
-	./$(DEPDIR)/libhak_la-number.Plo ./$(DEPDIR)/libhak_la-obj.Plo \
-	./$(DEPDIR)/libhak_la-opt.Plo ./$(DEPDIR)/libhak_la-pio.Plo \
-	./$(DEPDIR)/libhak_la-prim.Plo ./$(DEPDIR)/libhak_la-print.Plo \
-	./$(DEPDIR)/libhak_la-rbt.Plo ./$(DEPDIR)/libhak_la-read.Plo \
-	./$(DEPDIR)/libhak_la-std.Plo ./$(DEPDIR)/libhak_la-str.Plo \
-	./$(DEPDIR)/libhak_la-sym.Plo ./$(DEPDIR)/libhak_la-utf16.Plo \
-	./$(DEPDIR)/libhak_la-utf8.Plo ./$(DEPDIR)/libhak_la-utl.Plo \
-	./$(DEPDIR)/libhak_la-xchg.Plo ./$(DEPDIR)/libhak_la-xma.Plo \
-	./$(DEPDIR)/libhakx_la-json.Plo ./$(DEPDIR)/libhakx_la-tmr.Plo \
+	./$(DEPDIR)/libhak_la-hnd.Plo ./$(DEPDIR)/libhak_la-htb.Plo \
+	./$(DEPDIR)/libhak_la-mb8.Plo ./$(DEPDIR)/libhak_la-number.Plo \
+	./$(DEPDIR)/libhak_la-obj.Plo ./$(DEPDIR)/libhak_la-opt.Plo \
+	./$(DEPDIR)/libhak_la-pio.Plo ./$(DEPDIR)/libhak_la-prim.Plo \
+	./$(DEPDIR)/libhak_la-print.Plo ./$(DEPDIR)/libhak_la-rbt.Plo \
+	./$(DEPDIR)/libhak_la-read.Plo ./$(DEPDIR)/libhak_la-std.Plo \
+	./$(DEPDIR)/libhak_la-str.Plo ./$(DEPDIR)/libhak_la-sym.Plo \
+	./$(DEPDIR)/libhak_la-utf16.Plo ./$(DEPDIR)/libhak_la-utf8.Plo \
+	./$(DEPDIR)/libhak_la-utl.Plo ./$(DEPDIR)/libhak_la-xchg.Plo \
+	./$(DEPDIR)/libhak_la-xma.Plo ./$(DEPDIR)/libhakx_la-json.Plo \
+	./$(DEPDIR)/libhakx_la-tmr.Plo \
 	./$(DEPDIR)/libhakx_la-x-client.Plo \
 	./$(DEPDIR)/libhakx_la-x-proto.Plo \
 	./$(DEPDIR)/libhakx_la-x-server.Plo \
@@ -248,9 +250,9 @@ am__can_run_installinfo = \
     *) (install-info --version) >/dev/null 2>&1;; \
   esac
 am__pkginclude_HEADERS_DIST = hak.h hak-chr.h hak-cmgr.h hak-cmn.h \
-	hak-fmt.h hak-htb.h hak-opt.h hak-pac1.h hak-pio.h hak-rbt.h \
-	hak-str.h hak-upac.h hak-utl.h hak-xma.h hak-x.h hak-tmr.h \
-	hak-json.h
+	hak-fmt.h hak-htb.h hak-opt.h hak-pac1.h hak-hnd.h hak-pio.h \
+	hak-spl.h hak-rbt.h hak-str.h hak-upac.h hak-utl.h hak-xma.h \
+	hak-x.h hak-tmr.h hak-json.h
 HEADERS = $(pkginclude_HEADERS)
 am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) \
 	hak-cfg.h.in
@@ -442,8 +444,9 @@ LIBADD_LIB_COMMON = $(LIBM) $(am__append_1) $(am__append_2) \
 @WIN32_TRUE@	-DHAK_DEFAULT_PFMODPOSTFIX=\"-1.dll\" \
 @WIN32_TRUE@	$(am__append_4) $(am__append_5)
 pkginclude_HEADERS = hak.h hak-chr.h hak-cmgr.h hak-cmn.h hak-fmt.h \
-	hak-htb.h hak-opt.h hak-pac1.h hak-pio.h hak-rbt.h hak-str.h \
-	hak-upac.h hak-utl.h hak-xma.h $(am__append_8)
+	hak-htb.h hak-opt.h hak-pac1.h hak-hnd.h hak-pio.h hak-spl.h \
+	hak-rbt.h hak-str.h hak-upac.h hak-utl.h hak-xma.h \
+	$(am__append_8)
 pkglib_LTLIBRARIES = libhak.la $(am__append_7)
 libhak_la_SOURCES = \
 	hak-prv.h \
@@ -462,6 +465,7 @@ libhak_la_SOURCES = \
 	gc.c \
 	hak.c \
 	heap.c \
+	hnd.c \
 	htb.c \
 	mb8.c \
 	number.c \
@@ -612,6 +616,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhak_la-gc.Plo@am__quote@ # am--include-marker
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhak_la-hak.Plo@am__quote@ # am--include-marker
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhak_la-heap.Plo@am__quote@ # am--include-marker
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhak_la-hnd.Plo@am__quote@ # am--include-marker
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhak_la-htb.Plo@am__quote@ # am--include-marker
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhak_la-mb8.Plo@am__quote@ # am--include-marker
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhak_la-number.Plo@am__quote@ # am--include-marker
@@ -766,6 +771,13 @@ libhak_la-heap.lo: heap.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhak_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libhak_la-heap.lo `test -f 'heap.c' || echo '$(srcdir)/'`heap.c
 
+libhak_la-hnd.lo: hnd.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhak_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libhak_la-hnd.lo -MD -MP -MF $(DEPDIR)/libhak_la-hnd.Tpo -c -o libhak_la-hnd.lo `test -f 'hnd.c' || echo '$(srcdir)/'`hnd.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libhak_la-hnd.Tpo $(DEPDIR)/libhak_la-hnd.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='hnd.c' object='libhak_la-hnd.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhak_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libhak_la-hnd.lo `test -f 'hnd.c' || echo '$(srcdir)/'`hnd.c
+
 libhak_la-htb.lo: htb.c
 @am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhak_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libhak_la-htb.lo -MD -MP -MF $(DEPDIR)/libhak_la-htb.Tpo -c -o libhak_la-htb.lo `test -f 'htb.c' || echo '$(srcdir)/'`htb.c
 @am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libhak_la-htb.Tpo $(DEPDIR)/libhak_la-htb.Plo
@@ -1110,6 +1122,7 @@ distclean: distclean-am
 	-rm -f ./$(DEPDIR)/libhak_la-gc.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-hak.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-heap.Plo
+	-rm -f ./$(DEPDIR)/libhak_la-hnd.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-htb.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-mb8.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-number.Plo
@@ -1195,6 +1208,7 @@ maintainer-clean: maintainer-clean-am
 	-rm -f ./$(DEPDIR)/libhak_la-gc.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-hak.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-heap.Plo
+	-rm -f ./$(DEPDIR)/libhak_la-hnd.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-htb.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-mb8.Plo
 	-rm -f ./$(DEPDIR)/libhak_la-number.Plo

lib/exec.c

@@ -50,6 +50,12 @@ static hak_ooch_t oocstr_colon[2] = { ':', '\0' };
 static hak_ooch_t oocstr_dash[2] = { '-', '\0' };
 static hak_ooch_t oocstr_none[1] = { '\0' };
 
+/* global tick counter - all instances configured to receive ticks
+ * switch processes based on this counter.
+ * sig_atomic_t is more strict choice but hak_uint32_t is believed to be safe enough. */
+/* static volatile sig_atomic_t gtick = 0; */
+static volatile hak_uint32_t gtick = 0;
+
 #define PROC_MAP_INC 64
 
 /* TODO: adjust these max semaphore pointer buffer capacity,
@@ -1739,7 +1745,7 @@ static void update_sem_heap (hak_t* hak, hak_ooi_t index, hak_oop_semaphore_t ne
 }
 #endif
 
-static int add_sem_to_sem_io_tuple (hak_t* hak, hak_oop_semaphore_t sem, hak_ooi_t io_handle, hak_semaphore_io_type_t io_type)
+int hak_add_sem_to_sem_io_tuple (hak_t* hak, hak_oop_semaphore_t sem, hak_ooi_t io_handle, hak_semaphore_io_type_t io_type)
 {
 	hak_ooi_t index;
 	hak_ooi_t new_mask;
@@ -3212,24 +3218,50 @@ static HAK_INLINE int switch_process_if_needed (hak_t* hak)
 
 switch_to_next:
 	/* TODO: implement different process switching scheme - time-slice or clock based??? */
-#if defined(HAK_EXTERNAL_PROCESS_SWITCH)
-	if (hak->switch_proc)
+#if 0
+	if (hak->rcv_tick && (hak->last_tick != hak->tick || hak->last_gtick != gtick))
 	{
-#endif
-		if (!hak->proc_switched)
-		{
-			switch_to_next_runnable_process(hak);
-			hak->proc_switched = 0;
-		}
-#if defined(HAK_EXTERNAL_PROCESS_SWITCH)
-		hak->switch_proc = 0;
-	}
-	else hak->proc_switched = 0;
-#endif
+		/* clear the state regardless of the actual switching */
+		hak->last_gtick = gtick;
+		hak->last_tick = hak->tick;
 
+		/* switching happens only if it didn't happen yet */
+		if (!hak->proc_switched) switch_to_next_runnable_process(hak);
+	}
+#else
+	if (hak->rcv_tick && !hak->proc_switched && (hak->last_tick != hak->tick || hak->last_gtick != gtick))
+	{
+		/* clear the state only if the actual switching would happen */
+		hak->last_gtick = gtick;
+		hak->last_tick = hak->tick;
+		switch_to_next_runnable_process(hak); /* actual switching */
+	}
+#endif
+	hak->proc_switched = 0;
 	return 1;
 }
 
+void hak_rcvtick (hak_t* hak, int enabled)
+{
+	if (enabled)
+	{
+		hak->last_gtick = gtick;
+		hak->last_tick = hak->tick;
+	}
+	hak->rcv_tick = !!enabled;
+}
+
+void hak_raisetick (hak_t* hak)
+{
+	hak->tick++;
+}
+
+void hak_raise_gtick (int unused)
+{
+	/* this function is global and not bound to a specific instance. */
+	gtick++;
+}
+
 /* ------------------------------------------------------------------------- */
 
 static HAK_INLINE int do_return_from_block (hak_t* hak)
@@ -5705,7 +5737,11 @@ hak_pfrc_t hak_pf_semaphore_signal (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 static hak_pfrc_t __semaphore_signal_on_io (hak_t* hak, hak_ooi_t nargs, hak_semaphore_io_type_t io_type)
 {
 	hak_oop_semaphore_t sem;
+#if 0
 	hak_oop_t fd;
+#else
+	hak_hnd_t* hnd;
+#endif
 
 	sem = (hak_oop_semaphore_t)HAK_STACK_GETARG(hak, nargs, 0);
 	if (!HAK_IS_SEMAPHORE(hak, sem))
@@ -5714,13 +5750,22 @@ static hak_pfrc_t __semaphore_signal_on_io (hak_t* hak, hak_ooi_t nargs, hak_sem
 		return HAK_PF_FAILURE;
 	}
 
+#if 0
 	fd = HAK_STACK_GETARG(hak, nargs, 1);
-
 	if (!HAK_OOP_IS_SMOOI(fd))
 	{
 		hak_seterrbfmt(hak, HAK_EINVAL, "handle not a small integer - %O", fd);
 		return HAK_PF_FAILURE;
 	}
+#else
+	/* the second argument is a system handle id, not a raw descriptor.
+	 * resolving it through the handle table is what stops hak code from
+	 * naming a descriptor it never opened - hak's own multiplexer, signal
+	 * and io-thread descriptors among them - and what guarantees that
+	 * hak_closehnd() will later unbind whatever we register here. */
+	hnd = hak_gethndwithoop(hak, HAK_STACK_GETARG(hak, nargs, 1), HAK_HND_TYPE_ALL_MUXABLE);
+	if (HAK_UNLIKELY(!hnd)) return HAK_PF_FAILURE;
+#endif
 
 	if (sem->subtype != hak->_nil)
 	{
@@ -5743,10 +5788,18 @@ static hak_pfrc_t __semaphore_signal_on_io (hak_t* hak, hak_ooi_t nargs, hak_sem
 		return HAK_PF_FAILURE;
 	}
 
+#if 0
 	if (add_sem_to_sem_io_tuple(hak, sem, HAK_OOP_TO_SMOOI(fd), io_type) <= -1)
+#else
+	if (hak_bindhnd(hak, hnd, sem, io_type) <= -1)
+#endif
 	{
 		const hak_ooch_t* oldmsg = hak_backuperrmsg(hak);
+#if 0
 		hak_seterrbfmt(hak, hak->errnum, "unable to add the handle %zd to the multiplexer for %hs - %js", HAK_OOP_TO_SMOOI(fd), io_type_str[io_type], oldmsg);
+#else
+		hak_seterrbfmt(hak, hak->errnum, "unable to add the handle %zd to the multiplexer for %hs - %js", hnd->id, io_type_str[io_type], oldmsg);
+#endif
 		return HAK_PF_FAILURE;
 	}
 

lib/gc.c

@@ -1137,7 +1137,7 @@ void hak_gc (hak_t* hak, int full)
 {
 	if (hak->gci.lazy_sweep) hak_gc_ms_sweep_lazy(hak, HAK_TYPE_MAX(hak_oow_t));
 
-	HAK_LOG1 (hak, HAK_LOG_GC | HAK_LOG_INFO, "Starting GC (mark-sweep) - gci.bsz = %zu\n", hak->gci.bsz);
+	HAK_LOG1(hak, HAK_LOG_GC | HAK_LOG_INFO, "Starting GC (mark-sweep) - gci.bsz = %zu\n", hak->gci.bsz);
 
 	hak->gci.stack.len = 0;
 	/*hak->gci.stack.max = 0;*/
@@ -1156,7 +1156,7 @@ void hak_gc (hak_t* hak, int full)
 	    gc_ms_sweep(hak);
 	}
 
-	HAK_LOG2 (hak, HAK_LOG_GC | HAK_LOG_INFO, "Finished GC (mark-sweep) - gci.bsz = %zu, gci.stack.max %zu\n", hak->gci.bsz, hak->gci.stack.max);
+	HAK_LOG2(hak, HAK_LOG_GC | HAK_LOG_INFO, "Finished GC (mark-sweep) - gci.bsz = %zu, gci.stack.max %zu\n", hak->gci.bsz, hak->gci.stack.max);
 }
 
 hak_oop_t hak_moveoop (hak_t* hak, hak_oop_t oop)
@@ -1314,7 +1314,7 @@ void hak_gc (hak_t* hak)
 		{
 			if ((hak_oop_t)buc->slot[index] != hak->_nil)
 			{
-				HAK_LOG1 (hak, HAK_LOG_GC | HAK_LOG_DEBUG, "\t%O\n", buc->slot[index]);
+				HAK_LOG1(hak, HAK_LOG_GC | HAK_LOG_DEBUG, "\t%O\n", buc->slot[index]);
 			}
 		}
 		HAK_LOG0 (hak, HAK_LOG_GC | HAK_LOG_DEBUG, "--------------------------------------------\n");

lib/hak-hnd.h

@@ -0,0 +1,347 @@
+/*
+    Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
+    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+    OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+    IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+    NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+    THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef _HAK_HND_H_
+#define _HAK_HND_H_
+
+#include <hak.h>
+
+/** \file
+ * This file provides the system handle table - the single place where hak
+ * keeps track of operating system resources handed out to hak code.
+ *
+ * hak code never sees a raw file descriptor or a pointer. It sees a small
+ * non-negative integer id which is resolved against this table on every use.
+ * That resolution is what makes the following impossible:
+ *
+ * - naming a descriptor the script never opened (including hak's own
+ *   multiplexer, signal and io-thread descriptors, and any descriptor the
+ *   host application that embeds hak happens to hold open),
+ * - aiming hak_releaseiohandle() at a descriptor hak does not own, which
+ *   would delete the VM's own multiplexer registration for it,
+ * - keeping a multiplexer registration alive across a close(), where the
+ *   descriptor number may be recycled for something unrelated.
+ *
+ * There is exactly one table per #hak_t, shared by every module, so ids are
+ * unique across subsystems and the close protocol lives in one place.
+ *
+ * A node is one waitable operating system handle. A resource made of several
+ * handles (a child process with its pipes, say) is represented as several
+ * nodes tied together by \a owner, so that "which handle am I waiting on"
+ * never becomes a parameter of read, write or bind.
+ */
+
+/**
+ * The hak_hnd_type_t type enumerates the kinds of resource a node may hold.
+ * The values are bit flags so that hak_gethnd() can be given the set of
+ * types a caller is prepared to accept.
+ */
+enum hak_hnd_type_t
+{
+	HAK_HND_TYPE_FILE = (1 << 0), /**< regular file, directory or block device - not muxable */
+	HAK_HND_TYPE_PIPE = (1 << 1), /**< pipe or fifo end */
+	HAK_HND_TYPE_SCK  = (1 << 2), /**< socket */
+	HAK_HND_TYPE_CHR  = (1 << 3), /**< terminal or character device */
+	HAK_HND_TYPE_DIR  = (1 << 4), /**< directory stream - a pointer, not a descriptor */
+	HAK_HND_TYPE_PROC = (1 << 5), /**< child process - a pointer, not a descriptor */
+	HAK_HND_TYPE_EVT  = (1 << 6)  /**< anonymous-inode descriptor: pidfd, eventfd,
+	                               *   timerfd, signalfd. pollable but carries no
+	                               *   file type bits, and generally not readable
+	                               *   as a byte stream. */
+};
+typedef enum hak_hnd_type_t hak_hnd_type_t;
+
+/** every type that is backed by a file descriptor */
+#define HAK_HND_TYPE_ALL_FD \
+	(HAK_HND_TYPE_FILE | HAK_HND_TYPE_PIPE | HAK_HND_TYPE_SCK | \
+	 HAK_HND_TYPE_CHR | HAK_HND_TYPE_EVT)
+
+/** every type that moves bytes, and so may be given to hak_readhnd() */
+#define HAK_HND_TYPE_ALL_STREAM \
+	(HAK_HND_TYPE_FILE | HAK_HND_TYPE_PIPE | HAK_HND_TYPE_SCK | HAK_HND_TYPE_CHR)
+
+/** every type the multiplexer can accept */
+#define HAK_HND_TYPE_ALL_MUXABLE \
+	(HAK_HND_TYPE_PIPE | HAK_HND_TYPE_SCK | HAK_HND_TYPE_CHR | HAK_HND_TYPE_EVT)
+
+enum hak_hnd_flag_t
+{
+	/** the multiplexer accepts this handle. set by hak_wrapfd() from the
+	 *  probed type; a regular file never gets it because epoll refuses one
+	 *  outright and poll() would report it permanently ready. */
+	HAK_HND_FLAG_MUXABLE  = (1 << 0),
+
+	/** O_NONBLOCK is set on the handle */
+	HAK_HND_FLAG_NONBLOCK = (1 << 1),
+
+	/** a semaphore is currently bound to this handle. hak_closehnd() uses
+	 *  this to know it must call hak_releaseiohandle() first. */
+	HAK_HND_FLAG_IN_MUX   = (1 << 2),
+
+	/** release the node without closing the underlying handle. useful for a
+	 *  descriptor owned by someone else that was only wrapped for the ride. */
+	HAK_HND_FLAG_KEEPOPEN = (1 << 3)
+};
+typedef enum hak_hnd_flag_t hak_hnd_flag_t;
+
+/** hak_wrapfd() should put the descriptor into non-blocking mode */
+#define HAK_HND_OPEN_NONBLOCK HAK_HND_FLAG_NONBLOCK
+/** force #HAK_HND_FLAG_MUXABLE regardless of what the probe concluded, for a
+ *  caller that knows the descriptor is pollable */
+#define HAK_HND_OPEN_MUXABLE  HAK_HND_FLAG_MUXABLE
+/** hak_closehnd() should not close the underlying handle */
+#define HAK_HND_OPEN_KEEPOPEN HAK_HND_FLAG_KEEPOPEN
+
+typedef struct hak_hnd_t hak_hnd_t;
+
+/**
+ * The hak_hnd_dtor_t type defines how a node's underlying resource is
+ * released. It is what lets a pointer-shaped resource - a directory stream, a
+ * child process - be disposed of correctly even when hak code never closed it
+ * and hak_finihndtab() is doing the closing at teardown.
+ *
+ * The node itself is still returned to the free list afterwards; a destructor
+ * only has to deal with what \a hnd points at.
+ */
+typedef void (*hak_hnd_dtor_t) (
+	hak_t*     hak,
+	hak_hnd_t* hnd
+);
+
+struct hak_hnd_t
+{
+	/* the id is what hak code holds. it is always >= 0 and always within
+	 * HAK_SMOOI_MAX so that it can be handed over as a small integer. */
+	hak_ooi_t      id;
+	hak_hnd_type_t type;
+	int            flags;
+
+	/* id of the node that owns this one, or -1. closing an owner closes
+	 * everything it owns. */
+	hak_ooi_t      owner;
+
+	union
+	{
+		int   fd;  /**< HAK_HND_TYPE_FILE, _PIPE, _SCK, _CHR */
+		void* ptr; /**< HAK_HND_TYPE_DIR, _PROC */
+	} u;
+
+	/* how to release u.ptr, or a descriptor needing more than close().
+	 * HAK_NULL means the default: close() for a descriptor, nothing for a
+	 * pointer - which is why a pointer-shaped node without one leaks. */
+	hak_hnd_dtor_t dtor;
+
+	/* house keeping. do not touch from outside hnd.c */
+	hak_hnd_t* prev;
+	hak_hnd_t* next;
+};
+
+typedef struct hak_hndtab_t hak_hndtab_t;
+
+/* ========================================================================= */
+/* THE UNIFORM I/O CONTRACT                                                  */
+/* ========================================================================= */
+
+/**
+ * hak_readhnd() and hak_writehnd() never block and never raise. They return
+ * the number of bytes transferred, 0 at end of file, or one of the two values
+ * below. #HAK_HND_IO_WOULDBLOCK is an ordinary outcome that the caller is
+ * expected to hand back to hak code so that it can wait on a semaphore and
+ * retry; only #HAK_HND_IO_ERROR means the hak error has been set and the
+ * primitive should fail.
+ */
+#define HAK_HND_IO_WOULDBLOCK ((hak_ooi_t)-1)
+#define HAK_HND_IO_ERROR      ((hak_ooi_t)-2)
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+/* ========================================================================= */
+/* TABLE LIFECYCLE - called by hak_init()/hak_fini(), not by modules         */
+/* ========================================================================= */
+
+int  hak_inithndtab (hak_t* hak);
+
+/**
+ * Closes every handle still open and frees the table. Handles that outlive
+ * the hak instance would otherwise leak descriptors and child processes.
+ */
+void hak_finihndtab (hak_t* hak);
+
+/* ========================================================================= */
+/* CREATION                                                                  */
+/* ========================================================================= */
+
+/**
+ * Wraps the descriptor \a fd into a new node and returns it.
+ *
+ * The kind of descriptor is probed with fstat() and recorded in \a type,
+ * together with #HAK_HND_FLAG_MUXABLE when the multiplexer can accept it.
+ * Pass 0 for \a type_hint to take whatever the probe finds, or a mask of
+ * acceptable #hak_hnd_type_t values to require one of them.
+ *
+ * \a flags may carry #HAK_HND_OPEN_NONBLOCK and #HAK_HND_OPEN_KEEPOPEN.
+ *
+ * On success the table owns \a fd. On failure \a fd is left alone, so the
+ * caller remains responsible for closing it.
+ *
+ * \return node pointer on success, #HAK_NULL on failure
+ */
+hak_hnd_t* hak_wrapfd (
+	hak_t*         hak,
+	int            fd,
+	hak_hnd_type_t type_hint,
+	int            flags
+);
+
+/**
+ * Wraps a pointer-shaped resource, such as a directory stream or a child
+ * process object. Such a node is never muxable.
+ *
+ * \a dtor is how \a ptr gets released, and is called by hak_closehnd() -
+ * including the closes that hak_finihndtab() performs at teardown. Passing
+ * #HAK_NULL means the pointer is owned elsewhere and this node must not
+ * release it.
+ */
+hak_hnd_t* hak_wrapptr (
+	hak_t*         hak,
+	void*          ptr,
+	hak_hnd_type_t type,
+	int            flags,
+	hak_hnd_dtor_t dtor
+);
+
+/**
+ * Like hak_wrapfd() but idempotent: if \a fd already has a node, that node is
+ * returned instead of failing the way hak_wrapfd() does. Use it for a
+ * descriptor the VM owns and hands out repeatedly - the signal descriptor, for
+ * instance - so that hak code always sees the same id for it.
+ *
+ * Pass #HAK_HND_OPEN_KEEPOPEN for anything the handle table must not close.
+ */
+hak_hnd_t* hak_wrapfd_once (
+	hak_t*         hak,
+	int            fd,
+	hak_hnd_type_t type_hint,
+	int            flags
+);
+
+/**
+ * Makes \a hnd owned by \a owner, so that closing \a owner closes \a hnd too.
+ */
+void hak_ownhnd (
+	hak_t*     hak,
+	hak_hnd_t* hnd,
+	hak_hnd_t* owner
+);
+
+/* ========================================================================= */
+/* LOOKUP - the validation gate                                              */
+/* ========================================================================= */
+
+/**
+ * Resolves \a id to a node, requiring its type to be among
+ * \a acceptable_types. Sets the hak error and returns #HAK_NULL when the id
+ * is out of range, refers to no live node, or refers to a node of the wrong
+ * kind - so a caller can simply return HAK_PF_FAILURE.
+ */
+hak_hnd_t* hak_gethnd (
+	hak_t*     hak,
+	hak_ooi_t  id,
+	int        acceptable_types
+);
+
+/**
+ * Like hak_gethnd() but takes the id as an object, which is what a primitive
+ * has at hand. Rejects anything that is not a small integer.
+ */
+hak_hnd_t* hak_gethndwithoop (
+	hak_t*     hak,
+	hak_oop_t  id,
+	int        acceptable_types
+);
+
+/* ========================================================================= */
+/* DESTRUCTION                                                               */
+/* ========================================================================= */
+
+/**
+ * Closes \a hnd. Handles owned by it are closed first, any multiplexer
+ * registration is dropped through hak_releaseiohandle() before the underlying
+ * handle goes away, the resource is released through the node's
+ * #hak_hnd_dtor_t (or close() when it has none and is a descriptor), and the
+ * node is returned to the free list.
+ * \return 0 on success, -1 if the underlying close failed (the node is
+ *         released either way)
+ */
+int hak_closehnd (
+	hak_t*     hak,
+	hak_hnd_t* hnd
+);
+
+/* ========================================================================= */
+/* MULTIPLEXER BINDING - the only path into the io semaphore tuples          */
+/* ========================================================================= */
+
+/**
+ * Binds \a sem to \a hnd so that the semaphore is signalled when the handle
+ * becomes ready for \a io_type. Fails if the handle is not muxable.
+ *
+ * Unbinding is done with hak_pf_semaphore_unsignal() from hak code, which
+ * works from the semaphore rather than from the handle and so needs no
+ * handle-side counterpart.
+ *
+ * \return 0 on success, -1 on failure
+ */
+int hak_bindhnd (
+	hak_t*                  hak,
+	hak_hnd_t*              hnd,
+	hak_oop_semaphore_t     sem,
+	hak_semaphore_io_type_t io_type
+);
+
+/* ========================================================================= */
+/* I/O                                                                       */
+/* ========================================================================= */
+
+hak_ooi_t hak_readhnd (
+	hak_t*     hak,
+	hak_hnd_t* hnd,
+	void*      buf,
+	hak_oow_t  len
+);
+
+hak_ooi_t hak_writehnd (
+	hak_t*      hak,
+	hak_hnd_t*  hnd,
+	const void* buf,
+	hak_oow_t   len
+);
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif

lib/hak-pio.h

@@ -286,6 +286,22 @@ HAK_EXPORT void hak_pio_fini (
 	hak_pio_t* pio /**< pio object */
 );
 
+/**
+ * The hak_pio_free() function closes the pipes, makes sure the child is
+ * reaped, and frees the #hak_pio_t structure.
+ *
+ * Unlike hak_pio_close() it never waits indefinitely: the child is looked at
+ * without blocking first, and only if it is still running is it killed, which
+ * bounds the wait that follows because SIGKILL cannot be caught. Use this
+ * wherever an unbounded wait is unacceptable - inside a scheduler that has
+ * other work to run, or while tearing down a #hak_t.
+ *
+ * The error currently set on \a hak is preserved across the call.
+ */
+HAK_EXPORT void hak_pio_free (
+	hak_pio_t* pio /**< pio object */
+);
+
 #if defined(HAK_HAVE_INLINE)
 static HAK_INLINE void* hak_pio_getxtn (hak_pio_t* pio) { return (void*)(pio + 1); }
 #else

lib/hak-prv.h

@@ -29,6 +29,7 @@
 #include <hak-chr.h>
 #include <hak-cmgr.h>
 #include <hak-fmt.h>
+#include <hak-hnd.h>
 #include <hak-str.h>
 #include <hak-utl.h>
 
@@ -200,10 +201,6 @@ do { \
 /*#define HAK_PROFILE_VM 1*/
 #endif
 
-/* allow the caller to drive process switching by calling
- * stix_switchprocess(). */
-#define HAK_EXTERNAL_PROCESS_SWITCH
-
 /* limit the maximum object size such that:
  *   1. an index to an object field can be represented in a small integer.
  *   2. the maximum number of bits including bit-shifts can be represented
@@ -1652,6 +1649,19 @@ hak_heap_t* hak_makeheap (
 /**
  * The hak_killheap() function destroys the heap pointed to by \a heap.
  */
+/* --------------------------------------------------------------------------
+ * IO SEMAPHORE TUPLES (exec.c)
+ * -------------------------------------------------------------------------- */
+
+/* hak_bindhnd() in hnd.c is the only intended caller. binding is kept behind
+ * the handle table so that a raw descriptor can never be named from hak code. */
+int hak_add_sem_to_sem_io_tuple (
+	hak_t*                  hak,
+	hak_oop_semaphore_t     sem,
+	hak_ooi_t               io_handle,
+	hak_semaphore_io_type_t io_type
+);
+
 void hak_killheap (
 	hak_t*      hak,
 	hak_heap_t* heap

lib/hak-spl.h

@@ -0,0 +1,273 @@
+/*
+    Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
+    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+    OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+    IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+    NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+    THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+#ifndef _HAK_SPL_H_
+#define _HAK_SPL_H_
+
+#include <hak-cmn.h>
+
+/** \file
+ * This file provides a spinlock.
+ *
+ * A spinlock is the lock of last resort: it burns processor time while it
+ * waits, so a real mutex is preferable wherever one exists. What it has that
+ * a mutex does not is that zero is a valid unlocked state. HAK_SPL_INIT is a
+ * constant, so a spinlock can be a statically initialised global that is ready
+ * before main() runs and needs no library initialisation call to construct it.
+ *
+ * It must never be taken from a signal handler or an interrupt handler. The
+ * atomics it is built from are async-signal-safe, but that is not the binding
+ * constraint: a signal delivered to the thread already holding the lock would
+ * spin forever on a lock that thread can no longer reach the end of.
+ *
+ * Keep the guarded region to plain memory access. Spinning while the holder
+ * sits in a system call wastes exactly the time the spinlock was chosen to
+ * save.
+ *
+ * HAK_SUPPORT_SPL is left undefined if no implementation fits the target, so
+ * a caller can fall back to something else:
+ *
+ * \code
+ * #if defined(HAK_SUPPORT_SPL)
+ * static hak_spl_t lck = HAK_SPL_INIT;
+ * hak_spl_lock(&lck);
+ * ...
+ * hak_spl_unlock(&lck);
+ * #endif
+ * \endcode
+ *
+ * Define HAK_SPL_UNSUPPORTED_ERROR to turn an unsupported target into a
+ * compile-time error instead.
+ */
+
+#define HAK_SUPPORT_SPL
+
+typedef volatile hak_uint32_t hak_spl_t;
+
+#define HAK_SPL_INIT (0)
+
+#if defined(HAK_HAVE_INLINE)
+	static HAK_INLINE void hak_spl_init (hak_spl_t* spl) { *spl = HAK_SPL_INIT; }
+#else
+#	define hak_spl_init(spl) ((*(spl)) = HAK_SPL_INIT)
+#endif
+
+/* hint to the processor that this is a spin-wait, and give up the timeslice
+ * where that is cheap to do. without it a waiter can starve the holder on a
+ * single processor. */
+#if defined(_WIN32)
+#	define HAK_SPL_RELAX() Sleep(0)
+#elif defined(__OS2__)
+#	define HAK_SPL_RELAX() DosSleep(0)
+#elif defined(__GNUC__) && (defined(__x86_64) || defined(__amd64) || defined(__i386) || defined(i386))
+	/* "rep; nop" is the pause instruction, and decodes as a plain nop on
+	 * processors that predate it, so it is safe unconditionally. */
+#	define HAK_SPL_RELAX() __asm__ __volatile__ ("rep; nop" : : : "memory")
+#else
+#	define HAK_SPL_RELAX() ((void)0)
+#endif
+
+/* __sync_lock_test_and_set()/__sync_lock_release() are the pair gcc documents
+ * for building a spinlock: the first is an acquire-barrier exchange, the second
+ * a release-barrier store. hak-cmn.h probes them with __has_builtin, which is
+ * itself newer than the builtins are, so accept any gcc from 4.1 as well. That
+ * covers every architecture gcc targets, leaving the hand-written arms below
+ * for compilers older than that. */
+#if defined(HAK_HAVE_SYNC_LOCK_TEST_AND_SET) && defined(HAK_HAVE_SYNC_LOCK_RELEASE)
+#	define HAK_SPL_USE_SYNC_BUILTINS
+#elif defined(__GNUC__) && ((__GNUC__ > 4) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
+#	define HAK_SPL_USE_SYNC_BUILTINS
+#endif
+
+#if defined(HAK_SPL_USE_SYNC_BUILTINS)
+	/* =======================================================================
+	 * COMPILERS WITH BUILTIN ATOMICS
+	 * ======================================================================= */
+
+#if defined(HAK_HAVE_INLINE)
+	static HAK_INLINE_ALWAYS int hak_spl_trylock (hak_spl_t* spl) { return !__sync_lock_test_and_set(spl, 1); }
+	static HAK_INLINE_ALWAYS void hak_spl_lock (hak_spl_t* spl) { while (__sync_lock_test_and_set(spl, 1)) HAK_SPL_RELAX(); }
+	static HAK_INLINE_ALWAYS void hak_spl_unlock (hak_spl_t* spl) { __sync_lock_release(spl); }
+#else
+#	define hak_spl_trylock(spl) (!__sync_lock_test_and_set(spl, 1))
+#	define hak_spl_lock(spl) do { while (__sync_lock_test_and_set(spl, 1)) HAK_SPL_RELAX(); } while(0)
+#	define hak_spl_unlock(spl) (__sync_lock_release(spl))
+#endif
+
+#elif defined(_WIN32)
+	/* =======================================================================
+	 * WIN32 WITHOUT GCC - MSVC AND FRIENDS
+	 *
+	 * InterlockedCompareExchange() has been available since NT 3.51 and
+	 * carries a full barrier, so this arm holds for the whole range this
+	 * file targets. It is the reason the header exists: _WIN32 runs a
+	 * ticker thread but has no pthreads, and CRITICAL_SECTION cannot be
+	 * initialised statically.
+	 * ======================================================================= */
+
+#if defined(HAK_HAVE_INLINE)
+	static HAK_INLINE_ALWAYS int hak_spl_trylock (hak_spl_t* spl) { return InterlockedCompareExchange((LONG volatile*)spl, 1, 0) == 0; }
+	static HAK_INLINE_ALWAYS void hak_spl_lock (hak_spl_t* spl) { while (InterlockedCompareExchange((LONG volatile*)spl, 1, 0)) HAK_SPL_RELAX(); }
+	static HAK_INLINE_ALWAYS void hak_spl_unlock (hak_spl_t* spl) { InterlockedExchange((LONG volatile*)spl, 0); }
+#else
+#	define hak_spl_trylock(spl) (InterlockedCompareExchange((LONG volatile*)(spl), 1, 0) == 0)
+#	define hak_spl_lock(spl) do { while (InterlockedCompareExchange((LONG volatile*)(spl), 1, 0)) HAK_SPL_RELAX(); } while(0)
+#	define hak_spl_unlock(spl) (InterlockedExchange((LONG volatile*)(spl), 0))
+#endif
+
+#elif defined(_SCO_DS)
+/* =======================================================================
+ * SCO DEVELOPEMENT SYSTEM
+ *
+ *  NOTE: when the asm macros were indented, the compiler/linker ended up
+ *        with undefined symbols. never indent hak_spl_xxx macros.
+ * ======================================================================= */
+asm int hak_spl_trylock (hak_spl_t* spl)
+{
+%reg spl
+	movl   $1, %eax
+	xchgl  (spl), %eax
+	xorl   $1, %eax     / return zero on failure, non-zero on success
+
+%mem spl
+	movl  spl,  %ecx
+	movl  $1,     %eax
+	xchgl (%ecx), %eax
+	xorl  $1,     %eax  / return zero on failure, non-zero on success
+}
+
+/* jump labels cannot be made unique across multiple occurrences of an asm
+ * macro, so the loop lives in C instead. */
+#define hak_spl_lock(x) do { while (!hak_spl_trylock(x)) HAK_SPL_RELAX(); } while(0)
+
+asm void hak_spl_unlock (hak_spl_t* spl)
+{
+	/* don't need xchg as movl on an aligned data is atomic */
+	/* mfence is 0F AE F0 */
+%reg spl
+	.byte 0x0F
+	.byte 0xAE
+	.byte 0xF0
+	movl $0, (spl)
+
+%mem spl
+	.byte 0x0F
+	.byte 0xAE
+	.byte 0xF0
+	movl spl, %ecx
+	movl $0, (%ecx)
+}
+
+#elif defined(__GNUC__) && (defined(__x86_64) || defined(__amd64) || defined(__i386) || defined(i386))
+	/* =======================================================================
+	 * GCC OLDER THAN 4.1 ON X86
+	 * ======================================================================= */
+
+	static HAK_INLINE int hak_spl_trylock (hak_spl_t* spl)
+	{
+		int x = 1;
+		__asm__ volatile (
+			"xchgl %0, (%2)\n"
+			: "=r"(x)
+			: "0"(x), "r"(spl)
+			: "memory"
+		);
+		return !x;
+	}
+	static HAK_INLINE void hak_spl_lock (hak_spl_t* spl)
+	{
+		while (!hak_spl_trylock(spl)) HAK_SPL_RELAX();
+	}
+	static HAK_INLINE void hak_spl_unlock (hak_spl_t* spl)
+	{
+	#if defined(__x86_64) || defined(__amd64)
+		__asm__ volatile (
+			"mfence\n\t"
+			"movl $0, (%0)\n"
+			:
+			:"r"(spl)
+			:"memory"
+		);
+	#else
+		__asm__ volatile (
+			"movl $0, (%0)\n"
+			:
+			:"r"(spl)
+			:"memory"
+		);
+	#endif
+	}
+
+#elif defined(__GNUC__) && (defined(__POWERPC__) || defined(__powerpc) || defined(__powerpc__) || defined(__ppc))
+	/* =======================================================================
+	 * GCC OLDER THAN 4.1 ON POWERPC
+	 *
+	 * lwarx loads the word and reserves the location; the paired stwcx.
+	 * stores only if the reservation still holds.
+	 * ======================================================================= */
+
+	static HAK_INLINE int hak_spl_trylock (hak_spl_t* spl)
+	{
+		unsigned int rc;
+
+		__asm__ volatile (
+			"1:\n"
+			"lwarx        %0,0,%1\n"  /* load and reserve. rc(%0) = *spl(%1) */
+			"cmpwi        cr0,%0,0\n" /* cr0 = (rc compare-with 0) */
+			"li           %0,0\n"     /* rc = 0(failure) */
+			"bne          cr0,2f\n"   /* if cr0 != 0, goto 2; */
+			"li           %0,1\n"     /* rc = 1(success) */
+			"stwcx.       %0,0,%1\n"  /* *spl(%1) = 1(value in rc) if reserved */
+			"bne          cr0,1b\n"   /* if reservation is lost, goto 1 */
+			"lwsync\n"
+			"2:\n"
+			: "=&r"(rc)
+			: "r"(spl)
+			: "cr0", "memory"
+		);
+
+		return rc;
+	}
+	static HAK_INLINE void hak_spl_lock (hak_spl_t* spl)
+	{
+		while (!hak_spl_trylock(spl)) HAK_SPL_RELAX();
+	}
+	static HAK_INLINE void hak_spl_unlock (hak_spl_t* spl)
+	{
+		__asm__ volatile ("lwsync\n" : : : "memory");
+		*spl = 0;
+	}
+
+#else
+	/* no implementation fits. leave HAK_SUPPORT_SPL undefined so the caller
+	 * can choose something else - hak's own targets that land here, __DOS__
+	 * and EMSCRIPTEN, cannot run a second thread and need no lock at all. */
+#	undef HAK_SUPPORT_SPL
+#	if defined(HAK_SPL_UNSUPPORTED_ERROR)
+#		error UNSUPPORTED
+#	endif
+#endif
+
+#endif

lib/hak.c

@@ -23,6 +23,7 @@
  */
 
 #include "hak-prv.h"
+#include <hak-hnd.h>
 
 hak_t* hak_open (hak_mmgr_t* mmgr, hak_oow_t xtnsize, const hak_vmprim_t* vmprim, hak_errinf_t* errinf)
 {
@@ -118,6 +119,7 @@ int hak_init (hak_t* hak, hak_mmgr_t* mmgr, const hak_vmprim_t* vmprim)
 {
 	int static_mods_inited = 0;
 	int modtab_inited = 0;
+	int hndtab_inited = 0;
 	int n;
 
 	if (!vmprim->syserrstrb && !vmprim->syserrstru)
@@ -175,6 +177,10 @@ int hak_init (hak_t* hak, hak_mmgr_t* mmgr, const hak_vmprim_t* vmprim)
 	modtab_inited = 1;
 	hak_rbt_setstyle(&hak->modtab, hak_get_rbt_style(HAK_RBT_STYLE_INLINE_COPIERS));
 
+	n = hak_inithndtab(hak);
+	if (HAK_UNLIKELY(n <= -1)) goto oops;
+	hndtab_inited = 1;
+
 	fill_bigint_tables(hak);
 
 	hak->tagged_brands[HAK_OOP_TAG_SMOOI] = HAK_BRAND_SMOOI;
@@ -199,6 +205,7 @@ int hak_init (hak_t* hak, hak_mmgr_t* mmgr, const hak_vmprim_t* vmprim)
 	return 0;
 
 oops:
+	if (hndtab_inited) hak_finihndtab(hak);
 	if (modtab_inited) hak_rbt_fini(&hak->modtab);
 	if (static_mods_inited) hak_htb_fini(&hak->static_mods);
 	if (hak->gci.stack.ptr)
@@ -234,6 +241,10 @@ void hak_fini (hak_t* hak)
 	hak_rbt_fini(&hak->modtab);
 	hak_htb_fini(&hak->static_mods);
 
+	/* after the modules, so that a module's unload can close its own handles
+	 * first; whatever hak code leaked is closed here. */
+	hak_finihndtab(hak);
+
 	if (hak->log.len > 0)
 	{
 		/* flush pending log messages just in case. */

lib/hak.h

@@ -119,6 +119,9 @@ enum hak_errnum_t
 	HAK_EUNDEFVAR   /**< runtime error - undefined variable access */
 };
 typedef enum hak_errnum_t hak_errnum_t;
+
+/* defined in hak-hnd.h */
+typedef struct hak_hndtab_t hak_hndtab_t;
 /**/
 
 enum hak_synerrnum_t
@@ -1261,6 +1264,22 @@ typedef int (*hak_vmprim_getsig_t) (
 	hak_uint8_t*       sig
 );
 
+/**
+ * The hak_vmprim_catchsig_t type defines how an operating system signal is
+ * routed into hak. With \a enable non-zero the signal is caught and its number
+ * posted to the signal descriptor returned by \a vm_getsigfd, so that hak code
+ * can wait on that descriptor and read the number with \a vm_getsig. With
+ * \a enable zero the signal is released back to its previous disposition.
+ *
+ * Signals that cannot be caught, that indicate a crash, or that hak uses for
+ * process switching are refused.
+ */
+typedef int (*hak_vmprim_catchsig_t) (
+	hak_t*             hak,
+	int                signo,
+	int                enable
+);
+
 typedef int (*hak_vmprim_setsig_t) (
 	hak_t*             hak,
 	hak_uint8_t        sig
@@ -1301,6 +1320,7 @@ struct hak_vmprim_t
 	hak_vmprim_getsigfd_t  vm_getsigfd;
 	hak_vmprim_getsig_t    vm_getsig;
 	hak_vmprim_setsig_t    vm_setsig;
+	hak_vmprim_catchsig_t  vm_catchsig; /* optional. may be HAK_NULL */
 };
 
 typedef struct hak_vmprim_t hak_vmprim_t;
@@ -1868,6 +1888,10 @@ struct hak_t
 	hak_oow_t sem_io_map_capa;
 	/* ============================================================================= */
 
+	/* the system handle table. see hak-hnd.h. opaque here so that hak.h need
+	 * not pull in the handle definitions. */
+	hak_hndtab_t* hndtab;
+
 	hak_oop_t* proc_map;
 	hak_oow_t proc_map_capa;
 	hak_oow_t proc_map_used;
@@ -1891,10 +1915,14 @@ struct hak_t
 	hak_oob_t* active_code;
 	hak_ooi_t sp;
 	hak_ooi_t ip;
-	int no_proc_switch; /* process switching disabled */
-	int proc_switched; /* TODO: this is temporary. implement something else to skip immediate context switching */
-	int switch_proc;
-	int abort_req;
+	hak_uint8_t abort_req;
+	hak_uint8_t no_proc_switch; /* process switching disabled */
+	hak_uint8_t proc_switched; /* TODO: this is temporary. implement something else to skip immediate context switching */
+	hak_uint8_t rcv_tick; /* whether to receive tick or not */
+	hak_uint32_t tick; /* instance specific tick */
+	hak_uint32_t last_tick;  /* last instance specific tick this instance acted on */
+	hak_uint32_t last_gtick;  /* last global tick this instance acted on */
+
 	hak_ntime_t exec_start_time;
 	hak_ntime_t exec_end_time;
 	hak_oop_t last_retv;
@@ -2275,6 +2303,20 @@ HAK_EXPORT void hak_seterrumsg (
 	const hak_uch_t* errmsg
 ) HAK_NONNULL_1(1);
 
+/**
+ * The hak_releaseiohandle() function deletes the resources associated with
+ * the given IO handle, the IO semaphores among them. It must be called before
+ * closing an IO handle, or the multiplexer keeps watching a handle number that
+ * may since have been recycled for something unrelated.
+ *
+ * hak_closehnd() in hak-hnd.h does this for you; call it directly only for a
+ * handle the handle table does not own.
+ */
+HAK_EXPORT void hak_releaseiohandle (
+	hak_t*    hak,
+	hak_ooi_t io_handle
+);
+
 HAK_EXPORT void hak_seterrwithsyserr (
 	hak_t*       hak,
 	int          syserr_type,
@@ -2519,12 +2561,25 @@ HAK_EXPORT void hak_abort (
 	hak_t* hak
 );
 
+HAK_EXPORT void hak_rcvtick (
+	hak_t* hak,
+	int    enabled
+);
 
-#if defined(HAK_HAVE_INLINE)
-	static HAK_INLINE void hak_switchprocess (hak_t* hak) { hak->switch_proc = 1; }
-#else
-#	define hak_switchprocess(hak) ((hak)->switch_proc = 1)
-#endif
+/**
+ * The hak_raisetick() function raises a tick for the given instance only.
+ * hak_raise_gtick(), on the other hand, raises one for every instance in the
+ * process; it is safe to call from a signal handler, as it only increments a
+ * counter.
+ *
+ * A raised tick makes the instance switch to the next runnable process at its
+ * next opportunity. Reception must be enabled first: an instance ignores both
+ * kinds of tick until hak_rcvtick(hak, 1) has been called on it, and a global
+ * tick reaches only those instances that have enabled it.
+ */
+HAK_EXPORT void hak_raisetick (
+	hak_t* hak
+);
 
 HAK_EXPORT void hak_setbasesrloc (
 	hak_t*    hak,
@@ -2728,7 +2783,6 @@ void* hak_getxtn (
 	hak_t* hak
 );
 
-
 #if defined(HAK_HAVE_INLINE)
 static HAK_INLINE hak_code_t* hak_getcode (hak_t* hak) { return &hak->code; }
 static HAK_INLINE hak_oob_t* hak_getbcptr (hak_t* hak) { return hak->code.bc.ptr; }
@@ -3505,6 +3559,10 @@ HAK_EXPORT void hak_uncatch_termreq (
 	void
 );
 
+HAK_EXPORT void hak_raise_gtick (
+	int unused
+);
+
 #if defined(__cplusplus)
 }
 #endif

lib/hnd.c

@@ -0,0 +1,630 @@
+/*
+    Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in the
+       documentation and/or other materials provided with the distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
+    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+    OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+    IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+    NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+    THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#if !defined(_GNU_SOURCE)
+#	define _GNU_SOURCE
+#endif
+
+#include <hak-hnd.h>
+#include "hak-prv.h"
+
+#if defined(_WIN32)
+#	include <windows.h>
+#else
+#	include <sys/types.h>
+#	include <sys/stat.h>
+#	include <unistd.h>
+#	include <fcntl.h>
+#	include <errno.h>
+#endif
+
+/* how much the id map and the descriptor reverse map grow by */
+#define MAP_ALIGN 64
+
+/* the id map is indexed by id, which is dense, so an int-sized ceiling is
+ * plenty and keeps every id comfortably inside HAK_SMOOI_MAX */
+#define MAP_CAPA_MAX HAK_TYPE_MAX(int)
+
+struct hak_hndtab_t
+{
+	/* circular lists with real nodes as sentinels. a cast-a-2-pointer-struct
+	 * sentinel would silently depend on prev/next sitting at the very front
+	 * of hak_hnd_t; spending two nodes here removes that coupling. */
+	hak_hnd_t used;
+	hak_hnd_t free;
+
+	/* id -> node */
+	struct
+	{
+		hak_hnd_t** tab;
+		hak_ooi_t   capa;
+		hak_ooi_t   high; /* the next id to hand out */
+	} map;
+
+	/* descriptor -> id, so that a descriptor cannot be wrapped twice.
+	 * two nodes over one descriptor would make hak_closehnd() on either of
+	 * them drop the other's multiplexer registration. */
+	struct
+	{
+		hak_ooi_t* tab;
+		hak_ooi_t  capa;
+	} fdmap;
+};
+
+/* ------------------------------------------------------------------------- */
+
+static HAK_INLINE void chain_to_free (hak_hndtab_t* tab, hak_hnd_t* node)
+{
+	node->next = &tab->free;
+	node->prev = tab->free.prev;
+	node->prev->next = node;
+	tab->free.prev = node;
+}
+
+static HAK_INLINE void chain_to_used (hak_hndtab_t* tab, hak_hnd_t* node)
+{
+	node->next = &tab->used;
+	node->prev = tab->used.prev;
+	node->prev->next = node;
+	tab->used.prev = node;
+}
+
+static HAK_INLINE void unchain (hak_hnd_t* node)
+{
+	node->prev->next = node->next;
+	node->next->prev = node->prev;
+}
+
+/* ------------------------------------------------------------------------- */
+
+int hak_inithndtab (hak_t* hak)
+{
+	hak_hndtab_t* tab;
+
+	tab = (hak_hndtab_t*)hak_callocmem(hak, HAK_SIZEOF(*tab));
+	if (HAK_UNLIKELY(!tab)) return -1;
+
+	tab->used.prev = tab->used.next = &tab->used;
+	tab->free.prev = tab->free.next = &tab->free;
+
+	hak->hndtab = tab;
+	return 0;
+}
+
+void hak_finihndtab (hak_t* hak)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+	hak_hnd_t* node;
+
+	if (!tab) return;
+
+	/* close whatever hak code left open. an owner closes the handles it owns,
+	 * so walk from the head each time rather than caching a next pointer. */
+	while ((node = tab->used.next) != &tab->used)
+	{
+		hak_closehnd(hak, node);
+	}
+
+	while ((node = tab->free.next) != &tab->free)
+	{
+		unchain(node);
+		hak_freemem(hak, node);
+	}
+
+	if (tab->map.tab) hak_freemem(hak, tab->map.tab);
+	if (tab->fdmap.tab) hak_freemem(hak, tab->fdmap.tab);
+	hak_freemem(hak, tab);
+	hak->hndtab = HAK_NULL;
+}
+
+/* ------------------------------------------------------------------------- */
+
+static hak_hnd_t* alloc_node (hak_t* hak)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+	hak_hnd_t* node;
+
+	if (tab->free.next != &tab->free)
+	{
+		node = tab->free.next;
+		unchain(node);
+	}
+	else
+	{
+		hak_ooi_t id;
+
+		/* NOTE: the condition is >=, not <=. hawk's idmap-imp.h uses <=,
+		 * which reallocates on every single node creation. */
+		if (tab->map.high >= tab->map.capa)
+		{
+			hak_ooi_t newcapa, inc;
+			hak_hnd_t** tmp;
+
+			inc = MAP_CAPA_MAX - tab->map.capa;
+			if (inc <= 0)
+			{
+				hak_seterrbfmt(hak, HAK_EFLOOD, "too many system handles");
+				return HAK_NULL;
+			}
+			if (inc > MAP_ALIGN) inc = MAP_ALIGN;
+			newcapa = tab->map.capa + inc;
+
+			tmp = (hak_hnd_t**)hak_reallocmem(hak, tab->map.tab, HAK_SIZEOF(*tmp) * newcapa);
+			if (HAK_UNLIKELY(!tmp)) return HAK_NULL;
+
+			HAK_MEMSET(&tmp[tab->map.capa], 0, HAK_SIZEOF(*tmp) * (newcapa - tab->map.capa));
+			tab->map.tab = tmp;
+			tab->map.capa = newcapa;
+		}
+
+		id = tab->map.high;
+		/* an id travels to hak code as a small integer */
+		if (!HAK_IN_SMOOI_RANGE(id))
+		{
+			hak_seterrbfmt(hak, HAK_EFLOOD, "system handle id %zd out of the permitted range", id);
+			return HAK_NULL;
+		}
+
+		node = (hak_hnd_t*)hak_callocmem(hak, HAK_SIZEOF(*node));
+		if (HAK_UNLIKELY(!node)) return HAK_NULL;
+
+		node->id = id;
+		tab->map.high++;
+	}
+
+	HAK_ASSERT(hak, tab->map.tab[node->id] == HAK_NULL);
+	tab->map.tab[node->id] = node;
+	chain_to_used(tab, node);
+
+	node->owner = -1;
+	return node;
+}
+
+static void free_node (hak_t* hak, hak_hnd_t* node)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+	hak_ooi_t id = node->id;
+
+	unchain(node);
+	tab->map.tab[id] = HAK_NULL;
+
+	node->type = 0;
+	node->flags = 0;
+	node->owner = -1;
+	node->u.ptr = HAK_NULL;
+	node->dtor = HAK_NULL;
+
+	if (tab->map.high == id + 1)
+	{
+		/* the highest id. give the memory back and lower the watermark. */
+		hak_freemem(hak, node);
+		tab->map.high--;
+	}
+	else
+	{
+		node->id = id; /* keep the id for reuse */
+		chain_to_free(tab, node);
+	}
+}
+
+/* ------------------------------------------------------------------------- */
+
+static int remember_fd (hak_t* hak, int fd, hak_ooi_t id)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+
+	if (fd < 0) return 0;
+
+	if (fd >= tab->fdmap.capa)
+	{
+		hak_ooi_t newcapa, i;
+		hak_ooi_t* tmp;
+
+		newcapa = HAK_ALIGN_POW2((hak_ooi_t)fd + 1, MAP_ALIGN);
+		tmp = (hak_ooi_t*)hak_reallocmem(hak, tab->fdmap.tab, HAK_SIZEOF(*tmp) * newcapa);
+		if (HAK_UNLIKELY(!tmp)) return -1;
+
+		for (i = tab->fdmap.capa; i < newcapa; i++) tmp[i] = -1;
+		tab->fdmap.tab = tmp;
+		tab->fdmap.capa = newcapa;
+	}
+
+	tab->fdmap.tab[fd] = id;
+	return 0;
+}
+
+static HAK_INLINE void forget_fd (hak_t* hak, int fd)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+	if (fd >= 0 && fd < tab->fdmap.capa) tab->fdmap.tab[fd] = -1;
+}
+
+static HAK_INLINE hak_ooi_t fd_to_id (hak_t* hak, int fd)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+	if (fd < 0 || fd >= tab->fdmap.capa) return -1;
+	return tab->fdmap.tab[fd];
+}
+
+/* ------------------------------------------------------------------------- */
+
+/**
+ * Work out what kind of descriptor \a fd is and whether the multiplexer will
+ * take it. Doing this once here, at wrap time, is what keeps every caller
+ * from discovering it later as an EPERM out of epoll_ctl - or, on a poll()
+ * build, from never discovering it at all because poll() reports a regular
+ * file as permanently ready.
+ */
+static int probe_fd (hak_t* hak, int fd, hak_hnd_type_t* type, int* muxable)
+{
+#if defined(_WIN32)
+	/* TODO: GetFileType() on the underlying HANDLE. until then a caller must
+	 *       state the type and nothing is muxable. */
+	*type = 0;
+	*muxable = 0;
+	return 0;
+#else
+	struct stat st;
+
+	if (fstat(fd, &st) <= -1)
+	{
+		hak_seterrbfmtwithsyserr(hak, 0, errno, "unable to identify handle %d", fd);
+		return -1;
+	}
+
+	if (S_ISFIFO(st.st_mode))      { *type = HAK_HND_TYPE_PIPE; *muxable = 1; }
+	else if (S_ISSOCK(st.st_mode)) { *type = HAK_HND_TYPE_SCK;  *muxable = 1; }
+	else if (S_ISCHR(st.st_mode))  { *type = HAK_HND_TYPE_CHR;  *muxable = 1; }
+	else if ((st.st_mode & S_IFMT) == 0)
+	{
+		/* an anonymous inode. linux hands these out for pidfd, eventfd,
+		 * timerfd and signalfd: no file type bits at all, yet all of them are
+		 * pollable. without this arm they would fall through to FILE below and
+		 * the multiplexer would refuse them. */
+		*type = HAK_HND_TYPE_EVT;  *muxable = 1;
+	}
+	else                           { *type = HAK_HND_TYPE_FILE; *muxable = 0; }
+
+	return 0;
+#endif
+}
+
+static int set_nonblock (hak_t* hak, int fd)
+{
+#if defined(_WIN32)
+	hak_seterrnum(hak, HAK_ENOIMPL);
+	return -1;
+#elif defined(O_NONBLOCK)
+	int fl;
+
+	fl = fcntl(fd, F_GETFL, 0);
+	if (fl <= -1 || fcntl(fd, F_SETFL, fl | O_NONBLOCK) <= -1)
+	{
+		hak_seterrbfmtwithsyserr(hak, 0, errno, "unable to set handle %d non-blocking", fd);
+		return -1;
+	}
+	return 0;
+#else
+	hak_seterrnum(hak, HAK_ENOIMPL);
+	return -1;
+#endif
+}
+
+/* ------------------------------------------------------------------------- */
+
+hak_hnd_t* hak_wrapfd (hak_t* hak, int fd, hak_hnd_type_t type_hint, int flags)
+{
+	hak_hnd_t* node;
+	hak_hnd_type_t type;
+	int muxable = 0;
+
+	if (fd < 0)
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "invalid handle %d", fd);
+		return HAK_NULL;
+	}
+
+	if (fd_to_id(hak, fd) >= 0)
+	{
+		/* refuse rather than hand out a second node. see fdmap above. */
+		hak_seterrbfmt(hak, HAK_EEXIST, "handle %d already wrapped as %zd", fd, fd_to_id(hak, fd));
+		return HAK_NULL;
+	}
+
+	if (probe_fd(hak, fd, &type, &muxable) <= -1) return HAK_NULL;
+
+	if (type_hint && !(type_hint & type))
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "handle %d not of the required kind", fd);
+		return HAK_NULL;
+	}
+
+	if ((flags & HAK_HND_OPEN_NONBLOCK) && set_nonblock(hak, fd) <= -1) return HAK_NULL;
+
+	node = alloc_node(hak);
+	if (HAK_UNLIKELY(!node)) return HAK_NULL;
+
+	node->type = type;
+	node->flags = flags & (HAK_HND_FLAG_NONBLOCK | HAK_HND_FLAG_KEEPOPEN);
+	/* the probe decides, unless the caller asserts it knows better */
+	if (muxable || (flags & HAK_HND_FLAG_MUXABLE)) node->flags |= HAK_HND_FLAG_MUXABLE;
+	node->u.fd = fd;
+
+	if (remember_fd(hak, fd, node->id) <= -1)
+	{
+		free_node(hak, node);
+		return HAK_NULL;
+	}
+
+	return node;
+}
+
+hak_hnd_t* hak_wrapptr (hak_t* hak, void* ptr, hak_hnd_type_t type, int flags, hak_hnd_dtor_t dtor)
+{
+	hak_hnd_t* node;
+
+	if (!ptr || !(type & (HAK_HND_TYPE_DIR | HAK_HND_TYPE_PROC)))
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "invalid pointer-shaped handle");
+		return HAK_NULL;
+	}
+
+	node = alloc_node(hak);
+	if (HAK_UNLIKELY(!node)) return HAK_NULL;
+
+	node->type = type;
+	node->flags = flags & HAK_HND_FLAG_KEEPOPEN; /* never muxable */
+	node->u.ptr = ptr;
+	node->dtor = dtor;
+	return node;
+}
+
+hak_hnd_t* hak_wrapfd_once (hak_t* hak, int fd, hak_hnd_type_t type_hint, int flags)
+{
+	hak_ooi_t id;
+
+	if (fd < 0)
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "invalid handle %d", fd);
+		return HAK_NULL;
+	}
+
+	id = fd_to_id(hak, fd);
+	if (id >= 0) return hak->hndtab->map.tab[id];
+
+	return hak_wrapfd(hak, fd, type_hint, flags);
+}
+
+void hak_ownhnd (hak_t* hak, hak_hnd_t* hnd, hak_hnd_t* owner)
+{
+	HAK_ASSERT(hak, hnd != owner);
+	hnd->owner = owner? owner->id: -1;
+}
+
+/* ------------------------------------------------------------------------- */
+
+hak_hnd_t* hak_gethnd (hak_t* hak, hak_ooi_t id, int acceptable_types)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+	hak_hnd_t* node;
+
+	if (id < 0 || id >= tab->map.high || !(node = tab->map.tab[id]))
+	{
+		hak_seterrbfmt(hak, HAK_EBADHND, "invalid system handle %zd", id);
+		return HAK_NULL;
+	}
+
+	if (!(node->type & acceptable_types))
+	{
+		hak_seterrbfmt(hak, HAK_EBADHND, "system handle %zd not of an acceptable kind", id);
+		return HAK_NULL;
+	}
+
+	return node;
+}
+
+hak_hnd_t* hak_gethndwithoop (hak_t* hak, hak_oop_t id, int acceptable_types)
+{
+	if (!HAK_OOP_IS_SMOOI(id))
+	{
+		hak_seterrbfmt(hak, HAK_EBADHND, "system handle not a small integer - %O", id);
+		return HAK_NULL;
+	}
+	return hak_gethnd(hak, HAK_OOP_TO_SMOOI(id), acceptable_types);
+}
+
+/* ------------------------------------------------------------------------- */
+
+int hak_closehnd (hak_t* hak, hak_hnd_t* hnd)
+{
+	hak_hndtab_t* tab = hak->hndtab;
+	hak_hnd_t* p;
+	hak_hnd_t* next;
+	hak_ooi_t id = hnd->id;
+	int n = 0;
+
+	/* 1. handles this one owns go first. a child process must not outlive the
+	 *    node that represents it. */
+	for (p = tab->used.next; p != &tab->used; p = next)
+	{
+		next = p->next;
+		if (p != hnd && p->owner == id) hak_closehnd(hak, p);
+	}
+
+	/* 2. drop any multiplexer registration while the handle is still valid.
+	 *    doing this after the close would leave the VM watching a descriptor
+	 *    number that may already have been recycled. */
+	if ((hnd->flags & HAK_HND_FLAG_IN_MUX) && (hnd->type & HAK_HND_TYPE_ALL_FD))
+	{
+		hak_releaseiohandle(hak, hnd->u.fd);
+		hnd->flags &= ~HAK_HND_FLAG_IN_MUX;
+	}
+
+	/* 3. release the resource itself */
+	if (!(hnd->flags & HAK_HND_FLAG_KEEPOPEN))
+	{
+		if (hnd->dtor) /* destructor available */
+		{
+			/* the subsystem that created the resource knows how to dispose of
+			 * it. this is also the path hak_finihndtab() takes, which is why a
+			 * pointer-shaped node needs a destructor to avoid leaking both the
+			 * resource and, for a child process, the process itself. */
+			hnd->dtor(hak, hnd);
+		}
+		else if (hnd->type & HAK_HND_TYPE_ALL_FD)
+		{
+			/* all file-descriptor based handles */
+		#if defined(_WIN32)
+			if (!CloseHandle((HANDLE)(hak_uintptr_t)hnd->u.fd)) n = -1;
+		#else
+			if (close(hnd->u.fd) <= -1)
+			{
+				hak_seterrbfmtwithsyserr(hak, 0, errno, "unable to close handle %d", hnd->u.fd);
+				n = -1;
+			}
+		#endif
+		}
+		/* a pointer-shaped node with no destructor releases nothing, which is
+		 * only correct when the pointer is owned elsewhere. */
+	}
+
+	if (hnd->type & HAK_HND_TYPE_ALL_FD)
+	{
+		/* all file-descriptor based handles */
+		forget_fd(hak, hnd->u.fd);
+	}
+
+	free_node(hak, hnd);
+	return n;
+}
+
+/* ------------------------------------------------------------------------- */
+
+int hak_bindhnd (hak_t* hak, hak_hnd_t* hnd, hak_oop_semaphore_t sem, hak_semaphore_io_type_t io_type)
+{
+	if (!(hnd->flags & HAK_HND_FLAG_MUXABLE))
+	{
+		/* a regular file is the common case here. it is never reported as
+		 * not-ready, so waiting on one is meaningless as well as unsupported. */
+		hak_seterrbfmt(hak, HAK_EINVAL, "system handle %zd cannot be multiplexed", hnd->id);
+		return -1;
+	}
+
+	if (hak_add_sem_to_sem_io_tuple(hak, sem, hnd->u.fd, io_type) <= -1) return -1;
+
+	hnd->flags |= HAK_HND_FLAG_IN_MUX;
+	return 0;
+}
+
+/* ------------------------------------------------------------------------- */
+
+hak_ooi_t hak_readhnd (hak_t* hak, hak_hnd_t* hnd, void* buf, hak_oow_t len)
+{
+#if !defined(_WIN32)
+	hak_ooi_t n;
+#endif
+
+	if (!(hnd->type & HAK_HND_TYPE_ALL_STREAM))
+	{
+		hak_seterrbfmt(hak, HAK_EBADHND, "system handle %zd not readable", hnd->id);
+		return HAK_HND_IO_ERROR;
+	}
+
+	if (len > (hak_oow_t)HAK_TYPE_MAX(hak_ooi_t)) len = (hak_oow_t)HAK_TYPE_MAX(hak_ooi_t);
+
+#if defined(_WIN32)
+	{
+		DWORD count;
+		if (len > (hak_oow_t)HAK_TYPE_MAX(DWORD)) len = (hak_oow_t)HAK_TYPE_MAX(DWORD);
+		if (!ReadFile((HANDLE)(hak_uintptr_t)hnd->u.fd, buf, (DWORD)len, &count, HAK_NULL))
+		{
+			DWORD e = GetLastError();
+			if (e == ERROR_BROKEN_PIPE) return 0; /* end of file */
+			hak_seterrwithsyserr(hak, 1, e);
+			return HAK_HND_IO_ERROR;
+		}
+		return (hak_ooi_t)count;
+	}
+#else
+	n = read(hnd->u.fd, buf, len);
+	if (n <= -1)
+	{
+		if (errno == EINTR) return HAK_HND_IO_WOULDBLOCK; /* let hak code retry */
+	#if defined(EWOULDBLOCK) && defined(EAGAIN) && (EWOULDBLOCK != EAGAIN)
+		if (errno == EAGAIN || errno == EWOULDBLOCK) return HAK_HND_IO_WOULDBLOCK;
+	#elif defined(EAGAIN)
+		if (errno == EAGAIN) return HAK_HND_IO_WOULDBLOCK;
+	#elif defined(EWOULDBLOCK)
+		if (errno == EWOULDBLOCK) return HAK_HND_IO_WOULDBLOCK;
+	#endif
+		hak_seterrwithsyserr(hak, 0, errno);
+		return HAK_HND_IO_ERROR;
+	}
+	return n;
+#endif
+}
+
+hak_ooi_t hak_writehnd (hak_t* hak, hak_hnd_t* hnd, const void* buf, hak_oow_t len)
+{
+#if !defined(_WIN32)
+	hak_ooi_t n;
+#endif
+
+	if (!(hnd->type & HAK_HND_TYPE_ALL_STREAM))
+	{
+		hak_seterrbfmt(hak, HAK_EBADHND, "system handle %zd not writable", hnd->id);
+		return HAK_HND_IO_ERROR;
+	}
+
+	if (len > (hak_oow_t)HAK_TYPE_MAX(hak_ooi_t)) len = (hak_oow_t)HAK_TYPE_MAX(hak_ooi_t);
+
+#if defined(_WIN32)
+	{
+		DWORD count;
+		if (len > (hak_oow_t)HAK_TYPE_MAX(DWORD)) len = (hak_oow_t)HAK_TYPE_MAX(DWORD);
+		if (!WriteFile((HANDLE)(hak_uintptr_t)hnd->u.fd, buf, (DWORD)len, &count, HAK_NULL))
+		{
+			hak_seterrwithsyserr(hak, 1, GetLastError());
+			return HAK_HND_IO_ERROR;
+		}
+		return (hak_ooi_t)count;
+	}
+#else
+	n = write(hnd->u.fd, buf, len);
+	if (n <= -1)
+	{
+		if (errno == EINTR) return HAK_HND_IO_WOULDBLOCK;
+	#if defined(EWOULDBLOCK) && defined(EAGAIN) && (EWOULDBLOCK != EAGAIN)
+		if (errno == EAGAIN || errno == EWOULDBLOCK) return HAK_HND_IO_WOULDBLOCK;
+	#elif defined(EAGAIN)
+		if (errno == EAGAIN) return HAK_HND_IO_WOULDBLOCK;
+	#elif defined(EWOULDBLOCK)
+		if (errno == EWOULDBLOCK) return HAK_HND_IO_WOULDBLOCK;
+	#endif
+		hak_seterrwithsyserr(hak, 0, errno);
+		return HAK_HND_IO_ERROR;
+	}
+	return n;
+#endif
+}

lib/pio.c

@@ -1345,6 +1345,42 @@ void hak_pio_fini (hak_pio_t* pio)
 	hak_pio_wait(pio);
 }
 
+void hak_pio_free (hak_pio_t* pio)
+{
+	hak_t* hak = pio->hak;
+	hak_errnum_t errnum;
+
+	/* a teardown path must not clobber whatever error brought us here */
+	errnum = hak_geterrnum(hak);
+
+	hak_pio_end(pio, HAK_PIO_ERR);
+	hak_pio_end(pio, HAK_PIO_OUT);
+	hak_pio_end(pio, HAK_PIO_IN);
+
+	if (pio->child != HAK_PIO_PID_NIL)
+	{
+		int n;
+
+		/* look without blocking first - a child that has already exited
+		 * needs no killing */
+		pio->flags |= HAK_PIO_WAITNOBLOCK;
+		pio->flags &= ~HAK_PIO_WAITNORETRY;
+		n = hak_pio_wait(pio);
+
+		if (n == 255 + 1)
+		{
+			/* still running. SIGKILL cannot be caught or ignored, so the
+			 * blocking wait below is bounded however the child behaves. */
+			hak_pio_kill(pio);
+			pio->flags &= ~HAK_PIO_WAITNOBLOCK;
+			hak_pio_wait(pio);
+		}
+	}
+
+	hak_freemem(hak, pio);
+	hak_seterrnum(hak, errnum);
+}
+
 hak_pio_hnd_t hak_pio_gethnd (const hak_pio_t* pio, hak_pio_hid_t hid)
 {
 	return pio->handle[hid];

lib/prim.c

@@ -23,6 +23,7 @@
  */
 
 #include "hak-prv.h"
+#include <hak-hnd.h>
 
 struct pf_t
 {
@@ -1258,8 +1259,19 @@ static hak_pfrc_t 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_ooi_t fd;
+	hak_hnd_t* hnd;
+
 	fd = hak->vmprim.vm_getsigfd(hak);
-	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(fd));
+
+	/* hand back a system handle id rather than the descriptor itself, so that
+	 * the result can be given to sem-signal-on-input - which resolves handle
+	 * ids, not descriptors. wrapped HAK_HND_OPEN_KEEPOPEN because the VM owns
+	 * this descriptor and manages its blocking mode; the table must never
+	 * close it. wrapfd_once() keeps the id stable across calls. */
+	hnd = hak_wrapfd_once(hak, (int)fd, 0, HAK_HND_OPEN_KEEPOPEN);
+	if (HAK_UNLIKELY(!hnd)) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(hnd->id));
 	return HAK_PF_SUCCESS;
 }
 
@@ -1277,6 +1289,50 @@ 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
+ *                              signal descriptor, where hak code can wait for
+ *                              it with sem-signal-on-input
+ * (system-uncatch-sig signo) - release it again
+ *
+ * Note the difference from system-set-sig, 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.
+ */
+static hak_pfrc_t __system_catch_sig (hak_t* hak, hak_ooi_t nargs, int enable)
+{
+	hak_oop_t tmp;
+	hak_ooi_t signo;
+
+	tmp = HAK_STACK_GETARG(hak, nargs, 0);
+	if (!HAK_OOP_IS_SMOOI(tmp))
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "signal number not a small integer - %O", tmp);
+		return HAK_PF_FAILURE;
+	}
+	signo = HAK_OOP_TO_SMOOI(tmp);
+
+	if (!hak->vmprim.vm_catchsig)
+	{
+		hak_seterrbfmt(hak, HAK_ENOIMPL, "signal routing not supported");
+		return HAK_PF_FAILURE;
+	}
+
+	if (hak->vmprim.vm_catchsig(hak, (int)signo, enable) <= -1) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(signo));
+	return HAK_PF_SUCCESS;
+}
+
+static hak_pfrc_t 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)
+{
+	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_oop_t tmp;
@@ -1310,9 +1366,11 @@ 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' } },
+	{ 0, 0,                       pf_system_get_sigfd,   16, { 's','y','s','t','e','m','-','g','e','t','-','s','i','g','f','d' } },
 	{ 0, 0,                       pf_system_get_sig,     14,  { 's','y','s','t','e','m','-','g','e','t','-','s','i','g' } },
 	{ 1, 1,                       pf_system_set_sig,     14,  { 's','y','s','t','e','m','-','s','e','t','-','s','i','g' } },
+	{ 1, 1,                       pf_system_catch_sig,   16, { 's','y','s','t','e','m','-','c','a','t','c','h','-','s','i','g' } },
+	{ 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' } },
 

mod/core.c

@@ -313,6 +313,88 @@ static hak_pfrc_t pf_core_basic_size (hak_t* hak, hak_mod_t* mod, hak_ooi_t narg
 	return HAK_PF_SUCCESS;
 }
 
+/* ------------------------------------------------------------------------ *
+ * CONS CELLS
+ *
+ * A data list written #(1 2 3) is a chain of Cons cells, and a Cons keeps its
+ * head and tail in named instance variables rather than indexed slots. That
+ * puts it outside the reach of basicAt and primAt, both of which require a
+ * flexi (indexed) receiver, so a list was previously opaque to hak code. These
+ * three give the class library what it needs to walk one and to build one.
+ * ------------------------------------------------------------------------ */
+
+static hak_pfrc_t pf_core_car (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_t obj;
+
+	obj = HAK_STACK_GETARG(hak, nargs, 0);
+	if (!HAK_IS_CONS(hak, obj))
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "receiver not a cons - %O", obj);
+		return HAK_PF_FAILURE;
+	}
+
+	HAK_STACK_SETRET(hak, nargs, HAK_CONS_CAR(obj));
+	return HAK_PF_SUCCESS;
+}
+
+static hak_pfrc_t pf_core_cdr (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_t obj;
+
+	obj = HAK_STACK_GETARG(hak, nargs, 0);
+	if (!HAK_IS_CONS(hak, obj))
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "receiver not a cons - %O", obj);
+		return HAK_PF_FAILURE;
+	}
+
+	HAK_STACK_SETRET(hak, nargs, HAK_CONS_CDR(obj));
+	return HAK_PF_SUCCESS;
+}
+
+/* (core.cons head tail) -> a new cons cell */
+static hak_pfrc_t pf_core_cons (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_t car, cdr, c;
+
+	car = HAK_STACK_GETARG(hak, nargs, 0);
+	cdr = HAK_STACK_GETARG(hak, nargs, 1);
+
+	/* keep both rooted across the allocation. the argument stack roots them
+	 * too and the collector is mark-sweep, so this is belt-and-braces; it is
+	 * what would keep these local copies valid if the compacting collector in
+	 * gc.c were ever turned on. */
+	hak_pushvolat(hak, &car);
+	hak_pushvolat(hak, &cdr);
+	c = hak_makecons(hak, car, cdr);
+	hak_popvolats(hak, 2);
+	if (HAK_UNLIKELY(!c)) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, c);
+	return HAK_PF_SUCCESS;
+}
+
+/* (core.classOf obj) -> the class of obj
+ *
+ * className answers a string, which is no use for building something of the
+ * same kind as the receiver. This answers the class itself, so that a method
+ * can do what Smalltalk spells "self species new:" - collect and select on a
+ * String returning a String rather than an Array of characters.
+ *
+ * HAK_CLASSOF() copes with a value encoded into the pointer - a small integer,
+ * a character, an error or a small pointer - so this is total: every object has
+ * a class.
+ */
+static hak_pfrc_t pf_core_class_of (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_t obj;
+
+	obj = HAK_STACK_GETARG(hak, nargs, 0);
+	HAK_STACK_SETRET(hak, nargs, (hak_oop_t)HAK_CLASSOF(hak, obj));
+	return HAK_PF_SUCCESS;
+}
+
 static hak_pfrc_t pf_core_class_name (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 {
 	hak_oop_t obj;
@@ -515,9 +597,13 @@ static hak_pfinfo_t pfinfos[] =
 	{ "bit-shift",          { HAK_PFBASE_FUNC, hak_pf_integer_bshift,         2,  2 } },
 	{ "bit-xor",            { HAK_PFBASE_FUNC, hak_pf_integer_bxor,           2,  2 } },
 
+	{ "car",                { HAK_PFBASE_FUNC, pf_core_car,                   1,  1 } },
+	{ "cdr",                { HAK_PFBASE_FUNC, pf_core_cdr,                   1,  1 } },
 	{ "charToSmooi",        { HAK_PFBASE_FUNC, pf_core_char_to_smooi,         1,  1 } },
 	{ "className",          { HAK_PFBASE_FUNC, pf_core_class_name,            1,  1 } },
+	{ "classOf",            { HAK_PFBASE_FUNC, pf_core_class_of,              1,  1 } },
 	{ "classRespondsTo",    { HAK_PFBASE_FUNC, pf_core_class_responds_to,     2,  2 } },
+	{ "cons",               { HAK_PFBASE_FUNC, pf_core_cons,                  2,  2 } },
 
 	{ "eqk?",               { HAK_PFBASE_FUNC, hak_pf_eqk,                    2,  2 } },
 	{ "eql?",               { HAK_PFBASE_FUNC, hak_pf_eql,                    2,  2 } },

mod/dic.c

@@ -82,38 +82,284 @@ static hak_pfrc_t pf_dic_put (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 }
 
 
-static int walker (hak_t* hak, hak_oop_dic_t dic, hak_oop_cons_t pair, void* ctx)
+/* ------------------------------------------------------------------------ *
+ * INSPECTION
+ * ------------------------------------------------------------------------ */
+
+/* resolve and validate the dictionary argument shared by everything here */
+static hak_oop_dic_t arg_to_dic (hak_t* hak, hak_ooi_t nargs, hak_ooi_t idx)
 {
-	HAK_DEBUG2(hak, "walker ===> %O  =====> %O\n", HAK_CONS_CAR(pair), HAK_CONS_CDR(pair));
+	hak_oop_t d = HAK_STACK_GETARG(hak, nargs, idx);
+	if (!HAK_IS_DIC(hak, d))
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "parameter not a dictionary - %O", d);
+		return HAK_NULL;
+	}
+	return (hak_oop_dic_t)d;
+}
+
+/* (dic.make [bucket-size]) -> a new dictionary
+ * The literal #{} covers the common case; this is for choosing an initial
+ * bucket size when the eventual population is known. */
+static hak_pfrc_t pf_dic_make (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oow_t inisize = 16;
+	hak_oop_t d;
+
+	if (nargs >= 1)
+	{
+		hak_oop_t t = HAK_STACK_GETARG(hak, nargs, 0);
+		hak_ooi_t v;
+		if (hak_inttoooi(hak, t, &v) == 0) return HAK_PF_FAILURE;
+		if (v <= 0)
+		{
+			hak_seterrbfmt(hak, HAK_EINVAL, "bucket size not positive - %O", t);
+			return HAK_PF_FAILURE;
+		}
+		inisize = (hak_oow_t)v;
+	}
+
+	d = hak_makedic(hak, inisize);
+	if (HAK_UNLIKELY(!d)) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, d);
+	return HAK_PF_SUCCESS;
+}
+
+/* (dic.size d) -> how many pairs it holds */
+static hak_pfrc_t pf_dic_size (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_dic_t dic = arg_to_dic(hak, nargs, 0);
+	if (HAK_UNLIKELY(!dic)) return HAK_PF_FAILURE;
+	HAK_STACK_SETRET(hak, nargs, dic->tally);
+	return HAK_PF_SUCCESS;
+}
+
+/* (dic.has? d k) -> true or false
+ * dic.get answers with an error object for a missing key, which is awkward to
+ * test when the stored value could itself be an error. */
+static hak_pfrc_t pf_dic_has (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_dic_t dic = arg_to_dic(hak, nargs, 0);
+	hak_oop_t key;
+
+	if (HAK_UNLIKELY(!dic)) return HAK_PF_FAILURE;
+	key = HAK_STACK_GETARG(hak, nargs, 1);
+
+	HAK_STACK_SETRET(hak, nargs, hak_getatdic(hak, dic, key)? hak->_true: hak->_false);
+	return HAK_PF_SUCCESS;
+}
+
+/* (dic.delete d k) -> true if a pair went away, false if there was none */
+static hak_pfrc_t pf_dic_delete (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_dic_t dic = arg_to_dic(hak, nargs, 0);
+	hak_oop_t key;
+
+	if (HAK_UNLIKELY(!dic)) return HAK_PF_FAILURE;
+	key = HAK_STACK_GETARG(hak, nargs, 1);
+
+	HAK_STACK_SETRET(hak, nargs, (hak_zapatdic(hak, dic, key) >= 0)? hak->_true: hak->_false);
+	return HAK_PF_SUCCESS;
+}
+
+/* ------------------------------------------------------------------------ *
+ * ITERATION
+ *
+ * A dictionary is iterated by asking for its keys or values as an array and
+ * walking that from hak code. There is deliberately no callback form: calling
+ * a hak block from inside a primitive would need the virtual machine to be
+ * re-entrant, which it is not, and collecting first also keeps the caller
+ * clear of the question of what happens when the dictionary is modified
+ * during a walk.
+ * ------------------------------------------------------------------------ */
+
+struct collect_t
+{
+	hak_oop_t arr;
+	hak_oow_t idx;
+	hak_oow_t capa;
+	int       want;       /* WANT_KEY, WANT_VALUE or WANT_PAIR */
+};
+
+#define WANT_KEY   0
+#define WANT_VALUE 1
+#define WANT_PAIR  2
+typedef struct collect_t collect_t;
+
+static int collect_walker (hak_t* hak, hak_oop_dic_t dic, hak_oop_cons_t pair, void* ctx)
+{
+	collect_t* c = (collect_t*)ctx;
+
+	/* tally and the number of pairs actually walked should agree, but never
+	 * write past the array we sized from it */
+	if (c->idx >= c->capa) return -1;
+
+	HAK_OBJ_SET_OOP_VAL(c->arr, c->idx,
+		(c->want == WANT_PAIR)? (hak_oop_t)pair:
+		(c->want == WANT_VALUE)? HAK_CONS_CDR(pair): HAK_CONS_CAR(pair));
+	c->idx++;
 	return 0;
 }
 
-static hak_pfrc_t pf_dic_walk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+static hak_pfrc_t collect (hak_t* hak, hak_ooi_t nargs, int want)
 {
-/* TODO: write a proper function 
- * (dic.apply #{ ... } callable-or-lambda)
- */
-	hak_oop_t arg;
+	hak_oop_t dic;
+	hak_oop_t arr;
+	hak_ooi_t n;
+	collect_t c;
 
-	arg = HAK_STACK_GETARG(hak, nargs, 0);
-	if (!HAK_IS_DIC(hak,arg))
+	if (!arg_to_dic(hak, nargs, 0)) return HAK_PF_FAILURE;
+	dic = HAK_STACK_GETARG(hak, nargs, 0);
+
+	n = HAK_OOP_TO_SMOOI(((hak_oop_dic_t)dic)->tally);
+
+	/* Keep the dictionary rooted across the allocation. hak's collector is
+	 * mark-sweep and does not relocate, and the argument stack roots the
+	 * dictionary anyway, so this is belt-and-braces today; it is what would
+	 * keep the code correct if the compacting collector in gc.c were ever
+	 * turned on. */
+	hak_pushvolat(hak, &dic);
+	arr = hak_makearray(hak, (hak_oow_t)n);
+	hak_popvolat(hak);
+	if (HAK_UNLIKELY(!arr)) return HAK_PF_FAILURE;
+
+	/* nothing below allocates, so raw slot writes are safe from here */
+	c.arr = arr;
+	c.idx = 0;
+	c.capa = (hak_oow_t)n;
+	c.want = want;
+	hak_walkdic(hak, (hak_oop_dic_t)dic, collect_walker, &c);
+
+	HAK_STACK_SETRET(hak, nargs, arr);
+	return HAK_PF_SUCCESS;
+}
+
+/* (dic.keys d) -> an array of the keys */
+static hak_pfrc_t pf_dic_keys (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	return collect(hak, nargs, WANT_KEY);
+}
+
+/* (dic.values d) -> an array of the values, in the same order as dic.keys */
+static hak_pfrc_t pf_dic_values (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	return collect(hak, nargs, WANT_VALUE);
+}
+
+/* (dic.pairs d) -> an array of the associations themselves
+ *
+ * One array instead of the two that dic.keys plus dic.values costs; read each
+ * association with core.car and core.cdr. */
+static hak_pfrc_t pf_dic_pairs (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	return collect(hak, nargs, WANT_PAIR);
+}
+
+/* ------------------------------------------------------------------------ *
+ * ALLOCATION-FREE TRAVERSAL
+ *
+ * dic.keys, dic.values and dic.pairs each build an array. These two allocate
+ * nothing at all: walk the slots from 0 to dic.bucketSize and read whichever
+ * are occupied, taking key and value from the association with core.car and
+ * core.cdr.
+ *
+ * The cost is that the traversal is live rather than a snapshot - inserting
+ * during one may grow the bucket and rearrange everything, so a pair can be
+ * seen twice or missed. Removing is safe, since a removal never grows the
+ * bucket. Use dic.keys where a snapshot matters; use these where the traversal
+ * is hot and nothing is being inserted.
+ *
+ * These do expose that a bucket exists and has gaps. The bucket doubles once it
+ * is nearly full, so for a dictionary of any size the load runs between about
+ * 57% and 96% - a quarter of the slots walked are empty on average. A small
+ * dictionary still inside its initial bucket of 26 is far sparser than that, so
+ * the slot walk is relatively worst exactly where it matters least.
+ * ------------------------------------------------------------------------ */
+
+/* (dic.bucketSize d) -> how many slots to walk */
+static hak_pfrc_t pf_dic_bucket_size (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_dic_t dic = arg_to_dic(hak, nargs, 0);
+	if (HAK_UNLIKELY(!dic)) return HAK_PF_FAILURE;
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP((hak_ooi_t)HAK_OBJ_GET_SIZE(dic->bucket)));
+	return HAK_PF_SUCCESS;
+}
+
+/* (dic.pairAt d index) -> the association in that slot, or nil if it is empty */
+static hak_pfrc_t pf_dic_pair_at (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_dic_t dic = arg_to_dic(hak, nargs, 0);
+	hak_oop_t t;
+	hak_ooi_t i;
+
+	if (HAK_UNLIKELY(!dic)) return HAK_PF_FAILURE;
+
+	t = HAK_STACK_GETARG(hak, nargs, 1);
+	if (hak_inttoooi(hak, t, &i) == 0) return HAK_PF_FAILURE;
+
+	if (i < 0 || i >= (hak_ooi_t)HAK_OBJ_GET_SIZE(dic->bucket))
 	{
-		hak_seterrbfmt(hak, HAK_EINVAL, "parameter not a dictionary - %O", arg);
+		hak_seterrbfmt(hak, HAK_ERANGE, "slot %zd out of range - the bucket holds %zu", i, HAK_OBJ_GET_SIZE(dic->bucket));
 		return HAK_PF_FAILURE;
 	}
 
-	hak_walkdic(hak, (hak_oop_dic_t)arg, walker, HAK_NULL);
-	HAK_STACK_SETRET(hak, nargs, hak->_true);
+	t = dic->bucket->slot[i];
+	HAK_STACK_SETRET(hak, nargs, HAK_IS_CONS(hak, t)? t: hak->_nil);
+	return HAK_PF_SUCCESS;
+}
+
+/* (dic.clear d) -> the number of pairs removed */
+static hak_pfrc_t pf_dic_clear (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_t dic;
+	hak_oop_t keys;
+	hak_ooi_t n, i, gone = 0;
+	collect_t c;
+
+	if (!arg_to_dic(hak, nargs, 0)) return HAK_PF_FAILURE;
+	dic = HAK_STACK_GETARG(hak, nargs, 0);
+
+	n = HAK_OOP_TO_SMOOI(((hak_oop_dic_t)dic)->tally);
+
+	/* collect the keys before removing any: zapping during a walk would
+	 * disturb the buckets the walk is traversing. see collect() on the guard. */
+	hak_pushvolat(hak, &dic);
+	keys = hak_makearray(hak, (hak_oow_t)n);
+	hak_popvolat(hak);
+	if (HAK_UNLIKELY(!keys)) return HAK_PF_FAILURE;
+
+	c.arr = keys;
+	c.idx = 0;
+	c.capa = (hak_oow_t)n;
+	c.want = WANT_KEY;
+	hak_walkdic(hak, (hak_oop_dic_t)dic, collect_walker, &c);
+
+	for (i = 0; i < n; i++)
+	{
+		if (hak_zapatdic(hak, (hak_oop_dic_t)dic, HAK_OBJ_GET_OOP_VAL(keys, i)) >= 0) gone++;
+	}
+
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(gone));
 	return HAK_PF_SUCCESS;
 }
 
 
+/* sorted: hak_findpfbase() binary-searches this table */
 static hak_pfinfo_t pfinfos[] =
 {
+	{ "bucketSize", { HAK_PFBASE_FUNC, pf_dic_bucket_size, 1,  1 } },
+	{ "clear",  { HAK_PFBASE_FUNC, pf_dic_clear,   1,  1 } },
+	{ "delete", { HAK_PFBASE_FUNC, pf_dic_delete,  2,  2 } },
 	{ "get",    { HAK_PFBASE_FUNC, pf_dic_get,     2,  2 } },
-/*	{ "make",  { HAK_PFBASE_FUNC, pf_dic_make,    1,  1 } }, */
+	{ "has?",   { HAK_PFBASE_FUNC, pf_dic_has,     2,  2 } },
+	{ "keys",   { HAK_PFBASE_FUNC, pf_dic_keys,    1,  1 } },
+	{ "make",   { HAK_PFBASE_FUNC, pf_dic_make,    0,  1 } },
+	{ "pairAt", { HAK_PFBASE_FUNC, pf_dic_pair_at, 2,  2 } },
+	{ "pairs",  { HAK_PFBASE_FUNC, pf_dic_pairs,   1,  1 } },
 	{ "put",    { HAK_PFBASE_FUNC, pf_dic_put,     3,  3 } },
-	{ "walk",  { HAK_PFBASE_FUNC, pf_dic_walk,    2,  2 } },
+	{ "size",   { HAK_PFBASE_FUNC, pf_dic_size,    1,  1 } },
+	{ "values", { HAK_PFBASE_FUNC, pf_dic_values,  1,  1 } }
 };
 
 /* ------------------------------------------------------------------------ */

mod/sys.c

@@ -25,10 +25,26 @@
  */
 
 
+/* _GNU_SOURCE must precede any libc header - pipe2() is behind it */
+#if !defined(_WIN32) && !defined(_GNU_SOURCE)
+#	define _GNU_SOURCE
+#endif
+
 #include "_sys.h"
+#include <hak-hnd.h>
+#include <hak-pio.h>
 #include <hak-str.h>
 #include <stdlib.h>
 
+#if !defined(_WIN32)
+#	include <sys/types.h>
+#	include <sys/stat.h>
+#	include <unistd.h>
+#	include <fcntl.h>
+#	include <errno.h>
+#	include <sys/syscall.h>
+#endif
+
 #if defined(HAVE_SYS_TIME_H)
 #	include <sys/time.h>
 #endif
@@ -146,70 +162,591 @@ static hak_pfrc_t pf_sys_random (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 	return HAK_PF_SUCCESS;
 }
 
-#include <stdio.h> // TODO: remove this and replace it by own impl
-static hak_pfrc_t pf_sys_popen (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
-{
-	hak_oop_t t;
-	hak_bch_t* cmd;
-	FILE* pp;
 
-	t = HAK_STACK_GETARG(hak, nargs, 0);
-// TODO: support byte array?
-	/*if (!HAK_IS_STRING(hak, t)) goto oops;*/
-	if (!HAK_OBJ_IS_CHAR_POINTER(t) ||
-	    HAK_OBJ_GET_SIZE(t) == 0 ||
+/* ------------------------------------------------------------------------ *
+ * SYSTEM HANDLE PRIMITIVES
+ *
+ * Every one of these takes or returns a handle id - a small integer resolved
+ * against the handle table in hak-hnd.h. hak code never sees a descriptor, so
+ * it cannot name one it did not open, and hak_closehnd() is guaranteed the
+ * chance to unbind a handle from the multiplexer before it disappears.
+ *
+ * sys.read and sys.write follow the non-blocking contract: they return the
+ * byte count, 0 at end of file, or -1 when the handle would have blocked.
+ * -1 is an ordinary outcome - the caller is expected to wait on a semaphore
+ * bound with sem-signal-on-input/-output and try again. Only a genuine
+ * failure raises.
+ * ------------------------------------------------------------------------ */
+
+/* pull a null-terminated hak string out of an argument */
+static hak_bch_t* dup_path_arg (hak_t* hak, hak_oop_t t)
+{
+	if (!HAK_OBJ_IS_CHAR_POINTER(t) || HAK_OBJ_GET_SIZE(t) == 0 ||
 	    hak_count_oocstr(HAK_OBJ_GET_CHAR_SLOT(t)) != HAK_OBJ_GET_SIZE(t))
 	{
-		/* invalid command arguments */
-		goto oops;
+		hak_seterrbfmt(hak, HAK_EINVAL, "path not a proper string - %O", t);
+		return HAK_NULL;
 	}
+	return hak_dupootobcstr(hak, HAK_OBJ_GET_CHAR_SLOT(t), HAK_NULL);
+}
 
-	cmd = hak_dupootobcstr(hak, HAK_OBJ_GET_CHAR_SLOT(t), HAK_NULL);
-	if (!cmd) goto oops;
+#if !defined(_WIN32)
+/* translate a mode string into open() flags. hak has no way to expose
+ * O_RDONLY and friends as constants yet - HAK_PFBASE_CONST is unimplemented -
+ * so a mode string is what a script can actually write today. */
+static int mode_str_to_oflags (hak_t* hak, hak_oop_t t, int* oflags)
+{
+	const hak_ooch_t* p;
+	hak_oow_t len;
+	int fl;
 
-	/* TODO: we need a bidirectional popen.. replace it with our own impl. */
-	pp = popen(cmd, "r");
-	if (!pp) goto oops;
-
-	if (!HAK_IN_SMPTR_RANGE(pp))
+	if (!HAK_OBJ_IS_CHAR_POINTER(t))
 	{
-		pclose(pp);
-		goto oops;
+		hak_seterrbfmt(hak, HAK_EINVAL, "mode not a string - %O", t);
+		return -1;
 	}
 
-/* using smptr in this mannger is dangerous. because the caller may set random values to other function like pclose...... */
-	HAK_STACK_SETRET(hak, nargs, HAK_SMPTR_TO_OOP(pp));
-	return HAK_PF_SUCCESS;
+	p = HAK_OBJ_GET_CHAR_SLOT(t);
+	len = HAK_OBJ_GET_SIZE(t);
 
-oops:
-	// TODO: set return value..
+	if (len == 1 && p[0] == 'r')                     fl = O_RDONLY;
+	else if (len == 1 && p[0] == 'w')                fl = O_WRONLY | O_CREAT | O_TRUNC;
+	else if (len == 1 && p[0] == 'a')                fl = O_WRONLY | O_CREAT | O_APPEND;
+	else if (len == 2 && p[0] == 'r' && p[1] == '+') fl = O_RDWR;
+	else if (len == 2 && p[0] == 'w' && p[1] == '+') fl = O_RDWR | O_CREAT | O_TRUNC;
+	else if (len == 2 && p[0] == 'a' && p[1] == '+') fl = O_RDWR | O_CREAT | O_APPEND;
+	else
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "unrecognized open mode - %O", t);
+		return -1;
+	}
+
+#if defined(O_CLOEXEC)
+	/* a child process has no business inheriting a handle hak code opened */
+	fl |= O_CLOEXEC;
+#endif
+#if defined(O_NONBLOCK)
+	/* required in the open() itself for a fifo, where a blocking open would
+	 * wait for a peer. harmless on a regular file. */
+	fl |= O_NONBLOCK;
+#endif
+#if defined(O_LARGEFILE)
+	fl |= O_LARGEFILE;
+#endif
+
+	*oflags = fl;
+	return 0;
+}
+#endif
+
+static hak_pfrc_t pf_sys_open (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+#if defined(_WIN32)
+	hak_seterrnum(hak, HAK_ENOIMPL);
+	return HAK_PF_FAILURE;
+#else
+	hak_bch_t* path;
+	hak_hnd_t* hnd;
+	int oflags, fd;
+	hak_ooi_t mode = 0644;
+
+	path = dup_path_arg(hak, HAK_STACK_GETARG(hak, nargs, 0));
+	if (HAK_UNLIKELY(!path)) return HAK_PF_FAILURE;
+
+	if (mode_str_to_oflags(hak, HAK_STACK_GETARG(hak, nargs, 1), &oflags) <= -1)
+	{
+		hak_freemem(hak, path);
+		return HAK_PF_FAILURE;
+	}
+
+	if (nargs >= 3 && hak_inttoooi(hak, HAK_STACK_GETARG(hak, nargs, 2), &mode) == 0)
+	{
+		hak_freemem(hak, path);
+		return HAK_PF_FAILURE;
+	}
+
+	fd = open(path, oflags, (int)mode);
+	if (fd <= -1)
+	{
+		hak_seterrbfmtwithsyserr(hak, 0, errno, "unable to open %hs", path);
+		hak_freemem(hak, path);
+		return HAK_PF_FAILURE;
+	}
+	hak_freemem(hak, path);
+
+	/* the probe inside hak_wrapfd() decides the type and whether the
+	 * multiplexer will take it, so a regular file never reaches epoll. */
+	hnd = hak_wrapfd(hak, fd, 0, HAK_HND_OPEN_NONBLOCK);
+	if (HAK_UNLIKELY(!hnd))
+	{
+		close(fd);
+		return HAK_PF_FAILURE;
+	}
+
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(hnd->id));
+	return HAK_PF_SUCCESS;
+#endif
+}
+
+static hak_pfrc_t pf_sys_close (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_hnd_t* hnd;
+
+	hnd = hak_gethndwithoop(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_HND_TYPE_ALL_FD);
+	if (HAK_UNLIKELY(!hnd)) return HAK_PF_FAILURE;
+
+	/* hak_closehnd() unbinds the handle from the multiplexer before the
+	 * descriptor goes away and releases the node either way. */
+	if (hak_closehnd(hak, hnd) <= -1) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, hak->_nil);
 	return HAK_PF_SUCCESS;
 }
 
-static hak_pfrc_t pf_sys_pclose (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+/* resolve the (buffer, offset, length) triple shared by read and write */
+static int get_buf_args (hak_t* hak, hak_ooi_t nargs, hak_oop_t bufoop,
+                         hak_oob_t** ptr, hak_oow_t* len)
 {
-	hak_oop_t t;
+	hak_oow_t offset = 0, length, maxlen;
 
-	t = HAK_STACK_GETARG(hak, nargs, 0);
-	if (HAK_OOP_IS_SMPTR(t))
+	if (!HAK_OBJ_IS_BYTE_POINTER(bufoop))
 	{
-		FILE* pp;
-		pp = (FILE*)HAK_OOP_TO_SMPTR(t);
-		if (pp) pclose(pp);
+		hak_seterrbfmt(hak, HAK_EINVAL, "buffer not a byte array - %O", bufoop);
+		return -1;
 	}
 
-	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(0));
+	maxlen = HAK_OBJ_GET_SIZE(bufoop);
+	length = maxlen;
+
+	if (nargs >= 3)
+	{
+		hak_oop_t t = HAK_STACK_GETARG(hak, nargs, 2);
+		if (hak_inttooow(hak, t, &offset) == 0)
+		{
+			hak_seterrbfmt(hak, HAK_EINVAL, "invalid offset - %O", t);
+			return -1;
+		}
+		if (offset > maxlen)
+		{
+			hak_seterrbfmt(hak, HAK_ERANGE, "offset %zu past the end of a %zu byte buffer", offset, maxlen);
+			return -1;
+		}
+		length = maxlen - offset;
+
+		if (nargs >= 4)
+		{
+			t = HAK_STACK_GETARG(hak, nargs, 3);
+			if (hak_inttooow(hak, t, &length) == 0)
+			{
+				hak_seterrbfmt(hak, HAK_EINVAL, "invalid length - %O", t);
+				return -1;
+			}
+			if (length > maxlen - offset) length = maxlen - offset;
+		}
+	}
+
+	/* a raw slot pointer is safe to hold here: the collector is mark-sweep so
+	 * it never relocates an object, and the buffer stays rooted on the
+	 * argument stack for the duration of the call */
+	*ptr = &HAK_OBJ_GET_BYTE_SLOT(bufoop)[offset];
+	*len = length;
+	return 0;
+}
+
+static hak_pfrc_t pf_sys_read (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_hnd_t* hnd;
+	hak_oob_t* ptr;
+	hak_oow_t len;
+	hak_ooi_t n;
+
+	hnd = hak_gethndwithoop(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_HND_TYPE_ALL_FD);
+	if (HAK_UNLIKELY(!hnd)) return HAK_PF_FAILURE;
+
+	if (get_buf_args(hak, nargs, HAK_STACK_GETARG(hak, nargs, 1), &ptr, &len) <= -1) return HAK_PF_FAILURE;
+
+	n = hak_readhnd(hak, hnd, ptr, len);
+	if (n == HAK_HND_IO_ERROR) return HAK_PF_FAILURE;
+
+	/* n is >= 0, or -1 meaning the handle would have blocked */
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(n));
+	return HAK_PF_SUCCESS;
+}
+
+static hak_pfrc_t pf_sys_write (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_hnd_t* hnd;
+	hak_oob_t* ptr;
+	hak_oow_t len;
+	hak_ooi_t n;
+
+	hnd = hak_gethndwithoop(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_HND_TYPE_ALL_FD);
+	if (HAK_UNLIKELY(!hnd)) return HAK_PF_FAILURE;
+
+	if (get_buf_args(hak, nargs, HAK_STACK_GETARG(hak, nargs, 1), &ptr, &len) <= -1) return HAK_PF_FAILURE;
+
+	n = hak_writehnd(hak, hnd, ptr, len);
+	if (n == HAK_HND_IO_ERROR) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(n));
+	return HAK_PF_SUCCESS;
+}
+
+/* (sys.pipe) -> #[read-handle write-handle]
+ *
+ * This is how hak code obtains a handle the multiplexer will accept without
+ * any raw descriptor ever crossing the boundary. Both ends are non-blocking
+ * and close-on-exec. */
+static hak_pfrc_t pf_sys_pipe (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+#if defined(_WIN32)
+	hak_seterrnum(hak, HAK_ENOIMPL);
+	return HAK_PF_FAILURE;
+#else
+	int p[2];
+	hak_hnd_t *r = HAK_NULL, *w = HAK_NULL;
+	hak_oop_t arr;
+
+#if defined(HAVE_PIPE2) && defined(O_CLOEXEC) && defined(O_NONBLOCK)
+	if (pipe2(p, O_CLOEXEC | O_NONBLOCK) <= -1)
+	{
+		hak_seterrbfmtwithsyserr(hak, 0, errno, "unable to create a pipe");
+		return HAK_PF_FAILURE;
+	}
+#else
+	if (pipe(p) <= -1)
+	{
+		hak_seterrbfmtwithsyserr(hak, 0, errno, "unable to create a pipe");
+		return HAK_PF_FAILURE;
+	}
+#endif
+
+	r = hak_wrapfd(hak, p[0], 0, HAK_HND_OPEN_NONBLOCK);
+	if (HAK_UNLIKELY(!r)) goto oops;
+	w = hak_wrapfd(hak, p[1], 0, HAK_HND_OPEN_NONBLOCK);
+	if (HAK_UNLIKELY(!w)) goto oops;
+
+	/* the allocation may collect, but the handles live outside the heap */
+	arr = hak_makearray(hak, 2);
+	if (HAK_UNLIKELY(!arr)) goto oops;
+
+	HAK_OBJ_SET_OOP_VAL(arr, 0, HAK_SMOOI_TO_OOP(r->id));
+	HAK_OBJ_SET_OOP_VAL(arr, 1, HAK_SMOOI_TO_OOP(w->id));
+
+	HAK_STACK_SETRET(hak, nargs, arr);
+	return HAK_PF_SUCCESS;
+
+oops:
+	if (w) hak_closehnd(hak, w); else close(p[1]);
+	if (r) hak_closehnd(hak, r); else close(p[0]);
+	return HAK_PF_FAILURE;
+#endif
+}
+
+/* ------------------------------------------------------------------------ *
+ * CHILD PROCESSES
+ *
+ * A child is represented as a group of handles: one HAK_HND_TYPE_PROC node
+ * holding the hak_pio_t, plus one HAK_HND_TYPE_PIPE node per requested stream.
+ * The pipe nodes are owned by the proc node, so tearing the proc node down
+ * tears the whole group down in the right order - children first, which is
+ * what lets each pipe unbind itself from the multiplexer while its descriptor
+ * is still valid.
+ *
+ * pio owns those descriptors, so a stream node closes itself through
+ * hak_pio_end() rather than close(2). That keeps pio's own view consistent -
+ * it nils the handle it just closed, so the later hak_pio_free() will not
+ * close it twice - and it means sys.close on a child's stdin really does send
+ * EOF, which is how a filter like `tr` is told to flush and exit.
+ *
+ * Every pipe is non-blocking, so sys.read and sys.write on a child's streams
+ * behave exactly like they do on a sys.pipe handle - including returning -1
+ * for "would block", which is what makes a child usable from a coprocess
+ * without stalling the VM.
+ *
+ * Where the platform provides pidfd_open(), the group also carries an exit
+ * handle: a descriptor that becomes readable when the child terminates. It is
+ * an ordinary muxable handle, so waiting for a child costs nothing more than
+ * waiting for a pipe - no signal handler, no shared signal stream, and none of
+ * the coalescing that makes SIGCHLD awkward, since the handle is per child and
+ * stays readable once set. Without it the exit handle is nil and a caller has
+ * to poll sys.pwait.
+ * ------------------------------------------------------------------------ */
+
+/* kept in the pio extension area, so no separate allocation is needed */
+struct proc_xtn_t
+{
+	int reaped;  /* has the child been waited on already? */
+	int status;  /* ...and what did it exit with */
+};
+typedef struct proc_xtn_t proc_xtn_t;
+
+static void proc_dtor (hak_t* hak, hak_hnd_t* hnd)
+{
+	/* hak_pio_free() ends the pipes, reaps the child - killing it if it is
+	 * still running - and frees the object, all without an unbounded wait.
+	 * this runs from sys.pclose and from hak_finihndtab() alike, so a script
+	 * that simply forgets a child still cannot leak one. */
+	hak_pio_free((hak_pio_t*)hnd->u.ptr);
+}
+
+/* close a child's stream through pio, so that pio stops believing it still
+ * owns the descriptor. the stream is identified by matching the descriptor,
+ * which is unambiguous because a pio's three ends are always distinct. */
+static void stream_dtor (hak_t* hak, hak_hnd_t* hnd)
+{
+	hak_hnd_t* ph;
+
+	/* the owner is still alive here: hak_closehnd() closes what a node owns
+	 * before closing the node itself */
+	ph = hak_gethnd(hak, hnd->owner, HAK_HND_TYPE_PROC);
+	if (ph)
+	{
+		hak_pio_t* pio = (hak_pio_t*)ph->u.ptr;
+		hak_pio_hid_t hid;
+
+		for (hid = HAK_PIO_IN; hid <= HAK_PIO_ERR; hid++)
+		{
+			if (hak_pio_gethnd(pio, hid) == (hak_pio_hnd_t)hnd->u.fd)
+			{
+				hak_pio_end(pio, hid);
+				return;
+			}
+		}
+	}
+
+	/* the owner is gone, or the stream is no longer pio's - fall back so the
+	 * descriptor is not leaked */
+	close(hnd->u.fd);
+}
+
+/* wrap one of the child's streams as a pipe handle owned by the proc node */
+static hak_hnd_t* wrap_stream (hak_t* hak, hak_pio_t* pio, hak_pio_hid_t hid, hak_hnd_t* owner)
+{
+	hak_hnd_t* h;
+
+	h = hak_wrapfd(hak, (int)hak_pio_gethnd(pio, hid), HAK_HND_TYPE_PIPE, 0);
+	if (HAK_UNLIKELY(!h)) return HAK_NULL;
+
+	hak_ownhnd(hak, h, owner);
+	h->dtor = stream_dtor;
+	return h;
+}
+
+/* (sys.popen cmd [mode]) -> #[proc in out err exit]
+ *
+ * mode is any combination of 'r' (read the child's stdout), 'w' (write to its
+ * stdin) and 'e' (read its stderr); the default is "r". A stream that was not
+ * requested comes back as nil, as does the exit handle where the platform has
+ * no pidfd_open(). The command is run through a shell, as popen() does.
+ */
+static hak_pfrc_t pf_sys_popen (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_oop_t cmdoop, arr;
+	hak_pio_t* pio;
+	proc_xtn_t* x;
+	hak_hnd_t *ph, *ih = HAK_NULL, *oh = HAK_NULL, *eh = HAK_NULL, *xh = HAK_NULL;
+	int flags;
+
+	cmdoop = HAK_STACK_GETARG(hak, nargs, 0);
+	if (!HAK_OBJ_IS_CHAR_POINTER(cmdoop) || HAK_OBJ_GET_SIZE(cmdoop) == 0 ||
+	    hak_count_oocstr(HAK_OBJ_GET_CHAR_SLOT(cmdoop)) != HAK_OBJ_GET_SIZE(cmdoop))
+	{
+		hak_seterrbfmt(hak, HAK_EINVAL, "command not a proper string - %O", cmdoop);
+		return HAK_PF_FAILURE;
+	}
+
+	/* every wait is non-blocking; sys.pwait reports 256 for a live child
+	 * rather than stopping every other coprocess. */
+	flags = HAK_PIO_SHELL | HAK_PIO_WAITNOBLOCK;
+
+	if (nargs >= 2)
+	{
+		hak_oop_t m = HAK_STACK_GETARG(hak, nargs, 1);
+		const hak_ooch_t* p;
+		hak_oow_t i, len;
+
+		if (!HAK_OBJ_IS_CHAR_POINTER(m))
+		{
+			hak_seterrbfmt(hak, HAK_EINVAL, "mode not a string - %O", m);
+			return HAK_PF_FAILURE;
+		}
+
+		p = HAK_OBJ_GET_CHAR_SLOT(m);
+		len = HAK_OBJ_GET_SIZE(m);
+		for (i = 0; i < len; i++)
+		{
+			switch (p[i])
+			{
+				case 'r': flags |= HAK_PIO_READOUT | HAK_PIO_OUTNOBLOCK; break;
+				case 'w': flags |= HAK_PIO_WRITEIN | HAK_PIO_INNOBLOCK;  break;
+				case 'e': flags |= HAK_PIO_READERR | HAK_PIO_ERRNOBLOCK; break;
+				default:
+					hak_seterrbfmt(hak, HAK_EINVAL, "unrecognized popen mode - %O", m);
+					return HAK_PF_FAILURE;
+			}
+		}
+	}
+	else flags |= HAK_PIO_READOUT | HAK_PIO_OUTNOBLOCK;
+
+	pio = hak_pio_open(hak, HAK_SIZEOF(proc_xtn_t), HAK_OBJ_GET_CHAR_SLOT(cmdoop), flags, HAK_NULL, HAK_NULL);
+	if (HAK_UNLIKELY(!pio)) return HAK_PF_FAILURE;
+
+	x = (proc_xtn_t*)hak_pio_getxtn(pio);
+	x->reaped = 0;
+	x->status = 0;
+
+	/* the proc node owns the pio object from here on: if any wrap below
+	 * fails, closing it disposes of the child through proc_dtor(). */
+	ph = hak_wrapptr(hak, pio, HAK_HND_TYPE_PROC, 0, proc_dtor);
+	if (HAK_UNLIKELY(!ph))
+	{
+		hak_pio_free(pio);
+		return HAK_PF_FAILURE;
+	}
+
+	if ((flags & HAK_PIO_WRITEIN) && !(ih = wrap_stream(hak, pio, HAK_PIO_IN, ph))) goto oops;
+	if ((flags & HAK_PIO_READOUT) && !(oh = wrap_stream(hak, pio, HAK_PIO_OUT, ph))) goto oops;
+	if ((flags & HAK_PIO_READERR) && !(eh = wrap_stream(hak, pio, HAK_PIO_ERR, ph))) goto oops;
+
+/* -DHAK_SYS_NO_EXITHND suppresses the exit handle, which is how the SIGCHLD
+ * fallback path in the library layer gets exercised on a platform that does
+ * have pidfd_open(). */
+#if defined(SYS_pidfd_open) && !defined(HAK_SYS_NO_EXITHND)
+	{
+		/* the syscall directly rather than the glibc wrapper, which only
+		 * appeared in glibc 2.36 */
+		int xfd = (int)syscall(SYS_pidfd_open, (pid_t)hak_pio_getchild(pio), 0);
+		if (xfd >= 0)
+		{
+			/* HAK_HND_OPEN_MUXABLE because we know a pidfd is pollable; the
+			 * probe reaches the same conclusion via its anonymous-inode arm,
+			 * but saying so here keeps this correct on a platform where it
+			 * does not. */
+			xh = hak_wrapfd(hak, xfd, 0, HAK_HND_OPEN_MUXABLE);
+			if (HAK_UNLIKELY(!xh))
+			{
+				close(xfd);
+				goto oops;
+			}
+			hak_ownhnd(hak, xh, ph);
+		}
+		/* a failure here is not fatal: an older kernel simply means no exit
+		 * handle, and the caller polls sys.pwait instead. */
+	}
+#endif
+
+	/* this may collect, but handle nodes live outside the object heap */
+	arr = hak_makearray(hak, 5);
+	if (HAK_UNLIKELY(!arr)) goto oops;
+
+	HAK_OBJ_SET_OOP_VAL(arr, 0, HAK_SMOOI_TO_OOP(ph->id));
+	HAK_OBJ_SET_OOP_VAL(arr, 1, ih? HAK_SMOOI_TO_OOP(ih->id): hak->_nil);
+	HAK_OBJ_SET_OOP_VAL(arr, 2, oh? HAK_SMOOI_TO_OOP(oh->id): hak->_nil);
+	HAK_OBJ_SET_OOP_VAL(arr, 3, eh? HAK_SMOOI_TO_OOP(eh->id): hak->_nil);
+	HAK_OBJ_SET_OOP_VAL(arr, 4, xh? HAK_SMOOI_TO_OOP(xh->id): hak->_nil);
+
+	HAK_STACK_SETRET(hak, nargs, arr);
+	return HAK_PF_SUCCESS;
+
+oops:
+	hak_closehnd(hak, ph); /* takes the stream nodes and the child with it */
+	return HAK_PF_FAILURE;
+}
+
+/* (sys.pwait proc) -> 0..255 | 256 + signo | 256 if still running
+ *
+ * Never blocks. A script that wants to wait can loop on this, or - once
+ * SIGCHLD is routed to the signal descriptor - wait on that instead.
+ */
+static hak_pfrc_t pf_sys_pwait (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_hnd_t* ph;
+	hak_pio_t* pio;
+	proc_xtn_t* x;
+	int n;
+
+	ph = hak_gethndwithoop(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_HND_TYPE_PROC);
+	if (HAK_UNLIKELY(!ph)) return HAK_PF_FAILURE;
+
+	pio = (hak_pio_t*)ph->u.ptr;
+	x = (proc_xtn_t*)hak_pio_getxtn(pio);
+
+	if (x->reaped)
+	{
+		/* the child was waited on already; waitpid() would now fail with
+		 * ECHILD, so report what it exited with instead */
+		HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(x->status));
+		return HAK_PF_SUCCESS;
+	}
+
+	n = hak_pio_wait(pio);
+	if (n <= -1) return HAK_PF_FAILURE;
+
+	if (n != 255 + 1)
+	{
+		x->reaped = 1;
+		x->status = n;
+	}
+
+	HAK_STACK_SETRET(hak, nargs, HAK_SMOOI_TO_OOP(n));
+	return HAK_PF_SUCCESS;
+}
+
+/* (sys.pkill proc) - SIGKILL the child */
+static hak_pfrc_t pf_sys_pkill (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_hnd_t* ph;
+
+	ph = hak_gethndwithoop(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_HND_TYPE_PROC);
+	if (HAK_UNLIKELY(!ph)) return HAK_PF_FAILURE;
+
+	if (hak_pio_kill((hak_pio_t*)ph->u.ptr) <= -1) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, hak->_nil);
+	return HAK_PF_SUCCESS;
+}
+
+/* (sys.pclose proc) -> the child's exit status if it is known, else nil
+ *
+ * Tears the whole group down: the stream handles are released and unbound
+ * from the multiplexer, and the child is reaped - killed first if it has not
+ * exited. It does not wait for a running child to finish on its own, so it
+ * cannot stall the other coprocesses; use sys.pwait for that.
+ */
+static hak_pfrc_t pf_sys_pclose (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
+{
+	hak_hnd_t* ph;
+	proc_xtn_t* x;
+	hak_oop_t retv;
+
+	ph = hak_gethndwithoop(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_HND_TYPE_PROC);
+	if (HAK_UNLIKELY(!ph)) return HAK_PF_FAILURE;
+
+	x = (proc_xtn_t*)hak_pio_getxtn((hak_pio_t*)ph->u.ptr);
+	retv = x->reaped? HAK_SMOOI_TO_OOP(x->status): hak->_nil;
+
+	if (hak_closehnd(hak, ph) <= -1) return HAK_PF_FAILURE;
+
+	HAK_STACK_SETRET(hak, nargs, retv);
 	return HAK_PF_SUCCESS;
 }
 
 static hak_pfinfo_t pfinfos[] =
 {
+	{ "close",       { HAK_PFBASE_FUNC,  pf_sys_close,        1,  1 } },
+	{ "open",        { HAK_PFBASE_FUNC,  pf_sys_open,         2,  3 } },
 	{ "pclose",      { HAK_PFBASE_FUNC,  pf_sys_pclose,       1,  1 } },
+	{ "pipe",        { HAK_PFBASE_FUNC,  pf_sys_pipe,         0,  0 } },
+	{ "pkill",       { HAK_PFBASE_FUNC,  pf_sys_pkill,        1,  1 } },
 	{ "popen",       { HAK_PFBASE_FUNC,  pf_sys_popen,        1,  2 } },
+	{ "pwait",       { HAK_PFBASE_FUNC,  pf_sys_pwait,        1,  1 } },
 	{ "random",      { HAK_PFBASE_FUNC,  pf_sys_random,       0,  0 } },
+	{ "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 } },
-	{ "time",        { HAK_PFBASE_FUNC,  pf_sys_time,         0,  0 } }
+	{ "time",        { HAK_PFBASE_FUNC,  pf_sys_time,         0,  0 } },
+	{ "write",       { HAK_PFBASE_FUNC,  pf_sys_write,        2,  4 } }
 };
 
 /* ------------------------------------------------------------------------ */

src/kernel-demo.hak

@@ -0,0 +1,122 @@
+## ---------------------------------------------------------------------------------
+## Exercises for the kernel classes.
+##
+## This was the tail of kernel.hak. It is kept apart because kernel.hak has to
+## be loadable as a library: anything with $include "kernel.hak" in it was
+## running these exercises, and their output - and their deliberate errors -
+## came along with it.
+##
+## Run it directly:   hak src/kernel-demo.hak
+## ---------------------------------------------------------------------------------
+
+$include "kernel.hak"
+
+k := "abcdefghijklmn"
+printf "string length %d\n" ("aaaa":length)
+printf "substring [%s]\n" (k:slice 5 6)
+
+try {
+	printf "substring [%c]\n" (k:at 13)
+	k:atPut 14 'A'
+	printf "[%s]\n" k
+} catch (e) {
+	printf "EXCEPTION %O\n" e
+}
+
+k := #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15]
+
+try {
+	k:atPut 2 'A'
+	printf "%O\n" k
+} catch (e) {
+	printf "EXCEPTION %O\n" e
+}
+
+k := #b[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15]
+try {
+	k:atPut 2 -10
+	printf "%O\n" k
+} catch (e) {
+	printf "EXCEPTION %O\n" e
+}
+
+
+k := (Array:new 10)
+k:atPut 3 "hello"
+printf "%O\n" k
+
+printf "[%O]\n" (String:new 5)
+printf "[%O]\n" (String:basicNew 5)
+
+printf "[%O]\n" (String:respondsTo "new")
+printf "[%O]\n" (String:respondsTo "newx")
+printf "[%O]\n" (" ":respondsTo "new")
+printf "[%O]\n" (" ":respondsTo "length")
+
+##printf "[%O]\n" (String:classVariableNames)
+##printf "[%O]\n" (String:instanceVariableNames)
+
+##printf "%O\n" #"abcdefg"
+
+
+printf "----------------------------------------\n"
+
+k := #[1 2 3]
+printf "%O\n" (k:basicAt 2)
+
+class [#varying] Z: Object (a b c) {
+	fun[#classinst] new() {
+		self.a := 10
+		self.b := 20
+		self.c := 30
+	}
+
+	fun aaa() {
+	printf "%d %d %d\n" a b c
+	}
+}
+
+fun Z:abc() {
+	printf "%d %d %d\n" a b c ## this is not recognized as ....
+}
+
+class Q {
+fun[#class] k () {
+k := (Z:basicNew 10) ## #varying is really required? what is the big deal even if you allow it regardless?
+##k := (Z:new) ## no way to add extra fields.
+k:basicAtPut 2 "hello"
+k:basicAtPut 3 "world"
+printf "----------------------------------------\n"
+printf "%O\n" (k:basicAt 20)
+
+##k := (Z:new)
+##k:aaa
+}
+}
+
+fun c() {
+	(Q:k)
+}
+##try {
+	printf ">>>>>>>>>>>>>>>\n"
+
+	d := ((fun (x){
+		printf "<<%d>>\n" x
+		c
+	}) 90)
+	##(j)
+	(d 10)
+##} catch (e) {
+	printf "EXCEPTION: %O\n" e
+
+##	try {
+		throw 10000
+##	} catch (e) {
+##		printf "EXCEPTION-X: %O\n" e
+##	}
+##}
+
+
+## if the assigne operator is seen
+## a := (fun (x) { })
+## a := fun (x) { } <<--- can I support this syntax??

src/kernel.hak

@@ -82,113 +82,3 @@ $include "Collection.hak"
 ##$include "System.hak"
 
 ## ---------------------------------------------------------------------------------
-
-k := "abcdefghijklmn"
-printf "string length %d\n" ("aaaa":length)
-printf "substring [%s]\n" (k:slice 5 6)
-
-try {
-	printf "substring [%c]\n" (k:at 13)
-	k:atPut 14 'A'
-	printf "[%s]\n" k
-} catch (e) {
-	printf "EXCEPTION %O\n" e
-}
-
-k := #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15]
-
-try {
-	k:atPut 2 'A'
-	printf "%O\n" k
-} catch (e) {
-	printf "EXCEPTION %O\n" e
-}
-
-k := #b[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15]
-try {
-	k:atPut 2 -10
-	printf "%O\n" k
-} catch (e) {
-	printf "EXCEPTION %O\n" e
-}
-
-
-k := (Array:new 10)
-k:atPut 3 "hello"
-printf "%O\n" k
-
-printf "[%O]\n" (String:new 5)
-printf "[%O]\n" (String:basicNew 5)
-
-printf "[%O]\n" (String:respondsTo "new")
-printf "[%O]\n" (String:respondsTo "newx")
-printf "[%O]\n" (" ":respondsTo "new")
-printf "[%O]\n" (" ":respondsTo "length")
-
-##printf "[%O]\n" (String:classVariableNames)
-##printf "[%O]\n" (String:instanceVariableNames)
-
-##printf "%O\n" #"abcdefg"
-
-
-printf "----------------------------------------\n"
-
-k := #[1 2 3]
-printf "%O\n" (k:basicAt 2)
-
-class [#varying] Z: Object (a b c) {
-	fun[#classinst] new() {
-		self.a := 10
-		self.b := 20
-		self.c := 30
-	}
-
-	fun aaa() {
-	printf "%d %d %d\n" a b c
-	}
-}
-
-fun Z:abc() {
-	printf "%d %d %d\n" a b c ## this is not recognized as ....
-}
-
-class Q {
-fun[#class] k () {
-k := (Z:basicNew 10) ## #varying is really required? what is the big deal even if you allow it regardless?
-##k := (Z:new) ## no way to add extra fields.
-k:basicAtPut 2 "hello"
-k:basicAtPut 3 "world"
-printf "----------------------------------------\n"
-printf "%O\n" (k:basicAt 20)
-
-##k := (Z:new)
-##k:aaa
-}
-}
-
-fun c() {
-	(Q:k)
-}
-##try {
-	printf ">>>>>>>>>>>>>>>\n"
-
-	d := ((fun (x){
-		printf "<<%d>>\n" x
-		c
-	}) 90)
-	##(j)
-	(d 10)
-##} catch (e) {
-	printf "EXCEPTION: %O\n" e
-
-##	try {
-		throw 10000
-##	} catch (e) {
-##		printf "EXCEPTION-X: %O\n" e
-##	}
-##}
-
-
-## if the assigne operator is seen
-## a := (fun (x) { })
-## a := fun (x) { } <<--- can I support this syntax??

src/proc.hak

@@ -0,0 +1,235 @@
+## ---------------------------------------------------------------------------
+## Child process supervision.
+##
+## sys.popen hands back a group of handles and sys.pwait never blocks, which
+## leaves every caller to invent its own way of learning that a child has
+## finished. This layer supplies one: a set of children watched together, so
+## that a coprocess can wait for whichever of them finishes first without
+## stalling the rest of the virtual machine.
+##
+## Two mechanisms can report a child's exit, and they have different shapes:
+##
+##   - An exit handle (a pidfd on linux) belongs to one child and stays
+##     readable once that child is gone. Each child gets its own semaphore in
+##     the group, so a wakeup names exactly the child that finished.
+##
+##   - SIGCHLD is a single process-wide event. Only one semaphore may be bound
+##     to a descriptor, so the whole group shares one semaphore on the signal
+##     descriptor; and because standard signals coalesce - three children
+##     exiting can produce one SIGCHLD - a wakeup must examine every child
+##     rather than just one.
+##
+## The difference is confined to spawn() and wait(). Callers see the same
+## interface either way, and read the same #[proc in out err exit sem] record.
+## ---------------------------------------------------------------------------
+
+## record slots
+## 0 proc handle, 1 stdin, 2 stdout, 3 stderr, 4 exit handle, 5 semaphore
+
+class ChildGroup(
+	sg      ## semaphore group: the per-child semaphores or the shared one,
+	        ## plus tmo
+	tmo     ## timeout semaphore, always a member of sg
+	kids    ## array of child records, nil in a freed slot
+	capa
+	nkids
+	shared  ## true when exit handles are unavailable and SIGCHLD is in use
+	sigsem  ## the shared semaphore; only in shared mode
+) {
+	fun[#ci] new() {
+		set sg (semgr-new)
+		set tmo (sem-new)
+		semgr-add sg tmo
+		set capa 8
+		set kids (core.basicNew Array 8)
+		set nkids 0
+		set shared false
+		set sigsem nil
+		return self
+	}
+
+	fun count() { return self.nkids }
+
+	## --- registry ------------------------------------------------------
+
+	fun remember(kid) {
+		| i n bigger |
+		i := 0
+		while (< i self.capa) {
+			if (nil? (core.basicAt self.kids i)) {
+				core.basicAtPut self.kids i kid
+				set nkids (+ self.nkids 1)
+				return kid
+			}
+			i := (+ i 1)
+		}
+		## no free slot: widen the array and retry
+		n := (* self.capa 2)
+		bigger := (core.basicNew Array n)
+		i := 0
+		while (< i self.capa) {
+			core.basicAtPut bigger i (core.basicAt self.kids i)
+			i := (+ i 1)
+		}
+		set kids bigger
+		set capa n
+		return (self:remember kid)
+	}
+
+	fun forget(kid) {
+		| i |
+		i := 0
+		while (< i self.capa) {
+			if (eqv? (core.basicAt self.kids i) kid) {
+				core.basicAtPut self.kids i nil
+				set nkids (- self.nkids 1)
+				return kid
+			}
+			i := (+ i 1)
+		}
+		return nil
+	}
+
+	## --- spawning ------------------------------------------------------
+
+	## Spawn a command and watch it. mode is as sys.popen takes it.
+	## Returns the child record.
+	fun spawn(cmd mode) {
+		| p proc xh sem kid |
+
+		p := (sys.popen cmd mode)
+		proc := (core.basicAt p 0)
+		xh := (core.basicAt p 4)
+		sem := nil
+
+		if (nil? xh) {
+			## No per-child exit handle on this platform. Establish one shared
+			## semaphore on the signal descriptor for the whole group, once.
+			if (not self.shared) {
+				set shared true
+				system-catch-sig 17                 ## SIGCHLD - define this as a constant...
+				set sigsem (sem-new)
+				semgr-add self.sg self.sigsem
+				sem-signal-on-input self.sigsem (system-get-sigfd)
+			}
+		} else {
+			## A handle of its own, so a wakeup identifies this child directly.
+			sem := (sem-new)
+			semgr-add self.sg sem
+			sem-signal-on-input sem xh
+		}
+
+		kid := (core.basicNew Array 6)
+		core.basicAtPut kid 0 proc
+		core.basicAtPut kid 1 (core.basicAt p 1)
+		core.basicAtPut kid 2 (core.basicAt p 2)
+		core.basicAtPut kid 3 (core.basicAt p 3)
+		core.basicAtPut kid 4 xh
+		core.basicAtPut kid 5 sem
+		return (self:remember kid)
+	}
+
+	## --- waiting -------------------------------------------------------
+
+	## The first child that has already finished, or nil.
+	## Scanning every child is what makes SIGCHLD coalescing harmless: one
+	## signal covering three exits loses nothing.
+	fun finished() {
+		| i kid |
+		i := 0
+		while (< i self.capa) {
+			kid := (core.basicAt self.kids i)
+			if (not (nil? kid)) {
+				if (not (= (sys.pwait (core.basicAt kid 0)) 256)) { return kid }
+			}
+			i := (+ i 1)
+		}
+		return nil
+	}
+
+	fun kid-of-sem(sem) {
+		| i kid |
+		i := 0
+		while (< i self.capa) {
+			kid := (core.basicAt self.kids i)
+			if (not (nil? kid)) {
+				if (eqv? (core.basicAt kid 5) sem) { return kid }
+			}
+			i := (+ i 1)
+		}
+		return nil
+	}
+
+	## Wait for one of the watched children to finish, or for secs to elapse.
+	## Returns the child record, or nil on timeout. Other coprocesses keep
+	## running throughout: the wait is on a semaphore, not on a system call.
+	fun wait(secs) {
+		| w kid |
+
+		## one may have finished before we were asked
+		kid := (self:finished)
+		if (not (nil? kid)) { return kid }
+
+		while true {
+			sem-signal self.tmo secs 0
+			w := (semgr-wait self.sg)
+			sem-unsignal self.tmo
+
+			if (eqv? w self.tmo) { return nil }
+
+			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
+				kid := (self:finished)
+				if (not (nil? kid)) { return kid }
+				## otherwise it was a SIGCHLD for a child of the host
+				## application, or one already reaped. keep waiting.
+			} else {
+				kid := (self:kid-of-sem w)
+				if (not (nil? kid)) {
+					sem-unsignal w
+					return kid
+				}
+			}
+		}
+	}
+
+	## --- accessors and teardown ----------------------------------------
+
+	fun proc-of(kid) { return (core.basicAt kid 0) }
+	fun in-of(kid) { return (core.basicAt kid 1) }
+	fun out-of(kid) { return (core.basicAt kid 2) }
+	fun err-of(kid) { return (core.basicAt kid 3) }
+
+	## The exit status, or 256 while the child is still running.
+	fun status(kid) { return (sys.pwait (core.basicAt kid 0)) }
+
+	## Stop watching a child and release everything it holds.
+	fun close(kid) {
+		| sem |
+		sem := (core.basicAt kid 5)
+		if (not (nil? sem)) {
+			sem-unsignal sem
+			semgr-remove self.sg sem
+		}
+		self:forget kid
+		sys.pclose (core.basicAt kid 0)
+	}
+
+	## Release the group. Any children still in it are torn down.
+	fun done() {
+		| i kid |
+		i := 0
+		while (< i self.capa) {
+			kid := (core.basicAt self.kids i)
+			if (not (nil? kid)) { self:close kid }
+			i := (+ i 1)
+		}
+		if self.shared {
+			sem-unsignal self.sigsem
+			system-uncatch-sig 17
+			set shared false
+		}
+	}
+}

t/Makefile.am

@@ -9,14 +9,25 @@ AM_CPPFLAGS = \
 LDADD = ../lib/libhak.la
 
 check_SCRIPTS = \
+	classof-01.hak \
+	cons-01.hak \
+	dic-01.hak \
 	feed-01.hak \
 	fun-01.hak \
+	hnd-01.hak \
+	hnd-02.hak \
+	hnd-03.hak \
 	insta-01.hak \
 	insta-02.hak \
 	prim-01.hak \
 	proc-01.hak \
+	proclib-01.hak \
 	ret-01.hak \
 	retvar-01.hak \
+	sig-01.hak \
+	sysproc-01.hak \
+	sysproc-02.hak \
+	tick-01.hak \
 	va-01.hak \
 	var-01.hak \
 	var-02.hak \
@@ -26,15 +37,21 @@ check_ERRORS = \
 	call-5001.err \
 	class-5001.err \
 	feed-5001.err \
+	hnd-5001.err \
 	mlist-5001.err \
+	sig-5001.err \
 	var-5001.err \
 	var-5002.err \
 	var-5004.err
 
 check_PROGRAMS = \
-	t-001
+	t-001 \
+	t-002 \
+	t-003
 
 t_001_SOURCES = t-001.c tap.h
+t_002_SOURCES = t-002.c tap.h
+t_003_SOURCES = t-003.c tap.h
 
 ##noinst_SCRIPTS = $(check_SCRIPTS)
 EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)

t/Makefile.in

@@ -89,7 +89,7 @@ PRE_UNINSTALL = :
 POST_UNINSTALL = :
 build_triplet = @build@
 host_triplet = @host@
-check_PROGRAMS = t-001$(EXEEXT)
+check_PROGRAMS = t-001$(EXEEXT) t-002$(EXEEXT) t-003$(EXEEXT)
 subdir = t
 ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
 am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.m4 \
@@ -112,6 +112,14 @@ AM_V_lt = $(am__v_lt_@AM_V@)
 am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
 am__v_lt_0 = --silent
 am__v_lt_1 = 
+am_t_002_OBJECTS = t-002.$(OBJEXT)
+t_002_OBJECTS = $(am_t_002_OBJECTS)
+t_002_LDADD = $(LDADD)
+t_002_DEPENDENCIES = ../lib/libhak.la
+am_t_003_OBJECTS = t-003.$(OBJEXT)
+t_003_OBJECTS = $(am_t_003_OBJECTS)
+t_003_LDADD = $(LDADD)
+t_003_DEPENDENCIES = ../lib/libhak.la
 AM_V_P = $(am__v_P_@AM_V@)
 am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
 am__v_P_0 = false
@@ -127,7 +135,8 @@ am__v_at_1 =
 DEFAULT_INCLUDES = 
 depcomp = $(SHELL) $(top_srcdir)/ac/depcomp
 am__maybe_remake_depfiles = depfiles
-am__depfiles_remade = ./$(DEPDIR)/t-001.Po
+am__depfiles_remade = ./$(DEPDIR)/t-001.Po ./$(DEPDIR)/t-002.Po \
+	./$(DEPDIR)/t-003.Po
 am__mv = mv -f
 COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
 	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
@@ -147,8 +156,8 @@ AM_V_CCLD = $(am__v_CCLD_@AM_V@)
 am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
 am__v_CCLD_0 = @echo "  CCLD    " $@;
 am__v_CCLD_1 = 
-SOURCES = $(t_001_SOURCES)
-DIST_SOURCES = $(t_001_SOURCES)
+SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES)
+DIST_SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES)
 am__can_run_installinfo = \
   case $$AM_UPDATE_INFO_DIR in \
     n|no|NO) false;; \
@@ -538,14 +547,25 @@ AM_CPPFLAGS = \
 
 LDADD = ../lib/libhak.la
 check_SCRIPTS = \
+	classof-01.hak \
+	cons-01.hak \
+	dic-01.hak \
 	feed-01.hak \
 	fun-01.hak \
+	hnd-01.hak \
+	hnd-02.hak \
+	hnd-03.hak \
 	insta-01.hak \
 	insta-02.hak \
 	prim-01.hak \
 	proc-01.hak \
+	proclib-01.hak \
 	ret-01.hak \
 	retvar-01.hak \
+	sig-01.hak \
+	sysproc-01.hak \
+	sysproc-02.hak \
+	tick-01.hak \
 	va-01.hak \
 	var-01.hak \
 	var-02.hak \
@@ -555,12 +575,16 @@ check_ERRORS = \
 	call-5001.err \
 	class-5001.err \
 	feed-5001.err \
+	hnd-5001.err \
 	mlist-5001.err \
+	sig-5001.err \
 	var-5001.err \
 	var-5002.err \
 	var-5004.err
 
 t_001_SOURCES = t-001.c tap.h
+t_002_SOURCES = t-002.c tap.h
+t_003_SOURCES = t-003.c tap.h
 EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
 TESTS = $(check_PROGRAMS) $(check_SCRIPTS) $(check_ERRORS)
 TEST_EXTENSIONS = .hak .err
@@ -611,6 +635,14 @@ t-001$(EXEEXT): $(t_001_OBJECTS) $(t_001_DEPENDENCIES) $(EXTRA_t_001_DEPENDENCIE
 	@rm -f t-001$(EXEEXT)
 	$(AM_V_CCLD)$(LINK) $(t_001_OBJECTS) $(t_001_LDADD) $(LIBS)
 
+t-002$(EXEEXT): $(t_002_OBJECTS) $(t_002_DEPENDENCIES) $(EXTRA_t_002_DEPENDENCIES) 
+	@rm -f t-002$(EXEEXT)
+	$(AM_V_CCLD)$(LINK) $(t_002_OBJECTS) $(t_002_LDADD) $(LIBS)
+
+t-003$(EXEEXT): $(t_003_OBJECTS) $(t_003_DEPENDENCIES) $(EXTRA_t_003_DEPENDENCIES) 
+	@rm -f t-003$(EXEEXT)
+	$(AM_V_CCLD)$(LINK) $(t_003_OBJECTS) $(t_003_LDADD) $(LIBS)
+
 mostlyclean-compile:
 	-rm -f *.$(OBJEXT)
 
@@ -618,6 +650,8 @@ distclean-compile:
 	-rm -f *.tab.c
 
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t-001.Po@am__quote@ # am--include-marker
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t-002.Po@am__quote@ # am--include-marker
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t-003.Po@am__quote@ # am--include-marker
 
 $(am__depfiles_remade):
 	@$(MKDIR_P) $(@D)
@@ -880,6 +914,20 @@ t-001.log: t-001$(EXEEXT)
 	--log-file $$b.log --trs-file $$b.trs \
 	$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
 	"$$tst" $(AM_TESTS_FD_REDIRECT)
+t-002.log: t-002$(EXEEXT)
+	@p='t-002$(EXEEXT)'; \
+	b='t-002'; \
+	$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
+	--log-file $$b.log --trs-file $$b.trs \
+	$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
+	"$$tst" $(AM_TESTS_FD_REDIRECT)
+t-003.log: t-003$(EXEEXT)
+	@p='t-003$(EXEEXT)'; \
+	b='t-003'; \
+	$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
+	--log-file $$b.log --trs-file $$b.trs \
+	$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
+	"$$tst" $(AM_TESTS_FD_REDIRECT)
 .hak.log:
 	@p='$<'; \
 	$(am__set_b); \
@@ -988,6 +1036,8 @@ clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
 
 distclean: distclean-am
 	-rm -f ./$(DEPDIR)/t-001.Po
+	-rm -f ./$(DEPDIR)/t-002.Po
+	-rm -f ./$(DEPDIR)/t-003.Po
 	-rm -f Makefile
 distclean-am: clean-am distclean-compile distclean-generic \
 	distclean-tags
@@ -1034,6 +1084,8 @@ installcheck-am:
 
 maintainer-clean: maintainer-clean-am
 	-rm -f ./$(DEPDIR)/t-001.Po
+	-rm -f ./$(DEPDIR)/t-002.Po
+	-rm -f ./$(DEPDIR)/t-003.Po
 	-rm -f Makefile
 maintainer-clean-am: distclean-am maintainer-clean-generic
 

t/classof-01.hak

@@ -0,0 +1,34 @@
+## core.classOf
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+## every kind of object has a class, including values encoded in the pointer
+chk (eqv? (core.classOf #[1 2]) Array) "an array's class is Array"
+chk (eqv? (core.classOf #b[1 2]) ByteArray) "a byte array's class is ByteArray"
+chk (eqv? (core.classOf "s") String) "a string's class is String"
+chk (eqv? (core.classOf #{}) Dictionary) "a dictionary's class is Dictionary"
+chk (eqv? (core.classOf #(1 2)) Cons) "a data list's class is Cons"
+chk (class? (core.classOf 42)) "a small integer has a class"
+chk (class? (core.classOf 'c')) "a character has a class"
+chk (class? (core.classOf nil)) "nil has a class"
+chk (class? (core.classOf true)) "true has a class"
+chk (class? (core.classOf (fun(x) { return x }))) "a block has a class"
+
+## a class is itself an object, so it has a class of its own. this is where
+## classOf and className differ: className answers the receiver's own name
+## when handed a class, classOf answers what the class is an instance of.
+chk (class? (core.classOf Array)) "a class has a class"
+## className answers a symbol, not a string, and for a class it answers that
+## class's own name - so an instance and its class agree
+chk (eqv? (core.className #[1 2]) (core.className Array)) "className of an instance matches its class"
+chk (not (eqv? (core.classOf Array) Array)) "a class is not an instance of itself"
+
+## the point of it: building something of the receiver's own kind
+fun newLike(x size) { return (core.basicNew (core.classOf x) size) }
+chk (eqv? (core.classOf (newLike #[1] 2)) Array) "an array can make an array"
+chk (eqv? (core.classOf (newLike "s" 2)) String) "a string can make a string"
+chk (eqv? (core.classOf (newLike #b[1] 2)) ByteArray) "a byte array can make a byte array"
+chk (= (core.basicSize (newLike #[1] 5)) 5) "the new one has the requested size"

t/cons-01.hak

@@ -0,0 +1,79 @@
+## core.car / core.cdr / core.cons
+##
+## A data list #(1 2 3) is a chain of Cons cells whose head and tail live in
+## named instance variables, so basicAt and primAt cannot reach them. These
+## three are what let the class library walk and build a list.
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+l := #(1 2 3)
+chk (eqv? (core.classOf l) Cons) "a data list is a chain of Cons cells"
+chk (= (core.car l) 1) "car answers the head"
+chk (eqv? (core.classOf (core.cdr l)) Cons) "cdr answers the tail"
+chk (= (core.car (core.cdr l)) 2) "cadr reaches the second element"
+chk (nil? (core.cdr (core.cdr (core.cdr l)))) "the tail of the last cell is nil"
+
+## walking
+n := 0
+sum := 0
+p := l
+while (not (nil? p)) {
+	n := (+ n 1)
+	sum := (+ sum (core.car p))
+	p := (core.cdr p)
+}
+chk (= n 3) "a list can be walked to its end"
+chk (= sum 6) "and every element visited"
+
+## building
+b := (core.cons 1 (core.cons 2 (core.cons 3 nil)))
+chk (eqv? (core.classOf b) Cons) "cons builds a cell"
+chk (= (core.car b) 1) "the built list starts where it should"
+chk (= (core.car (core.cdr (core.cdr b))) 3) "and ends where it should"
+chk (nil? (core.cdr (core.cdr (core.cdr b)))) "and is properly terminated"
+
+## an improper list is allowed - the tail need not be a list
+i := (core.cons 1 2)
+chk (= (core.cdr i) 2) "cons accepts a non-list tail"
+
+## select over a list, species preserved, built with cons alone
+fun l-reverse(l) {
+	| p out |
+	out := nil
+	p := l
+	while (not (nil? p)) {
+		out := (core.cons (core.car p) out)
+		p := (core.cdr p)
+	}
+	return out
+}
+fun l-select(l blk) {
+	| p out x |
+	out := nil
+	p := l
+	while (not (nil? p)) {
+		x := (core.car p)
+		if (blk x) { out := (core.cons x out) }
+		p := (core.cdr p)
+	}
+	return (l-reverse out)
+}
+v := #(1 2 3 4 5 6)
+r := (l-select v (fun(x) { return (= 0 (rem x 2)) }))
+chk (eqv? (core.classOf r) Cons) "select over a list answers a list"
+chk (= (core.car r) 2) "with the right first element"
+chk (= (core.car (core.cdr r)) 4) "and the right second"
+chk (= (core.car (core.cdr (core.cdr r))) 6) "and the right third"
+chk (nil? (core.cdr (core.cdr (core.cdr r)))) "and nothing more"
+chk (= (core.car v) 1) "the original list is untouched"
+
+## the type gate
+bad := 0
+try { core.car nil } catch (e) { bad := (+ bad 1) }
+try { core.cdr nil } catch (e) { bad := (+ bad 1) }
+try { core.car #[1 2] } catch (e) { bad := (+ bad 1) }
+try { core.cdr "s" } catch (e) { bad := (+ bad 1) }
+chk (= bad 4) "car and cdr refuse anything that is not a cons"

t/dic-01.hak

@@ -0,0 +1,133 @@
+## the dic module
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+d := #{}
+chk (dictionary? d) "#{} is a dictionary"
+chk (= (dic.size d) 0) "a new dictionary is empty"
+
+dic.put d "a" 1
+dic.put d "b" 2
+dic.put d "c" 3
+chk (= (dic.size d) 3) "dic.size counts the pairs"
+chk (= (dic.get d "b") 2) "dic.get finds a value"
+chk (error? (dic.get d "z")) "dic.get answers with an error for a missing key"
+chk (dic.has? d "b") "dic.has? is true for a present key"
+chk (not (dic.has? d "z")) "dic.has? is false for a missing key"
+
+## replacing a value must not grow the dictionary
+dic.put d "b" 22
+chk (= (dic.get d "b") 22) "dic.put replaces a value"
+chk (= (dic.size d) 3) "replacing does not change the size"
+
+## keys and values line up pair by pair, whatever order the buckets give
+ks := (dic.keys d)
+vs := (dic.values d)
+chk (array? ks) "dic.keys returns an array"
+chk (array? vs) "dic.values returns an array"
+chk (= (core.basicSize ks) 3) "dic.keys has one entry per pair"
+chk (= (core.basicSize vs) 3) "dic.values has one entry per pair"
+aligned := 0
+i := 0
+while (< i 3) {
+	if (= (dic.get d (core.basicAt ks i)) (core.basicAt vs i)) { aligned := (+ aligned 1) }
+	i := (+ i 1)
+}
+chk (= aligned 3) "dic.keys and dic.values are in the same order"
+
+chk (dic.delete d "b") "dic.delete reports a removal"
+chk (not (dic.delete d "b")) "dic.delete reports nothing to remove the second time"
+chk (= (dic.size d) 2) "dic.delete shrinks the dictionary"
+chk (not (dic.has? d "b")) "the deleted key is gone"
+chk (= (core.basicSize (dic.keys d)) 2) "dic.keys reflects the removal"
+
+## dic.make, for choosing a bucket size up front
+e := (dic.make 64)
+chk (dictionary? e) "dic.make returns a dictionary"
+chk (= (dic.size e) 0) "dic.make starts empty"
+dic.put e 1 "one"
+chk (eql? (dic.get e 1) "one") "a dic.make dictionary works"
+f := (dic.make)
+chk (dictionary? f) "dic.make takes no argument too"
+
+## non-string keys
+g := #{}
+dic.put g 7 "seven"
+dic.put g "7" "string seven"
+chk (eql? (dic.get g 7) "seven") "an integer key works"
+chk (eql? (dic.get g "7") "string seven") "and does not collide with the string of it"
+
+chk (= (dic.clear d) 2) "dic.clear reports how many went"
+chk (= (dic.size d) 0) "dic.clear empties the dictionary"
+chk (= (core.basicSize (dic.keys d)) 0) "dic.keys is empty afterwards"
+chk (= (dic.clear d) 0) "clearing an empty dictionary removes nothing"
+
+## survives collection while holding a sizeable dictionary
+h := #{}
+n := 200
+i := 0
+while (< i n) {
+	dic.put h i (* i 3)
+	i := (+ i 1)
+}
+gc
+bad := 0
+hk := (dic.keys h)
+hv := (dic.values h)
+i := 0
+while (< i n) {
+	if (not (= (core.basicAt hv i) (* (core.basicAt hk i) 3))) { bad := (+ bad 1) }
+	i := (+ i 1)
+}
+chk (= (dic.size h) n) "a 200 pair dictionary keeps its size across a collection"
+chk (= bad 0) "and every key still maps to its own value"
+
+## --- one array instead of two ---
+p2 := #{}
+dic.put p2 "x" 10
+dic.put p2 "y" 20
+ps := (dic.pairs p2)
+chk (array? ps) "dic.pairs returns an array"
+chk (= (core.basicSize ps) 2) "dic.pairs has one entry per pair"
+chk (eqv? (core.classOf (core.basicAt ps 0)) Cons) "each entry is an association"
+paired := 0
+i := 0
+while (< i 2) {
+	a := (core.basicAt ps i)
+	if (eqv? (dic.get p2 (core.car a)) (core.cdr a)) { paired := (+ paired 1) }
+	i := (+ i 1)
+}
+chk (= paired 2) "car and cdr of each association agree with dic.get"
+
+## --- traversal that allocates nothing ---
+chk (integer? (dic.bucketSize p2)) "dic.bucketSize answers how many slots to walk"
+chk (>= (dic.bucketSize p2) (dic.size p2)) "the bucket is at least as big as the population"
+n := (dic.bucketSize p2)
+found := 0
+i := 0
+while (< i n) {
+	a := (dic.pairAt p2 i)
+	if (not (nil? a)) {
+		if (eqv? (dic.get p2 (core.car a)) (core.cdr a)) { found := (+ found 1) }
+	}
+	i := (+ i 1)
+}
+chk (= found 2) "walking the slots visits every pair exactly once"
+
+## an empty slot answers nil rather than failing
+empties := 0
+i := 0
+while (< i n) {
+	if (nil? (dic.pairAt p2 i)) { empties := (+ empties 1) }
+	i := (+ i 1)
+}
+chk (= (+ empties 2) n) "every slot is either an association or nil"
+
+## out of range is an error, not a silent nil
+oob := 0
+try { dic.pairAt p2 n } catch (e) { oob := (+ oob 1) }
+try { dic.pairAt p2 -1 } catch (e) { oob := (+ oob 1) }
+chk (= oob 2) "dic.pairAt refuses a slot outside the bucket"

t/hnd-01.hak

@@ -0,0 +1,48 @@
+## system handle table: file open/read/write/close and the validation gate
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+path := "/tmp/hak-hnd-01.tmp"
+
+## --- write ---
+h := (sys.open path "w")
+chk (integer? h) "sys.open for write returns a handle id"
+
+buf := (core.basicNew ByteArray 5)
+core.basicAtPut buf 0 104
+core.basicAtPut buf 1 101
+core.basicAtPut buf 2 108
+core.basicAtPut buf 3 108
+core.basicAtPut buf 4 111
+chk (= (sys.write h buf) 5) "sys.write returns the byte count"
+sys.close h
+
+## --- read it back ---
+h := (sys.open path "r")
+rb := (core.basicNew ByteArray 16)
+n := (sys.read h rb)
+chk (= n 5) "sys.read returns the byte count"
+chk (= (core.basicAt rb 0) 104) "first byte round-tripped"
+chk (= (core.basicAt rb 4) 111) "last byte round-tripped"
+chk (= (sys.read h rb) 0) "sys.read at end of file returns 0"
+
+## --- offset and length ---
+sys.close h
+h := (sys.open path "r")
+zb := (core.basicNew ByteArray 16)
+chk (= (sys.read h zb 2 3) 3) "sys.read honours offset and length"
+chk (= (core.basicAt zb 0) 0) "bytes before the offset are untouched"
+chk (= (core.basicAt zb 2) 104) "data landed at the offset"
+sys.close h
+
+## --- close returns nil ---
+h := (sys.open path "r")
+chk (nil? (sys.close h)) "sys.close returns nil"
+
+## --- a fresh handle reuses the freed id ---
+h2 := (sys.open path "r")
+chk (integer? h2) "a handle id is handed out again after a close"
+sys.close h2

t/hnd-02.hak

@@ -0,0 +1,36 @@
+## sys.pipe and the non-blocking I/O contract
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+p := (sys.pipe)
+chk (array? p) "sys.pipe returns an array"
+r := (core.basicAt p 0)
+w := (core.basicAt p 1)
+chk (integer? r) "the read end is a handle id"
+chk (integer? w) "the write end is a handle id"
+chk (not (= r w)) "the two ends are distinct handles"
+
+buf := (core.basicNew ByteArray 16)
+
+## a pipe with nothing in it must report "would block" rather than stalling
+chk (= (sys.read r buf) -1) "reading an empty pipe returns -1 (would block)"
+
+wb := (core.basicNew ByteArray 3)
+core.basicAtPut wb 0 97
+core.basicAtPut wb 1 98
+core.basicAtPut wb 2 99
+chk (= (sys.write w wb) 3) "writing to the pipe returns the count"
+
+n := (sys.read r buf)
+chk (= n 3) "the data comes back"
+chk (= (core.basicAt buf 0) 97) "byte 0 correct"
+chk (= (core.basicAt buf 2) 99) "byte 2 correct"
+chk (= (sys.read r buf) -1) "the pipe is empty again"
+
+## closing the writer turns the next read into an end-of-file
+sys.close w
+chk (= (sys.read r buf) 0) "reading after the writer closed returns 0 (eof)"
+sys.close r

t/hnd-03.hak

@@ -0,0 +1,82 @@
+## the async I/O model: a coprocess blocked on a handle must not stall the VM.
+## the primitive never blocks - it returns -1 - and the wait happens on a
+## semaphore bound to the handle, so the scheduler keeps running everyone else.
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+iosem := (sem-new)
+tmo   := (sem-new)
+sg    := (semgr-new)
+semgr-add sg iosem
+semgr-add sg tmo
+fin   := (sem-new)
+
+## returns 1 when the handle became readable, 0 when the timeout won
+fun waitin(h secs) {
+	| s |
+	sem-signal tmo secs 0
+	sem-signal-on-input iosem h
+	s := (semgr-wait sg)
+	sem-unsignal iosem
+	sem-unsignal tmo
+	if (eqv? s tmo) { return 0 } \
+	else { return 1 }
+}
+
+## --- the timeout arm: nothing is ever written ---
+q := (sys.pipe)
+chk (= (waitin (core.basicAt q 0) 1) 0) "a semaphore group timeout fires when no data arrives"
+sys.close (core.basicAt q 0)
+sys.close (core.basicAt q 1)
+
+## --- the readable arm, with a coprocess proving the VM kept running ---
+p     := (sys.pipe)
+r     := (core.basicAt p 0)
+w     := (core.basicAt p 1)
+ticks := 0
+got   := -2
+
+fun reader() {
+	| buf n |
+	buf := (core.basicNew ByteArray 16)
+	while true {
+		n := (sys.read r buf)
+		if (>= n 0) {
+			got := n
+			sem-signal fin
+			return 0
+		}
+		if (= (waitin r 5) 0) {
+			got := -1
+			sem-signal fin
+			return 0
+		}
+	}
+}
+
+fun writer() {
+	| wb |
+	## yield a few times first: the reader is blocked on the semaphore by now,
+	## so these ticks only happen if the VM is still scheduling
+	while (< ticks 4) {
+		ticks := (+ ticks 1)
+		yield
+	}
+	wb := (core.basicNew ByteArray 2)
+	core.basicAtPut wb 0 120
+	core.basicAtPut wb 1 121
+	sys.write w wb
+}
+
+fork reader
+fork writer
+sem-wait fin
+
+chk (= ticks 4) "other coprocesses ran while the reader was blocked"
+chk (= got 2) "the reader woke and read the data"
+
+sys.close r
+sys.close w

t/hnd-5001.err

@@ -0,0 +1,61 @@
+## a raw file descriptor is not a system handle. this is the property that
+## stops hak code naming a descriptor it never opened - including hak's own
+## multiplexer, signal and io-thread descriptors, and anything the host
+## application that embeds hak holds open.
+s := (sem-new)
+sem-signal-on-input s 0 ##ERROR: system handle 0
+
+---
+
+s := (sem-new)
+sem-signal-on-input s 4 ##ERROR: system handle 4
+
+---
+
+## a handle id stops resolving once it is closed, so a stale id cannot reach
+## a descriptor that has since been recycled
+p := (sys.pipe)
+r := (core.basicAt p 0)
+sys.close r
+sys.read r (core.basicNew ByteArray 4) ##ERROR: system handle 0
+
+---
+
+## a regular file is never accepted by the multiplexer: epoll refuses one
+## outright, and poll() would report it permanently ready
+f := (sys.open "/proc/version" "r")
+s := (sem-new)
+sem-signal-on-input s f ##ERROR: not of an acceptable kind
+
+---
+
+## the type gate: a pipe handle is not a process handle
+p := (sys.pipe)
+sys.pwait (core.basicAt p 0) ##ERROR: not of an acceptable kind
+
+---
+
+## ...and a process handle is not a stream
+p := (sys.popen "true" "r")
+sys.read (core.basicAt p 0) (core.basicNew ByteArray 4) ##ERROR: not of an acceptable kind
+
+---
+
+## an exit handle is muxable but carries no bytes
+p := (sys.popen "true" "r")
+sys.read (core.basicAt p 4) (core.basicNew ByteArray 4) ##ERROR: not readable
+
+---
+
+## a missing file is reported, not guessed at
+sys.open "/nonexistent/definitely-not-here" "r" ##ERROR: open /nonexistent/definitely-not-here
+
+---
+
+## an unknown open mode is rejected
+sys.open "/tmp/hak-hnd-5001.tmp" "q" ##ERROR: open mode
+
+---
+
+## an unknown popen mode likewise
+sys.popen "true" "z" ##ERROR: popen mode

t/proclib-01.hak

@@ -0,0 +1,85 @@
+## the child supervision layer in src/proc.hak
+
+$include "../src/proc.hak"
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+## --- children are collected in completion order, whichever finishes first ---
+g := (ChildGroup:new)
+chk (= (g:count) 0) "a new group watches nothing"
+a := (g:spawn "sleep 3; exit 11" "r")
+b := (g:spawn "sleep 1; exit 22" "r")
+c := (g:spawn "sleep 2; exit 33" "r")
+chk (= (g:count) 3) "spawn adds to the group"
+chk (integer? (g:proc-of a)) "the record carries a process handle"
+chk (integer? (g:out-of a)) "...and the requested stream"
+chk (nil? (g:in-of a)) "...and nil for one not requested"
+
+ticks := 0
+fun ticker() {
+	while (< ticks 5) {
+		ticks := (+ ticks 1)
+		yield
+	}
+}
+fork ticker
+
+order := (core.basicNew Array 3)
+n := 0
+while (< n 3) {
+	kid := (g:wait 25)
+	if (nil? kid) {
+		printf "ERROR: g:wait timed out\n"
+		n := 3
+	} \
+	else {
+		core.basicAtPut order n (g:status kid)
+		g:close kid
+		n := (+ n 1)
+	}
+}
+
+chk (= (core.basicAt order 0) 22) "the first to finish was reported first"
+chk (= (core.basicAt order 1) 33) "then the second"
+chk (= (core.basicAt order 2) 11) "then the third"
+chk (= ticks 5) "coprocesses ran while the group waited"
+chk (= (g:count) 0) "close removes a child from the group"
+g:done
+
+## --- simultaneous exits ---
+## standard signals do not queue, so on the SIGCHLD path one signal can stand
+## for every one of these; the group must still account for all of them.
+g2 := (ChildGroup:new)
+i := 0
+while (< i 6) {
+	g2:spawn "sleep 1; exit 7" "r"
+	i := (+ i 1)
+}
+seen := 0
+bad := 0
+while (< seen 6) {
+	kid := (g2:wait 25)
+	if (nil? kid) {
+		printf "ERROR: timed out with children unaccounted for\n"
+		seen := 6
+		bad := 1
+	} \
+	else {
+		if (not (= (g2:status kid) 7)) { bad := 1 }
+		g2:close kid
+		seen := (+ seen 1)
+	}
+}
+chk (= bad 0) "six children exiting together were all collected"
+g2:done
+
+## --- a timeout is reported as nil, not as a hang ---
+g3 := (ChildGroup:new)
+g3:spawn "sleep 30" "r"
+chk (= (g3:count) 1) "the group is watching the long-running child"
+chk (nil? (g3:wait 1)) "g:wait returns nil when nothing finishes in time"
+g3:done
+chk (= (g3:count) 0) "g:done emptied a group that still held a running child"

t/sig-01.hak

@@ -0,0 +1,82 @@
+## operating system signal routing
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+## --- SIGPIPE must not be fatal ---
+## with the default disposition, writing to a pipe whose reader has gone kills
+## the process outright and no I/O primitive can ever report the condition.
+p := (sys.pipe)
+r := (core.basicAt p 0)
+w := (core.basicAt p 1)
+sys.close r
+raised := false
+try {
+	sys.write w (core.basicNew ByteArray 4)
+} catch (e) {
+	raised := true
+}
+chk raised "writing to a pipe with no reader raises instead of killing the VM"
+sys.close w
+## the VM is genuinely still usable afterwards, not merely still alive
+q := (sys.pipe)
+chk (= (sys.write (core.basicAt q 1) (core.basicNew ByteArray 2)) 2) "I/O still works after SIGPIPE"
+sys.close (core.basicAt q 0)
+sys.close (core.basicAt q 1)
+
+## --- catch and uncatch are idempotent ---
+chk (= (system-catch-sig 10) 10) "system-catch-sig returns the signal number"
+chk (= (system-catch-sig 10) 10) "catching an already caught signal is fine"
+chk (= (system-uncatch-sig 10) 10) "system-uncatch-sig returns the signal number"
+chk (= (system-uncatch-sig 10) 10) "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 17
+
+h     := (system-get-sigfd)
+s     := (sem-new)
+tmo   := (sem-new)
+sg    := (semgr-new)
+semgr-add sg s
+semgr-add sg tmo
+fin   := (sem-new)
+ticks := 0
+signo := -1
+
+pr   := (sys.popen "sleep 1; exit 4" "r")
+proc := (core.basicAt pr 0)
+
+fun waiter() {
+	| w |
+	sem-signal tmo 20 0
+	sem-signal-on-input s h
+	w := (semgr-wait sg)
+	sem-unsignal s
+	sem-unsignal tmo
+	if (eqv? w tmo) { signo := -2 } \
+	else { signo := (system-get-sig) }
+	sem-signal fin
+	return 0
+}
+
+fun ticker() {
+	## the waiter is parked on the signal descriptor by now
+	while (< ticks 4) {
+		ticks := (+ ticks 1)
+		yield
+	}
+}
+
+fork waiter
+fork ticker
+sem-wait fin
+
+chk (= ticks 4) "coprocesses ran while a coprocess waited on a signal"
+chk (= signo 17) "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 17

t/sig-5001.err

@@ -0,0 +1,41 @@
+## signals that cannot be caught
+system-catch-sig 9 ##ERROR: 9 not routable
+
+---
+
+system-catch-sig 19 ##ERROR: 19 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 11 ##ERROR: 11 not routable
+
+---
+
+system-catch-sig 7 ##ERROR: 7 not routable
+
+---
+
+system-catch-sig 8 ##ERROR: 8 not routable
+
+---
+
+system-catch-sig 4 ##ERROR: 4 not routable
+
+---
+
+## the timer signal hak itself uses to switch processes
+system-catch-sig 26 ##ERROR: 26 not routable
+
+---
+
+system-catch-sig 0 ##ERROR: 0 not routable
+
+---
+
+system-catch-sig 9999 ##ERROR: 9999 not routable
+
+---
+
+system-catch-sig "two" ##ERROR: number not a small integer

t/sysproc-01.hak

@@ -0,0 +1,100 @@
+## child processes: sys.popen / pwait / pkill / pclose over the handle table
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+iosem := (sem-new)
+tmo   := (sem-new)
+sg    := (semgr-new)
+semgr-add sg iosem
+semgr-add sg tmo
+
+fun waitin(h secs) {
+	| s |
+	sem-signal tmo secs 0
+	sem-signal-on-input iosem h
+	s := (semgr-wait sg)
+	sem-unsignal iosem
+	sem-unsignal tmo
+	if (eqv? s tmo) { return 0 } else { return 1 }
+}
+
+## read until data arrives, retrying on -1
+fun rd(h buf) {
+	| n |
+	while true {
+		n := (sys.read h buf)
+		if (>= n 0) { return n }
+		if (= (waitin h 5) 0) { return -1 }
+	}
+}
+
+## reap without blocking the VM, waiting on a short timer between looks
+fun reap(proc) {
+	| n k |
+	k := 0
+	while (< k 300) {
+		n := (sys.pwait proc)
+		if (not (= n 256)) { return n }
+		sem-signal tmo 0 20000000
+		semgr-wait sg
+		sem-unsignal tmo
+		k := (+ k 1)
+	}
+	return 256
+}
+
+buf := (core.basicNew ByteArray 64)
+
+## --- stdout and the exit status ---
+p := (sys.popen "printf abc; exit 3" "r")
+chk (array? p) "sys.popen returns a handle array"
+chk (integer? (core.basicAt p 0)) "slot 0 is the process handle"
+chk (nil? (core.basicAt p 1)) "stdin is nil when 'w' was not requested"
+chk (integer? (core.basicAt p 2)) "stdout is a handle when 'r' was requested"
+chk (nil? (core.basicAt p 3)) "stderr is nil when 'e' was not requested"
+chk (= (rd (core.basicAt p 2) buf) 3) "the child's stdout is readable"
+chk (= (reap (core.basicAt p 0)) 3) "the exit status comes through"
+sys.pclose (core.basicAt p 0)
+
+## --- bidirectional: write to stdin, read stdout ---
+p    := (sys.popen "tr a-z A-Z" "rw")
+inh  := (core.basicAt p 1)
+outh := (core.basicAt p 2)
+chk (integer? inh) "stdin is a handle when 'w' was requested"
+wb := (core.basicNew ByteArray 3)
+core.basicAtPut wb 0 120
+core.basicAtPut wb 1 121
+core.basicAtPut wb 2 122
+chk (= (sys.write inh wb) 3) "writing to the child's stdin works"
+## closing the child's stdin must really send eof, or tr never flushes
+sys.close inh
+chk (= (rd outh buf) 3) "the child answered after stdin was closed"
+chk (= (core.basicAt buf 0) 88) "the child transformed the data (x -> X)"
+sys.pclose (core.basicAt p 0)
+
+## --- stderr kept separate from stdout ---
+p := (sys.popen "printf OUT; printf ERRR 1>&2" "re")
+chk (= (rd (core.basicAt p 2) buf) 3) "stdout has its own stream"
+chk (= (rd (core.basicAt p 3) buf) 4) "stderr has its own stream"
+sys.pclose (core.basicAt p 0)
+
+## --- a signalled child reports 256 + signo ---
+p := (sys.popen "kill -TERM $$" "r")
+chk (= (reap (core.basicAt p 0)) 271) "a signalled child reports 256 + SIGTERM"
+sys.pclose (core.basicAt p 0)
+
+## --- sys.pkill ---
+p := (sys.popen "sleep 60" "r")
+chk (= (sys.pwait (core.basicAt p 0)) 256) "a running child reports 256"
+sys.pkill (core.basicAt p 0)
+chk (= (reap (core.basicAt p 0)) 265) "after pkill the child reports 256 + SIGKILL"
+sys.pclose (core.basicAt p 0)
+
+## --- pclose tears the whole group down ---
+p    := (sys.popen "sleep 60" "r")
+outh := (core.basicAt p 2)
+sys.pclose (core.basicAt p 0)
+chk true "pclose released the group"

t/sysproc-02.hak

@@ -0,0 +1,64 @@
+## the exit handle: waiting for a child to terminate with no polling at all.
+##
+## sys.popen's slot 4 is a handle that becomes readable when the child exits,
+## so it is waited on exactly like a pipe. Where the platform has no such
+## facility the slot is nil and this test reports that it was skipped.
+
+fun chk(ok msg) {
+	if ok { printf "OK: %s\n" msg } \
+	else { printf "ERROR: %s\n" msg }
+}
+
+iosem := (sem-new)
+tmo   := (sem-new)
+sg    := (semgr-new)
+semgr-add sg iosem
+semgr-add sg tmo
+fin   := (sem-new)
+
+p    := (sys.popen "sleep 1; exit 5" "r")
+proc := (core.basicAt p 0)
+xh   := (core.basicAt p 4)
+
+if (nil? xh) {
+	printf "OK: no exit handle on this platform - skipped\n"
+	sys.pclose proc
+} \
+else {
+	ticks := 0
+	status := -2
+
+	fun waiter() {
+		| s |
+		sem-signal tmo 20 0
+		sem-signal-on-input iosem xh
+		s := (semgr-wait sg)
+		sem-unsignal iosem
+		sem-unsignal tmo
+		if (eqv? s tmo) { status := -1 } \
+		else { status := (sys.pwait proc) }
+		sem-signal fin
+		return 0
+	}
+
+	fun ticker() {
+		## the waiter is parked on the exit handle by now; these ticks only
+		## happen if the VM went on scheduling instead of blocking
+		while (< ticks 4) {
+			ticks := (+ ticks 1)
+			yield
+		}
+	}
+
+	chk (integer? xh) "sys.popen hands back an exit handle"
+	fork waiter
+	fork ticker
+	sem-wait fin
+
+	chk (= ticks 4) "other coprocesses ran while the child was alive"
+	chk (= status 5) "the exit handle woke the waiter and the status was read"
+
+	## it belongs to the process handle, so pclose takes it away
+	sys.pclose proc
+	chk true "pclose released the exit handle with the group"
+}

t/t-002.c

@@ -0,0 +1,251 @@
+/* multiple hak instances in one process.
+ *
+ * lib/std.c keeps process-wide state that no single hak instance owns: the
+ * g_hak chain that links every live instance, and g_sig_state[] holding the
+ * signal dispositions saved before hak installed its own. An embedder may
+ * hold several instances at once, so that state is shared and is guarded by
+ * a global lock rather than by any per-instance one.
+ *
+ * Run with no arguments, as make check does, this covers the sequential case,
+ * which is deterministic and is what regressions are caught by. Pass a thread
+ * count for the concurrent stress mode:
+ *
+ *     ./t-002 8
+ *
+ * The stress mode is kept out of make check because its runtime scales with
+ * the thread count and it is timing dependent, so it is a poor gate even
+ * though it passes. Reach for it when touching chain(), unchain() or the
+ * signal handler bookkeeping. */
+
+#include <hak.h>
+#include "tap.h"
+
+#include <signal.h>
+#include <stdlib.h>
+
+#if !defined(__DOS__) && !defined(EMSCRIPTEN) && defined(HAVE_PTHREAD) && defined(HAVE_STRERROR_R)
+#	define USE_THREAD
+#	include <pthread.h>
+#endif
+
+#define NINST 4
+
+#if defined(HAVE_SIGACTION)
+static int disposition_of (int sig, void** handler)
+{
+	struct sigaction sa;
+	if (sigaction(sig, (struct sigaction*)0, &sa) <= -1) return -1;
+	*handler = (sa.sa_flags & SA_SIGINFO)? (void*)sa.sa_sigaction: (void*)sa.sa_handler;
+	return 0;
+}
+#else
+static int disposition_of (int sig, void** handler) { *handler = (void*)0; return -1; }
+#endif
+
+/* open NINST instances, then close them in an order that leaves the one being
+ * unchained with a live neighbour on each side, which the plain open-then-close
+ * pattern never produces. */
+static void interleaved (void)
+{
+	hak_t* inst[NINST];
+	int i;
+	static const int order[NINST] = { 1, 3, 0, 2 }; /* middles first */
+
+	for (i = 0; i < NINST; i++)
+	{
+		inst[i] = hak_openstd(0, HAK_NULL);
+		OK (inst[i] != HAK_NULL, "instantiation with siblings already open");
+	}
+
+	for (i = 0; i < NINST; i++)
+	{
+		if (inst[order[i]]) hak_close(inst[order[i]]);
+		inst[order[i]] = HAK_NULL;
+	}
+
+	/* the chain must still be usable once emptied out of order */
+	inst[0] = hak_openstd(0, HAK_NULL);
+	OK (inst[0] != HAK_NULL, "instantiation after out-of-order teardown");
+	if (inst[0]) hak_close(inst[0]);
+}
+
+/* a surviving instance must still work after its neighbours are gone */
+static void survivor (void)
+{
+	hak_t* keep;
+	hak_t* tmp;
+	int i, n;
+
+	keep = hak_openstd(0, HAK_NULL);
+	OK (keep != HAK_NULL, "instantiation of the survivor");
+	if (!keep) return;
+
+	for (i = 0; i < NINST; i++)
+	{
+		tmp = hak_openstd(0, HAK_NULL);
+		if (tmp) hak_close(tmp);
+	}
+
+	n = hak_ignite(keep, 0);
+	OK (n == 0, "survivor ignites after its neighbours are closed");
+	n = hak_addbuiltinprims(keep);
+	OK (n == 0, "survivor registers builtin primitives");
+
+	hak_close(keep);
+}
+
+#if defined(USE_THREAD)
+/* Concurrent open/close, hammering the global lock that guards g_hak and
+ * g_sig_state. Removing either GLOBAL_LOCK() in lib/std.c makes this fault
+ * within a couple of runs at eight threads. */
+#define ROUNDS 150
+static void* worker (void* arg)
+{
+	int i;
+	for (i = 0; i < ROUNDS; i++)
+	{
+		hak_t* h = hak_openstd(0, HAK_NULL);
+		if (h) hak_close(h);
+	}
+	return (void*)0;
+}
+
+static int stress (int nthr)
+{
+	pthread_t t[64];
+	int i;
+
+	if (nthr < 1) nthr = 1;
+	if (nthr > 64) nthr = 64;
+
+	for (i = 0; i < nthr; i++)
+	{
+		if (pthread_create(&t[i], (pthread_attr_t*)0, worker, (void*)0) != 0) break;
+	}
+	nthr = i;
+	for (i = 0; i < nthr; i++) pthread_join(t[i], (void**)0);
+
+	printf("# %d threads x %d instances completed\n", nthr, ROUNDS);
+	return 0;
+}
+#else
+static int stress (int nthr)
+{
+	printf("# built without thread support - stress mode unavailable\n");
+	return 0;
+}
+#endif
+
+/* Signal dispositions are process-wide, so the library must not touch them
+ * behind the host's back. Neutralising SIGPIPE is the application's call -
+ * bin/hak.c makes it - and a program that would rather die quietly on a broken
+ * pipe is entitled to that. Opening and closing an instance must therefore
+ * leave every disposition exactly as it found it. */
+static const int WATCHED[] = {
+#if defined(SIGPIPE)
+	SIGPIPE,
+#endif
+	SIGINT, SIGTERM
+};
+#define NWATCHED ((int)(sizeof(WATCHED) / sizeof(WATCHED[0])))
+
+static void host_signals_untouched (void)
+{
+	void* before[NWATCHED];
+	void* during[NWATCHED];
+	void* after[NWATCHED];
+	hak_t* h;
+	int i, probed = 0;
+
+	for (i = 0; i < NWATCHED; i++)
+	{
+		if (disposition_of(WATCHED[i], &before[i]) <= -1) return; /* no sigaction */
+		probed = 1;
+	}
+	if (!probed) return;
+
+	h = hak_openstd(0, HAK_NULL);
+	OK (h != HAK_NULL, "instantiation failure");
+	if (!h) return;
+
+	for (i = 0; i < NWATCHED; i++) disposition_of(WATCHED[i], &during[i]);
+	hak_close(h);
+	for (i = 0; i < NWATCHED; i++) disposition_of(WATCHED[i], &after[i]);
+
+	for (i = 0; i < NWATCHED; i++)
+	{
+		OK (during[i] == before[i], "an open instance leaves the host disposition alone");
+		OK (after[i] == before[i], "a closed instance leaves the host disposition alone");
+	}
+}
+
+/* hak_catch_termreq() is the sanctioned way to hand hak the termination
+ * signals, and hak_uncatch_termreq() must put the host's dispositions back
+ * exactly as it found them. Nothing in the tree calls either, so this is the
+ * only exercise they get - and the only coverage of the restore path in
+ * unset_signal_handler(). */
+static const int TERMREQ[] = {
+	SIGTERM,
+	SIGINT
+#if defined(SIGHUP)
+	, SIGHUP
+#endif
+};
+#define NTERMREQ ((int)(sizeof(TERMREQ) / sizeof(TERMREQ[0])))
+
+static void termreq_round_trips (void)
+{
+	void* before[NTERMREQ];
+	void* during[NTERMREQ];
+	void* after[NTERMREQ];
+	int i;
+
+	for (i = 0; i < NTERMREQ; i++)
+	{
+		if (disposition_of(TERMREQ[i], &before[i]) <= -1) return; /* no sigaction */
+	}
+
+#if defined(SIGPIPE)
+	/* SIGPIPE is deliberately NOT in the set above. It is not a termination
+	 * request - it is the opposite, a measure against being terminated - and
+	 * neutralising it is the application's call, not the library's, because
+	 * the disposition is process-wide. bin/hak.c makes that call for itself.
+	 * So termreq must leave it exactly alone. */
+	void* pipe_before;
+	void* pipe_during;
+	int pipe_probed = (disposition_of(SIGPIPE, &pipe_before) >= 0);
+#endif
+
+	hak_catch_termreq();
+	for (i = 0; i < NTERMREQ; i++) disposition_of(TERMREQ[i], &during[i]);
+#if defined(SIGPIPE)
+	if (pipe_probed) disposition_of(SIGPIPE, &pipe_during);
+#endif
+
+	hak_uncatch_termreq();
+	for (i = 0; i < NTERMREQ; i++) disposition_of(TERMREQ[i], &after[i]);
+
+	for (i = 0; i < NTERMREQ; i++)
+	{
+		OK (during[i] != before[i], "hak_catch_termreq installs a handler");
+		OK (after[i] == before[i], "hak_uncatch_termreq restores the original");
+	}
+#if defined(SIGPIPE)
+	if (pipe_probed) OK (pipe_during == pipe_before, "hak_catch_termreq leaves SIGPIPE to the application");
+#endif
+}
+
+int main (int argc, char* argv[])
+{
+	if (argc > 1) return stress(atoi(argv[1]));
+
+	no_plan();
+
+	host_signals_untouched();
+	termreq_round_trips();
+
+	interleaved();
+	survivor();
+
+	return exit_status();
+}

t/t-003.c

@@ -0,0 +1,64 @@
+/* hak_raisetick() and hak_rcvtick() - the per-instance tick counter pair.
+ *
+ * The tick is published as a counter rather than a flag so that the raiser and
+ * the scheduler never write the same field: hak_raisetick() only increments
+ * hak->tick, and the scheduler only writes hak->last_tick, copying the value
+ * it observed. A raise landing between the scheduler's test and its update is
+ * therefore still pending afterwards rather than being lost, and no atomic
+ * operation is needed to get that.
+ *
+ * This checks that contract directly on the fields, which is white-box but is
+ * the only way to reach hak_raisetick() - it has no script-level binding, and
+ * driving it through a running VM cannot isolate it from the global tick.
+ *
+ * What this does NOT cover is the scheduler acting on a pending tick.
+ * t/tick-01.hak covers that for the global half. */
+
+#include <hak.h>
+#include "tap.h"
+
+int main (int argc, char* argv[])
+{
+	hak_t* hak;
+
+	no_plan();
+
+	hak = hak_openstd(0, HAK_NULL);
+	OK (hak != HAK_NULL, "instantiation");
+	if (!hak) return exit_status();
+
+	/* enabling reception seeds the watermark, so an instance does not act on
+	 * ticks raised before it was listening */
+	hak_raisetick(hak);
+	hak_raisetick(hak);
+	hak_rcvtick(hak, 1);
+	OK (hak->last_tick == hak->tick, "enabling reception discards earlier ticks");
+
+	hak_raisetick(hak);
+	OK (hak->last_tick != hak->tick, "hak_raisetick leaves a tick pending");
+
+	/* a second raise while one is already pending must not cancel it - the
+	 * flag version could lose one here, the counter cannot */
+	hak_raisetick(hak);
+	OK (hak->last_tick != hak->tick, "a second raise keeps the tick pending");
+
+	/* the scheduler consumes a tick by copying, never by clearing */
+	hak->last_tick = hak->tick;
+	OK (hak->last_tick == hak->tick, "copying the observed value consumes it");
+
+	hak_raisetick(hak);
+	OK (hak->last_tick != hak->tick, "and a later raise is seen again");
+
+	/* disabling reception must not lose a pending tick either - rcv_tick
+	 * gates whether ticks are acted on, not whether they are recorded */
+	hak_rcvtick(hak, 0);
+	OK (hak->last_tick != hak->tick, "disabling reception leaves the tick recorded");
+	OK (hak->rcv_tick == 0, "reception is off");
+
+	hak_rcvtick(hak, 1);
+	OK (hak->last_tick == hak->tick, "re-enabling reception reseeds the watermark");
+	OK (hak->rcv_tick == 1, "reception is on");
+
+	hak_close(hak);
+	return exit_status();
+}

t/tick-01.hak

@@ -0,0 +1,45 @@
+## preemptive process switching driven by the global tick counter
+##
+## The ticker - a signal handler on POSIX, a thread on _WIN32/__OS2__, a timer
+## interrupt on __DOS__ - only increments a global counter. Each instance
+## notices the change itself in switch_process_if_needed() and switches to the
+## next runnable process. Nothing else can interrupt a process that does not
+## yield, so a process yielding the CPU without ever asking to is proof that
+## the whole path works: hak_start_ticker, hak_rcvtick, the counter, and the
+## comparison against last_tick.
+
+fun chk(ok msg) {
+	if ok {
+		printf "OK: %s\n" msg
+	} else { 
+		printf "ERROR: %s\n" msg
+	}
+}
+
+flag := 0
+fun setter() { flag := 1 }
+
+## setter is runnable from here on, but it cannot run while this process holds
+## the CPU - and this process never calls yield.
+p := (fork setter)
+
+i := 0
+while (< i 3000000) {
+	if (== flag 1) { break }
+	i := (+ i 1)
+}
+
+## Without preemption the loop runs to its bound with flag still 0. With the
+## bound at 3000000 that takes well under a second, so a broken tick path
+## fails quickly rather than hanging.
+chk (== flag 1) "a process that never yields is preempted so another can run"
+
+## Guards against this test going vacuous if fork() ever switches to the new
+## process immediately: then setter would have run before the loop started and
+## i would be ~0, proving nothing about preemption. One tick is 20ms, which is
+## a great many iterations.
+chk (> i 1000) "the switch came from the ticker, not from an eager fork"
+
+## The preempted process must be resumed, not abandoned - reaching here at all
+## means the scheduler came back to it.
+chk (< i 3000000) "the preempted process resumes and runs to completion"