WRITE ALL works OK now.

diff --git a/cupl.h b/cupl.h
index 37a602716fb918ba514a52ddef2fe7d5ed0143cb..eeacc70b93cac5b763d9ccecb89c863002f72c08 100644 (file)
--- a/cupl.h
+++ b/cupl.h
@@ -113,6 +113,11 @@ extern void make_scalar(value *v, scalar n);
 extern value copy_value(value);
 extern void deallocate_value(value *);
 
+void cupl_reset_write();
+void cupl_eol_write();
+void cupl_scalar_write(char *name, scalar quant);
+void cupl_string_write(char *s);
+
 extern value cupl_add(value, value);
 extern value cupl_multiply(value, value);
 extern value cupl_subtract(value, value);

diff --git a/cupl.y b/cupl.y
index a1d0459234dcbcee3a1e12ef2c0584f5caa36c92..c8fb373b74ee21ed4a446bdd3e725040d8a41518 100644 (file)
--- a/cupl.y
+++ b/cupl.y
@@ -178,7 +178,7 @@ simple      :    LET IDENTIFIER '=' expr    {$$ = cons(LET, $2, $4);}
        |    GO TO IDENTIFIER           {$$ = cons(GO, $3, NULLNODE);}
        |    GO TO IDENTIFIER END       {$$ = cons(OG, $3, NULLNODE);}
        |    READ readl                 {$$ = $2;}
-       |    WRITE ALL                  {$$ = cons(WRITE, NULLNODE, NULLNODE);}
+       |    WRITE ALL                  {$$ = cons(WRITE, cons(ALL, NULLNODE, NULLNODE), NULLNODE);}
        |    WRITE writel               {$$ = $2;}
        |    ALLOCATE allocl            {$$ = $2;}
        |    WATCH varlist              {$$ = $2;}

diff --git a/execute.c b/execute.c
index c1f9f00363daaf621e5ea6f950ea30e5a0b560c3..a6c453e2725dccd298412e2acb4028e8b40a7e65 100644 (file)
--- a/execute.c
+++ b/execute.c
@@ -61,65 +61,29 @@ static void cupl_read(node *tp)
     }
 }
 
-static void needspace(int w)
-/* emit a LF if there are not more than w spaces left on the line */
-{
-    static int used;
-
-    if (w == 0)
-       used = 0;
-    else if (w == -1)
-    {
-       if (used != linewidth)
-           (void) putchar('\n');
-    }
-    else if (used + w >= linewidth)
-    {
-       (void) putchar('\n');
-       used = 0;
-    }
-    else
-       used += w;
-}
-
-static void cupl_write(node *tp)
+static void eval_write(node *tp)
 /* evaluate a WRITE item */
 {
     if (tp == (node *)NULL)
+       cupl_string_write("");
+    else if (tp->type == ALL)
     {
-       needspace(fieldwidth);
-       (void) printf("%-*s", fieldwidth, " ");
+       lvar    *lp;
+
+       for_symbols(lp)
+           if (lp->used || lp->assigned)
+               eval_write(lp->node);
     }
     else if (tp->type == STRING)
-    {
-       needspace(fieldwidth);
-       (void) printf("%-*s", fieldwidth, tp->u.string, stdout);
-    }
+       cupl_string_write(tp->u.string);
+    else if (tp->type == FWRITE)
+       cupl_scalar_write((char *)NULL, tp->car->syminf->value.elements[0]);
     else
-    {
-       scalar  q;
-
-       if (tp->type == FWRITE)
-       {
-           needspace(fieldwidth);
-           q = tp->car->syminf->value.elements[0];
-       }
-       else
-       {
-           q = tp->syminf->value.elements[0];
-
-           needspace(2 *fieldwidth);
-           (void) printf("%*s = ", fieldwidth -3, tp->u.string);
-       }
-
-       if (0.001 < fabs(q) && abs(q) < 100000)
-           (void) printf("%*f", fieldwidth, q);
-       else
-           (void) printf("%*E", fieldwidth, q);
-    }
+       cupl_scalar_write(tp->u.string, tp->syminf->value.elements[0]);
 }
 
 static void display_return(node *tree, node *left, node *right, value v)
+/* display the returned value of a node (for tracing purposes) */
 {
     if (verbose >= DEBUG_ALLOCATE)
     {
@@ -159,10 +123,10 @@ static value cupl_eval(node *tree)
        return(result);
 
     case WRITE:
-       needspace(0);
+       cupl_reset_write(0);
        for_cdr(np, tree)
-           cupl_write(np->car);
-       needspace(-1);
+           eval_write(np->car);
+       cupl_eol_write();
        result.rank = FAIL;
        RETURN_WRAP(tree, tree->car, tree->cdr, result)
        return(result);
@@ -333,12 +297,11 @@ void execute(node *tree)
     else if (last)
        last->cdr = (node *)NULL;
 
-    /* now execute the program */
-
-    /* setjmp so we can use STOP to exit */
+    /* first, setjmp so we can use STOP to exit */
     if (setjmp(jmpbuf) != 0)
        return;
     else
+       /* now execute the program */
        for (pc = tree; pc; pc = next)
        {
            next = pc->cdr;