MaximeBarniaudy
/
minproto
geforked van piumarta/minproto
1
0
Vork 0
Code Kwesties 0 Pull-aanvragen 0 Publicaties 0 Wiki Activiteit
Bladeren bron

Binary operators store pointer to implementation to avoid operator selection during eval.

master
Ian Piumarta 1 jaar geleden
bovenliggende
2f164a3100
commit
057733b85f
1 gewijzigde bestanden met toevoegingen van 195 en 38 verwijderingen
Zij-aan-zij weergave
Diff opties
Statistieken weergeven Download Patch-bestand Download Diff-bestand
  1. +195
    -38
      minproto.leg

+ 195
- 38
minproto.leg Bestand weergeven

@ -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)

Schrijf Voorbeeld
Laden…
Annuleren
Opslaan