diff --git a/minproto.leg b/minproto.leg index 2b4713f..b10d7ec 100644 --- a/minproto.leg +++ b/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 +# 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, ""); + 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;