Patch Tuesday - D

arty.c

@@ -1,7 +1,7 @@
 /*
     module  : arty.c
-    version : 1.13
-    date    : 03/21/24
+    version : 1.14
+    date    : 04/11/24
 */
 #include "globals.h"
 
@@ -51,10 +51,7 @@ int arity(pEnv env, NodeList *quot, int num)
 	case USR_:
 	    return -1;				/* assume too difficult */
 	case ANON_FUNCT_:
-	    if (env->bytecoding || env->compiling)
-		str = operarity(node.u.ent);
-	    else
-		str = operarity(operindex(env, node.u.proc));
+	    str = operarity(operindex(env, node.u.proc));
 	    for (; *str; str++)
 		if (*str == 'A')		/* add */
 		    num++;

eval.c

@@ -1,7 +1,7 @@
 /*
  *  module  : eval.c
- *  version : 1.19
- *  date    : 03/21/24
+ *  version : 1.20
+ *  date    : 04/11/24
  */
 #include "globals.h"
 
@@ -37,9 +37,9 @@ static void trace(pEnv env, FILE *fp)
 }
 
 /*
- * Execute program, as long as it is not empty.
+ * Evaluate program, as long as it is not empty.
  */
-void exeterm(pEnv env, NodeList *list)
+void evaluate(pEnv env, NodeList *list)
 {
     Node node;
     Entry ent;
@@ -54,7 +54,7 @@ void exeterm(pEnv env, NodeList *list)
 #if ALARM
 	if (time_out) {
 	    time_out = 0;
-	    execerror(env->filename, "more time", "exeterm");
+	    execerror(env->filename, "more time", "evaluate");
 	}
 #endif
 	if (env->debugging)
@@ -67,26 +67,19 @@ void exeterm(pEnv env, NodeList *list)
 		prog(env, ent.u.body);
 	    else if (env->undeferror)
 		execerror(env->filename, "definition", ent.name);
-	    break;
+	    continue;
 	case ANON_FUNCT_:
-	    if (env->bytecoding || env->compiling) {
-		ent = vec_at(env->symtab, node.u.ent);
-		(*ent.u.proc)(env);
-	    } else
-		(*node.u.proc)(env);
+	    (*node.u.proc)(env);
 	    env->opers++;
-	    break;
+	    continue;
 	case USR_PRIME_:
 	    node.op = USR_;
-	    goto next;
+	    break;
 	case ANON_PRIME_:
 	    node.op = ANON_FUNCT_;
-	    goto next;
-next:
-default:
-	    env->stck = pvec_add(env->stck, node);
 	    break;
 	}
+	env->stck = pvec_add(env->stck, node);
     }
     if (env->debugging)
 	trace(env, stdout);	/* final stack */

exec.c

@@ -1,7 +1,7 @@
 /*
  *  module  : exec.c
- *  version : 1.6
- *  date    : 03/21/24
+ *  version : 1.7
+ *  date    : 04/11/24
  */
 #include "globals.h"
 
@@ -15,17 +15,11 @@ void execute(pEnv env, NodeList *list)
 
 #ifdef BYTECODE
     if (env->bytecoding == 1) {
-	bytecode(list);
+	bytecode(env, list);
 	return;
     }
 #endif
-#ifdef COMPILER
-    if (env->compiling == 1) {
-	compileprog(env, list);
-	return;
-    }
-#endif
-    exeterm(env, list);
+    evaluate(env, list);
     if (pvec_cnt(env->stck)) {
 	if (env->autoput == 2)
 	    writeterm(env, env->stck, stdout);

globals.h

@@ -1,7 +1,7 @@
 /*
     module  : globals.h
-    version : 1.41
-    date    : 03/25/24
+    version : 1.42
+    date    : 04/11/24
 */
 #ifndef GLOBALS_H
 #define GLOBALS_H
@@ -220,7 +220,6 @@ typedef struct Env {
     unsigned char autoput;	/* options */
     unsigned char autoput_set;
     unsigned char echoflag;
-    unsigned char echoflag_set;
     unsigned char tracegc;
     unsigned char undeferror;
     unsigned char undeferror_set;
@@ -243,12 +242,15 @@ typedef struct table_t {
 /* arty.c */
 int arity(pEnv env, NodeList *quot, int num);
 /* comp.c */
-void initcompile(pEnv env, char *file);
+void initcompile(pEnv env);
+void exitcompile(pEnv env);
 void compileprog(pEnv env, NodeList *list);
 /* eval.c */
-void exeterm(pEnv env, NodeList *list);
+void evaluate(pEnv env, NodeList *list);
 /* exec.c */
 void execute(pEnv env, NodeList *list);
+/* exeterm.c */
+void exeterm(pEnv env, NodeList *list);
 /* lexr.l */
 void new_buffer(void);
 void old_buffer(int num);
@@ -312,15 +314,15 @@ void execerror(char *filename, char *message, char *op);
 /* ylex.c */
 int yylex(pEnv env);
 /* byte.c */
-void initbytes(pEnv env, char *file);
-void bytecode(NodeList *list);
+void initbytes(pEnv env);
+void bytecode(pEnv env, NodeList *list);
 void exitbytes(pEnv env);
 /* code.c */
-void readbytes(pEnv env);
+void readbytes(pEnv env, int flag);
 /* dump.c */
 void dumpbytes(pEnv env);
 /* optm.c */
-void rewritebic(char *file);
+void rewritebic(pEnv env);
 /* kraw.c */
 void SetRaw(pEnv env);
 #endif

lib/fib.joy

@@ -1 +1 @@
-40 [small] [] [pred dup pred] [+] binrec.
+14 [small] [] [pred dup pred] [+] binrec.

lib/grmlib.joy

@@ -30,7 +30,7 @@ HIDE
     show-put ==
 	pop put newline pop;
     show-put-step ==
-	pop [put] step newline pop;
+	pop [put space] step newline pop;
     show-putchars-step ==
 	pop [putchars] step newline pop;
     show-putchars-sp-step ==
@@ -132,7 +132,7 @@ HIDE
     parse-string-residues ==
 	pop [ succ dup put ": " putchars ] dip [putch] step newline;
     parse-list-residues ==
-	pop [ succ dup put ": " putchars ] dip [put] step newline;
+	pop [ succ dup put ": " putchars ] dip [put space] step newline;
     parse-test == pop pop true or;
     parse-count == # "count" put stack putln
 		 pop pop succ;

lib/grmtst.joy

@@ -2,15 +2,6 @@
 
 "\ntesting the grammar library in file  grmlib.joy\n\n" putchars.
 
-(*
-DEFINE old_in == in;
-           in == [[string] [pop false]] dip [old_in] cons ifte.
-*)
-(*
-DEFINE old_in == in;
-           in == _in.
-*)
-
 "grmlib" libload.
 0 __settracegc.
 1 setecho.

lib/jp-joyjoy.joy

@@ -81,7 +81,7 @@ joy0s  ==  (* joy0 with short trace *)
 
 joy0l  == (* joy0 with long trace *)
     newline "joy0l :" putchars newline
-    [ dup put (* long trace *)
+    [ dup put space (* long trace *)
       [ [ joy0l		body		joy0l	 ]
 	[ []				 	 ]
 	[ pop		pop		pop	 ]

lib/reptst.joy

@@ -173,11 +173,11 @@ DEFINE
     steps == "steps: " putchars state putln;
     trace == "trace: " putchars state putln.
 
-3 4 5  fact-fix   i swap put i swap put i swap putln pop.
+3 4 5  fact-fix   i swap put space i swap put space i swap putln pop.
 
-3 4 5  fact-fix-c i swap put i swap put i swap putln steps.
+3 4 5  fact-fix-c i swap put space i swap put space i swap putln steps.
 
-3 4 5  fact-fix-a i swap put i swap put i swap putln trace.
+3 4 5  fact-fix-a i swap put space i swap put space i swap putln trace.
 
 DEFINE
     nfib ==
@@ -218,11 +218,11 @@ DEFINE
 
 4 fact-fix i pop.
 
-[2 5 3 7 6] [a b c] length-fix-a i swap put i swap putln trace.
+[2 5 3 7 6] [a b c] length-fix-a i swap put space i swap putln trace.
 
 6 nfib-fix i pop.
 
-6 nfib-bin [] [[dup put] dip] rep.fix-i i newline pop.
+6 nfib-bin [] [[dup put space] dip] rep.fix-i i newline pop.
 
 DEFINE
     qsort-bin == [small] [] [uncons [>] split] [enconcat] rep.binary;

lib/tutlib.joy

@@ -42,8 +42,8 @@ LIBRA
 	0 0 ;
     put-stats ==
 	"You answered " putchars [put] dip
-	"of the " putchars put
-	"questions correctly.\n\n" putchars;
+	" of the " putchars put
+	" questions correctly.\n\n" putchars;
 
 (* the following assume a "Table Of Contents" definition of the form
 	toc-of-tutorial == [ [ [Q0] "Title" ]