handle sizeof() and malloc()

demofiles/memory-leak.c

@@ -5,10 +5,10 @@
 #include <assert.h>
 
 int main() {
-  for (int i = 0;  i < 10;  ++i) {
-    int *ptr = malloc(sizeof(*ptr));
-    assert(ptr);
-    *ptr = i;
-  }
-  return 0;
+    for (int i = 0;  i < 10;  ++i) {
+	int *ptr = malloc(sizeof(*ptr));
+	assert(ptr != 0);
+	*ptr = i;
+    }
+    return 0;
 }

main.leg

@@ -1,6 +1,6 @@
 # main.leg -- C parser + interpreter
 #
-# Last edited: 2025-01-27 09:37:11 by piumarta on zora
+# Last edited: 2025-01-27 11:18:13 by piumarta on zora
 
 %{
 ;
@@ -58,8 +58,8 @@ typedef union Object Object, *oop;
 
 #define _do_types(_)									\
     _(Undefined) _(Input) _(Integer) _(Float) _(Symbol) _(Pair) _(String) _(Array)	\
-    _(Reference) _(Closure) _(Call) _(Block) 						\
-    _(Address) _(Dereference) _(Unary) _(Binary) _(Assign) _(Cast)			\
+    _(Memory) _(Reference) _(Closure) _(Call) _(Block)					\
+    _(Address) _(Dereference) _(Sizeof) _(Unary) _(Binary) _(Assign) _(Cast)		\
     _(While) _(For) _(If) _(Return) _(Continue) _(Break)				\
     _(Tvoid) _(Tchar) _(Tshort) _(Tint) _(Tlong) _(Tfloat) _(Tdouble)			\
     _(Tpointer) _(Tarray) _(Tstruct) _(Tfunction) _(Tetc)				\
@@ -111,12 +111,14 @@ 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; };
 struct Array   	   { type_t _type;  int size;  oop *elements; };
+struct Memory      { type_t _type;  void *base;  size_t size; };
 struct Reference   { type_t _type;  oop target; };
 struct Closure	   { type_t _type;  oop function, environment; };
 struct Call   	   { type_t _type;  oop function, arguments; };
 struct Block   	   { type_t _type;  oop statements; };
 struct Address     { type_t _type;  oop rhs; };
 struct Dereference { type_t _type;  oop rhs; };
+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 Assign  	   { type_t _type;  oop lhs, rhs; };
@@ -573,6 +575,14 @@ oop Map_get(oop map, oop key)
     return kvs[index].val;
 }
 
+oop newMemory(void *base, size_t size)
+{
+    oop obj = new(Memory);
+    obj->Memory.base = base;
+    obj->Memory.size = size;
+    return obj;
+}
+
 CTOR1(Reference,   target);
 CTOR2(Closure,     function, environment);
 CTOR2(Call,    	   function, arguments);
@@ -580,6 +590,14 @@ CTOR1(Block,   	   statements);
 CTOR1(Address,     rhs);
 CTOR1(Dereference, rhs);
 
+oop newSizeof(oop operand)
+{
+    oop obj = new(Sizeof);
+    obj->Sizeof.rhs      = operand;
+    obj->Sizeof.size     = nil;
+    return obj;
+}
+
 oop newUnary(unary_t operator, oop operand)
 {
     oop obj = new(Unary);
@@ -982,6 +1000,10 @@ oop toStringOn(oop obj, oop str)
 	    String_append(str, '"');
 	    break;
 	}
+	case Memory: {
+	    String_format(str, "<%p+%zd>", get(obj, Memory,base), get(obj, Memory,size));
+	    break;
+	}
 	case Cast: {
 	    String_append(str, '(');
 	    toStringOn(get(obj, Cast,type), str);
@@ -994,6 +1016,10 @@ oop toStringOn(oop obj, oop str)
 	    toStringOn(get(obj, Dereference,rhs), str);
 	    break;
 	}
+	case Sizeof: {
+	    String_format(str, "sizeof(%d)", toString(get(obj, Sizeof,rhs)));
+	    break;
+	}
 	case Unary: {
 	    char *name = 0;
 	    oop rhs = get(obj, Unary,rhs);
@@ -1211,7 +1237,13 @@ void printiln(oop obj, int indent)
 	    break;
 	}
 	case Primitive: {
-	    printf("PRIMITIVE<%s>\n", symbolName(get(obj, Primitive,name)));
+	    printf("PRIMITIVE\n");
+	    printiln(get(obj, Primitive,name), indent+1);
+	    printiln(get(obj, Primitive,type), indent+1);
+	    break;
+	}
+	case Memory: {
+	    printf("MEMORY %p + %zd\n", get(obj, Memory,base), get(obj, Memory,size));
 	    break;
 	}
 	case Reference: {
@@ -1245,6 +1277,12 @@ void printiln(oop obj, int indent)
 	    printiln(get(obj, Dereference,rhs), indent+1);
 	    break;
 	}
+	case Sizeof: {
+	    printf("SIZEOF ");
+	    println(get(obj, Sizeof,size));
+	    printiln(get(obj, Sizeof,rhs), indent+1);
+	    break;
+	}
 	case Unary: {
 	    switch (get(obj, Unary,operator)) {
 		case NEG: 	printf("NEG\n");   	break;
@@ -1643,11 +1681,17 @@ unary	= MINUS  r:unary		{ $$ = newUnary(NEG,   	r) }
 	| AND    r:unary		{ $$ = newAddress(r) }
 	| PPLUS	 r:unary		{ $$ = newUnary(PREINC, r) }
 	| MMINUS r:unary		{ $$ = newUnary(PREDEC, r) }
+	| SIZEOF
+	  (        r:unary		{ $$ = newSizeof(r) }
+    	  | LPAREN t:tnamdec RPAREN	{ $$ = newSizeof(t) }
+	  )
 	| 	 cast
 	|        postfix
 
-cast	= LPAREN t:tname d:decltor
-	  RPAREN r:unary		{ $$ = newCast(makeType(t, d), r) }
+cast	= LPAREN t:tnamdec
+	  RPAREN r:unary		{ $$ = newCast(t, r) }
+
+tnamdec	= t:tname d:decltor		{ $$ = makeType(t, d) }
 
 postfix	= v:value ( a:args		{ v = newCall(v, a) }
 	  	  | i:index		{ v = newBinary(INDEX, v, i) }
@@ -1733,6 +1777,7 @@ DOUBLE	= "double"   ![_a-zA-Z0-9] -
 STRUCT	= "struct"   ![_a-zA-Z0-9] -
 # UNION	= "union"    ![_a-zA-Z0-9] -
 # ENUM	= "enum"     ![_a-zA-Z0-9] -
+SIZEOF	= "sizeof"   ![_a-zA-Z0-9] -
 IF	= "if"	     ![_a-zA-Z0-9] -
 ELSE	= "else"     ![_a-zA-Z0-9] -
 WHILE	= "while"    ![_a-zA-Z0-9] -
@@ -1986,6 +2031,7 @@ oop eval(oop exp, oop env)
 	case Pair:	assert(!"this cannot happen");
 	case String:	return exp;
 	case Array: 	assert(!"this cannot happen");
+	case Memory:	assert(!"this cannot happen");
 	case Primitive:	return exp;
 	case Reference: return exp;
 	case Closure:	return exp;
@@ -2046,6 +2092,9 @@ oop eval(oop exp, oop env)
 	    }
 	    break;
 	}
+	case Sizeof: {
+	    return get(exp, Sizeof,size);
+	}
 	case Unary: {
 	    unary_t op  = get(exp, Unary,operator);
 	    oop     rhs = get(exp, Unary,rhs);
@@ -2147,6 +2196,10 @@ oop eval(oop exp, oop env)
 			    case NE: {
 				if (is(Reference,lhs) && is(Integer,rhs) && _integerValue(rhs) == 0) return true;
 				if (is(Reference,rhs) && is(Integer,lhs) && _integerValue(lhs) == 0) return true;
+				if (is(Memory,   lhs) && is(Integer,rhs) && _integerValue(rhs) == 0)
+				    return (intptr_t)get(lhs, Memory,base) != _integerValue(rhs) ? true : false;
+				if (is(Memory,   rhs) && is(Integer,lhs) && _integerValue(lhs) == 0)
+				    return (intptr_t)get(rhs, Memory,base) != _integerValue(lhs) ? true : false;
 				return IRELOP(lhs, !=, rhs);
 			    }
 			    case BAND: 	return IBINOP(lhs, & , rhs);
@@ -2269,8 +2322,10 @@ oop eval(oop exp, oop env)
 		oop init = get(var, Variable,value);
 		oop valu = nil;
 		if (is(Tfunction, type)) continue;	// function declaration
+		// do this now so that init can refer to the new variable
+		oop var = declareVariable(name, type, valu);
 		if (!isNil(init)) valu = eval(init, nil);
-		declareVariable(name, type, valu);
+		set (var, Variable,value, valu);
 	    }
 	    return nil;
 	}
@@ -2307,6 +2362,7 @@ oop preval(oop exp)
 	case Pair:		break;
 	case String:		break;
 	case Array:		break;
+	case Memory:		break;
 	case Primitive:		return exp;
 	case Reference:		break;
 	case Closure:		break;
@@ -2314,6 +2370,7 @@ oop preval(oop exp)
 	case Block:		break;
 	case Address:		break;
 	case Dereference:	break;
+	case Sizeof:		return get(exp, Sizeof,size);
 	case Unary:		break;
 	case Binary:		break;
 	case Assign:		break;
@@ -2369,7 +2426,7 @@ oop preval(oop exp)
 // primitive functions
 
 #define _do_primitives(_)			\
-    _(printf) _(assert)
+    _(printf) _(assert) _(malloc)
 
 #define _(X) oop s_##X = 0;
 _do_primitives(_)
@@ -2450,6 +2507,24 @@ oop prim_assert(int argc, oop *argv, oop env) // array
     return nil;
 }
 
+oop prim_malloc(int argc, oop *argv, oop env) // array
+{
+    if (argc != 1) fatal("malloc: wrong number of arguments");
+    oop arg = argv[0];
+    if (is(Integer,arg)) {
+	size_t size = _integerValue(arg);
+	if (size >= 0) {
+	    if (size > 10*1024*1024)
+		fatal("cowardly refusing to allocate memory of size %zd", size);
+	    void *mem = malloc(_integerValue(arg));
+	    if (!mem) fatal("malloc(%zd) failed", size);
+	    return newMemory(mem, size);
+	}
+    }
+    fatal("malloc: invalid argument: %s", toString(arg));
+    return 0;
+}
+
 enum opcode_t { iHALT = 0, iPUSH, iPOP,
     iNOT, iCOM, iNEG, iDEREF, iINDEX,
     iMUL, iDIV, iMOD, iADD, iSUB, iSHL, iSHR,
@@ -2725,6 +2800,7 @@ void compileOn(oop exp, oop program, oop cs, oop bs)
 	case Pair:	EMITio(iPUSH, exp);	return;
 	case String:	EMITio(iPUSH, exp);	return;
 	case Array:	assert(!"unimplemented");
+	case Memory:	assert(!"unimplemented");
 	case Primitive:	EMITio(iPUSH, exp);	return;
 	case Reference: assert(!"unimplemented");
 	case Closure:	EMITio(iPUSH, exp);	return;
@@ -2754,6 +2830,7 @@ void compileOn(oop exp, oop program, oop cs, oop bs)
 	}
 	case Address:		assert(0);
 	case Dereference:	assert(0);
+	case Sizeof:		assert(0);
 	case Unary: {
 	    compileOn(get(exp, Unary,rhs), program, cs, bs);
 	    switch (get(exp, Unary,operator)) {
@@ -2920,6 +2997,12 @@ oop compile(oop exp) // 6*7
     return program;
 }
 
+int isType(oop obj)
+{
+    type_t type = getType(obj);
+    return Tvoid <= type && type <= Tfunction;
+}
+
 int typeSize(oop type)
 {
     switch (getType(type)) {
@@ -2941,6 +3024,7 @@ int typeSize(oop type)
 
 oop typeCheck(oop exp, oop fntype)
 {
+    printf("TYPECHECK "); println(exp);
     switch (getType(exp)) {
 	case Integer:	return t_int;
 	case Float:	return t_float;
@@ -2979,6 +3063,12 @@ oop typeCheck(oop exp, oop fntype)
 	    set(exp, Cast,converter, cvt);
 	    return lhs;
 	}
+	case Sizeof: {
+	    oop rhs  = get(exp, Sizeof,rhs);
+	    if (!isType(rhs)) rhs = typeCheck(rhs, fntype);	assert(isType(rhs));
+	    set(exp, Sizeof,size, newInteger(typeSize(rhs)));
+	    return t_long;
+	}
 	case Unary: {
 	    oop rhs = typeCheck(get(exp, Unary,rhs), fntype);
 	    switch (get(exp, Unary,operator)) {
@@ -2986,7 +3076,7 @@ oop typeCheck(oop exp, oop fntype)
 		case NOT:	assert(!"unimplemented");
 		case COM:	assert(!"unimplemented");
 		case PREINC:	return rhs;
-		case PREDEC:	assert(!"unimplemented");
+		case PREDEC:	return rhs;
 		case POSTINC:	assert(!"unimplemented");
 		case POSTDEC:	assert(!"unimplemented");
 	    }
@@ -3091,8 +3181,10 @@ oop typeCheck(oop exp, oop fntype)
             fntype = newTfunction(result, ptypes);
 	    set(exp, Primitive,type, fntype);
 #         define _(X) if (s_##X == name) set(exp, Primitive,function, prim_##X);
-	    _do_primitives(_)
+	    _do_primitives(_);
 #         undef _
+	    if (!get(exp, Primitive,function))
+		fatal("external symbol '%s' is undefined", toString(name));
 	    declare(name, exp);
 	    return nil;
 	}
@@ -3154,17 +3246,20 @@ oop typeCheck(oop exp, oop fntype)
 	    int  parc   = get(params, Array,size);
 	    oop *parv   = get(params, Array,elements);
 	    int  vararg = parc && (t_etc == parv[parc - 1]);
+	    printf("argc %d parc %d\n", argc, parc);
 	    if ((!vararg && (argc != parc)) || (vararg && (argc < parc - 1)))
 		fatal("wrong number (%d) of arguments, expected %d", argc, parc);
-	    for (int i = 0;  i < argc;  ++i) {
-		oop part = parv[i];
+	    int  argn = 0;
+	    while (argn < argc) {
+		oop part = parv[argn];
 		if (part == t_etc) break;
-		oop arg  = argv[i];
+		oop arg  = argv[argn++];
 		oop argt = typeCheck(arg, fntype);
 		if (argt != part)
 		    fatal("cannot pass argument of type '%s' to parameter of type '%s': %s ",
 			  toString(argt), toString(part), toString(exp));
 	    }
+	    while (argn < argc) typeCheck(argv[argn++], fntype);
 	    return get(tfunc, Tfunction,result);
 	}
 	case Return: {
@@ -3223,6 +3318,9 @@ 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);
+		Array_append(vars, var);
 		if (!isNil(init)) {
 		    oop initype = typeCheck(init, fntype);
 		    cvt_t cvt   = converter(getType(initype), getType(vartype));
@@ -3231,8 +3329,6 @@ oop typeCheck(oop exp, oop fntype)
 			      toString(varname), toString(vartype), toString(initype));
 		    }
 		}
-		oop var = declareVariable(varname, vartype, init);
-		Array_append(vars, var);
 	    }
 	    set(exp, VarDecls,variables, vars);
 	    return nil;

test.txt

@@ -29,6 +29,7 @@ int main(int argc, char **argv)
     printf("\n");
     while (x > 0) printf("%d ", --x);
     printf("\n");
+    printf("%d\n", sizeof(char *));
     return 0;
 }