heasm66 / mdlzork

Different versions of original mainframe Zork reconstructed and patched to run under Confusion.
15 stars 6 forks source link

Update Confusion from master #35

Closed heasm66 closed 1 year ago

heasm66 commented 1 year ago

M. Russotto have two updates that needs addressing:

More bugs? This was in my working directory

diff --git a/src/macros.cpp b/src/macros.cpp
index c8e989b9d6be26afd419f2a77861dd506dc5ec4b..3015a24d2064dcf9002c642bc671755a330512fb 100644
--- a/src/macros.cpp
+++ b/src/macros.cpp
@@ -1389,7 +1389,7 @@ mdl_value_t *mdl_internal_reopen_channel(mdl_value_t *chan)

     pathname = mdl_build_pathname(VITEM(chan, CHANNEL_SLOT_FN1), VITEM(chan, CHANNEL_SLOT_FN2), VITEM(chan, CHANNEL_SLOT_DEVN),VITEM(chan, CHANNEL_SLOT_DIRN));
     f = fopen(pathname, osmode);
-    fprintf(stderr, "RE-opened %s = %p\n", pathname, f);
+//    fprintf(stderr, "RE-opened %s = %p\n", pathname, f);
     if (f == NULL)
     {
         mdl_value_t *errfalse = NULL;
@@ -2107,7 +2107,7 @@ mdl_value_t *mdl_bind_arg_state_machine()
                 {
                     mdl_value_t *arg = argptr->v.p.car;
                     if (!mdl_bind_local_symbol(atom->v.a, arg, frame, false))
-                        return mdl_call_error_ext ("BAD-ARGUMENT-LIST", "Duplicate formal argument", farg, NULL);
+                        return mdl_call_error_ext ("BAD-ARGUMENT-LIST", "Duplicate formal argument", atom, NULL);
                     argptr = argptr->v.p.cdr;
                     args_processed++;
                 }
@@ -2115,11 +2115,25 @@ mdl_value_t *mdl_bind_arg_state_machine()
                     mdl_error("Too few args in function call");
                 else
                 {
-                    // I'm not 100% certain we don't want to evaluate the default value.
-                    if (!mdl_bind_local_symbol(atom->v.a, default_val, frame, false))
-                        return mdl_call_error_ext ("BAD-ARGUMENT-LIST", "Duplicate formal argument", farg, NULL);
+                    // Despite the quote, we do want to evaluate the default arg
+                    // (Zork APPLY-RANDOM demonstrates this)
+                    mdl_push_interp_eval(RETURN_COPYFORWARD, default_val, 0, NULL); 
+                    argstate = ARGSTATE_OPTIONAL_EVALED;
+                }
+                break;
+            case ARGSTATE_OPTIONAL_EVALED:
+            {
+                mdl_value_t *evaled_arg = own_interp_frame->retval;
+                if (!mdl_bind_local_symbol(atom->v.a, evaled_arg, frame, false)) {
+                    return mdl_call_error_ext ("BAD-ARGUMENT-LIST", "Duplicate formal argument", atom, NULL);
+                }
+                if (argptr) {
+                    argptr = argptr->v.p.cdr;
+                    args_processed++;
                 }
+                argstate = ARGSTATE_OPTIONAL;
                 break;
+            }
             default:
                 mdl_error("Unexpected quoted ATOM in formal argument list");
             }
@@ -4583,33 +4597,37 @@ mdl_value_t *mdl_internal_listen_error(mdl_value_t *args, bool is_error)

 void mdl_toplevel(FILE *restorefile)
 {
-    int jumpval;
-
-    mdl_push_interp_toplevel(RETURN_RETURN);
-    mdl_interp_stack->started = true;
-    cur_frame = initial_frame;
-    cur_frame->frame_flags |= MDL_FRAME_FLAGS_TRUEFRAME;
-    cur_frame->args = mdl_make_list(NULL);
-    cur_frame->interp_frame2 = mdl_interp_stack;
-    jumpval = mdl_setjmp(cur_frame->interp_frame2);
-    if (restorefile && !jumpval)
+    if (restorefile)
     {
-        mdl_read_image(restorefile);
-        fprintf(stderr, "Initial restore failed");
-        exit(-1);
-    }
-    // re-acquire the atom in case of restore
-    cur_frame->subr = mdl_get_atom("TOPLEVEL!-", true, NULL);
-    suppress_listen_message = jumpval == LONGJMP_RESTORE;
-    if (jumpval == LONGJMP_RESTORE && cur_frame->result)
-    {
-        mdl_eval(cur_frame->result);
-    }
-    cur_frame->result = NULL;
-    if (!mdl_chan_at_eof(mdl_get_default_inchan()))
+        bool restored = mdl_read_image(restorefile);
+        fclose(restorefile);
+        if (!restored) {
+            fprintf(stderr, "Initial restore failed");
+            exit(-1);
+        }
+        suppress_listen_message = true;
+        mdl_interp_stack->retval = mdl_new_string(8, "RESTORED");
+        if (!mdl_chan_at_eof(mdl_get_default_inchan()))
+        {
+            mdl_interp_from_stack();
+        }
+    } 
+    else
     {
-        mdl_std_apply(mdl_value_builtin_listen, mdl_make_list(mdl_cons_internal(mdl_value_builtin_listen, NULL)), MDL_TYPE_SUBR, true);
-        mdl_interp_from_stack();
+        suppress_listen_message = false;
+        mdl_push_interp_toplevel(RETURN_RETURN);
+        mdl_interp_stack->started = true;
+        cur_frame = initial_frame;
+        cur_frame->frame_flags |= MDL_FRAME_FLAGS_TRUEFRAME;
+        cur_frame->args = mdl_make_list(NULL);
+        cur_frame->interp_frame2 = mdl_interp_stack;
+        cur_frame->subr = mdl_get_atom("TOPLEVEL!-", true, NULL);
+        cur_frame->result = NULL;
+        if (!mdl_chan_at_eof(mdl_get_default_inchan()))
+        {
+            mdl_std_apply(mdl_value_builtin_listen, mdl_make_list(mdl_cons_internal(mdl_value_builtin_listen, NULL)), MDL_TYPE_SUBR, true);
+            mdl_interp_from_stack();
+        }
     }
     cur_frame = NULL;
 }
@@ -8295,7 +8313,7 @@ mdl_value_t *mdl_builtin_eval_fload()
     *VITEM(chan,CHANNEL_SLOT_DIRNARG) = *dir;
     mdl_set_chan_eof_object(chan, NULL);
     if (!mdl_is_true(mdl_internal_open_channel(chan)))
-        mdl_error("Couldn't open file in FLOAD"); // FIXME by passing FALSE to ERROR
+        return mdl_call_error("FILE-SYSTEM-ERROR", cur_frame->subr, NULL); // FIXME by passing FALSE to ERROR

     // frame for fake UNWIND
     prev_frame = cur_frame;
@@ -8629,7 +8647,6 @@ mdl_value_t *mdl_rep_state_machine() {
     IARGSETUP();
     IGETNEXTARG(state_val);
     mdl_interp_frame_t *my_iframe = mdl_interp_stack;
-    fprintf(stderr, "REPS %d\n", (int)state_val->v.w);
     switch (state_val->v.w) {
     case 0:
         mdl_push_interp_eval(RETURN_COPYFORWARD, my_iframe->retval);
@@ -8671,7 +8688,6 @@ mdl_value_t *mdl_builtin_eval_rep()
         mdl_error("Too many args to REP");
 #endif
 #if 1
-    fprintf(stderr, "REP1\n");
     mdl_value_t *readform;
     mdl_value_t *mdl_value_atom_read = mdl_get_atom_from_oblist("READ", mdl_value_root_oblist);
     readform = mdl_make_list(mdl_cons_internal(mdl_value_atom_read, NULL), MDL_TYPE_FORM);
@@ -8706,7 +8722,6 @@ mdl_value_t *mdl_builtin_eval_rep()
 // though the documentation suggests it is
 //    while (1)
     {
-        fprintf(stderr, "REP\n");
         readresult = mdl_std_eval(readform);
         evalresult = mdl_eval(readresult);
         mdl_set_lval(atom_last_out, evalresult, cur_frame);

Fix compiler warnings and missing headers

diff --git a/src/macros.cpp b/src/macros.cpp
index 3015a24d2064dcf9002c642bc671755a330512fb..7d7e8a577d7ca9b2d6212fdbe5e493aacc21c6a0 100644
--- a/src/macros.cpp
+++ b/src/macros.cpp
@@ -18,12 +18,14 @@
 #include <assert.h>
 #include <sys/stat.h>
 #include <sys/time.h>
+#include <sys/types.h>
 #include <sys/resource.h>
 #include <stdarg.h>
 #include <stdlib.h>
 #include <string.h>
 #include <errno.h>
 #include <math.h>
+#include <unistd.h>
 #include "macros.hpp"
 #include "mdl_internal_defs.h"
 #include "mdl_builtin_types.h"
@@ -613,7 +615,7 @@ bool mdl_oblists_are_reasonable(mdl_value_t *oblists)
 mdl_value_t *mdl_get_atom(const char *pname, bool insert_allowed, mdl_value_t *default_oblists)
 {

-    char *trailer = strstr(pname, "!-");
+    const char *trailer = strstr(pname, "!-");
     if (trailer == NULL)
     {
         return mdl_get_atom_default_oblist(pname, insert_allowed, default_oblists);
@@ -4474,7 +4476,7 @@ mdl_value_t *mdl_listen_error_pt2()
     {
         // a new frame is not made here; this is called out
         // explicitly in the documentation
-        mdl_value_t *mdl_builtin_eval_rep();
+        mdl_value_t *mdl_builtin_eval_rep(void);

         fprintf(stderr, "Atom REP has neither LVAL nor GVAL\n");
         mdl_builtin_eval_rep();
diff --git a/src/mdl_output.cpp b/src/mdl_output.cpp
index 003c4cdb86dcad00be216866ad696eee03f73724..79017148d12d7f20874ba0133c0939ce2255cdf3 100644
--- a/src/mdl_output.cpp
+++ b/src/mdl_output.cpp
@@ -22,6 +22,7 @@
 #include <ctype.h>
 #include <string.h>
 #include <errno.h>
+#include <unistd.h>
 #include "mdl_strbuf.h"

 typedef enum outbuf_items_t
@@ -437,12 +438,12 @@ const char *mdl_quote_atomname(const char *name, bool *nonnump)
     else if (*s == '-') 
     {
         newlen++;
-        *s++;
+        s++;
     }
     else if (*s == '*') 
     {
         newlen++;
-        *s++;
+        s++;
         octal = true;
     }
     while ((ch = *s++))
diff --git a/src/mdl_read.cpp b/src/mdl_read.cpp
index 67eb88ce3149f70393965dd896ecd894fd0864a6..c0d3d2ca1024599d9da582031b052b0b9bc694f9 100644
--- a/src/mdl_read.cpp
+++ b/src/mdl_read.cpp
@@ -20,6 +20,7 @@
 #include <string.h>
 #include <ctype.h>
 #include <errno.h>
+#include <unistd.h>
 #include "macros.hpp"
 #include "mdl_internal_defs.h"
 #include "mdl_interp.h"
diff --git a/src/mdli.cpp b/src/mdli.cpp
index d07f2721395a9c78c9aa594cec80ea32c4f46b2d..e3791d9056d33b3e12efa042274713b8eeca7349 100644
--- a/src/mdli.cpp
+++ b/src/mdli.cpp
@@ -17,6 +17,7 @@
 /*****************************************************************************/
 #include <stdio.h>
 #include <stdlib.h>
+#include <unistd.h>
 #include <gc/gc.h>
 #include "macros.hpp"
 #include "mdl_internal_defs.h"
heasm66 commented 1 year ago

These changes are from the master-branch and still considered "experimental". The compiler-warning-fixes are already incorperated.