ソースを参照

handle recursive structures, loading and storing pointers to structures in members

master
Ian Piumarta 3ヶ月前
コミット
e6bf046263
1個のファイルの変更177行の追加93行の削除
  1. +177
    -93
      main.leg

+ 177
- 93
main.leg ファイルの表示

@ -1,6 +1,6 @@
# main.leg -- C parser + interpreter
#
# Last edited: 2025-01-31 15:07:48 by piumarta on xubuntu
# Last edited: 2025-02-01 08:55:52 by piumarta on xubuntu
%{
;
@ -192,8 +192,6 @@ oop false = 0;
oop true = 0;
#define isNil(O) (nil == (O))
#define isFalse(O) (false == (O))
#define isTrue(O) (true == (O))
oop _new(size_t size, type_t type)
{
@ -1264,7 +1262,7 @@ oop toStringOn(oop obj, oop str)
oop tag = get(obj, Tstruct,tag);
oop members = get(obj, Tstruct,members);
if (nil != tag) String_format(str, " %s", symbolName(tag));
if (nil != members) {
else if (nil != members) {
String_format(str, " {");
List_do(members, vdecls) toStringOn(vdecls, str);
String_format(str, "}");
@ -1566,7 +1564,8 @@ void printiln(oop obj, int indent)
case Tstruct: {
printf("Tstruct\n");
printiln(get(obj, Tstruct,tag ), indent+1);
printiln(get(obj, Tstruct,members), indent+1);
if (indent < 1)
printiln(get(obj, Tstruct,members), indent+1);
break;
}
case Tfunction: {
@ -1601,7 +1600,7 @@ void printiln(oop obj, int indent)
break;
}
case Variable: {
printf("Variable %s\n", toString(obj));
printf("VARIABLE\n");
printiln(get(obj, Variable,name ), indent+1);
printiln(get(obj, Variable,type ), indent+1);
printiln(get(obj, Variable,value), indent+1);
@ -1876,6 +1875,7 @@ postfix = v:value ( a:args { v = newCall(v, a) }
| PPLUS { v = newUnary(POSTINC, v) }
| MMINUS { v = newUnary(POSTDEC, v) }
| DOT i:id { v = newMember(v, i) }
| ARROW i:id { v = newMember(newDereference(v), i) }
)* { $$ = v }
args = LPAREN a:mkList
@ -1969,6 +1969,7 @@ RETURN = "return" ![_a-zA-Z0-9] -
CONTINU = "continue" ![_a-zA-Z0-9] -
BREAK = "break" ![_a-zA-Z0-9] -
DOT = "." !"." -
ARROW = "->" -
ETC = "..." -
HASH = "#" -
ASSIGN = "=" !"=" -
@ -2209,7 +2210,15 @@ int typeSize(oop type)
case Tfloat: return 4;
case Tdouble: return 8;
case Tpointer: return 8; // fixme: make this a parameter
case Tstruct: assert(!"unimplemented");
case Tstruct: {
int size = get(type, Tstruct,size);
if (size < 0) {
oop tag = get(type, Tstruct,tag);
fatal("cannot determine size of incomplete struct type '%s'",
isNil(tag) ? "<anonymous>" : symbolName(tag));
}
return size;
}
case Tarray: {
oop target = get(type, Tarray,target);
if (isNil(target)) fatal("cannot determine size of incomplete array type (unknown element type)");
@ -2226,14 +2235,25 @@ int typeSize(oop type)
int toBoolean(oop arg)
{
switch (getType(arg)) {
case Integer: return _integerValue(arg);
case Float: return integerValue(arg);
case Integer: return !!_integerValue(arg);
case Float: return !! integerValue(arg);
case Reference: return 1;
case Pointer: {
oop base = get(arg, Pointer,base);
switch (getType(base)) {
case Integer: return !!_integerValue(base);
case Memory: return !!get(base, Memory,base);
default: fatal("cannot convert pointer base %s to boolean", getTypeName(base));
}
}
default: fatal("cannot convert %s to boolean", getTypeName(arg));
}
return 0;
}
#define isTrue(O) ( toBoolean(O))
#define isFalse(O) (!toBoolean(O))
oop pointerType(oop arg)
{
switch (getType(arg)) {
@ -2447,10 +2467,11 @@ void declareTag(oop type)
List_do(decls, decl) {
oop mtype = makeType(vtype, decl);
oop mname = makeName(decl);
int msize = typeSize(vtype);
int msize = typeSize(mtype);
int fragment = offset % msize;
if (fragment) offset += msize - fragment;
List_append(vars, newVariable(mname, mtype, newInteger(offset)));
oop var = newVariable(mname, mtype, newInteger(offset));
List_append(vars, var);
offset += msize;
}
}
@ -2662,7 +2683,7 @@ oop typeCheck(oop exp, oop fntype)
Scope_begin();
typeCheck(init, fntype);
cond = typeCheck(cond, fntype);
if (t_int != cond) fatal("for condition is not 'int'");
if (t_int != cond && !is(Tpointer, cond)) fatal("for condition is not 'int' or '*'");
typeCheck(step, fntype);
typeCheck(body, fntype);
Scope_end();
@ -2896,10 +2917,12 @@ oop typeCheck(oop exp, oop fntype)
}
default: {
oop initype = typeCheck(init, fntype);
if (is(Tpointer, vartype) && is(Integer,init) && !_integerValue(init))
break;
cvt_t cvt = converter(getType(initype), getType(vartype));
if (!cvt) {
fatal("initialising '%s': cannot convert '%s' to '%s'",
toString(varname), toString(vartype), toString(initype));
toString(varname), toString(initype), toString(vartype));
}
break;
}
@ -2970,13 +2993,18 @@ oop getPointer(oop ptr)
case Tlong: return newInteger(*(long *)addr);
case Tfloat: return newFloat (*(float *)addr);
case Tdouble: return newFloat (*(double *)addr);
default: break;
case Tstruct: return newStruct(type, base);
default:
println(ptr);
fatal("cannot load '%s' from memory pointer", getTypeName(type));
break;
}
break;
}
default:
break;
}
println(ptr);
fatal("cannot load '%s' through pointer", getTypeName(type));
return 0;
}
@ -3019,6 +3047,15 @@ oop getMemory(oop memory, int offset, oop type)
case Tlong: return newInteger(*(long *)addr);
case Tfloat: return newFloat (*(float *)addr);
case Tdouble: return newFloat (*(double *)addr);
case Tpointer: {
void *value = *(void **)addr;
oop target = get(type, Tpointer,target);
switch (getType(target)) {
case Tstruct: return newPointer(type, newMemory(value, typeSize(target)), 0);
default: break;
}
fatal("cannot load pointer to '%s' from memory", getTypeName(target));
}
default: break;
}
fatal("cannot load '%s' from memory", getTypeName(type));
@ -3039,6 +3076,30 @@ oop setMemory(oop memory, int offset, oop type, oop value)
case Tlong: return newInteger(*(long *)addr = _integerValue(value));
case Tfloat: return newFloat (*(float *)addr = _floatValue(value));
case Tdouble: return newFloat (*(double *)addr = _floatValue(value));
case Tpointer: {
switch (getType(value)) {
case Integer: {
*(void **)addr = (void *)(intptr_t)_integerValue(value);
return newPointer(type, value, 0);
}
case Pointer: {
oop base = get(value, Pointer,base);
switch (getType(base)) {
case Memory: {
*(void **)addr = get(base, Memory,base);
return value;
}
default: break;
}
println(base);
assert(0);
}
default: {
println(value);
fatal("cannot store '%s' into memory", getTypeName(type));
}
}
}
default: break;
}
fatal("cannot store '%s' into memory", getTypeName(type));
@ -3343,38 +3404,42 @@ void initialiseVariable(oop var, int local)
oop eval(oop exp)
{
if (opt_v > 2) { printf("EVAL "); println(exp); }
static int depth = 0;
# define ENTER ++depth
# define RETURN(X) do { --depth; return (X); } while (0)
if (opt_v > 2) { printf("EVAL "); printiln(exp, depth); }
ENTER;
switch (getType(exp)) {
case Undefined: assert(!"this cannot happen");
case Input: assert(!"this cannot happen");
case Integer: return exp;
case Float: return exp;
case Pointer: return exp;
case Array: return exp;
case Struct: return exp;
case Integer: RETURN(exp);
case Float: RETURN(exp);
case Pointer: RETURN(exp);
case Array: RETURN(exp);
case Struct: RETURN(exp);
case Symbol: {
oop value = Scope_lookup(exp);
if (!value) fatal("'%s' is undefined\n", get(exp, Symbol,name));
if (isNil(value)) fatal("'%s' is uninitialised\n", get(exp, Symbol,name));
switch (getType(value)) {
case Variable: return get(value, Variable,value);
case Function: return value;
case Primitive: return value;
case Variable: RETURN(get(value, Variable,value));
case Function: RETURN(value);
case Primitive: RETURN(value);
default: fatal("cannot eval: %s", toString(value));
}
break;
}
case Pair: assert(!"this cannot happen");
case String: return exp;
case String: RETURN(exp);
case List: assert(!"this cannot happen");
case Memory: assert(!"this cannot happen");
case Primitive: return exp;
case Reference: return exp;
case Closure: return exp;
case Primitive: RETURN(exp);
case Reference: RETURN(exp);
case Closure: RETURN(exp);
case Call: {
oop fun = eval(get(exp, Call,function));
oop args = get(exp, Call,arguments);
return apply(fun, args, nil);
RETURN(apply(fun, args, nil));
}
case Block: {
Object *stmts = get(exp, Block,statements);
@ -3384,16 +3449,16 @@ oop eval(oop exp)
Scope_begin();
switch (nlrPush()) { // longjmp occurred
case NLR_INIT: break;
case NLR_RETURN: Scope_end(); return nlrPop();
case NLR_CONTINUE: Scope_end(); nlrReturn(NLR_CONTINUE, nlrPop());
case NLR_BREAK: Scope_end(); nlrReturn(NLR_BREAK, nlrPop());
case NLR_RETURN: Scope_end(); --depth; nlrReturn(NLR_RETURN, nlrPop());
case NLR_CONTINUE: Scope_end(); --depth; nlrReturn(NLR_CONTINUE, nlrPop());
case NLR_BREAK: Scope_end(); --depth; nlrReturn(NLR_BREAK, nlrPop());
}
for (int i = 0; i < size; ++i) {
result = eval(elts[i]);
}
Scope_end();
nlrPop();
return result;
RETURN(result);
}
case Addressof: {
oop rhs = get(exp, Addressof,rhs);
@ -3404,8 +3469,8 @@ oop eval(oop exp)
switch (getType(rhs)) {
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);
if (is(Tarray,type)) RETURN(get(rhs, Variable,value));
RETURN(newPointer(newTpointer(get(rhs, Variable,type)), rhs, 0));
}
default:
break;
@ -3421,7 +3486,7 @@ oop eval(oop exp)
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);
RETURN(newPointer(newTpointer(get(type, Tarray,target)), base, index));
}
default: break;
}
@ -3439,7 +3504,7 @@ oop eval(oop exp)
oop rhs = get(exp, Dereference,rhs);
rhs = eval(rhs);
switch (getType(rhs)) {
case Pointer: return getPointer(rhs);
case Pointer: RETURN(getPointer(rhs));
default: break;
}
println(rhs);
@ -3448,7 +3513,7 @@ oop eval(oop exp)
break;
}
case Sizeof: {
return get(exp, Sizeof,size);
RETURN(get(exp, Sizeof,size));
}
case Unary: {
unary_t op = get(exp, Unary,operator);
@ -3472,7 +3537,7 @@ oop eval(oop exp)
default: assert("!this cannot happen");
}
set(rhs, Variable,value, value);
return result;
RETURN(result);
}
default: break;
}
@ -3484,11 +3549,11 @@ oop eval(oop exp)
case COM: {
rhs = eval(rhs);
switch (op) {
case NEG: return ( is(Float, rhs)
? newFloat (-floatValue (rhs))
: newInteger(-integerValue(rhs)) );
case NOT: return isFalse(rhs) ? true : false;
case COM: return newInteger(~integerValue(rhs));
case NEG: RETURN( is(Float, rhs)
? newFloat (-floatValue (rhs))
: newInteger(-integerValue(rhs)) );
case NOT: RETURN(isFalse(rhs) ? true : false);
case COM: RETURN(newInteger(~integerValue(rhs)));
default: break;
}
}
@ -3500,29 +3565,29 @@ oop eval(oop exp)
oop lhs = get(exp, Binary,lhs);
oop rhs = get(exp, Binary,rhs);
switch (get(exp, Binary,operator)) {
case LAND: return isFalse(eval(lhs)) ? false : eval(rhs);
case LOR: return isTrue (eval(lhs)) ? true : eval(rhs);
case LAND: RETURN(isFalse(eval(lhs)) ? false : eval(rhs));
case LOR: RETURN(isTrue (eval(lhs)) ? true : eval(rhs));
default: {
lhs = eval(lhs);
rhs = eval(rhs);
if (Float == getType(lhs) || Float == getType(rhs)) { // floating point result
switch (get(exp, Binary,operator)) {
case MUL: return FBINOP(lhs, * , rhs);
case DIV: return FBINOP(lhs, / , rhs);
case MOD: return newFloat(fmod(floatValue(lhs), floatValue(rhs)));
case ADD: return FBINOP(lhs, + , rhs);
case SUB: return FBINOP(lhs, - , rhs);
case SHL: return IBINOP(lhs, <<, rhs);
case SHR: return IBINOP(lhs, >>, rhs);
case LT: return FRELOP(lhs, < , rhs);
case LE: return FRELOP(lhs, <=, rhs);
case GE: return FRELOP(lhs, >=, rhs);
case GT: return FRELOP(lhs, > , rhs);
case EQ: return FRELOP(lhs, == , rhs);
case NE: return FRELOP(lhs, !=, rhs);
case BAND: return IBINOP(lhs, & , rhs);
case BXOR: return IBINOP(lhs, ^ , rhs);
case BOR: return IBINOP(lhs, | , rhs);
case MUL: RETURN(FBINOP(lhs, * , rhs));
case DIV: RETURN(FBINOP(lhs, / , rhs));
case MOD: RETURN(newFloat(fmod(floatValue(lhs), floatValue(rhs))));
case ADD: RETURN(FBINOP(lhs, + , rhs));
case SUB: RETURN(FBINOP(lhs, - , rhs));
case SHL: RETURN(IBINOP(lhs, <<, rhs));
case SHR: RETURN(IBINOP(lhs, >>, rhs));
case LT: RETURN(FRELOP(lhs, < , rhs));
case LE: RETURN(FRELOP(lhs, <=, rhs));
case GE: RETURN(FRELOP(lhs, >=, rhs));
case GT: RETURN(FRELOP(lhs, > , rhs));
case EQ: RETURN(FRELOP(lhs, == , rhs));
case NE: RETURN(FRELOP(lhs, !=, rhs));
case BAND: RETURN(IBINOP(lhs, & , rhs));
case BXOR: RETURN(IBINOP(lhs, ^ , rhs));
case BOR: RETURN(IBINOP(lhs, | , rhs));
case LAND:
case LOR:
break;
@ -3530,36 +3595,36 @@ oop eval(oop exp)
}
else { // non-float result
switch (get(exp, Binary,operator)) {
case MUL: return IBINOP(lhs, * , rhs);
case DIV: return IBINOP(lhs, / , rhs);
case MOD: return IBINOP(lhs, % , rhs);
case MUL: RETURN(IBINOP(lhs, * , rhs));
case DIV: RETURN(IBINOP(lhs, / , rhs));
case MOD: RETURN(IBINOP(lhs, % , rhs));
case ADD: {
if (is(Pointer, lhs) && is(Integer, rhs)) {
oop type = get(lhs, Pointer,type);
oop base = get(lhs, Pointer,base);
int offset = get(lhs, Pointer,offset);
offset += _integerValue(rhs);
return newPointer(type, base, offset);
RETURN(newPointer(type, base, offset));
}
if (is(Array, lhs) && is(Integer, rhs)) {
oop type = newTpointer(get(get(lhs, Array,type), Tarray,target));
oop ptr = newPointer(type, get(lhs, Array,base), _integerValue(rhs));
return ptr;
RETURN(ptr);
}
return IBINOP(lhs, + , rhs);
RETURN(IBINOP(lhs, + , rhs));
}
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 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);
case BXOR: return IBINOP(lhs, ^ , rhs);
case BOR: return IBINOP(lhs, | , rhs);
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(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));
case BXOR: RETURN(IBINOP(lhs, ^ , rhs));
case BOR: RETURN(IBINOP(lhs, | , rhs));
case LAND:
case LOR:
break;
@ -3576,7 +3641,7 @@ oop eval(oop exp)
int index = _integerValue(ondex);
oop lhs = eval(get(exp, Index,lhs));
switch (getType(lhs)) {
case Array: return getArray(lhs, index);
case Array: RETURN(getArray(lhs, index));
default: break;
}
println(lhs);
@ -3614,15 +3679,28 @@ oop eval(oop exp)
int offset = _integerValue(value);
int vsize = typeSize(vtype);
assert(offset + vsize <= size);
return getMemory(memory, offset, vtype);
RETURN(getMemory(memory, offset, vtype));
}
case Assign: {
return assign(get(exp, Assign,lhs), eval(get(exp, Assign,rhs)));
RETURN(assign(get(exp, Assign,lhs), eval(get(exp, Assign,rhs))));
}
case Cast: {
cvt_t cvt = get(exp, Cast,converter); assert(cvt);
oop type = get(exp, Cast,type);
oop rhs = eval(get(exp, Cast,rhs));
return cvt(rhs);
rhs = cvt(rhs);
switch (getType(type)) {
case Tpointer: {
if (is(Pointer,rhs)) {
int offset = get(rhs, Pointer,offset);
int rscale = typeSize(get(get(rhs, Pointer,type), Tpointer,target));
int lscale = typeSize(get(type, Tpointer,target));
offset = offset * lscale / rscale;
RETURN(newPointer(type, get(rhs, Pointer,base), get(rhs, Pointer,offset)));
}
}
}
RETURN(cvt(rhs));
}
case While: {
oop cond = get(exp, While,condition);
@ -3630,15 +3708,15 @@ oop eval(oop exp)
oop result = nil;
switch (nlrPush()) {
case NLR_INIT: break;
case NLR_RETURN: nlrReturn(NLR_RETURN, nlrPop()); // propagate upwards
case NLR_RETURN: --depth; nlrReturn(NLR_RETURN, nlrPop()); // propagate upwards
case NLR_CONTINUE: break;
case NLR_BREAK: return nlrPop();
case NLR_BREAK: --depth; return nlrPop();
}
while (isTrue(eval(cond))) {
result = eval(expr);
}
nlrPop();
return result;
RETURN(result);
}
case For: {
oop init = get(exp, For,initialiser);
@ -3648,19 +3726,20 @@ oop eval(oop exp)
Scope_begin();
switch (nlrPush()) {
case NLR_INIT: break;
case NLR_RETURN: nlrReturn(NLR_RETURN, nlrPop());
case NLR_RETURN: --depth; Scope_end(); nlrReturn(NLR_RETURN, nlrPop());
case NLR_CONTINUE: goto continued;
case NLR_BREAK: goto broken;
}
eval(init);
while (integerValue(eval(cond))) {
while (isTrue(eval(cond))) {
eval(body);
continued:
eval(step);
}
broken:
Scope_end();
return nil;
nlrPop();
RETURN(nil);
}
case If: {
oop cond = get(exp, If,condition);
@ -3668,17 +3747,20 @@ oop eval(oop exp)
oop altern = get(exp, If,alternate);
if (isTrue(eval(cond))) eval(conseq);
else if (!isNil(altern)) eval(altern);
return nil;
RETURN(nil);
}
case Return: {
--depth;
nlrReturn(NLR_RETURN, eval(get(exp, Return,value)));
break;
}
case Continue: {
--depth;
nlrReturn(NLR_CONTINUE, nil);
break;
}
case Break: {
--depth;
nlrReturn(NLR_BREAK, nil);
break;
}
@ -3702,7 +3784,7 @@ oop eval(oop exp)
declare(name, var);
initialiseVariable(var, 1);
}
return nil;
RETURN(nil);
}
case TypeDecls: {
oop types = get(exp, TypeDecls,typenames);
@ -3711,7 +3793,7 @@ oop eval(oop exp)
oop type = get(type, TypeName,type);
declareType(name, type);
}
return nil;
RETURN(nil);
}
case Scope: break;
case TypeName: break;
@ -3721,7 +3803,9 @@ oop eval(oop exp)
}
println(exp);
assert(!"this cannot happen");
return 0;
RETURN(0);
# undef ENTER
# undef LEAVE
}
// pre-evaluate a top-level declaration, definition, or constant expression

読み込み中…
キャンセル
保存