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