|
|
@ -1,6 +1,6 @@ |
|
|
|
# main.leg -- C parser + interpreter |
|
|
|
# |
|
|
|
# Last edited: 2025-01-29 16:00:13 by piumarta on xubuntu |
|
|
|
# Last edited: 2025-01-29 18:13:39 by piumarta on zora |
|
|
|
|
|
|
|
%{ |
|
|
|
; |
|
|
@ -98,8 +98,8 @@ char *binaryName(int op) { |
|
|
|
|
|
|
|
#undef _ |
|
|
|
|
|
|
|
#define _do_primitives(_) \ |
|
|
|
_(printf) _(assert) _(malloc) _(free) |
|
|
|
#define _do_primitives(_) \ |
|
|
|
_(printf) _(assert) _(malloc) _(free) _(exit) _(abort) |
|
|
|
|
|
|
|
#define _(X) oop s_##X = 0; |
|
|
|
_do_primitives(_) |
|
|
@ -2310,6 +2310,22 @@ oop prim_free(int argc, oop *argv, oop env) // array |
|
|
|
return nil; |
|
|
|
} |
|
|
|
|
|
|
|
oop prim_exit(int argc, oop *argv, oop env) // array |
|
|
|
{ |
|
|
|
if (argc != 1) fatal("exit: wrong number of arguments"); |
|
|
|
oop arg = argv[0]; |
|
|
|
if (!is(Integer,arg)) fatal("exit: argument is not an integer"); |
|
|
|
exit(_integerValue(arg)); |
|
|
|
return nil; |
|
|
|
} |
|
|
|
|
|
|
|
oop prim_abort(int argc, oop *argv, oop env) // array |
|
|
|
{ |
|
|
|
if (argc != 0) fatal("abort: wrong number of arguments"); |
|
|
|
abort(); |
|
|
|
return nil; |
|
|
|
} |
|
|
|
|
|
|
|
oop typeCheck(oop exp, oop fntype) |
|
|
|
{ |
|
|
|
switch (getType(exp)) { |
|
|
@ -2903,18 +2919,24 @@ int equal(oop a, oop b) |
|
|
|
} |
|
|
|
fatal("cannot compare %ss", getTypeName(a)); |
|
|
|
} |
|
|
|
else { |
|
|
|
if (is(Pointer, a) && is(Integer, b)) { |
|
|
|
oop base = get(a, Pointer,base); |
|
|
|
if (is(Integer, base)) { |
|
|
|
oop type = get(a, Pointer,type); |
|
|
|
int offset = get(a, Pointer,offset); |
|
|
|
int scale = typeSize(get(type, Tpointer,target)); |
|
|
|
return _integerValue(base) + offset * scale == _integerValue(b); |
|
|
|
} |
|
|
|
return 0; |
|
|
|
} |
|
|
|
if (is(Pointer, a) && is(Integer, b)) { |
|
|
|
oop base = get(a, Pointer,base); |
|
|
|
if (is(Integer, base)) { |
|
|
|
oop type = get(a, Pointer,type); |
|
|
|
int offset = get(a, Pointer,offset); |
|
|
|
int scale = typeSize(get(type, Tpointer,target)); |
|
|
|
return _integerValue(base) + offset * scale == _integerValue(b); |
|
|
|
} |
|
|
|
return 0; |
|
|
|
} |
|
|
|
|
|
|
|
if (is(Array, a) && is(Pointer, b)) { |
|
|
|
oop ba = get(a, Array,base), bb = get(b, Pointer,base); |
|
|
|
return (ba == bb) && (get(b, Pointer,offset) == 0); |
|
|
|
} |
|
|
|
|
|
|
|
if (is(Pointer, a) && is(Array, b)) return equal(b, a); |
|
|
|
|
|
|
|
fatal("cannot compare %s with %s", getTypeName(a), getTypeName(b)); |
|
|
|
return 0; |
|
|
|
} |
|
|
@ -3015,13 +3037,33 @@ oop eval(oop exp, oop env) |
|
|
|
rhs = Scope_lookup(rhs); |
|
|
|
if (!rhs) assert(!"this cannot happen"); |
|
|
|
switch (getType(rhs)) { |
|
|
|
case Variable: |
|
|
|
case Variable: { |
|
|
|
oop type = get(rhs, Variable,type); |
|
|
|
if (is(Tarray,type)) return get(rhs, Variable,value); |
|
|
|
return newPointer(newTpointer(get(rhs, Variable,type)), rhs, 0); |
|
|
|
} |
|
|
|
default: |
|
|
|
break; |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
case Index: { |
|
|
|
oop ondex = eval(get(rhs, Index,rhs), nil); |
|
|
|
if (!is(Integer, ondex)) fatal("array index is not 'int'"); |
|
|
|
int index = _integerValue(ondex); |
|
|
|
oop lhs = eval(get(rhs, Index,lhs), nil); |
|
|
|
switch (getType(lhs)) { |
|
|
|
case Array: { |
|
|
|
oop type = get(lhs, Array,type); |
|
|
|
oop base = get(lhs, Array,base); // xxx check index against size |
|
|
|
return newPointer(newTpointer(get(type, Tarray,target)), base, index); |
|
|
|
} |
|
|
|
default: break; |
|
|
|
} |
|
|
|
println(lhs); |
|
|
|
fatal("cannot take address"); |
|
|
|
break; |
|
|
|
} |
|
|
|
default: |
|
|
|
break; |
|
|
|
} |
|
|
@ -3144,10 +3186,10 @@ oop eval(oop exp, oop env) |
|
|
|
case SUB: return IBINOP(lhs, - , rhs); |
|
|
|
case SHL: return IBINOP(lhs, <<, rhs); |
|
|
|
case SHR: return IBINOP(lhs, >>, rhs); |
|
|
|
case LT: return compare(lhs, rhs) < 0 ? true : false; |
|
|
|
case LE: return IRELOP(lhs, <=, rhs); |
|
|
|
case GE: return IRELOP(lhs, >=, rhs); |
|
|
|
case GT: return IRELOP(lhs, > , rhs); |
|
|
|
case LT: return compare(lhs, rhs) < 0 ? true : false; |
|
|
|
case LE: return compare(lhs, rhs) <= 0 ? true : false; |
|
|
|
case GE: return compare(lhs, rhs) >= 0 ? true : false; |
|
|
|
case GT: return compare(lhs, rhs) > 0 ? true : false; |
|
|
|
case EQ: return equal(lhs, rhs) ? true : false; |
|
|
|
case NE: return equal(lhs, rhs) ? false : true; |
|
|
|
case BAND: return IBINOP(lhs, & , rhs); |
|
|
|