Patch Tuesday - E

eval.c

@@ -1,7 +1,7 @@
 /*
  *  module  : eval.c
- *  version : 1.20
- *  date    : 04/11/24
+ *  version : 1.22
+ *  date    : 04/26/24
  */
 #include "globals.h"
 
@@ -25,7 +25,7 @@ static void set_alarm(int num)
 }
 #endif
 
-static void trace(pEnv env, FILE *fp)
+void trace(pEnv env, FILE *fp)
 {
     writestack(env, env->stck, fp);
     if (env->debugging == 2) {
@@ -54,7 +54,7 @@ void evaluate(pEnv env, NodeList *list)
 #if ALARM
 	if (time_out) {
 	    time_out = 0;
-	    execerror(env->filename, "more time", "evaluate");
+	    execerror("more time", "evaluate");
 	}
 #endif
 	if (env->debugging)
@@ -66,7 +66,7 @@ void evaluate(pEnv env, NodeList *list)
 	    if (ent.u.body)
 		prog(env, ent.u.body);
 	    else if (env->undeferror)
-		execerror(env->filename, "definition", ent.name);
+		execerror("definition", ent.name);
 	    continue;
 	case ANON_FUNCT_:
 	    (*node.u.proc)(env);

globals.h

@@ -1,7 +1,7 @@
 /*
     module  : globals.h
-    version : 1.42
-    date    : 04/11/24
+    version : 1.46
+    date    : 05/02/24
 */
 #ifndef GLOBALS_H
 #define GLOBALS_H
@@ -127,6 +127,7 @@ typedef enum {
 typedef enum {
     ABORT_NONE,
     ABORT_RETRY,
+    ABORT_ERROR,
     ABORT_QUIT
 } Abort;
 
@@ -188,6 +189,7 @@ KHASH_MAP_INIT_INT64(Funtab, int)
  * Global variables are stored locally in the main function.
  */
 typedef struct Env {
+    jmp_buf finclude;		/* return point in finclude */
     double calls;		/* statistics */
     double opers;
     vector(Token) *tokens;	/* read ahead table */
@@ -231,6 +233,7 @@ typedef struct Env {
     unsigned char overwrite;
     unsigned char printing;
     unsigned char recurse;
+    unsigned char finclude_busy;
 } Env;
 
 typedef struct table_t {
@@ -246,6 +249,7 @@ void initcompile(pEnv env);
 void exitcompile(pEnv env);
 void compileprog(pEnv env, NodeList *list);
 /* eval.c */
+void trace(pEnv env, FILE *fp);
 void evaluate(pEnv env, NodeList *list);
 /* exec.c */
 void execute(pEnv env, NodeList *list);
@@ -258,8 +262,6 @@ int my_yylex(pEnv env);
 int get_input(void);
 /* main.c */
 void abortexecution_(int num);
-void stats(pEnv env);
-void dump(pEnv env);
 /* modl.c */
 void savemod(int *hide, int *modl, int *hcnt);
 void undomod(int hide, int modl, int hcnt);
@@ -299,7 +301,7 @@ void save(pEnv env, NodeList *list, int num, int remove);
 /* scan.c */
 void inilinebuffer(pEnv env);
 void include(pEnv env, char *str);
-int yywrap(void);
+int my_yywrap(pEnv env);	/* yywrap replacement */
 void my_error(char *str, YYLTYPE *bloc);
 void yyerror(pEnv env, char *str);
 /* util.c */
@@ -310,7 +312,7 @@ void writefactor(pEnv env, Node node, FILE *fp);
 void writeterm(pEnv env, NodeList *list, FILE *fp);
 void writestack(pEnv env, NodeList *list, FILE *fp);
 /* xerr.c */
-void execerror(char *filename, char *message, char *op);
+void execerror(char *message, char *op);
 /* ylex.c */
 int yylex(pEnv env);
 /* byte.c */

lexr.l

@@ -1,22 +1,26 @@
 %{
 /*
     module  : lexr.l
-    version : 1.31
-    date    : 03/22/24
+    version : 1.33
+    date    : 05/06/24
 */
 #include "globals.h"
 
 #define YY_DECL		int my_yylex(pEnv env)
+#define YY_NO_INPUT
 #define YY_NO_UNPUT
+#define YY_SKIP_YYWRAP
+
+#define yywrap()	my_yywrap(env)
 
 #define OUT_OF_COM	0
 #define WITHIN_COM	1
 #define LEAVE_COMM	2
 #define MAX_FILLER	3	/* allow max. three empty lines */
 
 char line[INPLINEMAX + 1];
-static int linenum, linepos;
 
+static int linenum, linepos;
 static int include_stack_ptr;
 static YY_BUFFER_STATE include_stack[INPSTACKMAX];
 
@@ -155,11 +159,3 @@ INLINE[ \t]*	return CONST_;
 .		return yytext[0];
 
 %%
-
-/*
- * Supporting getch, reading from the stack of input files, like get.
- */
-int get_input(void)
-{
-    return input();
-}

main.c

@@ -1,30 +1,34 @@
 /*
  *  module  : main.c
- *  version : 1.38
- *  date    : 04/11/24
+ *  version : 1.44
+ *  date    : 05/06/24
  */
 #include "globals.h"
 
 extern FILE *yyin;			/* lexr.c */
 
+static jmp_buf begin;			/* restart with empty program */
+
 char *bottom_of_stack;			/* used in gc.c */
 
-static jmp_buf begin;			/* restart with empty program */
+static void stats(pEnv env);
+static void dump(pEnv env);
 
 /*
  * abort execution and restart reading from yyin. In the NOBDW version the
  * stack is cleared as well.
  */
 void abortexecution_(int num)
 {
+    fflush(stdin);
     longjmp(begin, num);
 }
 
 /*
  * options - print help on startup options and exit: options are those that
  *	     cannot be set from within the language itself.
  */
-void options(pEnv env)
+static void options(pEnv env)
 {
     printf("JOY  -  compiled at %s on %s", __TIME__, __DATE__);
 #ifdef VERS
@@ -71,7 +75,7 @@ void options(pEnv env)
 #if 0
     printf("  -q : operate in quiet mode\n");
 #endif
-    printf("  -r : recurse w/o using the call stack\n");
+    printf("  -r : print without using recursion\n");
     printf("  -s : dump symbol table after execution\n");
     printf("  -t : print a trace of program execution\n");
     printf("  -u : set the undeferror flag (0,1)\n");
@@ -88,7 +92,7 @@ void options(pEnv env)
 #endif
 }
 
-void unknown_opt(pEnv env, char *exe, int ch)
+static void unknown_opt(pEnv env, char *exe, int ch)
 {
     printf("Unknown option argument: \"-%c\"\n", ch);
     printf("More info with: \"%s -h\"\n", exe);
@@ -211,7 +215,7 @@ int my_main(int argc, char **argv)
 #if 0
 		case 'v' : verbose = 0; break;
 #endif
-		case 'w' : env.overwrite = 0; break;
+		case 'w' : remove("joy.log"); env.overwrite = 0; break;
 		case 'x' : pstats = 1; break;
 #if YYDEBUG
 		case 'y' : yydebug = 1; break;
@@ -321,8 +325,8 @@ int my_main(int argc, char **argv)
      * initialize standard input and output.
      */
 #ifdef KEYBOARD
-    if (raw && strcmp(env.filename, "stdin")) {	/* filename required */
-	env.autoput = 0;		/* disable autoput */
+    if (raw && strcmp(env.filename, "stdin")) {	/* raw requires filename */
+	env.autoput = 0;		/* disable autoput and usrlib.joy */
 	env.autoput_set = 1;		/* prevent enabling autoput */
 	SetRaw(&env);
     } else				/* keep output buffered */
@@ -334,8 +338,10 @@ int my_main(int argc, char **argv)
     if (mustinclude)
 	include(&env, "usrlib.joy");	/* start reading from library first */
     rv = setjmp(begin);			/* return here after error or abort */
-    if (rv == ABORT_QUIT || (rv && !joy))
-	goto einde;
+    if (rv == ABORT_ERROR && joy)	/* in case of a runtime error ...   */
+	trace(&env, stderr);		/* ... dump stack and (all of) code */
+    if (rv == ABORT_QUIT || (rv && !joy))	/* in case end of file ...  */
+	goto einde;				/* ... wrap up and exit     */
     /*
      * (re)initialize code.
      */
@@ -376,7 +382,7 @@ int main(int argc, char **argv)
 /*
  * print statistics.
  */
-void stats(pEnv env)
+static void stats(pEnv env)
 {
     printf("%.0f milliseconds CPU\n", (clock() - env->startclock) * 1000.0 /
 	   CLOCKS_PER_SEC);
@@ -390,7 +396,7 @@ void stats(pEnv env)
 /*
  * dump the symbol table, from last to first.
  */
-void dump(pEnv env)
+static void dump(pEnv env)
 {
     int i;
     Entry ent;

modl.c

@@ -1,7 +1,7 @@
 /*
     module  : modl.c
-    version : 1.7
-    date    : 03/21/24
+    version : 1.8
+    date    : 04/23/24
 */
 #include "globals.h"
 
@@ -20,7 +20,7 @@ static int module_index = -1;
 
 /*
  * savemod saves the global variables, to be restored later with undomod.
-*/
+ */
 void savemod(int *hide, int *modl, int *hcnt)
 {
     *hide = hide_index;
@@ -43,7 +43,7 @@ void initmod(pEnv env, char *name)
 {
     if (++module_index >= DISPLAYMAX) {
 	module_index = -1;
-	execerror(env->filename, "index", "display");
+	execerror("index", "display");
     }
     env->module_stack[module_index].name = name;
     env->module_stack[module_index].hide = hide_index;
@@ -62,7 +62,7 @@ void initpriv(pEnv env)
 {
     if (++hide_index >= DISPLAYMAX) {
 	hide_index = -1;
-	execerror(env->filename, "index", "display");
+	execerror("index", "display");
     }
     env->hide_stack[hide_index] = ++hide_count;
     inside_hide = 1;
@@ -117,6 +117,9 @@ char *classify(pEnv env, char *name)
     size_t leng;
     char temp[MAXNUM], *buf = 0, *str;
 
+    /*
+     * if name already has a prefix, there is no need to add another one.
+     */
     if (strchr(name, '.'))
 	return name;
     /*