Initial revision

lang/occam/lib/AR2

@@ -0,0 +1,11 @@
+#!/bin/sh
+case $# in
+	0)	ar ru /user0/bot/lib/lib2.a *.o
+		ranlib /user0/bot/lib/lib2.a
+		rm -f *.o
+	;;
+	*)	keys=$1
+		shift
+		ar $keys /user0/bot/lib/lib2.a $*
+	;;
+esac

lang/occam/lib/AR4

@@ -0,0 +1,11 @@
+#!/bin/sh
+case $# in
+	0)	ar ru /user0/bot/lib/lib4.a *.o
+		ranlib /user0/bot/lib/lib4.a
+		rm -f *.o
+	;;
+	*)	keys=$1
+		shift
+		ar $keys /user0/bot/lib/lib4.a $*
+	;;
+esac

lang/occam/lib/Makefile

@@ -0,0 +1,28 @@
+PRIMITIVES=	par_vax.s
+PARALLEL=	parco.c par.c co.c
+OCRT=		ocrt.c builtin.c channel.c chan_struct.c
+
+COMMON=		$(PRIMITIVES) $(PARALLEL) $(OCRT)
+
+SIZE2=	em2.e
+SIZE4=	em4.e
+
+LIB2=	/user0/bot/lib/lib2.a
+LIB4=	/user0/bot/lib/lib4.a
+
+ACK2=	vax2
+ACK4=	vax4
+
+all:	lib2 lib4
+
+lib2:	$(COMMON) $(SIZE2)
+	rm -f *.o $(LIB2)
+	$(ACK2) -c.o -L -Dvoid=char -Dptrdiff=long $(COMMON) $(SIZE2)
+	ar cq $(LIB2) *.o
+	rm -f *.o
+
+lib4:	$(COMMON) $(SIZE4)
+	rm -f *.o $(LIB4)
+	$(ACK4) -c.o -L -Dvoid=char $(COMMON) $(SIZE4)
+	ar cq $(LIB4) *.o
+	rm -f *.o

lang/occam/lib/builtin.c

@@ -0,0 +1,75 @@
+/*	builtin.c - built in named processes */
+#include "channel.h"
+#ifndef nil
+#define nil 0
+#endif
+
+extern int errno;
+
+static void nullterm(s) register char *s;
+/* Change Occam string to C string */
+{
+	register len= (*s & 0377);
+	register char *p;
+
+	while (--len>=0) {
+		p=s++;
+		*p = *s;
+	}
+	*s=0;
+}
+
+static void lenterm(s) register char *s;
+/* Change C string to Occam string */
+{
+	register i=0;
+	register c0, c1;
+
+	c0=0;
+	do {
+		c1=s[i];
+		s[i++]=c0;
+		c0=c1;
+	} while (c0!=0);
+	*s= i-1;
+}
+
+void b_open(mode, name, index) register char *mode, *name; long *index;
+/* PROC open(VAR index, VALUE name[], mode[])=	*/
+{
+	register FILE *fp;
+	register i;
+
+	nullterm(name);
+	nullterm(mode);
+
+	fp=fopen(name, mode);
+
+	lenterm(name);
+	lenterm(mode);
+
+	if (fp==nil)
+		*index= -errno;
+	else {
+		/* Find free file channel, there must be one free! */
+
+		for (i=0; (file[i].f.flgs&C_F_INUSE)!=0; i++) ;
+
+		file[i].f.flgs|=C_F_INUSE;
+		unix_file[i]=fp;
+		*index=i;
+	}
+}
+
+void b_close(index) long index;
+/* PROC close(VALUE index)=	*/
+{
+	fclose(unix_file[index]);
+	file[index].f.flgs&= ~C_F_INUSE;
+}
+
+void b_exit(code) long code;
+/* PROC exit(VALUE code)=	*/
+{
+	exit((int) code);
+}

lang/occam/lib/channel.c

@@ -0,0 +1,152 @@
+/*	channel.c - basic channel handling routines */
+#include <errno.h>
+#include <signal.h>
+#include <sgtty.h>
+#include "channel.h"
+
+static void disaster();
+
+void c_init(c, z) register chan *c; register unsigned z;
+/* Initialise an array of interprocess channels declared as: CHAN c[z]. */
+{
+	do {
+		c->type=C_T_CHAN;
+		(c++)->c.synch=C_S_FREE;
+	} while (--z!=0);
+}
+
+void chan_in(v, c) long *v; register chan *c;
+/* Reads a value from channel c and returns it through v. */
+{
+	switch(c->type) {
+	case C_T_FILE:
+		if ((c->f.flgs&C_F_READAHEAD)!=0) {
+			*v=(c->f.preread&0377);
+			c->f.flgs&= ~C_F_READAHEAD;
+		} else {
+			register FILE *fp= unix_file[c->f.index];
+
+			*v= feof(fp) ? C_F_EOF : getc(fp);
+		}
+		break;
+	case C_T_CHAN:
+		deadlock=0;		/* Wait for value to arrive */
+		while (c->c.synch!=C_S_ANY) resumenext();
+
+		*v=c->c.val;
+		c->c.synch=C_S_ACK;	/* Acknowledge receipt */
+		break;
+	default:
+		disaster();
+	}
+}
+
+void chan_out(v, c) long v; register chan *c;
+/* Send value v through channel c. */
+{
+	switch(c->type) {
+	case C_T_FILE: {
+		register FILE *fp= unix_file[c->f.index];
+		struct sgttyb tty;
+
+		if ((v& ~0xff)==0)	/* Plain character */
+			putc( (int) v, fp);
+		else
+		if (v==C_F_TEXT) {
+			ioctl(fileno(fp), TIOCGETP, &tty);
+			tty.sg_flags&= ~CBREAK;
+			tty.sg_flags|= ECHO|CRMOD;
+			ioctl(fileno(fp), TIOCSETN, &tty);
+		} else
+		if (v==C_F_RAW) {
+			ioctl(fileno(fp), TIOCGETP, &tty);
+			tty.sg_flags|= CBREAK;
+			tty.sg_flags&= ~(ECHO|CRMOD);
+			ioctl(fileno(fp), TIOCSETN, &tty);
+		}
+	}	break;
+	case C_T_CHAN:
+		deadlock=0;		/* Wait until channel is free */
+		while (c->c.synch!=C_S_FREE) resumenext();
+
+		c->c.val=v;
+		c->c.synch=C_S_ANY;	/* Channel has data */
+
+		deadlock=0;		/* Wait for acknowledgement */
+		while (c->c.synch!=C_S_ACK) resumenext();
+
+		c->c.synch=C_S_FREE;	/* Back to normal */
+		break;
+	default:
+		disaster();
+	}
+}
+
+static int timeout();
+
+int chan_any(c) register chan *c;
+{
+	switch (c->type) {
+	case C_T_FILE:
+		if ((c->f.flgs&C_F_READAHEAD)!=0)
+			return 1;
+		else {
+			register FILE *fp= unix_file[c->f.index];
+			
+			if (feof(fp))
+				return 1;
+			else {
+				extern int errno;
+				register ch;
+
+				deadlock=0;
+					/* No deadlock while waiting for key */
+
+				signal(SIGALRM, timeout);
+				alarm(1);
+
+				errno=0;
+				ch=getc(fp);
+
+				signal(SIGALRM, SIG_IGN);
+				alarm(0);
+
+				if (errno==EINTR)
+					return 0;
+				else {
+					if (!feof(fp)) {
+						c->f.flgs|=C_F_READAHEAD;
+						c->f.preread=ch;
+					}
+					return 1;
+				}
+			}
+		}
+	case C_T_CHAN:
+		return c->c.synch==C_S_ANY;
+	default:
+		disaster();
+	}
+}
+
+/* The ch=getc(fp) in the above function calls read(2) to do its task, but if
+ * there's no input on the file (pipe or terminal) then the read will block.
+ * To stop this read from blocking, we use the fact that if the read is
+ * interrupted by a signal that is caught by the program, then the read returns
+ * error EINTR after the signal is processed. Thus we use a one second alarm
+ * to interrupt the read with a trap to timeout(). But since the alarm signal
+ * may occur *before* the read is called, it is continuously restarted in
+ * timeout() to prevent it from getting lost.
+ */
+
+static int timeout(sig)
+{
+	signal(SIGALRM, timeout);
+	alarm(1);
+}
+
+static void disaster()
+{
+	write(2, "Fatal error: Channel variable corrupted\n", 40);
+	abort();
+}

lang/occam/lib/co.c

@@ -0,0 +1,115 @@
+/*	co.c - Routines to handle coroutines */
+#include "process.h"
+
+static void search(), RESUMERR();
+
+void resume(id) identification id;
+/* Stops the current process, by saving its stack, and searches for the
+ * process with identification 'id' in the group the running process
+ * belongs to. If 'id' cannot be found then repeat these actions with
+ * the running process' parent. If 'id' is found it is activated. It
+ * is a fatal error if 'id' cannot be found.
+ */
+{
+	if (group!=nil) {
+		register wordsize size;
+
+		size=top_size(group->s_brk);
+		(*group->active)->stack=alloc((unsigned) size);
+
+		if (top_save(size, (*group->active)->stack))
+			search(id);
+		else {
+			free((*group->active)->stack);
+			load_betweens();
+		}
+	} else
+		RESUMERR();
+}
+
+static void search(id) identification id;
+/* Searches for the process with identification 'id'.
+ * If the process is found it is activated and its process tree is
+ * traversed to find the running process.
+ */
+{
+	register struct process **aproc, *proc;
+
+	for(;;) {
+		aproc= &group->first;
+
+		while (*aproc!=nil && (*aproc)->id!=id)
+			aproc= &(*aproc)->next;
+
+		if (*aproc!=nil) break;
+
+		save_between(group);
+
+		if ((group=group->up)==nil)
+			RESUMERR();
+	}
+	group->active=aproc;
+	proc= *aproc;
+	highest_group=group;
+
+	while (proc->down!=nil) {
+		group=proc->down;
+		proc= *group->active;
+	}
+	top_load(proc->stack);
+}
+
+static void delete_group(group) struct procgroup *group;
+/* Removes the whole group and sub-groups recursively from the running
+ * process.
+ */
+{
+	register struct process *proc, *next;
+
+	proc=group->first;
+
+	while (proc!=nil) {
+		if (proc->down!=nil)
+			delete_group(proc->down);
+		else
+			free(proc->stack);
+		next=proc->next;
+		free( (void *) proc);
+		proc=next;
+	}
+	delete_between(group);
+	free( (void *) group);
+}
+
+void coend()
+{
+	register struct process *proc, *next;
+	register struct procgroup *junk;
+
+	proc=group->first;
+
+	while (proc!=nil) {
+		if (proc!= *group->active) {
+			if (proc->down!=nil)
+				delete_group(proc->down);
+			else
+				free(proc->stack);
+		}
+		next=proc->next;
+		free( (void *) proc);
+		proc=next;
+	}
+	delete_between(group);
+	junk=group;
+	group=group->up;
+	free( (void *) junk);
+
+	if (group!=nil)
+		(*group->active)->down=nil;
+}
+
+static void RESUMERR()
+{
+	write(2, "RESUMERR\n", 9);
+	abort();
+}

lang/occam/lib/em2.e

@@ -0,0 +1,52 @@
+ mes 2,2,4
+
+oldtrp
+ bss 4, 0, 0
+
+ exp $init
+ pro $init, 0
+ loc -321-1
+ sim
+ lpi $catch1
+ sig
+ sde oldtrp
+ cal $initfile
+ ret 0
+ end 0
+
+ pro $catch1, 0
+ lde oldtrp
+ sig
+ asp 4
+ loe 0
+ lde 4
+ lol 0
+ cal $catch
+ asp 8
+ lol 0
+ trp
+ rtt
+ end 0
+
+ exp $now
+ pro $now, 12
+ zre deadlock
+ lal -12
+ loc 35
+ mon
+ asp 2
+ ldl -12
+ ret 4
+ end 12
+
+ exp $block_mo
+ pro $block_mo, 0
+ ldl 4
+ ldl 8
+ ldl 0
+ loc 4
+ loc 2
+ cuu
+ bls 2
+ ret 0
+ end 0

lang/occam/lib/em4.e

@@ -0,0 +1,49 @@
+ mes 2,4,4
+
+oldtrp
+ bss 4, 0, 0
+
+ exp $init
+ pro $init, 0
+ loc -321-1
+ sim
+ lpi $catch1
+ sig
+ ste oldtrp
+ cal $initfile
+ ret 0
+ end 0
+
+ pro $catch1, 0
+ loe oldtrp
+ sig
+ asp 4
+ loe 0
+ loe 4
+ lol 0
+ cal $catch
+ asp 12
+ lol 0
+ trp
+ rtt
+ end 0
+
+ exp $now
+ pro $now, 12
+ zre deadlock
+ lal -12
+ loc 35
+ mon
+ asp 4
+ lol -12
+ ret 4
+ end 12
+
+ exp $block_mo
+ pro $block_mo, 0
+ lol 4
+ lol 8
+ lol 0
+ bls 4
+ ret 0
+ end 0

lang/occam/lib/ocm_chan.h

@@ -0,0 +1,47 @@
+/*	channel.h - channel definitions */
+#include <stdio.h>
+#include "parco.h"
+
+typedef union channel {
+	struct {		/* Interprocess channel */
+		char _type;	/* Channel type, see note */
+		char synch;	/* State in channel synchronization */
+		long val;	/* Transmitted value */
+	} c;
+	struct {		/* File channel */
+		char _type;	/* Dummy field, see note */
+		char index;	/* Index in the file array */
+		char flgs;	/* Status flags: in use & readahead */
+		char preread;	/* Possible preread character */
+	} f;
+} chan;
+#define type		c._type	/* Channel type */
+/* Note: The channel type should not be part of each structure in chan. But
+ * the C alignment rules would make chan about 50% bigger if we had done it
+ * the right way. Note that the order of fields in a struct cannot be a problem
+ * as long as struct c is the largest within the union.
+ */
+
+#define C_T_CHAN	0	/* Type of a interprocess channel */
+#define C_T_FILE	1	/* Type of a file channel */
+
+#define C_S_FREE	0	/* IP channel is free */
+#define C_S_ANY		1	/* IP channel contains data */
+#define C_S_ACK		2	/* IP channel data is removed */
+
+#define C_F_EOF		(-1L)	/* File channel returns EOF */
+#define C_F_TEXT	(-2L)	/* File channel becomes line oriented */
+#define C_F_RAW		(-3L)	/* File channel becomes character oriented */
+
+#define C_F_INUSE	0x01	/* File channel is connected to a UNIX file */
+#define C_F_READAHEAD	0x02	/* File channel has a preread character */
+
+extern chan file[_NFILE];	/* Array of file channels */
+extern FILE *unix_file[_NFILE];	/* Pointers to buffered UNIX files */
+
+void c_init();
+
+void chan_in(), cbyte_in(), c_wa_in(), c_ba_in();
+void chan_out(), c_wa_out(), c_ba_out();
+
+int chan_any();

lang/occam/lib/ocm_parco.h

@@ -0,0 +1,18 @@
+/*	parco.h - Define names for simulation routines
+ *
+ *      This file is to be included by users of the higher-level routines
+ *
+ */
+
+void pc_begin(), resumenext(), parend(), resume(), coend();
+int pc_fork();
+
+#define nullid	((int *) 0 - (int *) 0)
+	/* I.e. a 0 of type "pointer difference" */
+
+#define parbegin(sbrk)		pc_begin(sbrk, nullid)
+#define parfork()		pc_fork(nullid)
+#define cobegin(sbrk, id)	pc_begin(sbrk, id)
+#define cofork(id)		pc_fork(id)
+
+extern int deadlock;

lang/occam/lib/ocm_proc.h

@@ -0,0 +1,52 @@
+/*	process.h - Define administration types and functions
+ *
+ *      This file is to be included by implementors of the higher
+ *      level routines
+ *
+ */
+#include "parco.h"
+
+#ifndef ptrdiff	/* This type must be able to hold a pointer difference */
+#define ptrdiff int	/* Define as long int if necessary */
+#endif
+
+#define nil	0
+void *alloc(), free();
+
+typedef ptrdiff wordsize, identification;
+
+wordsize top_size();
+int top_save();
+void top_load();		/* Primitives */
+
+struct procgroup;
+
+struct process {
+	struct process *next;	/* Next process in the same group */
+	struct procgroup *down;	/* Process group running under this process */
+	void *stack;		/* Pointer to the saved stack top */
+	identification id;	/* Coroutine identification */
+};
+
+#define init_between	__i_b__	/* These names are hidden */
+#define save_between	__s_b__
+#define load_betweens	__l_b__
+#define delete_between	__d_b__
+
+void init_between(), save_between(), load_betweens(), delete_between();
+
+struct procgroup {
+	struct process **active;/* Active process within this group */
+	struct procgroup *up;	/* The group that this group belongs to */
+	struct process *first;	/* List of processes belonging to this group */
+	void *s_brk;		/* Point where the stack is split */
+	void *between;		/* Stack space between s_brk and up->s_brk */
+};
+
+#define group		__grp__	/* Ignore this please */
+#define highest_group	__hgrp__
+
+extern struct procgroup *group;		/* Current running group */
+extern struct procgroup *highest_group;	/* highest group that has been seen
+					 * while searching for a process
+					 */

lang/occam/lib/ocrt.c

@@ -0,0 +1,52 @@
+/*	ocrt.c - Occam runtime support */
+#include "channel.h"
+
+int chandes[]= { 0, 0, sizeof(int)+sizeof(long) };
+int worddes[]= { 0, 0, sizeof(long) };
+int bytedes[]= { 0, 0, 1 };
+long any;
+
+void catch(sig, file, line) int sig; char *file; int line;
+/* Catches traps in the occam program */
+{
+	register char *mes;
+
+	switch (sig) {
+	case 0:
+		mes="array bound error";
+		break;
+	case 6:
+		mes="division by zero";
+		break;
+	case 8:
+		mes="undefined variable";
+		break;
+	default:
+		return;
+	}
+	fprintf(stderr, "%s (%d) F: %s\n", file, line, mes);
+	abort();
+}
+
+chan file[_NFILE];
+FILE *unix_file[_NFILE];
+
+void initfile()
+{
+	register i;
+	register chan *c=file;
+
+	for (i=0; i<_NFILE; i++) {
+		c->type=C_T_FILE;
+		c->f.flgs=0;
+		(c++)->f.index=i;
+	}
+	file[0].f.flgs|=C_F_INUSE;
+	unix_file[0]=stdin;
+
+	file[1].f.flgs|=C_F_INUSE;
+	unix_file[1]=stdout;
+
+	file[2].f.flgs|=C_F_INUSE;
+	unix_file[2]=stderr;
+}

lang/occam/lib/par.c

@@ -0,0 +1,92 @@
+/*	par.c - Routines to simulate parallelism */
+#include "process.h"
+
+static void search_next(), DEADLOCK();
+
+void resumenext()
+/* Stops the current process, by saving its stack,  and determines a new one
+ * to restart. In case the root of the process tree is passed more then once,
+ * without a process  having done something useful, we'll have a deadlock.
+ */
+{
+	if (group!=nil) {
+		register struct process *proc= *group->active;
+		register wordsize size;
+
+		size=top_size(group->s_brk);
+		proc->stack=alloc((unsigned) size);
+
+		if (top_save(size, proc->stack)) {
+			group->active= &proc->next;
+			search_next();
+		} else {
+			free(proc->stack);
+			load_betweens();
+		}
+	} else
+		if (++deadlock>1) DEADLOCK();
+}
+
+static void search_next()
+/* Tries to resume the active process, if this is not possible, the process
+ * tree will be searched for another process. If the process tree is fully
+ * traversed, search will restart at the root of the tree.
+ */
+{
+	while (*group->active==nil && group->up!=nil) {
+		save_between(group);
+
+		group=group->up;
+
+		group->active= &(*group->active)->next;
+	}
+
+	if (*group->active==nil) {
+		if (++deadlock>1) DEADLOCK();
+		group->active= &group->first;
+	}
+
+	highest_group=group;
+
+	while ((*group->active)->down!=nil) {
+		group=(*group->active)->down;
+		group->active= &group->first;
+	}
+	top_load((*group->active)->stack);
+}
+
+void parend()
+/* Deletes the current process from its process group and searches for a new
+ * process to run. The entire group is removed if this is the last process in
+ * the group, execution then continues with the process that set up this group
+ * in the first place.
+ */
+{
+	register struct process *junk;
+
+	junk= *group->active;
+	*group->active=junk->next;
+	free((void *) junk);
+
+	if (group->first==nil) {
+		register struct procgroup *junk;
+
+		delete_between(group);
+
+		junk=group;
+		group=group->up;
+		free((void *) junk);
+
+		if (group!=nil)
+			(*group->active)->down=nil;
+	} else {
+		deadlock=0;
+		search_next();
+	}
+}
+
+static void DEADLOCK()
+{
+	write(2, "DEADLOCK\n", 9);
+	abort();
+}

lang/occam/lib/par_em2.e

@@ -0,0 +1,53 @@
+ mes 2,2,4
+ exp $top_size
+ pro $top_size, 14
+ ldl 0			; s_brk
+ lor 1			; s_brk  SP
+ sbs 4			; s_brk-SP
+ ret 4			; return size of block to be saved
+ end 14
+
+ exp $top_save
+ pro $top_save, 0
+ loe 0
+ lde 4			; load line number and file name
+ lim			; ignore mask
+ lor 0			; LB
+ ldl 0			; size of block
+ loc 4
+ loc 2
+ cuu
+ dup 2
+ stl 0			; push & store size in 2 bytes
+ lor 1			; SP (the SP BEFORE pushing)
+ lor 1			; SP (address of stack top to save)
+ ldl 4			; area
+ lol 0			; size
+ bls 2			; move whole block
+ asp 18			; remove the lot from the stack
+ loc 1
+ ret 2			; return 1
+ end 0
+
+ exp $top_load
+ pro $top_load, 0
+ ldl 0
+ dup 4
+ sde area		; copy area pointer from argument 0
+ loi 4			; load indirect to
+ str 1			; restore SP
+ lde area		; load area, note that the SP is now correct
+ lor 1			; SP (the SP AFTER, see above)
+ lde area
+ lof 4			; size of block
+ bls 2			; move block back (SP becomes the SP BEFORE again!)
+ asp 2			; drop size
+ str 0			; LB
+ sim			; ignore mask
+ sde 4
+ ste 0			; line and file
+ loc 0
+ ret 2			; return 0
+ end 0
+area
+ bss 4,0,0

lang/occam/lib/par_em4.e

@@ -0,0 +1,46 @@
+ mes 2,4,4
+ exp $top_size
+ pro $top_size, 20
+ lol 0			; s_brk
+ lor 1			; s_brk  SP
+ sbs 4			; s_brk-SP
+ ret 4			; return size of block to be saved
+ end 20
+
+ exp $top_save
+ pro $top_save, 0
+ lde 0			; load line number and file name
+ lim			; ignore mask
+ lor 0			; LB
+ lol 0			; size of block
+ lor 1			; SP (the SP BEFORE pushing)
+ lor 1			; SP (address of stack top to save)
+ lol 4			; area
+ lol 0			; size
+ bls 4			; move whole block
+ asp 24			; remove the lot from the stack
+ loc 1
+ ret 4			; return 1
+ end 0
+
+ exp $top_load
+ pro $top_load, 0
+ lol 0
+ dup 4
+ ste area		; copy area pointer from argument 0
+ loi 4			; load indirect to
+ str 1			; restore sp
+ loe area		; load area, note that the SP is now correct
+ lor 1			; SP (the SP AFTER, see above)
+ loe area
+ lof 4			; size of block
+ bls 4			; move block back (SP becomes the SP BEFORE again!)
+ asp 4			; drop size
+ str 0			; LB
+ sim			; ignore mask
+ sde 0			; line and file
+ loc 0
+ ret 4			; return 0
+ end 0
+area
+ bss 4,0,0

lang/occam/lib/par_vax.s

@@ -0,0 +1,51 @@
+ # VAX code for the top_* primitives
+
+	.set	BIG, 0x8000	# 32K chunk per movc3
+	.text
+	.align 1
+	.globl _top_size
+	.globl _top_save
+	.globl _top_load
+
+_top_size: .word 0x0000
+	subl3	sp, 4(ap), r0	# bytes between stack pointer and break
+	addl2	$(8+6+1)*4, r0	# add 8 regs, 6 pushed longwords (line, file,
+	ret			# ap, fp, size, sp) and 1 extra argument
+
+_top_save: .word 0x0ff0		# save regs r4-r11
+	movq	hol0, -(sp)	# push line number and file name
+	movq	ap, -(sp)	# push LB equivalents ap and fp
+	pushl	4(ap)		# push size
+	pushal	-4(sp)		# push sp (the sp AFTER pushing)
+	movl	$BIG, r6	# chunk size in r6
+	movl	4(ap), r7	# size of block to move
+	movl	sp, r1		# source address
+	movl	8(ap), r3	# destination address
+	cmpl	r7, r6
+	jlequ	0f
+1:	movc3	r6, (r1), (r3)	# move chunk of the block, add r6 to r1 and r3
+	subl2	r6, r7
+	cmpl	r7, r6
+	jgtru	1b
+0:	movc3	r7, (r1), (r3)	# move what's left
+	movl	$1, r0		# return 1
+	ret
+
+_top_load: .word 0x0000
+	movl	4(ap), r1	# source
+	movl	(r1), sp	# restore sp
+	movl	$BIG, r6	# chunk size
+	movl	4(r1), r7	# size
+	movl	sp, r3		# destination
+	cmpl	r7, r6
+	jlequ	0f
+1:	movc3	r6, (r1), (r3)	# move chunk of the block back
+	subl2	r6, r7
+	cmpl	r7, r6
+	jgtru	1b
+0:	movc3	r7, (r1), (r3)	# move what's left back
+	addl2	$8, sp		# pop saved sp and size
+	movq	(sp)+, ap	# pop LB's
+	movq	(sp)+, hol0	# pop line and file
+	clrl	r0		# return 0
+	ret

lang/occam/lib/parco.c

@@ -0,0 +1,130 @@
+/*	parco.c	- Common routines for simulating parallelism or coroutines on
+ *		  machines with downward growing stacks
+ */
+#include "process.h"
+
+struct procgroup *group=nil, *highest_group;
+
+int deadlock=0;
+
+void pc_begin(s_brk, id)
+	register void *s_brk;
+	identification id;
+/* Sets up a group of processes and puts the current process in it */
+{
+	register struct procgroup *pg;
+	register struct process *p;
+
+	pg= (struct procgroup *) alloc(sizeof *pg);
+	p= (struct process *) alloc(sizeof *p);
+
+	pg->s_brk= s_brk==nil ? (void *) (&id +1) : s_brk;
+	pg->up=group;
+	pg->first=p;
+	pg->active= &pg->first;
+
+	p->next=nil;
+	p->down=nil;
+	p->id=id;
+
+	if (group!=nil)
+		(*group->active)->down=pg;
+
+	group=pg;
+	init_between(group);
+}
+
+int pc_fork(id) identification id;
+/* Makes a copy of the stack top of the calling function and creates an
+ * entry for it in the current process group.  Pc_fork() returns 1 in the
+ * current process, 0 in the copied process. The current process runs first.
+ */
+{
+	register struct process *newp;
+	register wordsize size;
+
+	newp= (struct process *) alloc(sizeof *newp);
+
+	newp->down=nil;
+	newp->id=id;
+
+	newp->next= *group->active;
+	*group->active= newp;
+	group->active= &newp->next;
+
+	size=top_size(group->s_brk);
+	newp->stack=alloc((unsigned) size);
+
+	if (top_save(size, newp->stack))
+		return 1;
+	else {
+		free(newp->stack);
+		load_betweens();
+		return 0;
+	}
+}
+
+void init_between(group) register struct procgroup *group;
+/* Allocates memory to hold the stack space between s_brk and up->s_brk. */
+{
+	register wordsize size;
+
+	if (group->up==nil
+	    || (size= (wordsize) group->up->s_brk - (wordsize) group->s_brk)==0)
+		group->between=nil;
+	else
+		group->between=alloc((unsigned) size);
+}
+
+void block_move();
+
+void save_between(group) register struct procgroup *group;
+/* Saves the stack space between  s_brk and up->s_brk. */
+{
+	register wordsize size;
+
+	if (group->between!=nil) {
+	    	size= (wordsize) group->up->s_brk - (wordsize) group->s_brk;
+		block_move(size, group->s_brk, group->between);
+	}
+}
+
+void load_betweens()
+/* All stack pieces between s_brk and up->s_brk from the current group
+ * upto the 'highest_group' are loaded onto the stack at the right
+ * place (i.e. s_brk).
+ */
+{
+	register struct procgroup *gr=group, *up;
+	register wordsize size;
+
+	while (gr!=highest_group) {
+		up=gr->up;
+		if (gr->between!=nil) {
+			size= (wordsize) up->s_brk - (wordsize) gr->s_brk;
+
+			block_move(size, gr->between, gr->s_brk);
+		}
+		gr=up;
+	}
+}
+
+void delete_between(group) register struct procgroup *group;
+/* Deallocates the stack space between s_brk and up->s_brk. */
+{
+	if (group->between!=nil)
+		free(group->between);
+}
+
+void *malloc();
+
+void *alloc(size) unsigned size;
+{
+	register void *mem;
+
+	if ((mem=malloc(size))==nil) {
+		write(2, "Heap error\n", 14);
+		abort();
+	}
+	return mem;
+}