diff --git a/main.leg b/main.leg index 80752e8..8f43b55 100644 --- a/main.leg +++ b/main.leg @@ -1,6 +1,6 @@ # main.leg -- C parser + interpreter # -# Last edited: 2025-01-30 08:36:36 by piumarta on m1mbp +# Last edited: 2025-01-31 13:17:21 by piumarta on xubuntu %{ ; @@ -31,12 +31,16 @@ void fatal(char *fmt, ...) #if USEGC # include # define MALLOC(N) GC_malloc(N) +# define CALLOC(N,S) GC_malloc((N)*(S)) # define REALLOC(P, N) GC_realloc(P, N) # define FREE(P) GC_free(P) +# define STRDUP(S) GC_strdup(S) #else # define MALLOC(N) malloc(N) +# define CALLOC(N,S) calloc((N), (S)) # define REALLOC(P, N) realloc(P, N) -# define free(P) free(P) +# define FREE(P) free(P) +# define STRDUP(S) strdup(S) #endif #define TAGBITS 2 @@ -56,17 +60,19 @@ typedef union Object Object, *oop; #define YYSTYPE oop -#define _do_types(_) \ - _(Undefined) _(Input) _(Integer) _(Float) _(Pointer) _(Array) _(Symbol) _(Pair) _(String) _(List) \ - _(Memory) _(Reference) _(Closure) _(Call) _(Block) \ - _(Addressof) _(Dereference) _(Sizeof) _(Unary) _(Binary) _(Index) _(Assign) _(Cast) \ - _(While) _(For) _(If) _(Return) _(Continue) _(Break) \ - _(Tvoid) _(Tchar) _(Tshort) _(Tint) _(Tlong) _(Tfloat) _(Tdouble) \ - _(Tpointer) _(Tarray) _(Tstruct) _(Tfunction) _(Tetc) \ - _(Scope) _(TypeName) _(Variable) _(Constant) _(Function) _(Primitive) \ +#define _do_types(_) \ + _(Undefined) _(Input) _(Integer) _(Float) _(Array) _(Symbol) _(Pair) _(String) _(List) \ + _(Pointer) _(Struct) \ + _(Memory) _(Reference) _(Closure) _(Call) _(Block) \ + _(Addressof) _(Dereference) _(Sizeof) _(Unary) \ + _(Binary) _(Index) _(Member) _(Assign) _(Cast) \ + _(While) _(For) _(If) _(Return) _(Continue) _(Break) \ + _(Tvoid) _(Tchar) _(Tshort) _(Tint) _(Tlong) _(Tfloat) _(Tdouble) \ + _(Tpointer) _(Tarray) _(Tstruct) _(Tfunction) _(Tetc) \ + _(Scope) _(TypeName) _(Variable) _(Constant) _(Function) _(Primitive) \ _(VarDecls) _(TypeDecls) -#define _do_unaries(_) \ +#define _do_unaries(_) \ _(NEG) _(NOT) _(COM) _(PREINC) _(PREDEC) _(POSTINC) _(POSTDEC) #define _do_binaries(_) \ @@ -98,8 +104,8 @@ char *binaryName(int op) { #undef _ -#define _do_primitives(_) \ - _(printf) _(assert) _(malloc) _(free) _(exit) _(abort) +#define _do_primitives(_) \ + _(printf) _(assert) _(malloc) _(free) _(exit) _(abort) _(sqrtf) #define _(X) oop s_##X = 0; _do_primitives(_) @@ -115,6 +121,7 @@ struct Integer { type_t _type; long value; }; struct Float { type_t _type; double value; }; struct Pointer { type_t _type; oop type, base; int offset; }; struct Array { type_t _type; oop type, base; int size; }; +struct Struct { type_t _type; oop type, memory; }; struct Symbol { type_t _type; char *name; oop value; }; struct Pair { type_t _type; oop head, tail; }; struct String { type_t _type; int size; char *elements; }; @@ -130,6 +137,7 @@ struct Sizeof { type_t _type; oop rhs, size; }; struct Unary { type_t _type; unary_t operator; oop rhs; }; struct Binary { type_t _type; binary_t operator; oop lhs, rhs; }; struct Index { type_t _type; oop lhs, rhs; }; +struct Member { type_t _type; oop lhs, name; }; struct Assign { type_t _type; oop lhs, rhs; }; struct Cast { type_t _type; oop type, rhs; cvt_t converter; }; struct While { type_t _type; oop condition, expression; }; @@ -148,11 +156,11 @@ struct Tfloat { type_t _type; }; struct Tdouble { type_t _type; }; struct Tpointer { type_t _type; oop target; }; struct Tarray { type_t _type; oop target; oop size; }; -struct Tstruct { type_t _type; oop tag, members; }; +struct Tstruct { type_t _type; oop tag, members; int size; }; struct Tfunction { type_t _type; oop result, parameters; }; struct Tetc { type_t _type; }; -struct Scope { type_t _type; oop names, types, values; }; +struct Scope { type_t _type; oop names, values; }; struct TypeName { type_t _type; oop name, type; }; struct Variable { type_t _type; oop name, type, value; }; struct Constant { type_t _type; oop name, type, value; }; @@ -183,6 +191,10 @@ Object _nil = { ._type = Undefined }; 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) { oop obj = MALLOC(size); @@ -262,6 +274,8 @@ oop newArray(oop type, oop base, int size) return obj; } +CTOR2(Struct, type, memory); + oop newFloat(double value) { # if TAGFLOAT @@ -359,7 +373,7 @@ double floatValue(oop obj) oop newSymbol(char *name) { oop obj = new(Symbol); - obj->Symbol.name = strdup(name); + obj->Symbol.name = STRDUP(name); obj->Symbol.value = nil; return obj; } @@ -423,7 +437,7 @@ oop newString(void) oop newStringWith(char *s) { oop obj = new(String); - obj->String.elements = strdup(s); + obj->String.elements = STRDUP(s); obj->String.size = strlen(s); return obj; } @@ -598,7 +612,7 @@ oop Map_set(oop map, oop key, oop val) if (index > 0) return kvs[index].val = val; index = -1 - index; int last = size++; - kvs = realloc(kvs, sizeof(*kvs) * size); + kvs = REALLOC(kvs, sizeof(*kvs) * size); while (last > index) { kvs[last] = kvs[last - 1]; --last; @@ -655,7 +669,8 @@ oop newBinary(binary_t operator, oop lhs, oop rhs) return obj; } -CTOR2(Index, lhs, rhs); +CTOR2(Index, lhs, rhs); +CTOR2(Member, lhs, name); CTOR2(Assign, lhs, rhs); oop newCast(oop type, oop rhs) @@ -738,11 +753,28 @@ oop newTarray(oop target, oop size) return obj; } +oop tags = 0; + oop newTstruct(oop tag, oop members) { + List_do(tags, t) { + if (tag == get(t, Tstruct,tag)) { + if (!is(Tstruct, t)) + fatal("tag '%s' redeclared as different type", symbolName(tag)); + oop oldmembers = get(t, Tstruct,members); + if (!isNil(oldmembers) && !isNil(members)) { + fatal("tag '%s' redefined", symbolName(tag)); + } + if (isNil(oldmembers) && !isNil(members)) + set(t, Tstruct,members, members); + return t; // uniqe types allow comparison by identity + } + } oop obj = new(Tstruct); obj->Tstruct.tag = tag; obj->Tstruct.members = members; + obj->Tstruct.size = -1; // incomplete type when negative + List_append(tags, obj); return obj; } @@ -777,7 +809,6 @@ oop newScope(void) { oop obj = new(Scope); obj->Scope.names = newList(); - obj->Scope.types = newList(); obj->Scope.values = newList(); return obj; } @@ -957,7 +988,8 @@ oop baseType(oop type) case Tint: case Tlong: case Tfloat: - case Tdouble: return type; + case Tdouble: + case Tstruct: return type; case Tpointer: return baseType(get(type, Tpointer,target)); case Tarray: return baseType(get(type, Tarray,target)); case Tfunction: return baseType(get(type, Tfunction,result)); @@ -998,6 +1030,10 @@ void declareStringOn(oop type, oop name, oop str) String_append(str, ']'); break; } + case Tstruct: { + String_format(str, "struct %s %s", toString(get(type, Tstruct,tag)), symbolName(name)); + break; + } case Tfunction: { declareStringOn(get(type, Tfunction,result), name, str); String_append(str, '('); @@ -1023,7 +1059,6 @@ char *declareString(oop type, oop name) oop toStringOn(oop obj, oop str) { - int n = 0; switch (getType(obj)) { case Undefined: String_appendAll(str, "", 5); @@ -1150,6 +1185,12 @@ oop toStringOn(oop obj, oop str) String_append(str, ']'); break; } + case Member: { + toStringOn(get(obj, Member,lhs), str); + String_append(str, '.'); + toStringOn(get(obj, Member,name), str); + break; + } case Assign: { toStringOn(get(obj, Assign,lhs), str); String_format(str, " = "); @@ -1218,6 +1259,18 @@ oop toStringOn(oop obj, oop str) String_append(str, ']'); break; } + case Tstruct: { + String_format(str, "struct"); + oop tag = get(obj, Tstruct,tag); + oop members = get(obj, Tstruct,members); + if (nil != tag) String_format(str, " %s", symbolName(tag)); + if (nil != members) { + String_format(str, " {"); + List_do(members, vdecls) toStringOn(vdecls, str); + String_format(str, "}"); + } + break; + } case Tfunction: { oop result = get(obj, Tfunction,result); oop params = get(obj, Tfunction,parameters); @@ -1240,7 +1293,10 @@ oop toStringOn(oop obj, oop str) oop name = get(obj, Variable,name); toStringOn(baseType(type), str); String_append(str, ' '); - declareStringOn(type, name, str); + if (nil != name) + declareStringOn(type, name, str); + else + toStringOn(type, str); break; } case Function: { @@ -1262,7 +1318,6 @@ oop toStringOn(oop obj, oop str) } case VarDecls: { oop vars = get(obj, VarDecls,variables); - oop base = get(obj, VarDecls,type); List_do(vars, var) { if (do_index) String_appendAll(str, ", ", 2); toStringOn(var, str); @@ -1271,7 +1326,6 @@ oop toStringOn(oop obj, oop str) } case TypeDecls: { oop types = get(obj, TypeDecls,typenames); - oop base = get(obj, TypeDecls,type); List_do(types, type) { if (do_index) String_appendAll(str, ", ", 2); toStringOn(type, str); @@ -1310,6 +1364,12 @@ void printiln(oop obj, int indent) printiln(get(obj, Array,base), indent+1); break; } + case Struct: { + printf("STRUCT %s @ %s\n", + symbolName(get(get(obj, Struct,type), Tstruct,tag)), + toString(get(obj, Struct,memory))); + break; + } case Symbol: printf("%s\n", symbolName (obj)); break; case Pair: { printf("PAIR\n"); @@ -1432,6 +1492,12 @@ void printiln(oop obj, int indent) printiln(get(obj, Index,rhs), indent+1); break; } + case Member: { + printf("MEMBER\n"); + printiln(get(obj, Member,lhs ), indent+1); + printiln(get(obj, Member,name), indent+1); + break; + } case Assign: { printf("ASSIGN\n"); printiln(get(obj, Assign,lhs), indent+1); @@ -1568,7 +1634,7 @@ oop input = 0; oop pushInput(char *name, FILE *file) { oop obj = new(Input); - obj->Input.name = strdup(name); + obj->Input.name = STRDUP(name); obj->Input.file = file; obj->Input.next = input; return input = obj; @@ -1579,7 +1645,7 @@ void popInput(void) if (!input) return; oop obj = input; input = get(obj, Input,next); - free(get(obj, Input,name)); + FREE(get(obj, Input,name)); fclose(get(obj, Input,file)); FREE(obj); } @@ -1622,7 +1688,8 @@ void expected(oop where, char *what) fatal("%s expected near: %.*s", what, get(where, String,size), get(where, String,elements)); } -oop eval(oop exp, oop env); +oop eval(oop exp); +oop preval(oop exp); %} @@ -1664,14 +1731,15 @@ tname = VOID { $$ = t_void } | id struct = STRUCT ( i:id m:members { $$ = newTstruct( i, m) } - | i:id { $$ = newTstruct(nil, m) } - | m:members { $$ = newTstruct( i, nil) } + | i:id { $$ = newTstruct( i, nil) } + | m:members { $$ = newTstruct(nil, m) } | e:error { expected(e, "structure/union definition") } ) -members = LBRACE vardecl* ( RBRACE - | e:error { expected(e, "struct/union member specification") } - ) +members = LBRACE l:mkList ( v:vardecl { List_append(l, v) } + )* ( RBRACE + | e:error { expected(e, "struct/union member specification") } + ) { $$ = l } inidecl = d:decltor ( ASSIGN ( e:initor { $$ = newAssign(d, e) } | e:error { expected(e, "variable initialiser") } @@ -1807,6 +1875,7 @@ postfix = v:value ( a:args { v = newCall(v, a) } | i:index { v = newIndex(v, i) } | PPLUS { v = newUnary(POSTINC, v) } | MMINUS { v = newUnary(POSTDEC, v) } + | DOT i:id { v = newMember(v, i) } )* { $$ = v } args = LPAREN a:mkList @@ -1863,7 +1932,8 @@ idopt = id | { $$ = nil } id = !keyword < alpha alnum* > - { $$ = intern(yytext) } -keyword = EXTERN | TYPEDEF | VOID | CHAR | SHORT | INT | LONG | FLOAT | DOUBLE | STRUCT +keyword = TYPEDEF | VOID | CHAR | SHORT | INT | LONG | FLOAT | DOUBLE + | STRUCT | UNION | ENUM | STATIC | EXTERN | IF | ELSE | WHILE | FOR | RETURN | CONTINU | BREAK alpha = [a-zA-Z_] @@ -1876,6 +1946,7 @@ comment = "//" < (![\n\r] .)* > INCLUDE = "include" ![_a-zA-Z0-9] - EXTERN = "extern" ![_a-zA-Z0-9] - +STATIC = "static" ![_a-zA-Z0-9] - TYPEDEF = "typedef" ![_a-zA-Z0-9] - VOID = "void" ![_a-zA-Z0-9] - CHAR = "char" ![_a-zA-Z0-9] - @@ -1885,6 +1956,8 @@ LONG = "long" ![_a-zA-Z0-9] - FLOAT = "float" ![_a-zA-Z0-9] - DOUBLE = "double" ![_a-zA-Z0-9] - STRUCT = "struct" ![_a-zA-Z0-9] - +UNION = "union" ![_a-zA-Z0-9] - +ENUM = "enum" ![_a-zA-Z0-9] - # UNION = "union" ![_a-zA-Z0-9] - # ENUM = "enum" ![_a-zA-Z0-9] - SIZEOF = "sizeof" ![_a-zA-Z0-9] - @@ -1895,6 +1968,7 @@ FOR = "for" ![_a-zA-Z0-9] - RETURN = "return" ![_a-zA-Z0-9] - CONTINU = "continue" ![_a-zA-Z0-9] - BREAK = "break" ![_a-zA-Z0-9] - +DOT = "." !"." - ETC = "..." - HASH = "#" - ASSIGN = "=" !"=" - @@ -1965,10 +2039,6 @@ oop nlrPop(void) #define FBINOP(L, OP, R) newFloat(floatValue(L) OP floatValue(R)) #define FRELOP(L, OP, R) (floatValue(L) OP floatValue(R) ? true : false) -#define isNil(O) (nil == (O)) -#define isFalse(O) (false == (O)) -#define isTrue(O) (true == (O)) - oop declareVariable(oop name, oop type, oop value); oop apply(oop function, oop arguments, oop env) @@ -1980,7 +2050,7 @@ oop apply(oop function, oop arguments, oop env) } case Primitive: { oop argv = newList(); - List_do(arguments, arg) List_append(argv, eval(arg, nil)); + List_do(arguments, arg) List_append(argv, eval(arg)); return get(function, Primitive,function) ( get(argv, List,size), get(argv, List,elements), @@ -2003,12 +2073,12 @@ oop apply(oop function, oop arguments, oop env) while (argn < parc) { oop var = parv[argn]; oop arg = argv[argn]; - declareVariable(get(var, Variable,name), get(var, Variable,type), eval(arg, nil)); + declareVariable(get(var, Variable,name), get(var, Variable,type), eval(arg)); ++argn; } if (argn < argc) { // put varargs array in local variable called "..." oop etc = newList(); - while (argn < argc) List_append(etc, eval(argv[argn++], nil)); + while (argn < argc) List_append(etc, eval(argv[argn++])); declareVariable(s_etc, t_etc, etc); } switch (nlrPush()) { // longjmp occurred @@ -2017,7 +2087,7 @@ oop apply(oop function, oop arguments, oop env) case NLR_CONTINUE: fatal("continue outside loop"); case NLR_BREAK: fatal("break outside loop"); } - oop result = eval(body, nil); + oop result = eval(body); Scope_end(); nlrPop(); return result; @@ -2039,7 +2109,6 @@ oop declare(oop name, oop value) case Variable: { oop valtype = get(value, Variable,type); if (oldtype == valtype) return value; // function declaration - printf("FUNCTION FORWARD TYPE MISMATCH 1\n"); break; } case Function: { // replace forard declaration with actual function @@ -2057,7 +2126,6 @@ oop declare(oop name, oop value) oop oldtype = get(old, Function,type); oop valtype = get(old, Variable,type); if (oldtype == valtype) return value; // compatible redeclaration - printf("FUNCTION FORWARD TYPE MISMATCH 2\n"); } break; } @@ -2073,6 +2141,7 @@ oop declare(oop name, oop value) oop declareVariable(oop name, oop type, oop value) { + assert(is(Symbol, name)); return declare(name, newVariable(name, type, value)); } @@ -2199,7 +2268,6 @@ oop pointerMemory(oop arg) oop prim_printf(int argc, oop *argv, oop env) // array { - oop result = nil; if (argc < 1) fatal("printf: no format string"); oop format = argv[0]; if (!is(String, format)) fatal("printf: format is not a string"); @@ -2283,7 +2351,6 @@ oop prim_printf(int argc, oop *argv, oop env) // array break; } case 'p': { - char tmp[32]; switch (getType(arg)) { case Pointer: case Array: { @@ -2319,7 +2386,7 @@ oop prim_malloc(int argc, oop *argv, oop env) // array if (size >= 0) { if (size > 10*1024*1024) fatal("cowardly refusing to allocate memory of size %zd", size); - void *mem = malloc(_integerValue(arg)); + void *mem = MALLOC(size); if (!mem) fatal("malloc(%zd) failed", size); return newPointer(t_pvoid, newMemory(mem, size), 0); } @@ -2337,7 +2404,7 @@ oop prim_free(int argc, oop *argv, oop env) // array switch (getType(base)) { case Integer: fatal("attempt to free arbitrary pointer %s", toString(arg)); case Variable: fatal("attempt to free pointer to variable %s", toString(arg)); - case Memory: free(get(base, Memory,base)); break; + case Memory: FREE(get(base, Memory,base)); break; default: assert(!"this cannot happen"); } return nil; @@ -2359,6 +2426,39 @@ oop prim_abort(int argc, oop *argv, oop env) // array return nil; } +oop prim_sqrtf(int argc, oop *argv, oop env) // array +{ + if (argc != 1) fatal("sqrtf: wrong number of arguments"); + oop arg = argv[0]; + if (!is(Float, arg)) fatal("sqrtf: argument is not an integer"); + return newFloat(sqrtf(_floatValue(arg))); +} + +void declareTag(oop type) +{ + oop members = get(type, Tstruct,members); + int size = get(type, Tstruct,size); + if (size < 0 && !isNil(members)) { // defining + int offset = 0; + oop vars = newList(); + List_do(members, vardecls) { + oop vtype = get(vardecls, VarDecls,type); + oop decls = get(vardecls, VarDecls,variables); + List_do(decls, decl) { + oop mtype = makeType(vtype, decl); + oop mname = makeName(decl); + int msize = typeSize(vtype); + int fragment = offset % msize; + if (fragment) offset += msize - fragment; + List_append(vars, newVariable(mname, mtype, newInteger(offset))); + offset += msize; + } + } + set(type, Tstruct,members, vars); + set(type, Tstruct,size, offset); + } +} + oop typeCheck(oop exp, oop fntype) { switch (getType(exp)) { @@ -2429,7 +2529,8 @@ oop typeCheck(oop exp, oop fntype) switch (get(exp, Binary,operator)) { case MUL: { if (lhs == rhs) { - if (t_int == lhs) return lhs; + if (t_int == lhs) return lhs; + if (t_float == lhs) return lhs; } fatal("cannot multiply '%s' and '%s'", toString(lhs), toString(rhs)); break; @@ -2438,7 +2539,8 @@ oop typeCheck(oop exp, oop fntype) case MOD: assert(!"unimplemented"); break; case ADD: { if (lhs == rhs) { - if (t_int == lhs) return lhs; + if (t_int == lhs) return lhs; + if (t_float == lhs) return lhs; } if (is(Tpointer, lhs) && t_int == rhs) { return lhs; @@ -2477,6 +2579,26 @@ oop typeCheck(oop exp, oop fntype) } break; } + case Member: { + oop lhs = get(exp, Member,lhs); + oop name = get(exp, Member,name); + oop ltype = typeCheck(lhs, fntype); + oop members = nil; + switch (getType(ltype)) { + case Tstruct: members = get(ltype, Tstruct,members); break; + default: + fatal("member reference to non-struct/union type '%s': %s", + toString(ltype), toString(lhs)); + } + if (isNil(members)) + fatal("member reference to incomplete type '': %s", + toString(ltype), toString(lhs)); + List_do(members, member) + if (name == get(member, Variable,name)) + return get(member, Variable,type); + fatal("no member named '%s' in '%s'", symbolName(name), toString(ltype)); + break; + } case Assign: { oop lhs = typeCheck(get(exp, Assign,lhs), fntype); oop rhs = typeCheck(get(exp, Assign,rhs), fntype); @@ -2653,6 +2775,7 @@ oop typeCheck(oop exp, oop fntype) } case VarDecls: { oop base = makeBaseType(get(exp, VarDecls,type)); + if (is(Tstruct, base)) declareTag(base); oop decls = get(exp, VarDecls,variables); oop vars = newList(); List_do(decls, decl) { @@ -2697,48 +2820,50 @@ oop typeCheck(oop exp, oop fntype) declareString(oldtype, varname), declareString(vartype, varname)); } - // do this now so that initialiser can refer to the new variable - oop var = declareVariable(varname, vartype, init); - List_append(vars, var); - if (!isNil(init)) { - if (is(Tarray, vartype)) { - oop etype = get(vartype, Tarray,target); - oop asize = get(vartype, Tarray,size); - int isize = 0; - if (t_char == etype && is(String, init)) { - isize = get(init, String,size); - if (isNil(asize)) ++isize; // nul terminator - } - else if (is(List, init)) { - isize = List_size(init); - } - if (isNil(asize)) { - asize = newInteger(isize); - vartype = newTarray(etype, asize); - set(var, Variable,type, vartype); // implicitly sized array + if (!isNil(varname)) { + // do this now so that an initialiser can refer to the new variable + oop var = declareVariable(varname, vartype, init); + List_append(vars, var); + if (!isNil(init)) { + if (is(Tarray, vartype)) { + oop etype = get(vartype, Tarray,target); + oop asize = get(vartype, Tarray,size); + int isize = 0; + if (t_char == etype && is(String, init)) { + isize = get(init, String,size); + if (isNil(asize)) ++isize; // nul terminator + } + else if (is(List, init)) { + isize = List_size(init); + } + if (isNil(asize)) { + asize = newInteger(isize); + vartype = newTarray(etype, asize); + set(var, Variable,type, vartype); // implicitly sized array + } + else { + int na = _integerValue(asize); + if (isize < na) /*fatal("too few initialisers for array")*/; + if (isize > na) fatal("too many initialisers for array"); + } + if (is(List, init)) { + List_do(init, ini) { + oop itype = typeCheck(ini, fntype); + if (itype != etype) + fatal("cannot initialise array element type '%s' with '%s'", + toString(etype), toString(itype)); + } + } } else { - int na = _integerValue(asize); - if (isize < na) /*fatal("too few initialisers for array")*/; - if (isize > na) fatal("too many initialisers for array"); - } - if (is(List, init)) { - List_do(init, ini) { - oop itype = typeCheck(ini, fntype); - if (itype != etype) - fatal("cannot initialise array element type '%s' with '%s'", - toString(etype), toString(itype)); + oop initype = typeCheck(init, fntype); + cvt_t cvt = converter(getType(initype), getType(vartype)); + if (!cvt) { + fatal("initialising '%s': cannot convert '%s' to '%s'", + toString(varname), toString(vartype), toString(initype)); } } } - else { - oop initype = typeCheck(init, fntype); - cvt_t cvt = converter(getType(initype), getType(vartype)); - if (!cvt) { - fatal("initialising '%s': cannot convert '%s' to '%s'", - toString(varname), toString(vartype), toString(initype)); - } - } } } set(exp, VarDecls,variables, vars); @@ -2839,6 +2964,46 @@ oop getArray(oop array, int index) return 0; } +oop getMemory(oop memory, int offset, oop type) +{ + int memsize = get(memory, Memory,size); + int valsize = typeSize(type); + if (offset < 0) fatal("memory offset is negative"); + if (offset + valsize > memsize) fatal("memory offset out of bounds"); + void *addr = get(memory, Memory,base) + offset; + switch (getType(type)) { + case Tchar: return newInteger(*(char *)addr); + case Tshort: return newInteger(*(short *)addr); + case Tint: return newInteger(*(int *)addr); + case Tlong: return newInteger(*(long *)addr); + case Tfloat: return newFloat (*(float *)addr); + case Tdouble: return newFloat (*(double *)addr); + default: break; + } + fatal("cannot load '%s' from memory", getTypeName(type)); + return 0; +} + +oop setMemory(oop memory, int offset, oop type, oop value) +{ + int memsize = get(memory, Memory,size); + int valsize = typeSize(type); + if (offset < 0) fatal("memory offset is negative"); + if (offset + valsize > memsize) fatal("memory offset out of bounds"); + void *addr = get(memory, Memory,base) + offset; + switch (getType(type)) { + case Tchar: return newInteger(*(char *)addr = _integerValue(value)); + case Tshort: return newInteger(*(short *)addr = _integerValue(value)); + case Tint: return newInteger(*(int *)addr = _integerValue(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)); + default: break; + } + fatal("cannot store '%s' into memory", getTypeName(type)); + return 0; +} + oop setArray(oop array, int index, oop value) { int size = get(array, Array,size); @@ -2865,8 +3030,6 @@ oop setArray(oop array, int index, oop value) oop assign(oop lhs, oop rhs) { - //printf("ASSIGN "); println(lhs); - //printf(" = "); println(rhs); oop dst = lhs; if (is(Symbol, lhs)) lhs = Scope_lookup(lhs); switch (getType(lhs)) { @@ -2889,7 +3052,7 @@ oop assign(oop lhs, oop rhs) } case String: { if (t_pchar == ltype) { - char *chars = String_cString(rhs); + char *chars = STRDUP(String_cString(rhs)); oop memory = newMemory(chars, strlen(chars) + 1); rhs = newPointer(ltype, memory, 0); break; @@ -2904,18 +3067,51 @@ oop assign(oop lhs, oop rhs) return set(lhs, Variable,value, rhs); } case Index: { - oop ondex = eval(get(lhs, Index,rhs), nil); + oop ondex = eval(get(lhs, Index,rhs)); if (!is(Integer, ondex)) fatal("array index is not 'int'"); int index = _integerValue(ondex); - lhs = eval(get(lhs, Index,lhs), nil); + lhs = eval(get(lhs, Index,lhs)); switch (getType(lhs)) { case Array: return setArray(lhs, index, rhs); default: break; } break; } + case Member: { + oop name = get(lhs, Member,name); + oop soru = eval(get(lhs, Member,lhs)); // struct or union + oop type = nil; + oop memory = nil; + oop members = nil; + int size = 0; + switch (getType(soru)) { + case Struct: + type = get(soru, Struct,type); + memory = get(soru, Struct,memory); + members = get(type, Tstruct,members); + size = get(type, Tstruct,size); + break; + default: + fatal("this cannot happen"); + break; + } + oop value = nil; + oop vtype = nil; + List_do(members, var) { + if (name == get(var, Variable,name)) { + vtype = get(var, Variable,type); + value = get(var, Variable,value); + break; + } + } + assert(value != nil); + int offset = _integerValue(value); + int vsize = typeSize(vtype); + assert(offset + vsize <= size); + return setMemory(memory, offset, vtype, eval(rhs)); + } case Dereference: { // *<&var> = rhs - lhs = eval(get(lhs, Dereference,rhs), nil); + lhs = eval(get(lhs, Dereference,rhs)); switch (getType(lhs)) { case Pointer: { // &x oop base = get(lhs, Pointer,base); @@ -2954,11 +3150,8 @@ oop assign(oop lhs, oop rhs) } default: break; } - if (dst == lhs) - fatal("cannot assign to: %s", toString(lhs)); - else - fatal("invalid rvalue '%s' assigning to: %s", - toString(lhs), toString(dst)); + if (dst == lhs) fatal("cannot assign to: %s", toString(lhs)); + fatal("invalid rvalue '%s' assigning to: %s", toString(lhs), toString(dst)); return 0; } @@ -3033,7 +3226,66 @@ int compare(oop a, oop b) # undef CMP } -oop eval(oop exp, oop env) +void randomise(unsigned char *mem, size_t size) +{ + static unsigned lfsr = 0xC4E1u; + for (int i = 0; i < size; ++i) { + mem[i] = lfsr; + lfsr >>= 1; + if (lfsr & 1) lfsr ^= 0xB400; + } +} + +void initialiseVariable(oop var, int local) +{ + oop (*evaluate)(oop) = local ? eval : preval; + oop type = get(var, Variable,type); + oop init = get(var, Variable,value); + switch (getType(type)) { + case Tfunction: break; + case Tarray: { + oop target = get(type, Tarray,target); + int size = _integerValue(get(type, Tarray,size)); + int memsize = typeSize(target) * size; + void *mem = CALLOC(size, typeSize(target)); + oop memory = newMemory(mem, memsize); + oop value = newArray(type, memory, size); + if (local) randomise(mem, memsize); + if (!isNil(init)) { // size and types checked during typeCheck + if (is(String, init)) { + int isize = get(init, String,size); assert(isize <= size); + char *chars = get(init, String,elements); + for (int i = 0; i < isize; ++i) + setArray(value, i, newInteger(chars[i])); + if (isize < size) + setArray(value, isize, newInteger(0)); + } + else { + List_do(init, ini) { + setArray(value, do_index, evaluate(ini)); + } + } + } + set(var, Variable,value, value); + break; + } + case Tstruct: { + int size = get(type, Tstruct,size); + void *mem = CALLOC(1, size); + oop memory = newMemory(mem, size); + oop value = newStruct(type, memory); + if (local) randomise(mem, size); + set(var, Variable,value, value); + break; + } + default: { + if (!isNil(init)) set(var, Variable,value, evaluate(init)); + break; + } + } +} + +oop eval(oop exp) { if (opt_v > 2) { printf("EVAL "); println(exp); } switch (getType(exp)) { @@ -3043,6 +3295,7 @@ oop eval(oop exp, oop env) 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)); @@ -3063,7 +3316,7 @@ oop eval(oop exp, oop env) case Reference: return exp; case Closure: return exp; case Call: { - oop fun = eval(get(exp, Call,function), env); + oop fun = eval(get(exp, Call,function)); oop args = get(exp, Call,arguments); return apply(fun, args, nil); } @@ -3080,7 +3333,7 @@ oop eval(oop exp, oop env) case NLR_BREAK: Scope_end(); nlrReturn(NLR_BREAK, nlrPop()); } for (int i = 0; i < size; ++i) { - result = eval(elts[i], env); + result = eval(elts[i]); } Scope_end(); nlrPop(); @@ -3104,10 +3357,10 @@ oop eval(oop exp, oop env) break; } case Index: { - oop ondex = eval(get(rhs, Index,rhs), nil); + oop ondex = eval(get(rhs, Index,rhs)); if (!is(Integer, ondex)) fatal("array index is not 'int'"); int index = _integerValue(ondex); - oop lhs = eval(get(rhs, Index,lhs), nil); + oop lhs = eval(get(rhs, Index,lhs)); switch (getType(lhs)) { case Array: { oop type = get(lhs, Array,type); @@ -3128,13 +3381,13 @@ oop eval(oop exp, oop env) } case Dereference: { oop rhs = get(exp, Dereference,rhs); - rhs = eval(rhs, nil); + rhs = eval(rhs); switch (getType(rhs)) { case Pointer: return getPointer(rhs); default: break; } - printf("cannot dereference\n"); println(rhs); + assert(!"cannot dereference\n"); exit(1); break; } @@ -3173,7 +3426,7 @@ oop eval(oop exp, oop env) case NEG: case NOT: case COM: { - rhs = eval(rhs, env); + rhs = eval(rhs); switch (op) { case NEG: return ( is(Float, rhs) ? newFloat (-floatValue (rhs)) @@ -3191,11 +3444,11 @@ oop eval(oop exp, oop env) oop lhs = get(exp, Binary,lhs); oop rhs = get(exp, Binary,rhs); switch (get(exp, Binary,operator)) { - case LAND: return isFalse(eval(lhs, env)) ? false : eval(rhs, env); - case LOR: return isTrue (eval(lhs, env)) ? true : eval(rhs, env); + case LAND: return isFalse(eval(lhs)) ? false : eval(rhs); + case LOR: return isTrue (eval(lhs)) ? true : eval(rhs); default: { - lhs = eval(lhs, env); - rhs = eval(rhs, env); + 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); @@ -3262,22 +3515,57 @@ oop eval(oop exp, oop env) break; } case Index: { - oop ondex = eval(get(exp, Index,rhs), nil); + oop ondex = eval(get(exp, Index,rhs)); if (!is(Integer, ondex)) fatal("array index is not 'int'"); int index = _integerValue(ondex); - oop lhs = eval(get(exp, Index,lhs), nil); + oop lhs = eval(get(exp, Index,lhs)); switch (getType(lhs)) { case Array: return getArray(lhs, index); default: break; } + println(lhs); + assert(0); break; } + case Member: { + oop soru = eval(get(exp, Member,lhs)); // struct or union + oop name = get(exp, Member,name); + oop type = nil; + oop memory = nil; + oop members = nil; + int size = 0; + switch (getType(soru)) { + case Struct: + type = get(soru, Struct,type); + memory = get(soru, Struct,memory); + members = get(type, Tstruct,members); + size = get(type, Tstruct,size); + break; + default: + fatal("this cannot happen"); + break; + } + oop value = nil; + oop vtype = nil; + List_do(members, var) { + if (name == get(var, Variable,name)) { + vtype = get(var, Variable,type); + value = get(var, Variable,value); + break; + } + } + assert(value != nil); + int offset = _integerValue(value); + int vsize = typeSize(vtype); + assert(offset + vsize <= size); + return getMemory(memory, offset, vtype); + } case Assign: { - return assign(get(exp, Assign,lhs), eval(get(exp, Assign,rhs), nil)); + return assign(get(exp, Assign,lhs), eval(get(exp, Assign,rhs))); } case Cast: { cvt_t cvt = get(exp, Cast,converter); assert(cvt); - oop rhs = eval(get(exp, Cast,rhs), nil); + oop rhs = eval(get(exp, Cast,rhs)); return cvt(rhs); } case While: { @@ -3290,8 +3578,8 @@ oop eval(oop exp, oop env) case NLR_CONTINUE: break; case NLR_BREAK: return nlrPop(); } - while (isTrue(eval(cond, env))) { - result = eval(expr, env); + while (isTrue(eval(cond))) { + result = eval(expr); } nlrPop(); return result; @@ -3308,11 +3596,11 @@ oop eval(oop exp, oop env) case NLR_CONTINUE: goto continued; case NLR_BREAK: goto broken; } - eval(init, nil); - while (integerValue(eval(cond, nil))) { - eval(body, nil); + eval(init); + while (integerValue(eval(cond))) { + eval(body); continued: - eval(step, nil); + eval(step); } broken: Scope_end(); @@ -3322,12 +3610,12 @@ oop eval(oop exp, oop env) oop cond = get(exp, If,condition); oop conseq = get(exp, If,consequent); oop altern = get(exp, If,alternate); - if (isTrue(eval(cond, env))) eval(conseq, env); - else if (!isNil(altern)) eval(altern, env); + if (isTrue(eval(cond))) eval(conseq); + else if (!isNil(altern)) eval(altern); return nil; } case Return: { - nlrReturn(NLR_RETURN, eval(get(exp, Return,value), env)); + nlrReturn(NLR_RETURN, eval(get(exp, Return,value))); break; } case Continue: { @@ -3338,68 +3626,25 @@ oop eval(oop exp, oop env) nlrReturn(NLR_BREAK, nil); break; } - case Tvoid: assert(!"unimplemented"); break; - case Tchar: assert(!"unimplemented"); break; - case Tshort: assert(!"unimplemented"); break; - case Tint: assert(!"unimplemented"); break; - case Tlong: assert(!"unimplemented"); break; - case Tfloat: assert(!"unimplemented"); break; - case Tdouble: assert(!"unimplemented"); break; - case Tpointer: assert(!"unimplemented"); break; - case Tarray: assert(!"unimplemented"); break; - case Tstruct: assert(!"unimplemented"); break; - case Tfunction: assert(!"unimplemented"); break; - case Tetc: assert(!"unimplemented"); break; + case Tvoid: assert(!"unimplemented"); break; + case Tchar: assert(!"unimplemented"); break; + case Tshort: assert(!"unimplemented"); break; + case Tint: assert(!"unimplemented"); break; + case Tlong: assert(!"unimplemented"); break; + case Tfloat: assert(!"unimplemented"); break; + case Tdouble: assert(!"unimplemented"); break; + case Tpointer: assert(!"unimplemented"); break; + case Tarray: assert(!"unimplemented"); break; + case Tstruct: assert(!"unimplemented"); break; + case Tfunction: assert(!"unimplemented"); break; + case Tetc: assert(!"unimplemented"); break; case VarDecls: { - oop vars = get(exp, VarDecls,variables); - List_do(vars, var) { + // declareVariables(exp); + List_do(get(exp, VarDecls,variables), var) { oop name = get(var, Variable,name); - oop type = get(var, Variable,type); - oop init = get(var, Variable,value); - if (is(Tfunction, type)) continue; // function declaration - // do this now so that init can refer to the new variable - oop valu = nil; - if (is(Tarray, type)) { - oop target = get(type, Tarray,target); - int size = _integerValue(get(type, Tarray,size)); - if (size < 0) fatal("array has negative size"); - if (size > 10*1024*1024) fatal("corwardly refusing to create array of size %d", size); - oop mem = nil; - switch (getType(target)) { - case Tchar: - case Tshort: - case Tint: - case Tlong: - case Tfloat: - case Tdouble: - case Tpointer: - case Tarray: - mem = malloc(typeSize(target) * size); - break; - default: // xxx array of array - assert(!"unimplemented"); - } - valu = newArray(type, newMemory(mem, typeSize(target) * size), size); - if (!isNil(init)) { // size and types checked during typeCheck - if (is(String, init)) { - int isize = get(init, String,size); - assert(isize <= size); - char *chars = get(init, String,elements); - for (int i = 0; i < isize; ++i) - setArray(valu, i, newInteger(chars[i])); - } - else { - List_do(init, ini) { - setArray(valu, do_index, eval(ini, nil)); - } - } - } - declareVariable(name, type, valu); - } - else { - oop var = declareVariable(name, type, valu); - if (!isNil(init)) assign(var, eval(init, nil)); - } + var = newVariable(name, get(var, Variable,type), get(var, Variable,value)); + declare(name, var); + initialiseVariable(var, 1); } return nil; } @@ -3418,6 +3663,7 @@ oop eval(oop exp, oop env) case Constant: break; case Function: break; } + println(exp); assert(!"this cannot happen"); return 0; } @@ -3428,12 +3674,13 @@ oop preval(oop exp) { if (opt_v > 2) { printf("PREVAL "); println(exp); } switch (getType(exp)) { - case Undefined: break; + case Undefined: return exp; case Input: break; case Integer: return exp; case Float: return exp; case Pointer: return exp; case Array: return exp; + case Struct: return exp; case Symbol: break; case Pair: break; case String: break; @@ -3450,6 +3697,7 @@ oop preval(oop exp) case Unary: break; case Binary: break; case Index: break; + case Member: break; case Assign: break; case Cast: break; case While: break; @@ -3471,11 +3719,8 @@ oop preval(oop exp) case Tfunction: break; case Tetc: break; case VarDecls: { - oop vars = get(exp, VarDecls,variables); - List_do(vars, var) { - assert(Scope_lookup(get(var, Variable,name))); - oop init = get(var, Variable,value); - if (!isNil(init)) assign(var, preval(init)); + List_do(get(exp, VarDecls,variables), var) { + initialiseVariable(var, 0); } return nil; } @@ -3773,6 +4018,7 @@ void compileOn(oop exp, oop program, oop cs, oop bs) case Float: EMITio(iPUSH, exp); return; case Pointer: assert(!"unimplemented"); case Array: assert(!"unimplemented"); + case Struct: assert(!"unimplemented"); case Symbol: EMITio(iGETGVAR, exp); return; case Pair: EMITio(iPUSH, exp); return; case String: EMITio(iPUSH, exp); return; @@ -3805,9 +4051,9 @@ void compileOn(oop exp, oop program, oop cs, oop bs) compileOn(exps[size - 1], program, cs, bs); return; } - case Addressof: assert(0); - case Dereference: assert(0); - case Sizeof: assert(0); + case Addressof: assert(!"unimplemented"); + case Dereference: assert(!"unimplemented"); + case Sizeof: assert(!"unimplemented"); case Unary: { compileOn(get(exp, Unary,rhs), program, cs, bs); switch (get(exp, Unary,operator)) { @@ -3852,6 +4098,7 @@ void compileOn(oop exp, oop program, oop cs, oop bs) } } case Index: assert(!"unimplemented"); + case Member: assert(!"unimplemented"); case Assign: { oop symbol = get(exp, Assign,lhs); oop expr = get(exp, Assign,rhs); @@ -4038,7 +4285,8 @@ int main(int argc, char **argv) t_ppchar = newTpointer(t_pchar); t_etc = newTetc(); - scopes = newList(); + tags = newList(); // struct/union/enum tags + scopes = newList(); // lexically nested variable scopes Scope_begin(); // the global scope diff --git a/test.txt b/test.txt index 106f2d3..888ee68 100755 --- a/test.txt +++ b/test.txt @@ -1,5 +1,6 @@ #!./main +#include #include #include #include @@ -9,14 +10,23 @@ int x = 21; int baz(int xx, ...) { return 42; } -int foo(void) { return x + x; } +int foo(void) { return x + x; } char *bar(void) { return "bye bye"; } +struct Point { float x, y; }; + +struct Point pt; + +float Point_magnitude(struct Point p) { return sqrtf(p.x * p.x + p.y * p.y); } + +int gbl[5]; + int main(int argc, char **argv) { printf("hello, world %d %s\n", foo(), bar()); printf("baz is %d %d %d\n", baz(1), baz(1, 2), baz(1, "two", 3)); + printf("%d\n", 6*7); int x = 42; int *p = &x; printf("x is %d p is %p\n", *p, p); @@ -39,7 +49,7 @@ int main(int argc, char **argv) for (i = 0; i < 5; ++i) array[i] = i*i; for (i = 0; i < 5; ++i) printf("%d\n", array[i]); - for (i = 0; i < 5; ++i) array[i] = array[i] * array[i]; + for (i = 0; i < 5; ++i) array[i] = array[i] * array[i]; for (i = 0; i < 5; ++i) printf("%d\n", array[i]); printf("%p\n", array); @@ -69,7 +79,22 @@ int main(int argc, char **argv) printf("%zd %s\n", sizeof(sarray), sarray); printf("%zd %s\n", sizeof(tarray), tarray); printf("%zd %s\n", sizeof(uarray), uarray); - // printf("%zd %s\n", sizeof(varray), varray); // unterminated string + printf("%zd %s\n", sizeof(varray), uarray); // varray has unterminated string + + printf("gbl %f %f -> %f\n", pt.x, pt.y, Point_magnitude(pt)); // global data is filled with zero + pt.x = 3.0; + pt.y = 4.0; + printf("gbl %f %f -> %f\n", pt.x, pt.y, Point_magnitude(pt)); + + struct Point qt; + printf("lcl %f %f -> %f\n", qt.x, qt.y, Point_magnitude(qt)); // local data is random + qt.x = 3.0; + qt.y = 4.0; + printf("lcl %f %f -> %f\n", qt.x, qt.y, Point_magnitude(qt)); + + for (i = 0; i < 5; ++i) printf("g %d\n", gbl[i]); // global data is filled with zero + int lcl[5]; + for (i = 0; i < 5; ++i) printf("l %d\n", lcl[i]); // local data is random printf("passed\n");