Add: multi-core

Author: codybartfast

src/eceval.c

@@ -14,7 +14,6 @@
 
 #define AREA "ECEVAL"
 
-
 // ln 182
 static obj empty_arglist(void)
 {
@@ -46,8 +45,8 @@ static void timed_eval(obj start)
 
 static void save(obj dat, struct core *cr)
 {
-	savetmp = dat;
-	cr->stack = consgc(&savetmp, &cr->stack);
+	svtmp = dat;
+	cr->stack = consgc(&svtmp, &cr->stack);
 
 	if (is_err(cr->stack)) {
 		eprintf(AREA, "Halting - Reached Memory Limit");
@@ -68,8 +67,6 @@ static obj restore(struct core *cr)
 	}
 }
 
-// used for garbage collection
-
 static obj proc_name;
 static void set_proc_name(struct core *cr)
 {

src/register.c

@@ -7,137 +7,135 @@
 
 #define AREA "REGISTER"
 
-struct core core0;
-struct core *cr0 = &core0;
+static struct core cores[ncore];
 
-// tge       //  9
-obj anenv; // 10
-obj ambenv; // 11
-obj savetmp; // 12
+// global-env
+obj ambenv;
+obj anenv;
+obj svtmp;
 
-const int rootlen = 12;
+const int rootlen = nother + ncore;
 static obj rootlst;
 
+static void init(void)
+{
+	static bool initdone = false;
+	if (initdone)
+		return;
+
+	rootlst = emptylst;
+	int i, j;
+	for (i = 0; i < ncore; i++) {
+		obj reglst = emptylst;
+		for (j = 0; j < nreg; j++) {
+			reglst = cons(unspecified, reglst);
+		}
+		rootlst = cons(reglst, rootlst);
+	}
+	for (i = 0; i < nother; i++) {
+		rootlst = cons(unspecified, rootlst);
+	}
+	initdone = true;
+}
+
 obj getroot(void)
 {
-	int actlen;
+	int i;
 	obj lst = rootlst;
 
-	// intentionally not using rootlen here, change number manually after
-	// modifying body below.
-	if ((actlen = length_u(rootlst)) != 12) {
-		error_internal(
-			AREA,
-			"Bug! getroot() got list of unexpected length: %d ",
-			actlen);
-		exit(1);
-	}
-	// order must match setroot
-	set_car(lst, cr0->argl);
-	lst = cdr(lst);
-	set_car(lst, cr0->cont);
-	lst = cdr(lst);
-	set_car(lst, cr0->env);
-	lst = cdr(lst);
-	set_car(lst, cr0->expr);
-	lst = cdr(lst);
-	set_car(lst, cr0->proc);
-	lst = cdr(lst);
-	set_car(lst, cr0->stack);
-	lst = cdr(lst);
-	set_car(lst, cr0->unev);
-	lst = cdr(lst);
-	set_car(lst, cr0->val);
-	lst = cdr(lst);
 	set_car(lst, the_global_environment());
 	lst = cdr(lst);
+
+	set_car(lst, ambenv);
+	lst = cdr(lst);
+
 	set_car(lst, anenv);
 	lst = cdr(lst);
-	set_car(lst, ambenv);
+
+	set_car(lst, svtmp);
 	lst = cdr(lst);
-	set_car(lst, savetmp);
+
+	for (i = 0; i < ncore; i++, lst = cdr(lst)) {
+		struct core *cr = &cores[i];
+		obj reglst = car(lst);
+
+		set_car(reglst, cr->argl);
+		reglst = cdr(reglst);
+
+		set_car(reglst, cr->cont);
+		reglst = cdr(reglst);
+
+		set_car(reglst, cr->env);
+		reglst = cdr(reglst);
+
+		set_car(reglst, cr->expr);
+		reglst = cdr(reglst);
+
+		set_car(reglst, cr->proc);
+		reglst = cdr(reglst);
+
+		set_car(reglst, cr->stack);
+		reglst = cdr(reglst);
+
+		set_car(reglst, cr->unev);
+		reglst = cdr(reglst);
+
+		set_car(reglst, cr->val);
+		reglst = cdr(reglst);
+	}
 
 	return rootlst;
 }
 
-// used for garbage collection
-obj setroot(obj rlst)
+void setroot(obj rlst)
 {
-	int actlen;
+	int i;
 	obj lst = rootlst = rlst;
 
-	// intentionally not using rootlen here, change number manually after
-	// modifying body below.
-	if ((actlen = length_u(rootlst)) != 12) {
-		return error_internal(
-			AREA,
-			"Bug! setroot() got list of unexpected length: %d",
-			actlen);
-	}
-	// order must match getroot
-	cr0->argl = car(lst);
-	lst = cdr(lst);
-	cr0->cont = car(lst);
-	lst = cdr(lst);
-	cr0->env = car(lst);
-	lst = cdr(lst);
-	cr0->expr = car(lst);
-	lst = cdr(lst);
-	cr0->proc = car(lst);
-	lst = cdr(lst);
-	cr0->stack = car(lst);
-	lst = cdr(lst);
-	cr0->unev = car(lst);
-	lst = cdr(lst);
-	cr0->val = car(lst);
-	lst = cdr(lst);
 	set_global_environment(car(lst));
 	lst = cdr(lst);
+
+	ambenv = car(lst);
+	lst = cdr(lst);
+
 	anenv = car(lst);
 	lst = cdr(lst);
-	ambenv = car(lst);
+
+	svtmp = car(lst);
 	lst = cdr(lst);
-	savetmp = car(lst);
 
-	return unspecified;
-}
+	for (i = 0; i < ncore; i++, lst = cdr(lst)) {
+		struct core *cr = &cores[i];
+		obj reglst = car(lst);
 
-static bool initdone = false;
-static obj init(void)
-{
-	int actlen;
-
-	cr0->stack = emptylst;
-	// preallocate storage for gc root
-	rootlst = listn(12, //       <----- actual  length
-			unspecified, //  1
-			unspecified, //  2
-			unspecified, //  3
-			unspecified, //  4
-			unspecified, //  5
-			unspecified, //  6
-			unspecified, //  7
-			unspecified, //  8
-			unspecified, //  9
-			unspecified, // 10
-			unspecified, // 11
-			unspecified //  12
-	);
-	if ((actlen = length_u(rootlst)) != rootlen) {
-		error_internal(
-			AREA,
-			"Bug! init, root wrong length. is: %d, expected %d",
-			actlen, rootlen);
-		exit(1);
+		cr->argl = car(reglst);
+		reglst = cdr(reglst);
+
+		cr->cont = car(reglst);
+		reglst = cdr(reglst);
+
+		cr->env = car(reglst);
+		reglst = cdr(reglst);
+
+		cr->expr = car(reglst);
+		reglst = cdr(reglst);
+
+		cr->proc = car(reglst);
+		reglst = cdr(reglst);
+
+		cr->stack = car(reglst);
+		reglst = cdr(reglst);
+
+		cr->unev = car(reglst);
+		reglst = cdr(reglst);
+
+		cr->val = car(reglst);
+		reglst = cdr(reglst);
 	}
-	initdone = true;
-	return unspecified;
 }
 
 struct core *dfltcore(void)
 {
-	if (!initdone) {
-		init();
-	}
-	return cr0;
+	init();
+	return &cores[0];
 }

src/register.h

@@ -5,22 +5,26 @@
 #include "obj.h"
 
 struct core {
-	obj argl;
-	obj cont;
-	obj env;
-	obj expr;
-	obj proc;
-	obj stack;
-	obj unev;
-	obj val;
+	obj argl; //  1
+	obj cont; //  2
+	obj env; //   3
+	obj expr; //  4
+	obj proc; //  5
+	obj stack; // 6
+	obj unev; //  7
+	obj val; //   8
 };
+#define nreg 8
+#define ncore 16
 
-struct core *dfltcore(void);
-
-extern obj anenv;
-extern obj ambenv;
-extern obj savetmp;
+// global-env      // 1
+extern obj ambenv; // 2
+extern obj anenv; //  3
+extern obj svtmp; //  4
+#define nother 4
 
+struct core *dfltcore(void);
 obj getroot(void);
-obj setroot(obj);
-#endif
+void setroot(obj);
+
+#endif