Patch Tuesday - M

doc/JOYimplJOY.md

@@ -25,10 +25,10 @@ this version: JOY  -  compiled at 16:57:51 on Mar 17 2003.
 - The user manual has been updated with annotations, documenting some of the
   above.
 
-Stating that this repository differs slightly from the legacy version is a bit
-of an understatement. All source files have been modified. The statement is
-true w.r.t. the language. The aim of this repository is to not change the
-language.
+Stating that this repository differs slightly from the legacy version is
+somewhat of an understatement. All source files have been modified. The
+statement is true w.r.t. the language. The aim of this repository is to
+not change the language, while still allowing some development.
 
 Roadmap
 =======
@@ -47,8 +47,8 @@ be used and in that case the language is still the same as it was in 2003.
 Compiler
 --------
 
-There is some conditional compilation, activated by -DBYTECODE or -DCOMPILER
-that adds the option to compile Joy source code to bytecode or C.
+There is some conditional compilation, activated with -DBYTECODE or -DCOMPILER
+that adds the option to compile Joy source code to bytecode or to C.
 
 At this moment there are no repositories with Joy source code that could
 benefit from such compilation and because of that, these options are not
@@ -57,8 +57,8 @@ activated.
 When activated, they will only be available for joy1 and Moy, not Joy, due to
 the incompatible Node type of Joy.
 
-Bignum
-------
+Bignums
+-------
 
 There is also a bignum type, but no big numbers. There is no application yet
 that would need them.

globals.h

@@ -1,12 +1,16 @@
 /* FILE: globals.h */
 /*
  *  module  : globals.h
- *  version : 1.116
- *  date    : 10/11/24
+ *  version : 1.117
+ *  date    : 10/28/24
  */
 #ifndef GLOBALS_H
 #define GLOBALS_H
 
+#ifdef MALLOC_DEBUG
+#include "rmalloc.h"
+#endif
+
 /* #define USE_KHASHL */
 
 #include <stdio.h>

interp.c

@@ -1,8 +1,8 @@
 /* FILE: interp.c */
 /*
  *  module  : interp.c
- *  version : 1.85
- *  date    : 10/11/24
+ *  version : 1.86
+ *  date    : 10/18/24
  */
 
 /*
@@ -33,6 +33,7 @@
 	 fputstring (== fputchars for Heiko Kuhrt's program)
 */
 #include "globals.h"
+#include "builtin.h"
 
 static void writestack(pEnv env, Index n)
 {
@@ -209,6 +210,13 @@ void exeterm(pEnv env, Index n)
 		ent = vec_at(env->symtab, index);
 		ent.cflags |= IS_USED;
 		vec_at(env->symtab, index) = ent;
+		/*
+		 * An exception needs to be made for dup_ in case the stack
+		 * contains a list.
+		 */
+		if (env->stck && nodetype(env->stck) == LIST_ &&
+				ent.u.proc == dup_)
+		    nofun = 1;
 		/*
 		 * Functions that cannot be evaluated at compile time
 		 * are sent to output. There is no need for a nickname.

macros.h

@@ -1,7 +1,7 @@
 /*
  *  module  : macros.h
- *  version : 1.1
- *  date    : 10/11/24
+ *  version : 1.2
+ *  date    : 10/18/24
  */
 #define POP(X) X = nextnode1(X)
 
@@ -43,3 +43,13 @@
     env->stck = newnode2(env, NODE, nextnode2(env->stck))
 #define GTERNARY(NODE)							\
     env->stck = newnode2(env, NODE, nextnode3(env->stck))
+
+/*
+ * Strings are stored in consecutive nodes in the NOBDW version; the BDW
+ * version stores them somewhere else.
+ */
+#ifdef NOBDW
+#define GETSTRING(NODE)		(char *)&nodevalue(NODE)
+#else
+#define GETSTRING(NODE)		nodevalue(NODE).str
+#endif

main.c

@@ -1,8 +1,8 @@
 /* FILE: main.c */
 /*
  *  module  : main.c
- *  version : 1.107
- *  date    : 10/11/24
+ *  version : 1.108
+ *  date    : 10/28/24
  */
 
 /*
@@ -121,6 +121,9 @@ static jmp_buf begin;		/* restart with empty program */
 char *bottom_of_stack;		/* needed in gc.c */
 
 static void stats(pEnv env), dump(pEnv env);
+#ifdef MALLOC_DEBUG
+static void mem_free(pEnv env);
+#endif
 
 void printcandidates(pEnv env);
 
@@ -494,6 +497,9 @@ static void my_main(int argc, char **argv)
 	stats(&env);
     if (psdump)
 	dump(&env);
+#ifdef MALLOC_DEBUG
+    mem_free(&env);
+#endif
 }
 
 int main(int argc, char **argv)
@@ -556,3 +562,25 @@ static void dump(pEnv env)
 	}
     }
 }
+
+#ifdef MALLOC_DEBUG
+static void mem_free(pEnv env)
+{
+    int i, j;
+    Entry ent;
+
+    /*
+     * The strings in the symbol table have been moved to permanent memory.
+     * They need to be released explicitly.
+     */
+    for (i = tablesize(), j = vec_size(env->symtab); i < j; i++) {
+	ent = vec_at(env->symtab, i);
+	free(ent.name);
+    }
+#ifdef NOBDW
+    free(env->memory);
+#endif
+    kh_destroy(Symtab, env->hash);
+    kh_destroy(Funtab, env->prim);
+}
+#endif

src/argc.c

@@ -1,15 +1,15 @@
 /*
     module  : argc.c
-    version : 1.6
-    date    : 09/26/24
+    version : 1.7
+    date    : 10/24/24
 */
 #ifndef ARGC_C
 #define ARGC_C
 
 /**
 Q0  OK  3050  argc  :  ->  I
 [RUNTIME] Pushes the number of command line arguments.
-This is quivalent to 'argv size'.
+This is equivalent to 'argv size'.
 */
 PUSH(argc_, INTEGER_NEWNODE, env->g_argc)
 

src/compare.h

@@ -1,7 +1,7 @@
 /*
     module  : compare.h
-    version : 1.21
-    date    : 09/17/24
+    version : 1.22
+    date    : 10/18/24
 */
 #ifndef COMPARE_H
 #define COMPARE_H
@@ -59,11 +59,7 @@ int Compare(pEnv env, Index first, Index second)
 	    goto cmpstr;
 	case STRING_:
 	case BIGNUM_:
-#ifdef NOBDW
-	    name2 = (char *)&nodevalue(second);
-#else
-	    name2 = nodevalue(second).str;
-#endif
+	    name2 = GETSTRING(second);
 	    goto cmpstr;
 	}
 	break;
@@ -78,11 +74,7 @@ int Compare(pEnv env, Index first, Index second)
 	    goto cmpstr;
 	case STRING_:
 	case BIGNUM_:
-#ifdef NOBDW
-	    name2 = (char *)&nodevalue(second);
-#else
-	    name2 = nodevalue(second).str;
-#endif
+	    name2 = GETSTRING(second);
 	    goto cmpstr;
 	}
 	break;
@@ -147,11 +139,7 @@ int Compare(pEnv env, Index first, Index second)
 	break;
     case STRING_:
     case BIGNUM_:
-#ifdef NOBDW
-	name1 = (char *)&nodevalue(first);
-#else
-	name1 = nodevalue(first).str;
-#endif
+	name1 = GETSTRING(first);
 	switch (type2) {
 	case USR_:
 	    name2 = vec_at(env->symtab, nodevalue(second).ent).name;
@@ -161,11 +149,7 @@ int Compare(pEnv env, Index first, Index second)
 	    goto cmpstr;
 	case STRING_:
 	case BIGNUM_:
-#ifdef NOBDW
-	    name2 = (char *)&nodevalue(second);
-#else
-	    name2 = nodevalue(second).str;
-#endif
+	    name2 = GETSTRING(second);
 	    goto cmpstr;
 	}
 	break;

src/drop.c

@@ -1,7 +1,7 @@
 /*
     module  : drop.c
-    version : 1.12
-    date    : 09/17/24
+    version : 1.15
+    date    : 10/28/24
 */
 #ifndef DROP_C
 #define DROP_C
@@ -33,15 +33,12 @@ void drop_(pEnv env)
 	UNARY(SET_NEWNODE, set);
 	break;
     case STRING_:
-#ifdef NOBDW
-	str = strdup((char *)&nodevalue(env->stck));
-#else
-	str = nodevalue(env->stck).str;
-#endif
+	str = GETSTRING(env->stck);
 	while (n-- > 0 && str[i])
 	    i++;
 #ifdef NOBDW
-	UNARY(STRING_NEWNODE, str + i);
+	str = strdup(str + i);
+	UNARY(STRING_NEWNODE, str);
 	free(str);
 #else
 	UNARY(STRING_NEWNODE, GC_strdup(str + i));

src/fgets.c

@@ -1,7 +1,7 @@
 /*
     module  : fgets.c
-    version : 1.9
-    date    : 09/20/24
+    version : 1.10
+    date    : 10/28/24
 */
 #ifndef FGETS_C
 #define FGETS_C
@@ -30,8 +30,9 @@ void fgets_(pEnv env)
 	if ((leng = strlen(buf)) > 0 && buf[leng - 1] == '\n')
 	    break;
 #ifdef NOBDW
-	if ((tmp = realloc(buf, size <<= 1)) != 0)
-	    buf = tmp;
+	if ((tmp = realloc(buf, size <<= 1)) == 0)
+	    break;	/* LCOV_EXCLUDE_LINE */
+	buf = tmp;
 #else
 	buf = GC_realloc(buf, size <<= 1);
 #endif

src/filetime.c

@@ -1,7 +1,7 @@
 /*
     module  : filetime.c
-    version : 1.9
-    date    : 09/17/24
+    version : 1.11
+    date    : 10/28/24
 */
 #ifndef FILETIME_C
 #define FILETIME_C
@@ -21,17 +21,19 @@ void filetime_(pEnv env)
 
     ONEPARAM("filetime");
     STRING("filetime");
-#ifdef NOBDW
-    str = (char *)&nodevalue(env->stck);
-#else
-    str = nodevalue(env->stck).str;
-#endif
+    str = GETSTRING(env->stck);
     mtime = 0;
     if ((fp = fopen(str, "r")) != 0) {
+#ifdef NOBDW
 	buf = malloc(sizeof(struct stat));
+#else
+	buf = GC_malloc_atomic(sizeof(struct stat));
+#endif
 	if (fstat(fileno(fp), buf) >= 0)
 	    mtime = buf->st_mtime;
+#ifdef NOBDW
 	free(buf);
+#endif
 	fclose(fp);
     }
     UNARY(INTEGER_NEWNODE, mtime);

src/finclude.c

@@ -1,7 +1,7 @@
 /*
     module  : finclude.c
-    version : 1.16
-    date    : 10/11/24
+    version : 1.17
+    date    : 10/18/24
 */
 #ifndef FINCLUDE_C
 #define FINCLUDE_C
@@ -18,11 +18,7 @@ void finclude_(pEnv env)
 
     ONEPARAM("finclude");
     STRING("finclude");
-#ifdef NOBDW
-    str = (char *)&nodevalue(env->stck);/* read file name */
-#else
-    str = nodevalue(env->stck).str;	/* read file name */
-#endif
+    str = GETSTRING(env->stck);		/* read file name */
     POP(env->stck);			/* remove file name from stack */
     if (include(env, str))		/* include new file */
 	return;