1 files changed, 46 insertions, 149 deletions

diff --git a/src/runtime/ralc.r b/src/runtime/ralc.r
index 9f55671..403515b 100644
--- a/src/runtime/ralc.r
+++ b/src/runtime/ralc.r
@@ -11,12 +11,11 @@ static struct region *newregion	(word nbytes, word stdsize);
 
 extern word alcnum;
 
-#ifndef MultiThread
 word coexp_ser = 2;	/* serial numbers for co-expressions; &main is 1 */
+word extl_ser = 1;	/* serial numbers for externals */
 word list_ser = 1;	/* serial numbers for lists */
 word set_ser = 1;	/* serial numbers for sets */
 word table_ser = 1;	/* serial numbers for tables */
-#endif					/* MultiThread */
 
 
 /*
@@ -24,10 +23,6 @@ word table_ser = 1;	/* serial numbers for tables */
  */
 #begdef AlcBlk(var, struct_nm, t_code, nbytes)
 {
-#ifdef MultiThread
-   EVVal((word)nbytes, typech[t_code]);
-#endif					/* MultiThread */
-
    /*
     * Ensure that there is enough room in the block region.
     */
@@ -35,13 +30,6 @@ word table_ser = 1;	/* serial numbers for tables */
       return NULL;
 
    /*
-    * If monitoring, show the allocation.
-    */
-#ifndef MultiThread
-   EVVal((word)nbytes, typech[t_code]);
-#endif
-
-   /*
     * Decrement the free space in the block region by the number of bytes
     *  allocated and return the address of the first byte of the allocated
     *  block.
@@ -64,11 +52,7 @@ word table_ser = 1;	/* serial numbers for tables */
  */
 #begdef AlcVarBlk(var, struct_nm, t_code, n_desc)
    {
-#ifdef EventMon
-   uword size;
-#else					/* EventMon */
    register uword size;
-#endif					/* EventMon */
 
    /*
     * Variable size blocks are declared with one descriptor, thus
@@ -105,7 +89,6 @@ struct astkblk *alcactiv()
    return abp;
    }
 
-#ifdef LargeInts
 /*
  * alcbignum - allocate an n-digit bignum in the block region
  */
@@ -125,17 +108,18 @@ word n;
    blk->lsd = n - 1;
    return blk;
    }
-#endif					/* LargeInts */
 
 /*
  * alccoexp - allocate a co-expression stack block.
+ *
+ * Although pthreads allocates a C stack, we still need this an
+ * interpreter stack beyond the end of the coexpr block.
  */
 
-#if COMPILER
 struct b_coexpr *alccoexp()
    {
    struct b_coexpr *ep;
-   static int serial = 2; /* main co-expression is allocated elsewhere */
+
    ep = (struct b_coexpr *)malloc(stksize);
 
    /*
@@ -146,112 +130,24 @@ struct b_coexpr *alccoexp()
    if (ep == NULL || alcnum > AlcMax) {
       collect(Static);
       ep = (struct b_coexpr *)malloc(stksize);
-      }
-
+   }
    if (ep == NULL)
       ReturnErrNum(305, NULL);
 
-   alcnum++;                    /* increment allocation count since last g.c. */
-
-   ep->title = T_Coexpr;
-   ep->size = 0;
-   ep->id = serial++;
-   ep->nextstk = stklist;
-   ep->es_tend = NULL;
-   ep->file_name = "";
-   ep->line_num = 0;
-   ep->freshblk = nulldesc;
-   ep->es_actstk = NULL;
-   ep->cstate[0] = 0;		/* zero the first two cstate words as a flag */
-   ep->cstate[1] = 0;
-   stklist = ep;
-   return ep;
-   }
-#else					/* COMPILER */
-#ifdef MultiThread
-/*
- * If this is a new program being loaded, an icodesize>0 gives the
- * hdr.hsize and a stacksize to use; allocate
- * sizeof(progstate) + icodesize + mstksize
- * Otherwise (icodesize==0), allocate a normal stksize...
- */
-struct b_coexpr *alccoexp(icodesize, stacksize)
-long icodesize, stacksize;
-#else					/* MultiThread */
-struct b_coexpr *alccoexp()
-#endif					/* MultiThread */
-
-   {
-   struct b_coexpr *ep;
-
-#ifdef MultiThread
-   if (icodesize > 0) {
-      ep = (struct b_coexpr *)
-	calloc(1, stacksize+
-		       icodesize+
-		       sizeof(struct progstate)+
-		       sizeof(struct b_coexpr));
-      }
-   else
-#endif					/* MultiThread */
-
-   ep = (struct b_coexpr *)malloc(stksize);
-
-   /*
-    * If malloc failed or if there have been too many co-expression allocations
-    * since a collection, attempt to free some co-expression blocks and retry.
-    */
-
-   if (ep == NULL || alcnum > AlcMax) {
-
-      collect(Static);
-
-#ifdef MultiThread
-      if (icodesize>0) {
-         ep = (struct b_coexpr *)
-	    malloc(mstksize+icodesize+sizeof(struct progstate));
-         }
-      else
-#endif					/* MultiThread */
-
-         ep = (struct b_coexpr *)malloc(stksize);
-      }
-      if (ep == NULL)
-         ReturnErrNum(305, NULL);
-
    alcnum++;		/* increment allocation count since last g.c. */
 
    ep->title = T_Coexpr;
    ep->es_actstk = NULL;
    ep->size = 0;
-#ifdef MultiThread
-   ep->es_pfp = NULL;
-   ep->es_gfp = NULL;
-   ep->es_argp = NULL;
-   ep->tvalloc = NULL;
-
-   if (icodesize > 0)
-      ep->id = 1;
-   else
-#endif					/* MultiThread */
    ep->id = coexp_ser++;
    ep->nextstk = stklist;
    ep->es_tend = NULL;
    ep->cstate[0] = 0;		/* zero the first two cstate words as a flag */
    ep->cstate[1] = 0;
 
-#ifdef MultiThread
-   /*
-    * Initialize program state to self for &main; curpstate for others.
-    */
-   if(icodesize>0) ep->program = (struct progstate *)(ep+1);
-   else ep->program = curpstate;
-#endif					/* MultiThread */
-
    stklist = ep;
    return ep;
    }
-#endif					/* COMPILER */
 
 /*
  * alccset - allocate a cset in the block region.
@@ -274,6 +170,46 @@ struct b_cset *alccset()
    }
 
 /*
+ * alcexternal - allocate an external data block in the block region.
+ *
+ * nbytes is total struct size including header, or zero to use default
+ * f is dispatch table of user C functions; also differentiates external types
+ * data is copied in to initialize the data block.
+ * Any of these can be zero/null for default behavior.
+ *
+ * May cause a garbage collection.  Returns null if still unsuccessful.
+ */
+
+struct b_external *alcexternal(long nbytes, struct b_extlfuns *f, void *data)
+   {
+   register struct b_external *blk;
+   long datasize;
+   static struct b_extlfuns fdefault; 	/* default dispatch table, all empty */
+
+   if (nbytes == 0)
+      nbytes = sizeof(struct b_external);
+
+   /* datasize = nbytes - offsetof(struct b_external, data); */
+   datasize = nbytes - ((char*)blk->data - (char*)blk);
+   if (datasize < 0)
+      syserr("alcexternal: invalid size");
+
+   /* now, after calculating datasize, round up nbytes to a word multiple */
+   nbytes = (nbytes + sizeof(word) - 1) & ~(sizeof(word) - 1);
+
+   if (f == NULL)
+      f = &fdefault;
+
+   AlcBlk(blk, b_external, T_External, nbytes);
+   blk->blksize = nbytes;
+   blk->id = extl_ser++;
+   blk->funcs = f;
+   if (data != NULL)
+      memcpy(blk->data, data, datasize);
+   return blk;
+   }
+
+/*
  * alcfile - allocate a file block in the block region.
  */
 
@@ -429,23 +365,6 @@ union block *recptr;
  * alcrefresh - allocate a co-expression refresh block.
  */
 
-#if COMPILER
-struct b_refresh *alcrefresh(na, nl, nt, wrk_sz)
-int na;
-int nl;
-int nt;
-int wrk_sz;
-   {
-   struct b_refresh *blk;
-
-   AlcVarBlk(blk, b_refresh, T_Refresh, na + nl)
-   blk->nlocals = nl;
-   blk->nargs = na;
-   blk->ntemps = nt;
-   blk->wrk_size = wrk_sz;
-   return blk;
-   }
-#else					/* COMPILER */
 struct b_refresh *alcrefresh(entryx, na, nl)
 word *entryx;
 int na, nl;
@@ -457,7 +376,6 @@ int na, nl;
    blk->numlocals = nl;
    return blk;
    }
-#endif					/* COMPILER */
 
 /*
  * alcselem - allocate a set element block.
@@ -490,16 +408,6 @@ register word slen;
    register char *d;
    char *ofree;
 
-#ifdef MultiThread
-   StrLen(ts) = slen;
-   StrLoc(ts) = s;
-#ifdef EventMon
-   if (!noMTevents)
-#endif					/* EventMon */
-      EVVal(slen, E_String);
-   s = StrLoc(ts);
-#endif					/* MultiThread */
-
    /*
     * Make sure there is enough room in the string space.
     */
@@ -606,7 +514,6 @@ union block *bp;
       syserr ("deallocation botch");
    rp->free = (char *)bp;
    blktotal -= nbytes;
-   EVVal(nbytes, E_BlkDeAlc);
 }
 
 /*
@@ -691,16 +598,6 @@ word nbytes;
       if (curr->Gprev) curr->Gprev->Gnext = rp;
       curr->Gprev = rp;
       *pcurr = rp;
-#ifdef EventMon
-      if (!noMTevents) {
-         if (region == Strings) {
-            EVVal(rp->size, E_TenureString);
-            }
-         else {
-            EVVal(rp->size, E_TenureBlock);
-            }
-         }
-#endif					/* EventMon */
       return rp->free;
       }