Patch Tuesday - A

.gitignore

@@ -1,11 +1,5 @@
 joy.exe
 joy1.tar
-CMakeCache.txt
-CMakeFiles
-Makefile
-cmake_install.cmake
-*.o
 builtin.*
 table.c
-test/test
-test2/test
+bdwgc

CMakeLists.txt

@@ -1,30 +1,45 @@
 #
 #   module  : CMakeLists.txt
-#   version : 1.20
-#   date    : 10/02/23
+#   version : 1.24
+#   date    : 01/25/24
 #
 cmake_minimum_required(VERSION 3.0)
 project(Joy VERSION 1.0)
 if("${CMAKE_BUILD_TYPE}" STREQUAL "")
   set(CMAKE_BUILD_TYPE "Release")
 endif()
-option(RUN_TESTS "Run standard tests" OFF)
-add_definitions(-DCOPYRIGHT -DJVERSION="BDW ${CMAKE_BUILD_TYPE} ${CMAKE_PROJECT_VERSION}")
-add_executable(joy interp.c scan.c utils.c main.c factor.c module.c)
-add_dependencies(joy always)
-add_custom_target(always
-		  WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}
-		  COMMAND sh table.sh .
-		  COMMAND sh prims.sh .)
+if("${CMAKE_BUILD_TYPE}" STREQUAL "Debug")
+  option(RUN_TESTS "Run standard tests" ON)
+else()
+  option(RUN_TESTS "Run standard tests" OFF)
+endif()
+add_executable(joy main.c interp.c scan.c utils.c factor.c module.c)
+add_definitions(-DLINK="\\"${CMAKE_EXE_LINKER_FLAGS}\\"")
+add_definitions(-DVERS="BDW ${CMAKE_BUILD_TYPE} ${CMAKE_PROJECT_VERSION}")
+#
+#    MSVC: cmake --build . --config Release
+#
 if(CMAKE_CXX_COMPILER_ID MATCHES "MSVC")
-  add_definitions(-DGC_NOT_DLL -D_CRT_SECURE_NO_WARNINGS)
-  target_link_libraries(joy gc-lib)
+  set(CMAKE_VERBOSE_MAKEFILE ON)
+  set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -DCOPYRIGHT -DGC_NOT_DLL -D_CRT_SECURE_NO_WARNINGS")
+  add_definitions(-DCOMP="\\"${CMAKE_C_FLAGS}\\"")
+  target_link_libraries(joy bdwgc/Release/gc)
   include_directories(bdwgc/include)
   add_subdirectory(bdwgc)
 else()
-  if("${CMAKE_BUILD_TYPE}" STREQUAL "Debug")
-    set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -g -O0 --coverage -fprofile-arcs -ftest-coverage") # debug, no optimization
+  add_dependencies(joy always)
+  add_custom_target(always
+		    WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}
+		    COMMAND sh table.sh .
+		    COMMAND sh prims.sh .)
+  set(CF "-DCOPYRIGHT -Wall -Wextra -Wpedantic -Werror -Wno-unused-parameter")
+  if("${CMAKE_BUILD_TYPE}" STREQUAL "Release")
+    set(CMAKE_C_FLAGS_RELEASE "${CMAKE_C_FLAGS_RELEASE} ${CF}")
+    add_definitions(-DCOMP="\\"${CMAKE_C_FLAGS_RELEASE}\\"")
+  else()
+    set(CMAKE_C_FLAGS_DEBUG "${CMAKE_C_FLAGS_DEBUG} ${CF} -g -O0 --coverage -fprofile-arcs -ftest-coverage") # debug, no optimization
     set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} --coverage") # enabling coverage
+    add_definitions(-DCOMP="\\"${CMAKE_C_FLAGS_DEBUG}\\"")
   endif()
   target_link_libraries(joy m gc)
   if(RUN_TESTS)

README.md

@@ -5,36 +5,40 @@ Build|Linux|Windows|Coverity
 ---|---|---|---
 status|[![GitHub CI build status](https://github.com/Wodan58/joy1/actions/workflows/cmake.yml/badge.svg)](https://github.com/Wodan58/joy1/actions/workflows/cmake.yml)|[![AppVeyor CI build status](https://ci.appveyor.com/api/projects/status/github/Wodan58/joy1?branch=master&svg=true)](https://ci.appveyor.com/project/Wodan58/joy1)|[![Coverity Scan Build Status](https://img.shields.io/coverity/scan/14633.svg)](https://scan.coverity.com/projects/wodan58-joy1)
 
-This is the BDW version of [Joy](https://github.com/Wodan58/Joy). The two
-versions are drifting apart.
-
-Changes
--------
-
-Changes are documented in the `doc` directory.
-It is always possible to extract an up-to-date version of the manual:
-
-    echo '__html_manual.' | build/joy | lynx -stdin
-
-The lynx browser even adds some color.
-The original version can be seen [here](https://github.com/Wodan58/joy0).
+This is the [BDW](https://github.com/ivmai/bdwgc) version of
+[Joy](https://github.com/Wodan58/Joy).
 
 Build instructions
 ------------------
 
-Build with the [BDW garbage collector](https://github.com/ivmai/bdwgc):
-
     cd build
-    SOURCE_DATE_EPOCH=1047920271 cmake ..
+    cmake ..
     cmake --build .
 
-There is a customized version of usrlib.joy waiting in the build directory.
+Build with MSVC
+---------------
+
+After installing bdwgc in the bdwgc-directory use the CMake GUI to uncheck all
+boxes and then check the boxes in the lines that start with disable\_ and
+check the last one: without\_libatomic\_ops.
+
+    cd build
+    cmake ..
+    cmake --build . --config Release
+    copy Release\joy.exe
+
+Running
+-------
+
+There is a copy of usrlib.joy in the build directory.
 
 See also
 --------
 
 Implementation|Dependencies
 --------------|------------
+[42minjoy](https://github.com/Wodan58/42minjoy)|
+[joy0](https://github.com/Wodan58/joy0)|
 [Joy](https://github.com/Wodan58/Joy)|
 [Moy](https://github.com/Wodan58/Moy)|[BDW garbage collector](https://github.com/ivmai/bdwgc) and [Lex & Yacc](https://sourceforge.net/projects/winflexbison/files/win_flex_bison-latest.zip)
 

build/usrlib.joy

@@ -63,12 +63,12 @@ END.						(* end HIDE and LIBRA *)
 
 "usrlib  is loaded\n"  putchars.
 
-standard-setting.
+# standard-setting.
 
 "../lib/inilib.joy" include.
 				(* assuming inilib.joy was included:  *)
 "agglib" libload.
 
-DEFINE verbose == true. (* Example of over-riding  inilib.joy *)
+DEFINE verbose == true. 	(* Example of over-riding  inilib.joy *)
 
 (* END  usrlib.joy *)

factor.c

@@ -1,16 +1,17 @@
 /* FILE: factor.c */
 /*
  *  module  : factor.c
- *  version : 1.24
- *  date    : 11/06/23
+ *  version : 1.27
+ *  date    : 01/26/24
  */
 #include "globals.h"
 
 /*
     readfactor - read a factor from srcfile and push it on the stack.
 		 In case of LPAREN nothing gets pushed.
+		 The return value: success=1, failure=0.
 */
-PUBLIC void readfactor(pEnv env) /* read a JOY factor */
+PUBLIC int readfactor(pEnv env) /* read a JOY factor */
 {
     Entry ent;
     uint64_t set = 0;
@@ -20,7 +21,7 @@ PUBLIC void readfactor(pEnv env) /* read a JOY factor */
 	lookup(env);
 	if (!env->location && strchr(env->yylval.str, '.')) {
 	    error(env, "no such field in module");
-	    return;
+	    return 0;
 	}
 	ent = vec_at(env->symtab, env->location);
 	/* execute immediate functions at compile time */
@@ -33,14 +34,14 @@ PUBLIC void readfactor(pEnv env) /* read a JOY factor */
 	    env->yylval.proc = ent.u.proc;
 	    env->stck = newnode(env, ANON_FUNCT_, env->yylval, env->stck);
 	}
-	return;
+	return 1;
     case BOOLEAN_:
     case CHAR_:
     case INTEGER_:
     case STRING_:
     case FLOAT_:
 	env->stck = newnode(env, env->symb, env->yylval, env->stck);
-	return;
+	return 1;
     case LBRACE:
 	while (getsym(env), env->symb <= ATOM)
 	    if ((env->symb != CHAR_ && env->symb != INTEGER_)
@@ -52,20 +53,22 @@ PUBLIC void readfactor(pEnv env) /* read a JOY factor */
 	env->stck = newnode(env, SET_, env->bucket, env->stck);
 	if (env->symb != RBRACE)
 	    error(env, "'}' expected");
-	return;
+	return 1;
     case LBRACK:
 	getsym(env);
 	readterm(env);
 	if (env->symb != RBRACK)
 	    error(env, "']' expected");
-	return;
+	return 1;
     case LPAREN:
 	error(env, "'(' not implemented");
 	getsym(env);
-	return;
+	return 0;
     default:
 	error(env, "a factor cannot begin with this symbol");
+	return 0;
     }
+    return 0;
 }
 
 /*
@@ -77,16 +80,14 @@ PUBLIC void readterm(pEnv env)
     env->bucket.lis = 0;
     env->stck = newnode(env, LIST_, env->bucket, env->stck);
     if (env->symb <= ATOM) {
-	readfactor(env);
-	if (env->stck) {
+	if (readfactor(env)) {
 	    nodevalue(nextnode1(env->stck)).lis = env->stck;
 	    env->stck = nextnode1(env->stck);
 	    nextnode1(nodevalue(env->stck).lis) = 0;
 	    env->dump = newnode(env, LIST_, nodevalue(env->stck), env->dump);
 	}
 	while (getsym(env), env->symb <= ATOM) {
-	    readfactor(env);
-	    if (env->stck) {
+	    if (readfactor(env)) {
 		nextnode1(nodevalue(env->dump).lis) = env->stck;
 		env->stck = nextnode1(env->stck);
 		nextnode2(nodevalue(env->dump).lis) = 0;
@@ -108,8 +109,7 @@ PUBLIC void readterm(pEnv env)
     env->stck = newnode(env, LIST_, env->bucket, env->stck);
     dump = &nodevalue(env->stck).lis;
     while (env->symb <= ATOM) {
-	readfactor(env);
-	if (env->stck) {
+	if (readfactor(env)) {
 	    *dump = env->stck;
 	    dump = &nextnode1(env->stck);
 	    env->stck = *dump;
@@ -126,8 +126,8 @@ PUBLIC void readterm(pEnv env)
 PUBLIC void writefactor(pEnv env, Index n, FILE *fp)
 {
     int i;
-    char *p;
-    uint64_t set;
+    uint64_t set, j;
+    char *ptr, buf[BUFFERMAX], tmp[BUFFERMAX];
 
 /*
     This cannot happen. Factor has a small number of customers: writeterm,
@@ -151,31 +151,40 @@ PUBLIC void writefactor(pEnv env, Index n, FILE *fp)
     case CHAR_:
 	if (nodevalue(n).num >= 8 && nodevalue(n).num <= 13)
 	    fprintf(fp, "'\\%c", "btnvfr"[nodevalue(n).num - 8]);
+	else if (iscntrl(nodevalue(n).num))
+	    fprintf(fp, "'\\%03d", (int)nodevalue(n).num);
 	else
 	    fprintf(fp, "'%c", (int)nodevalue(n).num);
 	return;
     case KEYWORD_:
+	putc('#', fp);
+	goto keyword;
     case INTEGER_:
+keyword:
 	fprintf(fp, "%" PRId64, nodevalue(n).num);
 	return;
     case SET_:
 	putc('{', fp);
-	for (i = 0, set = nodevalue(n).set; i < SETSIZE; i++)
-	    if (set & ((int64_t)1 << i)) {
+	for (i = 0, j = 1, set = nodevalue(n).set; i < SETSIZE; i++, j <<= 1)
+	    if (set & j) {
 		fprintf(fp, "%d", i);
-		set &= ~((int64_t)1 << i);
+		set &= ~j;
 		if (set)
 		    putc(' ', fp);
 	    }
 	putc('}', fp);
 	return;
     case STRING_:
 	putc('"', fp);
-	for (p = nodevalue(n).str; *p; p++)
-	    if (*p >= 8 && *p <= 13)
-		fprintf(fp, "\\%c", "btnvfr"[*p - 8]);
+	for (ptr = nodevalue(n).str; *ptr; ptr++)
+	    if (*ptr == '"')
+		fprintf(fp, "\\\"");
+	    else if (*ptr >= 8 && *ptr <= 13)
+		fprintf(fp, "\\%c", "btnvfr"[*ptr - 8]);
+	    else if (iscntrl((int)*ptr))
+		fprintf(fp, "\\%03d", *ptr);
 	    else
-		putc(*p, fp);
+		putc(*ptr, fp);
 	putc('"', fp);
 	return;
     case LIST_:
@@ -184,20 +193,32 @@ PUBLIC void writefactor(pEnv env, Index n, FILE *fp)
 	putc(']', fp);
 	return;
     case FLOAT_:
-	fprintf(fp, "%g", nodevalue(n).dbl);
+	sprintf(buf, "%g", nodevalue(n).dbl);	/* exponent character is e */
+	if ((ptr = strchr(buf, '.')) == 0) {	/* locate decimal point */
+	    if ((ptr = strchr(buf, 'e')) == 0)  /* locate start of exponent */
+		strcat(buf, ".0");		/* add decimal point and 0 */
+	    else {
+		strcpy(tmp, ptr);		/* save exponent */
+		sprintf(ptr, ".0%s", tmp);	/* insert decimal point + 0 */
+	    }
+        }
+	fprintf(fp, "%s", buf);
 	return;
     case FILE_:
 	if (!nodevalue(n).fil)
 	    fprintf(fp, "file:NULL");
 	else if (nodevalue(n).fil == stdin)
-	    fprintf(fp, "file:stdin");
+	    fprintf(fp, "stdin");
 	else if (nodevalue(n).fil == stdout)
-	    fprintf(fp, "file:stdout");
+	    fprintf(fp, "stdout");
 	else if (nodevalue(n).fil == stderr)
-	    fprintf(fp, "file:stderr");
+	    fprintf(fp, "stderr");
 	else
 	    fprintf(fp, "file:%p", (void *)nodevalue(n).fil);
 	return;
+    case BIGNUM_:
+	fprintf(fp, "%s", nodevalue(n).str);
+	return;
     default:
 	error(env, "a factor cannot begin with this symbol");
     }