diff --git a/.gitignore b/.gitignore index d5182d9e..981907e4 100644 --- a/.gitignore +++ b/.gitignore @@ -3,7 +3,4 @@ moy.tar pars.c pars.h lexr.c -prim.c -prim.h -tabl.c bdwgc diff --git a/README.md b/README.md index 54367d56..97ba56b4 100644 --- a/README.md +++ b/README.md @@ -45,7 +45,7 @@ Implementation|Dependencies [Joy](https://github.com/Wodan58/Joy)| [joy1](https://github.com/Wodan58/joy1)|[BDW garbage collector](https://github.com/ivmai/bdwgc) -Documentation -------------- - +Documentation| +-------------| [Legacy Docs](https://wodan58.github.io) +[User Manual](https://wodan58.github.io/j09imp.html) diff --git a/appveyor.yml b/appveyor.yml index 16943f00..5d5bda42 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -26,4 +26,4 @@ install: build_script: - call "C:\Program Files\Microsoft Visual Studio\2022\Community\VC\Auxiliary\Build\vcvars64.bat" - cmake . - - cmake --build . + - cmake --build . --config Release diff --git a/arty.c b/arty.c index 75f1a134..fac0c7d3 100644 --- a/arty.c +++ b/arty.c @@ -1,7 +1,7 @@ /* module : arty.c - version : 1.11 - date : 02/12/24 + version : 1.12 + date : 03/05/24 */ #include "globals.h" @@ -56,7 +56,7 @@ PUBLIC int arity(pEnv env, NodeList *quot, int num) tab = readtable(node.u.ent); /* symbol table is w/o arity */ str = tab->arity; } else - str = operarity(node.u.proc); /* problem: lineair search */ + str = operarity(env, node.u.proc); for (; *str; str++) if (*str == 'A') /* add */ num++; diff --git a/build/usrlib.joy b/build/usrlib.joy index b9d6e49e..d60b8374 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/doc/MOYimplJOY.md b/doc/MOYimplJOY.md index 8c0220a7..173d8f07 100644 --- a/doc/MOYimplJOY.md +++ b/doc/MOYimplJOY.md @@ -7,13 +7,12 @@ Introduction This page presents a note about the technicalities of this Joy implementation. The mechanisms of this implementation differ from the [reference implementation](https://github.com/Wodan58/Joy). -The language itself should be the same. Implementation details ====================== This implementation uses vectors instead of linked lists and it recurses -without overflowing the stack. +without overflowing the hardware stack. The big advantage of stackless recursion is in the size of data structures that can be handled. A program that builds a list of integers in idiomatic fashion @@ -28,4 +27,3 @@ implemented, that is not recursive but still fails because `from-to-list` makes use of `linrec` and `linrec` recurses. This implementation succeeds where other implementations fail. -There is a downside: function calling is slower. diff --git a/eval.c b/eval.c index 1f76888c..eb1dae43 100644 --- a/eval.c +++ b/eval.c @@ -1,7 +1,7 @@ /* * module : eval.c - * version : 1.17 - * date : 02/12/24 + * version : 1.18 + * date : 03/05/24 */ #include "globals.h" @@ -21,16 +21,16 @@ PRIVATE void set_alarm(pEnv env) return; if (!init) { init = 1; - signal(SIGALRM, catch_alarm); /* install alarm clock */ + signal(SIGALRM, catch_alarm); /* install alarm clock */ } - alarm(ALARM); /* set alarm to trigger after ALARM seconds */ + alarm(ALARM); /* set alarm to trigger after ALARM seconds */ } PRIVATE void alarm_off(pEnv env) { if (!env->alarming) return; - alarm(0); /* set alarm off */ + alarm(0); /* set alarm off */ } #endif @@ -132,18 +132,18 @@ PUBLIC void exeterm(pEnv env, NodeList *list) } } #if ALARM - alarm_off(env); /* set alarm off */ + alarm_off(env); /* set alarm off */ #endif #ifdef TRACING - trace(env, stdout); /* final stack */ + trace(env, stdout); /* final stack */ #endif } /* nickname - return the name of an operator. If the operator starts with a - character that is not part of an identifier, then the nick name - is the part of the string after the first \0. The nick name - should be equal to the filename of the operator. + character that is not alphanumeric or underscore, then the nick + name is the part of the string after the first \0. The nick name + is sometimes equal to the filename that implements the operator. */ PRIVATE char *nickname(int ch) { @@ -160,55 +160,62 @@ PRIVATE char *nickname(int ch) } /* - showname - return the display name of an operator, not the filename. + showname - return the display name of a datatype, used in name. */ -PUBLIC char *showname(int i) +PUBLIC char *showname(int index) { OpTable *tab; - tab = readtable(i); + tab = readtable(index); return tab->name; } /* - operindex - return the optable entry for an operator. This requires search. + operindex - return the optable entry of an operator or combinator. */ -PUBLIC int operindex(proc_t proc) +PUBLIC int operindex(pEnv env, proc_t proc) { - int i; - OpTable *tab; + khiter_t key; - for (i = tablesize() - 1; i > 0; i--) { - tab = readtable(i); - if (tab->proc == proc) - return i; - } + if ((key = kh_get(Funtab, env->prim, (int64_t)proc)) != kh_end(env->prim)) + return kh_value(env->prim, key); return ANON_FUNCT_; /* if not found, return the index of ANON_FUNCT_ */ } /* cmpname - return the name of an operator, used in Compare. */ -PUBLIC char *cmpname(proc_t proc) +PUBLIC char *cmpname(pEnv env, proc_t proc) { - return nickname(operindex(proc)); + return nickname(operindex(env, proc)); } /* opername - return the name of an operator, used in writefactor. */ -PUBLIC char *opername(proc_t proc) +PUBLIC char *opername(pEnv env, proc_t proc) { - return showname(operindex(proc)); + return showname(operindex(env, proc)); } /* operarity - return the arity of an operator, used in arity. */ -PUBLIC char *operarity(proc_t proc) +PUBLIC char *operarity(pEnv env, proc_t proc) { OpTable *tab; - tab = readtable(operindex(proc)); + tab = readtable(operindex(env, proc)); return tab->arity; } + +/* + * qcode - return the qcode value of an operator or combinator. + */ +PUBLIC int operqcode(int index) +{ + OpTable *tab; + + tab = readtable(index); + return tab->qcode; +} diff --git a/globals.h b/globals.h index 91bec0bc..a9e0459a 100644 --- a/globals.h +++ b/globals.h @@ -1,7 +1,7 @@ /* module : globals.h - version : 1.32 - date : 02/12/24 + version : 1.35 + date : 03/05/24 */ #ifndef GLOBALS_H #define GLOBALS_H @@ -16,9 +16,13 @@ #include #ifdef _MSC_VER +#define WIN32_LEAN_AND_MEAN +#include #pragma warning(disable: 4244 4267) #else #include /* alarm function */ +#include +#include #endif /* @@ -40,7 +44,8 @@ /* configure */ #define INPSTACKMAX 10 #define INPLINEMAX 255 -#define BUFFERMAX 80 +#define BUFFERMAX 80 /* smaller buffer */ +#define MAXNUM 32 /* even smaller buffer */ #define DISPLAYMAX 10 /* nesting in HIDE & MODULE */ #define INIECHOFLAG 0 #define INIAUTOPUT 1 @@ -49,7 +54,7 @@ /* installation dependent */ #define SETSIZE (int)(CHAR_BIT * sizeof(uint64_t)) /* from limits.h */ -#define MAXINT INT64_MAX /* from stdint.h */ +#define MAXINT_ INT64_MAX /* from stdint.h */ typedef enum { ANYTYPE, @@ -77,7 +82,7 @@ typedef enum { MAXMIN, PREDSUCC, PLUSMINUS, - SIZE, + SIZE_, STEP, TAKE, CONCAT, @@ -90,7 +95,7 @@ typedef enum { FORMAT, FORMATF, CONS, - IN, + IN_, HAS, CASE, FIRST, @@ -157,7 +162,8 @@ typedef struct Node { The flags are used to distinguish between immediate and normal functions. */ typedef struct Entry { - char *name, is_user, flags; + char *name; + unsigned char is_user, flags; union { NodeList *body; proc_t proc; @@ -170,9 +176,11 @@ typedef struct Token { } Token; /* - The symbol table is accessed through a hash table. + The symbol table is accessed through two hash tables, one with name as + index; the other with function address as index, cast to int64_t. */ KHASH_MAP_INIT_STR(Symtab, pEntry) +KHASH_MAP_INIT_INT64(Funtab, pEntry) /* Global variables are stored locally in the main function. @@ -185,11 +193,11 @@ typedef struct Env { vector(Channel) *channel; #endif khash_t(Symtab) *hash; + khash_t(Funtab) *prim; NodeList *stck, *prog; /* stack, code, and quotations are vectors */ clock_t startclock; /* main */ char *pathname; char *filename; - char *output; /* output file/function */ char **g_argv; int g_argc; int token; /* yylex */ @@ -215,21 +223,20 @@ typedef struct Env { unsigned char undeferror; unsigned char undeferror_set; unsigned char tracegc; + unsigned char alarming; + unsigned char bytecoding; + unsigned char compiling; unsigned char debugging; unsigned char ignore; unsigned char overwrite; - unsigned char compiling; - unsigned char bytecoding; - unsigned char statistics; - unsigned char keyboard; - unsigned char preserve; + unsigned char printing; unsigned char quiet; - unsigned char norecurse; - unsigned char alarming; + unsigned char recurse; + unsigned char statistics; } Env; typedef struct OpTable { - char flags; + unsigned char qcode, flags; char *name; proc_t proc; char *arity, *messg1, *messg2; @@ -249,10 +256,11 @@ PUBLIC void compileprog(pEnv env, NodeList *list); /* eval.c */ PUBLIC void exeterm(pEnv env, NodeList *list); PUBLIC char *showname(int i); -PUBLIC int operindex(proc_t proc); -PUBLIC char *cmpname(proc_t proc); -PUBLIC char *opername(proc_t proc); -PUBLIC char *operarity(proc_t proc); +PUBLIC int operindex(pEnv env, proc_t proc); +PUBLIC char *cmpname(pEnv env, proc_t proc); +PUBLIC char *opername(pEnv env, proc_t proc); +PUBLIC char *operarity(pEnv env, proc_t proc); +PUBLIC int operqcode(int i); /* exec.c */ PUBLIC void execute(pEnv env, NodeList *list); /* lexr.l */ @@ -285,17 +293,17 @@ PUBLIC void push(pEnv env, int64_t num); PUBLIC void prime(pEnv env, Node node); PUBLIC Node pop(pEnv env); /* read.c */ -PUBLIC void readfactor(pEnv env) /* read a JOY factor */; +PUBLIC void readfactor(pEnv env); /* read a JOY factor */ PUBLIC void readterm(pEnv env); /* repl.c */ -PUBLIC void inisymboltable(pEnv env) /* initialise */; +PUBLIC void inisymboltable(pEnv env); /* initialise */ PUBLIC void lookup(pEnv env, char *name); PUBLIC void enteratom(pEnv env, char *name, NodeList *list); PUBLIC NodeList *newnode(Operator op, YYSTYPE u); /* save.c */ PUBLIC void save(pEnv env, NodeList *list, int num, int remove); /* scan.c */ -PUBLIC void inilinebuffer(pEnv env, int joy); +PUBLIC void inilinebuffer(pEnv env); PUBLIC void include(pEnv env, char *str); PUBLIC int yywrap(void); PUBLIC void my_error(char *str, YYLTYPE *bloc); @@ -318,7 +326,11 @@ PUBLIC void quit_(pEnv env); PUBLIC void initbytes(pEnv env); PUBLIC void bytecode(NodeList *list); /* code.c */ -PUBLIC void readbytes(pEnv env); +PUBLIC void readbytes(pEnv env, int skip); /* dump.c */ -PUBLIC void dumpbytes(pEnv env); +PUBLIC void dumpbytes(pEnv env, int skip); +/* optm.c */ +PUBLIC void rewritebic(char *file); +/* kraw.c */ +PUBLIC void enableRawMode(pEnv env); #endif diff --git a/lexr.l b/lexr.l index 53298759..ea6a099e 100644 --- a/lexr.l +++ b/lexr.l @@ -1,8 +1,8 @@ %{ /* module : lexr.l - version : 1.27 - date : 02/13/24 + version : 1.28 + date : 03/05/24 */ #include "globals.h" @@ -131,12 +131,12 @@ MODULE[ \t]* return MODULE; {character} { yylval.num = ChrVal(env, yytext + 1); return CHAR_; } {octal} | -{hexal} { yylval.num = strtoll(yytext, 0, 0); if (yylval.num == MAXINT) +{hexal} { yylval.num = strtoll(yytext, 0, 0); if (yylval.num == MAXINT_) { yylval.dbl = strtod(yytext, 0); return FLOAT_; } return INTEGER_; } {integer} { yylval.num = strtoll(yytext + (yytext[0] == '-' ? 1 : 0), 0, 0); - if (yylval.num == MAXINT) { + if (yylval.num == MAXINT_) { #ifdef USE_BIGNUM_ARITHMETIC yylval.str = GC_strdup(yytext); return BIGNUM_; diff --git a/lib/usrlib.joy b/lib/usrlib.joy index b9d6e49e..d60b8374 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 e45b552d..804de218 100644 --- a/main.c +++ b/main.c @@ -1,7 +1,7 @@ /* * module : main.c - * version : 1.30 - * date : 02/13/24 + * version : 1.31 + * date : 03/05/24 */ #include "globals.h" @@ -17,6 +17,7 @@ char *bottom_of_stack; /* used in gc.c */ */ PUBLIC void abortexecution_(int num) { + fflush(yyin); longjmp(begin, num); } @@ -96,17 +97,9 @@ PRIVATE void copyright(char *file) #ifdef SYMBOLS PRIVATE void dump_table(pEnv env) { - khint_t k; + int i; Entry ent; - int i, j = 0; - for (k = kh_begin(env->hash); k != kh_end(env->hash); k++) - if (kh_exist(env->hash, k)) { - i = printf("(%d) %s\n", kh_val(env->hash, k), kh_key(env->hash, k)); - if (j < i) - j = i; - } - printf("%*.*s\n", j, j, "------------------------------------------------"); for (i = vec_size(env->symtab) - 1; i >= 0; i--) { ent = vec_at(env->symtab, i); if (!ent.is_user) @@ -255,25 +248,31 @@ PRIVATE void options(pEnv env) printf(" -h : print this help text and exit\n"); #ifdef SETTINGS printf(" -i : ignore impure functions\n"); +#endif +#if defined(BYTECODE) || defined(COMPILER) printf(" -j : filename parameter is a .joy file\n"); -#if 0 - printf(" -k : allow keyboard editing and history\n"); #endif +#ifdef KEYBOARD + printf(" -k : allow keyboard input in raw mode\n"); +#endif +#ifdef SETTINGS printf(" -l : do not read usrlib.joy at startup\n"); #endif #ifdef STATS printf(" -m : set maximum limit of data stack\n"); printf(" -n : limit the number of operations\n"); #endif -#if 0 #if defined(BYTECODE) || defined(COMPILER) printf(" -o : name of output file/function\n"); #endif +#ifdef TOKENS + printf(" -p : print debug list of tokens\n"); +#endif #ifdef SETTINGS - printf(" -p : preserve joy1 semantics\n"); printf(" -q : operate in quiet mode\n"); - printf(" -r : print without using recursion\n"); #endif +#ifdef WRITE_USING_RECURSION + printf(" -r : print without using recursion\n"); #endif #ifdef SYMBOLS printf(" -s : dump symbol table after execution\n"); @@ -311,9 +310,20 @@ PRIVATE void unknown_opt(pEnv env, char *exe, int ch) PRIVATE int my_main(int argc, char **argv) { - static unsigned char mustinclude = 1, joy = 1; /* assume .joy */ +/* + * These variables need to be static because of an intervening longjmp. + */ + static unsigned char mustinclude = 1, joy = 0; +#ifdef BYTECODE + static unsigned char skip = 6; +#endif + int i, j, ch; - char *ptr, *exe; /* joy binary */ + char *ptr, *exe; /* joy binary */ +/* + * A number of flags can be handled within the main function; no need to pass + * them to subordinate functions. + */ unsigned char helping = 0, unknown = 0; #ifdef COPYRIGHT unsigned char verbose = 1; @@ -323,6 +333,10 @@ PRIVATE int my_main(int argc, char **argv) #endif #ifdef BYTECODE unsigned char listing = 0; + char *filename = "a.out"; /* filename when rewriting */ +#endif +#ifdef KEYBOARD + unsigned char raw = 0; #endif Env env; /* global variables */ @@ -335,7 +349,6 @@ PRIVATE int my_main(int argc, char **argv) #ifdef STATS my_atexit(report_clock); #endif - setbuf(stdout, 0); vec_init(env.tokens); vec_init(env.symtab); #ifdef USE_MULTI_THREADS_JOY @@ -372,7 +385,8 @@ PRIVATE int my_main(int argc, char **argv) switch (argv[i][j]) { #ifdef SETTINGS case 'a' : ptr = &argv[i][j + 1]; - env.autoput = atoi(ptr); /* numeric payload */ + if (!env.autoput_set) + env.autoput = atoi(ptr);/* numeric payload */ env.autoput_set = 1; ch = *ptr; /* first digit */ while (isdigit(ch)) { @@ -420,9 +434,17 @@ PRIVATE int my_main(int argc, char **argv) case 'h' : helping = 1; break; #ifdef SETTINGS case 'i' : env.ignore = 1; break; - case 'j' : joy = 2; break; /* enforce .joy */ - case 'k' : env.keyboard = 1; break; - case 'l' : mustinclude = 0; break; +#endif +#if defined(BYTECODE) || defined(COMPILER) + case 'j' : joy = 1; break; /* enforce .joy */ +#endif +#ifdef KEYBOARD + case 'k' : raw = 1; env.autoput = 0; /* terminal raw mode */ + env.autoput_set = 1; /* prevent override */ + break; /* & disable autoput */ +#endif +#ifdef SETTINGS + case 'l' : mustinclude = 0; break; /* include usrlib.joy */ #endif #ifdef STATS case 'm' : ptr = &argv[i][j + 1]; @@ -445,22 +467,17 @@ PRIVATE int my_main(int argc, char **argv) break; #endif #if defined(BYTECODE) || defined(COMPILER) - case 'o' : ptr = &argv[i][j + 1]; - env.output = ptr; /* string payload */ + case 'o' : filename = &argv[i][j + 1]; /* string payload */ goto next_parm; #endif +#ifdef TOKENS + case 'p' : env.printing = 1; break; +#endif #ifdef SETTINGS - case 'p' : ptr = &argv[i][j + 1]; - env.preserve = atoi(ptr); /* numeric payload */ - ch = *ptr; /* first digit */ - while (isdigit(ch)) { - j++; /* point last digit */ - ptr++; - ch = *ptr; - } - break; case 'q' : env.quiet = 1; break; - case 'r' : env.norecurse = 1; break; +#endif +#ifdef WRITE_USING_RECURSION + case 'r' : env.recurse = 1; break; #endif #ifdef SYMBOLS case 's' : symdump = 1; break; @@ -519,13 +536,20 @@ PRIVATE int my_main(int argc, char **argv) ch = argv[i][0]; if (!isdigit(ch)) { /* - * If the filename parameter has no extension or an extension - * different from .joy, it is assumed to be a binary file. + * If the filename parameter has no extension or an extension that + * differs from .joy, it is assumed to be a binary file. */ - if (joy == 1) { - ptr = strrchr(argv[i], '.'); - if (!ptr || strcmp(ptr, ".joy")) - joy = 0; + if (!joy) { + if ((ptr = strrchr(argv[i], '.')) == argv[i]) + ptr = 0; + if (ptr) { +#ifdef BYTECODE + if (!strcmp(ptr, ".bic")) /* extension .bic */ + skip = 0; +#endif + if (!strcmp(ptr, ".joy")) /* extension .joy */ + joy = 1; + } } if ((yyin = fopen(argv[i], joy ? "r" : "rb")) == 0) { fprintf(stderr, "failed to open the file '%s'.\n", argv[i]); @@ -571,24 +595,36 @@ PRIVATE int my_main(int argc, char **argv) options(&env); /* might print symbol table */ if (unknown) unknown_opt(&env, exe, unknown); + inilinebuffer(&env); inisymboltable(&env); #ifdef BYTECODE if (listing) - dumpbytes(&env); /* might print symbol table */ - if (env.bytecoding) - initbytes(&env); /* uses symtab and filename */ + dumpbytes(&env, skip); /* calls quit_; might print symbol table */ + if (env.bytecoding) { + if (joy) + initbytes(&env); /* create .bic file; uses symtab and filename */ + else { + rewritebic(filename); + quit_(&env); /* quit_ might print symbol table */ + } + } #endif #ifdef COMPILER if (env.compiling) initcompile(&env); /* uses symtab and filename */ #endif - inilinebuffer(&env, joy && !env.bytecoding && !env.compiling); env.stck = pvec_init(); /* start with an empty stack */ +#ifdef KEYBOARD + if (raw) + enableRawMode(&env); /* needs to be done only once */ + else +#endif + setbuf(stdout, 0); /* necessary when writing to a pipe */ setjmp(begin); /* return here after error or abort */ env.prog = pvec_init(); /* restart with an empty program */ #ifdef BYTECODE - if (!joy) - readbytes(&env); /* might print symbol table */ + if (!joy) /* process .bic file instead of .joy file */ + readbytes(&env, skip); /* calls quit_; might print symbol table */ #endif if (mustinclude) { mustinclude = 0; /* try including only once */ diff --git a/otab.c b/otab.c index 79c7e97d..22434196 100644 --- a/otab.c +++ b/otab.c @@ -1,10 +1,10 @@ /* module : otab.c - version : 1.4 - date : 02/01/24 + version : 1.5 + date : 03/05/24 */ #include "globals.h" -#include "prim.h" +#include "prim.h" /* declarations of functions */ #ifdef NCHECK #define PARM(n, m) @@ -12,65 +12,64 @@ #define PARM(n, m) parm(env, n, m, __FILE__) #endif +/* + * Specify number of quotations that a combinator consumes. + */ +enum { + Q0, + Q1, + Q2, + Q3, + Q4 +}; + static OpTable optable[] = { /* THESE MUST BE DEFINED IN THE ORDER OF THEIR VALUES */ -{OK, "__ILLEGAL", id_, "U", "->", +{Q0, OK, "__ILLEGAL", id_, "U", "->", "internal error, cannot happen - supposedly."}, -{OK, "__COPIED", id_, "U", "->", +{Q0, OK, "__COPIED", id_, "U", "->", "no message ever, used for gc."}, -{OK, "__USR", id_, "U", "->", +{Q0, OK, "__USR", id_, "U", "->", "user node."}, -{OK, "__ANON_FUNCT", id_, "U", "->", +{Q0, OK, "__ANON_FUNCT", id_, "U", "->", "op for anonymous function call."}, /* LITERALS */ -{OK, " truth value type", id_, "A", "-> B", +{Q0, OK, " truth value type", id_, "A", "-> B", "The logical type, or the type of truth values.\nIt has just two literals: true and false."}, -{OK, " character type", id_, "A", "-> C", +{Q0, OK, " character type", id_, "A", "-> C", "The type of characters. Literals are written with a single quote.\nExamples: 'A '7 '; and so on. Unix style escapes are allowed."}, -{OK, " integer type", id_, "A", "-> I", +{Q0, OK, " integer type", id_, "A", "-> I", "The type of negative, zero or positive integers.\nLiterals are written in decimal notation. Examples: -123 0 42."}, -{OK, " set type", id_, "A", "-> {...}", +{Q0, OK, " set type", id_, "A", "-> {...}", "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_, "A", "-> \"...\"", +{Q0, OK, " string type", id_, "A", "-> \"...\"", "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_, "A", "-> [...]", +{Q0, OK, " list type", id_, "A", "-> [...]", "The type of lists of values of any type (including lists),\nor the type of quoted programs which may contain operators or combinators.\nLiterals of this type are written inside square brackets.\nExamples: [] [3 512 -7] [john mary] ['A 'C ['B]] [dup *]."}, -{OK, " float type", id_, "A", "-> F", +{Q0, OK, " float type", id_, "A", "-> F", "The type of floating-point numbers.\nLiterals of this type are written with embedded decimal points (like 1.2)\nand optional exponent specifiers (like 1.5E2)."}, -{OK, " file type", id_, "A", "-> FILE:", +{Q0, OK, " file type", id_, "A", "-> FILE:", "The type of references to open I/O streams,\ntypically but not necessarily files.\nThe only literals of this type are stdin, stdout, and stderr."}, -{OK, " bignum type", id_, "A", "-> F", +{Q0, OK, " bignum type", id_, "A", "-> F", "The type of arbitrary precision floating-point numbers.\nLiterals of this type are written with embedded decimal points (like 1.2)\nand optional exponent specifiers (like 1.5E2)."}, -#include "tabl.c" +#include "tabl.c" /* the rest of optable */ }; -#include "prim.c" - -/* - readtable - return a pointer into optable; when looping, the index i - is increased from 0 onwards until the index becomes invalid. -*/ -PUBLIC OpTable *readtable(int i) -{ - int size; - - size = sizeof(optable) / sizeof(optable[0]); - return i >= 0 && i < size ? &optable[i] : 0; -} +#include "prim.c" /* the primitive functions themselves */ /* * tablesize - return the size of the table, to be used when searching from the @@ -80,3 +79,15 @@ PUBLIC int tablesize(void) { return sizeof(optable) / sizeof(optable[0]); } + +/* + readtable - return a pointer into optable; when looping, the index i is + increased from 0 onwards until the index becomes invalid. +*/ +PUBLIC OpTable *readtable(int i) +{ + int size; + + size = tablesize(); + return i >= 0 && i < size ? &optable[i] : 0; +} diff --git a/parm.c b/parm.c index b0549b3c..f764c577 100644 --- a/parm.c +++ b/parm.c @@ -1,7 +1,7 @@ /* module : parm.c - date : 1.12 - version : 11/16/23 + date : 1.14 + version : 03/05/24 */ #include "globals.h" @@ -342,7 +342,7 @@ PUBLIC void parm(pEnv env, int num, Params type, char *file) /* aggregate parameter is needed: */ - case SIZE: + case SIZE_: if (leng < 1) execerror(env->filename, "one parameter", file); first = pvec_lst(env->stck); @@ -538,7 +538,7 @@ PUBLIC void parm(pEnv env, int num, Params type, char *file) /* set member: */ - case IN: + case IN_: if (leng < 2) execerror(env->filename, "two parameters", file); first = pvec_lst(env->stck); diff --git a/prim.c b/prim.c new file mode 100644 index 00000000..390bb513 --- /dev/null +++ b/prim.c @@ -0,0 +1,243 @@ +#include "./src/__dump.c" +#include "./src/__html_manual.c" +#include "./src/__latex_manual.c" +#include "./src/__manual_list.c" +#include "./src/__memoryindex.c" +#include "./src/__memorymax.c" +#include "./src/__settracegc.c" +#include "./src/__symtabindex.c" +#include "./src/__symtabmax.c" +#include "./src/_help.c" +#include "./src/abort.c" +#include "./src/abs.c" +#include "./src/acos.c" +#include "./src/all.c" +#include "./src/and.c" +#include "./src/app1.c" +#include "./src/app11.c" +#include "./src/app12.c" +#include "./src/app2.c" +#include "./src/app3.c" +#include "./src/app4.c" +#include "./src/argc.c" +#include "./src/argv.c" +#include "./src/asin.c" +#include "./src/at.c" +#include "./src/atan.c" +#include "./src/atan2.c" +#include "./src/autoput.c" +#include "./src/binary.c" +#include "./src/binrec.c" +#include "./src/body.c" +#include "./src/branch.c" +#include "./src/case.c" +#include "./src/casting.c" +#include "./src/ceil.c" +#include "./src/char.c" +#include "./src/choice.c" +#include "./src/chr.c" +#include "./src/cleave.c" +#include "./src/clock.c" +#include "./src/compare.c" +#include "./src/concat.c" +#include "./src/cond.c" +#include "./src/condlinrec.c" +#include "./src/condnestrec.c" +#include "./src/cons.c" +#include "./src/construct.c" +#include "./src/conts.c" +#include "./src/cos.c" +#include "./src/cosh.c" +#include "./src/cpush.c" +#include "./src/cswap.c" +#include "./src/dip.c" +#include "./src/div.c" +#include "./src/divide.c" +#include "./src/drop.c" +#include "./src/dup.c" +#include "./src/dupd.c" +#include "./src/echo.c" +#include "./src/enconcat.c" +#include "./src/eql.c" +#include "./src/equal.c" +#include "./src/exit.c" +#include "./src/exp.c" +#include "./src/false.c" +#include "./src/fclose.c" +#include "./src/feof.c" +#include "./src/ferror.c" +#include "./src/fflush.c" +#include "./src/fgetch.c" +#include "./src/fgets.c" +#include "./src/file.c" +#include "./src/filetime.c" +#include "./src/filter.c" +#include "./src/first.c" +#include "./src/fjump.c" +#include "./src/float.c" +#include "./src/floor.c" +#include "./src/fold.c" +#include "./src/fopen.c" +#include "./src/format.c" +#include "./src/formatf.c" +#include "./src/fpush.c" +#include "./src/fput.c" +#include "./src/fputch.c" +#include "./src/fputchars.c" +#include "./src/fputstring.c" +#include "./src/fread.c" +#include "./src/fremove.c" +#include "./src/frename.c" +#include "./src/frexp.c" +#include "./src/fseek.c" +#include "./src/ftell.c" +#include "./src/fwrite.c" +#include "./src/gc.c" +#include "./src/genrec.c" +#include "./src/genrecaux.c" +#include "./src/geql.c" +#include "./src/get.c" +#include "./src/getch.c" +#include "./src/getenv.c" +#include "./src/gmtime.c" +#include "./src/greater.c" +#include "./src/has.c" +#include "./src/help.c" +#include "./src/helpdetail.c" +#include "./src/i.c" +#include "./src/id.c" +#include "./src/ifchar.c" +#include "./src/iffile.c" +#include "./src/iffloat.c" +#include "./src/ifinteger.c" +#include "./src/iflist.c" +#include "./src/iflogical.c" +#include "./src/ifset.c" +#include "./src/ifstring.c" +#include "./src/ifte.c" +#include "./src/in.c" +#include "./src/include.c" +#include "./src/infra.c" +#include "./src/integer.c" +#include "./src/intern.c" +#include "./src/jfalse.c" +#include "./src/jump.c" +#include "./src/kill.c" +#include "./src/ldexp.c" +#include "./src/leaf.c" +#include "./src/leql.c" +#include "./src/less.c" +#include "./src/linrec.c" +#include "./src/list.c" +#include "./src/localtime.c" +#include "./src/log.c" +#include "./src/log10.c" +#include "./src/logical.c" +#include "./src/manual.c" +#include "./src/map.c" +#include "./src/max.c" +#include "./src/maxint.c" +#include "./src/min.c" +#include "./src/minus.c" +#include "./src/mktime.c" +#include "./src/modf.c" +#include "./src/mul.c" +#include "./src/name.c" +#include "./src/neg.c" +#include "./src/neql.c" +#include "./src/not.c" +#include "./src/null.c" +#include "./src/nullary.c" +#include "./src/of.c" +#include "./src/opcase.c" +#include "./src/or.c" +#include "./src/ord.c" +#include "./src/over.c" +#include "./src/pfalse.c" +#include "./src/pick.c" +#include "./src/plus.c" +#include "./src/pop.c" +#include "./src/popd.c" +#include "./src/pow.c" +#include "./src/pred.c" +#include "./src/primrec.c" +#include "./src/push.c" +#include "./src/put.c" +#include "./src/putch.c" +#include "./src/putchars.c" +#include "./src/quit.c" +#include "./src/radix.c" +#include "./src/rand.c" +#include "./src/recv.c" +#include "./src/rem.c" +#include "./src/rest.c" +#include "./src/rolldown.c" +#include "./src/rolldownd.c" +#include "./src/rollup.c" +#include "./src/rollupd.c" +#include "./src/rotate.c" +#include "./src/rotated.c" +#include "./src/round.c" +#include "./src/sametype.c" +#include "./src/scale.c" +#include "./src/send.c" +#include "./src/set.c" +#include "./src/setautoput.c" +#include "./src/setecho.c" +#include "./src/setsize.c" +#include "./src/setundeferror.c" +#include "./src/sign.c" +#include "./src/sin.c" +#include "./src/sinh.c" +#include "./src/size.c" +#include "./src/small.c" +#include "./src/some.c" +#include "./src/split.c" +#include "./src/spush.c" +#include "./src/sqrt.c" +#include "./src/srand.c" +#include "./src/stack.c" +#include "./src/stderr.c" +#include "./src/stdin.c" +#include "./src/stdout.c" +#include "./src/step.c" +#include "./src/strftime.c" +#include "./src/string.c" +#include "./src/strtod.c" +#include "./src/strtol.c" +#include "./src/strue.c" +#include "./src/succ.c" +#include "./src/swap.c" +#include "./src/swapd.c" +#include "./src/swons.c" +#include "./src/system.c" +#include "./src/tailrec.c" +#include "./src/take.c" +#include "./src/tan.c" +#include "./src/tanh.c" +#include "./src/task.c" +#include "./src/ternary.c" +#include "./src/time.c" +#include "./src/times.c" +#include "./src/tpush.c" +#include "./src/treegenrec.c" +#include "./src/treegenrecaux.c" +#include "./src/treerec.c" +#include "./src/treerecaux.c" +#include "./src/treestep.c" +#include "./src/true.c" +#include "./src/trunc.c" +#include "./src/typeof.c" +#include "./src/unary.c" +#include "./src/unary2.c" +#include "./src/unary3.c" +#include "./src/unary4.c" +#include "./src/uncons.c" +#include "./src/undeferror.c" +#include "./src/undefs.c" +#include "./src/unstack.c" +#include "./src/unswons.c" +#include "./src/user.c" +#include "./src/while.c" +#include "./src/x.c" +#include "./src/xor.c" diff --git a/prim.h b/prim.h new file mode 100644 index 00000000..85744582 --- /dev/null +++ b/prim.h @@ -0,0 +1,243 @@ +void __dump_(pEnv env); +void __html_manual_(pEnv env); +void __latex_manual_(pEnv env); +void __manual_list_(pEnv env); +void __memoryindex_(pEnv env); +void __memorymax_(pEnv env); +void __settracegc_(pEnv env); +void __symtabindex_(pEnv env); +void __symtabmax_(pEnv env); +void _help_(pEnv env); +void abort_(pEnv env); +void abs_(pEnv env); +void acos_(pEnv env); +void all_(pEnv env); +void and_(pEnv env); +void app1_(pEnv env); +void app11_(pEnv env); +void app12_(pEnv env); +void app2_(pEnv env); +void app3_(pEnv env); +void app4_(pEnv env); +void argc_(pEnv env); +void argv_(pEnv env); +void asin_(pEnv env); +void at_(pEnv env); +void atan_(pEnv env); +void atan2_(pEnv env); +void autoput_(pEnv env); +void binary_(pEnv env); +void binrec_(pEnv env); +void body_(pEnv env); +void branch_(pEnv env); +void case_(pEnv env); +void casting_(pEnv env); +void ceil_(pEnv env); +void char_(pEnv env); +void choice_(pEnv env); +void chr_(pEnv env); +void cleave_(pEnv env); +void clock_(pEnv env); +void compare_(pEnv env); +void concat_(pEnv env); +void cond_(pEnv env); +void condlinrec_(pEnv env); +void condnestrec_(pEnv env); +void cons_(pEnv env); +void construct_(pEnv env); +void conts_(pEnv env); +void cos_(pEnv env); +void cosh_(pEnv env); +void cpush_(pEnv env); +void cswap_(pEnv env); +void dip_(pEnv env); +void div_(pEnv env); +void divide_(pEnv env); +void drop_(pEnv env); +void dup_(pEnv env); +void dupd_(pEnv env); +void echo_(pEnv env); +void enconcat_(pEnv env); +void eql_(pEnv env); +void equal_(pEnv env); +void exit_(pEnv env); +void exp_(pEnv env); +void false_(pEnv env); +void fclose_(pEnv env); +void feof_(pEnv env); +void ferror_(pEnv env); +void fflush_(pEnv env); +void fgetch_(pEnv env); +void fgets_(pEnv env); +void file_(pEnv env); +void filetime_(pEnv env); +void filter_(pEnv env); +void first_(pEnv env); +void fjump_(pEnv env); +void float_(pEnv env); +void floor_(pEnv env); +void fold_(pEnv env); +void fopen_(pEnv env); +void format_(pEnv env); +void formatf_(pEnv env); +void fpush_(pEnv env); +void fput_(pEnv env); +void fputch_(pEnv env); +void fputchars_(pEnv env); +void fputstring_(pEnv env); +void fread_(pEnv env); +void fremove_(pEnv env); +void frename_(pEnv env); +void frexp_(pEnv env); +void fseek_(pEnv env); +void ftell_(pEnv env); +void fwrite_(pEnv env); +void gc_(pEnv env); +void genrec_(pEnv env); +void genrecaux_(pEnv env); +void geql_(pEnv env); +void get_(pEnv env); +void getch_(pEnv env); +void getenv_(pEnv env); +void gmtime_(pEnv env); +void greater_(pEnv env); +void has_(pEnv env); +void help_(pEnv env); +void helpdetail_(pEnv env); +void i_(pEnv env); +void id_(pEnv env); +void ifchar_(pEnv env); +void iffile_(pEnv env); +void iffloat_(pEnv env); +void ifinteger_(pEnv env); +void iflist_(pEnv env); +void iflogical_(pEnv env); +void ifset_(pEnv env); +void ifstring_(pEnv env); +void ifte_(pEnv env); +void in_(pEnv env); +void include_(pEnv env); +void infra_(pEnv env); +void integer_(pEnv env); +void intern_(pEnv env); +void jfalse_(pEnv env); +void jump_(pEnv env); +void kill_(pEnv env); +void ldexp_(pEnv env); +void leaf_(pEnv env); +void leql_(pEnv env); +void less_(pEnv env); +void linrec_(pEnv env); +void list_(pEnv env); +void localtime_(pEnv env); +void log_(pEnv env); +void log10_(pEnv env); +void logical_(pEnv env); +void manual_(pEnv env); +void map_(pEnv env); +void max_(pEnv env); +void maxint_(pEnv env); +void min_(pEnv env); +void minus_(pEnv env); +void mktime_(pEnv env); +void modf_(pEnv env); +void mul_(pEnv env); +void name_(pEnv env); +void neg_(pEnv env); +void neql_(pEnv env); +void not_(pEnv env); +void null_(pEnv env); +void nullary_(pEnv env); +void of_(pEnv env); +void opcase_(pEnv env); +void or_(pEnv env); +void ord_(pEnv env); +void over_(pEnv env); +void pfalse_(pEnv env); +void pick_(pEnv env); +void plus_(pEnv env); +void pop_(pEnv env); +void popd_(pEnv env); +void pow_(pEnv env); +void pred_(pEnv env); +void primrec_(pEnv env); +void push_(pEnv env); +void put_(pEnv env); +void putch_(pEnv env); +void putchars_(pEnv env); +void quit_(pEnv env); +void radix_(pEnv env); +void rand_(pEnv env); +void recv_(pEnv env); +void rem_(pEnv env); +void rest_(pEnv env); +void rolldown_(pEnv env); +void rolldownd_(pEnv env); +void rollup_(pEnv env); +void rollupd_(pEnv env); +void rotate_(pEnv env); +void rotated_(pEnv env); +void round_(pEnv env); +void sametype_(pEnv env); +void scale_(pEnv env); +void send_(pEnv env); +void set_(pEnv env); +void setautoput_(pEnv env); +void setecho_(pEnv env); +void setsize_(pEnv env); +void setundeferror_(pEnv env); +void sign_(pEnv env); +void sin_(pEnv env); +void sinh_(pEnv env); +void size_(pEnv env); +void small_(pEnv env); +void some_(pEnv env); +void split_(pEnv env); +void spush_(pEnv env); +void sqrt_(pEnv env); +void srand_(pEnv env); +void stack_(pEnv env); +void stderr_(pEnv env); +void stdin_(pEnv env); +void stdout_(pEnv env); +void step_(pEnv env); +void strftime_(pEnv env); +void string_(pEnv env); +void strtod_(pEnv env); +void strtol_(pEnv env); +void strue_(pEnv env); +void succ_(pEnv env); +void swap_(pEnv env); +void swapd_(pEnv env); +void swons_(pEnv env); +void system_(pEnv env); +void tailrec_(pEnv env); +void take_(pEnv env); +void tan_(pEnv env); +void tanh_(pEnv env); +void task_(pEnv env); +void ternary_(pEnv env); +void time_(pEnv env); +void times_(pEnv env); +void tpush_(pEnv env); +void treegenrec_(pEnv env); +void treegenrecaux_(pEnv env); +void treerec_(pEnv env); +void treerecaux_(pEnv env); +void treestep_(pEnv env); +void true_(pEnv env); +void trunc_(pEnv env); +void typeof_(pEnv env); +void unary_(pEnv env); +void unary2_(pEnv env); +void unary3_(pEnv env); +void unary4_(pEnv env); +void uncons_(pEnv env); +void undeferror_(pEnv env); +void undefs_(pEnv env); +void unstack_(pEnv env); +void unswons_(pEnv env); +void user_(pEnv env); +void while_(pEnv env); +void x_(pEnv env); +void xor_(pEnv env); diff --git a/prog.c b/prog.c index 22b3e869..d7fe5bb7 100644 --- a/prog.c +++ b/prog.c @@ -1,7 +1,7 @@ /* module : prog.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #include "globals.h" @@ -24,7 +24,7 @@ PUBLIC void code(pEnv env, proc_t proc) Node node; if (env->bytecoding || env->compiling) - node.u.ent = operindex(proc); + node.u.ent = operindex(env, proc); else node.u.proc = proc; node.op = ANON_FUNCT_; diff --git a/repl.c b/repl.c index 665dcee8..11fbcdb1 100644 --- a/repl.c +++ b/repl.c @@ -1,15 +1,15 @@ /* module : repl.c - version : 1.9 - date : 01/24/24 + version : 1.10 + date : 03/05/24 */ #include "globals.h" /* * Initialise the symbol table with builtins. There is no need to classify - * builtins. The hash table contains an index into the symbol table. + * builtins. The hash tables contain an index into the symbol table. */ -PUBLIC void inisymboltable(pEnv env) /* initialise */ +PUBLIC void inisymboltable(pEnv env) /* initialise */ { Entry ent; int i, rv; @@ -17,13 +17,16 @@ PUBLIC void inisymboltable(pEnv env) /* initialise */ OpTable *tab; env->hash = kh_init(Symtab); + env->prim = kh_init(Funtab); for (i = 0; (tab = readtable(i)) != 0; i++) { ent.name = tab->name; - ent.is_user = 0; + ent.is_user = 0; /* builtins */ ent.flags = tab->flags; ent.u.proc = tab->proc; key = kh_put(Symtab, env->hash, ent.name, &rv); kh_value(env->hash, key) = i; + key = kh_put(Funtab, env->prim, (int64_t)ent.u.proc, &rv); + kh_value(env->prim, key) = i; vec_push(env->symtab, ent); } } @@ -42,7 +45,7 @@ PRIVATE void enterglobal(pEnv env, char *name) ent.name = name; ent.is_user = 1; ent.flags = 0; - ent.u.body = 0; /* may be assigned in definition */ + 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; vec_push(env->symtab, ent); diff --git a/scan.c b/scan.c index c1099f7b..ee0fb017 100644 --- a/scan.c +++ b/scan.c @@ -1,7 +1,7 @@ /* module : scan.c - version : 1.16 - date : 02/13/24 + version : 1.17 + date : 03/05/24 */ #include "globals.h" @@ -10,8 +10,6 @@ extern char line[]; extern int yylineno; static int ilevel; -static char my_line[INPLINEMAX + 1]; -static unsigned char my_echoflag; static struct { FILE *fp; @@ -19,35 +17,15 @@ static struct { char *name; } infile[INPSTACKMAX]; -/* - * Possibly echo a line. - */ -PRIVATE void echoline(void) -{ - if (!my_echoflag || !my_line[0]) - return; - if (my_echoflag > 2) - printf("%4d", 1); - if (my_echoflag > 1) - putchar('\t'); - printf("%s", my_line); - my_line[0] = 0; -} - /* inilinebuffer - initialise the stack of input files. The filename parameter - is used in error messages. Also read the first line. + is used in error messages. */ -PUBLIC void inilinebuffer(pEnv env, int joy) +PUBLIC void inilinebuffer(pEnv env) { infile[0].fp = yyin; infile[0].line = 1; /* start with line 1 */ infile[0].name = env->filename; - if (!joy) /* test whether compiler active */ - return; - if (fgets(my_line, INPLINEMAX, yyin)) /* read first line */ - rewind(yyin); - my_echoflag = env->echoflag; } /* @@ -56,8 +34,6 @@ PUBLIC void inilinebuffer(pEnv env, int joy) */ PRIVATE void redirect(char *str, FILE *fp) { - if (infile[ilevel].fp == fp) - return; /* already reading from this file */ infile[ilevel].line = yylineno; /* save last line number and line */ if (ilevel + 1 == INPSTACKMAX) /* increase the include level */ execerror(str, "fewer include files", "include"); @@ -92,13 +68,13 @@ PUBLIC void include(pEnv env, char *name) if (!strcmp(name, "usrlib.joy")) { /* check usrlib.joy */ if ((fp = fopen(str, "r")) != 0) goto normal; - if ((ptr = getenv("USERPROFILE")) != 0) { /* windows */ + if ((ptr = getenv("HOME")) != 0) { /* unix/cygwin */ str = GC_malloc_atomic(strlen(ptr) + strlen(name) + 2); sprintf(str, "%s/%s", ptr, name); if ((fp = fopen(str, "r")) != 0) goto normal; } - if ((ptr = getenv("HOME")) != 0) { + 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) @@ -124,7 +100,6 @@ PUBLIC void include(pEnv env, char *name) *ptr = 0; } redirect(name, fp); - my_echoflag = env->echoflag; return; } /* @@ -159,8 +134,6 @@ PUBLIC int yywrap(void) infile[ilevel].fp = 0; /* invalidate file pointer */ yyin = infile[--ilevel].fp; /* proceed with previous file */ old_buffer(infile[ilevel].line); /* and previous input buffer */ - if (!ilevel && yylineno == 1) /* if back to first input file */ - echoline(); return 0; /* continue with old buffer */ } diff --git a/src/__dump.c b/src/__dump.c index 952fe5d6..a003841d 100644 --- a/src/__dump.c +++ b/src/__dump.c @@ -1,13 +1,13 @@ /* module : __dump.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef __DUMP_C #define __DUMP_C /** -OK 1070 __dump : A -> [..] +Q0 OK 1070 __dump : A -> [..] debugging only: pushes the dump as a list. */ void __dump_(pEnv env) diff --git a/src/__html_manual.c b/src/__html_manual.c index a9ead86b..8332a96a 100644 --- a/src/__html_manual.c +++ b/src/__html_manual.c @@ -1,7 +1,7 @@ /* module : __html_manual.c - version : 1.6 - date : 02/01/24 + version : 1.7 + date : 03/05/24 */ #ifndef __HTML_MANUAL_C #define __HTML_MANUAL_C @@ -9,7 +9,7 @@ #include "manual.h" /** -OK 2940 __html_manual : N -> +Q0 OK 2940 __html_manual : N -> [IMPURE] Writes this manual of all Joy primitives to output file in HTML style. */ void __html_manual_(pEnv env) diff --git a/src/__latex_manual.c b/src/__latex_manual.c index 7a78880b..a558a4e1 100644 --- a/src/__latex_manual.c +++ b/src/__latex_manual.c @@ -1,7 +1,7 @@ /* module : __latex_manual.c - version : 1.6 - date : 02/01/24 + version : 1.7 + date : 03/05/24 */ #ifndef __LATEX_MANUAL_C #define __LATEX_MANUAL_C @@ -9,7 +9,7 @@ #include "manual.h" /** -OK 2950 __latex_manual : N -> +Q0 OK 2950 __latex_manual : N -> [IMPURE] Writes this manual of all Joy primitives to output file in Latex style but without the head and tail. */ diff --git a/src/__manual_list.c b/src/__manual_list.c index 100fcffd..62a76681 100644 --- a/src/__manual_list.c +++ b/src/__manual_list.c @@ -1,13 +1,13 @@ /* module : __manual_list.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef __MANUAL_LIST_C #define __MANUAL_LIST_C /** -OK 2960 __manual_list : A -> L +Q0 OK 2960 __manual_list : A -> L Pushes a list L of lists (one per operator) of three documentation strings. */ void __manual_list_(pEnv env) @@ -19,9 +19,9 @@ void __manual_list_(pEnv env) node.u.lis = pvec_init(); node.op = temp.op = LIST_; elem.op = STRING_; - for (i = 0; (tab = readtable(i)) != 0; i++) /* find end */ + for (i = 0; (tab = readtable(i)) != 0; i++) /* find end */ ; - for (--i; i >= 0; i--) { /* overshot */ + for (--i; i >= 0; i--) { /* overshot */ tab = readtable(i); temp.u.lis = pvec_init(); elem.u.str = tab->messg2; diff --git a/src/__memoryindex.c b/src/__memoryindex.c index 8d382597..d64fdfdd 100644 --- a/src/__memoryindex.c +++ b/src/__memoryindex.c @@ -1,13 +1,13 @@ /* module : __memoryindex.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef __MEMORYINDEX_C #define __MEMORYINDEX_C /** -OK 3060 __memoryindex : A -> I +Q0 OK 3060 __memoryindex : A -> I Pushes current value of memory. */ void __memoryindex_(pEnv env) diff --git a/src/__memorymax.c b/src/__memorymax.c index 61fac6f9..8a9d944b 100644 --- a/src/__memorymax.c +++ b/src/__memorymax.c @@ -1,13 +1,13 @@ /* module : __memorymax.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef __MEMORYMAX_C #define __MEMORYMAX_C /** -OK 1160 __memorymax : A -> I +Q0 OK 1160 __memorymax : A -> I Pushes value of total size of memory. */ void __memorymax_(pEnv env) diff --git a/src/__settracegc.c b/src/__settracegc.c index eef72ec7..4bbb9a38 100644 --- a/src/__settracegc.c +++ b/src/__settracegc.c @@ -1,13 +1,13 @@ /* module : __settracegc.c - version : 1.9 - date : 02/09/24 + version : 1.10 + date : 03/05/24 */ #ifndef __SETTRACEGC_C #define __SETTRACEGC_C /** -OK 2970 __settracegc : D I -> +Q0 OK 2970 __settracegc : D I -> [IMPURE] Sets value of flag for tracing garbage collection to I (= 0..6). */ void __settracegc_(pEnv env) @@ -16,11 +16,13 @@ void __settracegc_(pEnv env) PARM(1, PREDSUCC); env->stck = pvec_pop(env->stck, &node); - if (node.u.num) { /* enable compiling */ - if (env->bytecoding) - env->bytecoding = 1; - else if (env->compiling) - env->compiling = 1; - } + if (node.u.num) /* 0=enable compiling */ + ; + else if (env->bytecoding) + env->bytecoding = 1; + else if (env->compiling) + env->compiling = 1; + else + env->ignore = 0; /* disable ignore */ } #endif diff --git a/src/__symtabindex.c b/src/__symtabindex.c index 3c3df6a5..68b45b6a 100644 --- a/src/__symtabindex.c +++ b/src/__symtabindex.c @@ -1,13 +1,13 @@ /* module : __symtabindex.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef __SYMTABINDEX_C #define __SYMTABINDEX_C /** -OK 1060 __symtabindex : A -> I +Q0 OK 1060 __symtabindex : A -> I Pushes current size of the symbol table. */ void __symtabindex_(pEnv env) diff --git a/src/__symtabmax.c b/src/__symtabmax.c index dbe2fc52..b2abedc6 100644 --- a/src/__symtabmax.c +++ b/src/__symtabmax.c @@ -1,13 +1,13 @@ /* module : __symtabmax.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef __SYMTABMAX_C #define __SYMTABMAX_C /** -OK 1050 __symtabmax : A -> I +Q0 OK 1050 __symtabmax : A -> I Pushes value of maximum size of the symbol table. */ void __symtabmax_(pEnv env) diff --git a/src/_help.c b/src/_help.c index 6d06c510..36427005 100644 --- a/src/_help.c +++ b/src/_help.c @@ -1,13 +1,13 @@ /* module : _help.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef _HELP_C #define _HELP_C /** -OK 2910 _help : N -> +Q0 OK 2910 _help : N -> [IMPURE] Lists all hidden symbols in library and then all hidden builtin symbols. */ diff --git a/src/abort.c b/src/abort.c index ca556ae4..df4d11c7 100644 --- a/src/abort.c +++ b/src/abort.c @@ -1,13 +1,13 @@ /* module : abort.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef ABORT_C #define ABORT_C /** -OK 3120 abort : N -> +Q0 OK 3120 abort : N -> Aborts execution of current Joy program, returns to Joy main cycle. */ void abort_(pEnv env) diff --git a/src/abs.c b/src/abs.c index 57638671..52e84c7e 100644 --- a/src/abs.c +++ b/src/abs.c @@ -1,13 +1,13 @@ /* module : abs.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef ABS_C #define ABS_C /** -OK 1480 abs : DA N1 -> N2 +Q0 OK 1480 abs : DA N1 -> N2 Integer N2 is the absolute value (0,1,2..) of integer N1, or float N2 is the absolute value (0.0 ..) of float N1. */ diff --git a/src/acos.c b/src/acos.c index d6a5b2d2..ab79e0cf 100644 --- a/src/acos.c +++ b/src/acos.c @@ -1,13 +1,13 @@ /* module : acos.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ACOS_C #define ACOS_C /** -OK 1490 acos : DA F -> G +Q0 OK 1490 acos : DA F -> G G is the arc cosine of F. */ void acos_(pEnv env) diff --git a/src/all.c b/src/all.c index 76e00867..fc08d168 100644 --- a/src/all.c +++ b/src/all.c @@ -1,13 +1,13 @@ /* module : all.c - version : 1.10 - date : 01/25/24 + version : 1.11 + date : 03/05/24 */ #ifndef ALL_C #define ALL_C /** -OK 2860 all : DDA A [B] -> X +Q1 OK 2860 all : DDA A [B] -> X Applies test B to members of aggregate A, X = true if all pass. */ void all_(pEnv env) diff --git a/src/and.c b/src/and.c index 158cf4d8..c17ed724 100644 --- a/src/and.c +++ b/src/and.c @@ -1,13 +1,13 @@ /* module : and.c - version : 1.7 - date : 01/25/24 + version : 1.8 + date : 03/05/24 */ #ifndef AND_C #define AND_C /** -OK 1360 and : DDA X Y -> Z +Q0 OK 1360 and : DDA X Y -> Z Z is the intersection of sets X and Y, logical conjunction for truth values. */ void and_(pEnv env) diff --git a/src/app1.c b/src/app1.c index d747ffde..97197065 100644 --- a/src/app1.c +++ b/src/app1.c @@ -1,14 +1,14 @@ /* module : app1.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef APP1_C #define APP1_C /** -OK 2440 app1 : DDA X [P] -> R -Executes P, pushes result R on stack. +Q1 OK 2440 app1 : DDA X [P] -> R +Obsolescent. Executes P, pushes result R on stack. */ void app1_(pEnv env) { diff --git a/src/app11.c b/src/app11.c index d1bacf7b..38f3fc6b 100644 --- a/src/app11.c +++ b/src/app11.c @@ -1,13 +1,13 @@ /* module : app11.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef APP11_C #define APP11_C /** -OK 2450 app11 : DDDA X Y [P] -> R +Q1 OK 2450 app11 : DDDA X Y [P] -> R Executes P, pushes result R on stack. */ void app11_(pEnv env) diff --git a/src/app12.c b/src/app12.c index 6e669957..521cf72a 100644 --- a/src/app12.c +++ b/src/app12.c @@ -1,18 +1,18 @@ /* module : app12.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef APP12_C #define APP12_C /** -OK 2460 app12 : DDDDAA X Y1 Y2 [P] -> R1 R2 +Q1 OK 2460 app12 : DDDDAA X Y1 Y2 [P] -> R1 R2 Executes P twice, with Y1 and Y2, returns R1 and R2. */ PRIVATE void app12_(pEnv env) { - /* X Y Z [P] app12 */ + /* X Y Z [P] app12 */ PARM(4, DIP); code(env, pop_); code(env, rolldown_); diff --git a/src/app2.c b/src/app2.c index 5499ab7e..a8a5fc21 100644 --- a/src/app2.c +++ b/src/app2.c @@ -1,13 +1,13 @@ /* module : app2.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef APP2_C #define APP2_C /** -OK 2530 app2 : DDDAA X1 X2 [P] -> R1 R2 +Q1 OK 2530 app2 : DDDAA X1 X2 [P] -> R1 R2 Obsolescent. == unary2 */ void app2_(pEnv env) diff --git a/src/app3.c b/src/app3.c index 1731a4ee..45231ca5 100644 --- a/src/app3.c +++ b/src/app3.c @@ -1,13 +1,13 @@ /* module : app3.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef APP3_C #define APP3_C /** -OK 2540 app3 : DDDDAAA X1 X2 X3 [P] -> R1 R2 R3 +Q1 OK 2540 app3 : DDDDAAA X1 X2 X3 [P] -> R1 R2 R3 Obsolescent. == unary3 */ void app3_(pEnv env) diff --git a/src/app4.c b/src/app4.c index 4beaaaf9..ce78f213 100644 --- a/src/app4.c +++ b/src/app4.c @@ -1,13 +1,13 @@ /* module : app4.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef APP4_C #define APP4_C /** -OK 2550 app4 : DDDDDAAAA X1 X2 X3 X4 [P] -> R1 R2 R3 R4 +Q1 OK 2550 app4 : DDDDDAAAA X1 X2 X3 X4 [P] -> R1 R2 R3 R4 Obsolescent. == unary4 */ void app4_(pEnv env) diff --git a/src/argc.c b/src/argc.c index 7d609f69..0688a9f0 100644 --- a/src/argc.c +++ b/src/argc.c @@ -1,13 +1,13 @@ /* module : argc.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ARGC_C #define ARGC_C /** -OK 3050 argc : A -> I +Q0 OK 3050 argc : A -> I Pushes the number of command line arguments. This is quivalent to 'argv size'. */ void argc_(pEnv env) diff --git a/src/argv.c b/src/argv.c index 524e18b4..9fc6668e 100644 --- a/src/argv.c +++ b/src/argv.c @@ -1,13 +1,13 @@ /* module : argv.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ARGV_C #define ARGV_C /** -OK 3040 argv : A -> A +Q0 OK 3040 argv : A -> A Creates an aggregate A containing the interpreter's command line arguments. */ PRIVATE void argv_(pEnv env) diff --git a/src/asin.c b/src/asin.c index 3bc1c23c..0e6dd37c 100644 --- a/src/asin.c +++ b/src/asin.c @@ -1,13 +1,13 @@ /* module : asin.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ASIN_C #define ASIN_C /** -OK 1500 asin : DA F -> G +Q0 OK 1500 asin : DA F -> G G is the arc sine of F. */ void asin_(pEnv env) diff --git a/src/at.c b/src/at.c index 7a7727f9..03f8bee9 100644 --- a/src/at.c +++ b/src/at.c @@ -1,13 +1,13 @@ /* module : at.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef AT_C #define AT_C /** -OK 2060 at : DDA A I -> X +Q0 OK 2060 at : DDA A I -> X X (= A[I]) is the member of A at position I. */ void at_(pEnv env) diff --git a/src/atan.c b/src/atan.c index 7baffe69..ce2345d1 100644 --- a/src/atan.c +++ b/src/atan.c @@ -1,13 +1,13 @@ /* module : atan.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ATAN_C #define ATAN_C /** -OK 1510 atan : DA F -> G +Q0 OK 1510 atan : DA F -> G G is the arc tangent of F. */ void atan_(pEnv env) diff --git a/src/atan2.c b/src/atan2.c index ae9ba8fa..9564fcb1 100644 --- a/src/atan2.c +++ b/src/atan2.c @@ -1,13 +1,13 @@ /* module : atan2.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ATAN2_C #define ATAN2_C /** -OK 1520 atan2 : DDA F G -> H +Q0 OK 1520 atan2 : DDA F G -> H H is the arc tangent of F / G. */ void atan2_(pEnv env) diff --git a/src/autoput.c b/src/autoput.c index cb9fe334..51895455 100644 --- a/src/autoput.c +++ b/src/autoput.c @@ -1,13 +1,13 @@ /* module : autoput.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef AUTOPUT_C #define AUTOPUT_C /** -OK 1090 autoput : A -> I +Q0 OK 1090 autoput : A -> I Pushes current value of flag for automatic output, I = 0..2. */ void autoput_(pEnv env) diff --git a/src/binary.c b/src/binary.c index 9160ef88..d02c9e62 100644 --- a/src/binary.c +++ b/src/binary.c @@ -1,13 +1,13 @@ /* module : binary.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef BINARY_C #define BINARY_C /** -OK 2560 binary : DDDA X Y [P] -> R +Q0 OK 2560 binary : DDDA X Y [P] -> R Executes P, which leaves R on top of the stack. No matter how many parameters this consumes, exactly two are removed from the stack. diff --git a/src/binrec.c b/src/binrec.c index f2e28b8b..02638843 100644 --- a/src/binrec.c +++ b/src/binrec.c @@ -1,13 +1,13 @@ /* module : binrec.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef BINREC_C #define BINREC_C /** -OK 2730 binrec : DDDDDA [P] [T] [R1] [R2] -> ... +Q4 OK 2730 binrec : DDDDDA [P] [T] [R1] [R2] -> ... Executes P. If that yields true, executes T. Else uses R1 to produce two intermediates, recurses on both, then executes R2 to combine their results. diff --git a/src/body.c b/src/body.c index d0b890db..2a0d934a 100644 --- a/src/body.c +++ b/src/body.c @@ -1,13 +1,13 @@ /* module : body.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef BODY_C #define BODY_C /** -OK 2190 body : DA U -> [P] +Q0 OK 2190 body : DA U -> [P] Quotation [P] is the body of user-defined symbol U. */ void body_(pEnv env) diff --git a/src/branch.c b/src/branch.c index 913fbc9a..73320547 100644 --- a/src/branch.c +++ b/src/branch.c @@ -1,13 +1,13 @@ /* module : branch.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef BRANCH_C #define BRANCH_C /** -OK 2590 branch : DDDP B [T] [F] -> ... +Q2 OK 2590 branch : DDDP B [T] [F] -> ... If B is true, then executes T else executes F. */ void branch_(pEnv env) diff --git a/src/case.c b/src/case.c index 56362529..aaa83ac2 100644 --- a/src/case.c +++ b/src/case.c @@ -1,7 +1,7 @@ /* module : case.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef CASE_C #define CASE_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2100 case : DP X [..[X Y]..] -> Y i +Q1 OK 2100 case : DP X [..[X Y]..] -> Y i Indexing on the value of X, execute the matching Y. */ void case_(pEnv env) diff --git a/src/casting.c b/src/casting.c index 5e58876a..4100b2c1 100644 --- a/src/casting.c +++ b/src/casting.c @@ -1,13 +1,13 @@ /* module : casting.c - version : 1.9 - date : 02/01/24 + version : 1.10 + date : 03/05/24 */ #ifndef CASTING_C #define CASTING_C /** -OK 3140 casting : DDA X Y -> Z +Q0 OK 3140 casting : DDA X Y -> Z [EXT] Z takes the value from X and uses the value from Y as its type. */ void casting_(pEnv env) diff --git a/src/ceil.c b/src/ceil.c index 9df8bede..57c5886e 100644 --- a/src/ceil.c +++ b/src/ceil.c @@ -1,13 +1,13 @@ /* module : ceil.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef CEIL_C #define CEIL_C /** -OK 1530 ceil : DA F -> G +Q0 OK 1530 ceil : DA F -> G G is the float ceiling of F. */ void ceil_(pEnv env) diff --git a/src/char.c b/src/char.c index 9483056c..49bbe202 100644 --- a/src/char.c +++ b/src/char.c @@ -1,13 +1,13 @@ /* module : char.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef CHAR_C #define CHAR_C /** -OK 2320 char : DA X -> B +Q0 OK 2320 char : DA X -> B Tests whether X is a character. */ void char_(pEnv env) diff --git a/src/choice.c b/src/choice.c index d09541bc..cf19eb98 100644 --- a/src/choice.c +++ b/src/choice.c @@ -1,13 +1,13 @@ /* module : choice.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef CHOICE_C #define CHOICE_C /** -OK 1330 choice : DDDA B T F -> X +Q0 OK 1330 choice : DDDA B T F -> X If B is true, then X = T else X = F. */ void choice_(pEnv env) diff --git a/src/chr.c b/src/chr.c index 2d9ea75d..3d951c09 100644 --- a/src/chr.c +++ b/src/chr.c @@ -1,13 +1,13 @@ /* module : chr.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef CHR_C #define CHR_C /** -OK 1470 chr : DA I -> C +Q0 OK 1470 chr : DA I -> C C is the character whose Ascii value is integer I (or logical or character). */ void chr_(pEnv env) diff --git a/src/cleave.c b/src/cleave.c index d5d18f76..d39cc361 100644 --- a/src/cleave.c +++ b/src/cleave.c @@ -1,17 +1,17 @@ /* module : cleave.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef CLEAVE_C #define CLEAVE_C /** -OK 2580 cleave : DDDAA X [P1] [P2] -> R1 R2 +Q2 OK 2580 cleave : DDDAA X [P1] [P2] -> R1 R2 Executes P1 and P2, each with X on top, producing two results. */ PRIVATE void cleave_(pEnv env) -{ /* X [P1] [P2] cleave ==> X1 X2 */ +{ /* X [P1] [P2] cleave ==> X1 X2 */ unsigned size; Node first, second; diff --git a/src/clock.c b/src/clock.c index 349d2227..94e87416 100644 --- a/src/clock.c +++ b/src/clock.c @@ -1,13 +1,13 @@ /* module : clock.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef CLOCK_C #define CLOCK_C /** -OK 1130 clock : A -> I +Q0 OK 1130 clock : A -> I [IMPURE] Pushes the integer value of current CPU usage in milliseconds. */ void clock_(pEnv env) diff --git a/src/compare.c b/src/compare.c index 9d630e19..f4414a0e 100644 --- a/src/compare.c +++ b/src/compare.c @@ -1,7 +1,7 @@ /* module : compare.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef COMPARE_C #define COMPARE_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2050 compare : DDA A B -> I +Q0 OK 2050 compare : DDA A B -> I I (=-1,0,+1) is the comparison of aggregates A and B. The values correspond to the predicates <=, =, >=. */ diff --git a/src/compare.h b/src/compare.h index 6366ae92..ab18b65e 100644 --- a/src/compare.h +++ b/src/compare.h @@ -1,7 +1,7 @@ /* module : compare.h - version : 1.16 - date : 01/25/24 + version : 1.18 + date : 03/05/24 */ #ifndef COMPARE_H #define COMPARE_H @@ -34,7 +34,7 @@ PUBLIC int Compare(pEnv env, Node first, Node second) goto cmpstr; case ANON_FUNCT_: case ANON_PRIME_: - name2 = cmpname(second.u.proc); + name2 = cmpname(env, second.u.proc); goto cmpstr; case BOOLEAN_: case CHAR_: @@ -54,7 +54,7 @@ PUBLIC int Compare(pEnv env, Node first, Node second) break; case ANON_FUNCT_: case ANON_PRIME_: - name1 = cmpname(first.u.proc); + name1 = cmpname(env, first.u.proc); switch (second.op) { case USR_: case USR_PRIME_: @@ -62,7 +62,7 @@ PUBLIC int Compare(pEnv env, Node first, Node second) goto cmpstr; case ANON_FUNCT_: case ANON_PRIME_: - name2 = cmpname(second.u.proc); + name2 = cmpname(env, second.u.proc); goto cmpstr; case BOOLEAN_: case CHAR_: @@ -193,7 +193,7 @@ PUBLIC int Compare(pEnv env, Node first, Node second) goto cmpstr; case ANON_FUNCT_: case ANON_PRIME_: - name2 = cmpname(second.u.proc); + name2 = cmpname(env, second.u.proc); goto cmpstr; case BOOLEAN_: case CHAR_: @@ -213,6 +213,11 @@ PUBLIC int Compare(pEnv env, Node first, Node second) break; case LIST_: case USR_LIST_: + if (second.op == LIST_ || second.op == USR_LIST_) { + if (!pvec_cnt(first.u.lis) && !pvec_cnt(second.u.lis)) + return 0; /* equal */ + return first.u.lis != second.u.lis; + } return 1; /* unequal */ break; case FLOAT_: diff --git a/src/concat.c b/src/concat.c index f43e189b..17569fb6 100644 --- a/src/concat.c +++ b/src/concat.c @@ -1,13 +1,13 @@ /* module : concat.c - version : 1.8 - date : 01/25/24 + version : 1.9 + date : 03/05/24 */ #ifndef CONCAT_C #define CONCAT_C /** -OK 2150 concat : DDA S T -> U +Q0 OK 2150 concat : DDA S T -> U Sequence U is the concatenation of sequences S and T. */ void concat_(pEnv env) diff --git a/src/cond.c b/src/cond.c index 9af222ee..3e6f4a9c 100644 --- a/src/cond.c +++ b/src/cond.c @@ -1,13 +1,13 @@ /* module : cond.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef COND_C #define COND_C /** -OK 2690 cond : DDA [..[[Bi] Ti]..[D]] -> ... +Q1 OK 2690 cond : DDA [..[[Bi] Ti]..[D]] -> ... Tries each Bi. If that yields true, then executes Ti and exits. If no Bi yields true, executes default D. */ diff --git a/src/condlinrec.c b/src/condlinrec.c index f3fb1910..df7b4a03 100644 --- a/src/condlinrec.c +++ b/src/condlinrec.c @@ -1,13 +1,13 @@ /* module : condlinrec.c - version : 1.6 - date : 11/06/23 + version : 1.7 + date : 03/05/24 */ #ifndef CONDLINREC_C #define CONDLINREC_C /** -OK 2760 condlinrec : DDA [ [C1] [C2] .. [D] ] -> ... +Q1 OK 2760 condlinrec : DDA [ [C1] [C2] .. [D] ] -> ... Each [Ci] is of the form [[B] [T]] or [[B] [R1] [R2]]. Tries each B. If that yields true and there is just a [T], executes T and exit. If there are [R1] and [R2], executes R1, recurses, executes R2. diff --git a/src/condnestrec.c b/src/condnestrec.c index 561833f5..7aa25cce 100644 --- a/src/condnestrec.c +++ b/src/condnestrec.c @@ -1,13 +1,13 @@ /* module : condnestrec.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef CONDNESTREC_C #define CONDNESTREC_C /** -OK 2750 condnestrec : DDA [ [C1] [C2] .. [D] ] -> ... +Q1 OK 2750 condnestrec : DDA [ [C1] [C2] .. [D] ] -> ... A generalisation of condlinrec. Each [Ci] is of the form [[B] [R1] [R2] .. [Rn]] and [D] is of the form [[R1] [R2] .. [Rn]]. Tries each B, or if all fail, takes the default [D]. diff --git a/src/cons.c b/src/cons.c index d6f7da4a..d568e519 100644 --- a/src/cons.c +++ b/src/cons.c @@ -1,13 +1,13 @@ /* module : cons.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef CONS_C #define CONS_C /** -OK 2010 cons : DDA X A -> B +Q0 OK 2010 cons : DDA X A -> B Aggregate B is A with a new member X (first member for sequences). */ void cons_(pEnv env) diff --git a/src/construct.c b/src/construct.c index 0cb2f3db..4f920017 100644 --- a/src/construct.c +++ b/src/construct.c @@ -1,13 +1,13 @@ /* module : construct.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef CONSTRUCT_C #define CONSTRUCT_C /** -OK 2470 construct : DDP [P] [[P1] [P2] ..] -> R1 R2 .. +Q2 OK 2470 construct : DDP [P] [[P1] [P2] ..] -> R1 R2 .. Saves state of stack and then executes [P]. Then executes each [Pi] to give Ri pushed onto saved stack. */ diff --git a/src/conts.c b/src/conts.c index 754e0044..bbd6ebda 100644 --- a/src/conts.c +++ b/src/conts.c @@ -1,13 +1,13 @@ /* module : conts.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef CONTS_C #define CONTS_C /** -OK 1080 conts : A -> [[P] [Q] ..] +Q0 OK 1080 conts : A -> [[P] [Q] ..] Pushes current continuations. Buggy, do not use. */ void conts_(pEnv env) diff --git a/src/cos.c b/src/cos.c index 3b7c9e40..a8c3551b 100644 --- a/src/cos.c +++ b/src/cos.c @@ -1,13 +1,13 @@ /* module : cos.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef COS_C #define COS_C /** -OK 1540 cos : DA F -> G +Q0 OK 1540 cos : DA F -> G G is the cosine of F. */ void cos_(pEnv env) diff --git a/src/cosh.c b/src/cosh.c index 5a57e945..83cec1ae 100644 --- a/src/cosh.c +++ b/src/cosh.c @@ -1,13 +1,13 @@ /* module : cosh.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef COSH_C #define COSH_C /** -OK 1550 cosh : DA F -> G +Q0 OK 1550 cosh : DA F -> G G is the hyperbolic cosine of F. */ void cosh_(pEnv env) diff --git a/src/cpush.c b/src/cpush.c index a541f039..89921c67 100644 --- a/src/cpush.c +++ b/src/cpush.c @@ -1,13 +1,13 @@ /* module : cpush.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef CPUSH_C #define CPUSH_C /** -OK 3350 #cpush : D -> +Q0 OK 3350 #cpush : D -> Pop the location of an element from the code stack. Pop an element from the data stack and store it at the given location. */ diff --git a/src/cswap.c b/src/cswap.c index 3608a532..9d3335ee 100644 --- a/src/cswap.c +++ b/src/cswap.c @@ -1,13 +1,13 @@ /* module : cswap.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef CSWAP_C #define CSWAP_C /** -OK 3330 #cswap : N -> +Q0 OK 3330 #cswap : N -> Pop the location of an element from the code stack. Swap that element with the top of the data stack. */ diff --git a/src/dip.c b/src/dip.c index adaece71..fe60b8fd 100644 --- a/src/dip.c +++ b/src/dip.c @@ -1,13 +1,13 @@ /* module : dip.c - version : 1.8 - date : 02/05/24 + version : 1.9 + date : 03/05/24 */ #ifndef DIP_C #define DIP_C /** -OK 2430 dip : DDPA X [P] -> ... X +Q1 OK 2430 dip : DDPA X [P] -> ... X Saves X, executes P, pushes X back. */ PRIVATE void dip_(pEnv env) diff --git a/src/div.c b/src/div.c index 32ccf436..f9d32f7a 100644 --- a/src/div.c +++ b/src/div.c @@ -1,13 +1,13 @@ /* module : div.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef DIV_C #define DIV_C /** -OK 1430 div : DDAA I J -> K L +Q0 OK 1430 div : DDAA I J -> K L Integers K and L are the quotient and remainder of dividing I by J. */ void div_(pEnv env) diff --git a/src/divide.c b/src/divide.c index babdb9f5..f07a9f83 100644 --- a/src/divide.c +++ b/src/divide.c @@ -1,13 +1,13 @@ /* module : divide.c - version : 1.8 - date : 10/26/23 + version : 1.9 + date : 03/05/24 */ #ifndef DIVIDE_C #define DIVIDE_C /** -OK 1410 /\0divide : DDA I J -> K +Q0 OK 1410 /\0divide : DDA I J -> K Integer K is the (rounded) ratio of integers I and J. Also supports float. */ void divide_(pEnv env) diff --git a/src/drop.c b/src/drop.c index 964689b5..cdce8d6f 100644 --- a/src/drop.c +++ b/src/drop.c @@ -1,13 +1,13 @@ /* module : drop.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef DROP_C #define DROP_C /** -OK 2130 drop : DDA A N -> B +Q0 OK 2130 drop : DDA A N -> B Aggregate B is the result of deleting the first N elements of A. */ void drop_(pEnv env) diff --git a/src/dup.c b/src/dup.c index bf5a124a..b4cd9c11 100644 --- a/src/dup.c +++ b/src/dup.c @@ -1,13 +1,13 @@ /* module : dup.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef DUP_C #define DUP_C /** -OK 1210 dup : A X -> X X +Q0 OK 1210 dup : A X -> X X Pushes an extra copy of X onto stack. */ void dup_(pEnv env) diff --git a/src/dupd.c b/src/dupd.c index d32c8abf..9f1865bf 100644 --- a/src/dupd.c +++ b/src/dupd.c @@ -1,13 +1,13 @@ /* module : dupd.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef DUPD_C #define DUPD_C /** -OK 1270 dupd : DDAAA Y Z -> Y Y Z +Q0 OK 1270 dupd : DDAAA Y Z -> Y Y Z As if defined by: dupd == [dup] dip */ void dupd_(pEnv env) diff --git a/src/echo.c b/src/echo.c index 2180675f..4c7b391d 100644 --- a/src/echo.c +++ b/src/echo.c @@ -1,13 +1,13 @@ /* module : echo.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ECHO_C #define ECHO_C /** -OK 1120 echo : A -> I +Q0 OK 1120 echo : A -> I Pushes value of echo flag, I = 0..3. */ void echo_(pEnv env) diff --git a/src/enconcat.c b/src/enconcat.c index f03b7083..346f87f5 100644 --- a/src/enconcat.c +++ b/src/enconcat.c @@ -1,13 +1,13 @@ /* module : enconcat.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef ENCONCAT_C #define ENCONCAT_C /** -OK 2160 enconcat : DDDA X S T -> U +Q0 OK 2160 enconcat : DDDA X S T -> U Sequence U is the concatenation of sequences S and T with X inserted between S and T (== swapd cons concat). */ diff --git a/src/eql.c b/src/eql.c index 11ea139d..5a24d5f2 100644 --- a/src/eql.c +++ b/src/eql.c @@ -1,7 +1,7 @@ /* module : eql.c - version : 1.7 - date : 01/25/24 + version : 1.8 + date : 03/05/24 */ #ifndef EQL_C #define EQL_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2270 =\0equals : DDA X Y -> B +Q0 OK 2270 =\0equals : DDA X Y -> B Either both X and Y are numeric or both are strings or symbols. Tests whether X equal to Y. Also supports float. */ diff --git a/src/equal.c b/src/equal.c index 0da1f523..de73dd17 100644 --- a/src/equal.c +++ b/src/equal.c @@ -1,7 +1,7 @@ /* module : equal.c - version : 1.8 - date : 01/25/24 + version : 1.9 + date : 03/05/24 */ #ifndef EQUAL_C #define EQUAL_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2280 equal : DDA T U -> B +Q0 OK 2280 equal : DDA T U -> B (Recursively) tests whether trees T and U are identical. */ PRIVATE int compatible(int first, int second) diff --git a/src/exp.c b/src/exp.c index d8a80c99..a80fdb68 100644 --- a/src/exp.c +++ b/src/exp.c @@ -1,13 +1,13 @@ /* module : exp.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef EXP_C #define EXP_C /** -OK 1560 exp : DA F -> G +Q0 OK 1560 exp : DA F -> G G is e (2.718281828...) raised to the Fth power. */ void exp_(pEnv env) diff --git a/src/false.c b/src/false.c index 833a17d1..989b8966 100644 --- a/src/false.c +++ b/src/false.c @@ -1,13 +1,13 @@ /* module : false.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef FALSE_C #define FALSE_C /** -IMMEDIATE 1000 false : A -> false +Q0 IMMEDIATE 1000 false : A -> false Pushes the value false. */ void false_(pEnv env) diff --git a/src/fclose.c b/src/fclose.c index 4c65629d..9dac6810 100644 --- a/src/fclose.c +++ b/src/fclose.c @@ -1,13 +1,13 @@ /* module : fclose.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef FCLOSE_C #define FCLOSE_C /** -OK 1830 fclose : D S -> +Q0 OK 1830 fclose : D S -> [FOREIGN] Stream S is closed and removed from the stack. */ void fclose_(pEnv env) diff --git a/src/feof.c b/src/feof.c index 1ce55a40..10b3fc9d 100644 --- a/src/feof.c +++ b/src/feof.c @@ -1,13 +1,13 @@ /* module : feof.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FEOF_C #define FEOF_C /** -OK 1840 feof : A S -> S B +Q0 OK 1840 feof : A S -> S B [FOREIGN] B is the end-of-file status of stream S. */ void feof_(pEnv env) diff --git a/src/ferror.c b/src/ferror.c index 9629c518..73bf65be 100644 --- a/src/ferror.c +++ b/src/ferror.c @@ -1,13 +1,13 @@ /* module : ferror.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FERROR_C #define FERROR_C /** -OK 1850 ferror : A S -> S B +Q0 OK 1850 ferror : A S -> S B [FOREIGN] B is the error status of stream S. */ void ferror_(pEnv env) diff --git a/src/fflush.c b/src/fflush.c index ff13f8c1..4b0eb199 100644 --- a/src/fflush.c +++ b/src/fflush.c @@ -1,13 +1,13 @@ /* module : fflush.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FFLUSH_C #define FFLUSH_C /** -OK 1860 fflush : N S -> S +Q0 OK 1860 fflush : N S -> S [FOREIGN] Flush stream S, forcing all buffered output to be written. */ void fflush_(pEnv env) diff --git a/src/fgetch.c b/src/fgetch.c index 53dd8d4d..82837678 100644 --- a/src/fgetch.c +++ b/src/fgetch.c @@ -1,13 +1,13 @@ /* module : fgetch.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FGETCH_C #define FGETCH_C /** -OK 1870 fgetch : A S -> S C +Q0 OK 1870 fgetch : A S -> S C [FOREIGN] C is the next available character from stream S. */ void fgetch_(pEnv env) diff --git a/src/fgets.c b/src/fgets.c index 56021dfb..38d00be5 100644 --- a/src/fgets.c +++ b/src/fgets.c @@ -1,13 +1,13 @@ /* module : fgets.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FGETS_C #define FGETS_C /** -OK 1880 fgets : A S -> S L +Q0 OK 1880 fgets : A S -> S L [FOREIGN] L is the next available line (as a string) from stream S. */ void fgets_(pEnv env) diff --git a/src/file.c b/src/file.c index 7994af1f..137b0b6e 100644 --- a/src/file.c +++ b/src/file.c @@ -1,13 +1,13 @@ /* module : file.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef FILE_C #define FILE_C /** -OK 2400 file : DA F -> B +Q0 OK 2400 file : DA F -> B [FOREIGN] Tests whether F is a file. */ void file_(pEnv env) diff --git a/src/filetime.c b/src/filetime.c index 885bfdc7..bfee33eb 100644 --- a/src/filetime.c +++ b/src/filetime.c @@ -1,7 +1,7 @@ /* module : filetime.c - version : 1.11 - date : 02/05/24 + version : 1.12 + date : 03/05/24 */ #ifndef FILETIME_C #define FILETIME_C @@ -9,7 +9,7 @@ #include /** -OK 3150 filetime : DA F -> T +Q0 OK 3150 filetime : DA F -> T [FOREIGN] T is the modification time of file F. */ void filetime_(pEnv env) diff --git a/src/filter.c b/src/filter.c index a9564491..2fa9d910 100644 --- a/src/filter.c +++ b/src/filter.c @@ -1,13 +1,13 @@ /* module : filter.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef FILTER_C #define FILTER_C /** -OK 2830 filter : DDA A [B] -> A1 +Q0 OK 2830 filter : DDA A [B] -> A1 Uses test B to filter aggregate A producing sametype aggregate A1. */ void filter_(pEnv env) diff --git a/src/first.c b/src/first.c index e658436d..c787aae1 100644 --- a/src/first.c +++ b/src/first.c @@ -1,13 +1,13 @@ /* module : first.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef FIRST_C #define FIRST_C /** -OK 2030 first : DA A -> F +Q0 OK 2030 first : DA A -> F F is the first member of the non-empty aggregate A. */ void first_(pEnv env) diff --git a/src/fjump.c b/src/fjump.c index e5796e27..f482902f 100644 --- a/src/fjump.c +++ b/src/fjump.c @@ -1,13 +1,13 @@ /* module : fjump.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef FJUMP_C #define FJUMP_C /** -OK 3420 #fjump : D -> +Q0 OK 3420 #fjump : D -> Pop the jump location from the program stack. Pop the top of the data stack. If the top of the stack was false, jump to the location in the program stack. */ diff --git a/src/float.c b/src/float.c index 1bb14e5b..8ae63abc 100644 --- a/src/float.c +++ b/src/float.c @@ -1,13 +1,13 @@ /* module : float.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef FLOAT_C #define FLOAT_C /** -OK 2390 float : DA R -> B +Q0 OK 2390 float : DA R -> B Tests whether R is a float. */ void float_(pEnv env) diff --git a/src/floor.c b/src/floor.c index 17feed4c..a88b737b 100644 --- a/src/floor.c +++ b/src/floor.c @@ -1,13 +1,13 @@ /* module : floor.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef FLOOR_C #define FLOOR_C /** -OK 1570 floor : DA F -> G +Q0 OK 1570 floor : DA F -> G G is the floor of F. */ void floor_(pEnv env) diff --git a/src/fold.c b/src/fold.c index 2726b478..ab7a8afe 100644 --- a/src/fold.c +++ b/src/fold.c @@ -1,13 +1,13 @@ /* module : fold.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef FOLD_C #define FOLD_C /** -OK 2780 fold : DDDA A V0 [P] -> V +Q1 OK 2780 fold : DDDA A V0 [P] -> V Starting with value V0, sequentially pushes members of aggregate A and combines with binary operator P to produce value V. */ diff --git a/src/fopen.c b/src/fopen.c index 24bb715c..aba80766 100644 --- a/src/fopen.c +++ b/src/fopen.c @@ -1,13 +1,13 @@ /* module : fopen.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef FOPEN_C #define FOPEN_C /** -OK 1890 fopen : DDA P M -> S +Q0 OK 1890 fopen : DDA P M -> S [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. diff --git a/src/format.c b/src/format.c index 26a55c27..00de41e7 100644 --- a/src/format.c +++ b/src/format.c @@ -1,13 +1,13 @@ /* module : format.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef FORMAT_C #define FORMAT_C /** -OK 1760 format : DDDDA N C I J -> S +Q0 OK 1760 format : DDDDA N C I J -> S S is the formatted version of N in mode C ('d or 'i = decimal, 'o = octal, 'x or 'X = hex with lower or upper case letters) diff --git a/src/formatf.c b/src/formatf.c index b950d035..fd091fb2 100644 --- a/src/formatf.c +++ b/src/formatf.c @@ -1,13 +1,13 @@ /* module : formatf.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef FORMATF_C #define FORMATF_C /** -OK 1770 formatf : DDDDA F C I J -> S +Q0 OK 1770 formatf : DDDDA F C I J -> S S is the formatted version of F in mode C ('e or 'E = exponential, 'f = fractional, 'g or G = general with lower or upper case letters) diff --git a/src/fpush.c b/src/fpush.c index c221f35c..9e336e69 100644 --- a/src/fpush.c +++ b/src/fpush.c @@ -1,13 +1,13 @@ /* module : fpush.c - version : 1.11 - date : 01/25/24 + version : 1.12 + date : 03/05/24 */ #ifndef FPUSH_C #define FPUSH_C /** -OK 3380 #fpush : D -> +Q0 OK 3380 #fpush : D -> Pop the location of an aggregate and an element from the program stack. If the top of the data stack is true, add the element to the aggregate. */ diff --git a/src/fput.c b/src/fput.c index 8790a135..2a2d1248 100644 --- a/src/fput.c +++ b/src/fput.c @@ -1,13 +1,13 @@ /* module : fput.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FPUT_C #define FPUT_C /** -OK 1940 fput : D S X -> S +Q0 OK 1940 fput : D S X -> S [FOREIGN] Writes X to stream S, pops X off stack. */ void fput_(pEnv env) diff --git a/src/fputch.c b/src/fputch.c index d0ba746d..4c99163f 100644 --- a/src/fputch.c +++ b/src/fputch.c @@ -1,13 +1,13 @@ /* module : fputch.c - version : 1.8 - date : 02/02/24 + version : 1.9 + date : 03/05/24 */ #ifndef FPUTCH_C #define FPUTCH_C /** -OK 1950 fputch : A S C -> S +Q0 OK 1950 fputch : A S C -> S [FOREIGN] The character C is written to the current position of stream S. */ void fputch_(pEnv env) diff --git a/src/fputchars.c b/src/fputchars.c index a179e97c..fcdd56fa 100644 --- a/src/fputchars.c +++ b/src/fputchars.c @@ -1,17 +1,17 @@ /* module : fputchars.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FPUTCHARS_C #define FPUTCHARS_C /** -OK 1960 fputchars : D S "abc.." -> S +Q0 OK 1960 fputchars : D S "abc.." -> S [FOREIGN] The string abc.. (no quotes) is written to the current position of stream S. */ -void fputchars_(pEnv env) /* suggested by Heiko Kuhrt, as "fputstring_" */ +void fputchars_(pEnv env) /* suggested by Heiko Kuhrt, as "fputstring_" */ { Node node, elem; diff --git a/src/fputstring.c b/src/fputstring.c index 99d084c7..046dcfdc 100644 --- a/src/fputstring.c +++ b/src/fputstring.c @@ -1,13 +1,13 @@ /* module : fputstring.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef FPUTSTRING_C #define FPUTSTRING_C /** -OK 1970 fputstring : D S "abc.." -> S +Q0 OK 1970 fputstring : D S "abc.." -> S [FOREIGN] == fputchars, as a temporary alternative. */ void fputstring_(pEnv env) diff --git a/src/fread.c b/src/fread.c index eed925c7..aa4d4170 100644 --- a/src/fread.c +++ b/src/fread.c @@ -1,13 +1,13 @@ /* module : fread.c - version : 1.9 - date : 02/01/24 + version : 1.10 + date : 03/05/24 */ #ifndef FREAD_C #define FREAD_C /** -OK 1900 fread : DA S I -> S L +Q0 OK 1900 fread : DA S I -> S L [FOREIGN] I bytes are read from the current position of stream S and returned as a list of I integers. */ diff --git a/src/fremove.c b/src/fremove.c index 76ad0d4a..43dd5f21 100644 --- a/src/fremove.c +++ b/src/fremove.c @@ -1,13 +1,13 @@ /* module : fremove.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef FREMOVE_C #define FREMOVE_C /** -OK 1920 fremove : DA P -> B +Q0 OK 1920 fremove : DA P -> B [FOREIGN] The file system object with pathname P is removed from the file system. B is a boolean indicating success or failure. */ diff --git a/src/frename.c b/src/frename.c index f5d8375c..e77b7f7c 100644 --- a/src/frename.c +++ b/src/frename.c @@ -1,13 +1,13 @@ /* module : frename.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef FRENAME_C #define FRENAME_C /** -OK 1930 frename : DDA P1 P2 -> B +Q0 OK 1930 frename : DDA P1 P2 -> B [FOREIGN] The file system object with pathname P1 is renamed to P2. B is a boolean indicating success or failure. */ diff --git a/src/frexp.c b/src/frexp.c index 0a376412..2019e50f 100644 --- a/src/frexp.c +++ b/src/frexp.c @@ -1,13 +1,13 @@ /* module : frexp.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef FREXP_C #define FREXP_C /** -OK 1580 frexp : DAA F -> G I +Q0 OK 1580 frexp : DAA F -> G I G is the mantissa and I is the exponent of F. Unless F = 0, 0.5 <= abs(G) < 1.0. */ diff --git a/src/fseek.c b/src/fseek.c index e63b5a51..1be8d679 100644 --- a/src/fseek.c +++ b/src/fseek.c @@ -1,13 +1,13 @@ /* module : fseek.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FSEEK_C #define FSEEK_C /** -OK 1980 fseek : DDA S P W -> S B +Q0 OK 1980 fseek : DDA S P W -> S B [FOREIGN] Stream S is repositioned to position P relative to whence-point W, where W = 0, 1, 2 for beginning, current position, end respectively. */ diff --git a/src/ftell.c b/src/ftell.c index a831c5a2..e587d579 100644 --- a/src/ftell.c +++ b/src/ftell.c @@ -1,13 +1,13 @@ /* module : ftell.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FTELL_C #define FTELL_C /** -OK 1990 ftell : A S -> S I +Q0 OK 1990 ftell : A S -> S I [FOREIGN] I is the current position of stream S. */ void ftell_(pEnv env) diff --git a/src/fwrite.c b/src/fwrite.c index 8c0ff29b..f9254513 100644 --- a/src/fwrite.c +++ b/src/fwrite.c @@ -1,13 +1,13 @@ /* module : fwrite.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef FWRITE_C #define FWRITE_C /** -OK 1910 fwrite : D S L -> S +Q0 OK 1910 fwrite : D S L -> S [FOREIGN] A list of integers are written as bytes to the current position of stream S. */ diff --git a/src/gc.c b/src/gc.c index 3ee370bb..ac9e0711 100644 --- a/src/gc.c +++ b/src/gc.c @@ -1,13 +1,13 @@ /* module : gc.c - version : 1.6 - date : 02/01/24 + version : 1.7 + date : 03/05/24 */ #ifndef GC_C #define GC_C /** -OK 3010 gc : N -> +Q0 OK 3010 gc : N -> [IMPURE] Initiates garbage collection. */ void gc_(pEnv env) diff --git a/src/genrec.c b/src/genrec.c index fdfa9df7..d69f24ec 100644 --- a/src/genrec.c +++ b/src/genrec.c @@ -1,13 +1,13 @@ /* module : genrec.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef GENREC_C #define GENREC_C /** -OK 2740 genrec : DDDDDA [B] [T] [R1] [R2] -> ... +Q4 OK 2740 genrec : DDDDDA [B] [T] [R1] [R2] -> ... Executes B, if that yields true, executes T. Else executes R1 and then [[[B] [T] [R1] R2] genrec] R2. */ diff --git a/src/genrecaux.c b/src/genrecaux.c index 536bd48e..7c7b295e 100644 --- a/src/genrecaux.c +++ b/src/genrecaux.c @@ -1,13 +1,13 @@ /* module : genrecaux.c - version : 1.11 - date : 02/01/24 + version : 1.12 + date : 03/05/24 */ #ifndef GENRECAUX_C #define GENRECAUX_C /** -OK 3290 #genrec : DDDDDA [[B] [T] [R1] R2] -> ... +Q1 OK 3290 #genrec : DDDDDA [[B] [T] [R1] R2] -> ... Executes B, if that yields true, executes T. Else executes R1 and then [[[B] [T] [R1] R2] genrec] R2. */ diff --git a/src/geql.c b/src/geql.c index a34f7721..cfcc300f 100644 --- a/src/geql.c +++ b/src/geql.c @@ -1,7 +1,7 @@ /* module : geql.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef GEQL_C #define GEQL_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2220 >=\0geql : DDA X Y -> B +Q0 OK 2220 >=\0geql : DDA X Y -> B Either both X and Y are numeric or both are strings or symbols. Tests whether X greater than or equal to Y. Also supports float. */ diff --git a/src/get.c b/src/get.c index 7c5d3392..a29ac5e1 100644 --- a/src/get.c +++ b/src/get.c @@ -1,13 +1,13 @@ /* module : get.c - version : 1.6 - date : 02/01/24 + version : 1.7 + date : 03/05/24 */ #ifndef GET_C #define GET_C /** -OK 3070 get : A -> F +Q0 OK 3070 get : A -> F [IMPURE] Reads a factor from input and pushes it onto stack. */ PRIVATE void get_(pEnv env) diff --git a/src/getch.c b/src/getch.c index d48f8837..43ff6a0e 100644 --- a/src/getch.c +++ b/src/getch.c @@ -1,13 +1,13 @@ /* module : getch.c - version : 1.11 - date : 02/05/24 + version : 1.12 + date : 03/05/24 */ #ifndef GETCH_C #define GETCH_C /** -OK 3160 getch : A -> N +Q0 OK 3160 getch : A -> N [IMPURE] Reads a character from input and puts it onto stack. */ void getch_(pEnv env) diff --git a/src/getenv.c b/src/getenv.c index 5669d53e..017a0e41 100644 --- a/src/getenv.c +++ b/src/getenv.c @@ -1,13 +1,13 @@ /* module : getenv.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef GETENV_C #define GETENV_C /** -OK 3030 getenv : DA "variable" -> "value" +Q0 OK 3030 getenv : DA "variable" -> "value" Retrieves the value of the environment variable "variable". */ void getenv_(pEnv env) diff --git a/src/gmtime.c b/src/gmtime.c index 4e778089..f239e049 100644 --- a/src/gmtime.c +++ b/src/gmtime.c @@ -1,13 +1,13 @@ /* module : gmtime.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef GMTIME_C #define GMTIME_C /** -OK 1710 gmtime : DA I -> T +Q0 OK 1710 gmtime : DA I -> T Converts a time I into a list T representing universal time: [year month day hour minute second isdst yearday weekday]. Month is 1 = January ... 12 = December; diff --git a/src/greater.c b/src/greater.c index d7b6f395..132b98a4 100644 --- a/src/greater.c +++ b/src/greater.c @@ -1,7 +1,7 @@ /* module : greater.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef GREATER_C #define GREATER_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2230 >\0greater : DDA X Y -> B +Q0 OK 2230 >\0greater : DDA X Y -> B Either both X and Y are numeric or both are strings or symbols. Tests whether X greater than Y. Also supports float. */ diff --git a/src/has.c b/src/has.c index 7c0d5c03..9446bd79 100644 --- a/src/has.c +++ b/src/has.c @@ -1,7 +1,7 @@ /* module : has.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef HAS_C #define HAS_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2290 has : DDA A X -> B +Q0 OK 2290 has : DDA A X -> B Tests whether aggregate A has X as a member. */ void has_(pEnv env) diff --git a/src/help.c b/src/help.c index f25b46ab..0270251b 100644 --- a/src/help.c +++ b/src/help.c @@ -1,13 +1,13 @@ /* module : help.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef HELP_C #define HELP_C /** -OK 2900 help : N -> +Q0 OK 2900 help : N -> [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/helpdetail.c b/src/helpdetail.c index 373d68ea..c5fff377 100644 --- a/src/helpdetail.c +++ b/src/helpdetail.c @@ -1,13 +1,13 @@ /* module : helpdetail.c - version : 1.8 - date : 02/01/24 + version : 1.11 + date : 03/05/24 */ #ifndef HELPDETAIL_C #define HELPDETAIL_C /** -OK 2920 helpdetail : D [ S1 S2 .. ] -> +Q0 OK 2920 helpdetail : D [ S1 S2 .. ] -> [IMPURE] Gives brief help on each symbol S in the list. */ void helpdetail_(pEnv env) @@ -33,12 +33,12 @@ void helpdetail_(pEnv env) if (env->bytecoding || env->compiling) opcode = temp.u.ent; else - opcode = operindex(temp.u.proc); + opcode = operindex(env, temp.u.proc); } if (opcode == BOOLEAN_) - opcode = operindex(temp.u.num ? true_ : false_); - if (opcode == INTEGER_ && temp.u.num == MAXINT) - opcode = operindex(maxint_); + opcode = operindex(env, temp.u.num ? true_ : false_); + if (opcode == INTEGER_ && temp.u.num == MAXINT_) + opcode = operindex(env, maxint_); tab = readtable(opcode); printf("%s\t: %s.\n%s\n", tab->name, tab->messg1, tab->messg2); if (opcode <= BIGNUM_) diff --git a/src/i.c b/src/i.c index 2f2a5e32..c587176a 100644 --- a/src/i.c +++ b/src/i.c @@ -1,13 +1,13 @@ /* module : i.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef I_C #define I_C /** -OK 2410 i : DP [P] -> ... +Q1 OK 2410 i : DP [P] -> ... Executes P. So, [P] i == P. */ PRIVATE void i_(pEnv env) diff --git a/src/id.c b/src/id.c index 5ea8908d..9786885d 100644 --- a/src/id.c +++ b/src/id.c @@ -1,13 +1,13 @@ /* module : id.c - version : 1.5 - date : 10/02/23 + version : 1.6 + date : 03/05/24 */ #ifndef ID_C #define ID_C /** -OK 1200 id : N -> +Q0 OK 1200 id : N -> Identity function, does nothing. Any program of the form P id Q is equivalent to just P Q. */ diff --git a/src/ifchar.c b/src/ifchar.c index ad31e70f..35dd11d8 100644 --- a/src/ifchar.c +++ b/src/ifchar.c @@ -1,13 +1,13 @@ /* module : ifchar.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFCHAR_C #define IFCHAR_C /** -OK 2620 ifchar : DDDP X [T] [E] -> ... +Q2 OK 2620 ifchar : DDDP X [T] [E] -> ... If X is a character, executes T else executes E. */ void ifchar_(pEnv env) diff --git a/src/iffile.c b/src/iffile.c index 5ca916cc..a1ef0d08 100644 --- a/src/iffile.c +++ b/src/iffile.c @@ -1,13 +1,13 @@ /* module : iffile.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef IFFILE_C #define IFFILE_C /** -OK 2680 iffile : DDDP X [T] [E] -> ... +Q2 OK 2680 iffile : DDDP X [T] [E] -> ... [FOREIGN] If X is a file, executes T else executes E. */ void iffile_(pEnv env) diff --git a/src/iffloat.c b/src/iffloat.c index 4843c71f..fe31538e 100644 --- a/src/iffloat.c +++ b/src/iffloat.c @@ -1,13 +1,13 @@ /* module : iffloat.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFFLOAT_C #define IFFLOAT_C /** -OK 2670 iffloat : DDDP X [T] [E] -> ... +Q2 OK 2670 iffloat : DDDP X [T] [E] -> ... If X is a float, executes T else executes E. */ void iffloat_(pEnv env) diff --git a/src/ifinteger.c b/src/ifinteger.c index c46cf8e4..61571181 100644 --- a/src/ifinteger.c +++ b/src/ifinteger.c @@ -1,13 +1,13 @@ /* module : ifinteger.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFINTEGER_C #define IFINTEGER_C /** -OK 2610 ifinteger : DDDP X [T] [E] -> ... +Q2 OK 2610 ifinteger : DDDP X [T] [E] -> ... If X is an integer, executes T else executes E. */ void ifinteger_(pEnv env) diff --git a/src/iflist.c b/src/iflist.c index f9cc51f7..fbb155b1 100644 --- a/src/iflist.c +++ b/src/iflist.c @@ -1,13 +1,13 @@ /* module : iflist.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFLIST_C #define IFLIST_C /** -OK 2660 iflist : DDDP X [T] [E] -> ... +Q2 OK 2660 iflist : DDDP X [T] [E] -> ... If X is a list, executes T else executes E. */ void iflist_(pEnv env) diff --git a/src/iflogical.c b/src/iflogical.c index fcf537a9..76c83ae7 100644 --- a/src/iflogical.c +++ b/src/iflogical.c @@ -1,13 +1,13 @@ /* module : iflogical.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFLOGICAL_C #define IFLOGICAL_C /** -OK 2630 iflogical : DDDP X [T] [E] -> ... +Q2 OK 2630 iflogical : DDDP X [T] [E] -> ... If X is a logical or truth value, executes T else executes E. */ void iflogical_(pEnv env) diff --git a/src/ifset.c b/src/ifset.c index 6372ac7b..7f3ad587 100644 --- a/src/ifset.c +++ b/src/ifset.c @@ -1,13 +1,13 @@ /* module : ifset.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFSET_C #define IFSET_C /** -OK 2640 ifset : DDDP X [T] [E] -> ... +Q2 OK 2640 ifset : DDDP X [T] [E] -> ... If X is a set, executes T else executes E. */ void ifset_(pEnv env) diff --git a/src/ifstring.c b/src/ifstring.c index 5636deec..db7e76ab 100644 --- a/src/ifstring.c +++ b/src/ifstring.c @@ -1,13 +1,13 @@ /* module : ifstring.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFSTRING_C #define IFSTRING_C /** -OK 2650 ifstring : DDDP X [T] [E] -> ... +Q2 OK 2650 ifstring : DDDP X [T] [E] -> ... If X is a string, executes T else executes E. */ void ifstring_(pEnv env) diff --git a/src/ifte.c b/src/ifte.c index 546b7103..bcb12bdd 100644 --- a/src/ifte.c +++ b/src/ifte.c @@ -1,13 +1,13 @@ /* module : ifte.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef IFTE_C #define IFTE_C /** -OK 2600 ifte : DDDP [B] [T] [F] -> ... +Q3 OK 2600 ifte : DDDP [B] [T] [F] -> ... Executes B. If that yields true, then executes T else executes F. */ void ifte_(pEnv env) diff --git a/src/in.c b/src/in.c index f9d7accc..cd1c51f2 100644 --- a/src/in.c +++ b/src/in.c @@ -1,7 +1,7 @@ /* module : in.c - version : 1.10 - date : 01/25/24 + version : 1.12 + date : 03/05/24 */ #ifndef IN_C #define IN_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2300 in : DDA X A -> B +Q0 OK 2300 in : DDA X A -> B Tests whether X is a member of aggregate A. */ void in_(pEnv env) @@ -17,7 +17,7 @@ void in_(pEnv env) int i, found = 0; Node aggr, elem, node; - PARM(2, IN); + PARM(2, IN_); env->stck = pvec_pop(env->stck, &aggr); env->stck = pvec_pop(env->stck, &elem); switch (aggr.op) { diff --git a/src/include.c b/src/include.c index 26390ece..512c7697 100644 --- a/src/include.c +++ b/src/include.c @@ -1,13 +1,13 @@ /* module : include.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef INCLUDE_C #define INCLUDE_C /** -OK 3110 include : D "filnam.ext" -> +Q0 OK 3110 include : D "filnam.ext" -> Transfers input to file whose name is "filnam.ext". On end-of-file returns to previous input file. */ diff --git a/src/infra.c b/src/infra.c index ab81ae2b..135c9253 100644 --- a/src/infra.c +++ b/src/infra.c @@ -1,13 +1,13 @@ /* module : infra.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef INFRA_C #define INFRA_C /** -OK 2810 infra : DDA L1 [P] -> L2 +Q1 OK 2810 infra : DDA L1 [P] -> L2 Using list L1 as stack, executes P and returns a new list L2. The first element of L1 is used as the top of stack, and after execution of P the top of stack becomes the first element of L2. diff --git a/src/integer.c b/src/integer.c index fba38d85..5284166f 100644 --- a/src/integer.c +++ b/src/integer.c @@ -1,13 +1,13 @@ /* module : integer.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef INTEGER_C #define INTEGER_C /** -OK 2310 integer : DA X -> B +Q0 OK 2310 integer : DA X -> B Tests whether X is an integer. */ void integer_(pEnv env) diff --git a/src/intern.c b/src/intern.c index 3b0aee37..23aa3e96 100644 --- a/src/intern.c +++ b/src/intern.c @@ -1,13 +1,13 @@ /* module : intern.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef INTERN_C #define INTERN_C /** -OK 2180 intern : DA "sym" -> sym +Q0 OK 2180 intern : DA "sym" -> sym Pushes the item whose name is "sym". */ PRIVATE void intern_(pEnv env) diff --git a/src/jfalse.c b/src/jfalse.c index ca7394c5..0c1373d3 100644 --- a/src/jfalse.c +++ b/src/jfalse.c @@ -1,13 +1,13 @@ /* module : jfalse.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef JFALSE_C #define JFALSE_C /** -OK 3390 #jfalse : N -> +Q0 OK 3390 #jfalse : N -> Pop the jump location from the program stack. If the top of the data stack is false, jump to that location. */ diff --git a/src/jump.c b/src/jump.c index 86c2b09f..d3fddf5f 100644 --- a/src/jump.c +++ b/src/jump.c @@ -1,13 +1,13 @@ /* module : jump.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef JUMP_C #define JUMP_C /** -OK 3320 #jump : N -> +Q0 OK 3320 #jump : N -> Pop the jump location from the program stack. Jump to that location. */ void jump_(pEnv env) diff --git a/src/ldexp.c b/src/ldexp.c index 2a7c0aae..f50224ad 100644 --- a/src/ldexp.c +++ b/src/ldexp.c @@ -1,13 +1,13 @@ /* module : ldexp.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LDEXP_C #define LDEXP_C /** -OK 1590 ldexp : DDA F I -> G +Q0 OK 1590 ldexp : DDA F I -> G G is F times 2 to the Ith power. */ void ldexp_(pEnv env) diff --git a/src/leaf.c b/src/leaf.c index ac55cc71..98bed64b 100644 --- a/src/leaf.c +++ b/src/leaf.c @@ -1,13 +1,13 @@ /* module : leaf.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LEAF_C #define LEAF_C /** -OK 2370 leaf : DA X -> B +Q0 OK 2370 leaf : DA X -> B Tests whether X is not a list. */ void leaf_(pEnv env) diff --git a/src/leql.c b/src/leql.c index d2246c6b..0de770c9 100644 --- a/src/leql.c +++ b/src/leql.c @@ -1,7 +1,7 @@ /* module : leql.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LEQL_C #define LEQL_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2240 <=\0leql : DDA X Y -> B +Q0 OK 2240 <=\0leql : DDA X Y -> B Either both X and Y are numeric or both are strings or symbols. Tests whether X less than or equal to Y. Also supports float. */ diff --git a/src/less.c b/src/less.c index 6240574f..51af99ed 100644 --- a/src/less.c +++ b/src/less.c @@ -1,7 +1,7 @@ /* module : less.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LESS_C #define LESS_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2250 <\0less : DDA X Y -> B +Q0 OK 2250 <\0less : DDA X Y -> B Either both X and Y are numeric or both are strings or symbols. Tests whether X less than Y. Also supports float. */ diff --git a/src/linrec.c b/src/linrec.c index 9e02b277..b83c46a1 100644 --- a/src/linrec.c +++ b/src/linrec.c @@ -1,13 +1,13 @@ /* module : linrec.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef LINREC_C #define LINREC_C /** -OK 2710 linrec : DDDDDA [P] [T] [R1] [R2] -> ... +Q4 OK 2710 linrec : DDDDDA [P] [T] [R1] [R2] -> ... Executes P. If that yields true, executes T. Else executes R1, recurses, executes R2. */ diff --git a/src/list.c b/src/list.c index 34bb207f..b0cb25dc 100644 --- a/src/list.c +++ b/src/list.c @@ -1,13 +1,13 @@ /* module : list.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LIST_C #define LIST_C /** -OK 2360 list : DA X -> B +Q0 OK 2360 list : DA X -> B Tests whether X is a list. */ void list_(pEnv env) diff --git a/src/localtime.c b/src/localtime.c index 3b390a81..4998e835 100644 --- a/src/localtime.c +++ b/src/localtime.c @@ -1,13 +1,13 @@ /* module : localtime.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef LOCALTIME_C #define LOCALTIME_C /** -OK 1700 localtime : DA I -> T +Q0 OK 1700 localtime : DA I -> T Converts a time I into a list T representing local time: [year month day hour minute second isdst yearday weekday]. Month is 1 = January ... 12 = December; diff --git a/src/log.c b/src/log.c index 45252b90..80fcfcea 100644 --- a/src/log.c +++ b/src/log.c @@ -1,13 +1,13 @@ /* module : log.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LOG_C #define LOG_C /** -OK 1600 log : DA F -> G +Q0 OK 1600 log : DA F -> G G is the natural logarithm of F. */ void log_(pEnv env) diff --git a/src/log10.c b/src/log10.c index 2f439ee6..bd70d283 100644 --- a/src/log10.c +++ b/src/log10.c @@ -1,13 +1,13 @@ /* module : log10.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LOG10_C #define LOG10_C /** -OK 1610 log10 : DA F -> G +Q0 OK 1610 log10 : DA F -> G G is the common logarithm of F. */ void log10_(pEnv env) diff --git a/src/logical.c b/src/logical.c index f490322c..cca59643 100644 --- a/src/logical.c +++ b/src/logical.c @@ -1,13 +1,13 @@ /* module : logical.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef LOGICAL_C #define LOGICAL_C /** -OK 2330 logical : DA X -> B +Q0 OK 2330 logical : DA X -> B Tests whether X is a logical. */ void logical_(pEnv env) diff --git a/src/manual.c b/src/manual.c index 120382f7..fbb8e955 100644 --- a/src/manual.c +++ b/src/manual.c @@ -1,7 +1,7 @@ /* module : manual.c - version : 1.6 - date : 02/01/24 + version : 1.7 + date : 03/05/24 */ #ifndef MANUAL_C #define MANUAL_C @@ -9,7 +9,7 @@ #include "manual.h" /** -OK 2930 manual : N -> +Q0 OK 2930 manual : N -> [IMPURE] Writes this manual of all Joy primitives to output file. */ void manual_(pEnv env) diff --git a/src/manual.h b/src/manual.h index 3e681333..4ced1f86 100644 --- a/src/manual.h +++ b/src/manual.h @@ -1,7 +1,7 @@ /* module : manual.h - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef MANUAL_H #define MANUAL_H @@ -24,15 +24,16 @@ printf("\n\n"); \ } -PUBLIC void make_manual(int style /* 0=plain, 1=HTML, 2=Latex */) +PRIVATE void make_manual(int style) /* 0=plain, 1=HTML, 2=Latex */ { int i; + char *n; OpTable *optable; if (HTML) printf("\n
\n"); for (i = BOOLEAN_; (optable = readtable(i)) != 0; i++) { - char *n = optable->name; + n = optable->name; HEADER(n, " truth value type", "literal") else HEADER(n, "false", "operand") else HEADER(n, "id", "operator") else @@ -41,39 +42,43 @@ PUBLIC void make_manual(int style /* 0=plain, 1=HTML, 2=Latex */) HEADER(n, "help", "miscellaneous commands") else HEADER(n, "casting", "additional commands") else HEADER(n, "#genrec", "runtime commands") +#if 0 if (n[0] != '_') { - if (HTML) - printf("\n
"); - else if (LATEX) { - if (n[0] == ' ') { - n++; - printf("\\item[\\BX{"); - } else - printf("\\item[\\JX{"); - } - if (HTML && strcmp(n, "<=") == 0) - printf("<="); - else - printf("%s", n); - if (LATEX) - printf("}] \\verb#"); - if (HTML) - printf(" : "); - /* the above line does not produce the spaces around ":" */ - else - printf(" : "); - printf("%s", optable->messg1); - if (HTML) - printf("\n
"); - else if (LATEX) - printf("# \\\\ \n {\\small\\verb#"); - else - printf("\n"); - printf("%s", optable->messg2); - if (LATEX) - printf("#}"); - printf("\n\n"); +#endif + if (HTML) + printf("\n
"); + else if (LATEX) { + if (n[0] == ' ') { + n++; + printf("\\item[\\BX{"); + } else + printf("\\item[\\JX{"); + } + if (HTML && strcmp(n, "<=") == 0) + printf("<="); + else + printf("%s", n); + if (LATEX) + printf("}] \\verb#"); + if (HTML) + printf("  :  "); + /* the above line does produce the spaces around ":" */ + else + printf(" : "); + printf("%s", optable->messg1); + if (HTML) + printf("\n
"); + else if (LATEX) + printf("# \\\\ \n {\\small\\verb#"); + else + printf("\n"); + printf("%s", optable->messg2); + if (LATEX) + printf("#}"); + printf("\n\n"); +#if 0 } +#endif } if (HTML) printf("\n
\n\n"); diff --git a/src/map.c b/src/map.c index 1633f204..74be1fd3 100644 --- a/src/map.c +++ b/src/map.c @@ -1,13 +1,13 @@ /* module : map.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef MAP_C #define MAP_C /** -OK 2790 map : DDA A [P] -> B +Q1 OK 2790 map : DDA A [P] -> B Executes P on each member of aggregate A, collects results in sametype aggregate B. */ diff --git a/src/max.c b/src/max.c index 2b2fb7e1..8acc9736 100644 --- a/src/max.c +++ b/src/max.c @@ -1,13 +1,13 @@ /* module : max.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef MAX_C #define MAX_C /** -OK 1810 max : DDA N1 N2 -> N +Q0 OK 1810 max : DDA N1 N2 -> N N is the maximum of numeric values N1 and N2. Also supports float. */ void max_(pEnv env) diff --git a/src/maxint.c b/src/maxint.c index bbd5f1e7..bfcc9f66 100644 --- a/src/maxint.c +++ b/src/maxint.c @@ -1,20 +1,20 @@ /* module : maxint.c - version : 1.7 - date : 10/02/23 + version : 1.9 + date : 03/05/24 */ #ifndef MAXINT_C #define MAXINT_C /** -IMMEDIATE 1020 maxint : A -> maxint +Q0 IMMEDIATE 1020 maxint : A -> maxint Pushes largest integer (platform dependent). Typically it is 32 bits. */ void maxint_(pEnv env) { Node node; - node.u.num = MAXINT; + node.u.num = MAXINT_; node.op = INTEGER_; env->stck = pvec_add(env->stck, node); } diff --git a/src/min.c b/src/min.c index 0445c721..3bd9b90e 100644 --- a/src/min.c +++ b/src/min.c @@ -1,13 +1,13 @@ /* module : min.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef MIN_C #define MIN_C /** -OK 1820 min : DDA N1 N2 -> N +Q0 OK 1820 min : DDA N1 N2 -> N N is the minimum of numeric values N1 and N2. Also supports float. */ void min_(pEnv env) diff --git a/src/minus.c b/src/minus.c index 7b793bd0..6d833540 100644 --- a/src/minus.c +++ b/src/minus.c @@ -1,13 +1,13 @@ /* module : minus.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef MINUS_C #define MINUS_C /** -OK 1390 -\0minus : DDA M I -> N +Q0 OK 1390 -\0minus : DDA M I -> N Numeric N is the result of subtracting integer I from numeric M. Also supports float. */ diff --git a/src/mktime.c b/src/mktime.c index 2dfc1cce..a97ef742 100644 --- a/src/mktime.c +++ b/src/mktime.c @@ -1,7 +1,7 @@ /* module : mktime.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef MKTIME_C #define MKTIME_C @@ -9,7 +9,7 @@ #include "decode.h" /** -OK 1720 mktime : DA T -> I +Q0 OK 1720 mktime : DA T -> I Converts a list T representing local time into a time I. T is in the format generated by localtime. */ diff --git a/src/modf.c b/src/modf.c index 734f42d2..5e50df5a 100644 --- a/src/modf.c +++ b/src/modf.c @@ -1,13 +1,13 @@ /* module : modf.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef MODF_C #define MODF_C /** -OK 1620 modf : DAA F -> G H +Q0 OK 1620 modf : DAA F -> G H G is the fractional part and H is the integer part (but expressed as a float) of F. */ diff --git a/src/mul.c b/src/mul.c index 32996ec3..20ae875f 100644 --- a/src/mul.c +++ b/src/mul.c @@ -1,13 +1,13 @@ /* module : mul.c - version : 1.9 - date : 01/25/24 + version : 1.11 + date : 03/05/24 */ #ifndef MUL_C #define MUL_C /** -OK 1400 *\0ast : DDA I J -> K +Q0 OK 1400 *\0ast : DDA I J -> K Integer K is the product of integers I and J. Also supports float. */ void mul_(pEnv env) @@ -81,7 +81,7 @@ void mul_(pEnv env) if ((sign2 = num2 < 0) != 0) /* make positive */ num2 = -num2; #ifdef USE_BIGNUM_ARITHMETIC - if (num1 > MAXINT / num2 || num2 > MAXINT / num1) { /* overflow */ + if (num1 > MAXINT_ / num2 || num2 > MAXINT_ / num1) { /* overflow */ first.u.str = num2big(num1); second.u.str = num2big(num2); first.u.str = num_str_mul(first.u.str, second.u.str); diff --git a/src/name.c b/src/name.c index f33b102a..b243f438 100644 --- a/src/name.c +++ b/src/name.c @@ -1,13 +1,13 @@ /* module : name.c - version : 1.8 - date : 02/01/24 + version : 1.10 + date : 03/05/24 */ #ifndef NAME_C #define NAME_C /** -OK 2170 name : DA sym -> "sym" +Q0 OK 2170 name : DA sym -> "sym" For operators and combinators, the string "sym" is the name of item sym, for literals sym the result string is its type. */ @@ -23,7 +23,7 @@ void name_(pEnv env) if (env->bytecoding || env->compiling) node.u.str = vec_at(env->symtab, node.u.ent).name; else - node.u.str = opername(node.u.proc); + node.u.str = opername(env, node.u.proc); } else node.u.str = showname(node.op); node.op = STRING_; diff --git a/src/neg.c b/src/neg.c index 8d3211a5..9956b8b4 100644 --- a/src/neg.c +++ b/src/neg.c @@ -1,13 +1,13 @@ /* module : neg.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef NEG_C #define NEG_C /** -OK 1450 neg : DA I -> J +Q0 OK 1450 neg : DA I -> J Integer J is the negative of integer I. Also supports float. */ void neg_(pEnv env) diff --git a/src/neql.c b/src/neql.c index 369d9ceb..1f63af02 100644 --- a/src/neql.c +++ b/src/neql.c @@ -1,7 +1,7 @@ /* module : neql.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef NEQL_C #define NEQL_C @@ -9,7 +9,7 @@ #include "compare.h" /** -OK 2260 !=\0neql : DDA X Y -> B +Q0 OK 2260 !=\0neql : DDA X Y -> B Either both X and Y are numeric or both are strings or symbols. Tests whether X not equal to Y. Also supports float. */ diff --git a/src/not.c b/src/not.c index f2a72cd8..957a7069 100644 --- a/src/not.c +++ b/src/not.c @@ -1,13 +1,13 @@ /* module : not.c - version : 1.7 - date : 01/25/24 + version : 1.8 + date : 03/05/24 */ #ifndef NOT_C #define NOT_C /** -OK 1370 not : DA X -> Y +Q0 OK 1370 not : DA X -> Y Y is the complement of set X, logical negation for truth values. */ void not_(pEnv env) diff --git a/src/null.c b/src/null.c index 47e5477b..880a3cfa 100644 --- a/src/null.c +++ b/src/null.c @@ -1,13 +1,13 @@ /* module : null.c - version : 1.10 - date : 02/01/24 + version : 1.11 + date : 03/05/24 */ #ifndef NULL_C #define NULL_C /** -OK 2200 null : DA X -> B +Q0 OK 2200 null : DA X -> B Tests for empty aggregate X or zero numeric. */ void null_(pEnv env) diff --git a/src/nullary.c b/src/nullary.c index 36710937..29b57451 100644 --- a/src/nullary.c +++ b/src/nullary.c @@ -1,13 +1,13 @@ /* module : nullary.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef NULLARY_C #define NULLARY_C /** -OK 2480 nullary : DA [P] -> R +Q0 OK 2480 nullary : DA [P] -> R Executes P, which leaves R on top of the stack. No matter how many parameters this consumes, none are removed from the stack. */ diff --git a/src/of.c b/src/of.c index 40944c02..c45a27be 100644 --- a/src/of.c +++ b/src/of.c @@ -1,13 +1,13 @@ /* module : of.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef OF_C #define OF_C /** -OK 2070 of : DDA I A -> X +Q0 OK 2070 of : DDA I A -> X X (= A[I]) is the I-th member of aggregate A. */ void of_(pEnv env) diff --git a/src/opcase.c b/src/opcase.c index fc4a41c6..ff2ffd61 100644 --- a/src/opcase.c +++ b/src/opcase.c @@ -1,13 +1,13 @@ /* module : opcase.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef OPCASE_C #define OPCASE_C /** -OK 2090 opcase : DA X [..[X Xs]..] -> X [Xs] +Q0 OK 2090 opcase : DA X [..[X Xs]..] -> X [Xs] Indexing on type of X, returns the list [Xs]. */ void opcase_(pEnv env) diff --git a/src/or.c b/src/or.c index d487ce65..fd4afb1d 100644 --- a/src/or.c +++ b/src/or.c @@ -1,13 +1,13 @@ /* module : or.c - version : 1.7 - date : 01/25/24 + version : 1.8 + date : 03/05/24 */ #ifndef OR_C #define OR_C /** -OK 1340 or : DDA X Y -> Z +Q0 OK 1340 or : DDA X Y -> Z Z is the union of sets X and Y, logical disjunction for truth values. */ void or_(pEnv env) diff --git a/src/ord.c b/src/ord.c index 471cbfe3..4fd3c122 100644 --- a/src/ord.c +++ b/src/ord.c @@ -1,13 +1,13 @@ /* module : ord.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ORD_C #define ORD_C /** -OK 1460 ord : DA C -> I +Q0 OK 1460 ord : DA C -> I Integer I is the Ascii value of character C (or logical or integer). */ void ord_(pEnv env) diff --git a/src/over.c b/src/over.c index c18bee8f..ae75df01 100644 --- a/src/over.c +++ b/src/over.c @@ -1,13 +1,13 @@ /* module : over.c - version : 1.10 - date : 02/05/24 + version : 1.11 + date : 03/05/24 */ #ifndef OVER_C #define OVER_C /** -OK 3170 over : A X Y -> X Y X +Q0 OK 3170 over : A 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/pfalse.c b/src/pfalse.c index 51323df5..445ee7e2 100644 --- a/src/pfalse.c +++ b/src/pfalse.c @@ -1,13 +1,13 @@ /* module : pfalse.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef PFALSE_C #define PFALSE_C /** -OK 3370 #pfalse : D -> +Q0 OK 3370 #pfalse : D -> Pop the jump location from the program stack. Pop the condition from the data stack. If the condition is false, jump to that location. */ diff --git a/src/pick.c b/src/pick.c index f7380c73..8d8d7514 100644 --- a/src/pick.c +++ b/src/pick.c @@ -1,13 +1,13 @@ /* module : pick.c - version : 1.12 - date : 02/05/24 + version : 1.13 + date : 03/05/24 */ #ifndef PICK_C #define PICK_C /** -OK 3180 pick : DA X Y Z 2 -> X Y Z X +Q0 OK 3180 pick : DA 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/plus.c b/src/plus.c index 169d41d2..fd94acd8 100644 --- a/src/plus.c +++ b/src/plus.c @@ -1,13 +1,13 @@ /* module : plus.c - version : 1.9 - date : 10/02/23 + version : 1.10 + date : 03/05/24 */ #ifndef PLUS_C #define PLUS_C /** -OK 1380 +\0plus : DDA M I -> N +Q0 OK 1380 +\0plus : DDA M I -> N Numeric N is the result of adding integer I to numeric M. Also supports float. */ diff --git a/src/pop.c b/src/pop.c index 5311c7f6..be965c62 100644 --- a/src/pop.c +++ b/src/pop.c @@ -1,13 +1,13 @@ /* module : pop.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef POP_C #define POP_C /** -OK 1320 pop : D X -> +Q0 OK 1320 pop : D X -> Removes X from top of the stack. */ void pop_(pEnv env) diff --git a/src/popd.c b/src/popd.c index 905a19ef..67aa4eb4 100644 --- a/src/popd.c +++ b/src/popd.c @@ -1,13 +1,13 @@ /* module : popd.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef POPD_C #define POPD_C /** -OK 1260 popd : DDA Y Z -> Z +Q0 OK 1260 popd : DDA Y Z -> Z As if defined by: popd == [pop] dip */ void popd_(pEnv env) diff --git a/src/pow.c b/src/pow.c index e4a45c8f..28191da5 100644 --- a/src/pow.c +++ b/src/pow.c @@ -1,13 +1,13 @@ /* module : pow.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef POW_C #define POW_C /** -OK 1630 pow : DDA F G -> H +Q0 OK 1630 pow : DDA F G -> H H is F raised to the Gth power. */ void pow_(pEnv env) diff --git a/src/pred.c b/src/pred.c index 57db8cb4..397c7686 100644 --- a/src/pred.c +++ b/src/pred.c @@ -1,13 +1,13 @@ /* module : pred.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef PRED_C #define PRED_C /** -OK 1790 pred : DA M -> N +Q0 OK 1790 pred : DA M -> N Numeric N is the predecessor of numeric M. */ void pred_(pEnv env) diff --git a/src/primrec.c b/src/primrec.c index 288f79d9..604fcd31 100644 --- a/src/primrec.c +++ b/src/primrec.c @@ -1,13 +1,13 @@ /* module : primrec.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef PRIMREC_C #define PRIMREC_C /** -OK 2820 primrec : DDDA X [I] [C] -> R +Q2 OK 2820 primrec : DDDA X [I] [C] -> R Executes I to obtain an initial value R0. For integer X uses increasing positive integers to X, combines by C for new R. For aggregate X uses successive members and combines by C for new R. diff --git a/src/push.c b/src/push.c index 3ae16875..ea9c7ef1 100644 --- a/src/push.c +++ b/src/push.c @@ -1,13 +1,13 @@ /* module : push.c - version : 1.11 - date : 01/25/24 + version : 1.12 + date : 03/05/24 */ #ifndef PUSH_C #define PUSH_C /** -OK 3340 #push : D -> +Q0 OK 3340 #push : D -> Pop the location of an aggregate from the program stack. Pop an element from the data stack and add that element to the aggregate. */ @@ -19,7 +19,7 @@ void push_(pEnv env) PARM(1, ANYTYPE); env->stck = pvec_pop(env->stck, &elem); env->prog = pvec_pop(env->prog, &jump); - node = pvec_nth(env->prog, jump.u.num); /* read node */ + node = pvec_nth(env->prog, jump.u.num); /* read node */ switch (node.op) { case LIST_: node.u.lis = pvec_add(node.u.lis, elem); diff --git a/src/put.c b/src/put.c index beeb44bd..b3e1d032 100644 --- a/src/put.c +++ b/src/put.c @@ -1,13 +1,13 @@ /* module : put.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef PUT_C #define PUT_C /** -OK 3080 put : D X -> +Q0 OK 3080 put : D X -> [IMPURE] Writes X to output, pops X off stack. */ void put_(pEnv env) diff --git a/src/putch.c b/src/putch.c index e6a7bdf3..a89e4ab8 100644 --- a/src/putch.c +++ b/src/putch.c @@ -1,13 +1,13 @@ /* module : putch.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef PUTCH_C #define PUTCH_C /** -OK 3090 putch : D N -> +Q0 OK 3090 putch : D N -> [IMPURE] N : numeric, writes character whose ASCII is N. */ void putch_(pEnv env) diff --git a/src/putchars.c b/src/putchars.c index 2a36d80a..66024cba 100644 --- a/src/putchars.c +++ b/src/putchars.c @@ -1,13 +1,13 @@ /* module : putchars.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef PUTCHARS_C #define PUTCHARS_C /** -OK 3100 putchars : D "abc.." -> +Q0 OK 3100 putchars : D "abc.." -> [IMPURE] Writes abc.. (without quotes) */ void putchars_(pEnv env) diff --git a/src/quit.c b/src/quit.c index 618fdc6a..5ee2c03b 100644 --- a/src/quit.c +++ b/src/quit.c @@ -1,13 +1,13 @@ /* module : quit.c - version : 1.10 - date : 02/01/24 + version : 1.11 + date : 03/05/24 */ #ifndef QUIT_C #define QUIT_C /** -OK 3130 quit : N -> +Q0 OK 3130 quit : N -> Exit from Joy. */ static int exit_index; diff --git a/src/radix.c b/src/radix.c new file mode 100644 index 00000000..840962e0 --- /dev/null +++ b/src/radix.c @@ -0,0 +1,23 @@ +/* + module : radix.c + version : 1.2 + date : 03/05/24 +*/ +#ifndef RADIX_C +#define RADIX_C + +/** +Q0 OK 3190 radix : D I -> +[NUM] Sets the output radix. +*/ +void radix_(pEnv env) +{ +#ifdef USE_BIGNUM_ARITHMETIC + Node node; + + PARM(1, PREDSUCC); + env->stck = pvec_pop(env->stck, &node); + env->radix = node.u.num; +#endif +} +#endif diff --git a/src/rand.c b/src/rand.c index 31cc8d05..bdf77fda 100644 --- a/src/rand.c +++ b/src/rand.c @@ -1,13 +1,13 @@ /* module : rand.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef RAND_C #define RAND_C /** -OK 1150 rand : A -> I +Q0 OK 1150 rand : A -> I [IMPURE] I is a random integer. */ void rand_(pEnv env) diff --git a/src/rem.c b/src/rem.c index 38052cfd..03e0da5d 100644 --- a/src/rem.c +++ b/src/rem.c @@ -1,13 +1,13 @@ /* module : rem.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef REM_C #define REM_C /** -OK 1420 rem : DDA I J -> K +Q0 OK 1420 rem : DDA I J -> K Integer K is the remainder of dividing I by J. Also supports float. */ void rem_(pEnv env) diff --git a/src/rest.c b/src/rest.c index 1bbe278e..a1a55885 100644 --- a/src/rest.c +++ b/src/rest.c @@ -1,13 +1,13 @@ /* module : rest.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef REST_C #define REST_C /** -OK 2040 rest : DA A -> R +Q0 OK 2040 rest : DA A -> R R is the non-empty aggregate A with its first member removed. */ void rest_(pEnv env) diff --git a/src/rolldown.c b/src/rolldown.c index 1ed4467d..c3cebf2f 100644 --- a/src/rolldown.c +++ b/src/rolldown.c @@ -1,13 +1,13 @@ /* module : rolldown.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ROLLDOWN_C #define ROLLDOWN_C /** -OK 1240 rolldown : DDDAAA X Y Z -> Y Z X +Q0 OK 1240 rolldown : DDDAAA X Y Z -> Y Z X Moves Y and Z down, moves X up. */ void rolldown_(pEnv env) diff --git a/src/rolldownd.c b/src/rolldownd.c index 914afe78..732c617b 100644 --- a/src/rolldownd.c +++ b/src/rolldownd.c @@ -1,13 +1,13 @@ /* module : rolldownd.c - version : 1.6 + version : 1.7 date : */ #ifndef ROLLDOWND_C #define ROLLDOWND_C /** -OK 1300 rolldownd : DDDDAAAA X Y Z W -> Y Z X W +Q0 OK 1300 rolldownd : DDDDAAAA X Y Z W -> Y Z X W As if defined by: rolldownd == [rolldown] dip */ void rolldownd_(pEnv env) diff --git a/src/rollup.c b/src/rollup.c index b94b6957..824d12c3 100644 --- a/src/rollup.c +++ b/src/rollup.c @@ -1,13 +1,13 @@ /* module : rollup.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ROLLUP_C #define ROLLUP_C /** -OK 1230 rollup : DDDAAA X Y Z -> Z X Y +Q0 OK 1230 rollup : DDDAAA X Y Z -> Z X Y Moves X and Y up, moves Z down. */ void rollup_(pEnv env) diff --git a/src/rollupd.c b/src/rollupd.c index 209d2854..616ddbe9 100644 --- a/src/rollupd.c +++ b/src/rollupd.c @@ -1,13 +1,13 @@ /* module : rollupd.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ROLLUPD_C #define ROLLUPD_C /** -OK 1290 rollupd : DDDDAAAA X Y Z W -> Z X Y W +Q0 OK 1290 rollupd : DDDDAAAA X Y Z W -> Z X Y W As if defined by: rollupd == [rollup] dip */ void rollupd_(pEnv env) diff --git a/src/rotate.c b/src/rotate.c index 2c31cacd..9c6e18ac 100644 --- a/src/rotate.c +++ b/src/rotate.c @@ -1,13 +1,13 @@ /* module : rotate.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef ROTATE_C #define ROTATE_C /** -OK 1250 rotate : DDDAAA X Y Z -> Z Y X +Q0 OK 1250 rotate : DDDAAA X Y Z -> Z Y X Interchanges X and Z. */ void rotate_(pEnv env) diff --git a/src/rotated.c b/src/rotated.c index e2febabe..c2251ef3 100644 --- a/src/rotated.c +++ b/src/rotated.c @@ -1,13 +1,13 @@ /* module : rotated.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef ROTATED_C #define ROTATED_C /** -OK 1310 rotated : DDDDAAAA X Y Z W -> Z Y X W +Q0 OK 1310 rotated : DDDDAAAA X Y Z W -> Z Y X W As if defined by: rotated == [rotate] dip */ void rotated_(pEnv env) diff --git a/src/round.c b/src/round.c index 7cf47e6e..d38f64e5 100644 --- a/src/round.c +++ b/src/round.c @@ -1,13 +1,13 @@ /* module : round.c - version : 1.9 - date : 02/01/24 + version : 1.10 + date : 03/05/24 */ #ifndef ROUND_C #define ROUND_C /** -OK 3200 round : DA F -> G +Q0 OK 3200 round : DA 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 0ccc4dcf..acc5cf47 100644 --- a/src/sametype.c +++ b/src/sametype.c @@ -1,13 +1,13 @@ /* module : sametype.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef SAMETYPE_C #define SAMETYPE_C /** -OK 3210 sametype : DDA X Y -> B +Q0 OK 3210 sametype : DDA X Y -> B [EXT] Tests whether X and Y have the same type. */ void sametype_(pEnv env) diff --git a/src/scale.c b/src/scale.c index 60fdc618..58c4f7ac 100644 --- a/src/scale.c +++ b/src/scale.c @@ -1,13 +1,13 @@ /* module : scale.c - version : 1.4 - date : 02/05/24 + version : 1.5 + date : 03/05/24 */ #ifndef SCALE_C #define SCALE_C /** -OK 3220 scale : D I -> +Q0 OK 3220 scale : D I -> [NUM] Sets the number of digits to be used after the decimal point. */ void scale_(pEnv env) diff --git a/src/set.c b/src/set.c index 085cd4d5..5de4c6f4 100644 --- a/src/set.c +++ b/src/set.c @@ -1,13 +1,13 @@ /* module : set.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SET_C #define SET_C /** -OK 2340 set : DA X -> B +Q0 OK 2340 set : DA X -> B Tests whether X is a set. */ void set_(pEnv env) diff --git a/src/setautoput.c b/src/setautoput.c index f3a7b128..c7aba6e0 100644 --- a/src/setautoput.c +++ b/src/setautoput.c @@ -1,13 +1,13 @@ /* module : setautoput.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef SETAUTOPUT_C #define SETAUTOPUT_C /** -OK 2980 setautoput : D I -> +Q0 OK 2980 setautoput : D I -> [IMPURE] Sets value of flag for automatic put to I (if I = 0, none; if I = 1, put; if I = 2, stack). */ diff --git a/src/setecho.c b/src/setecho.c index 3f55af26..a590b98c 100644 --- a/src/setecho.c +++ b/src/setecho.c @@ -1,13 +1,13 @@ /* module : setecho.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef SETECHO_C #define SETECHO_C /** -OK 3000 setecho : D I -> +Q0 OK 3000 setecho : D I -> [IMPURE] Sets value of echo flag for listing. I = 0: no echo, 1: echo, 2: with tab, 3: and linenumber. */ diff --git a/src/setsize.c b/src/setsize.c index 4814cdd2..a7ce7a6f 100644 --- a/src/setsize.c +++ b/src/setsize.c @@ -1,13 +1,13 @@ /* module : setsize.c - version : 1.7 - date : 01/26/24 + version : 1.8 + date : 03/05/24 */ #ifndef SETSIZE_C #define SETSIZE_C /** -IMMEDIATE 1030 setsize : A -> setsize +Q0 IMMEDIATE 1030 setsize : A -> 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 463b27c5..55a7758f 100644 --- a/src/setundeferror.c +++ b/src/setundeferror.c @@ -1,13 +1,13 @@ /* module : setundeferror.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef SETUNDEFERROR_C #define SETUNDEFERROR_C /** -OK 2990 setundeferror : D I -> +Q0 OK 2990 setundeferror : D I -> [IMPURE] Sets flag that controls behavior of undefined functions (0 = no error, 1 = error). */ diff --git a/src/sign.c b/src/sign.c index 081076d6..c2f5e690 100644 --- a/src/sign.c +++ b/src/sign.c @@ -1,13 +1,13 @@ /* module : sign.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SIGN_C #define SIGN_C /** -OK 1440 sign : DA N1 -> N2 +Q0 OK 1440 sign : DA N1 -> N2 Integer N2 is the sign (-1 or 0 or +1) of integer N1, or float N2 is the sign (-1.0 or 0.0 or 1.0) of float N1. */ diff --git a/src/sin.c b/src/sin.c index 69b25d65..2c8baf8e 100644 --- a/src/sin.c +++ b/src/sin.c @@ -1,13 +1,13 @@ /* module : sin.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SIN_C #define SIN_C /** -OK 1640 sin : DA F -> G +Q0 OK 1640 sin : DA F -> G G is the sine of F. */ void sin_(pEnv env) diff --git a/src/sinh.c b/src/sinh.c index 2eec85fa..ae322627 100644 --- a/src/sinh.c +++ b/src/sinh.c @@ -1,13 +1,13 @@ /* module : sinh.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SINH_C #define SINH_C /** -OK 1650 sinh : DA F -> G +Q0 OK 1650 sinh : DA F -> G G is the hyperbolic sine of F. */ void sinh_(pEnv env) diff --git a/src/size.c b/src/size.c index 082ee212..04dccf4f 100644 --- a/src/size.c +++ b/src/size.c @@ -1,13 +1,13 @@ /* module : size.c - version : 1.9 - date : 01/25/24 + version : 1.11 + date : 03/05/24 */ #ifndef SIZE_C #define SIZE_C /** -OK 2080 size : DA A -> I +Q0 OK 2080 size : DA A -> I Integer I is the number of elements of aggregate A. */ void size_(pEnv env) @@ -15,7 +15,7 @@ void size_(pEnv env) int64_t i, j; Node node, temp; - PARM(1, SIZE); + PARM(1, SIZE_); env->stck = pvec_pop(env->stck, &node); switch (node.op) { case LIST_: diff --git a/src/small.c b/src/small.c index 1c35cd68..f3ded891 100644 --- a/src/small.c +++ b/src/small.c @@ -1,13 +1,13 @@ /* module : small.c - version : 1.10 - date : 02/01/24 + version : 1.11 + date : 03/05/24 */ #ifndef SMALL_C #define SMALL_C /** -OK 2210 small : DA X -> B +Q0 OK 2210 small : DA X -> B Tests whether aggregate X has 0 or 1 members, or numeric 0 or 1. */ void small_(pEnv env) diff --git a/src/some.c b/src/some.c index f0643e83..d1192671 100644 --- a/src/some.c +++ b/src/some.c @@ -1,13 +1,13 @@ /* module : some.c - version : 1.11 - date : 01/25/24 + version : 1.12 + date : 03/05/24 */ #ifndef SOME_C #define SOME_C /** -OK 2850 some : DDA A [B] -> X +Q1 OK 2850 some : DDA A [B] -> X Applies test B to members of aggregate A, X = true if some pass. */ void some_(pEnv env) diff --git a/src/split.c b/src/split.c index b50d9965..c2bc11e1 100644 --- a/src/split.c +++ b/src/split.c @@ -1,13 +1,13 @@ /* module : split.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef SPLIT_C #define SPLIT_C /** -OK 2840 split : DDAA A [B] -> A1 A2 +Q1 OK 2840 split : DDAA A [B] -> A1 A2 Uses test B to split aggregate A into sametype aggregates A1 and A2. */ void split_(pEnv env) diff --git a/src/spush.c b/src/spush.c index 6ed6883a..16c81d7b 100644 --- a/src/spush.c +++ b/src/spush.c @@ -1,13 +1,13 @@ /* module : spush.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef SPUSH_C #define SPUSH_C /** -OK 3360 #spush : A -> +Q0 OK 3360 #spush : A -> Pop the location of an element on the code stack. Read that element and push it on the data stack. */ diff --git a/src/sqrt.c b/src/sqrt.c index e172dddb..6fe527ca 100644 --- a/src/sqrt.c +++ b/src/sqrt.c @@ -1,13 +1,13 @@ /* module : sqrt.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SQRT_C #define SQRT_C /** -OK 1660 sqrt : DA F -> G +Q0 OK 1660 sqrt : DA F -> G G is the square root of F. */ void sqrt_(pEnv env) diff --git a/src/srand.c b/src/srand.c index bd98bf8d..41e40aac 100644 --- a/src/srand.c +++ b/src/srand.c @@ -1,13 +1,13 @@ /* module : srand.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef SRAND_C #define SRAND_C /** -OK 1780 srand : D I -> +Q0 OK 1780 srand : D I -> [IMPURE] Sets the random integer seed to integer I. */ void srand_(pEnv env) diff --git a/src/stack.c b/src/stack.c index c0312511..e5f96531 100644 --- a/src/stack.c +++ b/src/stack.c @@ -1,13 +1,13 @@ /* module : stack.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef STACK_C #define STACK_C /** -OK 1040 stack : A .. X Y Z -> .. X Y Z [Z Y X ..] +Q0 OK 1040 stack : A .. X Y Z -> .. X Y Z [Z Y X ..] Pushes the stack as a list. */ PRIVATE void stack_(pEnv env) diff --git a/src/stderr.c b/src/stderr.c index 45b28d07..55cbb6fa 100644 --- a/src/stderr.c +++ b/src/stderr.c @@ -1,13 +1,13 @@ /* module : stderr.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef STDERR_C #define STDERR_C /** -IMMEDIATE 1190 stderr : A -> S +Q0 IMMEDIATE 1190 stderr : A -> S [FOREIGN] Pushes the standard error stream. */ void stderr_(pEnv env) diff --git a/src/stdin.c b/src/stdin.c index d436bce2..15b4c5fc 100644 --- a/src/stdin.c +++ b/src/stdin.c @@ -1,13 +1,13 @@ /* module : stdin.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef STDIN_C #define STDIN_C /** -IMMEDIATE 1170 stdin : A -> S +Q0 IMMEDIATE 1170 stdin : A -> S [FOREIGN] Pushes the standard input stream. */ void stdin_(pEnv env) diff --git a/src/stdout.c b/src/stdout.c index 56462f7c..5ed921bb 100644 --- a/src/stdout.c +++ b/src/stdout.c @@ -1,13 +1,13 @@ /* module : stdout.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef STDOUT_C #define STDOUT_C /** -IMMEDIATE 1180 stdout : A -> S +Q0 IMMEDIATE 1180 stdout : A -> S [FOREIGN] Pushes the standard output stream. */ void stdout_(pEnv env) diff --git a/src/step.c b/src/step.c index 7145bf01..382dcd2b 100644 --- a/src/step.c +++ b/src/step.c @@ -1,13 +1,13 @@ /* module : step.c - version : 1.11 - date : 01/25/24 + version : 1.12 + date : 03/05/24 */ #ifndef STEP_C #define STEP_C /** -OK 2770 step : DDQ A [P] -> ... +Q1 OK 2770 step : DDQ A [P] -> ... Sequentially putting members of aggregate A onto stack, executes P for each member of A. */ diff --git a/src/strftime.c b/src/strftime.c index 5e50cb11..f080e16d 100644 --- a/src/strftime.c +++ b/src/strftime.c @@ -1,7 +1,7 @@ /* module : strftime.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef STRFTIME_C #define STRFTIME_C @@ -9,7 +9,7 @@ #include "decode.h" /** -OK 1730 strftime : DDA T S1 -> S2 +Q0 OK 1730 strftime : DDA T S1 -> S2 Formats a list T in the format of localtime or gmtime using string S1 and pushes the result S2. */ diff --git a/src/string.c b/src/string.c index ae175a24..d811f892 100644 --- a/src/string.c +++ b/src/string.c @@ -1,13 +1,13 @@ /* module : string.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef STRING_C #define STRING_C /** -OK 2350 string : DA X -> B +Q0 OK 2350 string : DA X -> B Tests whether X is a string. */ void string_(pEnv env) diff --git a/src/strtod.c b/src/strtod.c index 261d1b62..04f1417e 100644 --- a/src/strtod.c +++ b/src/strtod.c @@ -1,13 +1,13 @@ /* module : strtod.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef STRTOD_C #define STRTOD_C /** -OK 1750 strtod : DA S -> R +Q0 OK 1750 strtod : DA S -> R String S is converted to the float R. */ void strtod_(pEnv env) diff --git a/src/strtol.c b/src/strtol.c index 76f32cf0..d1ae211c 100644 --- a/src/strtol.c +++ b/src/strtol.c @@ -1,13 +1,13 @@ /* module : strtol.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef STRTOL_C #define STRTOL_C /** -OK 1740 strtol : DDA S I -> J +Q0 OK 1740 strtol : DDA S I -> J String S is converted to the integer J using base I. If I = 0, assumes base 10, but leading "0" means base 8 and leading "0x" means base 16. diff --git a/src/strue.c b/src/strue.c index 8261bb24..e7b4b087 100644 --- a/src/strue.c +++ b/src/strue.c @@ -1,13 +1,13 @@ /* module : strue.c - version : 1.9 - date : 01/24/24 + version : 1.10 + date : 03/05/24 */ #ifndef STRUE_C #define STRUE_C /** -OK 3400 #strue : N -> +Q0 OK 3400 #strue : N -> Pop the jump location from the program stack. If the top of the data stack is true, jump to that location. */ diff --git a/src/succ.c b/src/succ.c index 30f07285..da668b44 100644 --- a/src/succ.c +++ b/src/succ.c @@ -1,13 +1,13 @@ /* module : succ.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SUCC_C #define SUCC_C /** -OK 1800 succ : DA M -> N +Q0 OK 1800 succ : DA M -> N Numeric N is the successor of numeric M. */ void succ_(pEnv env) diff --git a/src/swap.c b/src/swap.c index 7cafa1f1..d93a989b 100644 --- a/src/swap.c +++ b/src/swap.c @@ -1,13 +1,13 @@ /* module : swap.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SWAP_C #define SWAP_C /** -OK 1220 swap : DDAA X Y -> Y X +Q0 OK 1220 swap : DDAA X Y -> Y X Interchanges X and Y on top of the stack. */ void swap_(pEnv env) diff --git a/src/swapd.c b/src/swapd.c index 2ec2dc28..109f0ba6 100644 --- a/src/swapd.c +++ b/src/swapd.c @@ -1,13 +1,13 @@ /* module : swapd.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef SWAPD_C #define SWAPD_C /** -OK 1280 swapd : DDDAAA X Y Z -> Y X Z +Q0 OK 1280 swapd : DDDAAA X Y Z -> Y X Z As if defined by: swapd == [swap] dip */ void swapd_(pEnv env) diff --git a/src/swons.c b/src/swons.c index 154c6f2b..f77b037a 100644 --- a/src/swons.c +++ b/src/swons.c @@ -1,13 +1,13 @@ /* module : swons.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef SWONS_C #define SWONS_C /** -OK 2020 swons : DDA A X -> B +Q0 OK 2020 swons : DDA A X -> B Aggregate B is A with a new member X (first member for sequences). */ void swons_(pEnv env) diff --git a/src/system.c b/src/system.c index 02d1c84c..e509cfa4 100644 --- a/src/system.c +++ b/src/system.c @@ -1,13 +1,13 @@ /* module : system.c - version : 1.8 - date : 02/01/24 + version : 1.9 + date : 03/05/24 */ #ifndef SYSTEM_C #define SYSTEM_C /** -OK 3020 system : D "command" -> +Q0 OK 3020 system : D "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. diff --git a/src/tailrec.c b/src/tailrec.c index 3a79a12e..7d6d427e 100644 --- a/src/tailrec.c +++ b/src/tailrec.c @@ -1,13 +1,13 @@ /* module : tailrec.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef TAILREC_C #define TAILREC_C /** -OK 2720 tailrec : DDDDA [P] [T] [R1] -> ... +Q3 OK 2720 tailrec : DDDDA [P] [T] [R1] -> ... Executes P. If that yields true, executes T. Else executes R1, recurses. */ diff --git a/src/take.c b/src/take.c index 77eb723f..99b82a5b 100644 --- a/src/take.c +++ b/src/take.c @@ -1,13 +1,13 @@ /* module : take.c - version : 1.8 - date : 01/25/24 + version : 1.9 + date : 03/05/24 */ #ifndef TAKE_C #define TAKE_C /** -OK 2140 take : DDA A N -> B +Q0 OK 2140 take : DDA A N -> B Aggregate B is the result of retaining just the first N elements of A. */ void take_(pEnv env) diff --git a/src/tan.c b/src/tan.c index 84bf33e7..3874be12 100644 --- a/src/tan.c +++ b/src/tan.c @@ -1,13 +1,13 @@ /* module : tan.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef TAN_C #define TAN_C /** -OK 1670 tan : DA F -> G +Q0 OK 1670 tan : DA F -> G G is the tangent of F. */ void tan_(pEnv env) diff --git a/src/tanh.c b/src/tanh.c index 37455b77..71b53ae5 100644 --- a/src/tanh.c +++ b/src/tanh.c @@ -1,13 +1,13 @@ /* module : tanh.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef TANH_C #define TANH_C /** -OK 1680 tanh : DA F -> G +Q0 OK 1680 tanh : DA F -> G G is the hyperbolic tangent of F. */ void tanh_(pEnv env) diff --git a/src/ternary.c b/src/ternary.c index 3c203cc8..0c915554 100644 --- a/src/ternary.c +++ b/src/ternary.c @@ -1,13 +1,13 @@ /* module : ternary.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef TERNARY_C #define TERNARY_C /** -OK 2570 ternary : DDDDA X Y Z [P] -> R +Q1 OK 2570 ternary : DDDDA X Y Z [P] -> R Executes P, which leaves R on top of the stack. No matter how many parameters this consumes, exactly three are removed from the stack. diff --git a/src/time.c b/src/time.c index 14e08783..43dee0ad 100644 --- a/src/time.c +++ b/src/time.c @@ -1,13 +1,13 @@ /* module : time.c - version : 1.7 - date : 02/01/24 + version : 1.8 + date : 03/05/24 */ #ifndef TIME_C #define TIME_C /** -OK 1140 time : A -> I +Q0 OK 1140 time : A -> I [IMPURE] Pushes the current time (in seconds since the Epoch). */ void time_(pEnv env) diff --git a/src/times.c b/src/times.c index ddec5a0d..95b1f459 100644 --- a/src/times.c +++ b/src/times.c @@ -1,13 +1,13 @@ /* module : times.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef TIMES_C #define TIMES_C /** -OK 2800 times : DDA N [P] -> ... +Q1 OK 2800 times : DDA N [P] -> ... N times executes P. */ void times_(pEnv env) diff --git a/src/tpush.c b/src/tpush.c index eda533e3..28140b12 100644 --- a/src/tpush.c +++ b/src/tpush.c @@ -1,13 +1,13 @@ /* module : tpush.c - version : 1.11 - date : 01/25/24 + version : 1.12 + date : 03/05/24 */ #ifndef TPUSH_C #define TPUSH_C /** -OK 3410 #tpush : D -> +Q0 OK 3410 #tpush : D -> Pop the location of two aggregates and an element from the program stack. The element is added to one of the two aggregates, depending on the value on top of the data stack. @@ -24,7 +24,7 @@ void tpush_(pEnv env) if (test.u.num) node = pvec_nth(env->prog, jump.u.num + 1); else - node = pvec_nth(env->prog, jump.u.num); /* one step further away */ + node = pvec_nth(env->prog, jump.u.num); /* one step further away */ switch (node.op) { case LIST_: node.u.lis = pvec_add(node.u.lis, elem); diff --git a/src/treegenrec.c b/src/treegenrec.c index dc77a23e..876c2d36 100644 --- a/src/treegenrec.c +++ b/src/treegenrec.c @@ -1,13 +1,13 @@ /* module : treegenrec.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef TREEGENREC_C #define TREEGENREC_C /** -OK 2890 treegenrec : DDDDA T [O1] [O2] [C] -> ... +Q3 OK 2890 treegenrec : DDDDA 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. */ diff --git a/src/treegenrecaux.c b/src/treegenrecaux.c index 5aa8168c..f918d8eb 100644 --- a/src/treegenrecaux.c +++ b/src/treegenrecaux.c @@ -1,13 +1,13 @@ /* module : treegenrecaux.c - version : 1.12 - date : 02/01/24 + version : 1.13 + date : 03/05/24 */ #ifndef TREEGENRECAUX_C #define TREEGENRECAUX_C /** -OK 3300 #treegenrec : DDDDDA T [[O1] [O2] C] -> ... +Q1 OK 3300 #treegenrec : DDDDDA 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. */ diff --git a/src/treerec.c b/src/treerec.c index 5e46df2f..820301b7 100644 --- a/src/treerec.c +++ b/src/treerec.c @@ -1,13 +1,13 @@ /* module : treerec.c - version : 1.8 - date : 01/24/24 + version : 1.9 + date : 03/05/24 */ #ifndef TREEREC_C #define TREEREC_C /** -OK 2880 treerec : DDDA T [O] [C] -> ... +Q2 OK 2880 treerec : DDDA T [O] [C] -> ... T is a tree. If T is a leaf, executes O. Else executes [[[O] C] treerec] C. */ void treerec_(pEnv env) diff --git a/src/treerecaux.c b/src/treerecaux.c index 1734d066..e47d065b 100644 --- a/src/treerecaux.c +++ b/src/treerecaux.c @@ -1,13 +1,13 @@ /* module : treerecaux.c - version : 1.12 - date : 02/01/24 + version : 1.13 + date : 03/05/24 */ #ifndef TREERECAUX_C #define TREERECAUX_C /** -OK 3310 #treerec : DDDDA T [[O] C] -> ... +Q1 OK 3310 #treerec : DDDDA T [[O] C] -> ... T is a tree. If T is a leaf, executes O. Else executes [[[O] C] treerec] C. */ void treerecaux_(pEnv env) diff --git a/src/treestep.c b/src/treestep.c index 7ae88340..6e65549b 100644 --- a/src/treestep.c +++ b/src/treestep.c @@ -1,13 +1,13 @@ /* module : treestep.c - version : 1.8 - date : 11/06/23 + version : 1.9 + date : 03/05/24 */ #ifndef TREESTEP_C #define TREESTEP_C /** -OK 2870 treestep : DDA T [P] -> ... +Q1 OK 2870 treestep : DDA T [P] -> ... Recursively traverses leaves of tree T, executes P for each leaf. */ void treestep_(pEnv env) diff --git a/src/true.c b/src/true.c index e30de23f..c106ad5a 100644 --- a/src/true.c +++ b/src/true.c @@ -1,13 +1,13 @@ /* module : true.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef TRUE_C #define TRUE_C /** -IMMEDIATE 1010 true : A -> true +Q0 IMMEDIATE 1010 true : A -> true Pushes the value true. */ void true_(pEnv env) diff --git a/src/trunc.c b/src/trunc.c index 464a2382..e30700e1 100644 --- a/src/trunc.c +++ b/src/trunc.c @@ -1,13 +1,13 @@ /* module : trunc.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef TRUNC_C #define TRUNC_C /** -OK 1690 trunc : DA F -> I +Q0 OK 1690 trunc : DA F -> I I is an integer equal to the float F truncated toward zero. */ void trunc_(pEnv env) diff --git a/src/typeof.c b/src/typeof.c index 10919478..57c1d90e 100644 --- a/src/typeof.c +++ b/src/typeof.c @@ -1,13 +1,13 @@ /* module : typeof.c - version : 1.13 - date : 02/05/24 + version : 1.14 + date : 03/05/24 */ #ifndef TYPEOF_C #define TYPEOF_C /** -OK 3230 typeof : DA X -> I +Q0 OK 3230 typeof : DA X -> I [EXT] Replace X by its type. */ void typeof_(pEnv env) diff --git a/src/unary.c b/src/unary.c index eacb3599..1255a00d 100644 --- a/src/unary.c +++ b/src/unary.c @@ -1,13 +1,13 @@ /* module : unary.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef UNARY_C #define UNARY_C /** -OK 2490 unary : DDA X [P] -> R +Q1 OK 2490 unary : DDA X [P] -> R Executes P, which leaves R on top of the stack. No matter how many parameters this consumes, exactly one is removed from the stack. diff --git a/src/unary2.c b/src/unary2.c index 41ff2cff..5c7bcbed 100644 --- a/src/unary2.c +++ b/src/unary2.c @@ -1,18 +1,18 @@ /* module : unary2.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef UNARY2_C #define UNARY2_C /** -OK 2500 unary2 : DDDAA X1 X2 [P] -> R1 R2 +Q1 OK 2500 unary2 : DDDAA X1 X2 [P] -> R1 R2 Executes P twice, with X1 and X2 on top of the stack. Returns the two values R1 and R2. */ void unary2_(pEnv env) -{ /* Y Z [P] unary2 ==> Y' Z' */ +{ /* Y Z [P] unary2 ==> Y' Z' */ unsigned size; Node list, node; @@ -20,7 +20,7 @@ void unary2_(pEnv env) env->stck = pvec_pop(env->stck, &list); env->stck = pvec_pop(env->stck, &node); /* Z */ code(env, swap_); - size = pvec_cnt(env->prog); /* location of first Z, then Y' */ + size = pvec_cnt(env->prog); /* location of first Z, then Y' */ prime(env, node); /* first Z, then Y' */ /* save the stack before the condition and restore it afterwards with diff --git a/src/unary3.c b/src/unary3.c index c4c3b95c..54dbd3c4 100644 --- a/src/unary3.c +++ b/src/unary3.c @@ -1,17 +1,17 @@ /* module : unary3.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef UNARY3_C #define UNARY3_C /** -OK 2510 unary3 : DDDDAAA X1 X2 X3 [P] -> R1 R2 R3 +Q1 OK 2510 unary3 : DDDDAAA X1 X2 X3 [P] -> R1 R2 R3 Executes P three times, with Xi, returns Ri (i = 1..3). */ PRIVATE void unary3_(pEnv env) -{ /* X Y Z [P] unary3 ==> X' Y' Z' */ +{ /* X Y Z [P] unary3 ==> X' Y' Z' */ unsigned size1, size2; Node param1, param2, list; diff --git a/src/unary4.c b/src/unary4.c index 55ac77de..cb8eef10 100644 --- a/src/unary4.c +++ b/src/unary4.c @@ -1,17 +1,17 @@ /* module : unary4.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef UNARY4_C #define UNARY4_C /** -OK 2520 unary4 : DDDDDAAAA X1 X2 X3 X4 [P] -> R1 R2 R3 R4 +Q1 OK 2520 unary4 : DDDDDAAAA X1 X2 X3 X4 [P] -> R1 R2 R3 R4 Executes P four times, with Xi, returns Ri (i = 1..4). */ PRIVATE void unary4_(pEnv env) -{ /* X Y Z W [P] unary4 ==> X' Y' Z' W' */ +{ /* X Y Z W [P] unary4 ==> X' Y' Z' W' */ unsigned size1, size2, size3; Node param1, param2, param3, list; diff --git a/src/uncons.c b/src/uncons.c index 07be13d6..2c211997 100644 --- a/src/uncons.c +++ b/src/uncons.c @@ -1,13 +1,13 @@ /* module : uncons.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef UNCONS_C #define UNCONS_C /** -OK 2110 uncons : DAA A -> F R +Q0 OK 2110 uncons : DAA A -> F R F and R are the first and the rest of non-empty aggregate A. */ void uncons_(pEnv env) diff --git a/src/undeferror.c b/src/undeferror.c index 50507637..cb0eccfd 100644 --- a/src/undeferror.c +++ b/src/undeferror.c @@ -1,13 +1,13 @@ /* module : undeferror.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef UNDEFERROR_C #define UNDEFERROR_C /** -OK 1100 undeferror : A -> I +Q0 OK 1100 undeferror : A -> I Pushes current value of undefined-is-error flag. */ void undeferror_(pEnv env) diff --git a/src/undefs.c b/src/undefs.c index a4fdf4d0..7b33023e 100644 --- a/src/undefs.c +++ b/src/undefs.c @@ -1,13 +1,13 @@ /* module : undefs.c - version : 1.6 - date : 10/02/23 + version : 1.7 + date : 03/05/24 */ #ifndef UNDEFS_C #define UNDEFS_C /** -OK 1110 undefs : A -> [..] +Q0 OK 1110 undefs : A -> [..] Push a list of all undefined symbols in the current symbol table. */ void undefs_(pEnv env) diff --git a/src/unstack.c b/src/unstack.c index 7366d4c2..385397f0 100644 --- a/src/unstack.c +++ b/src/unstack.c @@ -1,13 +1,13 @@ /* module : unstack.c - version : 1.7 - date : 11/06/23 + version : 1.8 + date : 03/05/24 */ #ifndef UNSTACK_C #define UNSTACK_C /** -OK 2000 unstack : DP [X Y ..] -> ..Y X +Q0 OK 2000 unstack : DP [X Y ..] -> ..Y X The list [X Y ..] becomes the new stack. */ void unstack_(pEnv env) diff --git a/src/unswons.c b/src/unswons.c index daa10f89..0fc66fa1 100644 --- a/src/unswons.c +++ b/src/unswons.c @@ -1,13 +1,13 @@ /* module : unswons.c - version : 1.9 - date : 01/25/24 + version : 1.10 + date : 03/05/24 */ #ifndef UNSWONS_C #define UNSWONS_C /** -OK 2120 unswons : DAA A -> R F +Q0 OK 2120 unswons : DAA A -> R F R and F are the rest and the first of non-empty aggregate A. */ void unswons_(pEnv env) diff --git a/src/user.c b/src/user.c index 30954aa1..e68745ef 100644 --- a/src/user.c +++ b/src/user.c @@ -1,13 +1,13 @@ /* module : user.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef USER_C #define USER_C /** -OK 2380 user : DA X -> B +Q0 OK 2380 user : DA X -> B Tests whether X is a user-defined symbol. */ void user_(pEnv env) diff --git a/src/while.c b/src/while.c index 24ebb59b..e800f752 100644 --- a/src/while.c +++ b/src/while.c @@ -1,13 +1,13 @@ /* module : while.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef WHILE_C #define WHILE_C /** -OK 2700 while : DDP [B] [D] -> ... +Q2 OK 2700 while : DDP [B] [D] -> ... While executing B yields true executes D. */ void while_(pEnv env) diff --git a/src/x.c b/src/x.c index 1a8dd2b6..9773fbe6 100644 --- a/src/x.c +++ b/src/x.c @@ -1,13 +1,13 @@ /* module : x.c - version : 1.7 - date : 10/02/23 + version : 1.8 + date : 03/05/24 */ #ifndef X_C #define X_C /** -OK 2420 x : P [P] x -> ... +Q1 OK 2420 x : P [P] x -> ... Executes P without popping [P]. So, [P] x == [P] P. */ void x_(pEnv env) diff --git a/src/xor.c b/src/xor.c index 77e475a1..549855fc 100644 --- a/src/xor.c +++ b/src/xor.c @@ -1,13 +1,13 @@ /* module : xor.c - version : 1.7 - date : 01/25/24 + version : 1.8 + date : 03/05/24 */ #ifndef XOR_C #define XOR_C /** -OK 1350 xor : DDA X Y -> Z +Q0 OK 1350 xor : DDA X Y -> Z Z is the symmetric difference of sets X and Y, logical exclusive disjunction for truth values. */ diff --git a/tabl.c b/tabl.c new file mode 100644 index 00000000..72a6636e --- /dev/null +++ b/tabl.c @@ -0,0 +1,243 @@ +/* 1000 */ { Q0, IMMEDIATE, "false", false_, "A", "-> false", "Pushes the value false.\n" }, +/* 1010 */ { Q0, IMMEDIATE, "true", true_, "A", "-> true", "Pushes the value true.\n" }, +/* 1020 */ { Q0, IMMEDIATE, "maxint", maxint_, "A", "-> maxint", "Pushes largest integer (platform dependent). Typically it is 32 bits.\n" }, +/* 1030 */ { Q0, IMMEDIATE, "setsize", setsize_, "A", "-> setsize", "Pushes the maximum number of elements in a set (platform dependent).\nTypically it is 32, and set members are in the range 0..31.\n" }, +/* 1040 */ { Q0, OK, "stack", stack_, "A", ".. X Y Z -> .. X Y Z [Z Y X ..]", "Pushes the stack as a list.\n" }, +/* 1050 */ { Q0, OK, "__symtabmax", __symtabmax_, "A", "-> I", "Pushes value of maximum size of the symbol table.\n" }, +/* 1060 */ { Q0, OK, "__symtabindex", __symtabindex_, "A", "-> I", "Pushes current size of the symbol table.\n" }, +/* 1070 */ { Q0, OK, "__dump", __dump_, "A", "-> [..]", "debugging only: pushes the dump as a list.\n" }, +/* 1080 */ { Q0, OK, "conts", conts_, "A", "-> [[P] [Q] ..]", "Pushes current continuations. Buggy, do not use.\n" }, +/* 1090 */ { Q0, OK, "autoput", autoput_, "A", "-> I", "Pushes current value of flag for automatic output, I = 0..2.\n" }, +/* 1100 */ { Q0, OK, "undeferror", undeferror_, "A", "-> I", "Pushes current value of undefined-is-error flag.\n" }, +/* 1110 */ { Q0, OK, "undefs", undefs_, "A", "-> [..]", "Push a list of all undefined symbols in the current symbol table.\n" }, +/* 1120 */ { Q0, OK, "echo", echo_, "A", "-> I", "Pushes value of echo flag, I = 0..3.\n" }, +/* 1130 */ { Q0, OK, "clock", clock_, "A", "-> I", "[IMPURE] Pushes the integer value of current CPU usage in milliseconds.\n" }, +/* 1140 */ { Q0, OK, "time", time_, "A", "-> I", "[IMPURE] Pushes the current time (in seconds since the Epoch).\n" }, +/* 1150 */ { Q0, OK, "rand", rand_, "A", "-> I", "[IMPURE] I is a random integer.\n" }, +/* 1160 */ { Q0, OK, "__memorymax", __memorymax_, "A", "-> I", "Pushes value of total size of memory.\n" }, +/* 1170 */ { Q0, IMMEDIATE, "stdin", stdin_, "A", "-> S", "[FOREIGN] Pushes the standard input stream.\n" }, +/* 1180 */ { Q0, IMMEDIATE, "stdout", stdout_, "A", "-> S", "[FOREIGN] Pushes the standard output stream.\n" }, +/* 1190 */ { Q0, IMMEDIATE, "stderr", stderr_, "A", "-> S", "[FOREIGN] Pushes the standard error stream.\n" }, +/* 1200 */ { Q0, OK, "id", id_, "N", "->", "Identity function, does nothing.\nAny program of the form P id Q is equivalent to just P Q.\n" }, +/* 1210 */ { Q0, OK, "dup", dup_, "A", "X -> X X", "Pushes an extra copy of X onto stack.\n" }, +/* 1220 */ { Q0, OK, "swap", swap_, "DDAA", "X Y -> Y X", "Interchanges X and Y on top of the stack.\n" }, +/* 1230 */ { Q0, OK, "rollup", rollup_, "DDDAAA", "X Y Z -> Z X Y", "Moves X and Y up, moves Z down.\n" }, +/* 1240 */ { Q0, OK, "rolldown", rolldown_, "DDDAAA", "X Y Z -> Y Z X", "Moves Y and Z down, moves X up.\n" }, +/* 1250 */ { Q0, OK, "rotate", rotate_, "DDDAAA", "X Y Z -> Z Y X", "Interchanges X and Z.\n" }, +/* 1260 */ { Q0, OK, "popd", popd_, "DDA", "Y Z -> Z", "As if defined by: popd == [pop] dip\n" }, +/* 1270 */ { Q0, OK, "dupd", dupd_, "DDAAA", "Y Z -> Y Y Z", "As if defined by: dupd == [dup] dip\n" }, +/* 1280 */ { Q0, OK, "swapd", swapd_, "DDDAAA", "X Y Z -> Y X Z", "As if defined by: swapd == [swap] dip\n" }, +/* 1290 */ { Q0, OK, "rollupd", rollupd_, "DDDDAAAA", "X Y Z W -> Z X Y W", "As if defined by: rollupd == [rollup] dip\n" }, +/* 1300 */ { Q0, OK, "rolldownd", rolldownd_, "DDDDAAAA", "X Y Z W -> Y Z X W", "As if defined by: rolldownd == [rolldown] dip\n" }, +/* 1310 */ { Q0, OK, "rotated", rotated_, "DDDDAAAA", "X Y Z W -> Z Y X W", "As if defined by: rotated == [rotate] dip\n" }, +/* 1320 */ { Q0, OK, "pop", pop_, "D", "X ->", "Removes X from top of the stack.\n" }, +/* 1330 */ { Q0, OK, "choice", choice_, "DDDA", "B T F -> X", "If B is true, then X = T else X = F.\n" }, +/* 1340 */ { Q0, OK, "or", or_, "DDA", "X Y -> Z", "Z is the union of sets X and Y, logical disjunction for truth values.\n" }, +/* 1350 */ { Q0, OK, "xor", xor_, "DDA", "X Y -> Z", "Z is the symmetric difference of sets X and Y,\nlogical exclusive disjunction for truth values.\n" }, +/* 1360 */ { Q0, OK, "and", and_, "DDA", "X Y -> Z", "Z is the intersection of sets X and Y, logical conjunction for truth values.\n" }, +/* 1370 */ { Q0, OK, "not", not_, "DA", "X -> Y", "Y is the complement of set X, logical negation for truth values.\n" }, +/* 1380 */ { Q0, OK, "+\0plus", plus_, "DDA", "M I -> N", "Numeric N is the result of adding integer I to numeric M.\nAlso supports float.\n" }, +/* 1390 */ { Q0, OK, "-\0minus", minus_, "DDA", "M I -> N", "Numeric N is the result of subtracting integer I from numeric M.\nAlso supports float.\n" }, +/* 1400 */ { Q0, OK, "*\0ast", mul_, "DDA", "I J -> K", "Integer K is the product of integers I and J. Also supports float.\n" }, +/* 1410 */ { Q0, OK, "/\0divide", divide_, "DDA", "I J -> K", "Integer K is the (rounded) ratio of integers I and J. Also supports float.\n" }, +/* 1420 */ { Q0, OK, "rem", rem_, "DDA", "I J -> K", "Integer K is the remainder of dividing I by J. Also supports float.\n" }, +/* 1430 */ { Q0, OK, "div", div_, "DDAA", "I J -> K L", "Integers K and L are the quotient and remainder of dividing I by J.\n" }, +/* 1440 */ { Q0, OK, "sign", sign_, "DA", "N1 -> N2", "Integer N2 is the sign (-1 or 0 or +1) of integer N1,\nor float N2 is the sign (-1.0 or 0.0 or 1.0) of float N1.\n" }, +/* 1450 */ { Q0, OK, "neg", neg_, "DA", "I -> J", "Integer J is the negative of integer I. Also supports float.\n" }, +/* 1460 */ { Q0, OK, "ord", ord_, "DA", "C -> I", "Integer I is the Ascii value of character C (or logical or integer).\n" }, +/* 1470 */ { Q0, OK, "chr", chr_, "DA", "I -> C", "C is the character whose Ascii value is integer I (or logical or character).\n" }, +/* 1480 */ { Q0, OK, "abs", abs_, "DA", "N1 -> N2", "Integer N2 is the absolute value (0,1,2..) of integer N1,\nor float N2 is the absolute value (0.0 ..) of float N1.\n" }, +/* 1490 */ { Q0, OK, "acos", acos_, "DA", "F -> G", "G is the arc cosine of F.\n" }, +/* 1500 */ { Q0, OK, "asin", asin_, "DA", "F -> G", "G is the arc sine of F.\n" }, +/* 1510 */ { Q0, OK, "atan", atan_, "DA", "F -> G", "G is the arc tangent of F.\n" }, +/* 1520 */ { Q0, OK, "atan2", atan2_, "DDA", "F G -> H", "H is the arc tangent of F / G.\n" }, +/* 1530 */ { Q0, OK, "ceil", ceil_, "DA", "F -> G", "G is the float ceiling of F.\n" }, +/* 1540 */ { Q0, OK, "cos", cos_, "DA", "F -> G", "G is the cosine of F.\n" }, +/* 1550 */ { Q0, OK, "cosh", cosh_, "DA", "F -> G", "G is the hyperbolic cosine of F.\n" }, +/* 1560 */ { Q0, OK, "exp", exp_, "DA", "F -> G", "G is e (2.718281828...) raised to the Fth power.\n" }, +/* 1570 */ { Q0, OK, "floor", floor_, "DA", "F -> G", "G is the floor of F.\n" }, +/* 1580 */ { Q0, OK, "frexp", frexp_, "DAA", "F -> G I", "G is the mantissa and I is the exponent of F.\nUnless F = 0, 0.5 <= abs(G) < 1.0.\n" }, +/* 1590 */ { Q0, OK, "ldexp", ldexp_, "DDA", "F I -> G", "G is F times 2 to the Ith power.\n" }, +/* 1600 */ { Q0, OK, "log", log_, "DA", "F -> G", "G is the natural logarithm of F.\n" }, +/* 1610 */ { Q0, OK, "log10", log10_, "DA", "F -> G", "G is the common logarithm of F.\n" }, +/* 1620 */ { Q0, OK, "modf", modf_, "DAA", "F -> G H", "G is the fractional part and H is the integer part\n(but expressed as a float) of F.\n" }, +/* 1630 */ { Q0, OK, "pow", pow_, "DDA", "F G -> H", "H is F raised to the Gth power.\n" }, +/* 1640 */ { Q0, OK, "sin", sin_, "DA", "F -> G", "G is the sine of F.\n" }, +/* 1650 */ { Q0, OK, "sinh", sinh_, "DA", "F -> G", "G is the hyperbolic sine of F.\n" }, +/* 1660 */ { Q0, OK, "sqrt", sqrt_, "DA", "F -> G", "G is the square root of F.\n" }, +/* 1670 */ { Q0, OK, "tan", tan_, "DA", "F -> G", "G is the tangent of F.\n" }, +/* 1680 */ { Q0, OK, "tanh", tanh_, "DA", "F -> G", "G is the hyperbolic tangent of F.\n" }, +/* 1690 */ { Q0, OK, "trunc", trunc_, "DA", "F -> I", "I is an integer equal to the float F truncated toward zero.\n" }, +/* 1700 */ { Q0, OK, "localtime", localtime_, "DA", "I -> T", "Converts a time I into a list T representing local time:\n[year month day hour minute second isdst yearday weekday].\nMonth is 1 = January ... 12 = December;\nisdst is a Boolean flagging daylight savings/summer time;\nweekday is 1 = Monday ... 7 = Sunday.\n" }, +/* 1710 */ { Q0, OK, "gmtime", gmtime_, "DA", "I -> T", "Converts a time I into a list T representing universal time:\n[year month day hour minute second isdst yearday weekday].\nMonth is 1 = January ... 12 = December;\nisdst is false; weekday is 1 = Monday ... 7 = Sunday.\n" }, +/* 1720 */ { Q0, OK, "mktime", mktime_, "DA", "T -> I", "Converts a list T representing local time into a time I.\nT is in the format generated by localtime.\n" }, +/* 1730 */ { Q0, OK, "strftime", strftime_, "DDA", "T S1 -> S2", "Formats a list T in the format of localtime or gmtime\nusing string S1 and pushes the result S2.\n" }, +/* 1740 */ { Q0, OK, "strtol", strtol_, "DDA", "S I -> J", "String S is converted to the integer J using base I.\nIf I = 0, assumes base 10,\nbut leading \"0\" means base 8 and leading \"0x\" means base 16.\n" }, +/* 1750 */ { Q0, OK, "strtod", strtod_, "DA", "S -> R", "String S is converted to the float R.\n" }, +/* 1760 */ { Q0, OK, "format", format_, "DDDDA", "N C I J -> S", "S is the formatted version of N in mode C\n('d or 'i = decimal, 'o = octal, 'x or\n'X = hex with lower or upper case letters)\nwith maximum width I and minimum width J.\n" }, +/* 1770 */ { Q0, OK, "formatf", formatf_, "DDDDA", "F C I J -> S", "S is the formatted version of F in mode C\n('e or 'E = exponential, 'f = fractional,\n'g or G = general with lower or upper case letters)\nwith maximum width I and precision J.\n" }, +/* 1780 */ { Q0, OK, "srand", srand_, "D", "I ->", "[IMPURE] Sets the random integer seed to integer I.\n" }, +/* 1790 */ { Q0, OK, "pred", pred_, "DA", "M -> N", "Numeric N is the predecessor of numeric M.\n" }, +/* 1800 */ { Q0, OK, "succ", succ_, "DA", "M -> N", "Numeric N is the successor of numeric M.\n" }, +/* 1810 */ { Q0, OK, "max", max_, "DDA", "N1 N2 -> N", "N is the maximum of numeric values N1 and N2. Also supports float.\n" }, +/* 1820 */ { Q0, OK, "min", min_, "DDA", "N1 N2 -> N", "N is the minimum of numeric values N1 and N2. Also supports float.\n" }, +/* 1830 */ { Q0, OK, "fclose", fclose_, "D", "S ->", "[FOREIGN] Stream S is closed and removed from the stack.\n" }, +/* 1840 */ { Q0, OK, "feof", feof_, "A", "S -> S B", "[FOREIGN] B is the end-of-file status of stream S.\n" }, +/* 1850 */ { Q0, OK, "ferror", ferror_, "A", "S -> S B", "[FOREIGN] B is the error status of stream S.\n" }, +/* 1860 */ { Q0, OK, "fflush", fflush_, "N", "S -> S", "[FOREIGN] Flush stream S, forcing all buffered output to be written.\n" }, +/* 1870 */ { Q0, OK, "fgetch", fgetch_, "A", "S -> S C", "[FOREIGN] C is the next available character from stream S.\n" }, +/* 1880 */ { Q0, OK, "fgets", fgets_, "A", "S -> S L", "[FOREIGN] L is the next available line (as a string) from stream S.\n" }, +/* 1890 */ { Q0, OK, "fopen", fopen_, "DDA", "P M -> S", "[FOREIGN] The file system object with pathname P is opened with mode M\n(r, w, a, etc.) and stream object S is pushed; if the open fails, file:NULL\nis pushed.\n" }, +/* 1900 */ { Q0, OK, "fread", fread_, "DA", "S I -> S L", "[FOREIGN] I bytes are read from the current position of stream S\nand returned as a list of I integers.\n" }, +/* 1910 */ { Q0, OK, "fwrite", fwrite_, "D", "S L -> S", "[FOREIGN] A list of integers are written as bytes to the current position of\nstream S.\n" }, +/* 1920 */ { Q0, OK, "fremove", fremove_, "DA", "P -> B", "[FOREIGN] The file system object with pathname P is removed from the file\nsystem. B is a boolean indicating success or failure.\n" }, +/* 1930 */ { Q0, OK, "frename", frename_, "DDA", "P1 P2 -> B", "[FOREIGN] The file system object with pathname P1 is renamed to P2.\nB is a boolean indicating success or failure.\n" }, +/* 1940 */ { Q0, OK, "fput", fput_, "D", "S X -> S", "[FOREIGN] Writes X to stream S, pops X off stack.\n" }, +/* 1950 */ { Q0, OK, "fputch", fputch_, "A", "S C -> S", "[FOREIGN] The character C is written to the current position of stream S.\n" }, +/* 1960 */ { Q0, OK, "fputchars", fputchars_, "D", "S \"abc..\" -> S", "[FOREIGN] The string abc.. (no quotes) is written to the current position of\nstream S.\n" }, +/* 1970 */ { Q0, OK, "fputstring", fputstring_, "D", "S \"abc..\" -> S", "[FOREIGN] == fputchars, as a temporary alternative.\n" }, +/* 1980 */ { Q0, OK, "fseek", fseek_, "DDA", "S P W -> S B", "[FOREIGN] Stream S is repositioned to position P relative to whence-point W,\nwhere W = 0, 1, 2 for beginning, current position, end respectively.\n" }, +/* 1990 */ { Q0, OK, "ftell", ftell_, "A", "S -> S I", "[FOREIGN] I is the current position of stream S.\n" }, +/* 2000 */ { Q0, OK, "unstack", unstack_, "DP", "[X Y ..] -> ..Y X", "The list [X Y ..] becomes the new stack.\n" }, +/* 2010 */ { Q0, OK, "cons", cons_, "DDA", "X A -> B", "Aggregate B is A with a new member X (first member for sequences).\n" }, +/* 2020 */ { Q0, OK, "swons", swons_, "DDA", "A X -> B", "Aggregate B is A with a new member X (first member for sequences).\n" }, +/* 2030 */ { Q0, OK, "first", first_, "DA", "A -> F", "F is the first member of the non-empty aggregate A.\n" }, +/* 2040 */ { Q0, OK, "rest", rest_, "DA", "A -> R", "R is the non-empty aggregate A with its first member removed.\n" }, +/* 2050 */ { Q0, OK, "compare", compare_, "DDA", "A B -> I", "I (=-1,0,+1) is the comparison of aggregates A and B.\nThe values correspond to the predicates <=, =, >=.\n" }, +/* 2060 */ { Q0, OK, "at", at_, "DDA", "A I -> X", "X (= A[I]) is the member of A at position I.\n" }, +/* 2070 */ { Q0, OK, "of", of_, "DDA", "I A -> X", "X (= A[I]) is the I-th member of aggregate A.\n" }, +/* 2080 */ { Q0, OK, "size", size_, "DA", "A -> I", "Integer I is the number of elements of aggregate A.\n" }, +/* 2090 */ { Q0, OK, "opcase", opcase_, "DA", "X [..[X Xs]..] -> X [Xs]", "Indexing on type of X, returns the list [Xs].\n" }, +/* 2100 */ { Q1, OK, "case", case_, "DP", "X [..[X Y]..] -> Y i", "Indexing on the value of X, execute the matching Y.\n" }, +/* 2110 */ { Q0, OK, "uncons", uncons_, "DAA", "A -> F R", "F and R are the first and the rest of non-empty aggregate A.\n" }, +/* 2120 */ { Q0, OK, "unswons", unswons_, "DAA", "A -> R F", "R and F are the rest and the first of non-empty aggregate A.\n" }, +/* 2130 */ { Q0, OK, "drop", drop_, "DDA", "A N -> B", "Aggregate B is the result of deleting the first N elements of A.\n" }, +/* 2140 */ { Q0, OK, "take", take_, "DDA", "A N -> B", "Aggregate B is the result of retaining just the first N elements of A.\n" }, +/* 2150 */ { Q0, OK, "concat", concat_, "DDA", "S T -> U", "Sequence U is the concatenation of sequences S and T.\n" }, +/* 2160 */ { Q0, OK, "enconcat", enconcat_, "DDDA", "X S T -> U", "Sequence U is the concatenation of sequences S and T\nwith X inserted between S and T (== swapd cons concat).\n" }, +/* 2170 */ { Q0, OK, "name", name_, "DA", "sym -> \"sym\"", "For operators and combinators, the string \"sym\" is the name of item sym,\nfor literals sym the result string is its type.\n" }, +/* 2180 */ { Q0, OK, "intern", intern_, "DA", "\"sym\" -> sym", "Pushes the item whose name is \"sym\".\n" }, +/* 2190 */ { Q0, OK, "body", body_, "DA", "U -> [P]", "Quotation [P] is the body of user-defined symbol U.\n" }, +/* 2200 */ { Q0, OK, "null", null_, "DA", "X -> B", "Tests for empty aggregate X or zero numeric.\n" }, +/* 2210 */ { Q0, OK, "small", small_, "DA", "X -> B", "Tests whether aggregate X has 0 or 1 members, or numeric 0 or 1.\n" }, +/* 2220 */ { Q0, OK, ">=\0geql", geql_, "DDA", "X Y -> B", "Either both X and Y are numeric or both are strings or symbols.\nTests whether X greater than or equal to Y. Also supports float.\n" }, +/* 2230 */ { Q0, OK, ">\0greater", greater_, "DDA", "X Y -> B", "Either both X and Y are numeric or both are strings or symbols.\nTests whether X greater than Y. Also supports float.\n" }, +/* 2240 */ { Q0, OK, "<=\0leql", leql_, "DDA", "X Y -> B", "Either both X and Y are numeric or both are strings or symbols.\nTests whether X less than or equal to Y. Also supports float.\n" }, +/* 2250 */ { Q0, OK, "<\0less", less_, "DDA", "X Y -> B", "Either both X and Y are numeric or both are strings or symbols.\nTests whether X less than Y. Also supports float.\n" }, +/* 2260 */ { Q0, OK, "!=\0neql", neql_, "DDA", "X Y -> B", "Either both X and Y are numeric or both are strings or symbols.\nTests whether X not equal to Y. Also supports float.\n" }, +/* 2270 */ { Q0, OK, "=\0equals", eql_, "DDA", "X Y -> B", "Either both X and Y are numeric or both are strings or symbols.\nTests whether X equal to Y. Also supports float.\n" }, +/* 2280 */ { Q0, OK, "equal", equal_, "DDA", "T U -> B", "(Recursively) tests whether trees T and U are identical.\n" }, +/* 2290 */ { Q0, OK, "has", has_, "DDA", "A X -> B", "Tests whether aggregate A has X as a member.\n" }, +/* 2300 */ { Q0, OK, "in", in_, "DDA", "X A -> B", "Tests whether X is a member of aggregate A.\n" }, +/* 2310 */ { Q0, OK, "integer", integer_, "DA", "X -> B", "Tests whether X is an integer.\n" }, +/* 2320 */ { Q0, OK, "char", char_, "DA", "X -> B", "Tests whether X is a character.\n" }, +/* 2330 */ { Q0, OK, "logical", logical_, "DA", "X -> B", "Tests whether X is a logical.\n" }, +/* 2340 */ { Q0, OK, "set", set_, "DA", "X -> B", "Tests whether X is a set.\n" }, +/* 2350 */ { Q0, OK, "string", string_, "DA", "X -> B", "Tests whether X is a string.\n" }, +/* 2360 */ { Q0, OK, "list", list_, "DA", "X -> B", "Tests whether X is a list.\n" }, +/* 2370 */ { Q0, OK, "leaf", leaf_, "DA", "X -> B", "Tests whether X is not a list.\n" }, +/* 2380 */ { Q0, OK, "user", user_, "DA", "X -> B", "Tests whether X is a user-defined symbol.\n" }, +/* 2390 */ { Q0, OK, "float", float_, "DA", "R -> B", "Tests whether R is a float.\n" }, +/* 2400 */ { Q0, OK, "file", file_, "DA", "F -> B", "[FOREIGN] Tests whether F is a file.\n" }, +/* 2410 */ { Q1, OK, "i", i_, "DP", "[P] -> ...", "Executes P. So, [P] i == P.\n" }, +/* 2420 */ { Q1, OK, "x", x_, "P", "[P] x -> ...", "Executes P without popping [P]. So, [P] x == [P] P.\n" }, +/* 2430 */ { Q1, OK, "dip", dip_, "DDPA", "X [P] -> ... X", "Saves X, executes P, pushes X back.\n" }, +/* 2440 */ { Q1, OK, "app1", app1_, "DDA", "X [P] -> R", "Obsolescent. Executes P, pushes result R on stack.\n" }, +/* 2450 */ { Q1, OK, "app11", app11_, "DDDA", "X Y [P] -> R", "Executes P, pushes result R on stack.\n" }, +/* 2460 */ { Q1, OK, "app12", app12_, "DDDDAA", "X Y1 Y2 [P] -> R1 R2", "Executes P twice, with Y1 and Y2, returns R1 and R2.\n" }, +/* 2470 */ { Q2, OK, "construct", construct_, "DDP", "[P] [[P1] [P2] ..] -> R1 R2 ..", "Saves state of stack and then executes [P].\nThen executes each [Pi] to give Ri pushed onto saved stack.\n" }, +/* 2480 */ { Q0, OK, "nullary", nullary_, "DA", "[P] -> R", "Executes P, which leaves R on top of the stack.\nNo matter how many parameters this consumes, none are removed from the stack.\n" }, +/* 2490 */ { Q1, OK, "unary", unary_, "DDA", "X [P] -> R", "Executes P, which leaves R on top of the stack.\nNo matter how many parameters this consumes,\nexactly one is removed from the stack.\n" }, +/* 2500 */ { Q1, OK, "unary2", unary2_, "DDDAA", "X1 X2 [P] -> R1 R2", "Executes P twice, with X1 and X2 on top of the stack.\nReturns the two values R1 and R2.\n" }, +/* 2510 */ { Q1, OK, "unary3", unary3_, "DDDDAAA", "X1 X2 X3 [P] -> R1 R2 R3", "Executes P three times, with Xi, returns Ri (i = 1..3).\n" }, +/* 2520 */ { Q1, OK, "unary4", unary4_, "DDDDDAAAA", "X1 X2 X3 X4 [P] -> R1 R2 R3 R4", "Executes P four times, with Xi, returns Ri (i = 1..4).\n" }, +/* 2530 */ { Q1, OK, "app2", app2_, "DDDAA", "X1 X2 [P] -> R1 R2", "Obsolescent. == unary2\n" }, +/* 2540 */ { Q1, OK, "app3", app3_, "DDDDAAA", "X1 X2 X3 [P] -> R1 R2 R3", "Obsolescent. == unary3\n" }, +/* 2550 */ { Q1, OK, "app4", app4_, "DDDDDAAAA", "X1 X2 X3 X4 [P] -> R1 R2 R3 R4", "Obsolescent. == unary4\n" }, +/* 2560 */ { Q0, OK, "binary", binary_, "DDDA", "X Y [P] -> R", "Executes P, which leaves R on top of the stack.\nNo matter how many parameters this consumes,\nexactly two are removed from the stack.\n" }, +/* 2570 */ { Q1, OK, "ternary", ternary_, "DDDDA", "X Y Z [P] -> R", "Executes P, which leaves R on top of the stack.\nNo matter how many parameters this consumes,\nexactly three are removed from the stack.\n" }, +/* 2580 */ { Q2, OK, "cleave", cleave_, "DDDAA", "X [P1] [P2] -> R1 R2", "Executes P1 and P2, each with X on top, producing two results.\n" }, +/* 2590 */ { Q2, OK, "branch", branch_, "DDDP", "B [T] [F] -> ...", "If B is true, then executes T else executes F.\n" }, +/* 2600 */ { Q3, OK, "ifte", ifte_, "DDDP", "[B] [T] [F] -> ...", "Executes B. If that yields true, then executes T else executes F.\n" }, +/* 2610 */ { Q2, OK, "ifinteger", ifinteger_, "DDDP", "X [T] [E] -> ...", "If X is an integer, executes T else executes E.\n" }, +/* 2620 */ { Q2, OK, "ifchar", ifchar_, "DDDP", "X [T] [E] -> ...", "If X is a character, executes T else executes E.\n" }, +/* 2630 */ { Q2, OK, "iflogical", iflogical_, "DDDP", "X [T] [E] -> ...", "If X is a logical or truth value, executes T else executes E.\n" }, +/* 2640 */ { Q2, OK, "ifset", ifset_, "DDDP", "X [T] [E] -> ...", "If X is a set, executes T else executes E.\n" }, +/* 2650 */ { Q2, OK, "ifstring", ifstring_, "DDDP", "X [T] [E] -> ...", "If X is a string, executes T else executes E.\n" }, +/* 2660 */ { Q2, OK, "iflist", iflist_, "DDDP", "X [T] [E] -> ...", "If X is a list, executes T else executes E.\n" }, +/* 2670 */ { Q2, OK, "iffloat", iffloat_, "DDDP", "X [T] [E] -> ...", "If X is a float, executes T else executes E.\n" }, +/* 2680 */ { Q2, OK, "iffile", iffile_, "DDDP", "X [T] [E] -> ...", "[FOREIGN] If X is a file, executes T else executes E.\n" }, +/* 2690 */ { Q1, OK, "cond", cond_, "DDA", "[..[[Bi] Ti]..[D]] -> ...", "Tries each Bi. If that yields true, then executes Ti and exits.\nIf no Bi yields true, executes default D.\n" }, +/* 2700 */ { Q2, OK, "while", while_, "DDP", "[B] [D] -> ...", "While executing B yields true executes D.\n" }, +/* 2710 */ { Q4, OK, "linrec", linrec_, "DDDDDA", "[P] [T] [R1] [R2] -> ...", "Executes P. If that yields true, executes T.\nElse executes R1, recurses, executes R2.\n" }, +/* 2720 */ { Q3, OK, "tailrec", tailrec_, "DDDDA", "[P] [T] [R1] -> ...", "Executes P. If that yields true, executes T.\nElse executes R1, recurses.\n" }, +/* 2730 */ { Q4, OK, "binrec", binrec_, "DDDDDA", "[P] [T] [R1] [R2] -> ...", "Executes P. If that yields true, executes T.\nElse uses R1 to produce two intermediates, recurses on both,\nthen executes R2 to combine their results.\n" }, +/* 2740 */ { Q4, OK, "genrec", genrec_, "DDDDDA", "[B] [T] [R1] [R2] -> ...", "Executes B, if that yields true, executes T.\nElse executes R1 and then [[[B] [T] [R1] R2] genrec] R2.\n" }, +/* 2750 */ { Q1, OK, "condnestrec", condnestrec_, "DDA", "[ [C1] [C2] .. [D] ] -> ...", "A generalisation of condlinrec.\nEach [Ci] is of the form [[B] [R1] [R2] .. [Rn]] and [D] is of the form\n[[R1] [R2] .. [Rn]]. Tries each B, or if all fail, takes the default [D].\nFor the case taken, executes each [Ri] but recurses between any two\nconsecutive [Ri] (n > 3 would be exceptional.)\n" }, +/* 2760 */ { Q1, OK, "condlinrec", condlinrec_, "DDA", "[ [C1] [C2] .. [D] ] -> ...", "Each [Ci] is of the form [[B] [T]] or [[B] [R1] [R2]].\nTries each B. If that yields true and there is just a [T], executes T and exit.\nIf there are [R1] and [R2], executes R1, recurses, executes R2.\nSubsequent case are ignored. If no B yields true, then [D] is used.\nIt is then of the form [[T]] or [[R1] [R2]]. For the former, executes T.\nFor the latter executes R1, recurses, executes R2.\n" }, +/* 2770 */ { Q1, OK, "step", step_, "DDQ", "A [P] -> ...", "Sequentially putting members of aggregate A onto stack,\nexecutes P for each member of A.\n" }, +/* 2780 */ { Q1, OK, "fold", fold_, "DDDA", "A V0 [P] -> V", "Starting with value V0, sequentially pushes members of aggregate A\nand combines with binary operator P to produce value V.\n" }, +/* 2790 */ { Q1, OK, "map", map_, "DDA", "A [P] -> B", "Executes P on each member of aggregate A,\ncollects results in sametype aggregate B.\n" }, +/* 2800 */ { Q1, OK, "times", times_, "DDA", "N [P] -> ...", "N times executes P.\n" }, +/* 2810 */ { Q1, OK, "infra", infra_, "DDA", "L1 [P] -> L2", "Using list L1 as stack, executes P and returns a new list L2.\nThe first element of L1 is used as the top of stack,\nand after execution of P the top of stack becomes the first element of L2.\n" }, +/* 2820 */ { Q2, OK, "primrec", primrec_, "DDDA", "X [I] [C] -> R", "Executes I to obtain an initial value R0.\nFor integer X uses increasing positive integers to X, combines by C for new R.\nFor aggregate X uses successive members and combines by C for new R.\n" }, +/* 2830 */ { Q0, OK, "filter", filter_, "DDA", "A [B] -> A1", "Uses test B to filter aggregate A producing sametype aggregate A1.\n" }, +/* 2840 */ { Q1, OK, "split", split_, "DDAA", "A [B] -> A1 A2", "Uses test B to split aggregate A into sametype aggregates A1 and A2.\n" }, +/* 2850 */ { Q1, OK, "some", some_, "DDA", "A [B] -> X", "Applies test B to members of aggregate A, X = true if some pass.\n" }, +/* 2860 */ { Q1, OK, "all", all_, "DDA", "A [B] -> X", "Applies test B to members of aggregate A, X = true if all pass.\n" }, +/* 2870 */ { Q1, OK, "treestep", treestep_, "DDA", "T [P] -> ...", "Recursively traverses leaves of tree T, executes P for each leaf.\n" }, +/* 2880 */ { Q2, OK, "treerec", treerec_, "DDDA", "T [O] [C] -> ...", "T is a tree. If T is a leaf, executes O. Else executes [[[O] C] treerec] C.\n" }, +/* 2890 */ { Q3, OK, "treegenrec", treegenrec_, "DDDDA", "T [O1] [O2] [C] -> ...", "T is a tree. If T is a leaf, executes O1.\nElse executes O2 and then [[[O1] [O2] C] treegenrec] C.\n" }, +/* 2900 */ { Q0, OK, "help", help_, "N", "->", "[IMPURE] Lists all defined symbols, including those from library files.\nThen lists all primitives of raw Joy.\n(There is a variant: \"_help\" which lists hidden symbols).\n" }, +/* 2910 */ { Q0, OK, "_help", _help_, "N", "->", "[IMPURE] Lists all hidden symbols in library and then all hidden builtin\nsymbols.\n" }, +/* 2920 */ { Q0, OK, "helpdetail", helpdetail_, "D", "[ S1 S2 .. ] ->", "[IMPURE] Gives brief help on each symbol S in the list.\n" }, +/* 2930 */ { Q0, OK, "manual", manual_, "N", "->", "[IMPURE] Writes this manual of all Joy primitives to output file.\n" }, +/* 2940 */ { Q0, OK, "__html_manual", __html_manual_, "N", "->", "[IMPURE] Writes this manual of all Joy primitives to output file in HTML style.\n" }, +/* 2950 */ { Q0, OK, "__latex_manual", __latex_manual_, "N", "->", "[IMPURE] Writes this manual of all Joy primitives to output file in Latex style\nbut without the head and tail.\n" }, +/* 2960 */ { Q0, OK, "__manual_list", __manual_list_, "A", "-> L", "Pushes a list L of lists (one per operator) of three documentation strings.\n" }, +/* 2970 */ { Q0, OK, "__settracegc", __settracegc_, "D", "I ->", "[IMPURE] Sets value of flag for tracing garbage collection to I (= 0..6).\n" }, +/* 2980 */ { Q0, OK, "setautoput", setautoput_, "D", "I ->", "[IMPURE] Sets value of flag for automatic put to I (if I = 0, none;\nif I = 1, put; if I = 2, stack).\n" }, +/* 2990 */ { Q0, OK, "setundeferror", setundeferror_, "D", "I ->", "[IMPURE] Sets flag that controls behavior of undefined functions\n(0 = no error, 1 = error).\n" }, +/* 3000 */ { Q0, OK, "setecho", setecho_, "D", "I ->", "[IMPURE] Sets value of echo flag for listing.\nI = 0: no echo, 1: echo, 2: with tab, 3: and linenumber.\n" }, +/* 3010 */ { Q0, OK, "gc", gc_, "N", "->", "[IMPURE] Initiates garbage collection.\n" }, +/* 3020 */ { Q0, OK, "system", system_, "D", "\"command\" ->", "[IMPURE] Escapes to shell, executes string \"command\".\nThe string may cause execution of another program.\nWhen that has finished, the process returns to Joy.\n" }, +/* 3030 */ { Q0, OK, "getenv", getenv_, "DA", "\"variable\" -> \"value\"", "Retrieves the value of the environment variable \"variable\".\n" }, +/* 3040 */ { Q0, OK, "argv", argv_, "A", "-> A", "Creates an aggregate A containing the interpreter's command line arguments.\n" }, +/* 3050 */ { Q0, OK, "argc", argc_, "A", "-> I", "Pushes the number of command line arguments. This is quivalent to 'argv size'.\n" }, +/* 3060 */ { Q0, OK, "__memoryindex", __memoryindex_, "A", "-> I", "Pushes current value of memory.\n" }, +/* 3070 */ { Q0, OK, "get", get_, "A", "-> F", "[IMPURE] Reads a factor from input and pushes it onto stack.\n" }, +/* 3080 */ { Q0, OK, "put", put_, "D", "X ->", "[IMPURE] Writes X to output, pops X off stack.\n" }, +/* 3090 */ { Q0, OK, "putch", putch_, "D", "N ->", "[IMPURE] N : numeric, writes character whose ASCII is N.\n" }, +/* 3100 */ { Q0, OK, "putchars", putchars_, "D", "\"abc..\" ->", "[IMPURE] Writes abc.. (without quotes)\n" }, +/* 3110 */ { Q0, OK, "include", include_, "D", "\"filnam.ext\" ->", "Transfers input to file whose name is \"filnam.ext\".\nOn end-of-file returns to previous input file.\n" }, +/* 3120 */ { Q0, OK, "abort", abort_, "N", "->", "Aborts execution of current Joy program, returns to Joy main cycle.\n" }, +/* 3130 */ { Q0, OK, "quit", quit_, "N", "->", "Exit from Joy.\n" }, +/* 3140 */ { Q0, OK, "casting", casting_, "DDA", "X Y -> Z", "[EXT] Z takes the value from X and uses the value from Y as its type.\n" }, +/* 3150 */ { Q0, OK, "filetime", filetime_, "DA", "F -> T", "[FOREIGN] T is the modification time of file F.\n" }, +/* 3160 */ { Q0, OK, "getch", getch_, "A", "-> N", "[IMPURE] Reads a character from input and puts it onto stack.\n" }, +/* 3170 */ { Q0, OK, "over", over_, "A", "X Y -> X Y X", "[EXT] Pushes an extra copy of the second item X on top of the stack.\n" }, +/* 3180 */ { Q0, OK, "pick", pick_, "DA", "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.\n" }, +/* 3190 */ { Q0, OK, "radix", radix_, "D", "I ->", "[NUM] Sets the output radix.\n" }, +/* 3200 */ { Q0, OK, "round", round_, "DA", "F -> G", "[EXT] G is F rounded to the nearest integer.\n" }, +/* 3210 */ { Q0, OK, "sametype", sametype_, "DDA", "X Y -> B", "[EXT] Tests whether X and Y have the same type.\n" }, +/* 3220 */ { Q0, OK, "scale", scale_, "D", "I ->", "[NUM] Sets the number of digits to be used after the decimal point.\n" }, +/* 3230 */ { Q0, OK, "typeof", typeof_, "DA", "X -> I", "[EXT] Replace X by its type.\n" }, +/* 3240 */ { Q0, OK, "exit", exit_, "N", "->", "[MTH] Exit a thread.\n" }, +/* 3250 */ { Q0, OK, "kill", kill_, "N", "->", "[MTH] Make all threads eligible for garbage collection.\n" }, +/* 3260 */ { Q0, OK, "recv", recv_, "A", "P -> P N", "[MTH] Receive a node from a channel and push it on the stack.\n" }, +/* 3270 */ { Q0, OK, "task", task_, "D", "Q ->", "[MTH] Execute quotation Q in a separate thread.\n" }, +/* 3280 */ { Q0, OK, "send", send_, "D", "C N -> C", "[MTH] Send a node through a channel and switch to the next task.\n" }, +/* 3290 */ { Q1, OK, "#genrec", genrecaux_, "DDDDDA", "[[B] [T] [R1] R2] -> ...", "Executes B, if that yields true, executes T.\nElse executes R1 and then [[[B] [T] [R1] R2] genrec] R2.\n" }, +/* 3300 */ { Q1, OK, "#treegenrec", treegenrecaux_, "DDDDDA", "T [[O1] [O2] C] -> ...", "T is a tree. If T is a leaf, executes O1.\nElse executes O2 and then [[[O1] [O2] C] treegenrec] C.\n" }, +/* 3310 */ { Q1, OK, "#treerec", treerecaux_, "DDDDA", "T [[O] C] -> ...", "T is a tree. If T is a leaf, executes O. Else executes [[[O] C] treerec] C.\n" }, +/* 3320 */ { Q0, OK, "#jump", jump_, "N", "->", "Pop the jump location from the program stack. Jump to that location.\n" }, +/* 3330 */ { Q0, OK, "#cswap", cswap_, "N", "->", "Pop the location of an element from the code stack.\nSwap that element with the top of the data stack.\n" }, +/* 3340 */ { Q0, OK, "#push", push_, "D", "->", "Pop the location of an aggregate from the program stack. Pop an element\nfrom the data stack and add that element to the aggregate.\n" }, +/* 3350 */ { Q0, OK, "#cpush", cpush_, "D", "->", "Pop the location of an element from the code stack.\nPop an element from the data stack and store it at the given location.\n" }, +/* 3360 */ { Q0, OK, "#spush", spush_, "A", "->", "Pop the location of an element on the code stack.\nRead that element and push it on the data stack.\n" }, +/* 3370 */ { Q0, OK, "#pfalse", pfalse_, "D", "->", "Pop the jump location from the program stack. Pop the condition from the data\nstack. If the condition is false, jump to that location.\n" }, +/* 3380 */ { Q0, OK, "#fpush", fpush_, "D", "->", "Pop the location of an aggregate and an element from the program stack.\nIf the top of the data stack is true, add the element to the aggregate.\n" }, +/* 3390 */ { Q0, OK, "#jfalse", jfalse_, "N", "->", "Pop the jump location from the program stack. If the top of the data stack\nis false, jump to that location.\n" }, +/* 3400 */ { Q0, OK, "#strue", strue_, "N", "->", "Pop the jump location from the program stack. If the top of the data stack\nis true, jump to that location.\n" }, +/* 3410 */ { Q0, OK, "#tpush", tpush_, "D", "->", "Pop the location of two aggregates and an element from the program stack.\nThe element is added to one of the two aggregates, depending on the value\non top of the data stack.\n" }, +/* 3420 */ { Q0, OK, "#fjump", fjump_, "D", "->", "Pop the jump location from the program stack. Pop the top of the data stack.\nIf the top of the stack was false, jump to the location in the program stack.\n" }, diff --git a/tabl.sh b/tabl.sh index 1b7018c0..cf9ed020 100644 --- a/tabl.sh +++ b/tabl.sh @@ -1,7 +1,7 @@ # # module : tabl.sh -# version : 1.6 -# date : 01/22/24 +# version : 1.7 +# date : 03/05/24 # # Generate tabl.c # The directory needs to be given as parameter. @@ -42,7 +42,7 @@ do N N N - s/[^\n]*\n\([^ \t]*\)[ \t]*\([^ \t]*\)[ \t]*\([^ \t]*\)[ \t]*:[ \t]*\([DANUPQ]*\)[ \t]*\([^\n]*\)[ \n]*\([^*]*\)\*\/.*/\/* \2 *\/ { \1, @\3@, '$j'_, @\4@, @\5@, @\6@ },/ + s/[^\n]*\n\([^ \t]*\)[ \t]*\([^ \t]*\)[ \t]*\([^ \t]*\)[ \t]*\([^ \t]*\)[ \t]*:[ \t]*\([DANUPQ]*\)[ \t]*\([^\n]*\)[ \n]*\([^*]*\)\*\/.*/\/* \3 *\/ { \1, \2, @\4@, '$j'_, @\5@, @\6@, @\7@ },/ s/\n/\\n/g s/"/\\"/g s/@/"/g diff --git a/writ.c b/writ.c index 1923b6c0..d7110473 100644 --- a/writ.c +++ b/writ.c @@ -1,7 +1,7 @@ /* * module : writ.c - * version : 1.19 - * date : 02/01/24 + * version : 1.20 + * date : 03/05/24 */ #include "globals.h" @@ -15,7 +15,7 @@ PUBLIC void writefactor(pEnv env, Node node, FILE *fp) int i; Entry ent; uint64_t set, j; - char *ptr, buf[BUFFERMAX], tmp[BUFFERMAX]; + char *ptr, buf[MAXNUM], tmp[MAXNUM]; /* This cannot happen. writefactor has a small number of customers: writeterm, @@ -43,7 +43,7 @@ PUBLIC void writefactor(pEnv env, Node node, FILE *fp) ent = vec_at(env->symtab, node.u.ent); fprintf(fp, "%s", ent.name); } else - fprintf(fp, "%s", opername(node.u.proc)); + fprintf(fp, "%s", opername(env, node.u.proc)); break; case BOOLEAN_: fprintf(fp, "%s", node.u.num ? "true" : "false"); @@ -51,7 +51,7 @@ PUBLIC void writefactor(pEnv env, Node node, FILE *fp) case CHAR_: if (node.u.num >= 8 && node.u.num <= 13) fprintf(fp, "'\\%c", "btnvfr"[node.u.num - 8]); - else if (iscntrl((int)node.u.num)) + else if (iscntrl((int)node.u.num) || node.u.num == 32) fprintf(fp, "'\\%03d", (int)node.u.num); else fprintf(fp, "'%c", (int)node.u.num); @@ -201,16 +201,21 @@ PUBLIC void writeterm(pEnv env, NodeList *list, FILE *fp) if ((j = pvec_cnt(list)) == 0) return; #ifdef WRITE_USING_RECURSION - for (i = j - 1; i >= 0; i--) { - writefactor(env, pvec_nth(list, i), fp); - if (i) - putchar(' '); - } + if (env->recurse) + for (i = j - 1; i >= 0; i--) { + writefactor(env, pvec_nth(list, i), fp); + if (i) + putchar(' '); + } + else { #else - vec_init(array); /* collect nodes in a vector */ - for (i = 0; i < j; i++) - vec_push(array, pvec_nth(list, i)); - writing(env, (void *)array, fp); + vec_init(array); /* collect nodes in a vector */ + for (i = 0; i < j; i++) + vec_push(array, pvec_nth(list, i)); + writing(env, (void *)array, fp); +#endif +#ifdef WRITE_USING_RECURSION + } #endif } diff --git a/ylex.c b/ylex.c index 5acee9d2..82dec149 100644 --- a/ylex.c +++ b/ylex.c @@ -1,7 +1,7 @@ /* module : ylex.c - version : 1.7 - date : 10/12/23 + version : 1.8 + date : 03/05/24 */ #include "globals.h" @@ -34,7 +34,7 @@ static void dumptok(Token tok, int num) break; case ';' : printf("SEMICOL"); break; - case JEQUAL : printf("EQUAL"); + case EQDEF : printf("EQUAL"); break; case END : printf("END"); break; @@ -82,7 +82,8 @@ PUBLIC int yylex(pEnv env) if (vec_size(env->tokens)) { tok = vec_pop(env->tokens); #ifdef TOKENS - dumptok(tok, 1); /* tokens from the first pop */ + if (env->printing) + dumptok(tok, 1); /* tokens from the first pop */ #endif symb = tok.symb; yylval = tok.yylval; @@ -153,7 +154,8 @@ done: undomod(hide, modl, hcnt); if (vec_size(env->tokens)) { tok = vec_pop(env->tokens); #ifdef TOKENS - dumptok(tok, 2); /* tokens from the second pop */ + if (env->printing) + dumptok(tok, 2); /* tokens from the second pop */ #endif symb = tok.symb; yylval = tok.yylval; @@ -161,7 +163,8 @@ done: undomod(hide, modl, hcnt); #ifdef TOKENS tok.symb = symb; tok.yylval = yylval; - dumptok(tok, 3); /* there was no value popped */ + if (env->printing) + dumptok(tok, 3); /* there was no value popped */ #endif } return symb;