#include "otalk.h"
#include "primitives.h"
#include "scanner.h"
#include <assert.h>
#include <string.h>

T_OBJECT throw_symbol = NULL;
T_OBJECT throw_value  = NULL;
extern T_OBJECT call_method (int , T_OBJECT , t_stackpointer ,int);


#define DEFINE_BYTECODE_OPERATOR(INTEG,ARGS,NAME) NAME

char* bytes_code_names[] = {
#include "byte_code.h"
};

#undef DEFINE_BYTECODE_OPERATOR

#define DEFINE_BYTECODE_OPERATOR(INTEG,ARGS,NAME) ARGS

int bytes_code_args[] = {
#include "byte_code.h"
};

struct primitive_def primitives[] = {
  {"sys_class",           0, prim_class        },
  {"sys_set_class()",     1, prim_set_class    },

  {"sys_add()",           1, prim_add          },
  {"sys_minus()",         1, prim_minus        },
  {"sys_mul()",           1, prim_mul          },
  {"sys_div()",           1, prim_div          },

  {"sys_less()",          1, prim_sys_less     },

  {"sys_slot_n()",        1, prim_sys_slot_n        },
  {"sys_set_slot_n()",    2, prim_sys_set_slot_n    },
  {"sys_new_vector()",    1, prim_sys_new_vector    },
  {"sys_vector_length()", 0, prim_sys_vector_length },
  {"sys_eq()",            1, prim_sys_eq            },

  {"sys_print_string()",      0, prim_print_string },
  {"sys_print_symbol()",      0, prim_print_symbol },
  {"sys_print_number()",      0, prim_print_number },
  {"sys_print_adress()",      0, prim_print_adress },

  {"sys_class_for()",         1, prim_sys_class_for },
  {"sys_register_class()",    0, prim_sys_register_class },

  {"sys_concat_string()",     1, prim_sys_concat_string  },
  {"sys_read_file()",         0, prim_sys_read_file },

  {"sys_hash_id()",           0, prim_sys_hash_id   },

  {"sys_set_global_value()",  1, prim_sys_set_global_value },
  {"sys_global_value()",      0, prim_sys_global_value },

  {"sys_as_symbol()",         0, prim_sys_as_symbol },

  {"sys_exit()",              1, prim_sys_exit },

  {"sys_throw()",             1, prim_sys_throw },

  {"sys_perform()",           2, prim_sys_perform },
  {"sys_find_errorhandler()", 0, prim_sys_find_errorhandler },
  {"sys_traceback()",         0, prim_sys_traceback },

  {"sys_sub_seq()",           2, prim_sys_sub_seq },
  {"sys_new_string()",        1, prim_sys_new_string },
  {NULL,                      0, NULL }
};


int primitive_name_index(char* str)
{
  int i = 0;

  while (primitives[i].name != NULL) {
    if (!strcmp(primitives[i].name,str))
      return i;
    ++i;
  }
  return -1;
}

int primitive_mandatory_args(int i)
{
  return primitives[i].args;
}

/* ----------------------------------------------------------------------
   Definitionen der Primitiven
   ---------------------------------------------------------------------- */
T_OBJECT prim_add_old(t_stackpointer stackpointer)
{
  if (CLASS(*stackpointer) != g_primitive_class_number) {
    throw_value = *stackpointer;
    throw_symbol = sym_arithmetic;
    return NULL;
  }

  *(stackpointer-1) = make_number(NUMBER(*stackpointer)+NUMBER(*(stackpointer-1)));
  --stackpointer;

  return *stackpointer;
}


T_OBJECT exceptions_resume(T_OBJECT ex,t_stackpointer stackpointer)
{
  T_OBJECT res;

  STACK_PUSH(stackpointer,ex);
  res = call_method(0,sym_handle_OCP,stackpointer,0);
  if (res == NULL)
    return sym_abort;
  else
    return res;
}

T_OBJECT check_on_integer(T_OBJECT ob,t_stackpointer stackpointer,T_OBJECT* res)
{
  if (CLASS(ob) != g_primitive_class_number) {
    T_OBJECT ex = make_exception(sym_arithmetic,
				 sym_mustBeInteger,
				 VALUE_NIL,
				 stackpointer-1,1);
    T_OBJECT res1;
    
    res1 = exceptions_resume(ex,stackpointer);
    if (res1 == sym_return) {
      *res = EXCEPTION_RETURN_VALUE(ex);
      return NULL;
    } 
    *res = NULL;
    return NULL; 
  }
  return VALUE_T;
}


T_OBJECT prim_add(t_stackpointer stackpointer)
{
  T_OBJECT res;

  if (check_on_integer(*stackpointer,stackpointer,&res) == NULL)
    return res;

  --stackpointer;
  *stackpointer = make_number(NUMBER(*(stackpointer+1))+NUMBER(*stackpointer));

  return *stackpointer;
}

T_OBJECT prim_minus(t_stackpointer stackpointer)
{
  T_OBJECT res;

  if (check_on_integer(*stackpointer,stackpointer,&res) == NULL)
    return res;

  *(stackpointer-1) = make_number(NUMBER(*(stackpointer-1))-NUMBER(*stackpointer));
  --stackpointer;

  return *stackpointer;
}

T_OBJECT prim_mul(t_stackpointer stackpointer)
{
  T_OBJECT res;

  if (check_on_integer(*stackpointer,stackpointer,&res) == NULL)
    return res;

  *(stackpointer-1) = make_number(NUMBER(*stackpointer)*NUMBER(*(stackpointer-1)));
  --stackpointer;

  return *stackpointer;
}

T_OBJECT prim_div(t_stackpointer stackpointer)
{
  T_OBJECT res;

  if (check_on_integer(*stackpointer,stackpointer,&res) == NULL)
    return res;

  *(stackpointer-1) = make_number(NUMBER(*stackpointer)/NUMBER(*(stackpointer-1)));
  --stackpointer;

  return *stackpointer;
}

T_OBJECT prim_sys_less(t_stackpointer stackpointer)
{
  T_OBJECT res;

  if (check_on_integer(*stackpointer,stackpointer,&res) == NULL)
    return res;

  *(stackpointer-1) = (NUMBER(*stackpointer)>NUMBER(*(stackpointer-1)))?VALUE_T:VALUE_F;
  --stackpointer;

  return *stackpointer;
}

T_OBJECT prim_class(t_stackpointer stackpointer)
{
  *stackpointer = CLASS(*stackpointer);

  return *stackpointer;
}

T_OBJECT prim_set_class(t_stackpointer stackpointer)
{
  stackpointer--;
  if ((*stackpointer) == g_top_object_class) {
    fprintf(stderr,"****** Error in prim_set_class()! Not allowed to set.\n");
    exit(8);
  }
  CLASS(*stackpointer) = *(stackpointer+1);

  return *stackpointer;
}


T_OBJECT prim_print_number(t_stackpointer stackpointer)
{
  T_OBJECT res;

  if (check_on_integer(*stackpointer,stackpointer,&res) == NULL)
    return res;

  printf("%d",NUMBER(*stackpointer));

  return *stackpointer;
}

T_OBJECT prim_print_string(t_stackpointer stackpointer)
{
  printf("%s",STRING_CHARS(*stackpointer));

  return *stackpointer;
}

T_OBJECT prim_print_symbol(t_stackpointer stackpointer)
{
  printf(":%s",STRING_CHARS(*stackpointer));

  return *stackpointer;
}

T_OBJECT prim_sys_slot_n(t_stackpointer stackpointer)
{
  --stackpointer;
  *stackpointer = SLOT_N(*stackpointer,NUMBER(*(stackpointer+1)));
  if (*stackpointer == NULL)
    assert(1==2);
  return *stackpointer;
}

T_OBJECT prim_sys_set_slot_n(t_stackpointer stackpointer)
{
  stackpointer -= 2;
  SET_SLOT_N(*stackpointer,
	     NUMBER(*(stackpointer+1)),
	     *(stackpointer+2));

  return *stackpointer;
}

T_OBJECT prim_sys_new_vector(t_stackpointer stackpointer)
{
  long n;
  int i;

  if (CLASS(*stackpointer) != g_primitive_class_number)
    return NULL;

  n=NUMBER(*stackpointer);
  --stackpointer;
  *stackpointer = make_vector(n);
  for (i=0; i<n; ++i)
    SET_SLOT_N(*stackpointer,i,VALUE_NIL);

  return *stackpointer;
}

T_OBJECT prim_sys_vector_length(t_stackpointer stackpointer)
{
  int length = VECTOR_LENGTH(*stackpointer);
  *stackpointer = make_number(length);

  return *stackpointer;
}

T_OBJECT prim_sys_eq(t_stackpointer stackpointer)
{
  T_OBJECT o=*stackpointer,o2;
  --stackpointer;
  o2 = *stackpointer;

  if ((CLASS(o)  == g_primitive_class_number) &&
      (CLASS(o2) == g_primitive_class_number)    )
      *stackpointer = (NUMBER(o)==NUMBER(o2))?VALUE_T:VALUE_F;
    else
      *stackpointer = (o==o2)?VALUE_T:VALUE_F;

  return *stackpointer;
}

T_OBJECT prim_print_adress(t_stackpointer stackpointer)
{
  printf("%p",*stackpointer);
  return *stackpointer;
}


T_OBJECT prim_sys_class_for(t_stackpointer stackpointer)
{
  extern T_OBJECT class_for(char*);

  T_OBJECT name=*stackpointer;
  --stackpointer;

  *stackpointer = class_for(STRING_CHARS(name));
  if ((*stackpointer) == NULL) {
    fprintf(stderr,"\nKann Klasse mit Namen %s nicht finden.\n",STRING_CHARS(name));
    exit(10);
  }

  return *stackpointer;
}

T_OBJECT prim_sys_register_class(t_stackpointer stackpointer)
{
  extern void add_class(T_OBJECT class);
  
  add_class(*stackpointer);
  return *stackpointer;
}


T_OBJECT prim_sys_concat_string(t_stackpointer stackpointer)
{
  T_OBJECT string1,string2;
  char* result;

  string2 = *stackpointer;
  --stackpointer;
  string1 = *stackpointer;

  result = mymalloc(STRING_LENGTH(string1)+STRING_LENGTH(string2)+1);
  strcpy(result,STRING_CHARS(string1));
  strcat(result,STRING_CHARS(string2));
  *stackpointer = make_string_with(result);

  return *stackpointer;
}

T_OBJECT prim_sys_sub_seq(t_stackpointer stackpointer)
{
  int length,to,from,newlength;
  char* result;

  if (*stackpointer == VALUE_NIL)
    to = 0;
  else
    to = NUMBER(*stackpointer);
  --stackpointer;
  if (*stackpointer == VALUE_NIL)
    from = STRING_LENGTH(*(stackpointer-1));
  else
    from = NUMBER(*stackpointer);
  --stackpointer;

  length = STRING_LENGTH(*stackpointer);

  if (to < 0)
    to = length + to;
  if (from < 0)
    from = length + from;

  if (to > length)
    to = length;
  if (from > length)
    from = length;
  if (to < 0) to = 0;
  if (from < 0) from = 0;
  newlength = to - from;
  /*printf("from %d to %d newlength %d\n",from,to,newlength);*/
  if (newlength <= 0)
    return make_string("");
  
  result = (char*)mymalloc(newlength+1);
  strncpy(result,STRING_CHARS(*stackpointer)+from,newlength);
  result[newlength] = 0;
  *stackpointer = make_string_with(result);

  return *stackpointer;
}

T_OBJECT prim_sys_new_string(t_stackpointer stackpointer)
{
  int length;
  char* result;

  length = NUMBER(*stackpointer);
  --stackpointer;
  if (length < 0) length = 0;

  result = (char*)mymalloc(length+1);
  result[length] = 0;
  *stackpointer = make_string_with(result);
  while (length--)
    *result++ = ' ';

  return *stackpointer;
}


T_OBJECT prim_sys_read_file(t_stackpointer stackpointer)
{
  read_file(STRING_CHARS(*stackpointer));
  return *stackpointer;
}

T_OBJECT prim_sys_hash_id(t_stackpointer stackpointer)
{
  /*printf("%p --> %d\n",*stackpointer,
	 ((((int)(*stackpointer))>>5))&1023);
	 */
  if (CLASS(*stackpointer) == g_primitive_class_number)
    *stackpointer = make_number(NUMBER((*stackpointer))&1023);
  else
    *stackpointer = make_number(((((int)(*stackpointer))>>4))&1023);

  return *stackpointer;
}

T_OBJECT prim_sys_global_value(t_stackpointer stackpointer)
{
  *stackpointer = global_value_for(*stackpointer);

  return *stackpointer;
}

T_OBJECT prim_sys_set_global_value(t_stackpointer stackpointer)
{
  set_global_value_for(*(stackpointer-1),*stackpointer);
  --stackpointer;
  return *stackpointer;
}

T_OBJECT prim_sys_as_symbol(t_stackpointer stackpointer)
{
  *stackpointer = make_symbol(STRING_CHARS(*stackpointer));

  return *stackpointer;
}

T_OBJECT prim_sys_exit(t_stackpointer stackpointer)
{
  int n;

  if (CLASS(*stackpointer) == g_primitive_class_number)
    n = NUMBER(*stackpointer);
  else
    n = 1000;
  fprintf(stderr,"\nSystem-Exit with Code %d\n",
	  n);
  exit(n);
}

T_OBJECT prim_sys_throw(t_stackpointer stackpointer)
{
  throw_value  = *stackpointer;
  --stackpointer;
  throw_symbol = *stackpointer;

  return *stackpointer;
}

T_OBJECT prim_sys_perform(t_stackpointer stackpointer)
{
  /* *(stackpointer-1) : Symbol                    
     *stackpointer     : Argumente als FixedVector */

  T_OBJECT vector = *stackpointer;
  T_OBJECT symbol;
  int args,i;

  if (vector == VALUE_NIL)
    args = 0;
  else
    args = VECTOR_LENGTH(vector);

  --stackpointer;
  symbol = *stackpointer;
  --stackpointer;
  
  for (i=0; i<args; ++i)
    STACK_PUSH(stackpointer,VECTOR_ENTRY(vector,i));
  
  return call_method(args,symbol,stackpointer,0);
}

T_OBJECT prim_sys_find_errorhandler(t_stackpointer stackpointer)
{
  extern T_OBJECT find_errorhandler(t_incarnation*);
  T_OBJECT res; 

  if ((res = find_errorhandler(NULL)) == NULL)
    return VALUE_NIL;
  else
    return res;
}

T_OBJECT prim_sys_traceback(t_stackpointer stackpointer)
{
  extern void print_traceback(t_stackpointer);

  print_traceback(NULL);
    
  return VALUE_NIL;
}


/*
(defalias 'prim-install (read-kbd-macro
"<home> C-s SPC C-SPC C-s ( <left> ESC x copy-region RET SPC DEL
 <C-home> C-s primitives[] <home> C-s NULL <home> RET <up> 2*SPC { \"
 C-y ()\" , ? , SPC C-y SPC } , <home> 4*<right> 5*C-d"))

*/

/* eof */
