diff --git a/minproto.leg b/minproto.leg index 0c2be62..538fee4 100644 --- a/minproto.leg +++ b/minproto.leg @@ -1,6 +1,6 @@ # minproto.leg -- minimal prototype langauge for semantic experiments # -# last edited: 2024-05-14 05:13:24 by piumarta on m1mbp +# last edited: 2024-05-14 06:33:02 by piumarta on m1mbp %{ ; @@ -24,6 +24,10 @@ # define DELOPT 0 // (approx. 60% performance increase, because no associative lookup of __delegate__) #endif +#ifndef BINOPT // store pointer to implemention function in Binop nodes +# define BINOPT 0 // (approx. 1% performance decrease due to lookup + indirect call) +#endif + #ifndef NONLOCAL // support non-local control flow (return, break, continue) # define NONLOCAL 1 // (approx. 5% [loop] to 55% [call] performance decrease, because of jmp_buf initialisations) #endif @@ -117,7 +121,7 @@ enum typecode { doTypes(makeProto); #undef makeProto -#define doProperties(_) _(name) _(eval) _(delegate) _(codeon) +#define doProperties(_) _(name) _(eval) _(delegate) _(codeon) _(function) #define declareProp(NAME) oop prop_##NAME = 0; doProperties(declareProp); @@ -1140,7 +1144,7 @@ oop newRefVar(oop name) return o; } -extern inline oop mkptr(oop *address) +extern inline oop mkptr(void *address) { // top 7 bits of virtual addresses are guaranteed to be the same, // at least until Apple decides to break that and call it a "feature" @@ -1603,24 +1607,24 @@ void Closure_codeOn(oop exp, oop str, oop env) #endif // !PRIMCLOSURE -#define doBinops(_) \ - _(opLogOr, ||) \ - _(opLogAnd, &&) \ - _(opBitOr, |) \ - _(opBitXor, ^) \ - _(opBitAnd, &) \ - _(opEq, ==) _(opNotEq, !=) \ - _(opLess, < ) _(opLessEq, <=) _(opGrtr, >=) _(opGrtrEq, > ) \ - _(opShl, <<) _(opShr, >>) \ - _(opAdd, +) _(opSub, -) \ - _(opMul, *) _(opDiv, /) _(opMod, %) \ - _(opPostAdd, ++) _(opPostDec, --) \ - _(opPreOr, |=) _(opPreXor, ^=) _(opPreAnd, &=) \ - _(opPreShl, >>=) _(opPreShr, <<=) \ - _(opPreAdd, +=) _(opPreSub, -=) \ - _(opPreMul, *=) _(opPreDiv, /=) _(opPreMod, %=) - -#define defineBinop(NAME, OP) NAME, +#define doBinops(_) \ + _(LogOr, ||) \ + _(LogAnd, &&) \ + _(BitOr, |) \ + _(BitXor, ^) \ + _(BitAnd, &) \ + _(Eq, ==) _(NotEq, !=) \ + _(Less, < ) _(LessEq, <=) _(Grtr, >=) _(GrtrEq, > ) \ + _(Shl, <<) _(Shr, >>) \ + _(Add, +) _(Sub, -) \ + _(Mul, *) _(Div, /) _(Mod, %) \ + _(PostAdd, ++) _(PostDec, --) \ + _(PreOr, |=) _(PreXor, ^=) _(PreAnd, &=) \ + _(PreShl, >>=) _(PreShr, <<=) \ + _(PreAdd, +=) _(PreSub, -=) \ + _(PreMul, *=) _(PreDiv, /=) _(PreMod, %=) + +#define defineBinop(NAME, OP) op##NAME, enum binop { doBinops(defineBinop) }; @@ -1632,15 +1636,46 @@ char *binopNames[] = { }; #undef nameBinop -oop newBinop(int operation, oop lhs, oop rhs) +#if BINOPT + +typedef oop (*binop_t)(oop lhs, oop rhs); + +#define declBinop(NAME, OP) oop bin##NAME(oop, oop); +doBinops(declBinop) +#undef declBinop + +#define implBinop(NAME, OP) bin##NAME, +binop_t binops[] = { + doBinops(implBinop) +}; +#undef implBinop + +#endif // BINOPT + +oop newBinop(enum binop operation, oop lhs, oop rhs) { oop o = new(pBinop); Object_put(o, sym_operation, newInteger(operation)); +# if BINOPT + Object_put(o, prop_function, mkptr(binops[operation])); +# endif Object_push(o, lhs); Object_push(o, rhs); return o; } +#define binop(NAME, OP) \ + oop NAME(oop lhs, oop rhs) \ + { \ + return newInteger(integerValue(lhs, #OP) OP integerValue(rhs, #OP)); \ + } + +binop(binBitOr, |); +binop(binBitXor, ^); +binop(binBitAnd, &); + +#undef binop + intptr_t cmp(oop l, oop r, char *who) { int tl = getType(l), tr = getType(r); @@ -1655,7 +1690,127 @@ intptr_t cmp(oop l, oop r, char *who) return (intptr_t)l - (intptr_t)r; } -oop shl(oop l, oop r) +#define newBoolean(TF) ((TF) ? sym_t : nil) + +#define binop(NAME, OP) \ + oop NAME(oop lhs, oop rhs) \ + { \ + return newBoolean(cmp(lhs, rhs, #OP) OP 0); \ + } + +binop(binEq, ==); +binop(binNotEq, !=); +binop(binLess, < ); +binop(binLessEq, <=); +binop(binGrtrEq, >=); +binop(binGrtr, > ); + +#undef binop + +oop binLogOr (oop lhs, oop rhs) { abort(); return 0; } +oop binLogAnd(oop lhs, oop rhs) { abort(); return 0; } + +oop binPostAdd(oop lhs, oop rhs) +{ assert(isInteger(lhs)); // lval ref + oop *ref = (oop *)(intptr_t)_integerValue(lhs); assert(isInteger(rhs)); // X++ -> X+=1 + oop value = *ref; + int amount = _integerValue(rhs); + switch (getType(value)) { + case Integer: *ref = newInteger(_integerValue(value) + amount); break; + case Float: *ref = newFloat (_floatValue (value) + amount); break; + default: fatal("++: non-numeric argument"); + } + return value; +} + +oop binPostDec(oop lhs, oop rhs) +{ assert(isInteger(lhs)); // lval ref + oop *ref = (oop *)(intptr_t)_integerValue(lhs); assert(isInteger(rhs)); // X-- -> X-=1 + oop value = *ref; + int amount = _integerValue(rhs); + switch (getType(value)) { + case Integer: *ref = newInteger(_integerValue(value) - amount); break; + case Float: *ref = newFloat (_floatValue (value) - amount); break; + default: fatal("++: non-numeric argument"); + } + return value; +} + +#define binop(NAME, OP) \ + oop NAME(oop lhs, oop rhs) \ + { assert(isInteger(lhs)); \ + oop *ref = (oop *)(intptr_t)_integerValue(lhs); assert(isInteger(rhs)); \ + oop val = *ref; \ + if (isInteger(val) && isInteger(rhs)) { \ + long l = _integerValue(val), r = _integerValue(rhs); \ + l OP r; \ + return *ref = newInteger(l); \ + } \ + double l = floatValue(val, #OP); \ + double r = floatValue(rhs, #OP); \ + l OP r; \ + return *ref = newFloat(l); \ + } + +binop(binPreAdd, +=); +binop(binPreSub, -=); +binop(binPreMul, *=); + +#undef binop + +oop binPreDiv(oop lhs, oop rhs) +{ assert(isInteger(lhs)); + oop *ref = (oop *)(intptr_t)_integerValue(lhs); assert(isInteger(rhs)); + oop val = *ref; + if (isInteger(val) && isInteger(rhs)) { + long l = _integerValue(val), r = _integerValue(rhs); + if (!r) fatal("/=: division by zero"); + l /= r; + return *ref = newInteger(l); + } + double l = floatValue(val, "/="); + double r = floatValue(rhs, "/="); + if (!r) fatal("/=: division by zero"); + l /= r; + return *ref = newFloat(l); +} + +oop binPreMod(oop lhs, oop rhs) +{ assert(isInteger(lhs)); + oop *ref = (oop *)(intptr_t)_integerValue(lhs); assert(isInteger(rhs)); + oop val = *ref; + if (isInteger(val) && isInteger(rhs)) { + long l = _integerValue(val), r = _integerValue(rhs); + if (!r) fatal("%%=: division by zero"); + l /= r; + return *ref = newInteger(l); + } + double l = floatValue(val, "%="); + double r = floatValue(rhs, "%="); + if (!r) fatal("%%=: division by zero"); + return *ref = newFloat(fmod(l, r)); +} + +#define binop(NAME, OP) \ + oop NAME(oop lhs, oop rhs) \ + { assert(isInteger(lhs)); \ + oop *ref = (oop *)(intptr_t)_integerValue(lhs); assert(isInteger(rhs)); \ + oop val = *ref; \ + long l = integerValue(val, #OP); \ + long r = integerValue(rhs, #OP); \ + l OP r; \ + return *ref = newInteger(l); \ + } + +binop(binPreOr, |=); +binop(binPreXor, ^=); +binop(binPreAnd, &=); +binop(binPreShl, <<=); +binop(binPreShr, >>=); + +#undef binop + +oop binShl(oop l, oop r) { int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) @@ -1664,7 +1819,7 @@ oop shl(oop l, oop r) return 0; } -oop shr(oop l, oop r) +oop binShr(oop l, oop r) { int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) @@ -1683,13 +1838,13 @@ oop NAME(oop l, oop r) return 0; \ } -binop(add, +); -binop(sub, -); -binop(mul, *); +binop(binAdd, +); +binop(binSub, -); +binop(binMul, *); #undef binop -oop quo(oop l, oop r) +oop binDiv(oop l, oop r) { int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) { @@ -1703,7 +1858,7 @@ oop quo(oop l, oop r) return 0; } -oop rem(oop l, oop r) +oop binMod(oop l, oop r) { int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) return newInteger( _integerValue(l) % _integerValue(r ) ); @@ -1712,8 +1867,6 @@ oop rem(oop l, oop r) return 0; } -#define newBoolean(TF) ((TF) ? sym_t : nil) - oop Binop_eval(oop exp, oop env) { assert(_get(exp, Object,isize) == 2); oop op = Object_get(exp, sym_operation); @@ -1727,6 +1880,9 @@ oop Binop_eval(oop exp, oop env) default: break; } rhs = eval(rhs, env); +# if BINOPT + return (binop_t)_integerValue(Object_get(exp, prop_function))(lhs, rhs); +# else switch (code) { case opLogOr: break; case opLogAnd: break; @@ -1739,13 +1895,13 @@ oop Binop_eval(oop exp, oop env) case opLessEq: return newBoolean(cmp(lhs, rhs, "<=") <= 0); case opGrtrEq: return newBoolean(cmp(lhs, rhs, ">=") >= 0); case opGrtr: return newBoolean(cmp(lhs, rhs, ">" ) > 0); - case opShl: return shl(lhs, rhs); - case opShr: return shr(lhs, rhs); - case opAdd: return add(lhs, rhs); - case opSub: return sub(lhs, rhs); - case opMul: return mul(lhs, rhs); - case opDiv: return quo(lhs, rhs); - case opMod: return rem(lhs, rhs); + case opShl: return binShl(lhs, rhs); + case opShr: return binShr(lhs, rhs); + case opAdd: return binAdd(lhs, rhs); + case opSub: return binSub(lhs, rhs); + case opMul: return binMul(lhs, rhs); + case opDiv: return binDiv(lhs, rhs); + case opMod: return binMod(lhs, rhs); case opPostAdd: case opPostDec: { assert(isInteger(lhs)); // ref oop *ref = (oop *)(intptr_t)_integerValue(lhs); @@ -1819,6 +1975,7 @@ oop Binop_eval(oop exp, oop env) } fatal("illegal binary operation %d", code); return 0; +# endif } void Binop_codeOn(oop exp, oop str, oop env)