Fix double-eval bug in apply(). Grow buffers by more than 1 wherever performance matters.

minproto.leg

@@ -1,6 +1,6 @@
 # minproto.leg -- minimal prototype langauge for semantic experiments
 #
-# last edited: 2024-06-20 03:14:11 by piumarta on m1mbp
+# last edited: 2024-06-20 13:22:50 by piumarta on m1mbp
 
 %{
     ;
@@ -19,7 +19,7 @@
 #endif
 
 #ifndef PRIMCLOSURE     // Lambda and Closure are primitive types, not subtypes of Object
-# define PRIMCLOSURE 1  // (approx. 6% performance decrease, because every Object_get() is slower)
+# define PRIMCLOSURE 0  // (approx. 6% performance decrease, because every Object_get() is slower)
 #endif
 
 #ifndef DELOPT          // delegate is a member of Object structure, not a normal property
@@ -63,14 +63,18 @@
 
 #if GC
 # include <gc.h>
+# define xcalloc(N,S)           (GC_malloc((N)*(S)))
 # define xmalloc(N)             (GC_malloc(N))
 # define xmallocAtomic(N)       (GC_malloc_atomic(N))
 # define xrealloc(P, N)         (GC_realloc(P, N))
+# define xfree(P)               (GC_free(P))
 #else
 # define GC_INIT()
+# define xcalloc(N,S)           (calloc(N, S))
 # define xmalloc(N)             (calloc(1, N))
 # define xmallocAtomic(N)       (calloc(1, N))
 # define xrealloc(P, N)         (realloc(P, N))
+# define xfree(P)               (free(P))
 #endif
 
 #define indexableSize(A)        (sizeof(A) / sizeof(*(A)))
@@ -172,10 +176,10 @@ int     nnlrs = 0;
 int   maxnlrs = 0;
 oop   valnlr  = 0;
 
-#define nlrPush() ({                                                                    \
-        if (++nnlrs >= maxnlrs) nlrs = realloc(nlrs, sizeof(struct NLR) * ++maxnlrs);   \
-        nlrs[nnlrs - 1].ntrace = _get(trace, Object,isize);                             \
-        setjmp(nlrs[nnlrs - 1].env);                                                    \
+#define nlrPush() ({                                                                            \
+        if (++nnlrs >= maxnlrs) nlrs = realloc(nlrs, sizeof(struct NLR) * (maxnlrs += 32));     \
+        nlrs[nnlrs - 1].ntrace = _get(trace, Object,isize);                                     \
+        setjmp(nlrs[nnlrs - 1].env);                                                            \
     })
 
 #define nlrReturn(VAL, TYPE) {                  \
@@ -650,6 +654,7 @@ oop newClosure(oop function, oop environment)
     oop obj = make(Closure);
     _set(obj, Closure,function,    function);
     _set(obj, Closure,environment, environment);
+    _set(obj, Closure,fixed,       nil);
     return obj;
 }
 
@@ -657,9 +662,10 @@ int isClosure(oop obj) { return is(Closure, obj); }
 
 #endif
 
-oop     macros  = 0;
-oop    *symbols = 0;
-size_t nsymbols = 0;
+oop        macros = 0;
+oop      *symbols = 0;
+size_t   nsymbols = 0;
+size_t maxsymbols = 0;
 
 oop intern(char *name)
 {
@@ -672,7 +678,7 @@ oop intern(char *name)
         else if (cmp > 0) lo = mid + 1;
         else              return sym;
     }
-    symbols = xrealloc(symbols, sizeof(*symbols) * ++nsymbols);
+    if (++nsymbols >= maxsymbols) symbols = xrealloc(symbols, sizeof(*symbols) * (maxsymbols += 32));
     memmove(symbols + lo + 1, symbols + lo, sizeof(*symbols) * (nsymbols - 1 - lo));
     return symbols[lo] = newSymbol(name);
 }
@@ -1279,6 +1285,7 @@ oop codeOn(oop str, oop obj, int indent)
         }
         case Closure: {
             String_appendAll(str, "<closure>");
+            codeOn(str, _get(obj, Closure,function), indent);
             break;
         }
 #endif
@@ -2421,7 +2428,7 @@ oop Closure_eval(oop exp, oop env)
 
 void Closure_codeOn(oop exp, oop str, oop env)
 {
-    printOn(str, exp, 0);
+    printOn(str, Object_getLocal(exp, sym_function), 0);
 }
 
 int isClosure(oop obj)
@@ -3963,7 +3970,7 @@ oop prim_String_new(oop func, oop self, oop args, oop env)
     int  nargs = _get(args, Object,isize);
     if (nargs == 0) return newStringLen(0, 0);
     int len = _integerValue(getArgType(args, 0, Integer, "String.new"));
-    return newStringLen(calloc(1, len), len);
+    return newStringLen(0, len);
 }
 
 oop prim_String_escaped(oop func, oop self, oop args, oop env)
@@ -4610,8 +4617,8 @@ oop prim_extern(oop func, oop self, oop args, oop env)
     void *adr = xdlsym(hnd, sym);
     char *sig = stringValue(pargs[2], "__extern__");
     int  argc = strlen(sig);
-    ffi_cif *cif = calloc(1, sizeof(ffi_cif));
-    ffi_type **argv = calloc(argc, sizeof(*argv));
+    ffi_cif *cif = xcalloc(1, sizeof(ffi_cif));
+    ffi_type **argv = xcalloc(argc, sizeof(*argv));
     for (int i = 0;  i < argc;  ++i) argv[i] = sig2type(sig[i]);
     ffi_prep_cif(cif, FFI_DEFAULT_ABI, argc - 1, argv[0], argv + 1);
     struct ffi_t *ffi = xmalloc(sizeof(*ffi));
@@ -4715,9 +4722,9 @@ oop applyThunkIn(oop func, oop env)
     oop  lambda      = _get(func, Closure,function);
     oop  body        = _get(lambda, Lambda,body);
 #else
-    if (Object != functype || pClosure  != _getDelegate(func))
-        valueError(nil == self ? "()" : ".()", "cannot apply", func);
+    if (Object != functype || pClosure  != _getDelegate(func)) valueError("()", "cannot apply", func);
     oop  lambda      = Object_get(func,   sym_function);
+    oop  body        = Object_get(lambda, sym_body);
     oop  parameters  = Object_get(lambda, sym_parameters);
 # if PROFILE
     oop  profile     = nil;
@@ -4853,7 +4860,7 @@ vmInsn *vmCompile(oop grammar, oop symbol)
     int   plen  = _get(program, Object,isize);
     if (plen % 5 != 0) valueError("__match__", "program length is not a multiple of five", program);
     int   clen  = plen / 5;
-    vmInsn *code = calloc(clen, sizeof(*code));
+    vmInsn *code = xcalloc(clen, sizeof(*code));
     vmCachePut(grammar, symbol, code);
     oop     env  = nil;
     int     ppc  = 0;
@@ -4926,11 +4933,13 @@ int vmRun(oop grammar, oop symbol, char *text, int start, int length)
 
     vmInsn *code = vmCacheGet(grammar, symbol);
 
+    int maxactions = 32;
+
     struct Action {
         void (*function)(vmState *state, oop object, char *yytext, int yyleng);
         oop    object;
         int    textbeg, textlen;
-    } *actions = 0;
+    } *actions = xcalloc(maxactions, sizeof(*actions));
 
     struct Context { // for back-tracking
         int position;
@@ -4938,14 +4947,15 @@ int vmRun(oop grammar, oop symbol, char *text, int start, int length)
     } *cstack, context;
 
     int csp = 0, ncstack = 32;
-    cstack = malloc(sizeof(*cstack) * ncstack);
+    cstack = xmalloc(sizeof(*cstack) * ncstack);
     context.position = start;
     context.nactions = 0;
 
     vmState state = VM_STATE_INITIALISER;
 
 # define saveAction(ACT, OBJ, BEG, LEN) {                                       \
-        actions = realloc(actions, sizeof(*actions) * (context.nactions + 1));  \
+        if (context.nactions >= maxactions)                                     \
+            actions = xrealloc(actions, sizeof(*actions) * (maxactions *= 2));  \
         actions[context.nactions++] = (struct Action){ ACT, OBJ, BEG, LEN };    \
     }
 
@@ -4957,7 +4967,7 @@ int vmRun(oop grammar, oop symbol, char *text, int start, int length)
     } *rstack, frame;
 
     int rsp = 0, nrstack = 32;
-    rstack = malloc(sizeof(*rstack) * nrstack);
+    rstack = xmalloc(sizeof(*rstack) * nrstack);
     frame.symbol   = symbol;
     frame.code     = vmCacheGet(grammar, symbol);
     frame.pc       = 0;
@@ -4968,7 +4978,7 @@ int vmRun(oop grammar, oop symbol, char *text, int start, int length)
     int result = 0;
 
 #define push(C, X) {                                                                                    \
-        if (C##sp >= n##C##stack) C##stack = realloc(C##stack, sizeof(*C##stack) * (n##C##stack *= 2)); \
+        if (C##sp >= n##C##stack) C##stack = xrealloc(C##stack, sizeof(*C##stack) * (n##C##stack *= 2)); \
         C##stack[C##sp++] = (X);                                                                        \
     }
 
@@ -5111,8 +5121,8 @@ int vmRun(oop grammar, oop symbol, char *text, int start, int length)
 #undef drop
 #undef push
 
-    free(cstack);
-    free(rstack);
+    xfree(cstack);
+    xfree(rstack);
 
     for (int i = 0;  i < context.nactions;  ++i) {
         char *yytext = text + actions[i].textbeg;