added process termination primitives

hcl/lib/exec.c

@@ -3993,6 +3993,12 @@ void hcl_abort (hcl_t* hcl)
 
 /* ------------------------------------------------------------------ */
 
+hcl_pfrc_t hcl_pf_process_current (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	HCL_STACK_SETRET (hcl, nargs, (hcl_oop_t)hcl->processor->active);
+	return HCL_PF_SUCCESS;
+}
+
 hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 {
 	hcl_oop_block_t blk;
@@ -4052,12 +4058,6 @@ hcl_pfrc_t hcl_pf_process_resume (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 	return  HCL_PF_SUCCESS;
 }
 
-hcl_pfrc_t hcl_pf_process_yield (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
-{
-	yield_process (hcl, hcl->processor->active);
-	return  HCL_PF_SUCCESS;
-}
-
 hcl_pfrc_t hcl_pf_process_suspend (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 {
 	hcl_oop_process_t prc;
@@ -4080,6 +4080,40 @@ hcl_pfrc_t hcl_pf_process_suspend (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 	return  HCL_PF_SUCCESS;
 }
 
+hcl_pfrc_t hcl_pf_process_terminate (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	hcl_oop_process_t prc;
+
+	if (nargs >= 1)
+	{
+		prc = (hcl_oop_process_t)HCL_STACK_GETARG(hcl, nargs, 0);
+		if (!HCL_IS_PROCESS(hcl, prc))
+		{
+			hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not process - %O", prc);
+			return HCL_PF_FAILURE;
+		}
+	}
+	else
+	{
+		prc = hcl->processor->active;
+	}
+
+	terminate_process (hcl, prc);
+	return  HCL_PF_SUCCESS;
+}
+
+hcl_pfrc_t hcl_pf_process_terminate_all (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	terminate_all_processes (hcl);
+	return  HCL_PF_SUCCESS;
+}
+
+hcl_pfrc_t hcl_pf_process_yield (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	yield_process (hcl, hcl->processor->active);
+	return  HCL_PF_SUCCESS;
+}
+
 /* ------------------------------------------------------------------ */
 hcl_pfrc_t hcl_pf_semaphore_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 {

hcl/lib/hcl-prv.h

@@ -1443,9 +1443,12 @@ hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons);
 /* ========================================================================= */
 /* exec.c                                                                    */
 /* ========================================================================= */
+hcl_pfrc_t hcl_pf_process_current (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
 hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
 hcl_pfrc_t hcl_pf_process_resume (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
 hcl_pfrc_t hcl_pf_process_suspend (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
+hcl_pfrc_t hcl_pf_process_terminate (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
+hcl_pfrc_t hcl_pf_process_terminate_all (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
 hcl_pfrc_t hcl_pf_process_yield (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
 
 hcl_pfrc_t hcl_pf_semaphore_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);

hcl/lib/prim.c

@@ -839,9 +839,12 @@ static pf_t builtin_prims[] =
 	{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mquo,     4,  { 'm','d','i','v' } },
 	{ 2, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mod,      3,  { 'm','o','d' } },
 
+	{ 0, 0,                       hcl_pf_process_current,   15, { 'c','u','r','r','e','n','t','-','p','r','o','c','e','s','s'} },
 	{ 1, HCL_TYPE_MAX(hcl_oow_t), hcl_pf_process_fork,      4,  { 'f','o','r','k'} },
 	{ 1, 1,                       hcl_pf_process_resume,    6,  { 'r','e','s','u','m','e' } },
 	{ 0, 1,                       hcl_pf_process_suspend,   7,  { 's','u','s','p','e','n','d' } },
+	{ 0, 1,                       hcl_pf_process_terminate, 9,  { 't','e','r','m','i','n','a','t','e' } },
+	{ 0, 0,                       hcl_pf_process_terminate_all, 13,  { 't','e','r','m','i','n','a','t','e','-','a','l','l' } },
 	{ 0, 0,                       hcl_pf_process_yield,     5,  { 'y','i','e','l','d'} },