Merge tag 'upstream/9.5.0'

Upstream version 9.5.0

1 files changed, 11 insertions, 277 deletions

diff --git a/src/runtime/rmisc.r b/src/runtime/rmisc.r
index a302da2..18097c5 100644
--- a/src/runtime/rmisc.r
+++ b/src/runtime/rmisc.r
@@ -50,17 +50,7 @@ int getvar(s,vp)
    register dptr np;
    register int i;
    struct b_proc *bp;
-#if COMPILER
-   struct descrip sdp;
-
-   if (!debug_info)
-      fatalerr(402,NULL);
-
-   StrLoc(sdp) = s;
-   StrLen(sdp) = strlen(s);
-#else					/* COMPILER */
    struct pf_marker *fp = pfp;
-#endif					/* COMPILER */
 
    /*
     * Is it a keyword that's a variable?
@@ -97,15 +87,6 @@ int getvar(s,vp)
          VarLoc(*vp) = &kywd_trc;
          return Succeeded;
          }
-
-#ifdef FncTrace
-      else if (strcmp(s,"&ftrace") == 0) {
-         vp->dword = D_Kywdint;
-         VarLoc(*vp) = &kywd_ftrc;
-         return Succeeded;
-         }
-#endif					/* FncTrace */
-
       else if (strcmp(s,"&dump") == 0) {
          vp->dword = D_Kywdint;
          VarLoc(*vp) = &kywd_dmp;
@@ -119,24 +100,6 @@ int getvar(s,vp)
          }
 #endif					/* Graphics */
 
-#ifdef MultiThread
-      else if (strcmp(s,"&eventvalue") == 0) {
-         vp->dword = D_Var;
-         VarLoc(*vp) = (dptr)&(curpstate->eventval);
-         return Succeeded;
-         }
-      else if (strcmp(s,"&eventsource") == 0) {
-         vp->dword = D_Var;
-         VarLoc(*vp) = (dptr)&(curpstate->eventsource);
-         return Succeeded;
-         }
-      else if (strcmp(s,"&eventcode") == 0) {
-         vp->dword = D_Var;
-         VarLoc(*vp) = (dptr)&(curpstate->eventcode);
-         return Succeeded;
-         }
-#endif					/* MultiThread */
-
       else return Failed;
       }
 
@@ -149,53 +112,31 @@ int getvar(s,vp)
     *  If no such variable exits, it fails.
     */
 
-#if !COMPILER
    /*
     *  If no procedure has been called (as can happen with icon_call(),
     *  dont' try to find local identifier.
     */
    if (pfp == NULL)
       goto glbvars;
-#endif					/* !COMPILER */
 
    dp = glbl_argp;
-#if COMPILER
-   bp = PFDebug(*pfp)->proc;  /* get address of procedure block */
-#else					/* COMPILER */
    bp = (struct b_proc *)BlkLoc(*dp);	/* get address of procedure block */
-#endif					/* COMPILER */
 
    np = bp->lnames;		/* Check the formal parameter names. */
 
    for (i = abs((int)bp->nparam); i > 0; i--) {
-#if COMPILER
-      if (eq(&sdp, np) == 1) {
-#else					/* COMPILER */
       dp++;
       if (strcmp(s,StrLoc(*np)) == 0) {
-#endif					/* COMPILER */
          vp->dword = D_Var;
          VarLoc(*vp) = (dptr)dp;
          return ParamName;
          }
       np++;
-#if COMPILER
-      dp++;
-#endif					/* COMPILER */
       }
-
-#if COMPILER
-   dp = &pfp->tend.d[0];
-#else					/* COMPILER */
    dp = &fp->pf_locals[0];
-#endif					/* COMPILER */
 
    for (i = (int)bp->ndynam; i > 0; i--) { /* Check the local dynamic names. */
-#if COMPILER
-         if (eq(&sdp, np)) {
-#else					/* COMPILER */
 	 if (strcmp(s,StrLoc(*np)) == 0) {
-#endif					/* COMPILER */
             vp->dword = D_Var;
             VarLoc(*vp) = (dptr)dp;
             return LocalName;
@@ -206,11 +147,7 @@ int getvar(s,vp)
 
    dp = &statics[bp->fstatic]; /* Check the local static names. */
    for (i = (int)bp->nstatic; i > 0; i--) {
-#if COMPILER
-         if (eq(&sdp, np)) {
-#else					/* COMPILER */
          if (strcmp(s,StrLoc(*np)) == 0) {
-#endif					/* COMPILER */
             vp->dword = D_Var;
             VarLoc(*vp) = (dptr)dp;
             return StaticName;
@@ -219,15 +156,6 @@ int getvar(s,vp)
          dp++;
          }
 
-#if COMPILER
-   for (i = 0; i < n_globals; ++i) {
-      if (eq(&sdp, &gnames[i])) {
-         vp->dword = D_Var;
-         VarLoc(*vp) = (dptr)&globals[i];
-         return GlobalName;
-         }
-      }
-#else					/* COMPILER */
 glbvars:
    dp = globals;	/* Check the global variable names. */
    np = gnames;
@@ -240,7 +168,6 @@ glbvars:
       np++;
       dp++;
       }
-#endif					/* COMPILER */
    return Failed;
    }
 
@@ -288,7 +215,6 @@ dptr dp;
             i = (13255 * (uword)IntVal(*dp)) >> 10;
             break;
 
-#ifdef LargeInts
          /*
           * The hash value of a bignum is based on its length and its
           *  most and least significant digits.
@@ -301,7 +227,6 @@ dptr dp;
 		(b->digits[b->msd] << 8) ^ b->digits[b->lsd];
 	    }
 	    break;
-#endif					/* LargeInts */
 
          /*
           * The hash value of a real number is itself times a constant,
@@ -412,15 +337,10 @@ int noimage;
          fprintf(f, "&null");
 
       integer:
-
-#ifdef LargeInts
          if (Type(*dp) == T_Lrgint)
             bigprint(f, dp);
          else
             fprintf(f, "%ld", (long)IntVal(*dp));
-#else					/* LargeInts */
-         fprintf(f, "%ld", (long)IntVal(*dp));
-#endif					/* LargeInts */
 
       real: {
          char s[30];
@@ -436,7 +356,7 @@ int noimage;
 	  * Check for a predefined cset; use keyword name if found.
 	  */
 	 if ((csn = csname(dp)) != NULL) {
-	    fprintf(f, csn);
+	    fprintf(f, "%s", csn);
 	    return;
 	    }
          /*
@@ -628,12 +548,6 @@ int noimage;
             fprintf(f, "&random = ");
          else if (VarLoc(*dp) == &kywd_trc)
             fprintf(f, "&trace = ");
-
-#ifdef FncTrace
-         else if (VarLoc(*dp) == &kywd_ftrc)
-            fprintf(f, "&ftrace = ");
-#endif					/* FncTrace */
-
          else if (VarLoc(*dp) == &kywd_dmp)
             fprintf(f, "&dump = ");
          else if (VarLoc(*dp) == &kywd_err)
@@ -642,14 +556,6 @@ int noimage;
          }
 
       kywdevent: {
-#ifdef MultiThread
-         if (VarLoc(*dp) == &curpstate->eventsource)
-            fprintf(f, "&eventsource = ");
-         else if (VarLoc(*dp) == &curpstate->eventcode)
-            fprintf(f, "&eventcode = ");
-         else if (VarLoc(*dp) == &curpstate->eventval)
-            fprintf(f, "&eventval = ");
-#endif					/* MultiThread */
          outimage(f, VarLoc(*dp), noimage);
          }
 
@@ -682,8 +588,13 @@ int noimage;
             outimage(f, dp, noimage);
             putc(')', f);
             }
-         else if (Type(*dp) == T_External)
-            fprintf(f, "external(%d)",((struct b_external *)BlkLoc(*dp))->blksize);
+         else if (Type(*dp) == T_External) {
+            q = callextfunc(&extlimage, dp, NULL); /* get image as a string */
+            i = StrLen(q);
+            s = StrLoc(q);
+            while (i-- > 0)
+               putc(*s++, f);
+            }
          else if (Type(*dp) <= MaxType)
             fprintf(f, "%s", blkname[Type(*dp)]);
          else
@@ -848,7 +759,6 @@ int (*compar)();
     return 0;
 }
 
-#if !COMPILER
 /*
  * qtos - convert a qualified string named by *dp to a C-style string.
  *  Put the C-style string in sbuf if it will fit, otherwise put it
@@ -883,9 +793,7 @@ char *sbuf;
       }
    return Succeeded;
    }
-#endif					/* !COMPILER */
 
-#ifdef Coexpr
 /*
  * pushact - push actvtr on the activator stack of ce
  */
@@ -895,10 +803,6 @@ struct b_coexpr *ce, *actvtr;
    struct astkblk *abp = ce->es_actstk, *nabp;
    struct actrec *arp;
 
-#ifdef MultiThread
-   abp->arec[0].activator = actvtr;
-#else					/* MultiThread */
-
    /*
     * If the last activator is the same as this one, just increment
     *  its count.
@@ -924,10 +828,8 @@ struct b_coexpr *ce, *actvtr;
    arp->acount = 1;
    arp->activator = actvtr;
    ce->es_actstk = abp;
-#endif					/* MultiThread */
    return Succeeded;
 }
-#endif					/* Coexpr */
 
 /*
  * popact - pop the most recent activator from the activator stack of ce
@@ -936,17 +838,10 @@ struct b_coexpr *ce, *actvtr;
 struct b_coexpr *popact(ce)
 struct b_coexpr *ce;
 {
-
-#ifdef Coexpr
-
    struct astkblk *abp = ce->es_actstk, *oabp;
    struct actrec *arp;
    struct b_coexpr *actvtr;
 
-#ifdef MultiThread
-   return abp->arec[0].activator;
-#else					/* MultiThread */
-
    /*
     * If the current stack block is empty, pop it.
     */
@@ -971,15 +866,8 @@ struct b_coexpr *ce;
 
    ce->es_actstk = abp;
    return actvtr;
-#endif					/* MultiThread */
-
-#else					/* Coexpr */
-    syserr("popact() called, but co-expressions not implemented");
-#endif					/* Coexpr */
-
 }
 
-#ifdef Coexpr
 /*
  * topact - return the most recent activator of ce.
  */
@@ -988,48 +876,14 @@ struct b_coexpr *ce;
 {
    struct astkblk *abp = ce->es_actstk;
 
-#ifdef MultiThread
-   return abp->arec[0].activator;
-#else					/* MultiThread */
    if (abp->nactivators == 0)
       abp = abp->astk_nxt;
    return abp->arec[abp->nactivators-1].activator;
-#endif					/* MultiThread */
 }
 
-#ifdef DeBugIconx
-/*
- * dumpact - dump an activator stack
- */
-void dumpact(ce)
-struct b_coexpr *ce;
-{
-   struct astkblk *abp = ce->es_actstk;
-   struct actrec *arp;
-   int i;
-
-   if (abp)
-      fprintf(stderr, "Ce %ld ", (long)ce->id);
-   while (abp) {
-      fprintf(stderr, "--- Activation stack block (%x) --- nact = %d\n",
-         abp, abp->nactivators);
-      for (i = abp->nactivators; i >= 1; i--) {
-         arp = &abp->arec[i-1];
-         /*for (j = 1; j <= arp->acount; j++)*/
-         fprintf(stderr, "co-expression_%ld(%d)\n", (long)(arp->activator->id),
-            arp->acount);
-         }
-      abp = abp->astk_nxt;
-      }
-}
-#endif					/* DeBugIconx */
-#endif					/* Coexpr */
-
-#if !COMPILER
 /*
  * findline - find the source line number associated with the ipc
  */
-#ifdef SrcColumnInfo
 int findline(ipc)
 word *ipc;
 {
@@ -1042,19 +896,12 @@ word *ipc;
 }
 
 int findloc(ipc)
-#else					/* SrcColumnInfo */
-int findline(ipc)
-#endif					/* SrcColumnInfo */
 word *ipc;
 {
    uword ipc_offset;
    uword size;
    struct ipc_line *base;
-
-#ifndef MultiThread
    extern struct ipc_line *ilines, *elines;
-#endif					/* MultiThread */
-
    static int two = 2;	/* some compilers generate bad code for division
 			   by a constant that is a power of two ... */
 
@@ -1084,11 +931,7 @@ int line;
 {
    uword size;
    struct ipc_line *base;
-
-#ifndef MultiThread
    extern struct ipc_line *ilines, *elines;
-#endif					/* MultiThread */
-
    static int two = 2;	/* some compilers generate bad code for division
 			   by a constant that is a power of two ... */
 
@@ -1113,10 +956,7 @@ word *ipc;
 {
    uword ipc_offset;
    struct ipc_fname *p;
-
-#ifndef MultiThread
    extern struct ipc_fname *filenms, *efilenms;
-#endif					/* MultiThread */
 
    if (!InRange(code,ipc,ecode))
       return "?";
@@ -1130,7 +970,6 @@ word *ipc;
    /*NOTREACHED*/
    return 0;  /* avoid gcc warning */
 }
-#endif					/* !COMPILER */
 
 /*
  * doimage(c,q) - allocate character c in string space, with escape
@@ -1249,7 +1088,6 @@ dptr dp1, dp2;
          }
 
       integer: {
-#ifdef LargeInts
          if (Type(source) == T_Lrgint) {
             word slen;
             word dlen;
@@ -1271,9 +1109,6 @@ dptr dp1, dp2;
 	    }
          else
             cnv: string(source, *dp2);
-#else					/* LargeInts */
-         cnv:string(source, *dp2);
-#endif					/* LargeInts */
 	 }
 
       real: {
@@ -1472,16 +1307,9 @@ dptr dp1, dp2;
          }
 
       default:
-        if (Type(*dp1) == T_External) {
-           /*
-            * For now, just produce "external(n)".
-            */
-           sprintf(sbuf, "external(%ld)", (long)BlkLoc(*dp1)->externl.blksize);
-           len = strlen(sbuf);
-           Protect(t = alcstr(sbuf, len), return Error);
-           StrLoc(*dp2) = t;
-           StrLen(*dp2) = len;
-           }
+         if (Type(*dp1) == T_External) {
+            *dp2 = callextfunc(&extlimage, dp1, NULL);
+            }
          else {
 	    ReturnErrVal(123, source, Error);
             }
@@ -1685,100 +1513,6 @@ word a;
    return -a;
 }
 
-#if COMPILER
-/*
- * sig_rsm - standard success continuation that just signals resumption.
- */
-
-int sig_rsm()
-   {
-   return A_Resume;
-   }
-
-/*
- * cmd_line - convert command line arguments into a list of strings.
- */
-void cmd_line(argc, argv, rslt)
-int argc;
-char **argv;
-dptr rslt;
-   {
-   tended struct b_list *hp;
-   register word i;
-   register struct b_lelem *bp;  /* need not be tended */
-
-   /*
-    * Skip the program name.
-    */
-   --argc;
-   ++argv;
-
-   /*
-    * Allocate the list and a list block.
-    */
-   Protect(hp = alclist(argc), fatalerr(0,NULL));
-   Protect(bp = alclstb(argc, (word)0, argc), fatalerr(0,NULL));
-
-   /*
-    * Make the list block just allocated into the first and last blocks
-    *  for the list.
-    */
-   hp->listhead = hp->listtail = (union block *)bp;
-#ifdef ListFix
-   bp->listprev = bp->listnext = (union block *)hp;
-#endif					/* ListFix */
-
-   /*
-    * Copy the arguments into the list
-    */
-   for (i = 0; i < argc; ++i) {
-      StrLen(bp->lslots[i]) = strlen(argv[i]);
-      StrLoc(bp->lslots[i]) = argv[i];
-      }
-
-   rslt->dword = D_List;
-   rslt->vword.bptr = (union block *) hp;
-   }
-
-/*
- * varargs - construct list for use in procedures with variable length
- *  argument list.
- */
-void varargs(argp, nargs, rslt)
-dptr argp;
-int nargs;
-dptr rslt;
-   {
-   tended struct b_list *hp;
-   register word i;
-   register struct b_lelem *bp;  /* need not be tended */
-
-   /*
-    * Allocate the list and a list block.
-    */
-   Protect(hp = alclist(nargs), fatalerr(0,NULL));
-   Protect(bp = alclstb(nargs, (word)0, nargs), fatalerr(0,NULL));
-
-   /*
-    * Make the list block just allocated into the first and last blocks
-    *  for the list.
-    */
-   hp->listhead = hp->listtail = (union block *)bp;
-#ifdef ListFix
-   bp->listprev = bp->listnext = (union block *)hp;
-#endif					/* ListFix */
-
-   /*
-    * Copy the arguments into the list
-    */
-   for (i = 0; i < nargs; i++)
-      deref(&argp[i], &bp->lslots[i]);
-
-   rslt->dword = D_List;
-   rslt->vword.bptr = (union block *) hp;
-   }
-#endif					/* COMPILER */
-
 /*
  * retderef - Dereference local variables and substrings of local
  *  string-valued variables. This is used for return, suspend, and