OBJECT_PTR create_call_frame(OBJECT_PTR next_expression,
OBJECT_PTR env,
OBJECT_PTR rib,
OBJECT_PTR source_expression)
{
uintptr_t ptr = object_alloc(5, ARRAY_TAG);
unsigned int *raw_ptr;
log_function_entry("create_call_frame");
//see comment in main.c for why we're not using object_alloc()
//posix_memalign((void **)&raw_ptr, 16, sizeof(unsigned int *));
//*((int *)raw_ptr) = 4;
//set_heap(ptr, 0, convert_int_to_object(4));
//set_heap(ptr, 0, (uintptr_t)raw_ptr + INTEGER_TAG);
*((unsigned int *)ptr) = 4;
set_heap(ptr, 1, next_expression);
set_heap(ptr, 2, env);
set_heap(ptr, 3, rib);
set_heap(ptr, 4, source_expression);
log_function_exit("create_call_frame");
return ptr + ARRAY_TAG;
}
OBJECT_PTR eval_sub_array(OBJECT_PTR array, OBJECT_PTR start, OBJECT_PTR length)
{
OBJECT_PTR ret;
int st = get_int_value(start);
int len = get_int_value(length);
uintptr_t *raw_ptr;
uintptr_t orig_ptr, ptr;
int i;
//see comment in main.c for why we're not using object_alloc()
//posix_memalign((void **)&raw_ptr, 16, sizeof(unsigned int *));
//*((int *)raw_ptr) = len;
orig_ptr = array & POINTER_MASK;
ptr = object_alloc(len + 1, ARRAY_TAG);
//set_heap(ptr, 0, convert_int_to_object(len));
//set_heap(ptr, 0, (uintptr_t)raw_ptr + INTEGER_TAG);
*((uintptr_t *)ptr) = len;
for(i=1; i<=len; i++)
set_heap(ptr, i, get_heap(orig_ptr, st + i));
ret = ptr;
log_function_exit("eval_sub_array");
return ret + ARRAY_TAG;
}
OBJECT_PTR eval_make_array(OBJECT_PTR size, OBJECT_PTR default_value)
{
int sz = get_int_value(size);
uintptr_t *raw_ptr;
uintptr_t ptr;
int i;
assert(IS_INTEGER_OBJECT(size));
//see comment in main.c for why we're not using object_alloc()
//posix_memalign((void **)&raw_ptr, 16, sizeof(unsigned int *));
//*((int *)raw_ptr) = sz;
ptr = object_alloc(sz+1, ARRAY_TAG);
//set_heap(ptr, 0, size);
//set_heap(ptr, 0, (uintptr_t)raw_ptr + INTEGER_TAG);
*((uintptr_t *)ptr) = sz;
for(i=0; i<sz; i++)
set_heap(ptr, i + 1, clone_object(default_value));
return ptr + ARRAY_TAG;
}
OBJECT_PTR eval_string(OBJECT_PTR literal)
{
char *str_val = strings[(int)literal >> OBJECT_SHIFT];
char *ptr = NULL;
unsigned int len = strlen(str_val);
uintptr_t *raw_ptr1;
uintptr_t raw_ptr;
int i=1;
assert(IS_STRING_LITERAL_OBJECT(literal));
//see comment in main.c for why we're not using object_alloc()
//posix_memalign((void **)&raw_ptr1, 16, sizeof(unsigned int *));
//*((int *)raw_ptr1) = len;
raw_ptr = object_alloc(len + 1, ARRAY_TAG);
//set_heap(raw_ptr, 0, convert_int_to_object(len));
//set_heap(raw_ptr, 0, (uintptr_t)raw_ptr1 + INTEGER_TAG);
*((uintptr_t *)raw_ptr) = len;
for(ptr=str_val;*ptr;ptr++)
{
set_heap(raw_ptr, i, (OBJECT_PTR)((*ptr << OBJECT_SHIFT) + CHAR_TAG));
i++;
}
return raw_ptr + ARRAY_TAG;
}
// Send a proof over IPC
void send_proof(envid_t to, Proof p) {
// Copy the proof to UTEMP
sys_page_alloc(0, UTEMP, PTE_U | PTE_W);
Heap tempHeap;
init_heap(&tempHeap, UTEMP, PGSIZE);
Heap *oldHeap = set_heap(&tempHeap);
Proof copy = proof_cp(p);
size_t offset = (uintptr_t)copy - (uintptr_t)UTEMP;
// Send the proof
ipc_send(to, offset, UTEMP, PTE_U);
sys_page_unmap(0, UTEMP);
// Reset the heap
set_heap(oldHeap);
}
void
umain(int argc, char **argv) {
Heap heap;
init_heap(&heap, &heapBuffer, 4*PGSIZE);
set_heap(&heap);
printall();
cprintf("\n\nSTARTING TESTS\n\n");
cprintf("should be empty\n\n");
testall();
cprintf("FINISHED tests\n\n");
cprintf("\n\nSTARTING FAILURES\n\n");
proof_check_expected_failures();
cprintf("FINISHED failures\n\n");
}
OBJECT_PTR eval_backquote(OBJECT_PTR form)
{
OBJECT_PTR car_obj;
assert(is_valid_object(form));
if(is_atom(form))
return form;
car_obj = car(form);
assert(is_valid_object(car_obj));
if(IS_SYMBOL_OBJECT(car_obj))
{
char buf[SYMBOL_STRING_SIZE];
print_symbol(car_obj, buf);
if(car_obj == COMMA)
{
OBJECT_PTR temp = compile(CADR(form), NIL);
#ifdef WIN32
if(temp == ERROR1)
#else
if(temp == ERROR)
#endif
{
throw_generic_exception("Backquote evaluation(1): compile failed");
return NIL;
}
reg_next_expression = cons(cons(FRAME, cons(cons(CONS_HALT_NIL, CADR(form)),
cons(temp, CADR(form)))),
CADR(form));
reg_current_value_rib = NIL;
while(car(reg_next_expression) != NIL)
{
//print_object(car(reg_next_expression));printf("\n");getchar();
eval(false);
if(in_error)
{
throw_generic_exception("Evaluation of backquote failed(1)");
return NIL;
}
}
reg_next_expression = cons(CONS_RETURN_NIL, cdr(reg_next_expression));
reg_current_value_rib = NIL;
return reg_accumulator;
}
}
if(form_contains_comma_at(form))
{
//1. loop through elements in form
//2. if element is not comma-at, call eval_backquote on
// it and append it to the result list without splicing
//3. if it is comma-at, get its symbol value and
// splice the value to the result list
//4. return the result list
OBJECT_PTR result = NIL;
OBJECT_PTR rest = form;
while(rest != NIL)
{
OBJECT_PTR ret;
OBJECT_PTR obj;
if(IS_CONS_OBJECT(car(rest)) &&
IS_SYMBOL_OBJECT(CAAR(rest)))
{
char buf[SYMBOL_STRING_SIZE];
print_symbol(CAAR(rest), buf);
if(CAAR(rest) == COMMA_AT)
{
OBJECT_PTR temp = compile(CADAR(rest), NIL);
#ifdef WIN32
if(temp == ERROR1)
#else
if(temp == ERROR)
#endif
{
throw_generic_exception("Backquote evaluation(2): compile failed");
return NIL;
}
reg_next_expression = cons(cons(FRAME, cons(cons(CONS_HALT_NIL, CADAR(rest)),
cons(temp, CADAR(rest)))),
CADAR(rest));
reg_current_value_rib = NIL;
while(car(reg_next_expression) != NIL)
{
eval(false);
if(in_error)
{
throw_generic_exception("Evaluation of backquote failed(2)");
return NIL;
}
}
reg_next_expression = cons(CONS_RETURN_NIL, cdr(reg_next_expression));
reg_current_value_rib = NIL;
obj = reg_accumulator;
if(result == NIL)
result = obj;
else
set_heap(last_cell(result) & POINTER_MASK, 1, obj);
}
else
{
obj = eval_backquote(car(rest));
if(result == NIL)
result = cons(obj, NIL);
else
set_heap(last_cell(result) & POINTER_MASK, 1, cons(obj, NIL));
}
}
else
{
obj = eval_backquote(car(rest));
if(result == NIL)
result = cons(obj, NIL);
else
set_heap(last_cell(result) & POINTER_MASK, 1, cons(obj, NIL));
}
rest = cdr(rest);
}
return result;
}
return cons(eval_backquote(car(form)),
eval_backquote(cdr(form)));
}
OBJECT_PTR create_current_continuation()
{
uintptr_t ptr = object_alloc(1, CONTINUATION_TAG);
set_heap(ptr, 0, reg_current_stack);
return ptr + CONTINUATION_TAG;
}
