/**
* InternalNumberCast
*
* Casts an object to a number object.
*/
ctr_object* ctr_internal_cast2number(ctr_object* o) {
if (o->info.type == CTR_OBJECT_TYPE_OTNUMBER) return o;
if (o->info.type == CTR_OBJECT_TYPE_OTSTRING) {
return ctr_build_number_from_string(o->value.svalue->value, o->value.svalue->vlen);
}
return ctr_build_number_from_float((ctr_number)0);
}
/**
* CTRWalkerMessage
*
* Processes a message sending operation.
*/
ctr_object *
ctr_cwlk_message (ctr_tnode * paramNode)
{
int sticky = 0;
char wasReturn = 0;
ctr_object *result;
ctr_tlistitem *eitem = paramNode->nodes;
ctr_tnode *receiverNode = eitem->node;
ctr_tnode *msgnode;
ctr_tlistitem *li = eitem;
char *message;
ctr_tlistitem *argumentList;
ctr_object *r;
ctr_object *recipientName = NULL;
switch (receiverNode->type)
{
case CTR_AST_NODE_REFERENCE:
recipientName = ctr_build_string (receiverNode->value, receiverNode->vlen);
recipientName->info.sticky = 1;
if (CtrStdFlow == NULL)
{
ctr_callstack[ctr_callstack_index++] = receiverNode;
}
if (receiverNode->modifier == 1 || receiverNode->modifier == 3)
{
r = ctr_find_in_my (recipientName);
}
else
{
r = ctr_find (recipientName);
}
if (CtrStdFlow == NULL)
{
ctr_callstack_index--;
}
if (!r)
{
exit (1);
}
break;
case CTR_AST_NODE_LTRNIL:
r = ctr_build_nil ();
break;
case CTR_AST_NODE_LTRBOOLTRUE:
r = ctr_build_bool (1);
break;
case CTR_AST_NODE_LTRBOOLFALSE:
r = ctr_build_bool (0);
break;
case CTR_AST_NODE_LTRSTRING:
r = ctr_build_string (receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_LTRNUM:
r = ctr_build_number_from_string (receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_IMMUTABLE:
case CTR_AST_NODE_NESTED:
r = ctr_cwlk_expr (receiverNode, &wasReturn);
break;
case CTR_AST_NODE_CODEBLOCK:
r = ctr_build_block (receiverNode);
break;
case CTR_AST_NODE_SYMBOL:
r = (ctr_object *) (receiverNode->value);
break;
default:
printf ("Cannot send messages to receiver of type: %d \n", receiverNode->type);
break;
}
while (li->next)
{
ctr_argument *a;
ctr_argument *aItem;
ctr_size l;
li = li->next;
msgnode = li->node;
message = msgnode->value;
l = msgnode->vlen;
if (CtrStdFlow == NULL)
{
ctr_callstack[ctr_callstack_index++] = msgnode;
}
argumentList = msgnode->nodes;
a = (ctr_argument *) ctr_heap_allocate (sizeof (ctr_argument));
aItem = a;
aItem->object = CtrStdNil;
if (argumentList)
{
ctr_tnode *node;
while (argumentList)
{
node = argumentList->node;
if (!node)
goto next;
aItem->object = ctr_cwlk_expr (node, &wasReturn);
/* we always send at least one argument, note that if you want to modify the argumentList, be sure to take this into account */
/* there is always an extra empty argument at the end */
aItem->next = ctr_heap_allocate (sizeof (ctr_argument));
aItem = aItem->next;
next:;
aItem->object = NULL;
argumentList = argumentList->next;
}
}
sticky = r->info.sticky;
r->info.sticky = 1;
result = ctr_send_message (r, message, l, a);
r->info.sticky = sticky;
aItem = a;
if (CtrStdFlow == NULL)
{
ctr_callstack_index--;
}
while (aItem->next)
{
a = aItem;
aItem = aItem->next;
ctr_heap_free (a);
}
ctr_heap_free (aItem);
r = result;
}
if (recipientName)
recipientName->info.sticky = 0;
return result;
}
/**
* CTRWalkerExpression
*
* Processes an expression.
*/
ctr_object *
ctr_cwlk_expr (ctr_tnode * node, char *wasReturn)
{
if (!node)
{
CtrStdFlow = ctr_build_string_from_cstring ("Encounered null parse node");
return NULL;
}
ctr_object *result;
switch (node->type)
{
case CTR_AST_NODE_LTRSTRING:
result = ctr_build_string (node->value, node->vlen);
break;
case CTR_AST_NODE_LTRBOOLTRUE:
result = ctr_build_bool (1);
break;
case CTR_AST_NODE_LTRBOOLFALSE:
result = ctr_build_bool (0);
break;
case CTR_AST_NODE_LTRNIL:
result = ctr_build_nil ();
break;
case CTR_AST_NODE_LTRNUM:
result = ctr_build_number_from_string (node->value, node->vlen);
break;
case CTR_AST_NODE_CODEBLOCK:
result = ctr_build_block (node);
break;
case CTR_AST_NODE_REFERENCE:
if (ctr_cwlk_replace_refs && ctr_cwlk_msg_level <= ctr_cwlk_last_msg_level)
{
// printf("%.*s\n", node->vlen, node->value);
result = ctr_build_string (node->value, node->vlen);
break;
}
if (CtrStdFlow == NULL)
{
ctr_callstack[ctr_callstack_index++] = node;
}
if (node->modifier == 1 || node->modifier == 3)
{
result = ctr_find_in_my (ctr_build_string (node->value, node->vlen));
}
else
result = ctr_find (ctr_build_string (node->value, node->vlen));
if (CtrStdFlow == NULL)
{
ctr_callstack_index--;
}
break;
case CTR_AST_NODE_EXPRMESSAGE:
result = ctr_cwlk_message (node);
break;
case CTR_AST_NODE_EXPRASSIGNMENT:
result = ctr_cwlk_assignment (node);
break;
case CTR_AST_NODE_IMMUTABLE:
result = ctr_build_immutable (node);
break;
case CTR_AST_NODE_SYMBOL:
result = (ctr_object *) (node->value);
break;
case CTR_AST_NODE_RETURNFROMBLOCK:
result = ctr_cwlk_return (node);
*wasReturn = 1;
break;
case CTR_AST_NODE_NESTED:
result = ctr_cwlk_expr (node->nodes->node, wasReturn);
break;
case CTR_AST_NODE_LISTCOMP:
result = ctr_build_listcomp (node);
break;
case CTR_AST_NODE_ENDOFPROGRAM:
if (CtrStdFlow && CtrStdFlow != CtrStdExit && ctr_cwlk_subprogram == 0)
{
printf ("Uncaught error has occurred.\n");
if (CtrStdFlow->info.type == CTR_OBJECT_TYPE_OTSTRING)
{
fwrite (CtrStdFlow->value.svalue->value, sizeof (char), CtrStdFlow->value.svalue->vlen, stdout);
printf ("\n");
}
ctr_print_stack_trace ();
}
result = ctr_build_nil ();
break;
default:
printf ("Runtime Error. Invalid parse node: %d %s \n", node->type, node->value);
exit (1);
break;
}
return result;
}
/**
* CTRWalkerMessage
*
* Processes a message sending operation.
*/
ctr_object* ctr_cwlk_message(ctr_tnode* paramNode) {
int sticky = 0;
char wasReturn = 0;
int literal = 1;
ctr_object* keys[40];
int key_index = 0;
ctr_object* result;
ctr_tlistitem* eitem = paramNode->nodes;
ctr_tnode* receiverNode = eitem->node;
ctr_tnode* msgnode;
ctr_tlistitem* li = eitem;
char* message;
ctr_tlistitem* argumentList;
ctr_object* r;
ctr_object* recipientName = NULL;
if (ctr_flag_sandbox && ++ctr_sandbox_steps>CTR_MAX_STEPS_LIMIT) exit(1);
switch (receiverNode->type) {
case CTR_AST_NODE_REFERENCE:
literal = 0;
recipientName = ctr_build_string(receiverNode->value, receiverNode->vlen);
recipientName->info.sticky = 1;
if (CtrStdFlow == NULL) {
ctr_callstack[ctr_callstack_index++] = receiverNode;
}
if (receiverNode->modifier == 1) {
r = ctr_find_in_my(recipientName);
} else {
r = ctr_find(recipientName);
}
if (CtrStdFlow == NULL) {
ctr_callstack_index--;
}
if (!r) {
exit(1);
}
break;
case CTR_AST_NODE_LTRNIL:
r = ctr_build_nil();
break;
case CTR_AST_NODE_LTRBOOLTRUE:
r = ctr_build_bool(1);
break;
case CTR_AST_NODE_LTRBOOLFALSE:
r = ctr_build_bool(0);
break;
case CTR_AST_NODE_LTRSTRING:
r = ctr_build_string(receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_LTRNUM:
r = ctr_build_number_from_string(receiverNode->value, receiverNode->vlen);
break;
case CTR_AST_NODE_NESTED:
r = ctr_cwlk_expr(receiverNode, &wasReturn);
break;
case CTR_AST_NODE_CODEBLOCK:
r = ctr_build_block(receiverNode);
break;
default:
fprintf(stderr, CTR_ERR_SEND, receiverNode->type);
break;
}
int ctr_assume_message_level = ctr_in_message;
int ctr_is_chain = 0;
while(li->next) {
if (ctr_flag_sandbox && ++ctr_sandbox_steps>CTR_MAX_STEPS_LIMIT) exit(1);
if (ctr_is_chain) {
ctr_in_message++;
}
ctr_is_chain++;
ctr_argument* a;
ctr_argument* aItem;
ctr_size l;
li = li->next;
msgnode = li->node;
message = msgnode->value;
l = msgnode->vlen;
if (CtrStdFlow == NULL) {
ctr_callstack[ctr_callstack_index++] = msgnode;
}
argumentList = msgnode->nodes;
a = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
aItem = a;
aItem->object = CtrStdNil;
sticky = r->info.sticky;
r->info.sticky = 1;
if (literal) {
keys[key_index++] = ctr_gc_internal_pin(r);
}
if (argumentList) {
ctr_tnode* node;
node = argumentList->node;
while(1) {
ctr_in_message++;
ctr_object* o = ctr_cwlk_expr(node, &wasReturn);
ctr_in_message--;
aItem->object = o;
keys[key_index++] = ctr_gc_internal_pin(o);
if (key_index > 39) {
printf( CTR_ERR_KEYINX );
exit(1);
}
/* we always send at least one argument, note that if you want to modify the argumentList, be sure to take this into account */
/* there is always an extra empty argument at the end */
aItem->next = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
aItem = aItem->next;
aItem->object = CtrStdNil;
if (!argumentList->next) break;
argumentList = argumentList->next;
node = argumentList->node;
}
}
result = ctr_send_message(r, message, l, a);
r->info.sticky = sticky;
aItem = a;
if (CtrStdFlow == NULL) {
ctr_callstack_index --;
}
while(aItem->next) {
a = aItem;
aItem = aItem->next;
ctr_internal_object_delete_property(ctr_contexts[ctr_context_id], keys[--key_index], CTR_CATEGORY_PRIVATE_PROPERTY);
ctr_heap_free( a );
}
ctr_heap_free( aItem );
if (literal) {
ctr_internal_object_delete_property( ctr_contexts[ctr_context_id], keys[--key_index], CTR_CATEGORY_PRIVATE_PROPERTY );
}
r = result;
}
ctr_in_message -= (ctr_is_chain - 1);
if (ctr_in_message != ctr_assume_message_level) {
printf( CTR_ERR_ANOMALY );
exit(1);
}
if (recipientName) recipientName->info.sticky = 0;
return result;
}
/**
* CTRWalkerExpression
*
* Processes an expression.
*/
ctr_object* ctr_cwlk_expr(ctr_tnode* node, char* wasReturn) {
ctr_object* result;
uint8_t i;
int line;
char* currentProgram = "?";
ctr_tnode* stackNode;
ctr_source_map* mapItem;
if (ctr_flag_sandbox && ++ctr_sandbox_steps>CTR_MAX_STEPS_LIMIT) exit(1);
switch (node->type) {
case CTR_AST_NODE_LTRSTRING:
result = ctr_build_string(node->value, node->vlen);
break;
case CTR_AST_NODE_LTRBOOLTRUE:
result = ctr_build_bool(1);
break;
case CTR_AST_NODE_LTRBOOLFALSE:
result = ctr_build_bool(0);
break;
case CTR_AST_NODE_LTRNIL:
result = ctr_build_nil();
break;
case CTR_AST_NODE_LTRNUM:
result = ctr_build_number_from_string(node->value, node->vlen);
break;
case CTR_AST_NODE_CODEBLOCK:
result = ctr_build_block(node);
break;
case CTR_AST_NODE_REFERENCE:
if (CtrStdFlow == NULL) {
ctr_callstack[ctr_callstack_index++] = node;
}
if (node->modifier == 1) {
result = ctr_find_in_my(ctr_build_string(node->value, node->vlen));
} else {
result = ctr_find(ctr_build_string(node->value, node->vlen));
}
if (CtrStdFlow == NULL) {
ctr_callstack_index--;
}
break;
case CTR_AST_NODE_EXPRMESSAGE:
result = ctr_cwlk_message(node);
break;
case CTR_AST_NODE_EXPRASSIGNMENT:
result = ctr_cwlk_assignment(node);
break;
case CTR_AST_NODE_RETURNFROMBLOCK:
result = ctr_cwlk_return(node);
*wasReturn = 1;
break;
case CTR_AST_NODE_NESTED:
result = ctr_cwlk_expr(node->nodes->node, wasReturn);
break;
case CTR_AST_NODE_ENDOFPROGRAM:
if (CtrStdFlow && CtrStdFlow != CtrStdExit && ctr_cwlk_subprogram == 0) {
fprintf(stderr, CTR_ERR_UNCAUGHT );
if (CtrStdFlow->info.type == CTR_OBJECT_TYPE_OTSTRING) {
fwrite(CtrStdFlow->value.svalue->value, sizeof(char), CtrStdFlow->value.svalue->vlen, stderr);
fprintf(stderr,"\n");
}
for ( i = ctr_callstack_index; i > 0; i--) {
fprintf(stderr,"#%d ", i);
stackNode = ctr_callstack[i-1];
fwrite(stackNode->value, sizeof(char), stackNode->vlen, stderr);
mapItem = ctr_source_map_head;
line = -1;
while(mapItem) {
if (line == -1 && mapItem->node == stackNode) {
line = mapItem->line;
}
if (line > -1 && mapItem->node->type == CTR_AST_NODE_PROGRAM) {
currentProgram = mapItem->node->value;
fprintf(stderr," (%s: %d)", currentProgram, line+1);
break;
}
mapItem = mapItem->next;
}
fprintf(stderr,"\n");
}
}
result = ctr_build_nil();
break;
default:
fprintf(stderr, CTR_ERR_NODE, node->type,node->value);
exit(1);
break;
}
return result;
}