diff --git a/.gitignore b/.gitignore index 954f4b0..1023684 100644 --- a/.gitignore +++ b/.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 diff --git a/CMakeLists.txt b/CMakeLists.txt index 82785dd..7252b9d 100644 --- a/CMakeLists.txt +++ b/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) diff --git a/README.md b/README.md index de888db..d73131e 100644 --- a/README.md +++ b/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) diff --git a/build/usrlib.joy b/build/usrlib.joy index d60b837..b9d6e49 100644 --- a/build/usrlib.joy +++ b/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 *) diff --git a/factor.c b/factor.c index 96a3ff4..df6052d 100644 --- a/factor.c +++ b/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,19 +151,24 @@ 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); } @@ -171,11 +176,15 @@ PUBLIC void writefactor(pEnv env, Index n, FILE *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"); } diff --git a/globals.h b/globals.h index dba1be2..9d30b26 100644 --- a/globals.h +++ b/globals.h @@ -1,8 +1,8 @@ /* FILE: globals.h */ /* * module : globals.h - * version : 1.81 - * date : 12/12/23 + * version : 1.86 + * date : 02/12/24 */ #ifndef GLOBALS_H #define GLOBALS_H @@ -19,10 +19,18 @@ #include #include #include +#ifndef NOBDW #include +#else +#include "gc.h" +#endif #include "kvec.h" #include "khash.h" +#ifdef _MSC_VER +#pragma warning(disable: 4244 4267) +#endif + #ifdef NOBDW #define nodetype(n) vec_at(env->memory, n).op #define nodevalue(n) vec_at(env->memory, n).u @@ -39,6 +47,9 @@ #define nextnode3(p) (nextnode2(p))->next #define nextnode4(p) (nextnode3(p))->next #define nextnode5(p) (nextnode4(p))->next +#ifdef ENABLE_TRACEGC +#undef ENABLE_TRACEGC +#endif #endif /* configure */ @@ -46,8 +57,8 @@ #define INPSTACKMAX 10 #define INPLINEMAX 255 #define BUFFERMAX 80 -#define ALEN 45 /* module + member */ -#define DISPLAYMAX 10 /* nesting in HIDE & MODULE */ +#define ALEN 42 /* module + '.' + member + \0 */ +#define DISPLAYMAX 10 /* nesting in HIDE & MODULE */ #define INIECHOFLAG 0 #define INIAUTOPUT 1 #define INITRACEGC 1 @@ -60,7 +71,6 @@ /* symbols from getsym */ #define ILLEGAL_ 0 #define COPIED_ 1 -#define KEYWORD_ 1 #define USR_ 2 #define ANON_FUNCT_ 3 #define BOOLEAN_ 4 @@ -71,6 +81,8 @@ #define LIST_ 9 #define FLOAT_ 10 #define FILE_ 11 +#define BIGNUM_ 12 +#define KEYWORD_ 13 #define LBRACK 900 #define LBRACE 901 #define LPAREN 902 @@ -177,10 +189,16 @@ typedef struct Env { int hide; } module_stack[DISPLAYMAX]; unsigned char autoput; /* options */ + unsigned char autoput_set; unsigned char echoflag; + unsigned char echoflag_set; unsigned char undeferror; + unsigned char undeferror_set; unsigned char tracegc; + unsigned char tracegc_set; unsigned char debugging; + unsigned char ignore; + unsigned char statistics; } Env; /* GOOD REFS: @@ -206,7 +224,7 @@ PUBLIC proc_t operproc(int o); PUBLIC int operflags(int o); PUBLIC int operindex(proc_t proc); /* factor.c */ -PUBLIC void readfactor(pEnv env); /* read a JOY factor */ +PUBLIC int readfactor(pEnv env); /* read a JOY factor */ PUBLIC void readterm(pEnv env); PUBLIC void writefactor(pEnv env, Index n, FILE *fp); PUBLIC void writeterm(pEnv env, Index n, FILE *fp); @@ -231,8 +249,7 @@ pEntry qualify(pEnv env, char *name); /* scan.c */ PUBLIC void inilinebuffer(pEnv env, char *str); PUBLIC void error(pEnv env, char *message); -PUBLIC int redirect(pEnv env, char *name, FILE *fp); -PUBLIC int include(pEnv env, char *name, int error); +PUBLIC void include(pEnv env, char *name); PUBLIC void getsym(pEnv env); /* utils.c */ #ifdef NOBDW diff --git a/interp.c b/interp.c index 87bc7bb..8bffad9 100644 --- a/interp.c +++ b/interp.c @@ -1,8 +1,8 @@ /* FILE: interp.c */ /* * module : interp.c - * version : 1.77 - * date : 12/12/23 + * version : 1.79 + * date : 02/12/24 */ /* @@ -289,8 +289,10 @@ #ifdef STATS static double calls, opers; -PRIVATE void report_stats(void) +PRIVATE void report_stats(pEnv env) { + if (!env->statistics) + return; fflush(stdout); fprintf(stderr, "%.0f calls to joy interpreter\n", calls); fprintf(stderr, "%.0f operations executed\n", opers); @@ -324,7 +326,7 @@ PUBLIC void exeterm(pEnv env, Index n) start: #ifdef STATS if (++calls == 1) - atexit(report_stats); + my_atexit(report_stats); #endif if (root == n) return; @@ -444,11 +446,13 @@ PUBLIC void exeterm(pEnv env, Index n) #include "src/plusminus.h" #include "src/predsucc.h" #include "src/push.h" +#include "src/push2.h" #include "src/someall.h" #include "src/type.h" #include "src/ufloat.h" #include "src/unmktime.h" #include "src/usetop.h" +#include "src/usetop2.h" #include "builtin.h" static struct { @@ -484,7 +488,7 @@ static struct { {OK, " set type", id_, "-> {...}", "The type of sets of small non-negative integers.\nThe maximum is platform dependent, typically the range is 0..31.\nLiterals are written inside curly braces.\nExamples: {} {0} {1 3 5} {19 18 17}."}, -{OK, " string type", id_, "-> \"...\" ", +{OK, " string type", id_, "-> \"...\"", "The type of strings of characters. Literals are written inside double quotes.\nExamples: \"\" \"A\" \"hello world\" \"123\".\nUnix style escapes are accepted."}, {OK, " list type", id_, "-> [...]", diff --git a/lib/CMakeLists.txt b/lib/CMakeLists.txt index dd2394a..acd74ed 100644 --- a/lib/CMakeLists.txt +++ b/lib/CMakeLists.txt @@ -1,30 +1,38 @@ # # module : CMakeLists.txt -# version : 1.3 -# date : 11/05/23 +# version : 1.4 +# date : 01/25/24 # macro(exe9 src) -add_custom_target(${src}.out ALL +add_custom_target(${src}.old ALL WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}/lib DEPENDS joy ${CMAKE_SOURCE_DIR}/lib/${src}.joy - COMMAND joy ${CMAKE_SOURCE_DIR}/lib/${src}.joy 24 54 >${src}.out) + COMMAND joy ${CMAKE_SOURCE_DIR}/lib/${src}.joy 24 54 >${src}.old) endmacro(exe9) -exe9(alljoy) +add_custom_target(tutinp.old ALL + WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}/lib + DEPENDS joy ${CMAKE_SOURCE_DIR}/lib/tutinp.joy + COMMAND joy <${CMAKE_SOURCE_DIR}/lib/tutinp.joy >tutinp.old) + +add_custom_target(lsptst.old ALL + WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}/lib + DEPENDS joy ${CMAKE_SOURCE_DIR}/lib/lsptst.joy + COMMAND joy <${CMAKE_SOURCE_DIR}/lib/lsptst.joy >tutinp.old) + +exe9(jp-joytst) +exe9(laztst) +exe9(symtst) +exe9(plgtst) +exe9(mtrtst) +exe9(grmtst) +exe9(reptst) +exe9(jp-reprodtst) exe9(flatjoy) +exe9(modtst) +exe9(alljoy) exe9(gcd) -exe9(grmtst) exe9(jp-church) -exe9(jp-joytst) exe9(jp-nestrec) -exe9(jp-reprodtst) -exe9(laztst) -exe9(lsptst) exe9(mandel) -exe9(modtst) -exe9(mtrtst) -exe9(plgtst) -exe9(reptst) -exe9(symtst) exe9(test) -exe9(tutinp) diff --git a/lib/joytut.inp b/lib/joytut.inp deleted file mode 100644 index dfd767d..0000000 --- a/lib/joytut.inp +++ /dev/null @@ -1,41 +0,0 @@ -(* FILE: joytut.inp *) - -"joytut.joy" include. -1 setecho. - -(* input that might have come from a terminal *) - -joytut quit. - hahaha - 1234 - 42 - 36 - 5 - 7 - [2 4 7] - [ 8 9 3 ] - [ [5 3] 5 3] - [ [5 3] 5 3] - [73] - - [ 9 4 16] - [ 10 + ] - [5 3 7] - [ 20 <] - - 15 - -8 - [ 0 =] - [ succ ] - [ factorial *] - [ dup pred ] - [ * ] - - 2 - - [6 4 8] - [ 10 + ] - [5 3 7] - [ 20 <] - -999 diff --git a/lib/numlib.joy b/lib/numlib.joy index ac0760f..8f8ac74 100644 --- a/lib/numlib.joy +++ b/lib/numlib.joy @@ -93,7 +93,7 @@ LIBRA *) newton == (* Usage: guess [F] newton *) dup deriv (* guess [F] [D] *) - [ pop i abs 0.001 > ] (* too big ? R.W. *) + [ pop i abs 0.0001 > ] (* too big ? *) [ [dupd] dip (* guess guess [F] [D] *) dup2 (* guess guess [F] [D] [F] [D] *) [[cleave / - ] dip] diff --git a/lib/replib.joy b/lib/replib.joy index fc40e4b..0441923 100644 --- a/lib/replib.joy +++ b/lib/replib.joy @@ -91,7 +91,7 @@ PUBLIC [ifte] cons cons cons; # [ .. .. .. ifte ] linear == [i] _expand; - _binary == [dip swap i] _expand (* R.W. *) + binary == [dip swap i] _expand END; # MODULE rep diff --git a/lib/reptst.joy b/lib/reptst.joy index 5966825..b498a7c 100644 --- a/lib/reptst.joy +++ b/lib/reptst.joy @@ -210,8 +210,8 @@ nfib-fix. DEFINE fact-lin == [null] [pop 1] [dup pred] [*] rep.linear; length-lin == [null] [pop 0] [rest] [succ] rep.linear; - nfib-bin == [small] [pop 1] [pred dup pred] [+] rep._binary; - (* R.W. *) + nfib-bin == [small] [pop 1] [pred dup pred] [+] rep.binary; + fact-fix == fact-lin rep.fix; length-fix-a == length-lin rep.fix-a; nfib-fix == nfib-bin rep.fix. @@ -225,8 +225,8 @@ DEFINE 6 nfib-bin [] [[dup put] dip] rep.fix-i i newline pop. DEFINE - qsort-bin == [small] [] [uncons [>] split] [enconcat] rep._binary; - qsort-fix-c == qsort-bin rep.fix-c; (* R.W. *) + qsort-bin == [small] [] [uncons [>] split] [enconcat] rep.binary; + qsort-fix-c == qsort-bin rep.fix-c; qtest == qsort-fix-c i state. [5 10 9 14 7 18 1 4 15 3 20 19 8 11 2 6 12 13 16 17] qtest. . diff --git a/lib/usrlib.joy b/lib/usrlib.joy index d60b837..b9d6e49 100644 --- a/lib/usrlib.joy +++ b/lib/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 *) diff --git a/main.c b/main.c index 4a6de3e..b08c404 100644 --- a/main.c +++ b/main.c @@ -1,8 +1,8 @@ /* FILE: main.c */ /* * module : main.c - * version : 1.81 - * date : 11/06/23 + * version : 1.90 + * date : 02/12/24 */ /* @@ -116,14 +116,11 @@ Manfred von Thun, 2006 */ #include "globals.h" -#define ERROR_ON_USRLIB 0 -#define DONT_READ_AHEAD 0 -#define READ_PRIV_AHEAD 1 +static jmp_buf begin; /* restart with empty program */ -static jmp_buf begin; -static char *filename = "stdin"; +static char *filename; /* used in execerror */ -char *bottom_of_stack; /* needed in gc.c */ +char *bottom_of_stack; /* needed in gc.c */ /* * Initialise the symbol table with builtins. There is no need to classify @@ -157,9 +154,9 @@ PRIVATE void enterglobal(pEnv env, char *name) khiter_t key; env->location = vec_size(env->symtab); - ent.flags = 0; ent.name = name; ent.is_user = 1; + ent.flags = 0; ent.u.body = 0; /* may be assigned in definition */ key = kh_put(Symtab, env->hash, ent.name, &rv); kh_value(env->hash, key) = env->location; @@ -217,6 +214,7 @@ PRIVATE void compound_def(pEnv env); /* forward */ PRIVATE void definition(pEnv env) { Entry ent; + char *name; pEntry here = 0; if (env->symb == LIBRA || env->symb == JPRIVATE || env->symb == HIDE @@ -237,6 +235,16 @@ PRIVATE void definition(pEnv env) return; /* symb == ATOM : */ + name = env->yylval.str; + + getsym(env); + if (env->symb == EQDEF) + getsym(env); + else + error(env, " == expected in definition"); + readterm(env); + + env->yylval.str = name; enteratom(env); ent = vec_at(env->symtab, env->location); if (!ent.is_user) { @@ -245,12 +253,7 @@ PRIVATE void definition(pEnv env) enterglobal(env, classify(env, env->yylval.str)); } here = env->location; - getsym(env); - if (env->symb == EQDEF) - getsym(env); - else - error(env, " == expected in definition"); - readterm(env); + if (here && env->stck && nodetype(env->stck) == LIST_) { vec_at(env->symtab, here).u.body = nodevalue(env->stck).lis; env->stck = nextnode1(env->stck); @@ -352,16 +355,21 @@ PRIVATE void report_clock(pEnv env) #ifdef NOBDW double perc; #endif - clock_t diff; + double diff; - diff = clock() - env->startclock; + if (!env->statistics) + return; + if ((diff = clock() - env->startclock) < 0) + diff = 0; fflush(stdout); - fprintf(stderr, "%ld milliseconds CPU to execute\n", + fprintf(stderr, "%.0f milliseconds CPU to execute\n", diff * 1000 / CLOCKS_PER_SEC); #ifdef NOBDW - perc = (double)env->gc_clock * 100 / diff; - fprintf(stderr, "%ld milliseconds CPU for gc (=%.0f%%)\n", - env->gc_clock * 1000 / CLOCKS_PER_SEC, perc); + if (diff && env->gc_clock) { + perc = env->gc_clock * 100.0 / diff; + fprintf(stderr, "%.0f milliseconds CPU for gc (=%.0f%%)\n", + env->gc_clock * 1000.0 / CLOCKS_PER_SEC, perc); + } #endif } #endif @@ -370,7 +378,7 @@ PRIVATE void report_clock(pEnv env) * copyright - Print all copyright notices, even historical ones. * * The version must be set on the commandline when compiling: - * -DJVERSION="\"alpha\"" or whatever. + * -DVERS="\"alpha\"" or whatever. */ #ifdef COPYRIGHT PRIVATE void copyright(char *file) @@ -409,8 +417,8 @@ PRIVATE void copyright(char *file) } } else { printf("JOY - compiled at %s on %s", __TIME__, __DATE__); -#ifdef JVERSION - printf(" (%s)", JVERSION); +#ifdef VERS + printf(" (%s)", VERS); #endif putchar('\n'); j = 1; @@ -448,34 +456,127 @@ PRIVATE void dump_table(pEnv env) */ PRIVATE void options(pEnv env) { - printf("Usage: joy [options] [filename] [parameters]\n"); - printf("options, filename, parameters can be given in any order\n"); - printf("options start with '-' and are all given together\n"); - printf("parameters start with a digit\n"); - printf("the filename parameter cannot start with '-' or a digit\n"); + char str[BUFFERMAX]; + + printf("Usage: joy (options | filenames | parameters)*\n"); + printf("options, filenames, parameters can be given in any order\n"); + printf("options start with '-' and parameters start with a digit\n"); + printf("filenames can be preceded by a pathname: e.g. './'\n"); + printf("Features included (+) or not (-):\n"); + sprintf(str, " symbols copyright jversion tracing stats ncheck"); +#ifdef SYMBOLS + str[0] = '+'; +#else + str[0] = '-'; +#endif +#ifdef COPYRIGHT + str[9] = '+'; +#else + str[9] = '-'; +#endif +#ifdef VERS + str[20] = '+'; +#else + str[20] = '-'; +#endif +#ifdef TRACING + str[30] = '+'; +#else + str[30] = '-'; +#endif +#ifdef STATS + str[39] = '+'; +#else + str[39] = '-'; +#endif +#ifdef NCHECK + str[46] = '+'; +#else + str[46] = '-'; +#endif + printf("%s\n", str); + sprintf(str, " tokens ndebug nobdw tracegc settings"); +#ifdef TOKENS + str[0] = '+'; +#else + str[0] = '-'; +#endif +#ifdef NDEBUG + str[8] = '+'; +#else + str[8] = '-'; +#endif +#ifdef NOBDW + str[16] = '+'; +#else + str[16] = '-'; +#endif +#ifdef ENABLE_TRACEGC + str[23] = '+'; +#else + str[23] = '-'; +#endif +#ifdef SETTINGS + str[32] = '+'; +#else + str[32] = '-'; +#endif + printf("%s\n", str); +#ifdef COMP + printf("Compile flags: %s\n", COMP); +#endif +#ifdef LINK + printf("Linker flags: %s\n", LINK); +#endif printf("Options:\n"); - printf(" -h : print this help text and exit\n"); +#ifdef SETTINGS + printf(" -a : set the autoput flag (0-2)\n"); +#endif #ifdef TRACING printf(" -d : print a trace of stack development\n"); #endif +#ifdef SETTINGS + printf(" -e : set the echoflag (0-3)\n"); +#endif +#ifdef ENABLE_TRACEGC + printf(" -g : set the __tracegc flag (0-6)\n"); +#endif + printf(" -h : print this help text and exit\n"); +#ifdef SETTINGS + printf(" -i : ignore impure functions\n"); + printf(" -l : do not read usrlib.joy at startup\n"); +#endif #ifdef SYMBOLS - printf(" -s : dump user-defined functions after execution\n"); + printf(" -s : dump symbol table after execution\n"); #endif #ifdef TRACING printf(" -t : print a trace of program execution\n"); #endif +#ifdef SETTINGS + printf(" -u : set the undeferror flag (0,1)\n"); +#endif #ifdef COPYRIGHT printf(" -v : do not print a copyright notice\n"); +#endif +#ifdef STATS + printf(" -x : print statistics after program finishes\n"); #endif quit_(env); } +PRIVATE void unknown_opt(pEnv env, char *exe, int ch) +{ + printf("Unknown option argument: \"-%c\"\n", ch); + printf("More info with: \"%s -h\"\n", exe); + quit_(env); +} + PRIVATE int my_main(int argc, char **argv) { static unsigned char mustinclude = 1; - char *ptr; + char *ptr, *exe; /* exe: name of joy binary */ int i, j, ch; - unsigned char helping = 0; + unsigned char helping = 0, unknown = 0; #ifdef COPYRIGHT unsigned char verbose = 1; #endif @@ -483,13 +584,14 @@ PRIVATE int my_main(int argc, char **argv) unsigned char symdump = 0; #endif - Env env; /* global variables */ + Env env; /* global variables */ memset(&env, 0, sizeof(env)); /* * Start the clock. my_atexit is called from quit_ that is called in * scan.c after reading EOF on the first input file. */ env.startclock = clock(); + setbuf(stdout, 0); #ifdef STATS my_atexit(report_clock); #endif @@ -498,43 +600,115 @@ PRIVATE int my_main(int argc, char **argv) /* * Initialize yyin and other environmental parameters. */ + filename = "stdin"; env.srcfile = stdin; - if ((ptr = strrchr(env.pathname = argv[0], '/')) != 0) { + if ((ptr = strrchr(env.pathname = exe = argv[0], '/')) != 0) { *ptr++ = 0; - argv[0] = ptr; + argv[0] = exe = ptr; } else if ((ptr = strrchr(env.pathname, '\\')) != 0) { *ptr++ = 0; - argv[0] = ptr; + argv[0] = exe = ptr; } else env.pathname = "."; + /* + * These flags are initialized here, allowing them to be overruled by the + * command line. The program must be compiled with -DSETTINGS for that to + * happen. When set on the command line, they can not be overruled in the + * source code. + */ + env.autoput = INIAUTOPUT; + env.echoflag = INIECHOFLAG; + env.undeferror = INIUNDEFERROR; + env.tracegc = INITRACEGC; + /* * First look for options. They start with -. */ - for (i = 1; i < argc; i++) + for (i = 1; i < argc; i++) { if (argv[i][0] == '-') { - for (j = 1; argv[i][j]; j++) + for (j = 1; argv[i][j]; j++) { switch (argv[i][j]) { - case 'h' : helping = 1; break; +#ifdef SETTINGS + case 'a' : ptr = &argv[i][j + 1]; + env.autoput = atoi(ptr); /* numeric payload */ + env.autoput_set = 1; + ch = *ptr; /* first digit */ + while (isdigit(ch)) { + j++; /* point last digit */ + ptr++; + ch = *ptr; + } + break; +#endif #ifdef TRACING case 'd' : env.debugging = 1; break; #endif +#ifdef SETTINGS + case 'e' : ptr = &argv[i][j + 1]; + env.echoflag = atoi(ptr); /* numeric payload */ + env.echoflag_set = 1; + ch = *ptr; /* first digit */ + while (isdigit(ch)) { + j++; /* point last digit */ + ptr++; + ch = *ptr; + } + break; +#endif +#ifdef ENABLE_TRACEGC + case 'g' : ptr = &argv[i][j + 1]; + env.tracegc = atoi(ptr); /* numeric payload */ + ch = *ptr; /* first digit */ + while (isdigit(ch)) { + j++; /* point last digit */ + ptr++; + ch = *ptr; + } + break; +#endif + case 'h' : helping = 1; break; +#ifdef SETTINGS + case 'i' : env.ignore = 1; break; + case 'l' : mustinclude = 0; break; +#endif #ifdef SYMBOLS case 's' : symdump = 1; break; #endif #ifdef TRACING case 't' : env.debugging = 2; break; #endif +#ifdef SETTINGS + case 'u' : ptr = &argv[i][j + 1]; + env.undeferror = atoi(ptr); /* numeric payload */ + env.undeferror_set = 1; + ch = *ptr; /* first digit */ + while (isdigit(ch)) { + j++; /* point last digit */ + ptr++; + ch = *ptr; + } + break; +#endif #ifdef COPYRIGHT case 'v' : verbose = 0; break; #endif - } +#ifdef STATS + case 'x' : env.statistics = 1; break; +#endif + default : unknown = argv[i][j]; break; + } /* end switch */ + } /* end for */ + /* - Overwrite the options with subsequent parameters. + Overwrite the options with subsequent parameters. Index i is + decreased, because the next parameter is copied to the current + index and i is increased in the for-loop. */ - for (--argc; i < argc; i++) - argv[i] = argv[i + 1]; - break; - } + for (--argc, j = i--; j < argc; j++) + argv[j] = argv[j + 1]; + } /* end if */ + } /* end for */ + /* * Look for a possible filename parameter. Filenames cannot start with - * and cannot start with a digit, unless preceded by a path: e.g. './'. @@ -542,7 +716,7 @@ PRIVATE int my_main(int argc, char **argv) for (i = 1; i < argc; i++) { ch = argv[i][0]; if (!isdigit(ch)) { - if ((env.srcfile = freopen(filename = argv[i], "r", stdin)) == 0) { + if ((env.srcfile = fopen(filename = argv[i], "r")) == 0) { fprintf(stderr, "failed to open the file '%s'.\n", filename); return 0; } @@ -557,8 +731,9 @@ PRIVATE int my_main(int argc, char **argv) for (--argc; i < argc; i++) argv[i] = argv[i + 1]; break; - } - } + } /* end if */ + } /* end for */ + env.g_argc = argc; env.g_argv = argv; #ifdef COPYRIGHT @@ -569,14 +744,12 @@ PRIVATE int my_main(int argc, char **argv) if (symdump) my_atexit(dump_table); #endif - env.echoflag = INIECHOFLAG; - env.tracegc = INITRACEGC; - env.autoput = INIAUTOPUT; - env.undeferror = INIUNDEFERROR; inilinebuffer(&env, filename); inisymboltable(&env); if (helping) options(&env); + if (unknown) + unknown_opt(&env, exe, unknown); setjmp(begin); /* return here after error or abort */ #ifdef NOBDW inimem1(&env, 0); /* does not clear the stack */ @@ -584,7 +757,8 @@ PRIVATE int my_main(int argc, char **argv) #endif env.prog = 0; /* clear program, just to be sure */ if (mustinclude) { - mustinclude = include(&env, "usrlib.joy", ERROR_ON_USRLIB); + mustinclude = 0; /* try only once */ + include(&env, "usrlib.joy"); fflush(stdout); /* flush include messages */ } while (1) { @@ -635,7 +809,8 @@ PRIVATE int my_main(int argc, char **argv) env.stck = nextnode1(env.stck); #endif } - putchar('\n'); + if (env.autoput && !env.ignore) + putchar('\n'); } } } diff --git a/makefile b/makefile index b497f05..570f068 100644 --- a/makefile +++ b/makefile @@ -1,19 +1,20 @@ # # module : makefile -# version : 1.7 -# date : 10/12/23 +# version : 1.8 +# date : 01/17/24 # +.POSIX: .SUFFIXES: -.SUFFIXES: .c .o -CC = gcc -CFLAGS = -DCOPYRIGHT -O3 -Wall -Wextra -Wpedantic \ - -Wno-unused-parameter -Werror -DJVERSION="\"BDW Release 1.0\"" -HDRS = globals.h -OBJS = interp.o scan.o utils.o main.o factor.o module.o +CC = gcc +CF = -DCOPYRIGHT -O3 -Wall -Wextra -Wpedantic -Werror -Wno-unused-parameter +LF = -lm -lgc +CFLAGS = $(CF) -DCOMP="\"$(CF)\"" -DLINK="\"$(LF)\"" -DVERS="\"BDW Release 1.0\"" +HDRS = globals.h +OBJS = main.o interp.o scan.o utils.o factor.o module.o joy: prep $(OBJS) - $(CC) -o$@ $(OBJS) -lm -lgc + $(CC) -o$@ $(OBJS) $(LF) $(OBJS): $(HDRS) @@ -24,5 +25,7 @@ prep: clean: rm -f $(OBJS) builtin.* table.c +.SUFFIXES: .c .o + .c.o: SOURCE_DATE_EPOCH=1047920271 $(CC) -o$@ $(CFLAGS) -c $< diff --git a/scan.c b/scan.c index 8138bfa..430e72b 100644 --- a/scan.c +++ b/scan.c @@ -1,8 +1,8 @@ /* FILE: scan.c */ /* * module : scan.c - * version : 1.57 - * date : 09/07/23 + * version : 1.63 + * date : 02/13/24 */ #include "globals.h" @@ -19,7 +19,6 @@ static int linelength, currentcolumn; static int errorcount; #endif static int ch = ' '; -static int fget_eof; static struct keys { char *name; @@ -55,6 +54,8 @@ PRIVATE void putline(pEnv env, FILE *fp, int echo) { int i; + if (!linenumber) + return; if (echo) { if (env->echoflag > 2) fprintf(fp, "%4d", linenumber); @@ -71,7 +72,7 @@ PRIVATE void putline(pEnv env, FILE *fp, int echo) */ PRIVATE void getch(pEnv env) { - int i; + int i, echo = 1; if (currentcolumn == linelength) { again: @@ -83,20 +84,24 @@ PRIVATE void getch(pEnv env) ; linelength = i; } else if (ilevel > 0) { - if (!strcmp(infile[ilevel].name, "fget")) - fget_eof = 1; fclose(infile[ilevel].fp); infile[ilevel].fp = 0; /* invalidate file pointer */ env->srcfile = infile[--ilevel].fp; linenumber = infile[ilevel].line; + echo = 0; /* do not echo this line again */ } else quit_(env); linbuf[linelength++] = ' '; /* to help getsym for numbers */ linbuf[linelength++] = 0; - if (env->echoflag) + if (env->echoflag && echo) putline(env, stdout, 1); /* echo line to stdout */ if (linbuf[0] == SHELLESCAPE) { - system(&linbuf[1]); + if (!env->ignore) { + if ((i = system(&linbuf[1])) != 0) { + fflush(stdout); + fprintf(stderr, "system: %d\n", i); + } + } goto again; } } @@ -130,70 +135,98 @@ PUBLIC void error(pEnv env, char *message) /* redirect - read from another file descriptor. Some special processing in - case of reading with fget. + the case of reading with fget. */ -PUBLIC int redirect(pEnv env, char *name, FILE *fp) +PUBLIC void redirect(pEnv env, char *str, FILE *fp) { - if (fget_eof) { /* stop reading from this file */ - fget_eof = 0; - return 0; /* abort fget functionality */ - } - if (!strcmp(infile[ilevel].name, name)) - return 1; /* already reading from this file */ + if (infile[ilevel].fp == fp) + return; /* already reading from this file */ infile[ilevel].line = linenumber; /* save last line number and line */ if (ilevel + 1 == INPSTACKMAX) /* increase the include level */ execerror("fewer include files", "include"); infile[++ilevel].fp = env->srcfile = fp; - infile[ilevel].line = 1; /* start with line 1 */ - infile[ilevel].name = name; - return 1; /* ok, switched to new file, buffer */ + infile[ilevel].line = linenumber = 0; /* start with line 0 */ + infile[ilevel].name = str; /* switch to new file */ } /* include - insert the contents of a file in the input. - Files are read in the current directory or if that fails - from the same directory as where the executable is stored. - If that path also fails an error is generated unless error - is set to 0. + Files are read in the current directory or if that fails from the + previous location. If that also fails an error is generated. */ -PUBLIC int include(pEnv env, char *name, int error) +PUBLIC void include(pEnv env, char *name) { + /* + * mustinclude - determine whether an attempt must be made to include + * usrlib.joy + */ FILE *fp; char *ptr, *str; -/* - First try to open name in the current working directory. -*/ - if ((fp = fopen(name, "r")) != 0) { -/* - Replace the pathname of argv[0] with the pathname of name. -*/ - if (strchr(name, '/')) { - env->pathname = GC_strdup(name); - ptr = strrchr(env->pathname, '/'); - *ptr = 0; + /* + * usrlib.joy is tried first in the current directory, then in the home + * directory and then in the directory where the joy binary is located. + * + * If all of that fails, no harm done. + */ + str = name; /* name copied to str */ + if (!strcmp(name, "usrlib.joy")) { /* check usrlib.joy */ + if ((fp = fopen(str, "r")) != 0) + goto normal; + if ((ptr = getenv("USERPROFILE")) != 0) { /* windows */ + str = GC_malloc_atomic(strlen(ptr) + strlen(name) + 2); + sprintf(str, "%s/%s", ptr, name); + if ((fp = fopen(str, "r")) != 0) + goto normal; } -/* - Prepend pathname to the filename and try again. -*/ - } else if (strcmp(env->pathname, ".")) { - str = GC_malloc_atomic(strlen(env->pathname) + strlen(name) + 2); - sprintf(str, "%s/%s", env->pathname, name); - if ((fp = fopen(str, "r")) != 0) { -/* - If this succeeds, establish a new pathname. -*/ + if ((ptr = getenv("HOME")) != 0) { + str = GC_malloc_atomic(strlen(ptr) + strlen(name) + 2); + sprintf(str, "%s/%s", ptr, name); + if ((fp = fopen(str, "r")) != 0) + goto normal; + } + if (strcmp(env->pathname, ".")) { + str = GC_malloc_atomic(strlen(env->pathname) + strlen(name) + 2); + sprintf(str, "%s/%s", env->pathname, name); + if ((fp = fopen(str, "r")) != 0) + goto normal; + } + /* + * Failure to open usrlib.joy need not be reported. + */ + return; +normal: + /* + * If there is a new pathname, replace the old one. + */ + if (strrchr(str, '/')) { env->pathname = GC_strdup(str); ptr = strrchr(env->pathname, '/'); *ptr = 0; } + redirect(env, name, fp); + return; + } + /* + * A file other that usrlib.joy is first tried in the current directory. + */ + if ((fp = fopen(name, "r")) != 0) + goto normal; + /* + * If that fails, the pathname is prepended and the file is tried again. + */ + if (strcmp(env->pathname, ".")) { + str = GC_malloc_atomic(strlen(env->pathname) + strlen(name) + 2); + sprintf(str, "%s/%s", env->pathname, name); + if ((fp = fopen(str, "r")) != 0) + goto normal; } - if (fp && redirect(env, name, fp)) - return 0; /* ok */ - if (error) - execerror("valid file name", "include"); - return 1; /* nok */ + /* + * If that also fails, no other path can be tried and an error is + * generated. + */ + execerror("valid file name", "include"); } /* @@ -422,7 +455,7 @@ PRIVATE void my_getsym(pEnv env) einde:; } -#ifdef DUMP_TOKENS +#ifdef TOKENS PRIVATE void dumptok(Token tok, int num) { printf("%d) ", num); @@ -504,7 +537,7 @@ PUBLIC void getsym(pEnv env) */ if (vec_size(env->tokens)) { tok = vec_pop(env->tokens); -#ifdef DUMP_TOKENS +#ifdef TOKENS dumptok(tok, 1); /* tokens from the first pop */ #endif env->symb = tok.symb; @@ -579,13 +612,13 @@ done: undomod(hide, modl, hcnt); */ if (vec_size(env->tokens)) { tok = vec_pop(env->tokens); -#ifdef DUMP_TOKENS +#ifdef TOKENS dumptok(tok, 2); /* tokens from the second pop */ #endif env->symb = tok.symb; env->yylval = tok.yylval; } else { -#ifdef DUMP_TOKENS +#ifdef TOKENS tok.symb = env->symb; tok.yylval = env->yylval; dumptok(tok, 3); /* there was no value popped */ diff --git a/src/__html_manual.c b/src/__html_manual.c index f963c93..cf9a9dd 100644 --- a/src/__html_manual.c +++ b/src/__html_manual.c @@ -1,7 +1,7 @@ /* module : __html_manual.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 01/22/24 */ #ifndef __HTML_MANUAL_C #define __HTML_MANUAL_C @@ -10,10 +10,12 @@ /** OK 2940 __html_manual : -> -Writes this manual of all Joy primitives to output file in HTML style. +[IMPURE] Writes this manual of all Joy primitives to output file in HTML style. */ -PRIVATE void __html_manual_(pEnv env) { make_manual(1); } - - - +PRIVATE void __html_manual_(pEnv env) +{ + if (env->ignore) + return; + make_manual(1); +} #endif diff --git a/src/__latex_manual.c b/src/__latex_manual.c index df01d9c..95fa65e 100644 --- a/src/__latex_manual.c +++ b/src/__latex_manual.c @@ -1,7 +1,7 @@ /* module : __latex_manual.c - version : 1.4 - date : 09/04/23 + version : 1.6 + date : 01/22/24 */ #ifndef __LATEX_MANUAL_C #define __LATEX_MANUAL_C @@ -10,10 +10,13 @@ /** OK 2950 __latex_manual : -> -Writes this manual of all Joy primitives to output file in Latex style +[IMPURE] Writes this manual of all Joy primitives to output file in Latex style but without the head and tail. */ -PRIVATE void __latex_manual_(pEnv env) { make_manual(2); } - - +PRIVATE void __latex_manual_(pEnv env) +{ + if (env->ignore) + return; + make_manual(2); +} #endif diff --git a/src/__manual_list.c b/src/__manual_list.c index 501325e..4f9f057 100644 --- a/src/__manual_list.c +++ b/src/__manual_list.c @@ -1,7 +1,7 @@ /* module : __manual_list.c - version : 1.6 - date : 09/04/23 + version : 1.7 + date : 01/24/24 */ #ifndef __MANUAL_LIST_C #define __MANUAL_LIST_C @@ -18,7 +18,7 @@ PRIVATE void __manual_list_(pEnv env) NULLARY(LIST_NEWNODE, 0); my_dump = &nodevalue(env->stck).lis; - for (i = 1; (name = opername(i)) != 0; i++) { + for (i = 0; (name = opername(i)) != 0; i++) { *my_dump = LIST_NEWNODE(0, 0); my_dump2 = &nodevalue(*my_dump).lis; *my_dump2 = STRING_NEWNODE(name, 0); diff --git a/src/__memoryindex.c b/src/__memoryindex.c index bb06c09..4a52968 100644 --- a/src/__memoryindex.c +++ b/src/__memoryindex.c @@ -1,14 +1,14 @@ /* module : __memoryindex.c - version : 1.4 - date : 09/04/23 + version : 1.5 + date : 02/01/24 */ #ifndef __MEMORYINDEX_C #define __MEMORYINDEX_C /** OK 3060 __memoryindex : -> I -Pushes current value of memory. +[IMPURE] Pushes current value of memory. */ PUBLIC void __memoryindex_(pEnv env) { diff --git a/src/__memorymax.c b/src/__memorymax.c index ac86173..3aea071 100644 --- a/src/__memorymax.c +++ b/src/__memorymax.c @@ -1,14 +1,14 @@ /* module : __memorymax.c - version : 1.3 - date : 08/13/23 + version : 1.4 + date : 02/01/24 */ #ifndef __MEMORYMAX_C #define __MEMORYMAX_C /** OK 1160 __memorymax : -> I -Pushes value of total size of memory. +[IMPURE] Pushes value of total size of memory. */ PUBLIC void __memorymax_(pEnv env) { diff --git a/src/__settracegc.c b/src/__settracegc.c index a49e89a..90d1a3d 100644 --- a/src/__settracegc.c +++ b/src/__settracegc.c @@ -1,17 +1,21 @@ /* module : __settracegc.c - version : 1.4 - date : 09/04/23 + version : 1.7 + date : 02/01/24 */ #ifndef __SETTRACEGC_C #define __SETTRACEGC_C /** OK 2970 __settracegc : I -> -Sets value of flag for tracing garbage collection to I (= 0..6). +[IMPURE] Sets value of flag for tracing garbage collection to I (= 0..6). */ -USETOP(__settracegc_, "settracegc", NUMERICTYPE, - env->tracegc = nodevalue(env->stck).num) - - +PRIVATE void __settracegc_(pEnv env) +{ + ONEPARAM("settracegc"); + NUMERICTYPE("settracegc"); + if (!env->ignore && !env->tracegc_set) + env->tracegc = nodevalue(env->stck).num; + POP(env->stck); +} #endif diff --git a/src/_help.c b/src/_help.c index 7435fb9..65ce2c2 100644 --- a/src/_help.c +++ b/src/_help.c @@ -1,17 +1,17 @@ /* module : _help.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 01/22/24 */ #ifndef _HELP_C #define _HELP_C /** OK 2910 _help : -> -Lists all hidden symbols in library and then all hidden builtin symbols. +[IMPURE] Lists all hidden symbols in library and then all hidden builtin +symbols. */ HELP(_help_, ==) - #endif diff --git a/src/andorxor.h b/src/andorxor.h index b6b8002..407a515 100644 --- a/src/andorxor.h +++ b/src/andorxor.h @@ -1,31 +1,29 @@ /* module : andorxor.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef ANDORXOR_H #define ANDORXOR_H -#define ANDORXOR(PROCEDURE, NAME, OPER1, OPER2) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - TWOPARAMS(NAME); \ - SAME2TYPES(NAME); \ - switch (nodetype(env->stck)) { \ - case SET_: \ - BINARY(SET_NEWNODE, \ - nodevalue( \ - nextnode1(env->stck)).set OPER1 nodevalue(env->stck).set); \ - return; \ - case BOOLEAN_: \ - case CHAR_: \ - case INTEGER_: \ - BINARY(BOOLEAN_NEWNODE, \ - nodevalue( \ - nextnode1(env->stck)).num OPER2 nodevalue(env->stck).num); \ - return; \ - default: \ - BADDATA(NAME); \ - } \ +#define ANDORXOR(PROCEDURE, NAME, OPER1, OPER2) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + TWOPARAMS(NAME); \ + SAME2TYPES(NAME); \ + switch (nodetype(env->stck)) { \ + case SET_: \ + BINARY(SET_NEWNODE, nodevalue(nextnode1(env->stck)).set \ + OPER1 nodevalue(env->stck).set); \ + return; \ + case BOOLEAN_: \ + case CHAR_: \ + case INTEGER_: \ + BINARY(BOOLEAN_NEWNODE, nodevalue(nextnode1(env->stck)).num \ + OPER2 nodevalue(env->stck).num); \ + return; \ + default: \ + BADDATA(NAME); \ + } \ } #endif diff --git a/src/bfloat.h b/src/bfloat.h index a0c9be1..72970d6 100644 --- a/src/bfloat.h +++ b/src/bfloat.h @@ -1,16 +1,16 @@ /* module : bfloat.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef BFLOAT_H #define BFLOAT_H -#define BFLOAT(PROCEDURE, NAME, FUNC) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - TWOPARAMS(NAME); \ - FLOAT2(NAME); \ - BINARY(FLOAT_NEWNODE, FUNC(FLOATVAL2, FLOATVAL)); \ +#define BFLOAT(PROCEDURE, NAME, FUNC) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + TWOPARAMS(NAME); \ + FLOAT2(NAME); \ + BINARY(FLOAT_NEWNODE, FUNC(FLOATVAL2, FLOATVAL)); \ } #endif diff --git a/src/casting.c b/src/casting.c index b069f86..81d8128 100644 --- a/src/casting.c +++ b/src/casting.c @@ -1,18 +1,21 @@ /* module : casting.c - version : 1.2 - date : 09/04/23 + version : 1.4 + date : 02/01/24 */ #ifndef CASTING_C #define CASTING_C /** -OK 3170 casting : X Y -> Z -[EXT] Z takes the value from X and the type from Y. +OK 3140 casting : X Y -> Z +[EXT] Z takes the value from X and uses the value from Y as its type. */ void casting_(pEnv env) { + Operator op; + TWOPARAMS("casting"); - GBINARY(nodetype(env->stck), nodevalue(nextnode1(env->stck))); + op = nodevalue(env->stck).num; + GBINARY(op, nodevalue(nextnode1(env->stck))); } #endif diff --git a/src/clock.c b/src/clock.c index f1abef7..46381d0 100644 --- a/src/clock.c +++ b/src/clock.c @@ -1,17 +1,17 @@ /* module : clock.c - version : 1.5 - date : 08/18/23 + version : 1.7 + date : 01/22/24 */ #ifndef CLOCK_C #define CLOCK_C /** OK 1130 clock : -> I -Pushes the integer value of current CPU usage in milliseconds. +[IMPURE] Pushes the integer value of current CPU usage in milliseconds. */ -PUSH(clock_, INTEGER_NEWNODE, ((clock() - env->startclock) * 1000 / CLOCKS_PER_SEC)) - +PUSH2(clock_, INTEGER_NEWNODE, + ((clock() - env->startclock) * 1000 / CLOCKS_PER_SEC)) #endif diff --git a/src/compare.h b/src/compare.h index c099281..e04432a 100644 --- a/src/compare.h +++ b/src/compare.h @@ -1,7 +1,7 @@ /* module : compare.h - version : 1.14 - date : 09/12/23 + version : 1.15 + date : 01/25/24 */ #ifndef COMPARE_H #define COMPARE_H @@ -113,14 +113,18 @@ PUBLIC int Compare(pEnv env, Index first, Index second) } break; case SET_: - num1 = nodevalue(first).num; + num1 = nodevalue(first).set; switch (type2) { case BOOLEAN_: case CHAR_: case INTEGER_: case SET_: - num2 = nodevalue(second).set; + num2 = nodevalue(second).num; goto cmpnum; + case FLOAT_: + dbl1 = num1; + dbl2 = nodevalue(second).dbl; + goto cmpdbl; default: return 1; /* unequal */ } @@ -156,6 +160,7 @@ PUBLIC int Compare(pEnv env, Index first, Index second) case BOOLEAN_: case CHAR_: case INTEGER_: + case SET_: dbl2 = nodevalue(second).num; goto cmpdbl; case FLOAT_: diff --git a/src/comprel.h b/src/comprel.h index d0bf182..e513203 100644 --- a/src/comprel.h +++ b/src/comprel.h @@ -1,24 +1,24 @@ /* module : comprel.h - version : 1.6 - date : 07/19/23 + version : 1.7 + date : 02/01/24 */ #ifndef COMPREL_H #define COMPREL_H -#define COMPREL(PROCEDURE, NAME, CONSTRUCTOR, OPR, SETCMP) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - uint64_t i, j; \ - int comp = 0; \ - TWOPARAMS(NAME); \ - if (nodetype(env->stck) == SET_ || \ - nodetype(nextnode1(env->stck)) == SET_) { \ - i = nodevalue(nextnode1(env->stck)).num; \ - j = nodevalue(env->stck).num; \ - comp = SETCMP; \ - } else \ - comp = Compare(env, nextnode1(env->stck), env->stck) OPR 0; \ - env->stck = CONSTRUCTOR(comp, nextnode2(env->stck)); \ +#define COMPREL(PROCEDURE, NAME, CONSTRUCTOR, OPR, SETCMP) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + uint64_t i, j; \ + int comp = 0; \ + TWOPARAMS(NAME); \ + if (nodetype(env->stck) == SET_ || \ + nodetype(nextnode1(env->stck)) == SET_) { \ + i = nodevalue(nextnode1(env->stck)).num; \ + j = nodevalue(env->stck).num; \ + comp = SETCMP; \ + } else \ + comp = Compare(env, nextnode1(env->stck), env->stck) OPR 0; \ + env->stck = CONSTRUCTOR(comp, nextnode2(env->stck)); \ } #endif diff --git a/src/cons_swons.h b/src/cons_swons.h index dd6f318..f9d2c68 100644 --- a/src/cons_swons.h +++ b/src/cons_swons.h @@ -1,38 +1,37 @@ /* module : cons_swons.h - version : 1.6 - date : 07/19/23 + version : 1.7 + date : 02/01/24 */ #ifndef CONS_SWONS_H #define CONS_SWONS_H -#define CONS_SWONS(PROCEDURE, NAME, AGGR, ELEM) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - Index temp; \ - TWOPARAMS(NAME); \ - switch (nodetype(AGGR)) { \ - case LIST_: \ - temp = newnode(env, nodetype(ELEM), nodevalue(ELEM), \ - nodevalue(AGGR).lis); \ - BINARY(LIST_NEWNODE, temp); \ - break; \ - case SET_: \ - CHECKSETMEMBER(ELEM, NAME); \ - BINARY(SET_NEWNODE, \ - nodevalue(AGGR).set | ((int64_t)1 << nodevalue(ELEM).num)); \ - break; \ - case STRING_: { \ - char *s; \ - CHECKCHARACTER(ELEM, NAME); \ - s = (char *)GC_malloc_atomic(strlen(nodevalue(AGGR).str) + 2); \ - s[0] = (char)nodevalue(ELEM).num; \ - strcpy(s + 1, nodevalue(AGGR).str); \ - BINARY(STRING_NEWNODE, s); \ - break; \ - } \ - default: \ - BADAGGREGATE(NAME); \ - } \ +#define CONS_SWONS(PROCEDURE, NAME, AGGR, ELEM) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + Index temp; \ + char *str; \ + TWOPARAMS(NAME); \ + switch (nodetype(AGGR)) { \ + case LIST_: \ + temp = newnode(env, nodetype(ELEM), nodevalue(ELEM), \ + nodevalue(AGGR).lis); \ + BINARY(LIST_NEWNODE, temp); \ + break; \ + case SET_: \ + CHECKSETMEMBER(ELEM, NAME); \ + BINARY(SET_NEWNODE, nodevalue(AGGR).set | \ + ((int64_t)1 << nodevalue(ELEM).num)); \ + break; \ + case STRING_: \ + CHECKCHARACTER(ELEM, NAME); \ + str = GC_malloc_atomic(strlen(nodevalue(AGGR).str) + 2); \ + str[0] = (char)nodevalue(ELEM).num; \ + strcpy(str + 1, nodevalue(AGGR).str); \ + BINARY(STRING_NEWNODE, str); \ + break; \ + default: \ + BADAGGREGATE(NAME); \ + } \ } #endif diff --git a/src/dipped.h b/src/dipped.h index eebac7a..1c2b199 100644 --- a/src/dipped.h +++ b/src/dipped.h @@ -1,19 +1,19 @@ /* module : dipped.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef DIPPED_H #define DIPPED_H -#define DIPPED(PROCEDURE, NAME, PARAMCOUNT, ARGUMENT) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - Node *save; \ - PARAMCOUNT(NAME); \ - save = env->stck; \ - POP(env->stck); \ - ARGUMENT(env); \ - GNULLARY(save->op, save->u); \ +#define DIPPED(PROCEDURE, NAME, PARAMCOUNT, ARGUMENT) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + Node *save; \ + PARAMCOUNT(NAME); \ + save = env->stck; \ + POP(env->stck); \ + ARGUMENT(env); \ + GNULLARY(save->op, save->u); \ } #endif diff --git a/src/fclose.c b/src/fclose.c index a885eb5..94ccdfd 100644 --- a/src/fclose.c +++ b/src/fclose.c @@ -1,14 +1,14 @@ /* module : fclose.c - version : 1.3 - date : 08/13/23 + version : 1.4 + date : 01/17/24 */ #ifndef FCLOSE_C #define FCLOSE_C /** OK 1830 fclose : S -> -Stream S is closed and removed from the stack. +[FOREIGN] Stream S is closed and removed from the stack. */ PRIVATE void fclose_(pEnv env) { diff --git a/src/feof.c b/src/feof.c index 1b2eaed..dc042bb 100644 --- a/src/feof.c +++ b/src/feof.c @@ -1,14 +1,14 @@ /* module : feof.c - version : 1.2 - date : 08/13/23 + version : 1.3 + date : 01/17/24 */ #ifndef FEOF_C #define FEOF_C /** OK 1840 feof : S -> S B -B is the end-of-file status of stream S. +[FOREIGN] B is the end-of-file status of stream S. */ FILEGET(feof_, "feof", BOOLEAN_NEWNODE, feof(nodevalue(env->stck).fil)) diff --git a/src/ferror.c b/src/ferror.c index 99e45c2..c4a11a5 100644 --- a/src/ferror.c +++ b/src/ferror.c @@ -1,14 +1,14 @@ /* module : ferror.c - version : 1.2 - date : 08/13/23 + version : 1.3 + date : 01/17/24 */ #ifndef FERROR_C #define FERROR_C /** OK 1850 ferror : S -> S B -B is the error status of stream S. +[FOREIGN] B is the error status of stream S. */ FILEGET(ferror_, "ferror", BOOLEAN_NEWNODE, ferror(nodevalue(env->stck).fil)) diff --git a/src/fflush.c b/src/fflush.c index 3020643..ea10e70 100644 --- a/src/fflush.c +++ b/src/fflush.c @@ -1,14 +1,14 @@ /* module : fflush.c - version : 1.2 - date : 08/13/23 + version : 1.3 + date : 01/17/24 */ #ifndef FFLUSH_C #define FFLUSH_C /** OK 1860 fflush : S -> S -Flush stream S, forcing all buffered output to be written. +[FOREIGN] Flush stream S, forcing all buffered output to be written. */ PRIVATE void fflush_(pEnv env) { diff --git a/src/fget.c b/src/fget.c deleted file mode 100644 index de96320..0000000 --- a/src/fget.c +++ /dev/null @@ -1,39 +0,0 @@ -/* - module : fget.c - version : 1.8 - date : 11/06/23 -*/ -#ifndef FGET_C -#define FGET_C - -/** -OK 3180 fget : S -> S F -[EXT] Reads a factor from stream S and pushes it onto stack. -*/ -PRIVATE void fget_(pEnv env) -{ - FILE *fp; - - ONEPARAM("fget"); - FILE("fget"); - fp = nodevalue(env->stck).fil; - if (!redirect(env, "fget", fp)) /* conditional switch of file */ - return; - getsym(env); - switch (env->symb) { - case ATOM: - case CHAR_: - case INTEGER_: - case STRING_: - case FLOAT_: - case LBRACE: - case LBRACK: - readfactor(env); - break; - default: - env->bucket.num = env->symb; - env->stck = newnode(env, KEYWORD_, env->bucket, env->stck); - break; - } -} -#endif diff --git a/src/fgetch.c b/src/fgetch.c index 0efbebb..7196434 100644 --- a/src/fgetch.c +++ b/src/fgetch.c @@ -1,14 +1,14 @@ /* module : fgetch.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FGETCH_C #define FGETCH_C /** OK 1870 fgetch : S -> S C -C is the next available character from stream S. +[FOREIGN] C is the next available character from stream S. */ FILEGET(fgetch_, "fgetch", CHAR_NEWNODE, getc(nodevalue(env->stck).fil)) diff --git a/src/fgets.c b/src/fgets.c index 2af9334..6470f6d 100644 --- a/src/fgets.c +++ b/src/fgets.c @@ -1,14 +1,14 @@ /* module : fgets.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FGETS_C #define FGETS_C /** OK 1880 fgets : S -> S L -L is the next available line (as a string) from stream S. +[FOREIGN] L is the next available line (as a string) from stream S. */ PRIVATE void fgets_(pEnv env) { diff --git a/src/file.c b/src/file.c index dc770c0..ce54609 100644 --- a/src/file.c +++ b/src/file.c @@ -1,14 +1,14 @@ /* module : file.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FILE_C #define FILE_C /** OK 2400 file : F -> B -Tests whether F is a file. +[FOREIGN] Tests whether F is a file. */ TYPE(file_, "file", ==, FILE_) diff --git a/src/fileget.h b/src/fileget.h index 8061e1a..62cf9da 100644 --- a/src/fileget.h +++ b/src/fileget.h @@ -1,16 +1,16 @@ /* module : fileget.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef FILEGET_H #define FILEGET_H -#define FILEGET(PROCEDURE, NAME, CONSTRUCTOR, EXPR) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - ONEPARAM(NAME); \ - FILE(NAME); \ - NULLARY(CONSTRUCTOR, EXPR); \ +#define FILEGET(PROCEDURE, NAME, CONSTRUCTOR, EXPR) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + ONEPARAM(NAME); \ + FILE(NAME); \ + NULLARY(CONSTRUCTOR, EXPR); \ } #endif diff --git a/src/filetime.c b/src/filetime.c index 47c551f..b604728 100644 --- a/src/filetime.c +++ b/src/filetime.c @@ -1,7 +1,7 @@ /* module : filetime.c - version : 1.2 - date : 09/04/23 + version : 1.5 + date : 02/05/24 */ #ifndef FILETIME_C #define FILETIME_C @@ -9,8 +9,8 @@ #include /** -OK 3190 filetime : F -> T -[EXT] T is the modification time of file F. +OK 3150 filetime : F -> T +[FOREIGN] T is the modification time of file F. */ void filetime_(pEnv env) { diff --git a/src/fopen.c b/src/fopen.c index d9c965f..be34792 100644 --- a/src/fopen.c +++ b/src/fopen.c @@ -1,15 +1,16 @@ /* module : fopen.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FOPEN_C #define FOPEN_C /** OK 1890 fopen : P M -> S -The file system object with pathname P is opened with mode M (r, w, a, etc.) -and stream object S is pushed; if the open fails, file:NULL is pushed. +[FOREIGN] The file system object with pathname P is opened with mode M +(r, w, a, etc.) and stream object S is pushed; if the open fails, file:NULL +is pushed. */ PRIVATE void fopen_(pEnv env) { diff --git a/src/fput.c b/src/fput.c index 43b7c79..83b80a1 100644 --- a/src/fput.c +++ b/src/fput.c @@ -1,14 +1,14 @@ /* module : fput.c - version : 1.6 - date : 09/07/23 + version : 1.7 + date : 01/17/24 */ #ifndef FPUT_C #define FPUT_C /** OK 1940 fput : S X -> S -Writes X to stream S, pops X off stack. +[FOREIGN] Writes X to stream S, pops X off stack. */ PRIVATE void fput_(pEnv env) { diff --git a/src/fputch.c b/src/fputch.c index d7cbd8a..086d8b4 100644 --- a/src/fputch.c +++ b/src/fputch.c @@ -1,14 +1,14 @@ /* module : fputch.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 02/02/24 */ #ifndef FPUTCH_C #define FPUTCH_C /** OK 1950 fputch : S C -> S -The character C is written to the current position of stream S. +[FOREIGN] The character C is written to the current position of stream S. */ PRIVATE void fputch_(pEnv env) { diff --git a/src/fputchars.c b/src/fputchars.c index 8a3c322..e9ef0e4 100644 --- a/src/fputchars.c +++ b/src/fputchars.c @@ -1,14 +1,15 @@ /* module : fputchars.c - version : 1.4 - date : 09/04/23 + version : 1.5 + date : 01/17/24 */ #ifndef FPUTCHARS_C #define FPUTCHARS_C /** OK 1960 fputchars : S "abc.." -> S -The string abc.. (no quotes) is written to the current position of stream S. +[FOREIGN] The string abc.. (no quotes) is written to the current position of +stream S. */ PRIVATE void fputchars_( pEnv env) /* suggested by Heiko Kuhrt, as "fputstring_" */ diff --git a/src/fputstring.c b/src/fputstring.c index 1d2ffba..b32a776 100644 --- a/src/fputstring.c +++ b/src/fputstring.c @@ -1,14 +1,14 @@ /* module : fputstring.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FPUTSTRING_C #define FPUTSTRING_C /** OK 1970 fputstring : S "abc.." -> S -== fputchars, as a temporary alternative. +[FOREIGN] == fputchars, as a temporary alternative. */ PRIVATE void fputstring_(pEnv env) { fputchars_(env); } diff --git a/src/fread.c b/src/fread.c index 17b667d..9792f0d 100644 --- a/src/fread.c +++ b/src/fread.c @@ -1,14 +1,14 @@ /* module : fread.c - version : 1.7 - date : 09/04/23 + version : 1.8 + date : 01/17/24 */ #ifndef FREAD_C #define FREAD_C /** OK 1900 fread : S I -> S L -I bytes are read from the current position of stream S +[FOREIGN] I bytes are read from the current position of stream S and returned as a list of I integers. */ PRIVATE void fread_(pEnv env) diff --git a/src/fremove.c b/src/fremove.c index 58ad2ca..7837ebf 100644 --- a/src/fremove.c +++ b/src/fremove.c @@ -1,15 +1,15 @@ /* module : fremove.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FREMOVE_C #define FREMOVE_C /** OK 1920 fremove : P -> B -The file system object with pathname P is removed from the file system. -B is a boolean indicating success or failure. +[FOREIGN] The file system object with pathname P is removed from the file +system. B is a boolean indicating success or failure. */ PRIVATE void fremove_(pEnv env) { diff --git a/src/frename.c b/src/frename.c index 057704b..ad50556 100644 --- a/src/frename.c +++ b/src/frename.c @@ -1,14 +1,14 @@ /* module : frename.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FRENAME_C #define FRENAME_C /** OK 1930 frename : P1 P2 -> B -The file system object with pathname P1 is renamed to P2. +[FOREIGN] The file system object with pathname P1 is renamed to P2. B is a boolean indicating success or failure. */ PRIVATE void frename_(pEnv env) diff --git a/src/fseek.c b/src/fseek.c index 7137a4b..3d47487 100644 --- a/src/fseek.c +++ b/src/fseek.c @@ -1,14 +1,14 @@ /* module : fseek.c - version : 1.5 - date : 09/04/23 + version : 1.6 + date : 01/17/24 */ #ifndef FSEEK_C #define FSEEK_C /** OK 1980 fseek : S P W -> S B -Stream S is repositioned to position P relative to whence-point W, +[FOREIGN] Stream S is repositioned to position P relative to whence-point W, where W = 0, 1, 2 for beginning, current position, end respectively. */ PRIVATE void fseek_(pEnv env) diff --git a/src/ftell.c b/src/ftell.c index aa42da4..2674ca4 100644 --- a/src/ftell.c +++ b/src/ftell.c @@ -1,14 +1,14 @@ /* module : ftell.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef FTELL_C #define FTELL_C /** OK 1990 ftell : S -> S I -I is the current position of stream S. +[FOREIGN] I is the current position of stream S. */ FILEGET(ftell_, "ftell", INTEGER_NEWNODE, ftell(nodevalue(env->stck).fil)) diff --git a/src/fwrite.c b/src/fwrite.c index 357007c..3fae9be 100644 --- a/src/fwrite.c +++ b/src/fwrite.c @@ -1,14 +1,15 @@ /* module : fwrite.c - version : 1.5 - date : 09/04/23 + version : 1.6 + date : 01/17/24 */ #ifndef FWRITE_C #define FWRITE_C /** OK 1910 fwrite : S L -> S -A list of integers are written as bytes to the current position of stream S. +[FOREIGN] A list of integers are written as bytes to the current position of +stream S. */ PRIVATE void fwrite_(pEnv env) { diff --git a/src/gc.c b/src/gc.c index b3f3a47..7051114 100644 --- a/src/gc.c +++ b/src/gc.c @@ -1,17 +1,19 @@ /* module : gc.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 01/22/24 */ #ifndef GC_C #define GC_C /** OK 3010 gc : -> -Initiates garbage collection. +[IMPURE] Initiates garbage collection. */ -PRIVATE void gc_(pEnv env) { GC_gcollect(); } - - - +PRIVATE void gc_(pEnv env) +{ + if (env->ignore) + return; + GC_gcollect(); +} #endif diff --git a/src/genrec.c b/src/genrec.c index 3c0d4f2..291bd43 100644 --- a/src/genrec.c +++ b/src/genrec.c @@ -1,7 +1,7 @@ /* module : genrec.c - version : 1.7 - date : 09/04/23 + version : 1.8 + date : 01/17/24 */ #ifndef GENREC_C #define GENREC_C @@ -18,6 +18,6 @@ PRIVATE void genrec_(pEnv env) cons_(env); cons_(env); cons_(env); - _genrec_(env); + genrecaux_(env); } #endif diff --git a/src/_genrec.c b/src/genrecaux.c similarity index 71% rename from src/_genrec.c rename to src/genrecaux.c index 7122c2d..bfa73ef 100644 --- a/src/_genrec.c +++ b/src/genrecaux.c @@ -1,17 +1,17 @@ /* - module : _genrec.c - version : 1.2 - date : 09/04/23 + module : genrecaux.c + version : 1.4 + date : 02/01/24 */ -#ifndef _GENREC_C -#define _GENREC_C +#ifndef GENRECAUX_C +#define GENRECAUX_C /** -OK 3140 (genrec) : [B] [T] [R1] [R2] -> ... +OK 3240 #genrec : [[B] [T] [R1] R2] -> ... Executes B, if that yields true, executes T. Else executes R1 and then [[[B] [T] [R1] R2] genrec] R2. */ -PRIVATE void _genrec_(pEnv env) +PRIVATE void genrecaux_(pEnv env) { int result; Node *program, *save, *temp; @@ -20,7 +20,7 @@ PRIVATE void _genrec_(pEnv env) POP(env->stck); save = env->stck; exeterm(env, program->u.lis->u.lis); /* [B] */ - CHECKSTACK("genrec"); + CHECKSTACK("genrecaux"); result = env->stck->u.num; env->stck = save; if (result) @@ -28,7 +28,7 @@ PRIVATE void _genrec_(pEnv env) else { exeterm(env, program->u.lis->next->next->u.lis);/* [R1] */ NULLARY(LIST_NEWNODE, program->u.lis); - temp = ANON_FUNCT_NEWNODE(_genrec_, 0); + temp = ANON_FUNCT_NEWNODE(genrecaux_, 0); NULLARY(LIST_NEWNODE, temp); cons_(env); exeterm(env, program->u.lis->next->next->next); /* [R2] */ diff --git a/src/get.c b/src/get.c index f093dcc..c518ca9 100644 --- a/src/get.c +++ b/src/get.c @@ -1,17 +1,22 @@ /* module : get.c - version : 1.4 - date : 09/04/23 + version : 1.6 + date : 01/22/24 */ #ifndef GET_C #define GET_C /** OK 3070 get : -> F -Reads a factor from input and pushes it onto stack. +[IMPURE] Reads a factor from input and pushes it onto stack. */ PRIVATE void get_(pEnv env) { + if (env->ignore) { + env->bucket.num = 0; + env->stck = newnode(env, INTEGER_, env->bucket, env->stck); + return; + } getsym(env); readfactor(env); } diff --git a/src/getch.c b/src/getch.c index eb6eb44..85e8c17 100644 --- a/src/getch.c +++ b/src/getch.c @@ -1,17 +1,22 @@ /* module : getch.c - version : 1.3 - date : 09/04/23 + version : 1.7 + date : 02/05/24 */ #ifndef GETCH_C #define GETCH_C /** -OK 3200 getch : -> N -[EXT] Reads a character from input and puts it onto stack. +OK 3160 getch : -> N +[IMPURE] Reads a character from input and puts it onto stack. */ -PRIVATE void getch_(pEnv env) { NULLARY(CHAR_NEWNODE, getchar()); } - - - +PRIVATE void getch_(pEnv env) +{ + if (env->ignore) { + env->bucket.num = 0; + env->stck = newnode(env, CHAR_, env->bucket, env->stck); + return; + } + NULLARY(CHAR_NEWNODE, fgetc(env->srcfile)); +} #endif diff --git a/src/gmtime.c b/src/gmtime.c index 349610e..b15c3f3 100644 --- a/src/gmtime.c +++ b/src/gmtime.c @@ -1,12 +1,12 @@ /* module : gmtime.c - version : 1.2 - date : 08/13/23 + version : 1.3 + date : 01/17/24 */ #ifndef GMTIME_C #define GMTIME_C -#ifdef WIN32 +#if defined(_MSC_VER) || defined(WIN32) void gmtime_r(time_t *t, struct tm *tm) { *tm = *gmtime(t); diff --git a/src/help.c b/src/help.c index c0e02ea..90e44fb 100644 --- a/src/help.c +++ b/src/help.c @@ -1,14 +1,14 @@ /* module : help.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 01/22/24 */ #ifndef HELP_C #define HELP_C /** OK 2900 help : -> -Lists all defined symbols, including those from library files. +[IMPURE] Lists all defined symbols, including those from library files. Then lists all primitives of raw Joy. (There is a variant: "_help" which lists hidden symbols). */ diff --git a/src/help.h b/src/help.h index 5ed0dd0..5a69445 100644 --- a/src/help.h +++ b/src/help.h @@ -1,30 +1,32 @@ /* module : help.h - version : 1.2 - date : 04/11/22 + version : 1.3 + date : 01/22/24 */ #ifndef HELP_H #define HELP_H -#define HELP(PROCEDURE, REL) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - int i = vec_size(env->symtab); \ - int column = 0; \ - int name_length; \ - Entry ent; \ - while (i) { \ - ent = vec_at(env->symtab, --i); \ - if (ent.name[0] REL '_' && !isdigit((int)ent.name[0])) { \ - name_length = strlen(ent.name) + 1; \ - if (column + name_length > 72) { \ - printf("\n"); \ - column = 0; \ - } \ - printf("%s ", ent.name); \ - column += name_length; \ - } \ - } \ - printf("\n"); \ +#define HELP(PROCEDURE, REL) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + int i = vec_size(env->symtab); \ + int column = 0; \ + int name_length; \ + Entry ent; \ + if (env->ignore) \ + return; \ + while (i) { \ + ent = vec_at(env->symtab, --i); \ + if (ent.name[0] REL '_' && !isdigit((int)ent.name[0])) { \ + name_length = strlen(ent.name) + 1; \ + if (column + name_length > 72) { \ + printf("\n"); \ + column = 0; \ + } \ + printf("%s ", ent.name); \ + column += name_length; \ + } \ + } \ + printf("\n"); \ } #endif diff --git a/src/helpdetail.c b/src/helpdetail.c index 4000f63..4429226 100644 --- a/src/helpdetail.c +++ b/src/helpdetail.c @@ -1,14 +1,14 @@ /* module : helpdetail.c - version : 1.10 - date : 09/07/23 + version : 1.12 + date : 01/22/24 */ #ifndef HELPDETAIL_C #define HELPDETAIL_C /** OK 2920 helpdetail : [ S1 S2 .. ] -> -Gives brief help on each symbol S in the list. +[IMPURE] Gives brief help on each symbol S in the list. */ PRIVATE void helpdetail_(pEnv env) { @@ -18,6 +18,10 @@ PRIVATE void helpdetail_(pEnv env) ONEPARAM("HELP"); LIST("HELP"); + if (env->ignore) { + POP(env->stck); + return; + } printf("\n"); n = nodevalue(env->stck).lis; while (n) { diff --git a/src/if_type.h b/src/if_type.h index c2837e1..5987327 100644 --- a/src/if_type.h +++ b/src/if_type.h @@ -1,21 +1,21 @@ /* module : if_type.h - version : 1.2 - date : 05/02/22 + version : 1.3 + date : 02/01/24 */ #ifndef IF_TYPE_H #define IF_TYPE_H -#define IF_TYPE(PROCEDURE, NAME, TYP) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - Node *first, *second; \ - THREEPARAMS(NAME); \ - TWOQUOTES(NAME); \ - second = env->stck->u.lis; \ - POP(env->stck); \ - first = env->stck->u.lis; \ - POP(env->stck); \ - exeterm(env, env->stck->op == TYP ? first : second); \ +#define IF_TYPE(PROCEDURE, NAME, TYP) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + Node *first, *second; \ + THREEPARAMS(NAME); \ + TWOQUOTES(NAME); \ + second = env->stck->u.lis; \ + POP(env->stck); \ + first = env->stck->u.lis; \ + POP(env->stck); \ + exeterm(env, env->stck->op == TYP ? first : second); \ } #endif diff --git a/src/iffile.c b/src/iffile.c index 98dc0b5..07566fd 100644 --- a/src/iffile.c +++ b/src/iffile.c @@ -1,14 +1,14 @@ /* module : iffile.c - version : 1.3 - date : 09/04/23 + version : 1.4 + date : 01/17/24 */ #ifndef IFFILE_C #define IFFILE_C /** OK 2680 iffile : X [T] [E] -> ... -If X is a file, executes T else executes E. +[FOREIGN] If X is a file, executes T else executes E. */ IF_TYPE(iffile_, "iffile", FILE_) diff --git a/src/include.c b/src/include.c index cc9ba12..1868953 100644 --- a/src/include.c +++ b/src/include.c @@ -1,7 +1,7 @@ /* module : include.c - version : 1.5 - date : 09/04/23 + version : 1.8 + date : 02/01/24 */ #ifndef INCLUDE_C #define INCLUDE_C @@ -11,7 +11,7 @@ OK 3110 include : "filnam.ext" -> Transfers input to file whose name is "filnam.ext". On end-of-file returns to previous input file. */ -USETOP(include_, "include", STRING, include(env, nodevalue(env->stck).str, 1)) +USETOP2(include_, "include", STRING, include(env, nodevalue(env->stck).str)) #endif diff --git a/src/inhas.h b/src/inhas.h index 43db212..f5f3b2b 100644 --- a/src/inhas.h +++ b/src/inhas.h @@ -1,41 +1,39 @@ /* module : inhas.h - version : 1.5 - date : 07/19/23 + version : 1.6 + date : 02/01/24 */ #ifndef INHAS_H #define INHAS_H -#define INHAS(PROCEDURE, NAME, AGGR, ELEM) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - int found = 0; \ - TWOPARAMS(NAME); \ - switch (nodetype(AGGR)) { \ - case SET_: \ - CHECKSETMEMBER(ELEM, NAME); \ - found \ - = ((nodevalue(AGGR).set) & ((int64_t)1 << nodevalue(ELEM).num))\ - > 0; \ - break; \ - case STRING_: { \ - char *s; \ - for (s = nodevalue(AGGR).str; \ - *s != '\0' && *s != nodevalue(ELEM).num; s++) \ - ; \ - found = *s != '\0'; \ - break; \ - } \ - case LIST_: { \ - Index n = nodevalue(AGGR).lis; \ - while (n && Compare(env, n, ELEM)) \ - n = nextnode1(n); \ - found = n != 0; \ - break; \ - } \ - default: \ - BADAGGREGATE(NAME); \ - } \ - BINARY(BOOLEAN_NEWNODE, found); \ +#define INHAS(PROCEDURE, NAME, AGGR, ELEM) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + int found = 0; \ + char *str; \ + Index node; \ + TWOPARAMS(NAME); \ + switch (nodetype(AGGR)) { \ + case SET_: \ + CHECKSETMEMBER(ELEM, NAME); \ + found = ((nodevalue(AGGR).set) & \ + ((int64_t)1 << nodevalue(ELEM).num)) > 0; \ + break; \ + case STRING_: \ + for (str = nodevalue(AGGR).str; \ + *str != '\0' && *str != nodevalue(ELEM).num; str++) \ + ; \ + found = *str != '\0'; \ + break; \ + case LIST_: \ + node = nodevalue(AGGR).lis; \ + while (node && Compare(env, node, ELEM)) \ + node = nextnode1(node); \ + found = node != 0; \ + break; \ + default: \ + BADAGGREGATE(NAME); \ + } \ + BINARY(BOOLEAN_NEWNODE, found); \ } #endif diff --git a/src/localtime.c b/src/localtime.c index 288cf06..c24fa5a 100644 --- a/src/localtime.c +++ b/src/localtime.c @@ -1,12 +1,12 @@ /* module : localtime.c - version : 1.2 - date : 08/13/23 + version : 1.3 + date : 01/17/24 */ #ifndef LOCALTIME_C #define LOCALTIME_C -#ifdef WIN32 +#if defined(_MSC_VER) || defined(WIN32) void localtime_r(time_t *t, struct tm *tm) { *tm = *localtime(t); diff --git a/src/manual.c b/src/manual.c index 5f768de..236887e 100644 --- a/src/manual.c +++ b/src/manual.c @@ -1,7 +1,7 @@ /* module : manual.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 01/22/24 */ #ifndef MANUAL_C #define MANUAL_C @@ -10,10 +10,12 @@ /** OK 2930 manual : -> -Writes this manual of all Joy primitives to output file. +[IMPURE] Writes this manual of all Joy primitives to output file. */ -PRIVATE void manual_(pEnv env) { make_manual(0); } - - - +PRIVATE void manual_(pEnv env) +{ + if (env->ignore) + return; + make_manual(0); +} #endif diff --git a/src/manual.h b/src/manual.h index d785d5a..23168d9 100644 --- a/src/manual.h +++ b/src/manual.h @@ -1,7 +1,7 @@ /* module : manual.h - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 02/01/24 */ #ifndef MANUAL_H #define MANUAL_H @@ -32,16 +32,15 @@ PRIVATE void make_manual(int style /* 0=plain, 1=HTML, 2=Latex */) if (HTML) printf("\n
\n"); for (i = BOOLEAN_; (n = opername(i)) != 0; i++) { - /* clang-format off */ HEADER(n, " truth value type", "literal") else HEADER(n, "false", "operand") else HEADER(n, "id", "operator") else HEADER(n, "null", "predicate") else HEADER(n, "i", "combinator") else HEADER(n, "help", "miscellaneous commands") else - HEADER(n, "casting", "additional commands") + HEADER(n, "casting", "additional commands") else + HEADER(n, "#genrec", "runtime commands") if (n[0] != '_') { - /* clang-format on */ if (HTML) printf("\n
"); else if (LATEX) { @@ -61,7 +60,7 @@ PRIVATE void make_manual(int style /* 0=plain, 1=HTML, 2=Latex */) printf(" : "); /* the above line does not produce the spaces around ":" */ else - printf("\t: "); + printf(" : "); printf("%s", optable[i].messg1); if (HTML) printf("\n
"); diff --git a/src/maxmin.h b/src/maxmin.h index 6eae8c7..244033c 100644 --- a/src/maxmin.h +++ b/src/maxmin.h @@ -1,34 +1,31 @@ /* module : maxmin.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef MAXMIN_H #define MAXMIN_H -#define MAXMIN(PROCEDURE, NAME, OPER) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - TWOPARAMS(NAME); \ - if (FLOATABLE2) { \ - BINARY(FLOAT_NEWNODE, \ - FLOATVAL OPER FLOATVAL2 ? FLOATVAL2 : FLOATVAL); \ - return; \ - } \ - SAME2TYPES(NAME); \ - NUMERICTYPE(NAME); \ - if (nodetype(env->stck) == CHAR_) \ - BINARY(CHAR_NEWNODE, nodevalue(env->stck) \ - .num OPER nodevalue(nextnode1(env->stck)) \ - .num \ - ? nodevalue(nextnode1(env->stck)).num \ - : nodevalue(env->stck).num); \ - else \ - BINARY( \ - INTEGER_NEWNODE, nodevalue(env->stck) \ - .num OPER nodevalue(nextnode1(env->stck)) \ - .num \ - ? nodevalue(nextnode1(env->stck)).num \ - : nodevalue(env->stck).num); \ +#define MAXMIN(PROCEDURE, NAME, OPER) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + TWOPARAMS(NAME); \ + if (FLOATABLE2) { \ + BINARY(FLOAT_NEWNODE, FLOATVAL OPER FLOATVAL2 ? \ + FLOATVAL2 : FLOATVAL); \ + return; \ + } \ + SAME2TYPES(NAME); \ + NUMERICTYPE(NAME); \ + if (nodetype(env->stck) == CHAR_) \ + BINARY(CHAR_NEWNODE, nodevalue(env->stck).num OPER \ + nodevalue(nextnode1(env->stck)).num ? \ + nodevalue(nextnode1(env->stck)).num : \ + nodevalue(env->stck).num); \ + else \ + BINARY(INTEGER_NEWNODE, nodevalue(env->stck).num OPER \ + nodevalue(nextnode1(env->stck)).num ? \ + nodevalue(nextnode1(env->stck)).num : \ + nodevalue(env->stck).num); \ } #endif diff --git a/src/n_ary.h b/src/n_ary.h index aa62d41..aa64d12 100644 --- a/src/n_ary.h +++ b/src/n_ary.h @@ -1,22 +1,22 @@ /* module : n_ary.h - version : 1.2 - date : 05/02/22 + version : 1.3 + date : 02/01/24 */ #ifndef N_ARY_H #define N_ARY_H -#define N_ARY(PROCEDURE, NAME, PARAMCOUNT, TOP) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - Node *save, *top; \ - PARAMCOUNT(NAME); \ - ONEQUOTE(NAME); \ - save = env->stck; \ - POP(env->stck); \ - top = TOP; \ - exeterm(env, save->u.lis); \ - CHECKVALUE(NAME); \ - env->stck = newnode(env, env->stck->op, env->stck->u, top); \ +#define N_ARY(PROCEDURE, NAME, PARAMCOUNT, TOP) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + Node *save, *top; \ + PARAMCOUNT(NAME); \ + ONEQUOTE(NAME); \ + save = env->stck; \ + POP(env->stck); \ + top = TOP; \ + exeterm(env, save->u.lis); \ + CHECKVALUE(NAME); \ + env->stck = newnode(env, env->stck->op, env->stck->u, top); \ } #endif diff --git a/src/ordchr.h b/src/ordchr.h index daf71d6..81e013c 100644 --- a/src/ordchr.h +++ b/src/ordchr.h @@ -1,16 +1,16 @@ /* module : ordchr.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef ORDCHR_H #define ORDCHR_H -#define ORDCHR(PROCEDURE, NAME, RESULTTYP) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - ONEPARAM(NAME); \ - NUMERICTYPE(NAME); \ - UNARY(RESULTTYP, nodevalue(env->stck).num); \ +#define ORDCHR(PROCEDURE, NAME, RESULTTYP) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + ONEPARAM(NAME); \ + NUMERICTYPE(NAME); \ + UNARY(RESULTTYP, nodevalue(env->stck).num); \ } #endif diff --git a/src/over.c b/src/over.c index 06cdd69..2f856c5 100644 --- a/src/over.c +++ b/src/over.c @@ -1,13 +1,13 @@ /* module : over.c - version : 1.2 - date : 09/04/23 + version : 1.4 + date : 02/05/24 */ #ifndef OVER_C #define OVER_C /** -OK 3210 over : X Y -> X Y X +OK 3170 over : X Y -> X Y X [EXT] Pushes an extra copy of the second item X on top of the stack. */ void over_(pEnv env) diff --git a/src/pick.c b/src/pick.c index 94e911a..291431e 100644 --- a/src/pick.c +++ b/src/pick.c @@ -1,13 +1,13 @@ /* module : pick.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 02/05/24 */ #ifndef PICK_C #define PICK_C /** -OK 3220 pick : X Y Z 2 -> X Y Z X +OK 3180 pick : X Y Z 2 -> X Y Z X [EXT] Pushes an extra copy of nth (e.g. 2) item X on top of the stack. */ void pick_(pEnv env) diff --git a/src/plusminus.h b/src/plusminus.h index e71ddb8..f1a834c 100644 --- a/src/plusminus.h +++ b/src/plusminus.h @@ -1,25 +1,23 @@ /* module : plusminus.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef PLUSMINUS_H #define PLUSMINUS_H -#define PLUSMINUS(PROCEDURE, NAME, OPER) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - TWOPARAMS(NAME); \ - FLOAT_I(OPER); \ - INTEGER(NAME); \ - NUMERIC2(NAME); \ - if (nodetype(nextnode1(env->stck)) == CHAR_) \ - BINARY(CHAR_NEWNODE, nodevalue(nextnode1(env->stck)) \ - .num OPER nodevalue(env->stck) \ - .num); \ - else \ - BINARY(INTEGER_NEWNODE, nodevalue(nextnode1(env->stck)) \ - .num OPER nodevalue(env->stck) \ - .num); \ +#define PLUSMINUS(PROCEDURE, NAME, OPER) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + TWOPARAMS(NAME); \ + FLOAT_I(OPER); \ + INTEGER(NAME); \ + NUMERIC2(NAME); \ + if (nodetype(nextnode1(env->stck)) == CHAR_) \ + BINARY(CHAR_NEWNODE, nodevalue(nextnode1(env->stck)).num \ + OPER nodevalue(env->stck).num); \ + else \ + BINARY(INTEGER_NEWNODE, nodevalue(nextnode1(env->stck)).num \ + OPER nodevalue(env->stck).num); \ } #endif diff --git a/src/predsucc.h b/src/predsucc.h index cebb631..12249c0 100644 --- a/src/predsucc.h +++ b/src/predsucc.h @@ -1,19 +1,19 @@ /* module : predsucc.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef PREDSUCC_H #define PREDSUCC_H -#define PREDSUCC(PROCEDURE, NAME, OPER) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - ONEPARAM(NAME); \ - NUMERICTYPE(NAME); \ - if (nodetype(env->stck) == CHAR_) \ - UNARY(CHAR_NEWNODE, nodevalue(env->stck).num OPER 1); \ - else \ - UNARY(INTEGER_NEWNODE, nodevalue(env->stck).num OPER 1); \ +#define PREDSUCC(PROCEDURE, NAME, OPER) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + ONEPARAM(NAME); \ + NUMERICTYPE(NAME); \ + if (nodetype(env->stck) == CHAR_) \ + UNARY(CHAR_NEWNODE, nodevalue(env->stck).num OPER 1); \ + else \ + UNARY(INTEGER_NEWNODE, nodevalue(env->stck).num OPER 1); \ } #endif diff --git a/src/push.h b/src/push.h index e49553b..c4e0e55 100644 --- a/src/push.h +++ b/src/push.h @@ -1,11 +1,11 @@ /* module : push.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 01/22/24 */ #ifndef PUSH_H #define PUSH_H -#define PUSH(PROCEDURE, CONSTRUCTOR, VALUE) \ +#define PUSH(PROCEDURE, CONSTRUCTOR, VALUE) \ PRIVATE void PROCEDURE(pEnv env) { NULLARY(CONSTRUCTOR, VALUE); } #endif diff --git a/src/push2.h b/src/push2.h new file mode 100644 index 0000000..b8af0d5 --- /dev/null +++ b/src/push2.h @@ -0,0 +1,19 @@ +/* + module : push2.h + version : 1.1 + date : 01/22/24 +*/ +#ifndef PUSH2_H +#define PUSH2_H + +#define PUSH2(PROCEDURE, CONSTRUCTOR, VALUE) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + if (env->ignore) { \ + env->bucket.num = 0; \ + env->stck = newnode(env, INTEGER_, env->bucket, env->stck); \ + return; \ + } \ + NULLARY(CONSTRUCTOR, VALUE); \ + } +#endif diff --git a/src/put.c b/src/put.c index 4fb4613..e0ab68f 100644 --- a/src/put.c +++ b/src/put.c @@ -1,14 +1,14 @@ /* module : put.c - version : 1.5 - date : 09/07/23 + version : 1.7 + date : 01/22/24 */ #ifndef PUT_C #define PUT_C /** OK 3080 put : X -> -Writes X to output, pops X off stack. +[IMPURE] Writes X to output, pops X off stack. */ USETOP(put_, "put", ONEPARAM, writefactor(env, env->stck, stdout); printf(" ")) diff --git a/src/putch.c b/src/putch.c index 0e8f887..97d28ee 100644 --- a/src/putch.c +++ b/src/putch.c @@ -1,17 +1,17 @@ /* module : putch.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 01/22/24 */ #ifndef PUTCH_C #define PUTCH_C /** OK 3090 putch : N -> -N : numeric, writes character whose ASCII is N. +[IMPURE] N : numeric, writes character whose ASCII is N. */ -USETOP( - putch_, "putch", NUMERICTYPE, printf("%c", (int)nodevalue(env->stck).num)) +USETOP(putch_, "putch", NUMERICTYPE, + printf("%c", (int)nodevalue(env->stck).num)) #endif diff --git a/src/putchars.c b/src/putchars.c index 6e67781..3345df6 100644 --- a/src/putchars.c +++ b/src/putchars.c @@ -1,14 +1,14 @@ /* module : putchars.c - version : 1.3 - date : 09/04/23 + version : 1.5 + date : 01/22/24 */ #ifndef PUTCHARS_C #define PUTCHARS_C /** OK 3100 putchars : "abc.." -> -Writes abc.. (without quotes) +[IMPURE] Writes abc.. (without quotes) */ USETOP(putchars_, "putchars", STRING, printf("%s", nodevalue(env->stck).str)) diff --git a/src/quit.c b/src/quit.c index 893cdbf..5aaa885 100644 --- a/src/quit.c +++ b/src/quit.c @@ -1,7 +1,7 @@ /* module : quit.c - version : 1.5 - date : 09/04/23 + version : 1.8 + date : 02/02/24 */ #ifndef QUIT_C #define QUIT_C @@ -15,10 +15,8 @@ Exit from Joy. */ PUBLIC void my_atexit(void (*proc)(pEnv)) { -#if 0 if (exit_index == DISPLAYMAX) return; -#endif table[exit_index++] = proc; } diff --git a/src/rand.c b/src/rand.c index 7452210..4765205 100644 --- a/src/rand.c +++ b/src/rand.c @@ -1,16 +1,16 @@ /* module : rand.c - version : 1.3 - date : 08/13/23 + version : 1.5 + date : 01/22/24 */ #ifndef RAND_C #define RAND_C /** OK 1150 rand : -> I -I is a random integer. +[IMPURE] I is a random integer. */ -PUSH(rand_, INTEGER_NEWNODE, rand()) +PUSH2(rand_, INTEGER_NEWNODE, rand()) diff --git a/src/round.c b/src/round.c index d638a8f..c2426d6 100644 --- a/src/round.c +++ b/src/round.c @@ -1,13 +1,13 @@ /* module : round.c - version : 1.2 - date : 09/04/23 + version : 1.3 + date : 02/01/24 */ #ifndef ROUND_C #define ROUND_C /** -OK 3230 round : F -> G +OK 3200 round : F -> G [EXT] G is F rounded to the nearest integer. */ double round2(double num) diff --git a/src/sametype.c b/src/sametype.c index 6a5adba..d231e7f 100644 --- a/src/sametype.c +++ b/src/sametype.c @@ -1,13 +1,13 @@ /* module : sametype.c - version : 1.4 - date : 09/04/23 + version : 1.5 + date : 02/01/24 */ #ifndef SAMETYPE_C #define SAMETYPE_C /** -OK 3240 sametype : X Y -> B +OK 3210 sametype : X Y -> B [EXT] Tests whether X and Y have the same type. */ PRIVATE void sametype_(pEnv env) diff --git a/src/setautoput.c b/src/setautoput.c index 9e6dea0..5b747a6 100644 --- a/src/setautoput.c +++ b/src/setautoput.c @@ -1,17 +1,22 @@ /* module : setautoput.c - version : 1.4 - date : 09/04/23 + version : 1.7 + date : 02/01/24 */ #ifndef SETAUTOPUT_C #define SETAUTOPUT_C /** OK 2980 setautoput : I -> -Sets value of flag for automatic put to I (if I = 0, none; +[IMPURE] Sets value of flag for automatic put to I (if I = 0, none; if I = 1, put; if I = 2, stack). */ -USETOP( - setautoput_, "setautoput", NUMERICTYPE, env->autoput = nodevalue(env->stck).num) - +PRIVATE void setautoput_(pEnv env) +{ + ONEPARAM("setautoput"); + NUMERICTYPE("setautoput"); + if (!env->ignore && !env->autoput_set) + env->autoput = nodevalue(env->stck).num; + POP(env->stck); +} #endif diff --git a/src/setecho.c b/src/setecho.c index 7f26402..da992a0 100644 --- a/src/setecho.c +++ b/src/setecho.c @@ -1,17 +1,22 @@ /* module : setecho.c - version : 1.4 - date : 09/04/23 + version : 1.7 + date : 02/01/24 */ #ifndef SETECHO_C #define SETECHO_C /** OK 3000 setecho : I -> -Sets value of echo flag for listing. +[IMPURE] Sets value of echo flag for listing. I = 0: no echo, 1: echo, 2: with tab, 3: and linenumber. */ -USETOP(setecho_, "setecho", NUMERICTYPE, env->echoflag = nodevalue(env->stck).num) - - +PRIVATE void setecho_(pEnv env) +{ + ONEPARAM("setecho"); + NUMERICTYPE("setecho"); + if (!env->ignore && !env->echoflag_set) + env->echoflag = nodevalue(env->stck).num; + POP(env->stck); +} #endif diff --git a/src/setsize.c b/src/setsize.c index 3d3c3f6..83e963a 100644 --- a/src/setsize.c +++ b/src/setsize.c @@ -1,13 +1,13 @@ /* module : setsize.c - version : 1.2 - date : 08/13/23 + version : 1.3 + date : 01/26/24 */ #ifndef SETSIZE_C #define SETSIZE_C /** -OK 1030 setsize : -> setsize +IMMEDIATE 1030 setsize : -> setsize Pushes the maximum number of elements in a set (platform dependent). Typically it is 32, and set members are in the range 0..31. */ diff --git a/src/setundeferror.c b/src/setundeferror.c index 032772e..c9e2d45 100644 --- a/src/setundeferror.c +++ b/src/setundeferror.c @@ -1,17 +1,22 @@ /* module : setundeferror.c - version : 1.4 - date : 09/04/23 + version : 1.7 + date : 02/01/24 */ #ifndef SETUNDEFERROR_C #define SETUNDEFERROR_C /** OK 2990 setundeferror : I -> -Sets flag that controls behavior of undefined functions +[IMPURE] Sets flag that controls behavior of undefined functions (0 = no error, 1 = error). */ -USETOP(setundeferror_, "setundeferror", NUMERICTYPE, - env->undeferror = nodevalue(env->stck).num) - +PRIVATE void setundeferror_(pEnv env) +{ + ONEPARAM("setundeferror"); + NUMERICTYPE("setundeferror"); + if (!env->ignore && !env->undeferror_set) + env->undeferror = nodevalue(env->stck).num; + POP(env->stck); +} #endif diff --git a/src/someall.h b/src/someall.h index d43a9dc..582d260 100644 --- a/src/someall.h +++ b/src/someall.h @@ -1,63 +1,59 @@ /* module : someall.h - version : 1.4 - date : 07/19/23 + version : 1.5 + date : 02/01/24 */ #ifndef SOMEALL_H #define SOMEALL_H -#define SOMEALL(PROCEDURE, NAME, INITIAL) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - int result = INITIAL; \ - Node *program, *my_dump, *save; \ - TWOPARAMS(NAME); \ - ONEQUOTE(NAME); \ - program = env->stck->u.lis; \ - POP(env->stck); \ - save = env->stck->next; \ - switch (env->stck->op) { \ - case SET_: { \ - int j; \ - uint64_t set = env->stck->u.set; \ - for (j = 0; j < SETSIZE && result == INITIAL; j++) { \ - if (set & ((int64_t)1 << j)) { \ - env->stck = INTEGER_NEWNODE(j, save); \ - exeterm(env, program); \ - CHECKSTACK(NAME); \ - if (env->stck->u.num != INITIAL) \ - result = 1 - INITIAL; \ - } \ - } \ - break; \ - } \ - case STRING_: { \ - char *s; \ - char *volatile ptr = GC_strdup(env->stck->u.str); \ - for (s = ptr; *s != '\0' && result == INITIAL; s++) { \ - env->stck = CHAR_NEWNODE(*s, save); \ - exeterm(env, program); \ - CHECKSTACK(NAME); \ - if (env->stck->u.num != INITIAL) \ - result = 1 - INITIAL; \ - } \ - break; \ - } \ - case LIST_: { \ - my_dump = env->stck->u.lis; \ - while (my_dump && result == INITIAL) { \ - env->stck = newnode(env, my_dump->op, my_dump->u, save); \ - exeterm(env, program); \ - CHECKSTACK(NAME); \ - if (env->stck->u.num != INITIAL) \ - result = 1 - INITIAL; \ - my_dump = my_dump->next; \ - } \ - break; \ - } \ - default: \ - BADAGGREGATE(NAME); \ - } \ - env->stck = BOOLEAN_NEWNODE(result, save); \ +#define SOMEALL(PROCEDURE, NAME, INITIAL) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + int j, result = INITIAL; \ + uint64_t set; \ + char *str, *volatile ptr; \ + Node *program, *my_dump, *save; \ + TWOPARAMS(NAME); \ + ONEQUOTE(NAME); \ + program = env->stck->u.lis; \ + POP(env->stck); \ + save = env->stck->next; \ + switch (env->stck->op) { \ + case SET_: \ + set = env->stck->u.set; \ + for (j = 0; j < SETSIZE && result == INITIAL; j++) \ + if (set & ((int64_t)1 << j)) { \ + env->stck = INTEGER_NEWNODE(j, save); \ + exeterm(env, program); \ + CHECKSTACK(NAME); \ + if (env->stck->u.num != INITIAL) \ + result = 1 - INITIAL; \ + } \ + break; \ + case STRING_: \ + ptr = GC_strdup(env->stck->u.str); \ + for (str = ptr; *str != '\0' && result == INITIAL; str++) { \ + env->stck = CHAR_NEWNODE(*str, save); \ + exeterm(env, program); \ + CHECKSTACK(NAME); \ + if (env->stck->u.num != INITIAL) \ + result = 1 - INITIAL; \ + } \ + break; \ + case LIST_: \ + my_dump = env->stck->u.lis; \ + while (my_dump && result == INITIAL) { \ + env->stck = newnode(env, my_dump->op, my_dump->u, save);\ + exeterm(env, program); \ + CHECKSTACK(NAME); \ + if (env->stck->u.num != INITIAL) \ + result = 1 - INITIAL; \ + my_dump = my_dump->next; \ + } \ + break; \ + default: \ + BADAGGREGATE(NAME); \ + } \ + env->stck = BOOLEAN_NEWNODE(result, save); \ } #endif diff --git a/src/srand.c b/src/srand.c index 4b20313..87166ac 100644 --- a/src/srand.c +++ b/src/srand.c @@ -1,14 +1,14 @@ /* module : srand.c - version : 1.3 - date : 08/13/23 + version : 1.5 + date : 01/22/24 */ #ifndef SRAND_C #define SRAND_C /** OK 1780 srand : I -> -Sets the random integer seed to integer I. +[IMPURE] Sets the random integer seed to integer I. */ USETOP(srand_, "srand", INTEGER, srand((unsigned)nodevalue(env->stck).num)) diff --git a/src/stderr.c b/src/stderr.c index 01a53a5..3ee560d 100644 --- a/src/stderr.c +++ b/src/stderr.c @@ -1,14 +1,14 @@ /* module : stderr.c - version : 1.2 - date : 08/13/23 + version : 1.4 + date : 01/26/24 */ #ifndef STDERR_C #define STDERR_C /** -OK 1190 stderr : -> S -Pushes the standard error stream. +IMMEDIATE 1190 stderr : -> S +[FOREIGN] Pushes the standard error stream. */ PUSH(stderr_, FILE_NEWNODE, stderr) diff --git a/src/stdin.c b/src/stdin.c index e3cfdf9..40ee9b6 100644 --- a/src/stdin.c +++ b/src/stdin.c @@ -1,14 +1,14 @@ /* module : stdin.c - version : 1.2 - date : 08/13/23 + version : 1.4 + date : 01/26/24 */ #ifndef STDIN_C #define STDIN_C /** -OK 1170 stdin : -> S -Pushes the standard input stream. +IMMEDIATE 1170 stdin : -> S +[FOREIGN] Pushes the standard input stream. */ PUSH(stdin_, FILE_NEWNODE, stdin) diff --git a/src/stdout.c b/src/stdout.c index 150921e..607d586 100644 --- a/src/stdout.c +++ b/src/stdout.c @@ -1,14 +1,14 @@ /* module : stdout.c - version : 1.2 - date : 08/13/23 + version : 1.4 + date : 01/26/24 */ #ifndef STDOUT_C #define STDOUT_C /** -OK 1180 stdout : -> S -Pushes the standard output stream. +IMMEDIATE 1180 stdout : -> S +[FOREIGN] Pushes the standard output stream. */ PUSH(stdout_, FILE_NEWNODE, stdout) diff --git a/src/system.c b/src/system.c index 1d89269..4f7c3be 100644 --- a/src/system.c +++ b/src/system.c @@ -1,17 +1,29 @@ /* module : system.c - version : 1.3 - date : 09/04/23 + version : 1.6 + date : 02/13/24 */ #ifndef SYSTEM_C #define SYSTEM_C /** OK 3020 system : "command" -> -Escapes to shell, executes string "command". +[IMPURE] Escapes to shell, executes string "command". The string may cause execution of another program. When that has finished, the process returns to Joy. */ -USETOP(system_, "system", STRING, (void)system(nodevalue(env->stck).str)) +PRIVATE void system_(pEnv env) +{ + int rv; + ONEPARAM("system"); + STRING("system"); + if (!env->ignore) { + if ((rv = system(nodevalue(env->stck).str)) != 0) { + fflush(stdout); + fprintf(stderr, "system: %d\n", rv); + } + } + POP(env->stck); +} #endif diff --git a/src/time.c b/src/time.c index 0f990fe..6aa890b 100644 --- a/src/time.c +++ b/src/time.c @@ -1,16 +1,16 @@ /* module : time.c - version : 1.5 - date : 08/13/23 + version : 1.7 + date : 01/22/24 */ #ifndef TIME_C #define TIME_C /** OK 1140 time : -> I -Pushes the current time (in seconds since the Epoch). +[IMPURE] Pushes the current time (in seconds since the Epoch). */ -PUSH(time_, INTEGER_NEWNODE, (int64_t)time(0)) +PUSH2(time_, INTEGER_NEWNODE, (int64_t)time(0)) diff --git a/src/treegenrec.c b/src/treegenrec.c index ae26357..4ff875c 100644 --- a/src/treegenrec.c +++ b/src/treegenrec.c @@ -1,7 +1,7 @@ /* module : treegenrec.c - version : 1.7 - date : 09/04/23 + version : 1.8 + date : 01/17/24 */ #ifndef TREEGENREC_C #define TREEGENREC_C @@ -17,6 +17,6 @@ PRIVATE void treegenrec_(pEnv env) THREEQUOTES("treegenrec"); cons_(env); cons_(env); - _treegenrec_(env); + treegenrecaux_(env); } #endif diff --git a/src/_treegenrec.c b/src/treegenrecaux.c similarity index 61% rename from src/_treegenrec.c rename to src/treegenrecaux.c index 5f8e3a5..b84ff3d 100644 --- a/src/_treegenrec.c +++ b/src/treegenrecaux.c @@ -1,27 +1,27 @@ /* - module : _treegenrec.c - version : 1.2 - date : 09/04/23 + module : treegenrecaux.c + version : 1.4 + date : 02/01/24 */ -#ifndef _TREEGENREC_C -#define _TREEGENREC_C +#ifndef TREEGENRECAUX_C +#define TREEGENRECAUX_C /** -OK 3150 (treegenrec) : T [O1] [O2] [C] -> ... +OK 3250 #treegenrec : T [[O1] [O2] C] -> ... T is a tree. If T is a leaf, executes O1. Else executes O2 and then [[[O1] [O2] C] treegenrec] C. */ -PRIVATE void _treegenrec_(pEnv env) +PRIVATE void treegenrecaux_(pEnv env) { Node *save, *temp; save = env->stck; POP(env->stck); - CHECKSTACK("treegenrec"); + CHECKSTACK("treegenrecaux"); if (env->stck->op == LIST_) { exeterm(env, save->u.lis->next->u.lis); /* [O2] */ GNULLARY(save->op, save->u); - temp = ANON_FUNCT_NEWNODE(_treegenrec_, 0); + temp = ANON_FUNCT_NEWNODE(treegenrecaux_, 0); NULLARY(LIST_NEWNODE, temp); cons_(env); exeterm(env, env->stck->u.lis->u.lis->next->next); /* [C] */ diff --git a/src/treerec.c b/src/treerec.c index dc1c7b3..8547c31 100644 --- a/src/treerec.c +++ b/src/treerec.c @@ -1,7 +1,7 @@ /* module : treerec.c - version : 1.6 - date : 09/04/23 + version : 1.7 + date : 01/17/24 */ #ifndef TREEREC_C #define TREEREC_C @@ -15,6 +15,6 @@ PRIVATE void treerec_(pEnv env) THREEPARAMS("treerec"); TWOQUOTES("treerec"); cons_(env); - _treerec_(env); + treerecaux_(env); } #endif diff --git a/src/_treerec.c b/src/treerecaux.c similarity index 61% rename from src/_treerec.c rename to src/treerecaux.c index f25d7ee..ea40c17 100644 --- a/src/_treerec.c +++ b/src/treerecaux.c @@ -1,21 +1,21 @@ /* - module : _treerec.c - version : 1.2 - date : 09/04/23 + module : treerecaux.c + version : 1.4 + date : 02/01/24 */ -#ifndef _TREEREC_C -#define _TREEREC_C +#ifndef TREERECAUX_C +#define TREERECAUX_C /** -OK 3160 (treerec) : T [O] [C] -> ... +OK 3260 #treerec : T [[O] C] -> ... T is a tree. If T is a leaf, executes O. Else executes [[[O] C] treerec] C. */ -PRIVATE void _treerec_(pEnv env) +PRIVATE void treerecaux_(pEnv env) { Node *temp; if (env->stck->next->op == LIST_) { - temp = ANON_FUNCT_NEWNODE(_treerec_, 0); + temp = ANON_FUNCT_NEWNODE(treerecaux_, 0); NULLARY(LIST_NEWNODE, temp); cons_(env); /* D [[[O] C] ANON_FUNCT_] */ exeterm(env, env->stck->u.lis->u.lis->next); diff --git a/src/type.h b/src/type.h index a2b76e0..fac3263 100644 --- a/src/type.h +++ b/src/type.h @@ -1,15 +1,15 @@ /* module : type.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef TYPE_H #define TYPE_H -#define TYPE(PROCEDURE, NAME, REL, TYP) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - ONEPARAM(NAME); \ - UNARY(BOOLEAN_NEWNODE, (nodetype(env->stck) REL TYP)); \ +#define TYPE(PROCEDURE, NAME, REL, TYP) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + ONEPARAM(NAME); \ + UNARY(BOOLEAN_NEWNODE, (nodetype(env->stck) REL TYP)); \ } #endif diff --git a/src/typeof.c b/src/typeof.c index 06f5b4e..75e876e 100644 --- a/src/typeof.c +++ b/src/typeof.c @@ -1,13 +1,13 @@ /* module : typeof.c - version : 1.2 - date : 09/04/23 + version : 1.4 + date : 02/01/24 */ #ifndef TYPEOF_C #define TYPEOF_C /** -OK 3250 typeof : X -> I +OK 3230 typeof : X -> I [EXT] Replace X by its type. */ void typeof_(pEnv env) diff --git a/src/ufloat.h b/src/ufloat.h index bc81053..bc582ea 100644 --- a/src/ufloat.h +++ b/src/ufloat.h @@ -1,16 +1,16 @@ /* module : ufloat.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 02/01/24 */ #ifndef UFLOAT_H #define UFLOAT_H -#define UFLOAT(PROCEDURE, NAME, FUNC) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - ONEPARAM(NAME); \ - FLOAT(NAME); \ - UNARY(FLOAT_NEWNODE, FUNC(FLOATVAL)); \ +#define UFLOAT(PROCEDURE, NAME, FUNC) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + ONEPARAM(NAME); \ + FLOAT(NAME); \ + UNARY(FLOAT_NEWNODE, FUNC(FLOATVAL)); \ } #endif diff --git a/src/unmktime.h b/src/unmktime.h index 53e4eef..91b5d5e 100644 --- a/src/unmktime.h +++ b/src/unmktime.h @@ -1,42 +1,42 @@ /* module : unmktime.h - version : 1.4 - date : 07/19/23 + version : 1.5 + date : 02/01/24 */ #ifndef UNMKTIME_H #define UNMKTIME_H -#define UNMKTIME(PROCEDURE, NAME, FUNC) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - struct tm t; \ - int64_t wday; \ - time_t timval; \ - Index *my_dump; \ - ONEPARAM(NAME); \ - INTEGER(NAME); \ - timval = env->stck->u.num; \ - FUNC(&timval, &t); \ - if ((wday = t.tm_wday) == 0) \ - wday = 7; \ - UNARY(LIST_NEWNODE, 0); \ - my_dump = &nodevalue(env->stck).lis; \ - *my_dump = INTEGER_NEWNODE((t.tm_year + 1900), 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = INTEGER_NEWNODE((t.tm_mon + 1), 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = INTEGER_NEWNODE(t.tm_mday, 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = INTEGER_NEWNODE(t.tm_hour, 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = INTEGER_NEWNODE(t.tm_min, 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = INTEGER_NEWNODE(t.tm_sec, 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = BOOLEAN_NEWNODE(t.tm_isdst, 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = INTEGER_NEWNODE(t.tm_yday, 0); \ - my_dump = &nextnode1(*my_dump); \ - *my_dump = INTEGER_NEWNODE(wday, 0); \ +#define UNMKTIME(PROCEDURE, NAME, FUNC) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + struct tm t; \ + int64_t wday; \ + time_t timval; \ + Index *my_dump; \ + ONEPARAM(NAME); \ + INTEGER(NAME); \ + timval = env->stck->u.num; \ + FUNC(&timval, &t); \ + if ((wday = t.tm_wday) == 0) \ + wday = 7; \ + UNARY(LIST_NEWNODE, 0); \ + my_dump = &nodevalue(env->stck).lis; \ + *my_dump = INTEGER_NEWNODE((t.tm_year + 1900), 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = INTEGER_NEWNODE((t.tm_mon + 1), 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = INTEGER_NEWNODE(t.tm_mday, 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = INTEGER_NEWNODE(t.tm_hour, 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = INTEGER_NEWNODE(t.tm_min, 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = INTEGER_NEWNODE(t.tm_sec, 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = BOOLEAN_NEWNODE(t.tm_isdst, 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = INTEGER_NEWNODE(t.tm_yday, 0); \ + my_dump = &nextnode1(*my_dump); \ + *my_dump = INTEGER_NEWNODE(wday, 0); \ } #endif diff --git a/src/usetop.h b/src/usetop.h index 74e51a2..70d541b 100644 --- a/src/usetop.h +++ b/src/usetop.h @@ -1,17 +1,18 @@ /* module : usetop.h - version : 1.1 - date : 05/21/21 + version : 1.2 + date : 01/22/24 */ #ifndef USETOP_H #define USETOP_H -#define USETOP(PROCEDURE, NAME, TYPE, BODY) \ - PRIVATE void PROCEDURE(pEnv env) \ - { \ - ONEPARAM(NAME); \ - TYPE(NAME); \ - BODY; \ - POP(env->stck); \ +#define USETOP(PROCEDURE, NAME, TYPE, BODY) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + ONEPARAM(NAME); \ + TYPE(NAME); \ + if (!env->ignore) \ + BODY; \ + POP(env->stck); \ } #endif diff --git a/src/usetop2.h b/src/usetop2.h new file mode 100644 index 0000000..ff5135c --- /dev/null +++ b/src/usetop2.h @@ -0,0 +1,17 @@ +/* + module : usetop2.h + version : 1.1 + date : 01/22/24 +*/ +#ifndef USETOP2_H +#define USETOP2_H + +#define USETOP2(PROCEDURE, NAME, TYPE, BODY) \ + PRIVATE void PROCEDURE(pEnv env) \ + { \ + ONEPARAM(NAME); \ + TYPE(NAME); \ + BODY; \ + POP(env->stck); \ + } +#endif diff --git a/test/test b/test/test new file mode 100644 index 0000000..e69de29 diff --git a/test/test01.joy b/test/test01.joy index 4672d6b..9ccc870 100644 --- a/test/test01.joy +++ b/test/test01.joy @@ -1,7 +1,7 @@ (* module : test01.joy - version : 1.3 - date : 04/13/22 + version : 1.4 + date : 02/13/24 *) 1 setundeferror. 2 setautoput. @@ -23,6 +23,9 @@ (* testing escape sequences *) "\b\t\n\v\f\r\'\"\v\\\a". +(* " <- this double quote is needed; testing escape sequence for character *) +'\007. + (* this should issue an error message if there are fewer than 3 digits *) "\007". diff --git a/test2/CMakeLists.txt b/test2/CMakeLists.txt index 712d7b9..5774612 100644 --- a/test2/CMakeLists.txt +++ b/test2/CMakeLists.txt @@ -1,7 +1,7 @@ # # module : CMakeLists.txt -# version : 1.9 -# date : 11/06/23 +# version : 1.10 +# date : 02/05/24 # macro(exe9 src) add_custom_target(${src}.out ALL @@ -76,7 +76,6 @@ exe9(fclose) exe9(feof) exe9(ferror) exe9(fflush) -exe9(fget) exe9(fgetch) exe9(fgets) exe9(file) diff --git a/test2/casting.joy b/test2/casting.joy index 6859aa2..bac83d7 100644 --- a/test2/casting.joy +++ b/test2/casting.joy @@ -1,13 +1,13 @@ (* module : casting.joy - version : 1.2 - date : 09/19/23 + version : 1.3 + date : 01/24/24 *) -[pop] first [pop] first casting [pop] first =. -1 false casting. -66 'A casting 'B =. -'A 10 casting 65 =. -123456789 {} casting {0 2 4 8 10 11 14 15 16 17 19 20 22 24 25 26} =. -0 [] casting [] equal. -1 1.1 casting 4.94066e-324 =. -argv stdin casting argv !=. +[pop] first 3 casting [pop] first =. +1 4 casting. +66 5 casting 'B =. +'A 6 casting 65 =. +123456789 7 casting {0 2 4 8 10 11 14 15 16 17 19 20 22 24 25 26} =. +0 9 casting [] equal. +1 10 casting 4.94066e-324 =. +argv 11 casting argv !=. diff --git a/test2/drop.joy b/test2/drop.joy index 5068834..585916d 100644 --- a/test2/drop.joy +++ b/test2/drop.joy @@ -1,12 +1,12 @@ (* module : drop.joy - version : 1.4 - date : 09/19/23 + version : 1.5 + date : 01/25/24 *) [1 2 3] 1 drop [2 3] equal. "test" 1 drop "est" =. {1 2 3} 1 drop {2 3} =. -# [1 2 3] 5 drop [] equal. -# "test" 5 drop "" =. -# {1 2 3} 5 drop {} =. +[1 2 3] 5 drop [] equal. +"test" 5 drop "" =. +{1 2 3} 5 drop {} =. diff --git a/test2/equal.joy b/test2/equal.joy index aee2187..19f7793 100644 --- a/test2/equal.joy +++ b/test2/equal.joy @@ -1,7 +1,7 @@ (* module : equal.joy - version : 1.6 - date : 09/19/23 + version : 1.7 + date : 01/25/24 *) DEFINE last == dup rest null [first] [rest last] branch. @@ -43,3 +43,7 @@ stdin argv equal false =. [1 2 3] [{3} {2} {1}] equal false =. [1 2 3] [[1] [2] [3]] equal false =. [[1 2 3] [4 5 6] [7 8 9]] [[1] [2] [3]] equal false =. + +{1 2 3} 3.14 equal false =. +3.14 {1 2 3} equal false =. +{1 2 3} "1 2 3" equal false =. diff --git a/test2/fget.joy b/test2/fget.joy deleted file mode 100644 index 485c547..0000000 --- a/test2/fget.joy +++ /dev/null @@ -1,10 +0,0 @@ -(* - module : fget.joy - version : 1.4 - date : 09/19/23 -*) -0 setautoput. -"fput.joy" "r" fopen -[file] [fget swap] while. -"end of fget\n" putchars pop. # pop file pointer -stack put. # contents of fput.joy diff --git a/test2/maxint.joy b/test2/maxint.joy index 3ad4131..d70aecb 100644 --- a/test2/maxint.joy +++ b/test2/maxint.joy @@ -1,6 +1,11 @@ (* module : maxint.joy - version : 1.4 - date : 09/19/23 + version : 1.5 + date : 01/25/24 *) maxint pred 9223372036854775806 =. + +99999999999999999999 (* 1.0e20 = *). + +99999999999999999999 +99999999999999999999 * (* 1.0e40 = *). diff --git a/test2/pick.joy b/test2/pick.joy index 8715855..700826a 100644 --- a/test2/pick.joy +++ b/test2/pick.joy @@ -1,6 +1,7 @@ (* module : pick.joy - version : 1.2 - date : 09/19/23 + version : 1.3 + date : 01/25/24 *) +1 2 3 10 pick 1 =. 1 2 3 4 5 2 pick 3 =. diff --git a/test2/putchars.joy b/test2/putchars.joy index ebac948..a79df8c 100644 --- a/test2/putchars.joy +++ b/test2/putchars.joy @@ -1,6 +1,10 @@ (* module : putchars.joy - version : 1.3 - date : 09/19/23 + version : 1.4 + date : 01/25/24 *) "test" putchars '\n putch. + +"Hello, World" 12 casting. + +'\001 1 =. diff --git a/test2/round.joy b/test2/round.joy index 4aa4ec2..d6693ca 100644 --- a/test2/round.joy +++ b/test2/round.joy @@ -1,7 +1,9 @@ (* module : round.joy - version : 1.2 - date : 09/19/23 + version : 1.3 + date : 01/25/24 *) -1.5 round -2 =. 1.5 round 2 =. + +2 round 2 =. diff --git a/test2/step.joy b/test2/step.joy index a4e759c..8f595a4 100644 --- a/test2/step.joy +++ b/test2/step.joy @@ -13,4 +13,4 @@ 0 [1 2 3] [] step 3 =. 0 "test" [] step 't =. -0 {1 2 3} [] step 1 =. +0 {1 2 3} [] step 3 =. diff --git a/test2/take.joy b/test2/take.joy index cc51676..678d637 100644 --- a/test2/take.joy +++ b/test2/take.joy @@ -1,8 +1,12 @@ (* module : take.joy - version : 1.7 - date : 09/19/23 + version : 1.8 + date : 01/25/24 *) [1 2 3] 2 take [1 2] equal. "test" 2 take "te" =. {1 2 3} 2 take {1 2} =. + +"te\001st" 10 take "te\001st" =. + +'\001 1 =. diff --git a/test2/test b/test2/test new file mode 100644 index 0000000..e69de29 diff --git a/utils.c b/utils.c index 83e6b09..32e88db 100644 --- a/utils.c +++ b/utils.c @@ -1,16 +1,18 @@ /* FILE: utils.c */ /* * module : utils.c - * version : 1.41 - * date : 09/19/23 + * version : 1.43 + * date : 02/12/24 */ #include "globals.h" #ifdef STATS static double nodes; -PRIVATE void report_nodes(void) +PRIVATE void report_nodes(pEnv env) { + if (!env->statistics) + return; fflush(stdout); fprintf(stderr, "%.0f nodes used\n", nodes); fprintf(stderr, "%.0f garbage collections\n", (double)GC_get_gc_no()); @@ -19,7 +21,7 @@ PRIVATE void report_nodes(void) PRIVATE void count_nodes(void) { if (++nodes == 1) - atexit(report_nodes); + my_atexit(report_nodes); } #endif @@ -43,12 +45,18 @@ PUBLIC Node *newnode(pEnv env, Operator o, Types u, Node *r) PUBLIC void my_memoryindex(pEnv env) { - env->bucket.num = GC_get_memory_use(); + if (env->ignore) + env->bucket.num = 0; + else + env->bucket.num = GC_get_memory_use(); env->stck = newnode(env, INTEGER_, env->bucket, env->stck); } PUBLIC void my_memorymax(pEnv env) { - env->bucket.num = GC_get_memory_use() + GC_get_free_bytes(); + if (env->ignore) + env->bucket.num = 0; + else + env->bucket.num = GC_get_memory_use() + GC_get_free_bytes(); env->stck = newnode(env, INTEGER_, env->bucket, env->stck); }