Ejemplo n.º 1
0
/*!
  Swap the current context with the given one.
  The context must be already existing in the process stack.
  
  \return FALSE if the context was syx_nil
*/
syx_bool
syx_interp_swap_context (SyxOop process, SyxOop context)
{
  SyxInterpState _state = SYX_INTERP_STATE_NEW;
  SyxInterpFrame *frame = syx_interp_context_to_frame (context);
  SyxInterpState *state;

  if (!frame)
    return TRUE;

  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;
      _syx_interp_switch_process (state, process);
    }

  _syx_interp_state_update (state, frame);

  return TRUE;
}
Ejemplo n.º 2
0
/*! Creates a MethodContext or BlockContext from a frame

  \param stack the OOP of the whole stack, e.g. SYX_PROCESS_STACK (aProcess). This will not be used
  if the frame has been detached.
  \return a new context */
SyxOop
syx_interp_frame_to_context (SyxOop stack, SyxInterpFrame *frame)
{
  SyxOop context;
  SyxOop arguments;

  if (!frame)
    return syx_nil;

  if (!SYX_IS_NIL (frame->this_context))
    return frame->this_context; 
  
  syx_memory_gc_begin ();
  /* FIXME: they're not accessible for GC troubles.
     Do we need to access them with primitives or do we need to detach the frame when
     created using enter_context? */
  arguments = syx_nil;

  if (!SYX_IS_NIL (frame->closure))
    {
      context = syx_block_context_new (frame->closure, arguments);
      SYX_CONTEXT_PART_STACK (context) = frame->detached_frame;
    }
  else
    {
      context = syx_method_context_new (frame->method, frame->receiver, arguments);
      SYX_CONTEXT_PART_STACK (context) = stack;
    }
  SYX_CONTEXT_PART_FRAME_POINTER (context) = SYX_POINTER_CAST_OOP (frame);
  frame->this_context = context;
  syx_memory_gc_end ();

  return context;
}
Ejemplo n.º 3
0
/* Dump the header of the object with variables */
static void
_syx_memory_write_object_with_vars (SyxObject *object, FILE *image)
{
  syx_int32 data;

  _syx_memory_write ((SyxOop *)&object, FALSE, 1, image);
  _syx_memory_write (&object->klass, FALSE, 1, image);
  fputc (object->has_refs, image);
  fputc (object->is_constant, image);

  data = syx_object_vars_size ((SyxOop)object);
  data = SYX_COMPAT_SWAP_32(data);
  fwrite (&data, sizeof (syx_int32), 1, image);

  /* store instance variables, keep an eye on special cases */
  if ((SYX_OOP_EQ (object->klass, syx_block_context_class) ||
       SYX_OOP_EQ (object->klass, syx_method_context_class))
      && !SYX_IS_NIL (object->vars[SYX_VARS_CONTEXT_PART_STACK]))
    _syx_memory_write_vars_with_fp (object, SYX_VARS_CONTEXT_PART_STACK, SYX_VARS_CONTEXT_PART_FRAME_POINTER, image);
  else if (SYX_OOP_EQ (object->klass, syx_process_class)
           && !SYX_IS_NIL (object->vars[SYX_VARS_PROCESS_STACK]))
    _syx_memory_write_vars_with_fp (object, SYX_VARS_PROCESS_STACK, SYX_VARS_PROCESS_FRAME_POINTER, image);
  else
    _syx_memory_write (object->vars, TRUE, SYX_COMPAT_SWAP_32(data), image);
}
Ejemplo n.º 4
0
/*!
  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;
}
Ejemplo n.º 5
0
static void
_syx_parser_parse_assignment (SyxParser *self, syx_symbol assign_name)
{
  syx_varsize pos;
  SyxOop binding;

  pos = _syx_parser_find_temporary_name (self, assign_name);
  if (pos >= 0)
    {
      _syx_parser_parse_expression (self);
      syx_bytecode_assign_temporary (self->bytecode, pos);
      return;
    }

  pos = _syx_parser_find_instance_name (self, assign_name);
  if (pos >= 0)
    {
      _syx_parser_parse_expression (self);
      syx_bytecode_assign_instance (self->bytecode, pos);
      return;
    }

  binding = _syx_parser_find_class_variable_name (self, assign_name);
  if (!SYX_IS_NIL (binding))
    {
      _syx_parser_parse_expression (self);
      syx_bytecode_assign_binding_variable (self->bytecode, binding);
      return;
    }
  
  syx_signal (SYX_ERROR_INTERP, syx_string_new ("Unassignable variable named: %s\n", assign_name));
}
Ejemplo n.º 6
0
static void
_syx_parser_parse_temporaries (SyxParser *self)
{
  SyxToken token = syx_lexer_get_last_token (self->lexer);
  SyxParserScope *scope = self->_temporary_scopes + self->_temporary_scopes_top;

  if (token.type == SYX_TOKEN_BINARY && !strcmp (token.value.string, "|"))
    {
      syx_token_free (token);
      token = syx_lexer_next_token (self->lexer);
      while (token.type == SYX_TOKEN_NAME_CONST)
        {
          scope->stack[scope->top++] = syx_strdup (token.value.string);
          syx_token_free (token);
          token = syx_lexer_next_token (self->lexer);
        }
      if (! (token.type == SYX_TOKEN_BINARY && !strcmp (token.value.string, "|")))
        syx_signal (SYX_ERROR_INTERP, syx_string_new ("Temporary list not terminated by bar"));
      syx_token_free (token);

      syx_lexer_next_token (self->lexer);
    }
    
  /* we choose the maximum number so we can hold all the temporaries without forgetting
     previous parsed optimized blocks. */
  if (SYX_IS_NIL (SYX_CODE_TEMPORARIES_COUNT (self->method))
      || scope->top > SYX_SMALL_INTEGER (SYX_CODE_TEMPORARIES_COUNT (self->method)))
    SYX_CODE_TEMPORARIES_COUNT(self->method) = syx_small_integer_new (scope->top);
}
Ejemplo n.º 7
0
/* 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);
}
Ejemplo n.º 8
0
/*!
  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;
}
Ejemplo n.º 9
0
/*! Returns the frame associated to the given context */
SyxInterpFrame *
syx_interp_context_to_frame (SyxOop context)
{
  if (SYX_IS_NIL (context))
    return NULL;

  return (SyxInterpFrame *) SYX_OOP_CAST_POINTER (SYX_CONTEXT_PART_FRAME_POINTER (context));
}
Ejemplo n.º 10
0
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;
}
Ejemplo n.º 11
0
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]);
    }
}
Ejemplo n.º 12
0
/*! 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;
}
Ejemplo n.º 13
0
/* 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);
}
Ejemplo n.º 14
0
/* 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);
}
Ejemplo n.º 15
0
static void
_syx_memory_gc_sweep ()
{
  SyxObject *object;

  /* skip constants */
  for (object=syx_memory+3; object <= SYX_MEMORY_TOP; object++)
    {
      if (SYX_IS_NIL (object->klass))
        continue;

      if (object->is_marked)
        object->is_marked = FALSE;
      else
        syx_object_free ((SyxOop) object);
    }
}
Ejemplo n.º 16
0
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]);
    }
}
Ejemplo n.º 17
0
/*! 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;
}
Ejemplo n.º 18
0
/*! Clears all the allocated memory */
void
syx_memory_clear (void)
{
  SyxObject *object = syx_memory;
  SyxOop context, process;

  if (!_syx_memory_initialized)
    return;

  object = syx_memory;

  /* finalize objects */
  for (object=syx_memory; object <= SYX_MEMORY_TOP; object++)
    {
      if (SYX_IS_NIL (object->klass))
        continue;

      if (SYX_IS_TRUE (SYX_CLASS_FINALIZATION (object->klass)))
        {
          process = syx_process_new ();
          context = syx_send_unary_message (SYX_POINTER_CAST_OOP (object), "finalize");
          syx_interp_enter_context (process, context);
          syx_process_execute_blocking (process);
        }
    }

  /* free memory used by objects */
  for (object=syx_memory; object <= SYX_MEMORY_TOP; object++)
    {
      if (object->vars)
        syx_free (object->vars);
      if (object->data)
        syx_free (object->data);
    }

  syx_free (syx_memory);
  syx_free (_syx_freed_memory);
  _syx_memory_initialized = FALSE;
}
Ejemplo n.º 19
0
/*! Same as syx_process_execute_scheduled but does not take care about the byteslice counter,
  and control is not yield until the process is terminated.
*/
void
syx_process_execute_blocking (SyxOop process)
{
  SyxInterpState orig_state;
  SyxOop orig_process;
  syx_uint16 byte;

  SYX_START_PROFILE;

  if (SYX_IS_NIL (process))
    {
      syx_scheduler_remove_process (process);
      return;
    }

  orig_process = syx_processor_active_process;
  orig_state = _syx_interp_state;

  _syx_interp_save_process_state (&_syx_interp_state);
  _syx_interp_switch_process (&_syx_interp_state, process);

  syx_processor_active_process = process;

  while (_syx_interp_state.frame)
    {
      byte = _syx_interp_get_next_byte ();
      _syx_interp_execute_byte (byte);
    }
  _syx_interp_save_process_state (&_syx_interp_state);

  syx_processor_active_process = orig_process;
  _syx_interp_switch_process (&_syx_interp_state, orig_process);

  syx_scheduler_remove_process (process);

  SYX_END_PROFILE(blocking);
}
Ejemplo n.º 20
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;
}
Ejemplo n.º 21
0
/*!
  Dumps all the memory.

  \param path the file path to put all inside
  \return FALSE if an error occurred
*/
syx_bool
syx_memory_save_image (syx_symbol path)
{
  SyxObject *object;
  FILE *image;
  syx_int32 data = 0;
  SyxObject *stack;
  SyxOop process;

  if (!path)
    path = SYX_OBJECT_SYMBOL (syx_globals_at ("ImageFileName"));

  if (!path)
    return FALSE;

  image = fopen (path, "wb");
  if (!image)
    return FALSE;

  syx_memory_gc ();

  data = SYX_COMPAT_SWAP_32 (_syx_memory_size);
  fwrite (&data, sizeof (syx_int32), 1, image);
  data = SYX_COMPAT_SWAP_32 (_syx_freed_memory_top);
  fwrite (&data, sizeof (syx_int32), 1, image);
  _syx_memory_write (_syx_freed_memory, FALSE, _syx_freed_memory_top, image);

  _syx_scheduler_save (image);

  _syx_memory_write (&syx_globals, FALSE, 1, image);
  _syx_memory_write (&syx_symbols, FALSE, 1, image);

  /* First store the processes */
  process = syx_processor_active_process;
  if (!SYX_IS_NIL (process))
    {
      do
        {
          _syx_memory_write_process_stack (SYX_OBJECT (process), image);
          process = SYX_PROCESS_NEXT (process);
        } while (SYX_OOP_NE (process, syx_processor_active_process));
    }

  for (object=syx_memory; object <= SYX_MEMORY_TOP; object++)
    {
      /* the mark check is not related to the GC but means the object has been already written */
      if (SYX_IS_NIL (object->klass) || object->is_marked)
        continue;

      _syx_memory_write_object_with_vars (object, image);

      /* store data */
      data = SYX_COMPAT_SWAP_32 (object->data_size);
      fwrite (&data, sizeof (syx_varsize), 1, image);
      if (object->data_size > 0)
        {
          if (object->has_refs)
            _syx_memory_write (object->data, TRUE, object->data_size, image);
          else
            {
#ifdef HAVE_LIBGMP
              if (SYX_OBJECT_IS_LARGE_INTEGER ((SyxOop)object))
                {
                  /* This algorithm is used to store large integers.
                     We need to specify how many bytes GMP wrote to the image,
                     for systems that don't support GMP */

                  syx_int32 offset = 0;
                  syx_nint start, end;
                  /* specify that's a large integer */
                  fputc (SYX_MEMORY_TYPE_LARGE_INTEGER, image);
                  /* make space to hold the offset */
                  fwrite (&offset, sizeof (syx_int32), 1, image);
                  start = ftell (image);
                  mpz_out_raw (image, SYX_OBJECT_LARGE_INTEGER ((SyxOop)object));
                  end = ftell (image);
                  offset = end - start;
                  /* go back to the offset */
                  fseek (image, - offset - sizeof (syx_int32), SEEK_CUR);
                  /* now write the length of the data written by mpz_out_raw () */
                  data = SYX_COMPAT_SWAP_32 (offset);
                  fwrite (&data, sizeof (syx_int32), 1, image);
                  /* return again to continue normal writing */
                  fseek (image, offset, SEEK_CUR);
                }
              else
#endif /* HAVE_LIBGMP */
                {
                  /* it's not a large integer */
                  fputc (SYX_MEMORY_TYPE_NORMAL, image);
                  fwrite (object->data, sizeof (syx_int8), object->data_size, image);
                }
            }
        }

      /* Check for block closures that are not attached to any process */
      if (SYX_OOP_EQ (object->klass, syx_block_closure_class))
        {
          stack = SYX_OBJECT (object->vars[SYX_VARS_BLOCK_CLOSURE_OUTER_FRAME]);
          /* Check if the stack has been collected or written to the image */
          if (SYX_IS_NIL (SYX_POINTER_CAST_OOP (stack)) || stack->is_marked)
            continue;

          _syx_memory_write_object_with_vars (stack, image);

          data = SYX_COMPAT_SWAP_32 (stack->data_size);
          fwrite (&data, sizeof (syx_varsize), 1, image);
          /* Store the index of this frame */
          fputc (SYX_MEMORY_TYPE_BOF, image);
          data = SYX_COMPAT_SWAP_32 (0);
          fwrite (&data, sizeof (syx_varsize), 1, image);
          /* Outer frames have only one frame */
          _syx_memory_write_frame (NULL, (SyxInterpFrame *)stack->data, NULL, image);
          fputc (SYX_MEMORY_TYPE_EOS, image);
          fwrite (&data, sizeof (syx_varsize), 1, image);
          
          stack->is_marked = TRUE;
        }
    }

  fclose (image);

  /* be sure all objects are unmarked */
  for (object=syx_memory; object <= SYX_MEMORY_TOP; object++)
    object->is_marked = FALSE;

  return TRUE;
}
Ejemplo n.º 22
0
/* Dump the whole stack of the process.
   This will also dump relative objects containing stack, like block closure outerFrames. */
static void
_syx_memory_write_process_stack (SyxObject *process, FILE *image)
{
  syx_int32 data;
  SyxObject *stack = SYX_OBJECT (process->vars[SYX_VARS_PROCESS_STACK]);
  SyxInterpFrame *bottom_frame = (SyxInterpFrame *)stack->data;
  SyxInterpFrame *frame = SYX_OOP_CAST_POINTER (process->vars[SYX_VARS_PROCESS_FRAME_POINTER]);
  SyxInterpFrame *upper_frame = NULL;
  SyxOop *oop;

  if (SYX_IS_NIL (SYX_POINTER_CAST_OOP (stack)))
    return;

  _syx_memory_write_object_with_vars (stack, image);

  /* store data size */
  data = SYX_COMPAT_SWAP_32 (stack->data_size);
  fwrite (&data, sizeof (syx_varsize), 1, image);
  /* We have to do things in reverse order because the stack is such a reverse single linked list,
     each frame connected by parent frames */
  while (frame)
    {
      /* We store detached frames later */
      if (!SYX_IS_NIL (frame->detached_frame))
        {
          frame = frame->parent_frame;
          continue;
        }

      /* Store the index of this frame */
      fputc (SYX_MEMORY_TYPE_BOF, image);
      data = SYX_COMPAT_SWAP_32 (SYX_POINTERS_OFFSET (frame, bottom_frame));
      fwrite (&data, sizeof (syx_varsize), 1, image);
      _syx_memory_write_frame (process, frame, NULL, image);
      upper_frame = frame;
      frame = frame->parent_frame;
    }
  fputc (SYX_MEMORY_TYPE_EOS, image);
  /* We have to store the rest of objects, for detached frames, up to the upper frame.
     What we need is only the local stacks, but we don't know where they begin, so just skip C pointers */
  if (upper_frame)
    {
      data = SYX_COMPAT_SWAP_32 (SYX_POINTERS_OFFSET (upper_frame, bottom_frame));
      fwrite (&data, sizeof (syx_int32), 1, image);
      for (oop = (SyxOop *)bottom_frame; oop != (SyxOop *)upper_frame; oop++)
        {
          if (SYX_IS_CPOINTER (*oop))
            _syx_memory_write (&syx_nil, TRUE, 1, image);
          else
            _syx_memory_write (oop, TRUE, 1, image);
        }
    }
  else
    {
      data = SYX_COMPAT_SWAP_32 (0);
      fwrite (&data, sizeof (syx_int32), 1, image);
    }
  stack->is_marked = TRUE;

  /* Let's store all detached frames until they have a reference to this process */
  frame = SYX_OOP_CAST_POINTER (process->vars[SYX_VARS_PROCESS_FRAME_POINTER]);
  while (frame)
    {
      stack = SYX_OBJECT (frame->detached_frame);
      /* Also check if the stack has been collected */
      if (SYX_IS_NIL (SYX_POINTER_CAST_OOP (stack)) || stack->is_marked)
        {
          frame = frame->parent_frame;
          continue;
        }

      _syx_memory_write_object_with_vars (stack, image);

      data = SYX_COMPAT_SWAP_32 (stack->data_size);
      fwrite (&data, sizeof (syx_varsize), 1, image);    
      /* Store the index of this frame */
      fputc (SYX_MEMORY_TYPE_BOF, image);
      data = SYX_COMPAT_SWAP_32 (0);
      fwrite (&data, sizeof (syx_varsize), 1, image);
      _syx_memory_write_frame (process, frame, NULL, image);
      fputc (SYX_MEMORY_TYPE_EOS, image);
      fwrite (&data, sizeof (syx_varsize), 1, image);

      stack->is_marked = TRUE;
      frame = frame->parent_frame;
    }
}
Ejemplo n.º 23
0
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;
}
Ejemplo n.º 24
0
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;
}
Ejemplo n.º 25
0
/*! 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;
    }
}
Ejemplo n.º 26
0
static syx_bool
_syx_parser_parse_name_term (SyxParser *self, syx_symbol name)
{
  syx_varsize pos;
  SyxOop binding;

  if (!strcmp (name, "self") || !strcmp (name, "super"))
    {
      syx_bytecode_push_argument (self->bytecode, 0);
      if (!strcmp (name, "super"))
        return TRUE;
      return FALSE;
    }

  if (!strcmp (name, "nil"))
    {
      syx_bytecode_push_constant (self->bytecode, SYX_BYTECODE_CONST_NIL);
      return FALSE;
    }
  else if (!strcmp (name, "true"))
    {
      syx_bytecode_push_constant (self->bytecode, SYX_BYTECODE_CONST_TRUE);
      return FALSE;
    }
  else if (!strcmp (name, "false"))
    {
      syx_bytecode_push_constant (self->bytecode, SYX_BYTECODE_CONST_FALSE);
      return FALSE;
    }
  else if (!strcmp (name, "thisContext"))
    {
      syx_bytecode_push_constant (self->bytecode, SYX_BYTECODE_CONST_CONTEXT);
      return FALSE;
    }

  pos = _syx_parser_find_argument_name (self, name);
  if (pos >= 0)
    {
      syx_bytecode_push_argument (self->bytecode, pos + 1);
      return FALSE;    
    }

  pos = _syx_parser_find_temporary_name (self, name);
  if (pos >= 0)
    {
      syx_bytecode_push_temporary (self->bytecode, pos);
      return FALSE;
    }

  pos = _syx_parser_find_instance_name (self, name);
  if (pos >= 0)
    {
      syx_bytecode_push_instance (self->bytecode, pos);
      return FALSE;
    }

  binding = _syx_parser_find_class_variable_name (self, name);
  if (!SYX_IS_NIL (binding))
    syx_bytecode_push_binding_variable (self->bytecode, binding);
  else
    syx_bytecode_push_binding_variable (self->bytecode,
                                        syx_dictionary_binding_at_symbol (syx_globals, name));

  return FALSE;
}
Ejemplo n.º 27
0
/*!
  Dumps all the memory.

  \param path the file path to put all inside
  \return FALSE if an error occurred
*/
syx_bool
syx_memory_save_image (syx_symbol path)
{
  SyxObject *object;
  FILE *image;
  syx_int32 data;

  if (!path)
    path = SYX_OBJECT_SYMBOL (syx_globals_at ("ImageFileName"));

  if (!path)
    return FALSE;

  image = fopen (path, "wb");
  if (!image)
    return FALSE;

  syx_memory_gc ();

  data = SYX_COMPAT_SWAP_32 (_syx_memory_size);
  fwrite (&data, sizeof (syx_int32), 1, image);
  data = SYX_COMPAT_SWAP_32 (_syx_freed_memory_top);
  fwrite (&data, sizeof (syx_int32), 1, image);
  _syx_memory_write (_syx_freed_memory, FALSE, _syx_freed_memory_top, image);

  _syx_scheduler_save (image);

  _syx_memory_write (&syx_globals, FALSE, 1, image);
  _syx_memory_write (&syx_symbols, FALSE, 1, image);

  for (object=syx_memory; object <= SYX_MEMORY_TOP; object++)
    {
      if (SYX_IS_NIL (object->klass))
        continue;

      _syx_memory_write ((SyxOop *)&object, FALSE, 1, image);
      _syx_memory_write (&object->klass, FALSE, 1, image);
      fputc (object->has_refs, image);
      fputc (object->is_constant, image);

      /* store instance variables */
      data = syx_object_vars_size ((SyxOop)object);
      data = SYX_COMPAT_SWAP_32(data);
      fwrite (&data, sizeof (syx_varsize), 1, image);
      _syx_memory_write (object->vars, TRUE, SYX_COMPAT_SWAP_32(data), image);

      /* store data */
      data = SYX_COMPAT_SWAP_32 (object->data_size);
      fwrite (&data, sizeof (syx_varsize), 1, image);
      if (object->data_size > 0)
        {
          if (object->has_refs)
            _syx_memory_write (object->data, TRUE, object->data_size, image);
          else
            {
#ifdef HAVE_LIBGMP
              if (SYX_OBJECT_IS_LARGE_INTEGER ((SyxOop)object))
                {
                  /* This algorithm is used to store large integers.
                     We need to specify how many bytes GMP wrote to the image,
                     for systems that doesn't support GMP */

                  syx_int32 offset = 0;
                  syx_nint start, end;
                  /* specify that's a large integer */
                  fputc (1, image);
                  /* make space to hold the offset */
                  fwrite (&offset, sizeof (syx_int32), 1, image);
                  start = ftell (image);
                  mpz_out_raw (image, SYX_OBJECT_LARGE_INTEGER ((SyxOop)object));
                  end = ftell (image);
                  offset = end - start;
                  /* go back to the offset */
                  fseek (image, - offset - sizeof (syx_int32), SEEK_CUR);
                  data = SYX_COMPAT_SWAP_32 (offset);
                  fwrite (&data, sizeof (syx_int32), 1, image);
                  /* return again to continue normal writing */
                  fseek (image, offset, SEEK_CUR);
                }
              else
#endif
                {
                  /* it's not a large integer */
                  fputc (0, image);
                  fwrite (object->data, sizeof (syx_int8), object->data_size, image);
                }
            }
        }
    }

  fclose (image);

  return TRUE;
}