From eb494a6b73f1b102b668fe473b9daa1a809f2880 Mon Sep 17 00:00:00 2001 From: Wodan58 Date: Tue, 7 May 2024 10:22:49 +0200 Subject: [PATCH] Patch Tuesday - E --- builtin.c | 3 ++- builtin.h | 3 ++- factor.c | 12 +++++++----- globals.h | 11 ++++++----- main.c | 5 +++-- optable.c | 8 ++++++-- prims.sh | 8 ++++---- scan.c | 12 ++++++------ src/finclude.c | 28 ++++++++++++++++++++++++++++ src/fput.c | 5 ++--- src/fputch.c | 6 +++--- src/getch.c | 17 ----------------- src/quit.c | 6 +++--- src/times.c | 6 +++--- src/unassign.c | 31 +++++++++++++++++++++++++++++++ table.c | 3 ++- table.sh | 6 +++--- test2/CMakeLists.txt | 5 ++--- test2/body.joy | 8 +++----- test2/equal.joy | 12 +++++------- test2/getch.joy | 10 ---------- test2/helpdetail.joy | 8 +++----- test2/name.joy | 8 +++----- test2/null.joy | 8 +++----- test2/put.joy | 8 +++----- test2/typeof.joy | 8 +++----- test2/user.joy | 8 +++----- 27 files changed, 139 insertions(+), 114 deletions(-) create mode 100644 src/finclude.c delete mode 100644 src/getch.c create mode 100644 src/unassign.c delete mode 100644 test2/getch.joy diff --git a/builtin.c b/builtin.c index 8d67135..b7b1fab 100644 --- a/builtin.c +++ b/builtin.c @@ -70,6 +70,7 @@ #include "./src/file.c" #include "./src/filetime.c" #include "./src/filter.c" +#include "./src/finclude.c" #include "./src/first.c" #include "./src/float.c" #include "./src/floor.c" @@ -93,7 +94,6 @@ #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" @@ -215,6 +215,7 @@ #include "./src/unary2.c" #include "./src/unary3.c" #include "./src/unary4.c" +#include "./src/unassign.c" #include "./src/uncons.c" #include "./src/undeferror.c" #include "./src/undefs.c" diff --git a/builtin.h b/builtin.h index f95a9b0..ee7355d 100644 --- a/builtin.h +++ b/builtin.h @@ -70,6 +70,7 @@ void fgets_(pEnv env); void file_(pEnv env); void filetime_(pEnv env); void filter_(pEnv env); +void finclude_(pEnv env); void first_(pEnv env); void float_(pEnv env); void floor_(pEnv env); @@ -93,7 +94,6 @@ 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); @@ -215,6 +215,7 @@ void unary_(pEnv env); void unary2_(pEnv env); void unary3_(pEnv env); void unary4_(pEnv env); +void unassign_(pEnv env); void uncons_(pEnv env); void undeferror_(pEnv env); void undefs_(pEnv env); diff --git a/factor.c b/factor.c index 19a7e8a..818876b 100644 --- a/factor.c +++ b/factor.c @@ -1,8 +1,8 @@ /* FILE: factor.c */ /* * module : factor.c - * version : 1.30 - * date : 03/23/24 + * version : 1.31 + * date : 04/19/24 */ #include "globals.h" @@ -257,9 +257,11 @@ void writefactor(pEnv env, Index n, FILE *fp) case FLOAT_: sprintf(buf, "%g", nodevalue(n).dbl); /* exponent character is e */ if ((ptr = strchr(buf, '.')) == 0) { /* locate decimal point */ - if ((ptr = strchr(buf, 'e')) == 0) /* locate start of exponent */ - strcat(buf, ".0"); /* add decimal point and 0 */ - else { + if ((ptr = strchr(buf, 'e')) == 0) {/* locate start of exponent */ + i = buf[strlen(buf) - 1]; + if (isdigit(i)) /* check digit present */ + strcat(buf, ".0"); /* add decimal point and 0 */ + } else { strcpy(tmp, ptr); /* save exponent */ sprintf(ptr, ".0%s", tmp); /* insert decimal point + 0 */ } diff --git a/globals.h b/globals.h index 3d8b7eb..0edbcf1 100644 --- a/globals.h +++ b/globals.h @@ -1,8 +1,8 @@ /* FILE: globals.h */ /* * module : globals.h - * version : 1.95 - * date : 04/12/24 + * version : 1.96 + * date : 05/02/24 */ #ifndef GLOBALS_H #define GLOBALS_H @@ -161,6 +161,7 @@ KHASH_MAP_INIT_STR(Symtab, int) KHASH_MAP_INIT_INT64(Funtab, int) typedef struct Env { + jmp_buf finclude; /* return point in finclude */ double maxnodes; double nodes; /* statistics */ double avail; @@ -184,10 +185,9 @@ typedef struct Env { #ifdef NOBDW clock_t gc_clock; vector(Node) *memory; /* dynamic memory */ - Index prog, stck, conts, dump, dump1, dump2, dump3, dump4, dump5; -#else - Node *prog, *stck; + Index conts, dump, dump1, dump2, dump3, dump4, dump5; #endif + Index prog, stck; int g_argc; /* command line */ int hide_stack[DISPLAYMAX]; struct { @@ -206,6 +206,7 @@ typedef struct Env { unsigned char ignore; unsigned char overwrite; unsigned char printing; + unsigned char finclude_busy; } Env; /* GOOD REFS: diff --git a/main.c b/main.c index 208a355..5dd83ab 100644 --- a/main.c +++ b/main.c @@ -1,8 +1,8 @@ /* FILE: main.c */ /* * module : main.c - * version : 1.95 - * date : 04/11/24 + * version : 1.96 + * date : 04/19/24 */ /* @@ -138,6 +138,7 @@ static void dump(pEnv env); */ void abortexecution_(int num) { + fflush(stdin); longjmp(begin, num); } diff --git a/optable.c b/optable.c index d0ef1f4..3c27a91 100644 --- a/optable.c +++ b/optable.c @@ -1,7 +1,7 @@ /* * module : optable.c - * version : 1.3 - * date : 04/11/24 + * version : 1.4 + * date : 04/29/24 */ #include "globals.h" @@ -95,6 +95,9 @@ #define INTEGER(NAME) \ if (nodetype(env->stck) != INTEGER_) \ execerror("integer", NAME) +#define POSITIVEINTEGER(NAME) \ + if (nodetype(env->stck) != INTEGER_ || nodevalue(env->stck).num < 0)\ + execerror("non-negative integer", NAME) #define INTEGER2(NAME) \ if (nodetype(nextnode1(env->stck)) != INTEGER_) \ execerror("integer as second parameter", NAME) @@ -200,6 +203,7 @@ #define STRING(NAME) #define STRING2(NAME) #define INTEGER(NAME) +#define POSITIVEINTEGER(NAME) #define INTEGER2(NAME) #define CHARACTER(NAME) #define INTEGERS2(NAME) diff --git a/prims.sh b/prims.sh index d478abb..a3894b5 100644 --- a/prims.sh +++ b/prims.sh @@ -1,7 +1,7 @@ # # module : prims.sh -# version : 1.4 -# date : 10/26/23 +# version : 1.6 +# date : 05/01/24 # # Generate builtin.c and builtin.h # The directory needs to be given as parameter. @@ -14,7 +14,7 @@ then echo creating builtin.c and builtin.h todo=1 else - diff prims.tmp $1/builtin.c + diff $1/builtin.c prims.tmp if [ $? -eq 0 ] then echo builtin.c and builtin.h are up-to-date @@ -29,5 +29,5 @@ then rm -f $1/builtin.c $1/builtin.h mv prims.tmp $1/builtin.c sed 's/.*\//void /;s/\..*/_(pEnv env);/' <$1/builtin.c >$1/builtin.h - touch $1/interp.c + touch $1/optable.c fi diff --git a/scan.c b/scan.c index 0906d35..0c9f846 100644 --- a/scan.c +++ b/scan.c @@ -1,7 +1,7 @@ /* module : scan.c - version : 1.67 - date : 03/23/24 + version : 1.68 + date : 05/02/24 */ #include "globals.h" @@ -54,14 +54,14 @@ int getch(pEnv env) int ch; again: - if (vec_size(env->pushback)) { - ch = vec_pop(env->pushback); - return ch; - } + if (vec_size(env->pushback)) + return vec_pop(env->pushback); if ((ch = fgetc(srcfile)) == EOF) { if (!ilevel) abortexecution_(ABORT_QUIT); fclose(srcfile); + if (env->finclude_busy) + longjmp(env->finclude, 1); /* back to finclude */ srcfile = infile[--ilevel].fp; linenum = infile[ilevel].line; filenam = infile[ilevel].name; diff --git a/src/finclude.c b/src/finclude.c new file mode 100644 index 0000000..bb6d72c --- /dev/null +++ b/src/finclude.c @@ -0,0 +1,28 @@ +/* + module : finclude.c + version : 1.12 + date : 05/02/24 +*/ +#ifndef FINCLUDE_C +#define FINCLUDE_C + +/** +OK 3160 finclude : S -> F ... +[FOREIGN] Reads Joy source code from stream S and pushes it onto stack. +*/ +void finclude_(pEnv env) +{ + char *str; + + ONEPARAM("finclude"); + STRING("finclude"); + str = nodevalue(env->stck).str; /* read file name */ + POP(env->stck); /* remove file name from stack */ + include(env, str); /* include new file */ + env->finclude_busy = 1; /* tell scanner about finclude */ + if (setjmp(env->finclude)) + env->finclude_busy = 0; /* done with finclude */ + else while (1) + get_(env); /* read all factors from file */ +} +#endif diff --git a/src/fput.c b/src/fput.c index 7724e8f..7c11f20 100644 --- a/src/fput.c +++ b/src/fput.c @@ -1,7 +1,7 @@ /* module : fput.c - version : 1.8 - date : 03/21/24 + version : 1.9 + date : 04/27/24 */ #ifndef FPUT_C #define FPUT_C @@ -21,6 +21,5 @@ void fput_(pEnv env) FILE("fput"); fp = nodevalue(env->stck).fil; writefactor(env, node, fp); - putc(' ', fp); } #endif diff --git a/src/fputch.c b/src/fputch.c index d6aff89..54aa6c8 100644 --- a/src/fputch.c +++ b/src/fputch.c @@ -1,7 +1,7 @@ /* module : fputch.c - version : 1.5 - date : 03/21/24 + version : 1.6 + date : 04/29/24 */ #ifndef FPUTCH_C #define FPUTCH_C @@ -15,7 +15,7 @@ void fputch_(pEnv env) int ch; TWOPARAMS("fputch"); - INTEGER("fputch"); + NUMERICTYPE("fputch"); ch = nodevalue(env->stck).num; POP(env->stck); FILE("fputch"); diff --git a/src/getch.c b/src/getch.c deleted file mode 100644 index 8e55983..0000000 --- a/src/getch.c +++ /dev/null @@ -1,17 +0,0 @@ -/* - module : getch.c - version : 1.8 - date : 03/21/24 -*/ -#ifndef GETCH_C -#define GETCH_C - -/** -POSTPONE 3160 getch : -> N -[IMPURE] Reads a character from input and puts it onto stack. -*/ -void getch_(pEnv env) -{ - NULLARY(CHAR_NEWNODE, getch(env)); -} -#endif diff --git a/src/quit.c b/src/quit.c index 338228a..177f983 100644 --- a/src/quit.c +++ b/src/quit.c @@ -1,7 +1,7 @@ /* module : quit.c - version : 1.9 - date : 03/21/24 + version : 1.10 + date : 04/29/24 */ #ifndef QUIT_C #define QUIT_C @@ -12,6 +12,6 @@ IGNORE_OK 3130 quit : -> */ void quit_(pEnv env) { - exit(EXIT_SUCCESS); + abortexecution_(ABORT_QUIT); } #endif diff --git a/src/times.c b/src/times.c index a46d8a7..c438e23 100644 --- a/src/times.c +++ b/src/times.c @@ -1,7 +1,7 @@ /* module : times.c - version : 1.5 - date : 03/21/24 + version : 1.6 + date : 04/29/24 */ #ifndef TIMES_C #define TIMES_C @@ -19,7 +19,7 @@ void times_(pEnv env) ONEQUOTE("times"); program = env->stck->u.lis; POP(env->stck); - INTEGER("times"); + POSITIVEINTEGER("times"); n = env->stck->u.num; POP(env->stck); for (i = 0; i < n; i++) diff --git a/src/unassign.c b/src/unassign.c new file mode 100644 index 0000000..267aec1 --- /dev/null +++ b/src/unassign.c @@ -0,0 +1,31 @@ +/* + module : unassign.c + version : 1.1 + date : 05/06/24 +*/ +#ifndef UNASSIGN_C +#define UNASSIGN_C + +/** +IGNORE_POP 3235 unassign : [N] -> +[IMPURE] Sets the body of the name N to uninitialized. +*/ +void unassign_(pEnv env) +{ + Index lis; + int index; + Entry ent; + + ONEPARAM(__FILE__); /* name */ + ONEQUOTE(__FILE__); /* quotation on top */ + lis = nodevalue(env->stck).lis; /* singleton list */ + CHECKEMPTYLIST(lis, __FILE__); /* check non-empty list */ + USERDEF2(lis, __FILE__); /* check user defined name */ + index = nodevalue(lis).ent; /* index user defined name */ + ent = vec_at(env->symtab, index); /* symbol table entry */ + POP(env->stck); /* bump stack again */ + ent.is_user = 1; /* ensure again user defined */ + ent.u.body = 0; /* ensure empty body */ + vec_at(env->symtab, index) = ent; /* update symbol table */ +} +#endif diff --git a/table.c b/table.c index cd5b651..611d059 100644 --- a/table.c +++ b/table.c @@ -214,13 +214,14 @@ /* 3130 */ { IGNORE_OK, "quit", quit_, "->", "[IMPURE] Exit from Joy.\n" }, /* 3140 */ { OK, "casting", casting_, "X Y -> Z", "[EXT] Z takes the value from X and uses the value from Y as its type.\n" }, /* 3150 */ { OK, "filetime", filetime_, "F -> T", "[FOREIGN] T is the modification time of file F.\n" }, -/* 3160 */ { POSTPONE, "getch", getch_, "-> N", "[IMPURE] Reads a character from input and puts it onto stack.\n" }, +/* 3160 */ { OK, "finclude", finclude_, "S -> F ...", "[FOREIGN] Reads Joy source code from stream S and pushes it onto stack.\n" }, /* 3170 */ { OK, "over", over_, "X Y -> X Y X", "[EXT] Pushes an extra copy of the second item X on top of the stack.\n" }, /* 3180 */ { OK, "pick", pick_, "X Y Z 2 -> X Y Z X", "[EXT] Pushes an extra copy of nth (e.g. 2) item X on top of the stack.\n" }, /* 3190 */ { IGNORE_POP, "assign", assign_, "V [N] ->", "[IMPURE] Assigns value V to the variable with name N.\n" }, /* 3200 */ { OK, "round", round_, "F -> G", "[EXT] G is F rounded to the nearest integer.\n" }, /* 3210 */ { OK, "sametype", sametype_, "X Y -> B", "[EXT] Tests whether X and Y have the same type.\n" }, /* 3230 */ { OK, "typeof", typeof_, "X -> I", "[EXT] Replace X by its type.\n" }, +/* 3235 */ { IGNORE_POP, "unassign", unassign_, "[N] ->", "[IMPURE] Sets the body of the name N to uninitialized.\n" }, /* 3240 */ { OK, "#genrec", genrecaux_, "[[B] [T] [R1] R2] -> ...", "Executes B, if that yields true, executes T.\nElse executes R1 and then [[[B] [T] [R1] R2] genrec] R2.\n" }, /* 3250 */ { OK, "#treegenrec", treegenrecaux_, "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" }, /* 3260 */ { OK, "#treerec", treerecaux_, "T [[O] C] -> ...", "T is a tree. If T is a leaf, executes O. Else executes [[[O] C] treerec] C.\n" }, diff --git a/table.sh b/table.sh index 78d324b..662ccfb 100644 --- a/table.sh +++ b/table.sh @@ -1,7 +1,7 @@ # # module : table.sh -# version : 1.5 -# date : 08/13/23 +# version : 1.6 +# date : 04/19/24 # # Generate table.c # The directory needs to be given as parameter. @@ -49,4 +49,4 @@ do P }' <$i done | sort >$1/table.c -touch $1/interp.c +touch $1/optable.c diff --git a/test2/CMakeLists.txt b/test2/CMakeLists.txt index 7059b3e..8213703 100644 --- a/test2/CMakeLists.txt +++ b/test2/CMakeLists.txt @@ -1,7 +1,7 @@ # # module : CMakeLists.txt -# version : 1.12 -# date : 04/11/24 +# version : 1.13 +# date : 05/02/24 # macro(exe9 src) add_custom_target(${src}.out ALL @@ -104,7 +104,6 @@ exe9(gc2) exe9(genrec) exe9(geql) exe9(get) -exe9(getch) exe9(getenv) exe9(gmtime) exe9(greater) diff --git a/test2/body.joy b/test2/body.joy index 2729f91..a8523fa 100644 --- a/test2/body.joy +++ b/test2/body.joy @@ -1,8 +1,6 @@ (* module : body.joy - version : 1.4 - date : 03/21/24 + version : 1.5 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - -[last] first body [dup rest null [first] [rest last] branch] equal. +[sum] first body [0 [+] fold] equal. diff --git a/test2/equal.joy b/test2/equal.joy index 4502713..4246d1e 100644 --- a/test2/equal.joy +++ b/test2/equal.joy @@ -1,13 +1,11 @@ (* module : equal.joy - version : 1.9 - date : 04/11/24 + version : 1.10 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - -[last] first [pop] first equal false =. -[last] first 10 equal false =. -[pop] first [last] first equal false =. +[sum] first [pop] first equal false =. +[sum] first 10 equal false =. +[pop] first [sum] first equal false =. [pop] first [pop] first equal. [pop] first 10 equal false =. 1 true equal. diff --git a/test2/getch.joy b/test2/getch.joy deleted file mode 100644 index f3c70c9..0000000 --- a/test2/getch.joy +++ /dev/null @@ -1,10 +0,0 @@ -(* - module : getch.joy - version : 1.5 - date : 03/21/24 -*) -0 setautoput getch getch getch. -ABC -1 setautoput 'C =. -'B =. -'A =. diff --git a/test2/helpdetail.joy b/test2/helpdetail.joy index c54f845..d29564a 100644 --- a/test2/helpdetail.joy +++ b/test2/helpdetail.joy @@ -1,12 +1,10 @@ (* module : helpdetail.joy - version : 1.5 - date : 03/22/24 + version : 1.6 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - "test" "w" fopen -[stdin stdout stderr 3.14 [] "" {} 10 'A true maxint helpdetail last dummy] +[stdin stdout stderr 3.14 [] "" {} 10 'A true maxint helpdetail sum dummy] cons helpdetail. $ cat test $ rm test diff --git a/test2/name.joy b/test2/name.joy index 33922e9..5bdd431 100644 --- a/test2/name.joy +++ b/test2/name.joy @@ -1,12 +1,10 @@ (* module : name.joy - version : 1.4 - date : 03/21/24 + version : 1.5 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - [pop] first name "pop" =. -[last] first name "last" =. +[sum] first name "sum" =. true name " truth value type" =. 'A name " character type" =. 10 name " integer type" =. diff --git a/test2/null.joy b/test2/null.joy index 0b52c28..33d4d76 100644 --- a/test2/null.joy +++ b/test2/null.joy @@ -1,12 +1,10 @@ (* module : null.joy - version : 1.4 - date : 03/21/24 + version : 1.5 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - [pop] first null false =. -[last] first null false =. +[sum] first null false =. false null. true null false =. '\000 null. diff --git a/test2/put.joy b/test2/put.joy index 1b05276..505d62a 100644 --- a/test2/put.joy +++ b/test2/put.joy @@ -1,12 +1,10 @@ (* module : put.joy - version : 1.5 - date : 04/15/24 + version : 1.6 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - [pop] first putln. -[last] first putln. +[sum] first putln. true putln. 'A putln. 10 putln. diff --git a/test2/typeof.joy b/test2/typeof.joy index 2b0a2ba..4dd1c1e 100644 --- a/test2/typeof.joy +++ b/test2/typeof.joy @@ -1,11 +1,9 @@ (* module : typeof.joy - version : 1.3 - date : 03/21/24 + version : 1.4 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - -[last] first typeof 2 =. +[sum] first typeof 2 =. [pop] first typeof 3 =. true typeof 4 =. 'A typeof 5 =. diff --git a/test2/user.joy b/test2/user.joy index 4006c98..44aafc5 100644 --- a/test2/user.joy +++ b/test2/user.joy @@ -1,9 +1,7 @@ (* module : user.joy - version : 1.4 - date : 03/21/24 + version : 1.5 + date : 04/19/24 *) -DEFINE last == dup rest null [first] [rest last] branch. - -[last] first user. +[sum] first user. [pop] first user false =.