int test_list()
{
cell *c[3];
symbol *x = new_symbol("x");
symbol *y = new_symbol("y");
symbol *z = new_symbol("z");
integer *i = new_integer(10);
integer *j = new_integer(20);
list *l;
c[0] = cons(x, i);
c[1] = cons(x, i);
c[2] = cons(y, j);
l = cons(c[0], cons(c[1], cons(c[2], NULL)));
print_sexp(c[0]);
printf("\n");
print_sexp(c[1]);
printf("\n");
print_sexp(c[2]);
printf("\n");
print_sexp(l);
printf("\n");
assert(is_list(l));
assert(is_list(NULL));
assert(!is_list(c[0]));
assert(generic_equal(assoc(x, l), c[0]));
assert(generic_equal(assoc(y, l), c[2]));
assert(generic_equal(assoc(z, l), NULL));
return 1;
}
TEST(plankton, cycles) {
CREATE_RUNTIME();
value_t i0 = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
value_t k0 = new_integer(78);
ASSERT_SUCCESS(set_instance_field(runtime, i0, k0, i0));
value_t d0 = transcode_plankton(runtime, NULL, NULL, i0);
ASSERT_SAME(d0, get_instance_field(d0, k0));
value_t i1 = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
value_t i2 = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
value_t i3 = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
value_t k1 = new_integer(79);
ASSERT_SUCCESS(set_instance_field(runtime, i1, k0, i2));
ASSERT_SUCCESS(set_instance_field(runtime, i1, k1, i3));
ASSERT_SUCCESS(set_instance_field(runtime, i2, k1, i3));
ASSERT_SUCCESS(set_instance_field(runtime, i3, k0, i1));
value_t d1 = transcode_plankton(runtime, NULL, NULL, i1);
value_t d2 = get_instance_field(d1, k0);
value_t d3 = get_instance_field(d1, k1);
ASSERT_NSAME(d1, d2);
ASSERT_NSAME(d1, d3);
ASSERT_SAME(d3, get_instance_field(d2, k1));
ASSERT_SAME(d1, get_instance_field(d3, k0));
DISPOSE_RUNTIME();
}
int test_eval()
{
symbol *sa = new_symbol("a");
symbol *sb = new_symbol("b");
symbol *sc = new_symbol("c");
symbol *plus = new_symbol("+");
prim_proc *proc = new_prim_proc(proc_plus_integer);
integer *i10 = new_integer(10);
integer *i20 = new_integer(20);
integer *i30 = new_integer(30);
integer *i60 = new_integer(60);
list *vara = cons(sa, cons(sb, cons(sc, NULL)));
list *val10 = cons(i10, cons(i20, cons(i30, NULL)));
list *plus_i = cons(plus, val10);
environment *env = NULL;
env = extend_env(vara, val10, env);
assert(generic_equal(eval(sa, env), i10));
assert(generic_equal(eval(i10, env), i10));
define_var_val(plus, proc, env);
assert(generic_equal(car(list_of_values(val10, env)), i10));
assert(generic_equal(eval(plus_i, env), i60));
return 1;
}
int test_cell()
{
cell *c[3];
symbol *x = new_symbol("x");
symbol *y = new_symbol("y");
integer *i = new_integer(10);
integer *j = new_integer(20);
c[0] = cons(x, i);
c[1] = cons(x, i);
c[2] = cons(y, j);
assert(equal_symbol(car(c[0]), car(c[1])));
assert(!equal_symbol(car(c[0]), car(c[2])));
assert(equal_integer(cdr(c[0]), cdr(c[1])));
assert(!equal_integer(cdr(c[0]), cdr(c[2])));
set_car(c[1], y);
assert(!equal_symbol(car(c[0]), car(c[1])));
assert(equal_symbol(car(c[1]), car(c[2])));
set_cdr(c[1], j);
assert(!equal_integer(cdr(c[0]), cdr(c[1])));
assert(equal_integer(cdr(c[1]), cdr(c[2])));
assert(!equal_cell(c[0], c[1]));
assert(equal_cell(c[1], c[2]));
return 1;
}
// Map values to ints.
static value_t value_to_int(value_t value, runtime_t *runtime, void *ptr) {
test_resolver_data_t *data = (test_resolver_data_t*) ptr;
if (value_identity_compare(value, data->i0)) {
return new_integer(0);
} else if (value_identity_compare(value, data->i1)) {
return new_integer(1);
} else {
return new_condition(ccNothing);
}
}
int test_begin()
{
integer *i10 = new_integer(10);
integer *i20 = new_integer(20);
integer *i30 = new_integer(30);
list *val10 = cons(i10, cons(i20, cons(i30, NULL)));
environment *env = new_env();
assert(generic_equal(syntax_begin(val10, env), i30));
return 1;
}
TEST(plankton, map) {
CREATE_RUNTIME();
value_t map = new_heap_id_hash_map(runtime, 16);
check_plankton(runtime, map);
for (size_t i = 0; i < 16; i++) {
set_id_hash_map_at(runtime, map, new_integer(i), new_integer(5));
check_plankton(runtime, map);
}
DISPOSE_RUNTIME();
}
int test_plus_integer()
{
integer *i10 = new_integer(10);
integer *i20 = new_integer(20);
integer *i30 = new_integer(30);
integer *i60 = new_integer(60);
list *val10 = cons(i10, cons(i20, cons(i30, NULL)));
assert(generic_equal(proc_plus_integer(cons(i10,NULL)), i10));
assert(generic_equal(proc_plus_integer(val10), i60));
return 1;
}
TEST(plankton, instance) {
CREATE_RUNTIME();
value_t instance = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
check_plankton(runtime, instance);
DEF_HEAP_STR(x, "x");
ASSERT_SUCCESS(try_set_instance_field(instance, x, new_integer(8)));
DEF_HEAP_STR(y, "y");
ASSERT_SUCCESS(try_set_instance_field(instance, y, new_integer(13)));
value_t decoded = check_plankton(runtime, instance);
ASSERT_SUCCESS(decoded);
ASSERT_VALEQ(new_integer(8), get_instance_field(decoded, x));
DISPOSE_RUNTIME();
}
/**
* Retrieve the index of the current position.
*
* @return The position index.
*/
RexxInternalObject *SupplierClass::index()
{
// past the end if an error
if (position > items->size())
{
reportException(Error_Incorrect_method_supplier);
}
// the index array is optional...if we don't have it, just give
// the numeric position
if (indexes == OREF_NULL)
{
return new_integer(position);
}
// already gone past the end of the index array?
if (position > indexes->size())
{
return TheNilObject;
}
else
{
// get the current value and return .nil if nothing is there.
return resultOrNil(indexes->get(position));
}
}
int test_integer()
{
integer *i[3];
int x = 10;
int y = 20;
i[0] = new_integer(x);
i[1] = new_integer(x);
i[2] = new_integer(y);
assert(is_integer(i[0]));
assert(equal_integer(i[0], i[1]));
assert(!equal_integer(i[0], i[2]));
assert(integer_to_int(i[0]) == x);
assert(integer_to_int(i[2]) == y);
return 1;
}
RexxObject *RexxSupplier::index()
/****************************************************************************/
/* Function: Retrieve the index of a collection item */
/****************************************************************************/
{
RexxObject *_value; /* supplier value */
/* already gone past the end? */
if (this->position > this->values->size())
{
/* oops, give an error */
reportException(Error_Incorrect_method_supplier);
}
if (this->indexes == OREF_NULL) /* no index array given? */
{
/* just return current position */
return(RexxObject *)new_integer(this->position);
}
/* already gone past the end? */
if (this->position > this->indexes->size())
{
_value = TheNilObject; /* no value to return */
}
else
{
/* get the value */
_value = this->indexes->get(this->position);
if (_value == OREF_NULL) /* returned nothing? */
{
_value = TheNilObject; /* change this to .nil */
}
}
return _value; /* and return the value */
}
static SCM c_string_to_number(char *buf)
{
int sign = 1;
int offset = 0;
switch (buf[offset]) {
case '+':
offset++;
break;
case '-':
offset++;
sign *= -1;
break;
}
if ('\0' == buf[offset]) { return SCM_FALSE; }
{
int index = offset;
while (buf[index]) {
if (! isdigit(buf[index]) ) {
return SCM_FALSE;
}
index++;
}
}
return new_integer((int) strtol(buf, NULL,10));
}
TEST(plankton, simple) {
CREATE_RUNTIME();
// Integers
check_plankton(runtime, new_integer(0));
check_plankton(runtime, new_integer(1));
check_plankton(runtime, new_integer(-1));
check_plankton(runtime, new_integer(65536));
check_plankton(runtime, new_integer(-65536));
// Singletons
check_plankton(runtime, null());
check_plankton(runtime, yes());
check_plankton(runtime, no());
DISPOSE_RUNTIME();
}
value_t map_scope_bind(map_scope_o *scope, value_t symbol, binding_type_t type,
uint32_t data) {
binding_info_codec_t codec;
binding_info_set(&codec.decoded, type, data, 0);
value_t value = new_integer(codec.encoded);
TRY(set_id_hash_map_at(scope->assembler->runtime, scope->map, symbol, value));
return success();
}
TEST(plankton, array) {
CREATE_RUNTIME();
value_t arr = new_heap_array(runtime, 5);
check_plankton(runtime, arr);
set_array_at(arr, 0, new_integer(5));
check_plankton(runtime, arr);
DISPOSE_RUNTIME();
}
/**
* Convert an unsigned number value into the appropriate Rexx
* object type.
*
* @param v The value to convert.
*
* @return The Rexx object version of this number.
*/
RexxObject *Numerics::stringsizeToObject(stringsize_t v)
{
// in the range for an integer object?
if (v <= (stringsize_t)MAX_WHOLENUMBER)
{
return new_integer((stringsize_t)v);
}
// out of range, we need to use a numberstring for this, using the full
// allowable digits range
return new_numberstringFromStringsize(v);
}
/**
* Convert an signed number value into the appropriate Rexx
* object type.
*
* @param v The value to convert.
*
* @return The Rexx object version of this number.
*/
RexxObject *Numerics::wholenumberToObject(wholenumber_t v)
{
// in the range for an integer object?
if (v <= MAX_WHOLENUMBER && v >= MIN_WHOLENUMBER)
{
return new_integer((wholenumber_t)v);
}
// out of range, we need to use a numberstring for this, using the full
// allowable digits range
return new_numberstringFromWholenumber(v);
}
void close_frame(frame_t *frame) {
value_t piece = frame->stack_piece;
CHECK_FALSE("stack piece already closed", is_stack_piece_closed(piece));
bool pushed = try_push_new_frame(frame, 0, ffLid | ffSynthetic, true);
CHECK_TRUE("Failed to close frame", pushed);
value_t *stack_start = frame_get_stack_piece_bottom(frame);
set_stack_piece_lid_frame_pointer(piece, new_integer(frame->frame_pointer - stack_start));
frame->stack_piece = nothing();
frame->frame_pointer = frame->limit_pointer = frame->stack_pointer = 0;
frame->pc = 0;
}
/* Integer special object routines */
mmObjectPtr mm_new_integer(long value) {
mmInteger* i;
if ( (value>=-32767) && (value<=32767) ) {
i=(mmInteger*)integer_cache[value+32767];
} else {
i=(mmInteger*)new_integer(value);
}
return (mmObjectPtr)i;
}
// Map ints to values.
static value_t int_to_value(value_t value, runtime_t *runtime, void *ptr) {
test_resolver_data_t *data = (test_resolver_data_t*) ptr;
switch (get_integer_value(value)) {
case 0:
return data->i0;
case 1:
return data->i1;
default:
UNREACHABLE("int to value");
return new_integer(0);
}
}
/**
* Convert an signed ptr value into the appropriate Rexx object
* type.
*
* @param v The value to convert.
*
* @return The Rexx object version of this number.
*/
RexxObject *Numerics::intptrToObject(intptr_t v)
{
// in the range for an integer object?
if (v <= (intptr_t)MAX_WHOLENUMBER && v >=(intptr_t)MIN_WHOLENUMBER)
{
return new_integer((wholenumber_t)v);
}
// out of range, we need to use a numberstring for this, using the full
// allowable digits range. Note that this assumes we maintain the connection
// that a wholenumber_t is the same size as an intptr_t.
return new_numberstringFromWholenumber((wholenumber_t)v);
}
int test_environment()
{
symbol *sa = new_symbol("a");
symbol *sb = new_symbol("b");
symbol *sc = new_symbol("c");
symbol *sx = new_symbol("x");
symbol *sy = new_symbol("y");
symbol *sz = new_symbol("z");
symbol *sn = new_symbol("n");
integer *i10 = new_integer(10);
integer *i20 = new_integer(20);
integer *i30 = new_integer(30);
integer *i40 = new_integer(40);
integer *i50 = new_integer(50);
integer *i60 = new_integer(60);
list *vara = cons(sa, cons(sb, cons(sc, NULL)));
list *varx = cons(sx, cons(sy, cons(sz, NULL)));
list *val10 = cons(i10, cons(i20, cons(i30, NULL)));
list *val40 = cons(i40, cons(i50, cons(i60, NULL)));
environment *env = NULL;
env = extend_env(vara, val10, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
env = define_var_val(sx, i40, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
assert(generic_equal(lookup_var_val(sx, env), cons(sx, i40)));
assert(generic_equal(lookup_var_val(sy, env), NULL));
env = set_var_val(sx, i50, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
assert(generic_equal(lookup_var_val(sx, env), cons(sx, i50)));
assert(generic_equal(lookup_var_val(sy, env), NULL));
env = extend_env(varx, val40, env);
assert(generic_equal(lookup_var_val(sa, env), cons(sa, i10)));
assert(generic_equal(lookup_var_val(sb, env), cons(sb, i20)));
assert(generic_equal(lookup_var_val(sc, env), cons(sc, i30)));
assert(generic_equal(lookup_var_val(sx, env), cons(sx, i40)));
assert(generic_equal(lookup_var_val(sy, env), cons(sy, i50)));
assert(generic_equal(lookup_var_val(sz, env), cons(sz, i60)));
assert(generic_equal(lookup_var_val(sn, env), NULL));
return 1;
}
void mm_init_memory_cache() {
int i;
int int_value;
for (i=0;i<65535;i++) {
int_value=i-32767;
integer_cache[i]=new_integer(int_value);
mm_inc_ref(integer_cache[i]);
}
for (i=0;i<255;i++) {
character_cache[i]=new_character(i);
mm_inc_ref(character_cache[i]);
}
}
bool test_equal()
{
symbol *s[3];
integer *i[3];
boolean *b[3];
s[0] = new_symbol("foo");
s[1] = new_symbol("bar");
s[2] = new_symbol("foo");
i[0] = new_integer(0);
i[1] = new_integer(1);
i[2] = new_integer(0);
b[0] = new_boolean(true);
b[1] = new_boolean(false);
b[2] = new_boolean(true);
assert(generic_equal(s[0], s[0]) == true);
assert(generic_equal(s[0], s[1]) == false);
assert(generic_equal(s[0], s[2]) == true);
assert(generic_equal(i[0], i[0]) == true);
assert(generic_equal(i[0], i[1]) == false);
assert(generic_equal(i[0], i[2]) == true);
assert(generic_equal(b[0], b[0]) == true);
assert(generic_equal(b[0], b[1]) == false);
assert(generic_equal(b[0], b[2]) == true);
assert(generic_equal(b[0], s[0]) == false);
assert(generic_equal(b[0], i[1]) == false);
assert(generic_equal(s[0], b[1]) == false);
return true;
}
// checks if pad is a single character string
inline RexxString *checkPadArgument(const char *pFuncName, size_t position, RexxString *pad)
{
// pads are typically optional, so accept if not there.
if (pad == OREF_NULL)
{
return OREF_NULL;
}
if (pad->getLength() != 1)
{
reportException(Error_Incorrect_call_pad, pFuncName, new_integer(position), pad);
}
return pad;
}
value_t build_call_tags_entries(runtime_t *runtime, value_t tags) {
int64_t tag_count = get_array_length(tags);
TRY_DEF(result, new_heap_pair_array(runtime, tag_count));
for (int64_t i = 0; i < tag_count; i++) {
set_pair_array_first_at(result, i, get_array_at(tags, i));
// The offset is counted backwards because the argument evaluated last will
// be at the top of the stack, that is, offset 0, and the first will be at
// the bottom so has the highest offset.
int64_t offset = tag_count - i - 1;
set_pair_array_second_at(result, i, new_integer(offset));
}
TRY(co_sort_pair_array(result));
IF_EXPENSIVE_CHECKS_ENABLED(check_call_tags_entries_unique(result));
return result;
}
int main(void){
int a = *new_integer_ptr(); // now a should be 10
int b = new_integer(); // and b is 5
printf("At address : %x : %i\n",&a, a);
printf("At address : %x : %i\n",&b, b);
printf("When the first function completes, it frees the mamory\n"
"on the stack that it was occupying, but the variable\n"
"that was created in this function remains in the same, freed memory\n"
"When a new function is called, it might be allocated at the same memory as\n"
"the previous function and may overwrite the value of the first variable\n"
"and when we try to access its location by using the pointer, the result may\n"
"be completely different");
return 0;
}
/**
* Do post-callout processing of a command dispatch. This
* code runs after re-entering the interpreter, so all
* interpreter facilities are available.
*
* @param result The return RC result.
* @param condition A potential condition return.
*/
void CommandHandlerDispatcher::complete(RexxString *command, ProtectedObject &result, ProtectedObject &condition)
{
// did we get a numeric return code? Turn into an Integer object.
if (sbrc != 0)
{
result = new_integer(sbrc);
}
// maybe we got a string value back?
else if (!RXNULLSTRING(retstr))
{
// make into a string value and try to convert to an integer (not an error
// if it doesn't convert)
result = new_string(retstr.strptr, retstr.strlength);
// try to get this as a numeric value
result->numberValue(sbrc);
// handle any buffer reallocation
if (retstr.strptr != default_return_buffer)
{
SystemInterpreter::releaseResultMemory(retstr.strptr);
}
}
// default return code is zero
else
{
result = IntegerZero;
}
// Check error flags from subcom handler and if needed, stick condition
// into result array.
if (flags & (unsigned short)RXSUBCOM_FAILURE)
{
// raise the condition when things are done
condition = activity->createConditionObject(GlobalNames::FAILURE, result, command, OREF_NULL, OREF_NULL);
}
else if (flags & (unsigned short)RXSUBCOM_ERROR)
{
// raise the condition when things are done
condition = activity->createConditionObject(GlobalNames::ERRORNAME, result, command, OREF_NULL, OREF_NULL);
}
}
void cubex_main(){
input = get_input();
ref_increment((General_t)input);
a = NULL;
__temp4 = NULL;
__temp0 = NULL;
__temp5 = NULL;
__temp1 = NULL;
__temp6 = NULL;
__temp2 = NULL;
__temp7 = NULL;
__temp3 = NULL;
__temp0 = NULL;
ref_decrement((General_t)__temp0);
__temp0 = new_integer(1);
ref_increment((General_t)__temp0);
ref_decrement((General_t)__temp0);
__temp0 = NULL;
ref_decrement((General_t)__temp1);
__temp1 = new_integer(1);
ref_increment((General_t)__temp1);
if(((Boolean_t)__temp1)->value) {
ref_decrement((General_t)__temp1);
__temp1= NULL;
__temp2 = NULL;
ref_decrement((General_t)__temp2);
__temp2 = new_git_obj_charuni((char) 't');
ref_increment((General_t)__temp2);
__temp3 = NULL;
ref_decrement((General_t)__temp3);
__temp3 = iterable_append((git_t) __temp2,(git_t) NULL);
ref_increment((General_t)__temp3);
ref_decrement((General_t)__temp2);
__temp2 = NULL;
ref_decrement((General_t)a);
a = __temp3;
ref_increment((General_t)a);
ref_decrement((General_t)__temp3);
__temp3 = NULL;
} else {
ref_decrement((General_t)__temp1);
__temp1= NULL;
__temp4 = NULL;
ref_decrement((General_t)__temp4);
__temp4 = new_git_obj_charuni((char) 'f');
ref_increment((General_t)__temp4);
__temp5 = NULL;
ref_decrement((General_t)__temp5);
__temp5 = iterable_append((git_t) __temp4,(git_t) NULL);
ref_increment((General_t)__temp5);
ref_decrement((General_t)__temp4);
__temp4 = NULL;
ref_decrement((General_t)a);
a = __temp5;
ref_increment((General_t)a);
ref_decrement((General_t)__temp5);
__temp5 = NULL;
}
ref_decrement((General_t)__temp6);
__temp6 = new_git_obj((void*) a);
ref_increment((General_t)__temp6);
ref_decrement((General_t)a);
a = NULL;
ref_decrement((General_t)__temp7);
__temp7 = iterable_append((git_t) __temp6,(git_t) NULL);
ref_increment((General_t)__temp7);
ref_decrement((General_t)__temp6);
__temp6 = NULL;
_it1 = new_iterator((__temp7));
ref_increment((General_t)_it1);
while(hasNext(_it1)) {
_return = getNext(_it1);
print_line(charToString(_return), stringLength(_return));
}
ref_decrement((General_t)_it1);
_it1 = NULL;
ref_decrement((General_t)__temp7);
__temp7 = NULL;
ref_decrement((General_t)input);
ending();
return;
}
