New coroutine mechanism incorporated

lang/m2/libm2/LIST

@@ -28,7 +28,8 @@ absf.e
 absi.c
 absl.c
 halt.c
-transfer.e
+SYSTEM.c
+par_misc.e
 init.c
 sigtrp.c
 store.c

lang/m2/libm2/SYSTEM.c

@@ -0,0 +1,118 @@
+/*
+  (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
+  See the copyright notice in the ACK home directory, in the file "Copyright".
+*/
+
+/*
+  Module:	SYSTEM
+  Author:	Ceriel J.H. Jacobs
+  Version:	$Header$
+*/
+
+/*
+	An implementation of the Modula-2 NEWPROCESS and TRANSFER facilities
+	using the topsize, topsave, and topload facilities.
+	For each coroutine, a proc structure is built. For the main routine,
+	a static space is declared to save its stack. For the other coroutines,
+	the user specifies this space.
+*/
+
+#include <m2_traps.h>
+
+#if EM_WSIZE == EM_PSIZE
+#define ptrsiz unsigned
+#else
+#define ptrsiz unsigned long
+#endif
+
+#define MAXMAIN	2048
+
+struct proc {
+	ptrsiz size;		/* size of saved stackframe(s) */
+	int (*proc)();		/* address of coroutine procedure */
+	char *brk;		/* stack break of this coroutine */
+};
+
+static struct proc mainproc[MAXMAIN/sizeof(struct proc) + 1];
+
+static struct proc *curproc = 0;/* current coroutine */
+extern char *MainLB;		/* stack break of main routine */
+
+_SYSTEM__NEWPROCESS(p, a, n, p1)
+	int (*p)();		/* coroutine procedure */
+	struct proc *a;		/* pointer to area for saved stack-frame */
+	unsigned n;		/* size of this area */
+	struct proc **p1;	/* where to leave coroutine descriptor,
+				   in this implementation the address of
+				   the area for saved stack-frame(s) */
+{
+	/*	This procedure creates a new coroutine, but does not
+		transfer control to it. The routine "topsize" will compute the
+		stack break, which will be the local base of this routine.
+		Notice that we can do this because we do not need the stack
+		above this point for this coroutine. In Modula-2, coroutines
+		must be level 0 procedures without parameters.
+	*/
+	char *brk = 0;
+	ptrsiz sz = topsize(&brk);
+
+	if (sz + sizeof(struct proc) > n) {
+		/* not enough space */
+		TRP(M2_TOOLARGE);
+	}
+	a->size = n;
+	a->proc = p;
+	a->brk = brk;
+	*p1 = a;
+	if (topsave(brk, a+1))
+		/* stack frame saved; now just return */
+		;
+	else {
+		/* We get here through the first transfer to the coroutine
+		   created above.
+		   This also means that curproc is now set to this coroutine.
+		   We cannot trust the parameters anymore.
+		   Just call the coroutine procedure.
+		*/
+		(*(curproc->proc))();
+		_exit(0);
+	}
+}
+
+_SYSTEM__TRANSFER(a, b)
+	struct proc **a, **b;
+{
+	/*	transfer from one coroutine to another, saving the current
+		descriptor in the space indicated by "a", and transfering to
+		the coroutine in descriptor "b".
+	*/
+	ptrsiz size;
+
+	if (! curproc) {
+		/* the current coroutine is the main process;
+		   initialize a coroutine descriptor for it ...
+		*/
+		mainproc[0].brk = MainLB;
+		mainproc[0].size = sizeof(mainproc);
+		curproc = &mainproc[0];
+	}
+	*a = curproc;		/* save current descriptor in "a" */
+	if (*b == curproc) {
+		/* transfer to itself is a no-op */
+		return;
+	}
+	size = topsize(&(curproc->brk));
+	if (size + sizeof(struct proc) > curproc->size) {
+		TRP(M2_TOOLARGE);
+	}
+	if (topsave(curproc->brk, curproc+1)) {
+		/* stack top saved. Now restore context of target
+		   coroutine
+		*/
+		curproc = *b;
+		topload(curproc+1);
+		/* we never get here ... */
+	}
+	/* but we do get here, when a transfer is done to the coroutine in "a".
+	*/
+}

lang/m2/libm2/head_m2.e

@@ -11,47 +11,22 @@
 
  mes 2,EM_WSIZE,EM_PSIZE
 
-#define STACKSIZE	2048	/* maximum stack size for a coroutine */
-
  exa handler
  exa environ
  exa argv
  exa argc
- exa CurrentProcess
- exa MainProcess
- exa StackBase
  exa MainLB
- exa StackSize
  exp $catch
  exp $init
  inp $trap_handler
 
-mainroutine
- bss 2*EM_PSIZE,0,0
-
  exp $m_a_i_n
- pro $m_a_i_n, STACKSIZE
+ pro $m_a_i_n, 0
-
- loc STACKSIZE
- ste StackSize
 
  lor 0
  lae MainLB
  sti EM_PSIZE
 
- lal -EM_WSIZE
- adp EM_WSIZE
- lae StackBase
- sti EM_PSIZE
-
- lae mainroutine
- adp 2*EM_PSIZE
- dup EM_PSIZE
- lae CurrentProcess
- sti EM_PSIZE
- lae MainProcess
- sti EM_PSIZE
-
  lal EM_WSIZE+EM_PSIZE
  loi EM_PSIZE
  lae environ		; save environment pointer

lang/m2/libm2/init.c

@@ -56,5 +56,5 @@ extern int catch();
 
 int (*handler)() = catch;
 char **argv = 0, **environ = 0;
-int argc = 0, StackSize = 0;
+int argc = 0;
-char *CurrentProcess = 0, MainProcess = 0, StackBase = 0, MainLB = 0;
+char *MainLB = 0;

lang/m2/libm2/par_misc.e

@@ -0,0 +1,131 @@
+#
+;
+; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
+; See the copyright notice in the ACK home directory, in the file "Copyright".
+;
+
+;
+; Module:	coroutine primitives
+; Author:	Kees Bot, Edwin Scheffer, Ceriel Jacobs
+; Version:	$Header$
+;
+
+ mes 2,EM_WSIZE,EM_PSIZE
+
+ ; topsize takes care of two things:
+ ; - given a stack-break,
+ ;   it computes the size of the chunk of memory needed to save the stack;
+ ; - also, if this stack-break = 0, it creates one, assuming that caller is
+ ;   the stack-break.
+ ;
+ ; This implementation assumes a continuous stack growing downwards
+
+ exp $topsize
+ pro $topsize, 2*EM_WSIZE+4*EM_PSIZE
+ ; local space for line-number, ignoremask, filename, stack-break, size,
+ ; and stack-pointer (see the topsave routine)
+ mes 11
+ lal 0
+ loi EM_PSIZE
+ loi EM_PSIZE		; stack-break or 0
+ zer EM_PSIZE
+ cmp
+ zne *1
+ lxl 0
+ dch			; local base of caller
+ lal 0
+ loi EM_PSIZE
+ sti EM_PSIZE
+1
+ lal 0
+ loi EM_PSIZE
+ loi EM_PSIZE
+ lpb			; convert this local base to an argument base.
+			; An implementation of a sort of "topsize" EM
+			; instruction should take a local base, and save
+			; the whole frame.
+
+ lor 1			; stack-break  SP
+ sbs EM_PSIZE		; stack-break-SP
+ ret EM_PSIZE		; return size of block to be saved
+ end 2*EM_WSIZE+4*EM_PSIZE
+
+ exp $topsave
+ pro $topsave, 0
+ mes 11
+ loe 0
+ lae 4			; load line number and file name
+ loi EM_PSIZE
+ lim			; ignore mask
+ lor 0			; LB
+ lal 0
+ loi EM_PSIZE		; stack-break
+ lpb
+ lor 1
+ sbs EM_PSIZE
+ loc EM_PSIZE
+ adu EM_PSIZE		; gives size
+ dup EM_PSIZE
+ lal 0
+ sti EM_PSIZE		; save size
+ lor 1			; SP (the SP BEFORE pushing)
+ lor 1			; SP (address of stack top to save)
+ lal EM_PSIZE		; area
+ loi EM_PSIZE
+ lal 0			; size
+ loi EM_PSIZE
+ bls EM_PSIZE		; move whole block
+ asp 4*EM_PSIZE+2*EM_WSIZE	; remove the lot from the stack
+ loc 1
+ ret EM_WSIZE			; return 1
+ end 0
+
+sv
+ bss EM_PSIZE,0,0
+
+ exp $topload
+ pro $topload, 0
+
+ lal 0
+ loi EM_PSIZE
+ lae sv
+ sti EM_PSIZE		; saved parameter
+
+ lxl 0
+2
+ dup EM_PSIZE
+ lal 0
+ loi EM_PSIZE		; compare target SP with current LB to see if we must
+ loi EM_PSIZE
+ cmp			; find another LB first
+ zgt *1
+ dch			; just follow dinamic chain to make sure we find
+			; a legal one
+ bra *2
+1
+ str 0
+
+ lae sv
+ loi EM_PSIZE
+ loi EM_PSIZE		; load indirect to
+ str 1			; restore SP
+ asp -EM_PSIZE		; to stop int from complaining about non-existent memory
+ lae sv
+ loi EM_PSIZE		; source address
+ lor 1
+ adp EM_PSIZE		; destimation address
+ lae sv
+ loi EM_PSIZE
+ adp EM_PSIZE
+ loi EM_PSIZE		; size of block
+ bls EM_PSIZE		; move block back (SP becomes the SP AFTER again, 
+			; because of the asp -EM_PSIZE!)
+ asp 2*EM_PSIZE		; drop size + SP
+ str 0			; restore local base
+ sim			; ignore mask
+ lae 4
+ sti EM_PSIZE
+ ste 0			; line and file
+ loc 0
+ ret EM_WSIZE		; return 0
+ end 0