Patch Tuesday - B

.gitignore

@@ -3,7 +3,4 @@ moy.tar
 pars.c
 pars.h
 lexr.c
-prim.c
-prim.h
-tabl.c
 bdwgc

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)

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

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++;

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 *)

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.

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;
+}

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 <inttypes.h>
 
 #ifdef _MSC_VER
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
 #pragma warning(disable: 4244 4267)
 #else
 #include <unistd.h>		/* alarm function */
+#include <termios.h>
+#include <sys/ioctl.h>
 #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