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]);
}
}
/* Fetches and updates the execution state of the interpreter to be ready for next instructions */
static void
_syx_interp_state_update (SyxInterpState *state, SyxInterpFrame *frame)
{
SyxOop bytecodes;
SyxOop method = frame->method;;
state->frame = frame;
bytecodes = SYX_CODE_BYTECODES (method);
state->arguments = &frame->local;
state->temporaries = state->arguments + SYX_SMALL_INTEGER (SYX_CODE_ARGUMENTS_COUNT (method));
state->method_literals = SYX_OBJECT_DATA (SYX_CODE_LITERALS (method));
state->method_bytecodes = (syx_uint16 *)SYX_OBJECT_DATA (bytecodes);
state->method_bytecodes_count = SYX_OBJECT_DATA_SIZE (bytecodes);
}
/* Write the variables of a Process or of a Context, fixing the frame pointer to match a valid index
in the stack */
static void
_syx_memory_write_vars_with_fp (SyxObject *object, SyxVariables stack_var, SyxVariables fp_var, FILE *image)
{
SyxInterpFrame *frame = SYX_OOP_CAST_POINTER (object->vars[fp_var]);
SyxOop stack;
syx_int32 offset;
if (!SYX_IS_NIL (frame->detached_frame))
{
stack = frame->detached_frame;
offset = 0;
}
else
{
stack = object->vars[stack_var];
offset = SYX_COMPAT_SWAP_32 (SYX_POINTERS_OFFSET (frame, SYX_OBJECT_DATA (stack)));
}
/* Write all variables before FRAME_POINTER */
_syx_memory_write (object->vars, TRUE, fp_var, image);
/* Now specify our own type for frame pointers */
fputc (SYX_MEMORY_TYPE_FRAME_POINTER, image);
/* We have to store the stack OOP in order to point to the right stack when loading back the image */
_syx_memory_write (&stack, FALSE, 1, image);
fwrite (&offset, sizeof (syx_int32), 1, image);
/* Let's store the remaining variables */
_syx_memory_write (object->vars + fp_var + 1, TRUE,
syx_object_vars_size ((SyxOop)object) - fp_var - 1, image);
}
/*!
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;
}
/*! Both create a new frame and prepare for calling a block closure.
This function shouldn't be called by any applications.
It's not static because it's called form within syx primitives. */
void
_syx_interp_frame_prepare_new_closure (SyxInterpState *state, SyxOop closure)
{
SyxInterpFrame *frame;
_syx_interp_frame_prepare_new (state, SYX_BLOCK_CLOSURE_BLOCK (closure));
frame = state->frame;
frame->outer_frame = (SyxInterpFrame *)SYX_OBJECT_DATA (SYX_BLOCK_CLOSURE_OUTER_FRAME (closure));
frame->receiver = frame->outer_frame->receiver;
frame->closure = closure;
/* We can't return more if there's no parent frame. See BlockClosure_newProcess primitive for instance. */
if (frame->parent_frame)
frame->stack_return_frame = frame->outer_frame->stack_return_frame;
}
/* Dump a single frame */
static void
_syx_memory_write_frame (SyxObject *process, SyxInterpFrame *frame, SyxInterpFrame *upper_frame, FILE *image)
{
syx_int32 data;
SyxInterpFrame *bottom_frame;
if (!process)
bottom_frame = NULL;
else
bottom_frame = (SyxInterpFrame *)SYX_OBJECT_DATA (process->vars[SYX_VARS_PROCESS_STACK]);
_syx_memory_write (&frame->this_context, FALSE, 1, image);
_syx_memory_write (&frame->detached_frame, FALSE, 1, image);
_syx_memory_write_lazy_pointer (process, frame->parent_frame, image);
_syx_memory_write_lazy_pointer (process, frame->outer_frame, image);
_syx_memory_write_lazy_pointer (process, frame->stack_return_frame, image);
_syx_memory_write (&frame->method, FALSE, 1, image);
_syx_memory_write (&frame->closure, FALSE, 1, image);
/* this is not a SmallInteger */
data = SYX_COMPAT_SWAP_32 (frame->next_instruction);
fwrite (&data, sizeof (syx_int32), 1, image);
/* the stack pointer should point inside the process stack itself */
if (process)
_syx_memory_write (&process->vars[SYX_VARS_PROCESS_STACK], FALSE, 1, image);
else
{
data = SYX_COMPAT_SWAP_32 (0);
fwrite (&data, sizeof (syx_int32), 1, image);
}
data = SYX_COMPAT_SWAP_32 (SYX_POINTERS_OFFSET (frame->stack, bottom_frame));
fwrite (&data, sizeof (syx_int32), 1, image);
_syx_memory_write (&frame->receiver, TRUE, 1, image);
/* Store arguments, temporaries and local stack.
Only copy arguments and temporaries for detached frames without following the stack pointer */
if (SYX_IS_NIL (frame->detached_frame))
{
/* if no upper_frame is given, this frame is the top most frame of the process stack */
if (!upper_frame)
data = SYX_POINTERS_OFFSET (frame->stack, &frame->local);
else
data = SYX_POINTERS_OFFSET (upper_frame, &frame->local);
}
else
data = SYX_OBJECT_DATA_SIZE (frame->detached_frame) - SYX_POINTERS_OFFSET (&frame->local, frame);
data = SYX_COMPAT_SWAP_32 (data);
fwrite (&data, sizeof (syx_int32), 1, image);
_syx_memory_write (&frame->local, TRUE, SYX_COMPAT_SWAP_32 (data), image);
}
/* Writes a single entry of the frame that points to another frame */
static void
_syx_memory_write_lazy_pointer (SyxObject *process, SyxInterpFrame *frame, FILE *image)
{
SyxOop stack;
syx_int32 offset;
if (frame && !SYX_IS_NIL (frame->detached_frame))
stack = frame->detached_frame;
else if (!process || !frame)
stack = syx_nil; /* this will be encoded as 0 */
else
stack = process->vars[SYX_VARS_PROCESS_STACK];
_syx_memory_write (&stack, FALSE, 1, image);
offset = SYX_COMPAT_SWAP_32 (SYX_POINTERS_OFFSET (frame, SYX_OBJECT_DATA (stack)));
fwrite (&offset, sizeof (syx_int32), 1, image);
}
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;
}
static SyxOop
_syx_cold_parse_vars (SyxLexer *lexer, syx_bool capitalized)
{
SyxOop vars;
SyxOop vars_raw[256];
syx_varsize vars_size;
SyxToken token;
/* Fetch variable names using the lexer */
token = syx_lexer_next_token (lexer);
for (vars_size=0; token.type != SYX_TOKEN_END; vars_size++)
{
if (token.type != SYX_TOKEN_NAME_CONST)
{
syx_token_free (token);
syx_error ("Expected names for variables\n");
}
if (capitalized && !isupper (token.value.string[0]))
{
syx_token_free (token);
syx_error ("First letter must be uppercase\n");
}
vars_raw[vars_size] = syx_symbol_new (token.value.string);
syx_token_free (token);
token = syx_lexer_next_token (lexer);
}
/* Create the array */
vars = syx_array_new_size (vars_size);
/* Copy out of the stack */
memcpy (SYX_OBJECT_DATA (vars), vars_raw, sizeof (SyxOop ) * vars_size);
return vars;
}
int SYX_CDECL
main (int argc, char *argv[])
{
SyxOop process, context;
SyxOop arguments;
SyxOop structTestClass;
SyxOop structTest;
syx_init (0, NULL, "..");
syx_memory_load_image ("test.sim");
syx_scheduler_init ();
puts ("- Initializing test classes");
syx_cold_file_in ("stsupport/TestCStruct.st");
structTestClass = syx_globals_at ("TestCStruct");
syx_object_initialize (structTestClass);
structTest = syx_object_new (structTestClass);
puts ("- Test fields alignment 1");
arguments = syx_array_new_size (6);
SYX_OBJECT_DATA(arguments)[0] = syx_small_integer_new ((syx_nint)&test1.f1 - (syx_nint)&test1);
SYX_OBJECT_DATA(arguments)[1] = syx_small_integer_new ((syx_nint)&test1.f2 - (syx_nint)&test1);
SYX_OBJECT_DATA(arguments)[2] = syx_small_integer_new ((syx_nint)&test1.f3 - (syx_nint)&test1);
SYX_OBJECT_DATA(arguments)[3] = syx_small_integer_new ((syx_nint)&test1.f4 - (syx_nint)&test1);
SYX_OBJECT_DATA(arguments)[4] = syx_small_integer_new ((syx_nint)&test1.f5 - (syx_nint)&test1);
SYX_OBJECT_DATA(arguments)[5] = syx_small_integer_new ((syx_nint)&test1.f6 - (syx_nint)&test1);
process = syx_process_new ();
context = syx_send_message (structTest,
"testOffsets:from:",
2, arguments, syx_symbol_new ("Test1Struct"));
syx_interp_enter_context (process, context);
syx_process_execute_blocking (process);
puts ("- Test fields alignment 2");
arguments = syx_array_new_size (14);
SYX_OBJECT_DATA(arguments)[0] = syx_small_integer_new ((syx_nint)&test2.f1 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[1] = syx_small_integer_new ((syx_nint)&test2.f2 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[2] = syx_small_integer_new ((syx_nint)&test2.f3 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[3] = syx_small_integer_new ((syx_nint)&test2.f4 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[4] = syx_small_integer_new ((syx_nint)&test2.f5 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[5] = syx_small_integer_new ((syx_nint)&test2.f6 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[6] = syx_small_integer_new ((syx_nint)&test2.f7 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[7] = syx_small_integer_new ((syx_nint)&test2.f8 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[8] = syx_small_integer_new ((syx_nint)&test2.f9 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[9] = syx_small_integer_new ((syx_nint)&test2.f10 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[10] = syx_small_integer_new ((syx_nint)&test2.f11 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[11] = syx_small_integer_new ((syx_nint)&test2.f12 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[12] = syx_small_integer_new ((syx_nint)&test2.f13 - (syx_nint)&test2);
SYX_OBJECT_DATA(arguments)[13] = syx_small_integer_new ((syx_nint)&test2.f14 - (syx_nint)&test2);
process = syx_process_new ();
context = syx_send_message (structTest,
"testOffsets:from:",
2, arguments, syx_symbol_new ("Test2Struct"));
syx_interp_enter_context (process, context);
syx_process_execute_blocking (process);
puts ("- Test fields alignment 3");
arguments = syx_array_new_size (6);
SYX_OBJECT_DATA(arguments)[0] = syx_small_integer_new ((syx_nint)&test3.f1 - (syx_nint)&test3);
SYX_OBJECT_DATA(arguments)[1] = syx_small_integer_new ((syx_nint)&test3.f2 - (syx_nint)&test3);
SYX_OBJECT_DATA(arguments)[2] = syx_small_integer_new ((syx_nint)&test3.f3 - (syx_nint)&test3);
SYX_OBJECT_DATA(arguments)[3] = syx_small_integer_new ((syx_nint)&test3.f4 - (syx_nint)&test3);
SYX_OBJECT_DATA(arguments)[4] = syx_small_integer_new ((syx_nint)&test3.f5 - (syx_nint)&test3);
SYX_OBJECT_DATA(arguments)[5] = syx_small_integer_new ((syx_nint)&test3.f6 - (syx_nint)&test3);
process = syx_process_new ();
context = syx_send_message (structTest,
"testOffsets:from:",
2, arguments, syx_symbol_new ("Test3Struct"));
syx_interp_enter_context (process, context);
syx_process_execute_blocking (process);
puts ("- Test reading");
test3.f1 = 240;
test3.f2 = 7143;
test3.f3 = 'R';
test3.f4 = 199.11822;
test3.f5 = 23.5; /* won't read yet */
process = syx_process_new ();
context = syx_send_binary_message (structTest,
"testRead:",
SYX_POINTER_CAST_OOP (&test3));
syx_interp_enter_context (process, context);
syx_process_execute_blocking (process);
puts ("- Test writing");
process = syx_process_new ();
context = syx_send_binary_message (structTest,
"testWrite:",
SYX_POINTER_CAST_OOP (&test3));
syx_interp_enter_context (process, context);
syx_process_execute_blocking (process);
assert(test3.f1 == 320);
assert(test3.f2 == 10293);
assert(test3.f3 == ',');
assert(test3.f4 == 291.4837);
/* Double to float conversion
assert(test3.f5 == 76.119);
*/
/* won't write longs yet */
puts ("- Test unions");
test4.f1 = 'S';
process = syx_process_new ();
context = syx_send_binary_message (structTest,
"testUnion:",
SYX_POINTER_CAST_OOP (&test4));
syx_interp_enter_context (process, context);
syx_process_execute_blocking (process);
assert(test4.f1 == 'T');
syx_quit ();
return 0;
}
/*!
Loads the memory.
\param path the file containing the data dumped by syx_memory_save_image
\return FALSE if an error occurred
*/
syx_bool
syx_memory_load_image (syx_symbol path)
{
SyxObject *object;
FILE *image;
syx_int32 data;
syx_int32 i;
SyxMemoryLazyPointer *lazy;
SYX_START_PROFILE;
if (!path)
{
if (SYX_IS_NIL (syx_globals))
path = syx_get_image_path ();
else
path = SYX_OBJECT_SYMBOL (syx_globals_at ("ImageFileName"));
}
if (!path)
return FALSE;
image = fopen (path, "rb");
if (!image)
return FALSE;
fread (&data, sizeof (syx_int32), 1, image);
data = SYX_COMPAT_SWAP_32 (data);
syx_memory_init (data);
fread (&data, sizeof (syx_int32), 1, image);
_syx_freed_memory_top = SYX_COMPAT_SWAP_32 (data);
_syx_memory_read (_syx_freed_memory, FALSE, _syx_freed_memory_top, image);
_syx_scheduler_load (image);
_syx_memory_read (&syx_globals, FALSE, 1, image);
_syx_memory_read (&syx_symbols, FALSE, 1, image);
while (!feof (image))
{
if (!_syx_memory_read ((SyxOop *)&object, FALSE, 1, image))
break;
_syx_memory_read (&object->klass, FALSE, 1, image);
object->has_refs = fgetc (image);
object->is_constant = fgetc (image);
/* fetch instance variables */
fread (&data, sizeof (syx_varsize), 1, image);
data = SYX_COMPAT_SWAP_32 (data);
if (object->vars)
syx_free (object->vars);
object->vars = (SyxOop *) syx_calloc (data, sizeof (SyxOop));
_syx_memory_read (object->vars, TRUE, data, image);
/* fetch data */
fread (&data, sizeof (syx_varsize), 1, image);
object->data_size = SYX_COMPAT_SWAP_32 (data);
if (object->data_size > 0)
{
if (object->data && object->data_size > 0)
syx_free (object->data);
if (object->has_refs)
{
object->data = (SyxOop *) syx_calloc (object->data_size, sizeof (SyxOop));
_syx_memory_read (object->data, TRUE, object->data_size, image);
}
else
{
object->data = (SyxOop *) syx_calloc (object->data_size, sizeof (syx_int8));
if (fgetc (image) == SYX_MEMORY_TYPE_LARGE_INTEGER)
{
fread (&data, sizeof (syx_int32), 1, image);
data = SYX_COMPAT_SWAP_32 (data);
#ifdef HAVE_LIBGMP
mpz_init (SYX_OBJECT_LARGE_INTEGER ((SyxOop)object));
mpz_inp_raw (SYX_OBJECT_LARGE_INTEGER ((SyxOop)object), image);
#else
/* skip GMP data since we can't handle it */
fseek (image, data, SEEK_CUR);
#endif
}
else
fread (object->data, sizeof (syx_int8), object->data_size, image);
}
}
}
fclose (image);
/* Fix lazy pointers */
for (i=0; i < _syx_memory_lazy_pointers_top; i++)
{
lazy = &_syx_memory_lazy_pointers[i];
if (lazy->stack != 0)
*lazy->entry = SYX_POINTER_CAST_OOP (SYX_OBJECT_DATA (lazy->stack) + lazy->offset);
else
*lazy->entry = SYX_POINTER_CAST_OOP (NULL);
}
syx_free (_syx_memory_lazy_pointers);
_syx_memory_lazy_pointers_top = 0;
syx_fetch_basic ();
SYX_END_PROFILE(load_image);
syx_initialize_system ();
return TRUE;
}
/*! 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;
}
}
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;
}
