diff --git a/main.leg b/main.leg index af8dd72..af69313 100644 --- a/main.leg +++ b/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) ? "" : 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