diff --git a/lang/m2/libm2/LIST b/lang/m2/libm2/LIST index ab5e0fa17..5d8621cb0 100644 --- a/lang/m2/libm2/LIST +++ b/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 diff --git a/lang/m2/libm2/SYSTEM.c b/lang/m2/libm2/SYSTEM.c new file mode 100644 index 000000000..ae2a53ce7 --- /dev/null +++ b/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 + +#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". + */ +} diff --git a/lang/m2/libm2/head_m2.e b/lang/m2/libm2/head_m2.e index b49cf1799..d56cb62ab 100644 --- a/lang/m2/libm2/head_m2.e +++ b/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 - - loc STACKSIZE - ste StackSize + pro $m_a_i_n, 0 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 diff --git a/lang/m2/libm2/init.c b/lang/m2/libm2/init.c index be9069027..43b325092 100644 --- a/lang/m2/libm2/init.c +++ b/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; -char *CurrentProcess = 0, MainProcess = 0, StackBase = 0, MainLB = 0; +int argc = 0; +char *MainLB = 0; diff --git a/lang/m2/libm2/par_misc.e b/lang/m2/libm2/par_misc.e new file mode 100644 index 000000000..be5f1121d --- /dev/null +++ b/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