static void ffi_ptr_dereference_assign(VMState *state, CallInfo *info) {
VM_ASSERT(info->args_len == 3, "wrong arity: expected 2, got %i", info->args_len);
Object *root = state->root;
Object *pointer_base = state->shared->vcache.pointer_base;
FFIObject *ffi = (FFIObject*) AS_OBJ(OBJECT_LOOKUP(root, ffi));
Object *ffi_type = AS_OBJ(OBJECT_LOOKUP((Object*) ffi, type));
Object *thisptr = AS_OBJ(load_arg(state->frame, info->this_arg));
VM_ASSERT(thisptr->parent == pointer_base, "internal error");
PointerObject *thisptr_obj = (PointerObject*) thisptr;
Object *ffi_type_obj = obj_instance_of(OBJ_OR_NULL(load_arg(state->frame, INFO_ARGS_PTR(info)[0])), ffi_type);
Value offs_val = load_arg(state->frame, INFO_ARGS_PTR(info)[1]);
VM_ASSERT(IS_INT(offs_val), "offset must be integer");
int offs = AS_INT(offs_val);
VM_ASSERT(ffi_type_obj, "type is not a FFI type");
char *offset_ptr = (char*) thisptr_obj->ptr + offs;
Value value = load_arg(state->frame, INFO_ARGS_PTR(info)[2]);
(void) offset_ptr; (void) value;
if (ffi_type_obj == ffi->long_obj) {
VM_ASSERT(IS_INT(value), "can only assign integer to long");
*(long*) offset_ptr = AS_INT(value);
} else {
fprintf(stderr, "TODO\n");
abort();
}
}
int nl_compare_internal(ImmT left, ImmT right) {
if (_global_const_begin_ != NULL && left >= _global_const_begin_ && left < _global_const_end_
&& right >= _global_const_begin_ && right < _global_const_end_) {
return left == right;
}
if (((NlData *)left)->type != ((NlData *)right)->type) {
if(IS_INT(left) && IS_STRING(right))
return eq_int_string((NlInt *)left, (NlString *)right);
if(IS_INT(right) && IS_STRING(left))
return eq_int_string((NlInt *)right, (NlString *)left);
if(IS_INT(right) && IS_FLOAT(left))
return ((NlInt *)right)->i == ((NlFloat *)left)->f;
if(IS_INT(left) && IS_FLOAT(right))
return ((NlInt *)left)->i == ((NlFloat *)right)->f;
if(IS_FLOAT(left) && IS_STRING(right))
return eq_float_string((NlFloat *)left, (NlString *)right);
if(IS_FLOAT(right) && IS_STRING(left))
return eq_float_string((NlFloat *)right, (NlString *)left);
return 0;
}
if (((NlData *)left)->type == ___TYPE_STRING) {
return compare_strings((NlString *)left, (NlString *)right) == 0;
} else if (((NlData *)left)->type == ___TYPE_INT) {
return (((NlInt *)left)->i == ((NlInt *)right)->i);
} else if (((NlData *)left)->type == ___TYPE_FLOAT) {
return (((NlFloat *)left)->f == ((NlFloat *)right)->f);
} else {
return left == right;
}
}
// Concatenate two strings. Now used only internally in the RTS.
Handle strconcatc(TaskData *mdTaskData, Handle y, Handle x)
/* Note: arguments are in the reverse order from Poly */
{
Handle result;
POLYUNSIGNED len, xlen, ylen;
char *from_ptr, *to_ptr;
if (IS_INT(DEREFWORD(x)))
xlen = 1;
else
xlen = DEREFSTRINGHANDLE(x)->length;
/* Don't concatenate with null strings */
if (xlen == 0) return y;
if (IS_INT(DEREFWORD(y)))
ylen = 1;
else
ylen = DEREFSTRINGHANDLE(y)->length;
if (ylen == 0) return x;
len = xlen + ylen;
/* Get store for combined string. Include rounding up to next word and
room for the length word and add in the flag. */
result = alloc_and_save(mdTaskData, (len + sizeof(PolyWord)-1)/sizeof(PolyWord) + 1, F_BYTE_OBJ);
DEREFSTRINGHANDLE(result)->length = len;
/* Copy first string */
to_ptr = DEREFSTRINGHANDLE(result)->chars;
if (xlen == 1)
{
*to_ptr++ = (char)UNTAGGED(DEREFSTRINGHANDLE(x));
}
else
{
from_ptr = DEREFSTRINGHANDLE(x)->chars;
while (xlen-- > 0) (*to_ptr++ = *from_ptr++);
}
/* Add on second */
if (ylen == 1)
{
*to_ptr = (char)UNTAGGED(DEREFSTRINGHANDLE(y));
}
else
{
from_ptr = DEREFSTRINGHANDLE(y)->chars;
while (ylen-- > 0) (*to_ptr++ = *from_ptr++);
}
return(result);
} /* strconcat */
void HandlePtrArith(short dest, short src0, char op, short src1)
/*
* Ptr arithmetic must be of form <ptr> = <ptr> [+,-] <int/const>
*/
{
short rs0, rs1, flag, type, dflag;
#ifdef X86_64
short k;
#endif
if (op != '+' && op != '-')
fko_error(__LINE__,"pointers may take only + and - operators");
if (!IS_PTR(STflag[src0-1]))
fko_error(__LINE__,"Expecting <ptr> = <ptr> + <int>");
/*
* Majedul: The concept of LIL as three address code violets here. We have
* multiple operations in single load-store block. For example:
* A1 = A0 + lda is actually treated as
* A1 = A0 + (lda * size)
* So, we have addition and shift in same load-store block. This would create
* redundant computation. We eliminate the redundant computation of (lda*size),
* we need to split this expression out and treated this as two HIL instruction
* while converting this into LIL, like:
* _lda = lda * size
* A1 = A0 + _lda
* NOTE: All variables starting with '_' are compiler's internal variables,
* should not be used as variable name in HIL
*/
dflag = STflag[dest-1];
type = FLAG2TYPE(dflag);
flag = STflag[src1-1];
if (IS_CONST(flag))
{
rs0 = LocalLoad(src0); /* load src0 */
if (IS_INT(flag))
#ifdef X86_64
{
if (IS_INT(dflag)) rs1 = -STiconstlookup(SToff[src1-1].i*4);
else rs1 = -STiconstlookup(SToff[src1-1].i*type2len(type));
}
#else
rs1 = -STiconstlookup(SToff[src1-1].i*type2len(type));
#endif
else
fko_error(__LINE__,"Pointers may only be incremented by integers");
}
static Handle setRegistryKey(TaskData *taskData, Handle args, HKEY hkey)
{
TCHAR valName[MAX_PATH];
LONG lRes;
PolyWord str = args->WordP()->Get(3);
POLYUNSIGNED length = Poly_string_to_C(args->WordP()->Get(1), valName, MAX_PATH);
DWORD dwType = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
if (length > MAX_PATH)
raise_syscall(taskData, "Value name too long", ENAMETOOLONG);
// The value is binary. Strings will already have had a null added.
if (IS_INT(str))
{
byte b = (byte)UNTAGGED(str);
// Single byte value.
lRes = RegSetValueEx(hkey, valName, 0, dwType, &b, 1);
}
else
{
PolyStringObject *ps = (PolyStringObject*)str.AsObjPtr();
lRes = RegSetValueEx(hkey, valName, 0, dwType,
(CONST BYTE *)ps->chars, (DWORD)ps->length);
}
if (lRes != ERROR_SUCCESS)
raise_syscall(taskData, "RegSetValue failed", -lRes);
return Make_arbitrary_precision(taskData, 0);
}
uptr_t eval(uptr_t *env, uptr_t form) {
if (IS_INT(form) || IS_NIL(form))
return form;
if (IS_SYM(form))
return get(*env, form);
if (IS_CONS(form)) {
uptr_t *form_p = refer(form),
*fn_p = refer(eval(env, CAR(*form_p))),
rval;
if (IS_SYM(*fn_p)) {
rval = exec_special(env, *form_p);
} else if (IS_CONS(*fn_p) && SVAL(CAR(*fn_p)) == S_FN) {
rval = _fn(env, *fn_p, eval_list(env, CDR(*form_p)));
} else {
printf_P(PSTR("ERROR: "));
print_form(CAR(*form_p));
printf_P(PSTR(" cannot be in function position.\n"));
rval = NIL;
}
release(2); // form_p, fn_p
return rval;
}
return NIL;
}
// Process the value at a given location and update it as necessary.
POLYUNSIGNED ScanAddress::ScanAddressAt(PolyWord *pt)
{
PolyWord val = *pt;
PolyWord newVal = val;
if (IS_INT(val) || val == PolyWord::FromUnsigned(0))
{
// We can get zeros in the constant area if we garbage collect
// while compiling some code. */
}
else if (val.IsCodePtr())
{
// We can get code pointers either in the stack as return addresses or
// handler pointers or in constants in code segments as the addresses of
// exception handlers.
// Find the start of the code segment
PolyObject *oldObject = ObjCodePtrToPtr(val.AsCodePtr());
// Calculate the byte offset of this value within the code object.
POLYUNSIGNED offset = val.AsCodePtr() - (byte*)oldObject;
// Mustn't use ScanAddressAt here. That's only valid if the value points
// into the area being updated.
PolyObject *newObject = ScanObjectAddress(oldObject);
newVal = PolyWord::FromCodePtr((byte*)newObject + offset);
}
else
{
ASSERT(OBJ_IS_DATAPTR(val));
// Database pointer, local pointer or IO pointer.
// We need to include IO area pointers when we produce an object module.
newVal = ScanObjectAddress(val.AsObjPtr());
}
if (newVal != val) // Only update if we need to.
*pt = newVal;
return 0;
}
// Process a constant within the code. This is a direct copy of ScanAddress::ScanConstant
// with the addition of the locking.
void MTGCProcessMarkPointers::ScanConstant(byte *addressOfConstant, ScanRelocationKind code)
{
// If this code is in the local area there's the possibility that
// ScanObjectAddress could return an updated address for a
// constant within the code. This could happen if the code is
// in the allocation area or if it has been moved into the
// mutable/immutable area by the last incomplete partial GC.
// Constants can be aligned on any byte offset so another thread
// scanning the same code could see an invalid address if it read
// the constant while it was being updated. We put a lock round
// this just in case.
LocalMemSpace *space = gMem.LocalSpaceForAddress(addressOfConstant);
if (space != 0)
space->spaceLock.Lock();
PolyWord p = GetConstantValue(addressOfConstant, code);
if (space != 0)
space->spaceLock.Unlock();
if (! IS_INT(p))
{
PolyWord oldValue = p;
ScanAddress::ScanAddressAt(&p);
if (p != oldValue) // Update it if it has changed.
{
if (space != 0)
space->spaceLock.Lock();
SetConstantValue(addressOfConstant, p, code);
if (space != 0)
space->spaceLock.Unlock();
}
}
}
WCHAR *Poly_string_to_U_alloc(PolyWord ps)
{
char iBuff[1];
int iLength = 0;
const char *iPtr;
if (IS_INT(ps))
{
iLength = 1;
iBuff[0] = (char)UNTAGGED(ps);
iPtr = iBuff;
}
else
{
PolyStringObject *str = (PolyStringObject *)ps.AsObjPtr();
iLength = (int)str->length;
if (iLength == 0) return _wcsdup(L"");
iPtr = str->chars;
}
// Find the space required.
int chars = MultiByteToWideChar(codePage, 0, iPtr, iLength, NULL, 0);
if (chars <= 0) return _wcsdup(L"");
WCHAR *res = (WCHAR*)malloc((chars+1) * sizeof(WCHAR));
if (res == 0) return 0;
chars = MultiByteToWideChar(codePage, 0, iPtr, iLength, res, chars);
res[chars] = 0;
return res;
}
void PExport::printValue(PolyWord q)
{
if (IS_INT(q) || q == PolyWord::FromUnsigned(0))
fprintf(exportFile, "%" POLYSFMT, UNTAGGED(q));
else if (OBJ_IS_CODEPTR(q))
printCodeAddr(q.AsCodePtr());
else
printAddress(q.AsAddress());
}
void print_string(PolyWord s)
{
if (IS_INT(s))
putc((char)UNTAGGED(s), stdout);
else {
PolyStringObject * str = (PolyStringObject *)s.AsObjPtr();
fwrite(str->chars, 1, str->length, stdout);
}
}
int main(int argc,char *argv[])
{
int MyRank, Numprocs;
int Root = 0;
int ilevel, value, ans;
int Source, Source_tag;
int Destination, Destination_tag;
int Level, NextLevel;
float NoofLevels;
static int sum = 0;
MPI_Status *status;
MPI_Request request[200];
MPI_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD,&Numprocs);
MPI_Comm_rank(MPI_COMM_WORLD,&MyRank);
NoofLevels = LOG2(Numprocs);
if(!(IS_INT(NoofLevels))){
if(MyRank == Root)
printf("\nNumber of processors should be power of 2\n");
MPI_Finalize();
exit(-1);
}
sum = MyRank;
Source_tag = 0;
Destination_tag = 0;
for(ilevel = 0 ; ilevel < NoofLevels; ilevel ++){
Level = (int)(pow((double)2, (double)ilevel ));
if((MyRank % Level) == 0){
NextLevel = (int)(pow((double)2, (double)(ilevel +1)));
if((MyRank % NextLevel) == 0){
Source = MyRank + Level;
MPI_Irecv(&value, 1, MPI_INT, Source, Source_tag,
MPI_COMM_WORLD, &request[ilevel]);
MPI_Waitall(1,&request[ilevel],status);
sum = sum + value;
}
else{
Destination = (MyRank - Level);
MPI_Isend(&sum, 1, MPI_INT, Destination, Destination_tag,
MPI_COMM_WORLD,&request[ilevel]);
MPI_Waitall(1,&request[ilevel],status);
}
}
}
if(MyRank == Root)
printf(" My Rank is %d Final SUM is%d\n", MyRank, sum);
MPI_Finalize();
}
static void ffi_ptr_dereference(VMState *state, CallInfo *info) {
VM_ASSERT(info->args_len == 2, "wrong arity: expected 2, got %i", info->args_len);
Object *root = state->root;
Object *pointer_base = state->shared->vcache.pointer_base;
FFIObject *ffi = (FFIObject*) AS_OBJ(OBJECT_LOOKUP(root, ffi));
Object *ffi_type = AS_OBJ(OBJECT_LOOKUP((Object*) ffi, type));
Object *thisptr = AS_OBJ(load_arg(state->frame, info->this_arg));
VM_ASSERT(thisptr->parent == pointer_base, "internal error");
PointerObject *thisptr_obj = (PointerObject*) thisptr;
Object *ffi_type_obj = obj_instance_of(OBJ_OR_NULL(load_arg(state->frame, INFO_ARGS_PTR(info)[0])), ffi_type);
Value offs_val = load_arg(state->frame, INFO_ARGS_PTR(info)[1]);
VM_ASSERT(IS_INT(offs_val), "offset must be integer");
int offs = AS_INT(offs_val);
VM_ASSERT(ffi_type_obj, "type is not a FFI type");
char *offset_ptr = (char*) thisptr_obj->ptr + offs;
if (ffi_type_obj == ffi->short_obj) {
short s = *(short*) offset_ptr;
vm_return(state, info, INT2VAL(s));
} else if (ffi_type_obj == ffi->ushort_obj) {
unsigned short us = *(unsigned short*) offset_ptr;
vm_return(state, info, INT2VAL(us));
} else if (ffi_type_obj == ffi->int_obj) {
int i = *(int*) offset_ptr;
vm_return(state, info, INT2VAL(i));
} else if (ffi_type_obj == ffi->uint_obj) {
unsigned int u = *(unsigned int*) offset_ptr;
vm_return(state, info, INT2VAL(u));
} else if (ffi_type_obj == ffi->int8_obj) {
int8_t i8 = *(int8_t*) offset_ptr;
vm_return(state, info, INT2VAL(i8));
} else if (ffi_type_obj == ffi->uint8_obj) {
uint8_t u8 = *(uint8_t*) offset_ptr;
vm_return(state, info, INT2VAL(u8));
} else if (ffi_type_obj == ffi->int32_obj) {
int32_t i32 = *(int32_t*) offset_ptr;
vm_return(state, info, INT2VAL(i32));
} else if (ffi_type_obj == ffi->uint32_obj) {
uint32_t u32 = *(uint32_t*) offset_ptr;
vm_return(state, info, INT2VAL(u32));
} else if (ffi_type_obj == ffi->pointer_obj) {
void *ptr = *(void**) offset_ptr;
vm_return(state, info, make_ffi_pointer(state, ptr));
} else if (ffi_type_obj == ffi->char_pointer_obj) {
char *ptr = *(char**) offset_ptr;
vm_return(state, info, make_string_static(state, ptr));
} else if (ffi_type_obj == ffi->long_obj) {
long l = *(long*) offset_ptr;
if (l < INT_MIN || l > INT_MAX) {
VM_ASSERT(false, "value exceeds bounds of my int type");
}
vm_return(state, info, INT2VAL((int) l));
} else { fprintf(stderr, "TODO\n"); abort(); }
}
// The default action is to call the DEFAULT ScanAddressAt NOT the virtual which means that it calls
// ScanObjectAddress for the base address of the object referred to.
void ScanAddress::ScanConstant(byte *addressOfConstant, ScanRelocationKind code)
{
PolyWord p = GetConstantValue(addressOfConstant, code);
if (! IS_INT(p))
{
PolyWord oldValue = p;
ScanAddress::ScanAddressAt(&p);
if (p != oldValue) // Update it if it has changed.
SetConstantValue(addressOfConstant, p, code);
}
}
// These functions are used in the interpreter. They are generally replaced by
// hand-coded versions in the assembly code section.
static int string_test(PolyWord x, PolyWord y)
/* Returns -1, 0, +1 if the first string is less, equal to or greater than the
second. These are addresses of the strings because calling
fix_persistent_address could result in a garbage-collection which could
move the other string. */
{
POLYUNSIGNED i;
PolyStringObject *xs, *ys;
/* Deal with single characters. */
if (IS_INT(x))
{
s_test_x.length = 1;
s_test_x.chars[0] = (char)UNTAGGED(x);
xs = &s_test_x;
}
else xs = (PolyStringObject*)x.AsObjPtr();
if (IS_INT(y))
{
s_test_y.length = 1;
s_test_y.chars[0] = (char)UNTAGGED(y);
ys = &s_test_y;
}
else ys = (PolyStringObject*)y.AsObjPtr();
/* Now do the comparison. */
for(i = 0; i < xs->length && i < ys->length; i++)
{
if (xs->chars[i] != ys->chars[i])
return xs->chars[i] < ys->chars[i] ? -1 : 1;
}
/* They must be equal or one must be a leading substring of the other. */
if (i < xs->length)
return 1; /* y must be the substring. */
else if (i < ys->length)
return -1; /* x must be the substring */
else
return 0; /* They must be equal. */
}
static void ffi_ptr_index_assign_fn(VMState *state, CallInfo *info) {
VM_ASSERT(info->args_len == 2, "wrong arity: expected 2, got %i", info->args_len);
Object *pointer_base = state->shared->vcache.pointer_base;
Object *thisptr = OBJ_OR_NULL(load_arg(state->frame, info->this_arg));
VM_ASSERT(thisptr && thisptr->parent == pointer_base, "invalid pointer index write on non-pointer object");
PointerObject *thisptr_obj = (PointerObject*) thisptr;
Object *ffi_type_obj = AS_OBJ(OBJECT_LOOKUP(thisptr, target_type));
VM_ASSERT(ffi_type_obj, "cannot assign index on untyped pointer!");
Value offs_val = load_arg(state->frame, INFO_ARGS_PTR(info)[0]);
VM_ASSERT(IS_INT(offs_val), "offset must be integer");
int offs = AS_INT(offs_val);
Value sizeof_val = OBJECT_LOOKUP(ffi_type_obj, sizeof);
VM_ASSERT(IS_INT(sizeof_val), "internal error: sizeof wrong type or undefined");
int elemsize = AS_INT(sizeof_val);
char *offset_ptr = (char*) thisptr_obj->ptr + elemsize * offs;
bool res = ffi_pointer_write(state, ffi_type_obj, (void*) offset_ptr, load_arg(state->frame, INFO_ARGS_PTR(info)[1]));
if (!res) return;
}
POLYUNSIGNED Poly_string_to_C(PolyWord ps, WCHAR *buff, POLYUNSIGNED bufflen)
{
if (IS_INT(ps))
{
buff[0] = (WCHAR)(UNTAGGED(ps));
buff[1] = 0;
return(1);
}
PolyStringObject *str = (PolyStringObject *)ps.AsObjPtr();
POLYUNSIGNED chars = str->length >= bufflen ? bufflen-1 : str->length;
for (POLYUNSIGNED i = 0; i < chars; i++) buff[i] = str->chars[i];
buff[chars] = 0;
return chars;
} /* Poly_string_to_C */
struct atom *builtin_mod(struct atom *expr, struct env *env)
{
struct list *list = expr->list;
struct atom *op = LIST_FIRST(list);
struct atom *a = CDR(op);
struct atom *b = CDR(a);
if (!a || !b)
{
printf("error: mod takes two arguments\n");
return &nil_atom;
}
a = eval(a, env);
b = eval(b, env);
if (!IS_INT(a) || !IS_INT(b))
{
printf("error: mod arguments must be integers\n");
return &nil_atom;
}
return atom_new_int(a->l % b->l);
}
POLYUNSIGNED Poly_string_to_C(PolyWord ps, char *buff, POLYUNSIGNED bufflen)
/* Copies the characters from the string into the destination buffer.
Returns original length of string. */
{
if (IS_INT(ps))
{
buff[0] = (char)(UNTAGGED(ps));
buff[1] = '\0';
return(1);
}
PolyStringObject *str = (PolyStringObject *)ps.AsObjPtr();
POLYUNSIGNED chars = str->length >= bufflen ? bufflen-1 : str->length;
if (chars != 0) strncpy(buff, str->chars, chars);
buff[chars] = '\0';
return chars;
} /* Poly_string_to_C */
bool ffi_pointer_write(VMState *state, Object *type, void *ptr, Value val) {
ValueCache *vcache = &state->shared->vcache;
Object *string_base = vcache->string_base;
FFIObject *ffi = (FFIObject*) vcache->ffi_obj;
if (type == ffi->float_obj) {
if (IS_FLOAT(val)) *(float*) ptr = AS_FLOAT(val);
else if (IS_INT(val)) *(float*) ptr = AS_INT(val);
else {
VM_ASSERT(false, "invalid value for float type") false;
}
return true;
} else {
Object *c_type_obj = AS_OBJ(OBJECT_LOOKUP(type, c_type));
StringObject *c_type = (StringObject*) obj_instance_of(c_type_obj, string_base);
assert(c_type);
VM_ASSERT(false, "unhandled pointer write type: %s", c_type->value) false;
}
}
static void ffi_ptr_add(VMState *state, CallInfo *info) {
VM_ASSERT(info->args_len == 1, "wrong arity: expected 1, got %i", info->args_len);
Object *pointer_base = state->shared->vcache.pointer_base;
Object *thisptr = OBJ_OR_NULL(load_arg(state->frame, info->this_arg));
VM_ASSERT(thisptr && thisptr->parent == pointer_base, "internal error");
PointerObject *thisptr_obj = (PointerObject*) thisptr;
void *ptr = (void*) thisptr_obj->ptr;
int elemsize = 1;
Value target_type = OBJECT_LOOKUP(thisptr, target_type);
if (!IS_NULL(target_type)) {
VM_ASSERT(IS_OBJ(target_type), "target type must be ffi type");
Value sizeof_val = OBJECT_LOOKUP(AS_OBJ(target_type), sizeof);
VM_ASSERT(IS_INT(sizeof_val), "internal error: sizeof wrong type or undefined");
elemsize = AS_INT(sizeof_val);
}
WCHAR *Poly_string_to_U_alloc(PolyWord ps)
{
if (IS_INT(ps))
{
WCHAR *res = (WCHAR*)malloc(2 * sizeof(WCHAR));
res[0] = (WCHAR)(UNTAGGED(ps));
res[1] = 0;
return res;
}
else
{
PolyStringObject *str = (PolyStringObject *)ps.AsObjPtr();
POLYUNSIGNED chars = str->length;
WCHAR * res = (WCHAR*)malloc((chars+1) * sizeof(WCHAR));
for (POLYUNSIGNED i = 0; i < chars; i++) res[i] = str->chars[i];
res[chars] = 0;
return res;
}
} /* Poly_string_to_U_alloc */
void print_form(uptr_t form) {
if (IS_NIL(form)) {
printf_P(PSTR("()"));
} else if (IS_REG(form)) {
printf_P(PSTR("R:%p"), TO_PTR(form));
} else if (IS_INT(form)) {
printf_P(PSTR("%d"), TO_INT(form));
} else if (IS_SYM(form)) {
char buf[7];
memset(buf, 0, 7);
unhash_sym(buf, form);
printf_P(PSTR("%s"), buf);
} else {
printf_P(PSTR("("));
print_list(form);
printf_P(PSTR(")"));
}
}
char *Poly_string_to_C_alloc(PolyWord ps)
/* Similar to Poly_string_to_C except that the string is allocated using
malloc and must be freed by the caller. */
{
char *res;
if (IS_INT(ps))
{
res = (char*)malloc(2);
res[0] = (char)(UNTAGGED(ps));
res[1] = '\0';
}
else
{
PolyStringObject * str = (PolyStringObject *)ps.AsObjPtr();
POLYUNSIGNED chars = str->length;
res = (char*)malloc(chars+1);
if (chars != 0) strncpy(res, str->chars, chars);
res[chars] = '\0';
}
return res;
} /* Poly_string_to_C_alloc */
/* This is called for each constant within the code.
Print a relocation entry for the word and return a value that means
that the offset is saved in original word. */
void SaveStateExport::ScanConstant(byte *addr, ScanRelocationKind code)
{
PolyWord p = GetConstantValue(addr, code);
if (IS_INT(p) || p == PolyWord::FromUnsigned(0))
return;
void *a = p.AsAddress();
unsigned aArea = findArea(a);
// We don't need a relocation if this is relative to the current segment
// since the relative address will already be right.
if (code == PROCESS_RELOC_I386RELATIVE && aArea == findArea(addr))
return;
// Set the value at the address to the offset relative to the symbol.
RelocationEntry reloc;
setRelocationAddress(addr, &reloc.relocAddress);
reloc.targetAddress = (char*)a - (char*)memTable[aArea].mtAddr;
reloc.targetSegment = (unsigned)memTable[aArea].mtIndex;
reloc.relKind = code;
fwrite(&reloc, sizeof(reloc), 1, exportFile);
relocationCount++;
}
POLYUNSIGNED Poly_string_to_C(PolyWord ps, WCHAR *buff, POLYUNSIGNED bufflen)
{
char iBuff[1];
int iLength = 0;
const char *iPtr;
if (IS_INT(ps))
{
iLength = 1;
iBuff[0] = (char)UNTAGGED(ps);
iPtr = iBuff;
}
else
{
PolyStringObject *str = (PolyStringObject *)ps.AsObjPtr();
iLength = (int)str->length;
if (iLength == 0)
{
// Null string.
if (bufflen != 0) buff[0] = 0;
return 0;
}
iPtr = str->chars;
}
// We can convert it directly using the maximum string length.
int space = MultiByteToWideChar(codePage, 0, iPtr, iLength, buff, (int)bufflen-1);
if (space <= 0)
{
if (bufflen != 0) buff[0] = 0;
return 0; // Error
}
buff[space] = 0; // Null terminate
return space;
}
// General purpose object processor, Processes all the addresses in an object.
// Handles the various kinds of object that may contain addresses.
void ScanAddress::ScanAddressesInObject(PolyObject *obj, POLYUNSIGNED lengthWord)
{
do
{
ASSERT (OBJ_IS_LENGTH(lengthWord));
if (OBJ_IS_BYTE_OBJECT(lengthWord))
return; /* Nothing more to do */
POLYUNSIGNED length = OBJ_OBJECT_LENGTH(lengthWord);
PolyWord *baseAddr = (PolyWord*)obj;
if (OBJ_IS_CODE_OBJECT(lengthWord))
{
// Scan constants within the code.
machineDependent->ScanConstantsWithinCode(obj, obj, length, this);
// Skip to the constants and get ready to scan them.
obj->GetConstSegmentForCode(length, baseAddr, length);
} // else it's a normal object,
PolyWord *endWord = baseAddr + length;
// We want to minimise the actual recursion we perform so we try to
// use tail recursion if we can. We first scan from the end and
// remove any words that don't need recursion.
POLYUNSIGNED lastLengthWord = 0;
while (endWord != baseAddr)
{
PolyWord wordAt = endWord[-1];
if (IS_INT(wordAt) || wordAt == PolyWord::FromUnsigned(0))
endWord--; // Don't need to look at this.
else if ((lastLengthWord = ScanAddressAt(endWord-1)) != 0)
// We need to process this one
break;
else endWord--; // We're not interested in this.
}
if (endWord == baseAddr)
return; // We've done everything.
// There is at least one word that needs to be processed, the
// one at endWord-1.
// Now process from the beginning forward to see if there are
// any words before this that need to be handled. This way we are more
// likely to handle the head of a list by recursion and the
// tail by looping (tail recursion).
while (baseAddr < endWord-1)
{
PolyWord wordAt = *baseAddr;
if (IS_INT(wordAt) || wordAt == PolyWord::FromUnsigned(0))
baseAddr++; // Don't need to look at this.
else
{
POLYUNSIGNED lengthWord = ScanAddressAt(baseAddr);
if (lengthWord != 0)
{
wordAt = *baseAddr; // Reload because it may have been side-effected
// We really have to process this recursively.
if (wordAt.IsCodePtr())
ScanAddressesInObject(ObjCodePtrToPtr(wordAt.AsCodePtr()), lengthWord);
else
ScanAddressesInObject(wordAt.AsObjPtr(), lengthWord);
baseAddr++;
}
else baseAddr++;
}
}
// Finally process the last word we found that has to be processed.
// Do this by looping rather than recursion.
PolyWord wordAt = *baseAddr; // Last word to do.
// This must be an address
if (wordAt.IsCodePtr())
obj = ObjCodePtrToPtr(wordAt.AsCodePtr());
else
obj = wordAt.AsObjPtr();
lengthWord = lastLengthWord;
} while(1);
}
/*
* Parse the type and its initializer and emit it (recursively).
*/
static void
emitInitVal(struct dbuf_s *oBuf, symbol *topsym, sym_link *my_type, initList *list)
{
symbol *sym;
int size, i;
long lit;
unsigned char *str;
size = getSize(my_type);
if (IS_PTR(my_type)) {
DEBUGprintf ("(pointer, %d byte) %p\n", size, list ? (void *)(long)list2int(list) : NULL);
emitIvals(oBuf, topsym, list, 0, size);
return;
}
if (IS_ARRAY(my_type) && topsym && topsym->isstrlit) {
str = (unsigned char *)SPEC_CVAL(topsym->etype).v_char;
emitIvalLabel(oBuf, topsym);
do {
dbuf_printf (oBuf, "\tretlw 0x%02x ; '%c'\n", str[0], (str[0] >= 0x20 && str[0] < 128) ? str[0] : '.');
} while (*(str++));
return;
}
if (IS_ARRAY(my_type) && list && list->type == INIT_NODE) {
fprintf (stderr, "Unhandled initialized symbol: %s\n", topsym->name);
assert ( !"Initialized char-arrays are not yet supported, assign at runtime instead." );
return;
}
if (IS_ARRAY(my_type)) {
DEBUGprintf ("(array, %d items, %d byte) below\n", DCL_ELEM(my_type), size);
assert (!list || list->type == INIT_DEEP);
if (list) list = list->init.deep;
for (i = 0; i < DCL_ELEM(my_type); i++) {
emitInitVal(oBuf, topsym, my_type->next, list);
topsym = NULL;
if (list) list = list->next;
} // for i
return;
}
if (IS_FLOAT(my_type)) {
// float, 32 bit
DEBUGprintf ("(float, %d byte) %lf\n", size, list ? list2int(list) : 0.0);
emitIvals(oBuf, topsym, list, 0, size);
return;
}
if (IS_CHAR(my_type) || IS_INT(my_type) || IS_LONG(my_type)) {
// integral type, 8, 16, or 32 bit
DEBUGprintf ("(integral, %d byte) 0x%lx/%ld\n", size, list ? (long)list2int(list) : 0, list ? (long)list2int(list) : 0);
emitIvals(oBuf, topsym, list, 0, size);
return;
} else if (IS_STRUCT(my_type) && SPEC_STRUCT(my_type)->type == STRUCT) {
// struct
DEBUGprintf ("(struct, %d byte) handled below\n", size);
assert (!list || (list->type == INIT_DEEP));
// iterate over struct members and initList
if (list) list = list->init.deep;
sym = SPEC_STRUCT(my_type)->fields;
while (sym) {
long bitfield = 0;
int len = 0;
if (IS_BITFIELD(sym->type)) {
while (sym && IS_BITFIELD(sym->type)) {
int bitoff = SPEC_BSTR(getSpec(sym->type)) + 8 * sym->offset;
assert (!list || ((list->type == INIT_NODE)
&& IS_AST_LIT_VALUE(list->init.node)));
lit = (long) (list ? list2int(list) : 0);
DEBUGprintf ( "(bitfield member) %02lx (%d bit, starting at %d, bitfield %02lx)\n",
lit, SPEC_BLEN(getSpec(sym->type)),
bitoff, bitfield);
bitfield |= (lit & ((1ul << SPEC_BLEN(getSpec(sym->type))) - 1)) << bitoff;
len += SPEC_BLEN(getSpec(sym->type));
sym = sym->next;
if (list) list = list->next;
} // while
assert (len < sizeof (long) * 8); // did we overflow our initializer?!?
len = (len + 7) & ~0x07; // round up to full bytes
emitIvals(oBuf, topsym, NULL, bitfield, len / 8);
topsym = NULL;
} // if
if (sym) {
emitInitVal(oBuf, topsym, sym->type, list);
topsym = NULL;
sym = sym->next;
if (list) list = list->next;
} // if
} // while
if (list) {
assert ( !"Excess initializers." );
} // if
return;
} else if (IS_STRUCT(my_type) && SPEC_STRUCT(my_type)->type == UNION) {
// union
DEBUGprintf ("(union, %d byte) handled below\n", size);
assert (list && list->type == INIT_DEEP);
// iterate over union members and initList, try to map number and type of fields and initializers
my_type = matchIvalToUnion(list, my_type, size);
if (my_type) {
emitInitVal(oBuf, topsym, my_type, list->init.deep);
topsym = NULL;
size -= getSize(my_type);
if (size > 0) {
// pad with (leading) zeros
emitIvals(oBuf, NULL, NULL, 0, size);
}
return;
} // if
assert ( !"No UNION member matches the initializer structure.");
} else if (IS_BITFIELD(my_type)) {
assert ( !"bitfields should only occur in structs..." );
} else {
printf ("SPEC_NOUN: %d\n", SPEC_NOUN(my_type));
assert( !"Unhandled initialized type.");
}
}
/*
* XXX warn about ``unsigned char *'' vs ``char *'',
* unlike gcc
*/
static int
compare_tlist(struct type_node *dest, struct type_node *src, int flag) {
struct type_node *dest_start = dest;
for (;
dest != NULL && src != NULL;
dest = dest->next, src = src->next) {
if (src->type == TN_FUNCTION
|| dest->type == TN_FUNCTION) {
if (dest->type != src->type) {
/* XXX fix this later */
if (dest == dest_start) {
/*
* Ordinary function symbols are
* compatible with pointers to
* functions
*/
if (dest->type == TN_FUNCTION) {
if (src->type
== TN_POINTER_TO) {
src = src->next;
} else {
return -1;
}
} else {
if (dest->type
== TN_POINTER_TO) {
dest = dest->next;
} else {
return -1;
}
}
}
}
}
if (dest->type != src->type) {
/* Pointer vs array vs function */
if (flag & CMPTY_ARRAYPTR) {
if ((dest->type == TN_ARRAY_OF
|| src->type == TN_ARRAY_OF
|| dest->type == TN_VARARRAY_OF
|| src->type == TN_VARARRAY_OF)
&& (dest->type == TN_POINTER_TO
|| src->type == TN_POINTER_TO)) {
continue;
}
}
return -1;
}
switch (dest->type) {
case TN_ARRAY_OF:
case TN_VARARRAY_OF:
if (flag & CMPTY_TENTDEC) {
#if REMOVE_ARRARG
if (!dest->have_array_size
|| !src->have_array_size) {
#else
if (dest->arrarg->const_value == NULL
|| src->arrarg->const_value == NULL) {
#endif
/*
* probably
* extern int foo[];
* int foo[123];
* -> OK!
*/
break;
}
}
if (dest->arrarg_const != src->arrarg_const
&& ((flag & CMPTY_ARRAYPTR) == 0
|| dest_start != dest)) {
#if REMOVE_ARRARG
if (!src->have_array_size
|| !dest->have_array_size) {
#else
if (src->arrarg->const_value == NULL
|| dest->arrarg->const_value == NULL) {
#endif
/*
* One side has unspecified size, this
* is OK!
* extern char foo[];
* char (*p)[5] = &foo;
* char bar[5];
* char (*p2)[] = &bar;
*/
break;
} else {
/* Array sizes differ */
return -1;
}
}
break;
case TN_POINTER_TO:
break;
case TN_FUNCTION:
if (compare_tfunc(dest->tfunc, src->tfunc) == -1) {
return -1;
}
break;
}
}
if (dest != NULL || src != NULL) {
/* One list is longer, so it differs by definition */
return -1;
}
return 0;
}
#endif /* #ifndef PREPROCESSOR */
int
compare_types(struct type *dest, struct type *src, int flag) {
int is_void_ptr = 0;
/* 04/08/08: Changed this (for the better, hopefully!) */
if (dest->tlist != NULL
&& dest->tlist->type == TN_POINTER_TO
&& dest->tlist->next == NULL
&& dest->code == TY_VOID) {
is_void_ptr = 1;
} else if (src->tlist != NULL
&& src->tlist->type == TN_POINTER_TO
&& src->tlist->next == NULL
&& src->code == TY_VOID) {
is_void_ptr = 1;
}
if (dest->code != src->code) {
/*
* Differing base type - This is ok if we have a void
* pointer vs a non-void pointer, otherwise return error
*/
if (!is_void_ptr || src->tlist == NULL || dest->tlist == NULL) {
return -1;
}
}
if (flag & CMPTY_SIGN) {
if (dest->sign != dest->sign) {
/* Differing sign */
return -1;
}
}
if (flag & CMPTY_CONST) {
if (IS_CONST(dest->flags) != IS_CONST(src->flags)) {
/* One is const-qualified */
/*return -1;*/
}
}
/*
* 04/08/08: Skip the tlist comparison if this is void pointer
* vs non-void pointer; Otherwise tlists of different length
* will compare uneven, as in void * vs int **, which is wrong
*/
if (is_void_ptr) {
return 0;
}
#ifndef PREPROCESSOR
return compare_tlist(dest->tlist, src->tlist, flag);
#else
return -1;
#endif
}
int
check_init_type(struct type *ofwhat, struct expr *init) {
if (ofwhat->tlist == NULL) {
if (init->next != NULL) {
}
} else if (ofwhat->tlist->type == TN_ARRAY_OF) {
if (init->type->code == TOK_STRING_LITERAL) {
return 0;
} else {
struct expr *ex;
for (ex = init; ex != NULL; ex = ex->next) {
}
}
}
return 0;
}
void
copy_type(struct type *dest, const struct type *src, int fullcopy) {
if (fullcopy) {
memcpy(dest, src, sizeof *dest);
} else {
memcpy(dest, src, sizeof *dest);
}
}
struct type_node *
copy_tlist(struct type_node **dest, const struct type_node *src) {
struct type_node *head;
struct type_node *tail;
struct type_node *tn;
if (src == NULL) {
*dest = NULL;
return NULL;
}
head = tail = NULL;
do {
tn = n_xmalloc(sizeof *tn);
memcpy(tn, src, sizeof *tn);
if (head == NULL) {
head = tail = tn;
} else {
tail->next = tn;
tail = tail->next;
}
} while ((src = src->next) != NULL);
*dest = head;
return tail;
}
void
set_type_sign(struct type *ty) {
if (ty->code == TY_UCHAR
|| ty->code == TY_USHORT
|| ty->code == TY_UINT
|| ty->code == TY_ULONG
|| ty->code == TY_ULLONG) {
ty->sign = TOK_KEY_UNSIGNED;
} else if (!IS_FLOATING(ty->code)
&& ty->code != TY_STRUCT
&& ty->code != TY_UNION) {
ty->sign = TOK_KEY_SIGNED;
}
}
struct type *
make_basic_type(int code) {
#define N_TYPES (TY_MAX - TY_MIN)
#if 0
static struct type basic_types[N_TYPES];
#endif
static int inited;
static struct type *basic_types;
if (!inited) {
int i;
int nbytes = N_TYPES * sizeof(struct type);
int need_mprotect = 1;
basic_types = debug_malloc_pages(nbytes);
if (basic_types == NULL) {
/*
* Probably debug_malloc_pages() doesn't work
* on this system
*/
basic_types = n_xmalloc(nbytes);
need_mprotect = 0;
}
memset(basic_types, 0, nbytes);
for (i = 0; i < N_TYPES; ++i) {
basic_types[i].code = i + TY_MIN;
set_type_sign(&basic_types[i]);
}
inited = 1;
if (need_mprotect) {
/*
* We make the array unwritable because it really
* should not be written to; Modifying it is a bug
* that has happend more than once.
*
* The void cast is necessary because of a broken
* Solaris prototype that takes caddr_t :-/
*/
mprotect((void *)basic_types, nbytes, PROT_READ);
}
}
if (code < 0 || (code - TY_MIN) >= N_TYPES) {
printf("BUG: bad code for make_basic_type: %d\n", code);
abort();
}
#if 0
if (code == TY_PSEUDEO_SIZE_T) {
static struct type ty;
static struct type *p;
if (p == NULL) {
ty = basic_types[TY_UINT];
}
}
#endif
#if 0
/* As of Jan 6 2007, the basic types may not be modified anymore */
basic_types[code - TY_MIN].tlist = NULL;
#endif
return &basic_types[code - TY_MIN];
}
struct type *
make_void_ptr_type(void) {
static struct type *ty;
if (ty == NULL) {
ty = make_basic_type(TY_VOID);
ty = n_xmemdup(ty, sizeof *ty);
append_typelist(ty, TN_POINTER_TO, NULL, NULL, NULL);
}
return ty;
}
struct type *
make_array_type(int size, int is_wide_char) {
struct type *ret = alloc_type();
if (is_wide_char) {
ret->code = backend->get_wchar_t()->code;
ret->sign = backend->get_wchar_t()->sign;
} else {
ret->code = TY_CHAR;
if (CHAR_MAX == UCHAR_MAX) { /* XXX */
ret->sign = TOK_KEY_UNSIGNED;
} else {
ret->sign = TOK_KEY_SIGNED;
}
}
ret->storage = TOK_KEY_STATIC;
ret->tlist = alloc_type_node();
ret->tlist->type = TN_ARRAY_OF;
ret->tlist->arrarg_const = size;
#if REMOVE_ARRARG
ret->tlist->have_array_size = 1;
#endif
return ret;
}
/*
* Helper function for parse_declarator()- stores pointer/array-of/function
* property (specified by ``type'' argument) with optional arguments type_arg
* (for pointer/array-of) and tf (for function) in type specified by t
*
* 01/26/08: Extended to do some sanity checking (functions may not return
* functions or arrays). This means some type constructions are now REQUIRED
* to go through append_typelist()! May not be the best approach, needs
* testing?!
*/
void
append_typelist(struct type *t,
int type,
void *type_arg,
struct ty_func *tf,
struct token *tok) {
struct type_node *te;
struct expr *ex;
(void) tok; /* XXX unneeded?!?! */
/* Allocate and insert new type node */
if (t->tlist == NULL) {
te = t->tlist = t->tlist_tail = alloc_type_node();
te->prev = NULL;
if (type == TN_FUNCTION) {
/*
* If the first node in the type list is a function
* designator, this means we are dealing with a genuine
* function declaration/definition (as opposed to a
* pointer)
*/
t->is_func = 1;
}
} else {
/*
* 01/26/08: Some sanity checking!
*/
int tailtype = t->tlist_tail->type;
if (tailtype == TN_ARRAY_OF || tailtype == TN_VARARRAY_OF) {
if (type == TN_FUNCTION) {
errorfl(tok, "Invalid declaration of `array of "
"functions' - Maybe you meant `array "
"of pointer to function'; `void (*ar[N])();'?");
return /* -1 XXX */ ;
}
} else if (tailtype == TN_FUNCTION) {
if (type == TN_ARRAY_OF || type == TN_VARARRAY_OF) {
errorfl(tok, "Invalid declaration of `function "
"returning array' - If you really want "
"to return an array by value, put it "
"into a structure!");
return /* -1 XXX */ ;
} else if (type == TN_FUNCTION) {
errorfl(tok, "Invalid declaration of `function "
"returning function' - You can at most "
"return a pointer to a function; "
"`void (*foo())();'");
return /* -1 XXX */ ;
}
}
te = alloc_type_node();
te->prev = t->tlist_tail;
t->tlist_tail->next = te;
t->tlist_tail = t->tlist_tail->next;
}
te->next = NULL;
te->type = type;
switch (type) {
case TN_VARARRAY_OF:
case TN_ARRAY_OF:
#if REMOVE_ARRARG
ex = type_arg;
if (ex->const_value == NULL) {
/* Size not specified - extern char buf[]; */
te->have_array_size = 0;
} else {
te->have_array_size = 1;
ex->const_value->type =
n_xmemdup(ex->const_value->type,
sizeof(struct type));
cross_convert_tyval(ex->const_value, NULL, NULL);
te->arrarg_const = cross_to_host_size_t(
ex->const_value);
if (te->arrarg_const == 0) {
/*
* In GNU C,
* int foo[0];
* may be a flexible array member
*/
te->have_array_size = 0;
#if 0
errorfl(tok,
"Cannot create zero-sized arrays");
#endif
}
}
if (type == TN_VARARRAY_OF) {
te->variable_arrarg = ex;
}
#else /* Using arrarg */
te->arrarg = type_arg;
if (te->arrarg->const_value) {
te->arrarg->const_value->type =
n_xmemdup(te->arrarg->const_value->type,
sizeof(struct type));
cross_convert_tyval(te->arrarg->const_value, NULL, NULL);
te->arrarg_const = /* *(size_t *) */
cross_to_host_size_t(
te->arrarg->const_value); /*->value; */
if (te->arrarg_const == 0) {
/*
* In GNU C,
* int foo[0];
* may be a flexible array member
*/
te->arrarg->const_value = NULL;
#if 0
errorfl(tok,
"Cannot create zero-sized arrays");
#endif
}
}
#endif /* REMOVE_ARRARG is disabled */
break;
case TN_POINTER_TO:
te->ptrarg = type_arg? *(int *)type_arg: 0;
break;
case TN_FUNCTION:
te->tfunc = tf;
break;
}
}
static struct {
char *name;
int code;
} basic_type_names[] = {
{ "char", TY_CHAR },
{ "unsigned char", TY_UCHAR },
{ "signed char", TY_SCHAR },
{ "short", TY_SHORT },
{ "unsigned short", TY_USHORT },
{ "int", TY_INT },
{ "unsigned int", TY_UINT },
{ "long", TY_LONG },
{ "unsigned long", TY_ULONG },
{ "float", TY_FLOAT },
{ "double", TY_DOUBLE },
{ "long double", TY_LDOUBLE },
{ "struct", TY_STRUCT },
{ "union", TY_UNION },
{ "enum", TY_ENUM },
{ "void", TY_VOID },
{ "long long", TY_LLONG },
{ "unsigned long long", TY_ULLONG },
{ "_Bool", TY_BOOL },
{ NULL, 0 }
};
char *
ret_type_to_text(struct type *ty) {
struct type_node *orig_tlist = NULL;
char *ret;
if (ty->tlist != NULL) {
orig_tlist = ty->tlist;
if (ty->tlist->type == TN_FUNCTION) {
ty->tlist = ty->tlist->next;
} else if (ty->tlist->type == TN_POINTER_TO
&& ty->tlist->next != NULL
&& ty->tlist->next->type == TN_FUNCTION) {
ty->tlist = ty->tlist->next->next;
}
ret = type_to_text(ty);
ty->tlist = orig_tlist;
} else {
ret = type_to_text(ty);
}
return ret;
}
char *
type_to_text(struct type *dt) {
struct type_node *t;
char *buf = NULL;
char *p = NULL;
size_t size = 0;
size_t used = 0;
int i;
for (t = dt->tlist; t != NULL; t = t->next) {
switch (t->type) {
case TN_ARRAY_OF:
case TN_VARARRAY_OF:
make_room(&buf, &size, used + 64);
used += sprintf(buf+used, "an array of %d ",
(int)t->arrarg_const);
break;
case TN_POINTER_TO: {
char *quali = "";
if (t->ptrarg != 0) {
switch (t->ptrarg) {
case TOK_KEY_VOLATILE:
quali = "volatile";
break;
case TOK_KEY_CONST:
quali = "constant";
break;
case TOK_KEY_RESTRICT:
quali = "restricted";
break;
}
}
make_room(&buf, &size, used + 32);
used += sprintf(buf+used, "a %s pointer to ", quali);
break;
}
case TN_FUNCTION:
make_room(&buf, &size, used + 32);
used += sprintf(buf+used, "a function (with %d args) returning ", t->tfunc->nargs);
break;
}
}
#if 0
p = basic_type_names[dt->code - TY_MIN];
#endif
for (i = 0; basic_type_names[i].name != NULL; ++i) {
if (dt->code == basic_type_names[i].code) {
p = basic_type_names[i].name;
break;
}
}
make_room(&buf, &size, strlen(p) + 5);
used += sprintf(buf+used, "%s", p);
if (dt->code == TY_STRUCT) {
if (dt->tstruc && dt->tstruc->tag) {
make_room(&buf, &size,
used + strlen(dt->tstruc->tag) + 2);
sprintf(buf+used, " %s", dt->tstruc->tag);
}
}
return buf;
}
#ifndef PREPROCESSOR
extern void put_ppc_llong(struct num *);
/*
* XXX same stupid size_t cross-compilaion bug as const_from_value()..
* this stuff SUCKS!!!
*/
struct token *
const_from_type(struct type *ty, int from_alignment, int extype, struct token *t) {
struct token *ret = alloc_token();
size_t size;
int size_t_size;
#if 0
ret->type = TY_ULONG; /* XXX size_t */
#endif
ret->type = backend->get_size_t()->code;
if (from_alignment) {
size = backend->get_align_type(ty);
} else {
size = backend->get_sizeof_type(ty, t);
}
/*ret->data = n_xmemdup(&size, sizeof size);*/
ret->data = n_xmalloc(16); /* XXX */
size_t_size = backend->get_sizeof_type(backend->get_size_t(), NULL);
if (sizeof size == size_t_size) {
memcpy(ret->data, &size, sizeof size);
} else if (sizeof(int) == size_t_size) {
unsigned int i = (unsigned int)size;
memcpy(ret->data, &i, sizeof i);
} else if (sizeof(long) == size_t_size) {
unsigned long l = (unsigned long)size;
memcpy(ret->data, &l, sizeof l);
} else if (sizeof(long long) == size_t_size) {
unsigned long long ll = (unsigned long long)size;
memcpy(ret->data, &ll, sizeof ll);
} else {
unimpl();
}
if (backend->abi == ABI_POWER64
&& extype != EXPR_CONST
&& extype != EXPR_CONSTINIT
/* What about EXPR_OPTCONSTINIT?! */ ) {
struct num *n = n_xmalloc(sizeof *n);
/*
* XXX see definition of put_ppc_llong() for an
* explanation of this mess
*/
n->type = ret->type;
n->value = ret->data;
put_ppc_llong(n);
/*ret->data = llong_const;*/
ret->data2 = llong_const;
}
return ret;
}
/*
* XXX this interface is ROTTEN!!
* too easy to pass a ``size_t'' for value with ty=NULL by accident!!
*
* XXXX WOAH this was totally broken WRT cross-compilation! ``type''
* is interpreted as host type when dealing with ``value'', and as
* target type too by making it the type of the token! Current ad-hoc
* kludge sucks!
*/
struct token *
const_from_value(void *value, struct type *ty) {
struct token *ret = alloc_token();
size_t size;
if (ty == NULL) {
ret->type = TY_INT;
size = backend->get_sizeof_type(make_basic_type(
TY_INT), NULL);;
} else {
ret->type = ty->code;
size = backend->get_sizeof_type(ty, NULL);
}
if (ty && (IS_LONG(ty->code) || IS_LLONG(ty->code))) {
if (sizeof(long) == size) {
/* Size matches - nothing to do */
;
} else {
static long long llv;
llv = *(int *)value;
value = &llv;
}
}
ret->data = n_xmemdup(value, size);
if (backend->abi == ABI_POWER64
&& ty != NULL
&& is_integral_type(ty)
&& size == 8) {
struct num *n = n_xmalloc(sizeof *n);
static struct num nullnum;
*n = nullnum;
n->type = ret->type;
n->value = ret->data;
put_ppc_llong(n);
ret->data2 = llong_const;
}
return ret;
}
/*
* Construct a floating point constant token of type ``type''
* containing ``value'' (which must be a string parsable by sscanf().)
*/
struct token *
fp_const_from_ascii(const char *value, int type) {
struct num *n;
struct token *ret = n_xmalloc(sizeof *ret);
n = cross_scan_value(value, type, 0, 0, 1);
if (n == NULL) {
return NULL;
}
/*
* XXX token.data is ``struct ty_float'', not
* ``struct num''. Because the interfaces are
* still messed up, we have to get the current
* ty_float corresponding to ``n'' from the
* float list. This SUCKS!
*/
ret->data = float_const/*n->value*/;
ret->type = type;
ret->ascii = n_xstrdup(value);
return ret;
}
struct token *
const_from_string(const char *value) {
struct token *ret = alloc_token();
struct type *ty;
struct ty_string *tmpstr;
tmpstr = alloc_ty_string();
tmpstr->size = strlen(value) + 1;
tmpstr->str = n_xmemdup(value, tmpstr->size);
tmpstr->is_wide_char = 0;
ret->type = TOK_STRING_LITERAL;
ty = make_array_type(tmpstr->size, tmpstr->is_wide_char);
tmpstr->ty = ty;
ret->data = tmpstr;
return ret;
}
int
is_integral_type(struct type *t) {
if (t->tlist != NULL) {
return 0;
}
if (IS_CHAR(t->code)
|| IS_SHORT(t->code)
|| IS_INT(t->code)
|| IS_LONG(t->code)
|| IS_LLONG(t->code)
|| t->code == TY_ENUM) {
return 1;
}
return 0;
}
int
is_floating_type(struct type *t) {
if (t->tlist != NULL) {
return 0;
}
if (t->code == TY_FLOAT
|| t->code == TY_DOUBLE
|| t->code == TY_LDOUBLE) {
return 1;
}
return 0;
}
int
is_arithmetic_type(struct type *t) {
if (t->tlist != NULL) {
return 0;
}
if (IS_FLOATING(t->code)
|| is_integral_type(t)) {
return 1;
}
return 0;
}
int
is_array_type(struct type *t) {
struct type_node *tn;
if (t->tlist == NULL) {
return 0;
}
for (tn = t->tlist; tn != NULL; tn = tn->next) {
if (tn->type != TN_ARRAY_OF) {
return 0;
} else {
break;
}
}
return 1;
}
int
is_basic_agg_type(struct type *t) {
if (t->tlist == NULL) {
if (t->code == TY_STRUCT || t->code == TY_UNION) {
return 1;
}
} else if (is_array_type(t)) {
return 1;
}
return 0;
}
int
is_scalar_type(struct type *t) {
if (t->tlist == NULL
&& (t->code == TY_STRUCT
|| t->code == TY_UNION
|| t->code == TY_VOID)) {
return 0;
}
return 1;
}
int
is_arr_of_ptr(struct type *t) {
struct type_node *tn;
for (tn = t->tlist; tn != NULL; tn = tn->next) {
if (tn->type == TN_POINTER_TO) {
return 1;
} else if (tn->type == TN_FUNCTION) {
return 0;
}
}
return 0;
}
int
is_nullptr_const(struct token *constant, struct type *ty) {
if (IS_INT(ty->code)
&& *(unsigned *)constant->data == 0) {
return 1;
} else if (IS_LONG(ty->code)
&& *(unsigned long *)constant->data == 0) {
return 1;
}
return 0;
}
/*
* The source type must be passed with a vreg because we need the null
* pointer constant and object backing information it gives us
*/
int
check_types_assign(
struct token *t,
struct type *left,
struct vreg *right,
int to_const_ok,
int silent) {
struct type *ltype = left;
struct type *rtype = right->type;
if (ltype == NULL || rtype == NULL) {
printf("attempt to assign to/from value without type :(\n");
abort();
}
/*
* 01/26/08: Changed this to call is_modifyable(), which also
* rules out assignment to const-qualified pointers
*/
/*if (ltype->tlist == NULL && ltype->is_const && !to_const_ok) { */
if (!is_modifyable(ltype) && !to_const_ok) {
if (!silent) {
errorfl(t,
"Assignment to const-qualified object");
}
return -1;
}
if (is_arithmetic_type(ltype)) {
if (!is_arithmetic_type(rtype)) {
if (ltype->code == TY_BOOL
&& rtype->tlist != NULL) {
/* ok - pointer to bool */
return 0;
} else {
int allow = 0;
if (rtype->tlist != NULL
&& is_integral_type(ltype)) {
/*
* 03/09/09: Give in and allow pointer
* to integer assignment with a warning
*/
allow = 1;
}
if (!silent) {
if (allow) {
warningfl(t,
"Assignment from non-arithmetic to "
"arithmetic type");
} else {
errorfl(t,
"Assignment from non-arithmetic to "
"arithmetic type");
}
}
if (allow) {
return 0;
} else {
return -1;
}
}
} else if (ltype->sign != rtype->sign
&& !right->from_const) {
/*
* Do not warn about signedness differences if the
* right side is a constant!
*/
#if 0
/* XXX Too verbose */
warningfl(t,
"Assignment from type of differing signedness");
#endif
return 0;
}
return 0;
} else if (ltype->tlist == NULL) {
/* Must be struct/union */
if (rtype->tlist != NULL) {
if (ltype->code == TY_BOOL) {
return 0;
} else {
if (!silent) {
/* 06/01/08: Warn, not error */
warningfl(t,
"Assignment from pointer to non-pointer type");
}
/*
* 07/20/08: The return below was commented out!
* That's wrong because pointer to struct will
* compare assignable to struct
* Why was this removed?
*/
return -1;
}
} else if (ltype->code == TY_BOOL) {
return 0; /* _Bool b = ptr; is OK */
} else if (rtype->code != ltype->code
|| rtype->tstruc != ltype->tstruc) {
if (!silent) {
errorfl(t,
"Assignment from incompatible type");
}
return -1;
} else {
return 0;
}
} else {
/* Left is pointer of some sort */
if (right->is_nullptr_const) {
; /* ok */
} else if (rtype->tlist == NULL) {
if (!silent) {
warningfl(t, "Assignment from non-pointer "
"to pointer type");
}
/* return -1;*/
} else if (rtype->code == TY_VOID
&& rtype->tlist->type == TN_POINTER_TO
&& rtype->tlist->next == NULL) {
; /* void pointer - compatible */
} else if (ltype->code == TY_VOID
&& ltype->tlist->type == TN_POINTER_TO
&& ltype->tlist->next == NULL) {
; /* void pointer - compatible */
} else if (compare_tlist(ltype->tlist, rtype->tlist,
CMPTY_ARRAYPTR)) {
if (!silent) {
warningfl(t, "Assignment from incompatible pointer type"
" (illegal in ISO C, and very "
"probably not what you want)");
} else {
/*
* This is only used for transparent_union
* right now... in that case we do not want
* to allow this assignment because type-
* checking is the whole point of that
* language extension
*/
return -1;
}
return 0;
} else if (!IS_CONST(ltype->flags) && IS_CONST(rtype->flags)) {
if (!silent) {
warningfl(t,
"Assignment from const-qualified type "
"to unqualified one");
}
return 0;
} else if (rtype->code != ltype->code
&& rtype->code != TY_VOID
&& ltype->code != TY_VOID
/* XXX */ && (!IS_CHAR(ltype->code) || !IS_CHAR(rtype->code))) {
if (type_without_sign(ltype->code)
== type_without_sign(rtype->code)) {
if (!silent) {
warningfl(t, "Assignment from pointer of "
"differing signedness");
} else {
return -1;
}
return 0;
} else {
if (!silent) {
warningfl(t, "Assignment from incompatible "
"pointer type (illegal in ISO C, and "
"very probably not what you want)");
} else {
return -1;
}
#if 0
return -1;
#endif
return 0;
}
} else if (IS_CONST(ltype->flags) && !IS_CONST(rtype->flags)
&& ltype->tlist != NULL
&& ltype->tlist->next != NULL) {
if (!silent) {
warningfl(t, "ISO C does not allow assignment "
"from `T **' to `const T **' without a "
"cast (otherwise invalid code like "
"`const char dont_modify; char *p; const "
"char **cp = &p; *cp = &dont_modify; *p = 0;' "
"would pass without warning)");
}
return 0;
}
}
return 0;
}
struct type *
addrofify_type(struct type *ty) {
struct type *ret = n_xmemdup(ty, sizeof *ty);
struct type_node *tn;
copy_tlist(&ret->tlist, ret->tlist);
tn = alloc_type_node();
tn->type = TN_POINTER_TO;
tn->next = ret->tlist;
ret->tlist = tn;
return ret;
}
int
type_without_sign(int code) {
int rc = code;
if (code == TY_UCHAR) rc = TY_CHAR;
else if (code == TY_USHORT) rc = TY_SHORT;
else if (code == TY_UINT) rc = TY_INT;
else if (code == TY_ULONG) rc = TY_LONG;
else if (code == TY_ULLONG) rc = TY_LLONG;
return rc;
}
/*
* For UNIONs, we first have to find the correct alternative to map the
* initializer to. This function maps the structure of the initializer to
* the UNION members recursively.
* Returns the type of the first `fitting' member.
*/
static sym_link *
matchIvalToUnion (initList *list, sym_link *type, int size)
{
symbol *sym;
assert (type);
if (IS_PTR(type) || IS_CHAR(type) || IS_INT(type) || IS_LONG(type)
|| IS_FLOAT(type))
{
if (!list || (list->type == INIT_NODE)) {
DEBUGprintf ("OK, simple type\n");
return (type);
} else {
DEBUGprintf ("ERROR, simple type\n");
return (NULL);
}
} else if (IS_BITFIELD(type)) {
if (!list || (list->type == INIT_NODE)) {
DEBUGprintf ("OK, bitfield\n");
return (type);
} else {
DEBUGprintf ("ERROR, bitfield\n");
return (NULL);
}
} else if (IS_STRUCT(type) && SPEC_STRUCT(getSpec(type))->type == STRUCT) {
if (!list || (list->type == INIT_DEEP)) {
if (list) list = list->init.deep;
sym = SPEC_STRUCT(type)->fields;
while (sym) {
DEBUGprintf ("Checking STRUCT member %s\n", sym->name);
if (!matchIvalToUnion(list, sym->type, 0)) {
DEBUGprintf ("ERROR, STRUCT member %s\n", sym->name);
return (NULL);
}
if (list) list = list->next;
sym = sym->next;
} // while
// excess initializers?
if (list) {
DEBUGprintf ("ERROR, excess initializers\n");
return (NULL);
}
DEBUGprintf ("OK, struct\n");
return (type);
}
return (NULL);
} else if (IS_STRUCT(type) && SPEC_STRUCT(getSpec(type))->type == UNION) {
if (!list || (list->type == INIT_DEEP)) {
if (list) list = list->init.deep;
sym = SPEC_STRUCT(type)->fields;
while (sym) {
DEBUGprintf ("Checking UNION member %s.\n", sym->name);
if (((IS_STRUCT(sym->type) || getSize(sym->type) == size))
&& matchIvalToUnion(list, sym->type, size))
{
DEBUGprintf ("Matched UNION member %s.\n", sym->name);
return (sym->type);
}
sym = sym->next;
} // while
} // if
// no match found
DEBUGprintf ("ERROR, no match found.\n");
return (NULL);
} else {
assert ( !"Unhandled type in UNION." );
}
assert ( !"No match found in UNION for the given initializer structure." );
return (NULL);
}
