--- /dev/null
+/*
+ (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".
+ */
+}
--- /dev/null
+#
+;
+; (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
public / ack.git / commitdiff