INLINE void
_syx_memory_gc_mark (SyxOop object)
{
syx_varsize i;
if (!SYX_IS_OBJECT (object) || SYX_OBJECT_IS_MARKED(object) || SYX_IS_NIL(syx_object_get_class (object)))
return;
SYX_OBJECT_IS_MARKED(object) = TRUE;
_syx_memory_gc_mark (SYX_OBJECT(object)->klass);
/* Only the used stack part of the process must be marked */
if (SYX_OOP_EQ (syx_object_get_class (object), syx_process_class))
{
SyxOop stack = SYX_PROCESS_STACK (object);
SyxInterpFrame *frame = SYX_OOP_CAST_POINTER (SYX_PROCESS_FRAME_POINTER (object));
syx_int32 offset = SYX_POINTERS_OFFSET (frame->stack,
SYX_OBJECT_DATA (stack));
SYX_OBJECT_IS_MARKED(stack) = TRUE;
/* First mark variables except the process stack */
for (i=0; i < SYX_VARS_PROCESS_STACK; i++)
_syx_memory_gc_mark (SYX_OBJECT_VARS(object)[i]);
/* Mark detached frames */
while (frame)
{
_syx_memory_gc_mark (frame->detached_frame);
frame = frame->parent_frame;
}
/* Now mark the stack */
for (i=0; i < offset; i++)
_syx_memory_gc_mark (SYX_OBJECT_DATA(stack)[i]);
/* Mark variables after the process stack */
for (i=SYX_VARS_PROCESS_STACK+1; i < syx_object_vars_size (object); i++)
_syx_memory_gc_mark (SYX_OBJECT_VARS(object)[i]);
/* Process has no data */
return;
}
else
{
for (i=0; i < syx_object_vars_size (object); i++)
_syx_memory_gc_mark (SYX_OBJECT_VARS(object)[i]);
}
if (SYX_OBJECT_HAS_REFS (object))
{
for (i=0; i < SYX_OBJECT_DATA_SIZE (object); i++)
_syx_memory_gc_mark (SYX_OBJECT_DATA(object)[i]);
}
}
/*!
Create a MethodContext for an arbitrary message ready to enter a Process.
\param num_args the number of arguments
\param ap a va_list containing all SyxOops
*/
SyxOop
syx_vsend_message (SyxOop receiver, syx_symbol selector, syx_int32 num_args, va_list ap)
{
syx_varsize i;
SyxOop context;
SyxOop klass;
SyxOop method;
SyxOop arguments;
if (num_args == 0)
return syx_send_unary_message (receiver, selector);
klass = syx_object_get_class (receiver);
method = syx_class_lookup_method (klass, selector);
if (SYX_IS_NIL (method))
syx_error ("Unable to lookup method #%s in class %p (%s)\n", selector,
SYX_OOP_CAST_POINTER (klass),
SYX_OBJECT_BYTE_ARRAY (SYX_CLASS_NAME(klass)));
arguments = syx_array_new_size (num_args);
for (i=0; i < num_args; i++)
SYX_OBJECT_DATA(arguments)[i] = va_arg (ap, SyxOop);
context = syx_method_context_new (method, receiver, arguments);
return context;
}
/*!
Enters a new MethodContext or BlockContext.
\return FALSE if the context was syx_nil
*/
syx_bool
syx_interp_enter_context (SyxOop process, SyxOop context)
{
SyxOop arguments;
syx_bool reset_parent_frame = FALSE;
SyxInterpState _state = SYX_INTERP_STATE_NEW;
SyxInterpState *state;
SyxInterpFrame *frame;
if (SYX_IS_NIL (process) || SYX_IS_NIL (context))
return FALSE;
if (SYX_OOP_EQ (process, _syx_interp_state.process))
state = &_syx_interp_state;
else
{
state = &_state;
frame = SYX_OOP_CAST_POINTER (SYX_PROCESS_FRAME_POINTER (process));
/* This is a new Process, reset the parent_frame once we created the frame */
if (SYX_IS_NIL (frame->method))
reset_parent_frame = TRUE;
state->frame = frame;
state->process = process;
}
arguments = SYX_CONTEXT_PART_ARGUMENTS (context);
if (SYX_IS_NIL (arguments))
state->message_arguments_count = 0;
else
{
state->message_arguments_count = SYX_OBJECT_DATA_SIZE (arguments);
memcpy (state->message_arguments, SYX_OBJECT_DATA (arguments), state->message_arguments_count * sizeof (SyxOop));
}
if (SYX_OOP_EQ (syx_object_get_class (context), syx_block_context_class))
_syx_interp_frame_prepare_new_closure (state, SYX_BLOCK_CONTEXT_CLOSURE (context));
else
{
state->message_receiver = SYX_METHOD_CONTEXT_RECEIVER (context);
_syx_interp_frame_prepare_new (state, SYX_CONTEXT_PART_METHOD (context));
}
if (reset_parent_frame)
state->frame->stack_return_frame = state->frame->parent_frame = NULL;
state->frame->this_context = context;
SYX_CONTEXT_PART_FRAME_POINTER (context) = SYX_POINTER_CAST_OOP (state->frame);
_syx_interp_save_process_state (state);
return TRUE;
}
static SyxOop
_syx_parser_find_class_variable_name (SyxParser *self, syx_symbol name)
{
SyxOop klass = self->klass;
SyxOop binding;
if (syx_object_get_class (klass) == syx_metaclass_class)
klass = SYX_METACLASS_INSTANCE_CLASS (klass);
for (; !SYX_IS_NIL(klass); klass=SYX_CLASS_SUPERCLASS(klass))
{
binding = syx_dictionary_binding_at_symbol_if_absent (SYX_CLASS_CLASS_VARIABLES (klass), name, syx_nil);
if (!SYX_IS_NIL (binding))
return binding;
}
return syx_nil;
}
/*! Create a MethodContext for a unary message ready to enter a Process */
SyxOop
syx_send_unary_message (SyxOop receiver, syx_symbol selector)
{
SyxOop context;
SyxOop klass;
SyxOop method;
klass = syx_object_get_class (receiver);
method = syx_class_lookup_method (klass, selector);
if (SYX_IS_NIL (method))
syx_error ("Unable to lookup method #%s in class %p (%s)\n", selector,
SYX_OOP_CAST_POINTER (klass),
SYX_IS_NIL (SYX_CLASS_NAME(klass))
? NULL
: SYX_OBJECT_STRING (SYX_CLASS_NAME(klass)));
context = syx_method_context_new (method, receiver, syx_nil);
return context;
}
INLINE void
_syx_memory_gc_mark (SyxOop object)
{
syx_varsize i;
if (!SYX_IS_OBJECT (object) || SYX_OBJECT_IS_MARKED(object) || SYX_IS_NIL(syx_object_get_class (object)))
return;
SYX_OBJECT_IS_MARKED(object) = TRUE;
_syx_memory_gc_mark (SYX_OBJECT(object)->klass);
for (i=0; i < syx_object_vars_size (object); i++)
_syx_memory_gc_mark (SYX_OBJECT_VARS(object)[i]);
if (SYX_OBJECT_HAS_REFS (object))
{
for (i=0; i < SYX_OBJECT_DATA_SIZE (object); i++)
_syx_memory_gc_mark (SYX_OBJECT_DATA(object)[i]);
}
}
/*! Create a MethodContext for a binary message ready to enter a Process */
SyxOop
syx_send_binary_message (SyxOop receiver, syx_symbol selector, SyxOop argument)
{
SyxOop context;
SyxOop klass;
SyxOop method;
SyxOop arguments;
klass = syx_object_get_class (receiver);
method = syx_class_lookup_method (klass, selector);
if (SYX_IS_NIL (method))
syx_error ("Unable to lookup method #%s in class %p (%s)\n", selector,
SYX_OOP_CAST_POINTER (klass),
SYX_OBJECT_BYTE_ARRAY (SYX_CLASS_NAME(klass)));
arguments = syx_array_new_size (1);
SYX_OBJECT_DATA(arguments)[0] = argument;
context = syx_method_context_new (method, receiver, arguments);
return context;
}
/*! Print to stdout the current execution state of the interpreter and the Process traceback */
void
syx_show_traceback (void)
{
SyxInterpState *es;
SyxInterpFrame *frame, *homeframe;
syx_symbol traceformat;
SyxOop classname;
syx_symbol extraclass;
SyxOop receiver;
if (!syx_memory)
{
puts ("Can't print the memory state");
return;
}
es = &_syx_interp_state;
frame = es->frame;
puts ("Memory state:");
printf("Memory size: %d\n", _syx_memory_size);
printf("Freed memory top: %d\n", _syx_freed_memory_top);
if (!_syx_memory_gc_trans_running)
puts ("No GC transaction");
else
printf("GC transaction top: %d\n", _syx_memory_gc_trans_top);
if (!es)
{
puts ("Can't print the execution state");
return;
}
puts ("\nExecution state:");
printf("Process: %p (memory index: %ld)\n",
SYX_OOP_CAST_POINTER (syx_processor_active_process),
SYX_MEMORY_INDEX_OF (syx_processor_active_process));
printf("Frame: %p\n", (syx_pointer) frame);
if (!frame)
return;
printf("Receiver: %p (memory index: %ld)\n",
SYX_OOP_CAST_POINTER (frame->receiver),
SYX_MEMORY_INDEX_OF (frame->receiver));
printf("Arguments: %p\n", (syx_pointer) es->arguments);
printf("Temporaries: %p\n", (syx_pointer) es->temporaries);
printf("Stack: %p\n", (syx_pointer) frame->stack);
printf("Literals: %p\n", (syx_pointer) es->method_literals);
printf("Bytecodes: %p (size: %d)\n", (syx_pointer) es->method_bytecodes, es->method_bytecodes_count);
printf("Byteslice: %d\n", es->byteslice);
printf("Instruction pointer: %p\n", (syx_pointer) frame->next_instruction);
printf("Stack pointer: %p\n", (syx_pointer) frame->stack);
printf("Message receiver: %p (memory index: %ld)\n",
SYX_OOP_CAST_POINTER (es->message_receiver),
SYX_MEMORY_INDEX_OF (es->message_receiver));
printf("Message arguments: %p (size: %d)\n",
(syx_pointer) es->message_arguments,
es->message_arguments_count);
if (SYX_IS_NIL (frame->detached_frame))
printf("Process offset: %d\n", SYX_POINTERS_OFFSET (frame, SYX_OBJECT_DATA (SYX_PROCESS_STACK (_syx_interp_state.process))));
puts ("\nTraceback:");
while (frame)
{
if (frame->outer_frame)
{
homeframe = frame->outer_frame;
while (homeframe->outer_frame)
homeframe = homeframe->outer_frame;
traceformat = "%s%s>>%s[]\n";
}
else
{
homeframe = frame;
traceformat = "%s%s>>%s\n";
}
receiver = frame->receiver;
classname = SYX_CLASS_NAME(syx_object_get_class(receiver));
if (SYX_IS_NIL (classname))
{
classname = SYX_CLASS_NAME(SYX_METACLASS_INSTANCE_CLASS(syx_object_get_class(receiver)));
extraclass = " class";
}
else
extraclass = "";
printf (traceformat,
SYX_OBJECT_SYMBOL(classname),
extraclass,
SYX_OBJECT_SYMBOL(SYX_METHOD_SELECTOR(homeframe->method)));
frame = frame->parent_frame;
}
}
syx_bool
syx_cold_parse_methods (SyxLexer *lexer)
{
SyxToken token;
SyxOop klass;
SyxParser *parser;
SyxLexer *method_lexer;
/*syx_symbol category; */
syx_string chunk;
SyxLexer saved_lexer = *lexer;
token = syx_lexer_next_token (lexer);
if (token.type != SYX_TOKEN_NAME_CONST)
{
*lexer = saved_lexer;
return FALSE;
}
klass = syx_globals_at (token.value.string);
syx_token_free (token);
if (SYX_IS_NIL (klass))
return FALSE;
token = syx_lexer_next_token (lexer);
if (token.type == SYX_TOKEN_NAME_CONST && !strcmp (token.value.string, "class"))
{
klass = syx_object_get_class (klass);
syx_token_free (token);
token = syx_lexer_next_token (lexer);
}
if (! (token.type == SYX_TOKEN_NAME_COLON && !strcmp (token.value.string, "methodsFor:")))
{
*lexer = saved_lexer;
return FALSE;
}
syx_token_free (token);
token = syx_lexer_next_token (lexer);
if (token.type != SYX_TOKEN_STR_CONST)
{
*lexer = saved_lexer;
return FALSE;
}
/* category = syx_strdup (token.value.string); */
syx_token_free (token);
token = syx_lexer_next_token (lexer);
if (!_IS_EXL_MARK (token))
{
*lexer = saved_lexer;
return FALSE;
}
syx_token_free (token);
if (SYX_IS_NIL (SYX_CLASS_METHODS (klass)))
{
SYX_CLASS_METHODS(klass) = syx_dictionary_new (50);
}
while (TRUE)
{
chunk = syx_lexer_next_chunk (lexer);
method_lexer = syx_lexer_new (chunk);
if (!method_lexer)
break;
parser = syx_parser_new (method_lexer, syx_method_new (), klass);
syx_parser_parse (parser, FALSE);
syx_dictionary_at_symbol_put (SYX_CLASS_METHODS(klass),
SYX_METHOD_SELECTOR(parser->method),
parser->method);
syx_parser_free (parser, TRUE);
}
return TRUE;
}
static syx_bool
_syx_cold_parse_class (SyxLexer *lexer)
{
SyxToken token = syx_lexer_get_last_token (lexer);
SyxOop superclass, subclass;
syx_string subclass_name;
syx_bool existing_class = TRUE;
SyxOop inst_vars, class_vars;
SyxLexer *inst_vars_lexer, *class_vars_lexer;
syx_varsize super_inst_vars_size;
syx_int32 i;
if (token.type != SYX_TOKEN_NAME_CONST)
{
syx_error ("Expected a name constant\n");
syx_token_free (token);
return FALSE;
}
if (!strcmp (token.value.string, "nil"))
superclass = syx_nil;
else
superclass = syx_globals_at (token.value.string);
token = syx_lexer_next_token (lexer);
if (!(token.type == SYX_TOKEN_NAME_COLON && !strcmp (token.value.string, "subclass:")))
{
syx_token_free (token);
syx_error ("Expected #subclass:\n");
return FALSE;
}
syx_token_free (token);
token = syx_lexer_next_token (lexer);
if (token.type != SYX_TOKEN_SYM_CONST)
{
syx_token_free (token);
syx_error ("Expected a symbol constant\n");
return FALSE;
}
subclass_name = syx_strdup (token.value.string);
syx_token_free (token);
subclass = syx_globals_at_if_absent (subclass_name, syx_nil);
if (strcmp (subclass_name, "Object"))
{
if (SYX_IS_NIL (subclass))
existing_class = FALSE;
else
{
existing_class = TRUE;
if (SYX_OOP_NE (SYX_CLASS_SUPERCLASS(subclass), superclass))
{
syx_array_remove (SYX_CLASS_SUBCLASSES (SYX_CLASS_SUPERCLASS (subclass)),
subclass);
SYX_CLASS_SUPERCLASS(subclass) = superclass;
syx_array_add (SYX_CLASS_SUBCLASSES (superclass), subclass, TRUE);
syx_array_remove (SYX_CLASS_SUBCLASSES (SYX_CLASS_SUPERCLASS(syx_object_get_class (subclass))),
syx_object_get_class (subclass));
SYX_CLASS_SUPERCLASS(syx_object_get_class (subclass)) = syx_object_get_class (superclass);
syx_array_add (SYX_CLASS_SUBCLASSES (syx_object_get_class (superclass)),
syx_object_get_class (subclass), TRUE);
}
}
}
token = syx_lexer_next_token (lexer);
if (token.type != SYX_TOKEN_NAME_COLON)
{
syx_token_free (token);
syx_error ("Expected #instanceVariableNames:\n");
return FALSE;
}
syx_token_free (token);
token = syx_lexer_next_token (lexer);
if (token.type != SYX_TOKEN_STR_CONST)
{
syx_token_free (token);
syx_error ("Expected a string as argument for #instanceVariableNames:\n");
return FALSE;
}
inst_vars_lexer = syx_lexer_new (token.value.string);
token = syx_lexer_next_token (lexer);
if (token.type != SYX_TOKEN_NAME_COLON)
{
syx_token_free (token);
syx_error ("Expected #classVariableNames:\n");
return FALSE;
}
syx_token_free (token);
token = syx_lexer_next_token (lexer);
if (token.type != SYX_TOKEN_STR_CONST)
{
syx_token_free (token);
syx_error ("Expected a string as argument for #classVariableNames:\n");
return FALSE;
}
class_vars_lexer = syx_lexer_new (token.value.string);
token = syx_lexer_next_token (lexer);
if (!_IS_EXL_MARK (token))
{
syx_token_free (token);
syx_error ("Class definition must terminate with an exlamation mark\n");
return FALSE;
}
syx_token_free (token);
if (!existing_class)
{
subclass = syx_class_new (superclass);
SYX_CLASS_NAME(subclass) = syx_symbol_new (subclass_name);
syx_globals_at_put (SYX_CLASS_NAME(subclass), subclass);
}
syx_free (subclass_name);
/* Parse instance variables */
inst_vars = _syx_cold_parse_vars (inst_vars_lexer, FALSE);
syx_lexer_free (inst_vars_lexer, TRUE);
/* Fetch superclass instanceSize */
if (SYX_IS_NIL (superclass))
super_inst_vars_size = 0;
else
super_inst_vars_size = SYX_SMALL_INTEGER (SYX_CLASS_INSTANCE_SIZE (superclass));
SYX_CLASS_INSTANCE_VARIABLES(subclass) = inst_vars;
SYX_CLASS_INSTANCE_SIZE(subclass) = syx_small_integer_new (super_inst_vars_size
+ SYX_OBJECT_DATA_SIZE (inst_vars));
/* Now parse class variables */
class_vars = _syx_cold_parse_vars (class_vars_lexer, TRUE);
syx_lexer_free (class_vars_lexer, TRUE);
SYX_CLASS_CLASS_VARIABLES(subclass) = syx_dictionary_new (SYX_OBJECT_DATA_SIZE (class_vars) + 10);
/* translate from array to dictionary */
for (i=0; i < SYX_OBJECT_DATA_SIZE(class_vars); i++)
syx_dictionary_at_symbol_put (SYX_CLASS_CLASS_VARIABLES(subclass),
SYX_OBJECT_DATA(class_vars)[i], syx_nil);
/* get rid of this */
syx_object_free (class_vars);
return TRUE;
}
