

/* Pocket Smalltalk
   Copyright (c) 1998,1999 by Andrew Brault
   http://www.pocketsmalltalk.com
   See LICENSE.TXT for license information */

/* Primitive table and some common primitive methods. */


#include "main.h"
#include <charattr.h>


static Object p_unused(void);

static Object p_basic_error(Object message);
static Object p_clean_exit(void);
static Object p_running_on_device(void);
static Object p_basic_size(void);
static Object p_basic_at(Object index);
static Object p_basic_at_put(Object index, Object value);
static Object p_block_value0(void);
static Object p_block_value1(Object arg1);
static Object p_block_value2(Object arg1, Object arg2);
static Object p_block_value_with_arguments(Object array);
static Object p_basic_new(void);
static Object p_basic_new_indexed(Object size);
static Object p_collect_garbage(void);
static Object p_perform0(Object selector);
static Object p_perform1(Object selector, Object arg1);
static Object p_perform2(Object selector, Object arg1, Object arg2);
static Object p_perform3(Object selector, Object arg1, Object arg2, Object arg3);
static Object p_perform_with_arguments(Object selector, Object array);
static Object p_shallow_copy(void);
static Object p_basic_hash(void);
static Object p_become(Object other);
static Object p_class(void);
static Object p_is_kind_of(Object test_class);
static Object p_inst_var_at(Object index_val);
static Object p_inst_var_at_put(Object index_val, Object new_val);
static Object p_character_value(void);
static Object p_make_character(void);
static Object p_byte_concatenate(Object arg);
static Object p_free_memory(void);

static Object p_text_of_selector(Object selector);
static Object p_name_of_class(Object cls);
static Object p_context_slots(Object context);
static Object p_context_receiver(Object context);
static Object p_context_selector(Object context);
static Object p_context_class(Object context);
static Object p_context_slot_at(Object slot, Object context);

static Object p_compare_bytes(Object other);
static Object p_test_char_bit(Object bit);
static Object p_pointer_byte_access(Object index);
static Object p_pointer_byte_set(Object index, Object value);
static Object p_pointer_word_access(Object index);
static Object p_pointer_word_set(Object index, Object value);
static Object p_pointer_dword_access(Object index);
static Object p_pointer_dword_set(Object index, Object value);
static Object p_offset_pointer(Object offset);
static Object p_basic_change_class(Object new_class);
static Object p_string_hash(void);
static Object p_pointer_is_null(void);
static Object p_behavior_implements(Object selector);



const Primitive primitive_table[PRIMITIVE_COUNT] = {
  { 0, p_unused },             /* 0 */
  { 1, p_basic_error },        /* 1 */
  { 0, p_clean_exit },         /* 2 */
  { 0, p_running_on_device },  /* 3 */
  { 0, p_basic_size },         /* 4 */
  { 1, p_basic_at },           /* 5 */
  { 2, p_basic_at_put },       /* 6 */
  { 0, p_block_value0 },       /* 7 */
  { 1, p_block_value1 },       /* 8 */
  { 2, p_block_value2 },       /* 9 */
  { 0, p_basic_new },          /* 10 */
  { 1, p_basic_new_indexed },  /* 11 */
  { 0, p_collect_garbage },    /* 12 */
  { 1, p_perform0 },           /* 13 */
  { 2, p_perform1 },           /* 14 */
  { 3, p_perform2 },           /* 15 */
  { 4, p_perform3 },           /* 16 */
  { 2, p_perform_with_arguments }, /* 17 */
  { 0, p_shallow_copy },       /* 18 */
  { 0, p_basic_hash },         /* 19 */
  { 1, p_become },             /* 20 */
  { 0, p_class },              /* 21 */
  { 1, p_is_kind_of },         /* 22 */
  { 1, p_inst_var_at },        /* 23 */
  { 2, p_inst_var_at_put },    /* 24 */
  { 0, p_character_value },    /* 25 */
  { 0, p_make_character },     /* 26 */
  { 1, p_byte_concatenate },   /* 27 */
  { 0, p_free_memory },        /* 28 */
  { 0, p_unused },             /* 29 */
  { 0, p_unused },             /* 30 */
  { 0, p_unused },             /* 31 */
  { 1, p_text_of_selector },   /* 32 */
  { 1, p_name_of_class },      /* 33 */
  { 1, p_context_slots },      /* 34 */
  { 1, p_context_receiver },   /* 35 */
  { 1, p_context_selector },   /* 36 */
  { 1, p_context_class },      /* 37 */
  { 2, p_context_slot_at },    /* 38 */
  { 0, p_unused },             /* 39 */
  { 1, p_compare_bytes },    /* 40 */
  { 1, p_test_char_bit },      /* 41 */
  { 1, p_pointer_byte_access },     /* 42 */
  { 2, p_pointer_byte_set },        /* 43 */
  { 1, p_pointer_word_access },     /* 44 */
  { 2, p_pointer_word_set },        /* 45 */
  { 1, p_pointer_dword_access },    /* 46 */
  { 2, p_pointer_dword_set },       /* 47 */
  { 1, p_offset_pointer },      /* 48 */
  { 1, p_basic_change_class },      /* 49 */
  { 0, p_string_hash },              /* 50 */
  { 1, p_block_value_with_arguments }, /* 51 */
  { 0, p_pointer_is_null },           /* 52 */
  { 1, p_behavior_implements },        /* 53 */
  { 0, p_unused },                   /* 54 */
  { 0, p_unused },                   /* 55 */
  { 0, p_unused },                   /* 56 */
  { 0, p_unused },                   /* 57 */
  { 0, p_unused },                   /* 58 */
  { 0, p_unused },                   /* 59 */
  { 1, p_array_expanded },           /* 60 */
  { 1, p_byte_array_expanded },      /* 61 */
  { 1, p_strstream_nextput },        /* 62 */
  { 1, p_strstream_nextputall },     /* 63 */
  { 2, p_array_copyfrom_to },        /* 64 */
  { 2, p_bytearray_copyfrom_to },    /* 65 */
  { 0, p_unused },                   /* 66 */
  { 0, p_unused },                   /* 67 */
  { 0, p_unused },                   /* 68 */
  { 0, p_unused },                   /* 69 */
  { 1, p_integer_add },              /* 70 */
  { 1, p_integer_subtract },	     /* 71 */
  { 1, p_integer_multiply },	     /* 72 */
  { 1, p_integer_bitand },	     /* 73 */
  { 1, p_integer_bitor },	     /* 74 */
  { 1, p_integer_bitxor },	     /* 75 */
  { 1, p_integer_truncate_div },     /* 76 */
  { 1, p_integer_quo_div },	     /* 77 */
  { 1, p_integer_gcd },		     /* 78 */
  { 1, p_integer_less },	     /* 79 */
  { 1, p_integer_lesseq },	     /* 80 */
  { 1, p_integer_greater },	     /* 81 */
  { 1, p_integer_greatereq },	     /* 82 */
  { 1, p_integer_equal },	     /* 83 */
  { 1, p_integer_notequal },	     /* 84 */
  { 1, p_integer_rem },		     /* 85 */
  { 1, p_integer_mod },		     /* 86 */
  { 1, p_integer_bitshift },	     /* 87 */
  { 0, p_integer_print_string },     /* 88 */
  { 0, p_unused },                   /* 89 */
#ifdef USE_MATHLIB
  { 0, p_double_print_string },	     /* 90 */
  { 0, p_double_as_integer },	     /* 91 */
  { 0, p_integer_as_double },	     /* 92 */
  { 1, p_double_add },		     /* 93 */
  { 1, p_double_subtract },	     /* 94 */
  { 1, p_double_multiply },	     /* 95 */
  { 1, p_double_divide },	     /* 96 */
  { 1, p_double_less },		     /* 97 */
  { 1, p_double_unary_function },    /* 98 */
  { 1, p_double_remainder },         /* 99 */
#else /* USE_MATHLIB */
  { 0, p_unused },                   /* 90 */
  { 0, p_unused },		     /* 91 */
  { 0, p_unused },		     /* 92 */
  { 0, p_unused },		     /* 93 */
  { 0, p_unused },		     /* 94 */
  { 0, p_unused },		     /* 95 */
  { 0, p_unused },		     /* 96 */
  { 0, p_unused },		     /* 97 */
  { 0, p_unused },		     /* 98 */
  { 0, p_unused },       	     /* 99 */
#endif
  { 3, p_set_list_choices }          /* 100 */
};

int fail_code;




void * decode_pointer(Object c_pointer)
{
  void * ptr;

  MEMCOPY(&ptr, OBJECT_BYTES(c_pointer), 4);
  return ptr;
}


Object encode_pointer(void * ptr)
{
  Object cpointer;

  cpointer = instantiate_byte_indexed(CPointer, 4);
  MEMCOPY(OBJECT_BYTES(cpointer), &ptr, 4);
  return cpointer;
}


static Object p_unused(void)
{
  panic("unused primitive");
  return receiver;
}


static Object p_basic_error(Object message)
{
  char buf[100];
  int len;

  if(CLASS_OF(message) != String)
    panic("basic error not a string");
  len = OBJECT_BYTE_SIZE(message);
  if(len > sizeof(buf)-1)
    len = sizeof(buf)-1;
  MEMCOPY(buf, OBJECT_BYTES(message), len);
  buf[len] = 0;
  panic(buf);
  return receiver;
}


static Object p_clean_exit(void)
{
  ErrThrow(1);
  return nil;
}


/* Smalltalk class>>#runningOnDevice
   Used to determine whether the program is executing in the
   emulator or on an actual PalmPilot. */
static Object p_running_on_device(void)
{
  return true_obj;
}


/* Object>>#basicSize
   Get the number of indexed slots in the receiver.
*/
static Object p_basic_size(void)
{
  Object layout;
  uint16 layout_value, size;

  if(IS_SMALLINT(receiver))
    return TO_SMALLINT(0);

  layout = OBJECT_ACCESS(OBJECT_CLASS(receiver), Behavior_layout);
  layout_value = FROM_SMALLINT(layout);

  if(layout_value & 8192) {
    /* Pointerless object -- get number of bytes */
    size = OBJECT_BYTE_SIZE(receiver);
  }
  else
    size = OBJECT_SIZE(receiver) - (layout_value & 4095);
  return TO_SMALLINT(size);
}


/* Object>>#basicAt:
   Access an indexed slot of the receiver.
   Fails with:
     1 - index is not a SmallInteger
     2 - index is out of bounds, or receiver is not indexable
*/
static Object p_basic_at(Object index)
{
  int16 int_index;
  Object result;

  if(!IS_SMALLINT(index))
    { FAIL(1); }
  int_index = FROM_SMALLINT(index);
  if(index < 1)
    { FAIL(1); }
  result = basic_at(receiver, (uint16)(int_index - 1));
  if(result == Failure_value)
    { FAIL(2); }
  else return result;
}


/* Object>>#basicAt:put:
   Set an indexed slot of the receiver.
   Fails with:
     1 - index is not a positive SmallInteger
     2 - index is out of bounds, or receiver is not
	 indexable, or receiver cannot hold new value
*/
static Object p_basic_at_put(Object index, Object value)
{
  int16 int_index;

  if(!IS_SMALLINT(index))
    { FAIL(1); }
  int_index = FROM_SMALLINT(index);
  if(index < 1)
    { FAIL(1); }
  if(basic_at_put(receiver, (uint16)(int_index - 1), value))
    return receiver;
  else { FAIL(2); }
}



static Object p_block_value0(void)
{
  if(block_value(0))
    return Failure_value;  /* special...it really succeeded! */
  else {
    /* Wrong # of arguments ... */
    FAIL(1);
  }
}


static Object p_block_value1(Object arg1)
{
  if(block_value(1))
    return Failure_value;  /* special...it really succeeded! */
  else {
    /* Wrong # of arguments ... */
    FAIL(1);
  }
}


static Object p_block_value2(Object arg1, Object arg2)
{
  if(block_value(2))
    return Failure_value;  /* special...it really succeeded! */
  else {
    /* Wrong # of arguments ... */
    FAIL(1);
  }
}


/* See also p_perform_with_arguments */
static Object p_block_value_with_arguments(Object array)
{
  int16 size;

  if(CLASS_OF(array) != Array) { FAIL(1); }
  size = OBJECT_SIZE(array);
  if(size > 16) { FAIL(2); }
  destructure_array();
  if(block_value(size))
    return Failure_value;
  else { FAIL(1); }
}



/* Behavior>>#basicNew
   Create a new instance of the receiver.
   The receiver must not be indexable or pointerless.
   Fails with:
     1 - receiver is indexable or pointerless
     2 - not enough memory
*/
static Object p_basic_new(void)
{
  uint16 layout;

  layout = FROM_SMALLINT(OBJECT_ACCESS(receiver, Behavior_layout));
  if(layout & (4096 | 8192))
    { FAIL(1); }
  return instantiate_normal(receiver);
}


/* Behavior>>#basicNew:
   Create a new instance of the receiver with indexed variables.
   The receiver must be indexable or pointerless.
   Fails with:
     1 - receiver is not indexable or pointerless
     2 - not enough memory
     3 - size argument is invalid
*/
static Object p_basic_new_indexed(Object size)
{
  int16 indexed_size;
  uint16 layout;

  if(!IS_SMALLINT(size))
    { FAIL(3); }
  indexed_size = FROM_SMALLINT(size);
  if(indexed_size < 0)
    { FAIL(3); }

  layout = FROM_SMALLINT(OBJECT_ACCESS(receiver, Behavior_layout));
  if(layout & 8192) {
    /* Pointerless */
    return instantiate_byte_indexed(receiver, indexed_size);
  }
  else if(layout & 4096) {
    /* Indexable, not pointerless */
    return instantiate_indexed(receiver, indexed_size);
  }
  else {
    /* Neither indexable nor pointerless */
    FAIL(1);
  }
}


/* Smalltalk class>>#collectGarbage
   Perform a garbage collection.
*/
static Object p_collect_garbage(void)
{
  collect_garbage();
  return receiver;
}


/* Object>>#perform:
   Indirect message send.
*/
static Object p_perform0(Object selector)
{
  perform(0);
  return Failure_value;
}


/* Object>>#perform:with:
*/
static Object p_perform1(Object selector, Object arg1)
{
  perform(1);
  return Failure_value;
}


/* Object>>#perform:with:with:
*/
static Object p_perform2(Object selector, Object arg1, Object arg2)
{
  perform(2);
  return Failure_value;
}


/* Object>>#perform:with:with:with:
*/
static Object p_perform3(Object selector, Object arg1, Object arg2, Object arg3)
{
  perform(3);
  return Failure_value;
}


/* Object>>#perform:withArguments:
   Fails if there are too many elements in the array
   (currently hardcoded as 16).
*/
static Object p_perform_with_arguments(Object selector, Object array)
{
  int16 size;

  if(CLASS_OF(array) != Array) { FAIL(1); }
  size = OBJECT_SIZE(array);
  if(size > 16) { FAIL(2); }
  destructure_array();
  perform(size);
  return Failure_value;
}


/* Object>>#shallowCopy
   Answer a shallow copy of the receiver.
   Works for all objects; immediates are returned unchanged.
*/
static Object p_shallow_copy(void)
{
  return shallow_copy(receiver);
}


/* Object>>#basicHash
   Answer the identity hash value for the receiver.
   Note that this primitive is also used for #asOOP.
*/
static Object p_basic_hash(void)
{
  /* Simply convert to a SmallInteger */
  return receiver | 1;
}


/* Object>>#become:
   Swap the identities of two objects.
   Fails with:
     1 - either object is immediate
     2 - either object is static (compile-time allocated)
*/
static Object p_become(Object other)
{
  if(IS_SMALLINT(receiver) || IS_SMALLINT(other))
    { FAIL(1); }
  if(((receiver >> 1) < static_high_water) ||
     ((other >> 1) < static_high_water))
    { FAIL(2); }

  become(receiver, other);
  return other;
}


/* Object>>#class
   Answer the class of the receiver.
*/
static Object p_class(void)
{
  return CLASS_OF(receiver);
}


/* Object>>#isKindOf:
   Direct class test; answers true or false. */
static Object p_is_kind_of(Object test_class)
{
  Object cls;

  cls = CLASS_OF(receiver);
  while(cls) {
    if(cls == test_class)
      return true_obj;
    cls = OBJECT_ACCESS(cls, Behavior_superclass);
  }
  return false_obj;
}


/* Object>>#instVarAt:
   Direct access to an object.
   Fails with:
     1 - index is not a SmallInteger
     2 - index is out of range
*/
static Object p_inst_var_at(Object index_val)
{
  int16 index;
  Object object;

  if(!IS_SMALLINT(index_val))
    { FAIL(1); }
  index = FROM_SMALLINT(index_val);
  if((object = inst_var_at(receiver, index - 1)) == Failure_value)
    { FAIL(2); }
  else return object;
}


/* Object>>#instVarAt:put:
   Direct access to an object.
   Fails with:
     1 - index is not a SmallInteger
     2 - index is out of range
*/
static Object p_inst_var_at_put(Object index_val, Object new_val)
{
  int16 index;

  if(!IS_SMALLINT(index_val))
    { FAIL(1); }
  index = FROM_SMALLINT(index_val) - 1;
  if(!inst_var_at_put(receiver, index, new_val))
    { FAIL(2); }
  return new_val;
}


/* Character>>#asInteger
   Give the ASCII value of a Character.
*/
static Object p_character_value(void)
{
  return TO_SMALLINT(FROM_CHARACTER(receiver));
}


/* SmallInteger>>#asCharacter
   Answer the Character with a given ASCII value.
   Fails with:
     1 - integer not in the range 0..255
*/
static Object p_make_character(void)
{
  int16 value;

  value = FROM_SMALLINT(receiver);
  if(value < 0 || value > 255)
    { FAIL(1); }
  return TO_CHARACTER(value);
}


/* ByteArray>>#, or String>>#,
   Byte-object concatenation.
   Fails with:
     1 - receiver class != argument class
*/
static Object p_byte_concatenate(Object arg)
{
  uint16 receiver_size, arg_size;
  Object result;

  if(OBJECT_CLASS(receiver) != CLASS_OF(arg))
    { FAIL(1); }
  receiver_size = OBJECT_BYTE_SIZE(receiver);
  arg_size = OBJECT_BYTE_SIZE(arg);
  result = instantiate_byte_indexed(OBJECT_CLASS(receiver),
				    receiver_size + arg_size);
  MEMCOPY(OBJECT_BYTES(result), OBJECT_BYTES(receiver), receiver_size);
  MEMCOPY(OBJECT_BYTES(result) + receiver_size,
	  OBJECT_BYTES(arg), arg_size);
  return result;
}


/* Smalltalk class>>#freeMemory
   Answer the number of free bytes; performs a garbage
   collection first. */
static Object p_free_memory(void)
{
  collect_garbage();
  return as_smalltalk_integer(total_free_memory() * 2);
}


/* Context class>>#textOfSelector:
   Answer the character string corresponding to the given
   selector.  Fails with:
     1 - text for the selector is not available
*/
static Object p_text_of_selector(Object selector)
{
#ifdef DEBUG_INFO
  uint8 * string;
  uint16 len;
  Object result;

  if(!IS_SMALLINT(selector))
    { FAIL(1); }

  selector >>= 1;
  string = text_of_selector(selector);
  if(!string) { FAIL(1); }
  len = STRLEN((char *)string);
  result = instantiate_byte_indexed(String, len);
  MEMCOPY(OBJECT_BYTES(result), string, len);
  return result;
#else
  FAIL(1);
#endif
}


/* Context class>>#nameOfClass:
   Answer the character string corresponding to the name
   of the given class or metaclass.  Metaclasses will have
   a name ending in ' class'.
   Fails with:
     1 - name of the class is not available
*/
static Object p_name_of_class(Object cls)
{
#ifdef DEBUG_INFO
  uint8 * string;
  uint16 len;
  Object result;

  string = name_of_class(cls);
  if(!string) { FAIL(1); }
  len = STRLEN((char *)string);
  result = instantiate_byte_indexed(String, len);
  MEMCOPY(OBJECT_BYTES(result), string, len);
  return result;
#else
  FAIL(1);
#endif
}


/* String>>#=, ByteArray>>#=, etc.
   Compare two byte indexable objects for equality.
   Fails with
     1 - receiver is not the same class as argument
*/
static Object p_compare_bytes(Object other)
{
  if(CLASS_OF(other) != OBJECT_CLASS(receiver))
    { FAIL(1); }
  if(OBJECT_BYTE_SIZE(receiver) != OBJECT_BYTE_SIZE(other))
    return false_obj;
  return MEMCMP(OBJECT_BYTES(receiver), OBJECT_BYTES(other),
		OBJECT_BYTE_SIZE(receiver))
    ? false_obj : true_obj;
}


/* Context class>>#stackSlotsForContext:
   Answer the number of stack slots between the local variable
   base and the data stack pointer, for the given context index.
   Fails with:
     1 - the context index is not a SmallInteger
     2 - the context index is out of bounds
*/
static Object p_context_slots(Object context)
{
  int16 index, val;

  if(!IS_SMALLINT(context))
    { FAIL(1); }
  index = FROM_SMALLINT(context);
  if(index < 1 || index >= call_stack_ptr)
    { FAIL(2); }
  val = call_stack[index].data_stack_ptr -
                call_stack[index].local_var_base;
  return TO_SMALLINT(val);
}


/* Context class>>#receiverForContext:
   Answer the receiver associated with the given context index.
   Fails with:
     1 - the context index is not a SmallInteger
     2 - the context index is out of bounds
*/
static Object p_context_receiver(Object context)
{
  int16 index;

  if(!IS_SMALLINT(context))
    { FAIL(1); }
  index = FROM_SMALLINT(context);
  if(index < 1 || index >= call_stack_ptr)
    { FAIL(2); }
  return call_stack[index].receiver;
}


/* Context class>>#selectorForContext:behavior:
   Answer the selector for the method executing in the
   given context index.
   Fails with:
     1 - the context index is not a SmallInteger
     2 - the context index is out of bounds
*/
static Object p_context_selector(Object context)
{
  int16 index;
  uint16 selector;
  Object method_class;

  if(!IS_SMALLINT(context))
    { FAIL(1); }
  index = FROM_SMALLINT(context);
  if(index < 1 || index >= call_stack_ptr)
    { FAIL(2); }
  method_class = infer_class(call_stack[index].instruction_ptr);
  selector = infer_selector(method_class, call_stack[index].instruction_ptr);
  return TO_SMALLINT(selector);
}


static Object p_context_class(Object context)
{
  int16 index;

  if(!IS_SMALLINT(context))
    { FAIL(1); }
  index = FROM_SMALLINT(context);
  if(index < 1 || index >= call_stack_ptr)
    { FAIL(2); }
  return infer_class(call_stack[index].instruction_ptr);
}


/* Context class>>#stackSlotAt:forContext:
   Answer the stack value at the given context, at the
   given index (0-origin).  Index 0 means the first local
   variable.
   Fails with:
     1 - the context index is not a SmallInteger
     2 - the context index is out of bounds
     3 - the slot index is not a SmallInteger
*/
static Object p_context_slot_at(Object slot, Object context)
{
  int16 index, slot_index;

  if(!IS_SMALLINT(context))
    { FAIL(1); }
  index = FROM_SMALLINT(context);
  if(index < 1 || index >= call_stack_ptr)
    { FAIL(2); }
  if(!IS_SMALLINT(slot))
    { FAIL(3); }
  slot_index = FROM_SMALLINT(slot);
  return data_stack[call_stack[index].local_var_base + slot_index];
}


/* Character>>#testAttributeBit:
   Answer whether the receiver has the given attribute.
   The attribute is a integer as defined in misc.c
   Fails with:
     1 - the argument is not a valid attribute bit
*/
static Object p_test_char_bit(Object bit)
{
  uint16 val, ascii, result;
//  WordPtr attr;

  if(!IS_SMALLINT(bit))
    { FAIL(1); }
  val = FROM_SMALLINT(bit);
  ascii = FROM_CHARACTER(receiver);
//  attr = GetCharAttr();
  result = TxtCharAttr(ascii) & val;
  return AS_BOOLEAN(result);
}


/* CPointer>>#byteAt: */
static Object p_pointer_byte_access(Object index)
{
  uint8 * ptr;

  if(!IS_SMALLINT(index))
    { FAIL(1); }
  ptr = (uint8 *)decode_pointer(receiver);
  return TO_SMALLINT(ptr[FROM_SMALLINT(index)]);
}


/* CPointer>>#byteAt:put: */
static Object p_pointer_byte_set(Object index, Object value)
{
  uint8 * ptr;

  if(!(IS_SMALLINT(index) && IS_SMALLINT(value)))
    { FAIL(1); }
  ptr = (uint8 *)decode_pointer(receiver);
  ptr[FROM_SMALLINT(index)] = FROM_SMALLINT(value);
  return value;
}


/* CPointer>>#wordAt: */
static Object p_pointer_word_access(Object index)
{
  uint8 * ptr;

  if(!IS_SMALLINT(index))
    { FAIL(1); }
  ptr = (uint8 *)decode_pointer(receiver);
  return as_smalltalk_integer(
     ((uint16 *)(ptr + FROM_SMALLINT(index)))[0]);
}


/* CPointer>>#wordAt:put: */
static Object p_pointer_word_set(Object index, Object value)
{
  uint8 * ptr;

  if(!(IS_SMALLINT(index) && is_integer(value)))
    { FAIL(1); }
  ptr = (uint8 *)decode_pointer(receiver);
  ((uint16 *)(ptr + FROM_SMALLINT(index)))[0] =
  	as_c_integer(value);
  return value;
}


/* CPointer>>#dwordAt: */
static Object p_pointer_dword_access(Object index)
{
  uint8 * ptr;

  if(!IS_SMALLINT(index))
    { FAIL(1); }
  ptr = (uint8 *)decode_pointer(receiver);
  return as_smalltalk_integer(
     ((uint32 *)(ptr + FROM_SMALLINT(index)))[0]);
}


/* CPointer>>#dwordAt:put: */
static Object p_pointer_dword_set(Object index, Object value)
{
  uint8 * ptr;

  if(!(IS_SMALLINT(index) && is_integer(value)))
    { FAIL(1); }
  ptr = (uint8 *)decode_pointer(receiver);
  ((uint32 *)(ptr + FROM_SMALLINT(index)))[0] =
  	as_c_integer(value);
  return value;
}


/* CPointer>>#offsetBy: */
static Object p_offset_pointer(Object offset)
{
  uint8 * ptr;

  if(!IS_SMALLINT(offset))
    { FAIL(1); }
  ptr = decode_pointer(receiver);
  ptr += FROM_SMALLINT(offset);
  return encode_pointer(ptr);
}


/* Object>>#basicChangeClassTo: */
/* Does NO error checking! */
static Object p_basic_change_class(Object new_class)
{
  OBJECT_CLASS(receiver) = new_class;
  return receiver;
}


/* String>>#hash
   Actually, works for any byte indexable object. */
static Object p_string_hash(void)
{
  uint32 hashcode = 0;
  uint16 length;
  uint8 * bytes;

  length = OBJECT_BYTE_SIZE(receiver);
  bytes = OBJECT_BYTES(receiver);

  while(length-- > 0) {
    hashcode = (hashcode << 4) + *bytes++;
    if(hashcode > 0xFFFFFFFUL) {
      hashcode = (hashcode & 0xFFFFFFFUL)
	^ ((hashcode >> 24) & 0xF0);
    }
  }
  /* Maximum positive magnitude for SmallIntegers is
     16383 (0x3FFF) */
  return TO_SMALLINT(hashcode & 0x3FFF);
}


/* CPointer>>#isNull */
static Object p_pointer_is_null(void)
{
  if(decode_pointer(receiver))
    return false_obj;
  else return true_obj;
}


/* Behavior>>#implements:
   Answer whether the receiver -directly- implements
   the given selector. */
static Object p_behavior_implements(Object selector)
{
  if(!IS_SMALLINT(selector))
    { FAIL(1); }
  return AS_BOOLEAN(class_implements(receiver,
				     FROM_SMALLINT(selector)));
}

