|
|
@ -1,6 +1,6 @@ |
|
|
|
# main.leg -- C parser + interpreter |
|
|
|
# |
|
|
|
# Last edited: 2025-01-31 13:17:21 by piumarta on xubuntu |
|
|
|
# Last edited: 2025-01-31 15:07:48 by piumarta on xubuntu |
|
|
|
|
|
|
|
%{ |
|
|
|
; |
|
|
@ -2483,11 +2483,10 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
return newTpointer(typeCheck(get(exp, Addressof,rhs), fntype)); |
|
|
|
} |
|
|
|
case Dereference: { |
|
|
|
oop rhs = typeCheck(get(exp, Dereference,rhs), fntype); |
|
|
|
if (!is(Tpointer, rhs)) { |
|
|
|
fatal("cannot dereference '%s'", toString(rhs)); |
|
|
|
} |
|
|
|
return get(rhs, Tpointer,target); |
|
|
|
oop rhs = get(exp, Dereference,rhs); |
|
|
|
oop rht = typeCheck(rhs, fntype); |
|
|
|
if (!is(Tpointer, rht)) fatal("cannot dereference '%s'", toString(rhs)); |
|
|
|
return get(rht, Tpointer,target); |
|
|
|
} |
|
|
|
case Cast: { |
|
|
|
oop lhs = makeBaseType(get(exp, Cast,type)); |
|
|
@ -2511,15 +2510,26 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
return t_long; |
|
|
|
} |
|
|
|
case Unary: { |
|
|
|
oop rhs = typeCheck(get(exp, Unary,rhs), fntype); |
|
|
|
oop rhs = get(exp, Unary,rhs); |
|
|
|
oop rht = typeCheck(rhs, fntype); |
|
|
|
switch (get(exp, Unary,operator)) { |
|
|
|
case NEG: assert(!"unimplemented"); |
|
|
|
case NOT: assert(!"unimplemented"); |
|
|
|
case COM: assert(!"unimplemented"); |
|
|
|
case PREINC: return rhs; |
|
|
|
case PREDEC: return rhs; |
|
|
|
case POSTINC: return rhs; |
|
|
|
case POSTDEC: assert(!"unimplemented"); |
|
|
|
case NEG: |
|
|
|
switch (getType(rht)) { |
|
|
|
case Tchar: case Tshort: case Tint: return t_int; |
|
|
|
case Tfloat: case Tdouble: return rht; |
|
|
|
default: fatal("cannot negate: %s", toString(rhs)); |
|
|
|
} |
|
|
|
case NOT: return t_int; |
|
|
|
case COM: |
|
|
|
switch (getType(rht)) { |
|
|
|
case Tint: case Tlong: return rht; |
|
|
|
default: fatal("cannot complement: %s", toString(rhs)); |
|
|
|
return t_int; |
|
|
|
} |
|
|
|
case PREINC: return rht; |
|
|
|
case PREDEC: return rht; |
|
|
|
case POSTINC: return rht; |
|
|
|
case POSTDEC: return rht; |
|
|
|
} |
|
|
|
return nil; |
|
|
|
} |
|
|
@ -2529,13 +2539,24 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
switch (get(exp, Binary,operator)) { |
|
|
|
case MUL: { |
|
|
|
if (lhs == rhs) { |
|
|
|
if (t_int == lhs) return lhs; |
|
|
|
if (t_float == lhs) return lhs; |
|
|
|
if (t_int == lhs) return lhs; |
|
|
|
if (t_long == lhs) return lhs; |
|
|
|
if (t_float == lhs) return lhs; |
|
|
|
if (t_double == lhs) return lhs; |
|
|
|
} |
|
|
|
fatal("cannot multiply '%s' and '%s'", toString(lhs), toString(rhs)); |
|
|
|
break; |
|
|
|
} |
|
|
|
case DIV: assert(!"unimplemented"); break; |
|
|
|
case DIV: { |
|
|
|
if (lhs == rhs) { |
|
|
|
if (t_int == lhs) return lhs; |
|
|
|
if (t_long == lhs) return lhs; |
|
|
|
if (t_float == lhs) return lhs; |
|
|
|
if (t_double == lhs) return lhs; |
|
|
|
} |
|
|
|
fatal("cannot divide '%s' and '%s'", toString(lhs), toString(rhs)); |
|
|
|
break; |
|
|
|
} |
|
|
|
case MOD: assert(!"unimplemented"); break; |
|
|
|
case ADD: { |
|
|
|
if (lhs == rhs) { |
|
|
@ -2825,42 +2846,62 @@ oop typeCheck(oop exp, oop fntype) |
|
|
|
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"); |
|
|
|
switch (getType(vartype)) { |
|
|
|
case Tarray: { |
|
|
|
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)); |
|
|
|
} |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
if (is(List, init)) { |
|
|
|
List_do(init, ini) { |
|
|
|
case Tstruct: { |
|
|
|
assert(is(List, init)); |
|
|
|
oop members = get(vartype, Tstruct,members); |
|
|
|
int ssize = get(members, List,size); |
|
|
|
int isize = List_size(init); |
|
|
|
if (isize != ssize) fatal("wrong number of structure initialisers\n"); |
|
|
|
List_do(members, member) { |
|
|
|
oop ini = List_get(init, do_index); |
|
|
|
oop itype = typeCheck(ini, fntype); |
|
|
|
if (itype != etype) |
|
|
|
fatal("cannot initialise array element type '%s' with '%s'", |
|
|
|
toString(etype), toString(itype)); |
|
|
|
oop mtype = get(member, Variable,type); |
|
|
|
if (itype != mtype) |
|
|
|
fatal("incompatible types initialising member '%s'", |
|
|
|
get(member, Variable,name)); |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
} |
|
|
|
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)); |
|
|
|
default: { |
|
|
|
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)); |
|
|
|
} |
|
|
|
break; |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
@ -3250,8 +3291,11 @@ void initialiseVariable(oop var, int local) |
|
|
|
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 (isNil(init)) { // size and types checked during typeCheck |
|
|
|
if (local) |
|
|
|
randomise(mem, memsize); |
|
|
|
} |
|
|
|
else { // 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); |
|
|
@ -3274,7 +3318,19 @@ void initialiseVariable(oop var, int local) |
|
|
|
void *mem = CALLOC(1, size); |
|
|
|
oop memory = newMemory(mem, size); |
|
|
|
oop value = newStruct(type, memory); |
|
|
|
if (local) randomise(mem, size); |
|
|
|
if (isNil(init)) { |
|
|
|
if (local) |
|
|
|
randomise(mem, size); |
|
|
|
} |
|
|
|
else { // size and types checked during typeCheck |
|
|
|
oop members = get(type, Tstruct,members); |
|
|
|
List_do(members, member) { |
|
|
|
int offset = _integerValue(get(member, Variable,value)); |
|
|
|
oop type = get(member, Variable,type); |
|
|
|
oop inival = evaluate(List_get(init, do_index)); |
|
|
|
setMemory(memory, offset, type, inival); |
|
|
|
} |
|
|
|
} |
|
|
|
set(var, Variable,value, value); |
|
|
|
break; |
|
|
|
} |
|
|
@ -3694,8 +3750,128 @@ oop preval(oop exp) |
|
|
|
case Addressof: break; |
|
|
|
case Dereference: break; |
|
|
|
case Sizeof: return get(exp, Sizeof,size); |
|
|
|
case Unary: break; |
|
|
|
case Binary: break; |
|
|
|
case Unary: { |
|
|
|
unary_t op = get(exp, Unary,operator); |
|
|
|
oop rhs = get(exp, Unary,rhs); |
|
|
|
switch (op) { |
|
|
|
case PREINC: |
|
|
|
case PREDEC: |
|
|
|
case POSTINC: |
|
|
|
case POSTDEC: { |
|
|
|
if (is(Symbol, rhs)) { |
|
|
|
rhs = Scope_lookup(rhs); |
|
|
|
switch (getType(rhs)) { |
|
|
|
case Variable: { |
|
|
|
oop value = get(rhs, Variable,value); |
|
|
|
oop result = value; |
|
|
|
switch (op) { |
|
|
|
case PREINC: result = value = incr(value, 1); break; |
|
|
|
case PREDEC: result = value = incr(value, -1); break; |
|
|
|
case POSTINC: result = value; value = incr(value, 1); break; |
|
|
|
case POSTDEC: result = value; value = incr(value, -1); break; |
|
|
|
default: assert("!this cannot happen"); |
|
|
|
} |
|
|
|
set(rhs, Variable,value, value); |
|
|
|
return result; |
|
|
|
} |
|
|
|
default: break; |
|
|
|
} |
|
|
|
} |
|
|
|
fatal("illegal increment operation: %s", toString(exp)); |
|
|
|
} |
|
|
|
case NEG: |
|
|
|
case NOT: |
|
|
|
case COM: { |
|
|
|
rhs = preval(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)); |
|
|
|
default: break; |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
assert("!this cannot happen"); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Binary: { |
|
|
|
oop lhs = get(exp, Binary,lhs); |
|
|
|
oop rhs = get(exp, Binary,rhs); |
|
|
|
switch (get(exp, Binary,operator)) { |
|
|
|
case LAND: return isFalse(preval(lhs)) ? false : preval(rhs); |
|
|
|
case LOR: return isTrue (preval(lhs)) ? true : preval(rhs); |
|
|
|
default: { |
|
|
|
lhs = preval(lhs); |
|
|
|
rhs = preval(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 LAND: |
|
|
|
case LOR: |
|
|
|
break; |
|
|
|
} |
|
|
|
} |
|
|
|
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 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); |
|
|
|
} |
|
|
|
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 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; |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
assert(!"this cannot happen"); |
|
|
|
break; |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
case Index: break; |
|
|
|
case Member: break; |
|
|
|
case Assign: break; |
|
|
@ -4219,6 +4395,7 @@ oop compile(oop exp) // 6*7 |
|
|
|
if (opt_v > 2) disassemble(program); |
|
|
|
return program; |
|
|
|
} |
|
|
|
|
|
|
|
void replFile(char *name, FILE *file) |
|
|
|
{ |
|
|
|
input = pushInput(name, file); |
|
|
|