|
@ -1,6 +1,6 @@ |
|
|
# main.leg -- C parser + interpreter |
|
|
# main.leg -- C parser + interpreter |
|
|
# |
|
|
# |
|
|
# Last edited: 2025-01-28 12:32:11 by piumarta on zora-1043.local |
|
|
|
|
|
|
|
|
# Last edited: 2025-01-29 16:00:13 by piumarta on xubuntu |
|
|
|
|
|
|
|
|
%{ |
|
|
%{ |
|
|
; |
|
|
; |
|
@ -1039,15 +1039,17 @@ oop toStringOn(oop obj, oop str) |
|
|
} |
|
|
} |
|
|
case Array: { |
|
|
case Array: { |
|
|
oop base = get(obj, Array,base); |
|
|
oop base = get(obj, Array,base); |
|
|
|
|
|
oop type = get(obj, Array,type); |
|
|
|
|
|
String_format(str, "[%s ", toString(type)); |
|
|
switch (getType(base)) { |
|
|
switch (getType(base)) { |
|
|
case Integer: |
|
|
case Integer: |
|
|
String_format(str, "[%p", (void *)(intptr_t)_integerValue(base)); |
|
|
|
|
|
|
|
|
String_format(str, "%p", (void *)(intptr_t)_integerValue(base)); |
|
|
break; |
|
|
break; |
|
|
case Variable: |
|
|
case Variable: |
|
|
String_format(str, "[&%s", symbolName(get(base, Variable,name))); |
|
|
|
|
|
|
|
|
String_format(str, "&%s", symbolName(get(base, Variable,name))); |
|
|
break; |
|
|
break; |
|
|
case Memory: |
|
|
case Memory: |
|
|
String_format(str, "[%p[%d]", get(base, Memory,base), get(base, Memory,size)); |
|
|
|
|
|
|
|
|
String_format(str, "%p[%d]", get(base, Memory,base), get(base, Memory,size)); |
|
|
break; |
|
|
break; |
|
|
default: |
|
|
default: |
|
|
fatal("cannot convert array base %s to string", toString(base)); |
|
|
fatal("cannot convert array base %s to string", toString(base)); |
|
@ -1795,8 +1797,8 @@ tnamdec = t:tname d:decltor { $$ = makeType(t, d) } |
|
|
|
|
|
|
|
|
postfix = v:value ( a:args { v = newCall(v, a) } |
|
|
postfix = v:value ( a:args { v = newCall(v, a) } |
|
|
| i:index { v = newIndex(v, i) } |
|
|
| i:index { v = newIndex(v, i) } |
|
|
| PPLUS { v = newUnary(POSTINC, a) } |
|
|
|
|
|
| MMINUS { v = newUnary(POSTDEC, a) } |
|
|
|
|
|
|
|
|
| PPLUS { v = newUnary(POSTINC, v) } |
|
|
|
|
|
| MMINUS { v = newUnary(POSTDEC, v) } |
|
|
)* { $$ = v } |
|
|
)* { $$ = v } |
|
|
|
|
|
|
|
|
args = LPAREN a:mkList |
|
|
args = LPAREN a:mkList |
|
@ -2104,7 +2106,11 @@ oop incr(oop val, int amount) |
|
|
switch (getType(val)) { |
|
|
switch (getType(val)) { |
|
|
case Integer: return newInteger(integerValue(val) + amount); |
|
|
case Integer: return newInteger(integerValue(val) + amount); |
|
|
case Float: return newFloat ( floatValue(val) + amount); |
|
|
case Float: return newFloat ( floatValue(val) + amount); |
|
|
default: fatal("cannot increment: %s", toString(val)); |
|
|
|
|
|
|
|
|
case Pointer: return newPointer(get(val, Pointer,type), |
|
|
|
|
|
get(val, Pointer,base), |
|
|
|
|
|
get(val, Pointer,offset) + amount); |
|
|
|
|
|
default: |
|
|
|
|
|
fatal("cannot increment: %s", toString(val)); |
|
|
} |
|
|
} |
|
|
return nil; |
|
|
return nil; |
|
|
} |
|
|
} |
|
@ -2196,6 +2202,25 @@ oop prim_printf(int argc, oop *argv, oop env) // array |
|
|
printf("%+d>", get(arg, Pointer,offset)); |
|
|
printf("%+d>", get(arg, Pointer,offset)); |
|
|
continue; |
|
|
continue; |
|
|
} |
|
|
} |
|
|
|
|
|
case Array: { |
|
|
|
|
|
oop base = get(arg, Array,base); |
|
|
|
|
|
switch (getType(base)) { |
|
|
|
|
|
case Integer: |
|
|
|
|
|
n += printf("[%p", (void *)(intptr_t)_integerValue(base)); |
|
|
|
|
|
break; |
|
|
|
|
|
case Variable: |
|
|
|
|
|
n += printf("[&%s", symbolName(get(base, Variable,name))); |
|
|
|
|
|
break; |
|
|
|
|
|
case Memory: |
|
|
|
|
|
n += printf("[%p[%zd]", get(base, Memory,base), get(base, Memory,size)); |
|
|
|
|
|
break; |
|
|
|
|
|
default: |
|
|
|
|
|
fatal("%%p conversion base is %s", getTypeName(base)); |
|
|
|
|
|
break; |
|
|
|
|
|
} |
|
|
|
|
|
printf("[%d]]", get(arg, Array,size)); |
|
|
|
|
|
continue; |
|
|
|
|
|
} |
|
|
default: |
|
|
default: |
|
|
break; |
|
|
break; |
|
|
} |
|
|
} |
|
@ -2344,7 +2369,7 @@ oop typeCheck(oop exp, oop fntype) |
|
|
case COM: assert(!"unimplemented"); |
|
|
case COM: assert(!"unimplemented"); |
|
|
case PREINC: return rhs; |
|
|
case PREINC: return rhs; |
|
|
case PREDEC: return rhs; |
|
|
case PREDEC: return rhs; |
|
|
case POSTINC: assert(!"unimplemented"); |
|
|
|
|
|
|
|
|
case POSTINC: return rhs; |
|
|
case POSTDEC: assert(!"unimplemented"); |
|
|
case POSTDEC: assert(!"unimplemented"); |
|
|
} |
|
|
} |
|
|
return nil; |
|
|
return nil; |
|
@ -2357,7 +2382,7 @@ oop typeCheck(oop exp, oop fntype) |
|
|
if (lhs == rhs) { |
|
|
if (lhs == rhs) { |
|
|
if (t_int == lhs) return lhs; |
|
|
if (t_int == lhs) return lhs; |
|
|
} |
|
|
} |
|
|
fatal("cannot add '%s' and '%s'", toString(lhs), toString(rhs)); |
|
|
|
|
|
|
|
|
fatal("cannot multiply '%s' and '%s'", toString(lhs), toString(rhs)); |
|
|
break; |
|
|
break; |
|
|
} |
|
|
} |
|
|
case DIV: assert(!"unimplemented"); break; |
|
|
case DIV: assert(!"unimplemented"); break; |
|
@ -2366,6 +2391,12 @@ oop typeCheck(oop exp, oop fntype) |
|
|
if (lhs == rhs) { |
|
|
if (lhs == rhs) { |
|
|
if (t_int == lhs) return lhs; |
|
|
if (t_int == lhs) return lhs; |
|
|
} |
|
|
} |
|
|
|
|
|
if (is(Tpointer, lhs) && t_int == rhs) { |
|
|
|
|
|
return lhs; |
|
|
|
|
|
} |
|
|
|
|
|
if (is(Tarray, lhs) && t_int == rhs) { |
|
|
|
|
|
return newTpointer(get(lhs, Tarray,target)); |
|
|
|
|
|
} |
|
|
fatal("cannot add '%s' and '%s'", toString(lhs), toString(rhs)); |
|
|
fatal("cannot add '%s' and '%s'", toString(lhs), toString(rhs)); |
|
|
break; |
|
|
break; |
|
|
} |
|
|
} |
|
@ -2400,8 +2431,20 @@ oop typeCheck(oop exp, oop fntype) |
|
|
case Assign: { |
|
|
case Assign: { |
|
|
oop lhs = typeCheck(get(exp, Assign,lhs), fntype); |
|
|
oop lhs = typeCheck(get(exp, Assign,lhs), fntype); |
|
|
oop rhs = typeCheck(get(exp, Assign,rhs), fntype); |
|
|
oop rhs = typeCheck(get(exp, Assign,rhs), fntype); |
|
|
if (lhs != rhs) |
|
|
|
|
|
fatal("incompatible types assigning '%s' to '%s'", toString(rhs), toString(lhs)); |
|
|
|
|
|
|
|
|
if (lhs == rhs) return lhs; |
|
|
|
|
|
int lht = getType(lhs), rht = getType(rhs); |
|
|
|
|
|
if (Tpointer == lht) { |
|
|
|
|
|
oop target = nil; |
|
|
|
|
|
switch (rht) { |
|
|
|
|
|
case Tpointer: target = get(rhs, Tpointer,target); break; |
|
|
|
|
|
case Tarray: target = get(rhs, Tarray, target); break; |
|
|
|
|
|
default: goto error; |
|
|
|
|
|
} |
|
|
|
|
|
if (get(lhs, Tpointer,target) == target) return lhs; |
|
|
|
|
|
goto error; |
|
|
|
|
|
} |
|
|
|
|
|
error: |
|
|
|
|
|
fatal("incompatible types assigning '%s' to '%s'", toString(rhs), toString(lhs)); |
|
|
return lhs; |
|
|
return lhs; |
|
|
} |
|
|
} |
|
|
case If: { |
|
|
case If: { |
|
@ -2609,11 +2652,29 @@ oop typeCheck(oop exp, oop fntype) |
|
|
oop var = declareVariable(varname, vartype, init); |
|
|
oop var = declareVariable(varname, vartype, init); |
|
|
List_append(vars, var); |
|
|
List_append(vars, var); |
|
|
if (!isNil(init)) { |
|
|
if (!isNil(init)) { |
|
|
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)); |
|
|
|
|
|
|
|
|
if (is(Tarray, vartype)) { |
|
|
|
|
|
if (!is(List, init)) fatal("aggregate initialiser expected for array"); |
|
|
|
|
|
int isize = List_size(init); |
|
|
|
|
|
oop osize = get(vartype, Tarray,size); |
|
|
|
|
|
int asize = isize; |
|
|
|
|
|
if (!isNil(osize)) asize = _integerValue(osize); |
|
|
|
|
|
if (isize < asize) fatal("too few initialisers for array"); |
|
|
|
|
|
if (isize > asize) fatal("too many initialisers for array"); |
|
|
|
|
|
oop etype = get(vartype, Tarray,target); |
|
|
|
|
|
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 { |
|
|
|
|
|
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)); |
|
|
|
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
@ -2654,10 +2715,91 @@ oop typeCheck(oop exp, oop fntype) |
|
|
default: |
|
|
default: |
|
|
break; |
|
|
break; |
|
|
} |
|
|
} |
|
|
|
|
|
println(exp); |
|
|
fatal("cannot typeCheck: %s", toString(exp)); |
|
|
fatal("cannot typeCheck: %s", toString(exp)); |
|
|
return 0; |
|
|
return 0; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
oop getPointer(oop ptr) |
|
|
|
|
|
{ |
|
|
|
|
|
oop base = get(ptr, Pointer,base); |
|
|
|
|
|
int offset = get(ptr, Pointer,offset); |
|
|
|
|
|
oop type = get(get(ptr, Pointer,type), Tpointer,target); |
|
|
|
|
|
int scale = typeSize(type); |
|
|
|
|
|
switch (getType(base)) { |
|
|
|
|
|
case Variable: { |
|
|
|
|
|
if (offset != 0) fatal("pointer to variable no longer points to its variable"); |
|
|
|
|
|
return get(base, Variable,value); |
|
|
|
|
|
} |
|
|
|
|
|
case Memory: { |
|
|
|
|
|
void *addr = get(base, Memory,base) + offset * scale; |
|
|
|
|
|
assert(addr < get(base, Memory,base) + get(base, Memory,size)); |
|
|
|
|
|
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; |
|
|
|
|
|
} |
|
|
|
|
|
break; |
|
|
|
|
|
} |
|
|
|
|
|
default: |
|
|
|
|
|
break; |
|
|
|
|
|
} |
|
|
|
|
|
fatal("cannot load '%s' through pointer", getTypeName(type)); |
|
|
|
|
|
return 0; |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
oop getArray(oop array, int index) |
|
|
|
|
|
{ |
|
|
|
|
|
int size = get(array, Array,size); |
|
|
|
|
|
if (index < 0) fatal("array index is negative"); |
|
|
|
|
|
if (index >= size) fatal("array index out of bounds"); |
|
|
|
|
|
oop base = get(array, Array,base); |
|
|
|
|
|
oop type = get(get(array, Array,type), Tarray,target); |
|
|
|
|
|
int scale = typeSize(type); |
|
|
|
|
|
assert(is(Memory, base)); |
|
|
|
|
|
void *addr = get(base, Memory,base) + index * scale; |
|
|
|
|
|
assert(addr < get(base, Memory,base) + get(base, Memory,size)); |
|
|
|
|
|
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 array", getTypeName(type)); |
|
|
|
|
|
return 0; |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
oop setArray(oop array, int index, oop value) |
|
|
|
|
|
{ |
|
|
|
|
|
int size = get(array, Array,size); |
|
|
|
|
|
if (index < 0) fatal("array index is negative"); |
|
|
|
|
|
if (index >= size) fatal("array index out of bounds"); |
|
|
|
|
|
oop base = get(array, Array,base); |
|
|
|
|
|
oop type = get(get(array, Array,type), Tarray,target); |
|
|
|
|
|
int scale = typeSize(type); |
|
|
|
|
|
assert(is(Memory, base)); |
|
|
|
|
|
void *addr = get(base, Memory,base) + index * scale; |
|
|
|
|
|
assert(addr < get(base, Memory,base) + get(base, Memory,size)); |
|
|
|
|
|
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 array", getTypeName(type)); |
|
|
|
|
|
return 0; |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
oop assign(oop lhs, oop rhs) |
|
|
oop assign(oop lhs, oop rhs) |
|
|
{ |
|
|
{ |
|
|
//printf("ASSIGN "); println(lhs); |
|
|
//printf("ASSIGN "); println(lhs); |
|
@ -2678,8 +2820,12 @@ oop assign(oop lhs, oop rhs) |
|
|
rhs = newPointer(ltype, get(rhs, Pointer,base), get(rhs, Pointer,offset)); |
|
|
rhs = newPointer(ltype, get(rhs, Pointer,base), get(rhs, Pointer,offset)); |
|
|
break; |
|
|
break; |
|
|
} |
|
|
} |
|
|
|
|
|
case Array: { |
|
|
|
|
|
rhs = newPointer(ltype, get(rhs, Array,base), 0); |
|
|
|
|
|
break; |
|
|
|
|
|
} |
|
|
default: { |
|
|
default: { |
|
|
fatal("cannot assign '%s' = '%s'", getTypeName(lhs), getTypeName(rhs)); |
|
|
|
|
|
|
|
|
fatal("cannot assign '%s' = '%s'", toString(lhs), toString(rhs)); |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
@ -2691,26 +2837,7 @@ oop assign(oop lhs, oop rhs) |
|
|
int index = _integerValue(ondex); |
|
|
int index = _integerValue(ondex); |
|
|
lhs = eval(get(lhs, Index,lhs), nil); |
|
|
lhs = eval(get(lhs, Index,lhs), nil); |
|
|
switch (getType(lhs)) { |
|
|
switch (getType(lhs)) { |
|
|
case Array: { |
|
|
|
|
|
int size = get(lhs, Array,size); |
|
|
|
|
|
if (index < 0) fatal("array index is negative"); |
|
|
|
|
|
if (index >= size) fatal("array index out of bounds"); |
|
|
|
|
|
oop base = get(lhs, Array,base); |
|
|
|
|
|
oop type = get(get(lhs, Array,type), Tarray,target); |
|
|
|
|
|
int scale = typeSize(type); |
|
|
|
|
|
assert(is(Memory, base)); |
|
|
|
|
|
void *addr = get(base, Memory,base) + index * scale; |
|
|
|
|
|
switch (getType(type)) { |
|
|
|
|
|
case Tchar: return newInteger(*(char *)addr = _integerValue(rhs)); |
|
|
|
|
|
case Tshort: return newInteger(*(short *)addr = _integerValue(rhs)); |
|
|
|
|
|
case Tint: return newInteger(*(int *)addr = _integerValue(rhs)); |
|
|
|
|
|
case Tlong: return newInteger(*(long *)addr = _integerValue(rhs)); |
|
|
|
|
|
case Tfloat: return newFloat (*(float *)addr = _floatValue(rhs)); |
|
|
|
|
|
case Tdouble: return newFloat (*(double *)addr = _floatValue(rhs)); |
|
|
|
|
|
default: break; |
|
|
|
|
|
} |
|
|
|
|
|
fatal("cannot store '%s' into array", getTypeName(type)); |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
case Array: return setArray(lhs, index, rhs); |
|
|
default: break; |
|
|
default: break; |
|
|
} |
|
|
} |
|
|
break; |
|
|
break; |
|
@ -2792,6 +2919,42 @@ int equal(oop a, oop b) |
|
|
return 0; |
|
|
return 0; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
int compare(oop a, oop b) |
|
|
|
|
|
{ |
|
|
|
|
|
# define CMP(A, B) ((A) < (B) ? -1 : (A) > (B) ? 1 : 0) |
|
|
|
|
|
if (a == b) return 0; |
|
|
|
|
|
type_t ta = getType(a), tb = getType(b); |
|
|
|
|
|
if (ta == tb) { |
|
|
|
|
|
switch (getType(a)) { |
|
|
|
|
|
case Integer: return CMP(_integerValue(a), _integerValue(b)); |
|
|
|
|
|
case Float: return CMP( _floatValue(a), _floatValue(b)); |
|
|
|
|
|
case Pointer: { |
|
|
|
|
|
oop ba = get(a, Pointer,base), bb = get(b, Pointer,base); |
|
|
|
|
|
if (ba != bb) fatal("comparing pointers to different objects"); |
|
|
|
|
|
int oa = get(a, Pointer,offset), ob = get(b, Pointer,offset); |
|
|
|
|
|
return CMP(oa, ob); |
|
|
|
|
|
} |
|
|
|
|
|
default: break; |
|
|
|
|
|
} |
|
|
|
|
|
fatal("cannot compare %ss", getTypeName(a)); |
|
|
|
|
|
} |
|
|
|
|
|
else { |
|
|
|
|
|
if (is(Pointer, a) && is(Integer, b)) { |
|
|
|
|
|
oop base = get(a, Pointer,base); |
|
|
|
|
|
if (is(Integer, base)) { |
|
|
|
|
|
oop type = get(a, Pointer,type); |
|
|
|
|
|
int offset = get(a, Pointer,offset); |
|
|
|
|
|
int scale = typeSize(get(type, Tpointer,target)); |
|
|
|
|
|
return _integerValue(base) + offset * scale == _integerValue(b); |
|
|
|
|
|
} |
|
|
|
|
|
return 0; |
|
|
|
|
|
} |
|
|
|
|
|
} |
|
|
|
|
|
fatal("cannot compare %s with %s", getTypeName(a), getTypeName(b)); |
|
|
|
|
|
return 0; |
|
|
|
|
|
# undef CMP |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
oop eval(oop exp, oop env) |
|
|
oop eval(oop exp, oop env) |
|
|
{ |
|
|
{ |
|
|
if (opt_v > 2) { printf("EVAL "); println(exp); } |
|
|
if (opt_v > 2) { printf("EVAL "); println(exp); } |
|
@ -2869,14 +3032,7 @@ oop eval(oop exp, oop env) |
|
|
oop rhs = get(exp, Dereference,rhs); |
|
|
oop rhs = get(exp, Dereference,rhs); |
|
|
rhs = eval(rhs, nil); |
|
|
rhs = eval(rhs, nil); |
|
|
switch (getType(rhs)) { |
|
|
switch (getType(rhs)) { |
|
|
case Pointer: { |
|
|
|
|
|
oop base = get(rhs, Pointer,base); |
|
|
|
|
|
switch (getType(base)) { |
|
|
|
|
|
case Variable: return get(base, Variable,value); |
|
|
|
|
|
default: break; |
|
|
|
|
|
} |
|
|
|
|
|
break; |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
case Pointer: return getPointer(rhs); |
|
|
default: break; |
|
|
default: break; |
|
|
} |
|
|
} |
|
|
printf("cannot dereference\n"); |
|
|
printf("cannot dereference\n"); |
|
@ -2899,16 +3055,16 @@ oop eval(oop exp, oop env) |
|
|
rhs = Scope_lookup(rhs); |
|
|
rhs = Scope_lookup(rhs); |
|
|
switch (getType(rhs)) { |
|
|
switch (getType(rhs)) { |
|
|
case Variable: { |
|
|
case Variable: { |
|
|
oop val = get(rhs, Variable,value); |
|
|
|
|
|
oop result = nil; |
|
|
|
|
|
|
|
|
oop value = get(rhs, Variable,value); |
|
|
|
|
|
oop result = value; |
|
|
switch (op) { |
|
|
switch (op) { |
|
|
case PREINC: val = incr(val, 1); result = val; break; |
|
|
|
|
|
case PREDEC: val = incr(val, -1); result = val; break; |
|
|
|
|
|
case POSTINC: result = val; val = incr(val, 1); break; |
|
|
|
|
|
case POSTDEC: result = val; val = incr(val, -1); break; |
|
|
|
|
|
|
|
|
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"); |
|
|
default: assert("!this cannot happen"); |
|
|
} |
|
|
} |
|
|
set(rhs, Variable,value, val); |
|
|
|
|
|
|
|
|
set(rhs, Variable,value, value); |
|
|
return result; |
|
|
return result; |
|
|
} |
|
|
} |
|
|
default: break; |
|
|
default: break; |
|
@ -2965,16 +3121,30 @@ oop eval(oop exp, oop env) |
|
|
break; |
|
|
break; |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
|
else { // integer result |
|
|
|
|
|
|
|
|
else { // non-float result |
|
|
switch (get(exp, Binary,operator)) { |
|
|
switch (get(exp, Binary,operator)) { |
|
|
case MUL: return IBINOP(lhs, * , rhs); |
|
|
case MUL: return IBINOP(lhs, * , rhs); |
|
|
case DIV: return IBINOP(lhs, / , rhs); |
|
|
case DIV: return IBINOP(lhs, / , rhs); |
|
|
case MOD: return IBINOP(lhs, % , rhs); |
|
|
case MOD: return IBINOP(lhs, % , rhs); |
|
|
case ADD: 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 SUB: return IBINOP(lhs, - , rhs); |
|
|
case SHL: return IBINOP(lhs, <<, rhs); |
|
|
case SHL: return IBINOP(lhs, <<, rhs); |
|
|
case SHR: return IBINOP(lhs, >>, rhs); |
|
|
case SHR: return IBINOP(lhs, >>, rhs); |
|
|
case LT: return IRELOP(lhs, < , rhs); |
|
|
|
|
|
|
|
|
case LT: return compare(lhs, rhs) < 0 ? true : false; |
|
|
case LE: return IRELOP(lhs, <=, rhs); |
|
|
case LE: return IRELOP(lhs, <=, rhs); |
|
|
case GE: return IRELOP(lhs, >=, rhs); |
|
|
case GE: return IRELOP(lhs, >=, rhs); |
|
|
case GT: return IRELOP(lhs, > , rhs); |
|
|
case GT: return IRELOP(lhs, > , rhs); |
|
@ -2999,26 +3169,7 @@ oop eval(oop exp, oop env) |
|
|
int index = _integerValue(ondex); |
|
|
int index = _integerValue(ondex); |
|
|
oop lhs = eval(get(exp, Index,lhs), nil); |
|
|
oop lhs = eval(get(exp, Index,lhs), nil); |
|
|
switch (getType(lhs)) { |
|
|
switch (getType(lhs)) { |
|
|
case Array: { |
|
|
|
|
|
int size = get(lhs, Array,size); |
|
|
|
|
|
if (index < 0) fatal("array index is negative"); |
|
|
|
|
|
if (index >= size) fatal("array index out of bounds"); |
|
|
|
|
|
oop base = get(lhs, Array,base); |
|
|
|
|
|
oop type = get(get(lhs, Array,type), Tarray,target); |
|
|
|
|
|
int scale = typeSize(type); |
|
|
|
|
|
assert(is(Memory, base)); |
|
|
|
|
|
void *addr = get(base, Memory,base) + index * scale; |
|
|
|
|
|
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 read '%s' from array", getTypeName(type)); |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
case Array: return getArray(lhs, index); |
|
|
default: break; |
|
|
default: break; |
|
|
} |
|
|
} |
|
|
break; |
|
|
break; |
|
@ -3131,9 +3282,17 @@ oop eval(oop exp, oop env) |
|
|
assert(!"unimplemented"); |
|
|
assert(!"unimplemented"); |
|
|
} |
|
|
} |
|
|
valu = newArray(type, newMemory(mem, typeSize(target) * size), size); |
|
|
valu = newArray(type, newMemory(mem, typeSize(target) * size), size); |
|
|
|
|
|
if (!isNil(init)) { // size and types checked during typeCheck |
|
|
|
|
|
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)); |
|
|
} |
|
|
} |
|
|
oop var = declareVariable(name, type, valu); |
|
|
|
|
|
if (!isNil(init)) assign(var, eval(init, nil)); |
|
|
|
|
|
} |
|
|
} |
|
|
return nil; |
|
|
return nil; |
|
|
} |
|
|
} |
|
|