/* classes: src_files */

/*	Copyright (C) 1995 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 */



#include "scm.h"


SCM sym_SourceFile;
SCM sym_ConstantValue;
SCM sym_LineNumberTable;
SCM sym_LocalVariableTable;
SCM sym_Code;

SCM constant_type_names[n_constant_types];


#define get_u4(var) \
    if (nleft < 4) \
      goto too_short; \
    var = (pos[0] * (1<<24)) + (pos[1] * (1<<16)) + (pos[2] * (1<<8)) + (pos[3]); \
    pos += 4; \
    nleft -= 4

#define get_u8(var) \
    if (nleft < 8) \
      goto too_short; \
    var[0] = (pos[0] * (1<<24)) + (pos[1] * (1<<16)) + (pos[2] * (1<<8)) + (pos[3]); \
    var[1] = (pos[4] * (1<<24)) + (pos[5] * (1<<16)) + (pos[6] * (1<<8)) + (pos[7]); \
    pos += 8; \
    nleft -= 8

#define get_u2(var) \
    if (nleft < 2) \
      goto too_short; \
    var = (pos[0] * (1<<8)) + (pos[1]); \
    pos += 2; \
    nleft -= 2

#define get_u1(var) \
    if (nleft < 1) \
      goto too_short; \
    var = (pos[0]); \
    pos += 1; \
    nleft -= 1

#define get_float(var) \
    if (nleft < 4) \
      goto too_short; \
    ((unsigned long *)&var)[0] = (  ((unsigned long)pos[0]<<24) \
				  + ((unsigned long)pos[1]<<16) \
				  + ((unsigned long)pos[2]<<8) \
				  + ((unsigned long)pos[3])); \
    pos += 4; \
    nleft -= 4

#define get_double(var) \
    if (nleft < 8) \
      goto too_short; \
    ((unsigned long *)&var)[0] = (  ((unsigned long)pos[0]<<24) \
				  + ((unsigned long)pos[1]<<16) \
				  + ((unsigned long)pos[2]<<8) \
				  + ((unsigned long)pos[3])); \
    ((unsigned long *)&var)[2] = (  ((unsigned long)pos[4]<<24) \
				  + ((unsigned long)pos[5]<<16) \
				  + ((unsigned long)pos[6]<<8) \
				  + ((unsigned long)pos[7])); \
    pos += 8; \
    nleft -= 8


#define get_length(VAR, expected, func) \
   get_u4(VAR); \
   ASSERT (VAR == expected, MAKINUM (VAR), "incorrect length count", func)



#define get_string(var, len) \
		if (nleft < len) \
		  goto too_short; \
		var = scm_makfromstr (pos, len, 0); \
		pos += len; \
		nleft -= len



SCM 
constant_pool_check (constants, index, type, func)
     SCM constants;
     int index;
     int type;
     char * func;
{
  SCM i;
  SCM answer;
  int reffed;

  ASSERT (index < LENGTH (constants), MAKINUM (index),
	  "constant pool index out of bounds", func);

  i = VELTS (constants)[index];

  ASSERT (CAR (i) == constant_type_names[type],
	  MAKINUM (index),
	  "wrong type in constant pool", func);

  return i;
}



static char s_parse_latte[] = "parse-latte";


static SCM 
get_attributes (nleftp, posp, constants)
     int * nleftp;
     unsigned char ** posp;
     SCM constants;
{
  int nleft;
  char * pos;

  SCM attributes;
  SCM * attribute_table;
  int attribute_count;
  int attributes_pos;
  int i;

  nleft = *nleftp;
  pos = *posp;

  get_u2 (attribute_count);
  attributes = scm_make_vector (MAKINUM (attribute_count), BOOL_F);
  attribute_table = VELTS (attributes);

  for (i = 0; i < attribute_count; ++i)
    {
      int name_index;
      int len;
      SCM type;

      get_u2 (name_index);
      type = constant_pool_check (constants,
				  name_index,
				  CONSTANT_Asciz,
				  s_parse_latte);
      type = CDR (type);
      if (type == sym_SourceFile)
	{
	  int x;
	  get_length (x, 2, s_parse_latte);
	  get_u2 (x);
	  attribute_table[i] = MAKINUM (x);
	}
      else if (type == sym_ConstantValue)
	{
	  int x;
	  get_length (x, 2, s_parse_latte);
	  get_u2 (x);
	  attribute_table[i] = MAKINUM (x);
	}
      else if (type == sym_LineNumberTable)
	{
	  int n_line_numbers;
	  SCM line_numbers;
	  SCM * line_number_table;
	  int x;
	  int line_table_len;

	  get_u4 (line_table_len);
	  get_u2 (n_line_numbers);
	  line_numbers = scm_make_vector (MAKINUM (n_line_numbers), BOOL_F);
	  line_number_table = VELTS (line_numbers);
	  for (x = 0; x < n_line_numbers; ++x)
	    {
	      int start_pc;
	      int line_number;

	      get_u2 (start_pc);
	      get_u2 (line_number);

	      line_number_table[x] = scm_cons (MAKINUM (start_pc), MAKINUM (line_number));
	    }
	  attribute_table[i] = line_numbers;
	}
      else if (type == sym_LocalVariableTable)
	{
	  int n_local_variables;
	  SCM local_variables;
	  SCM * local_variable_table;
	  int x;
	  int local_var_len;

	  get_u4 (local_var_len);
	  get_u2 (n_local_variables);
	  local_variables = scm_make_vector (MAKINUM (n_local_variables), BOOL_F);
	  local_variable_table = VELTS (local_variables);
	  for (x = 0; x < n_local_variables; ++x)
	    {
	      int start_pc;
	      int valid_len;
	      int name_index;
	      SCM name;
	      int sig_index;
	      SCM sig;
	      int slot;
	      
	      get_u2 (start_pc);
	      get_u2 (valid_len);
	      get_u2 (name_index);
	      name = MAKINUM (name_index);
	      get_u2 (sig_index);
	      sig = MAKINUM (sig_index);
	      get_u2 (slot);

	      local_variable_table[x] = scm_listify (MAKINUM (start_pc),
						     MAKINUM (valid_len),
						     name,
						     sig,
						     MAKINUM (slot));
	    }
	  attribute_table[i] = local_variables;
	}
      else if (type == sym_Code)
	{
	  int len;
	  int nleft_before_code;
	  int max_stack;
	  int max_locals;
	  int code_length;
	  SCM code;
	  int n_exceptions;
	  SCM exceptions;
	  SCM * exception_table;
	  SCM sub_attributes;
	  
	  get_u4 (len);
	  nleft_before_code = nleft;

	  get_u1 (max_stack);
	  get_u1 (max_locals);

	  get_u2 (code_length);
	  get_string (code, code_length);

	  get_u2 (n_exceptions);
	  exceptions = scm_make_vector (MAKINUM (n_exceptions), BOOL_F);
	  exception_table = VELTS (exceptions);

	  {
	    int x;
	    for (x = 0; x < n_exceptions; ++x)
	      {
		int start_pc;
		int end_pc;
		int handler_pc;
		int catch_index;
		SCM catch_type;

		get_u2 (start_pc);
		get_u2 (end_pc);
		get_u2 (handler_pc);
		get_u2 (catch_index);
		
		catch_type = MAKINUM (catch_index);
		exception_table[x] = scm_listify (MAKINUM (start_pc),
						  MAKINUM (end_pc),
						  MAKINUM (handler_pc),
						  catch_type);
	      }
	  }

	  sub_attributes = get_attributes (&nleft, &pos, constants);

	  {
	    SCM code_attr;
	    code_attr = scm_make_vector (MAKINUM (5), BOOL_F);
	    VELTS (code_attr)[0] = MAKINUM (max_stack);
	    VELTS (code_attr)[1] = MAKINUM (max_locals);
	    VELTS (code_attr)[2] = code;
	    VELTS (code_attr)[3] = exceptions;
	    VELTS (code_attr)[4] = sub_attributes;
	    attribute_table[i] = code_attr;
	  }
	}


      attribute_table[i] = scm_cons (type, attribute_table[i]);
    }

 done:
  *posp = pos;
  *nleftp = nleft;
  return attributes;

 too_short:
  attributes = BOOL_F;
  goto done;
}



SCM
scm_parse_latte (str)
     SCM str;
{
  unsigned char * pos;
  int nleft;

  SCM constants;
  SCM access;
  SCM this;
  SCM super;
  SCM interfaces;
  SCM fields;
  SCM methods;
  SCM attributes;

  ASSERT (NIMP (str) && (STRINGP (str) || SYMBOLP (str)), str, ARG1, s_parse_latte);

  scm_remember (&str);
  pos = (unsigned char *)CHARS (str);
  nleft = LENGTH (str);

  /* Look for a magic cafe babe.
   * I'm sure i saw him once.
   */

  {
    unsigned long x;
    get_u4 (x);
    if (x != (unsigned long)0xcafebabeL)
      return CDR (scm_intern0 ("bad-magic"));
  }

  /* Check Version
   */
  {
    int minor;
    int major;

    get_u2 (minor);
    get_u2 (major);
    if ((minor != 2) || (major != 45))
      return CDR (scm_intern0 ("bad-version"));
  }

  /* Constant Pool
   */
  {
    int cp_count;
    SCM * constant_table;
    int * constant_types;

    /* constant pool count */
    get_u2 (cp_count);

    constants = scm_make_vector (MAKINUM (cp_count), BOOL_F);
    constant_table = VELTS (constants);

    DEFER_INTS;
    constant_types = (int *)alloca (sizeof (int) * cp_count);
    ALLOW_INTS;

    {
      int s_type;
      int cp_pos;

      for (cp_pos = 1; cp_pos < cp_count; ++cp_pos)
	{
	  /* type of the constant pool entry */
	  if (!nleft)
	    goto too_short;
	  s_type = *pos++;
	  --nleft;

	  constant_types[cp_pos] = s_type;
	  switch (s_type)
	    {
	    default:
	      return CDR (scm_intern0 ("unrecognized-constant-type"));

	    case CONSTANT_Asciz:
	      {
		int len;
		get_u2(len);

		if (nleft < len)
		  goto too_short;

		constant_table[cp_pos] = CAR (scm_intern (pos, len));
		nleft -= len;
		pos += len;
		break;
	      }

	    case CONSTANT_Integer:
	      {
		unsigned long n;

		get_u4(n);
		constant_table[cp_pos] = scm_ulong2num (n);
		break;
	      }

	    case CONSTANT_Float:
	      {
		float f;
		get_float(f);
		constant_table[cp_pos] = scm_makdbl (f, 0.0);
		break;
	      }

	    case CONSTANT_Long:
	      {
		unsigned long n[2];

		get_u8(n);
		constant_table[cp_pos] = scm_2ulong2big (n);
		break;
	      }

	    case CONSTANT_Double:
	      {
		double f;
		get_double(f);
		constant_table[cp_pos] = scm_makdbl (f, 0.0);
		break;
	      }

	    case CONSTANT_Class:
	      {
		int index;
		get_u2 (index);
		constant_table[cp_pos] = MAKINUM (index);
		break;
	      }

	    case CONSTANT_String:
	      {
		int index;
		get_u2 (index);
		constant_table[cp_pos] = MAKINUM (index);
		break;
	      }
	      
	    case CONSTANT_Fieldref:
	    case CONSTANT_MethodRef:
	    case CONSTANT_InterfaceMethodref:
	    case CONSTANT_NameandType:
	      {
		int class_index;
		int name_type_index;
		SCM class_obj;
		SCM name_type_obj;

		get_u2 (class_index);
		get_u2 (name_type_index);

		class_obj = MAKINUM (class_index);
		name_type_obj = MAKINUM (name_type_index);

		constant_table[cp_pos] = scm_cons (class_obj, name_type_obj);
		break;
	      }

	    }

	  constant_table[cp_pos] = scm_cons (constant_type_names[s_type],
					     constant_table[cp_pos]);
	}
    }
  }


  /* access for the whole class */
  {
    int a;
    get_u2 (a);
    access = MAKINUM (a);
  }

  /* this  class index */
  {
    int a;
    get_u2 (a);
    this = MAKINUM (a);
  }

  /* super class index */
  {
    int a;
    get_u2 (a);
    super = MAKINUM (a);
  }

  /* The list of supported interfaces. */
  {
    int i_count;
    int i;
    SCM * interface_table;

    get_u2 (i_count);
    interfaces = scm_make_vector (MAKINUM (i_count), BOOL_F);
    interface_table = VELTS (interfaces);

    for (i = 0; i < i_count; ++i)
      {
	int x;
	get_u2 (x);
	interface_table[i] = MAKINUM (x);
      }
  }

  /* The fields locally defined. */
  {
    int i;
    int field_count;
    SCM * field_table;
    int fields_pos;

    get_u2 (field_count);
    fields = scm_make_vector (MAKINUM (field_count), BOOL_F);
    field_table = VELTS (fields);

    for (i = 0; i < field_count; ++i)
      {
	int access_flags;
	int name_index;
	int signature_index;
	SCM field_attributes;

	get_u2 (access_flags);
	get_u2 (name_index);
	get_u2 (signature_index);


	field_attributes = get_attributes (&nleft, &pos, constants);
	if (field_attributes == BOOL_F)
	  goto too_short;

	{
	  SCM fname;
	  SCM fsig;
	  fname = MAKINUM (name_index);
	  fsig = MAKINUM (signature_index);
	  field_table[i] = scm_listify (MAKINUM (access_flags),
					fname,
					fsig,
					field_attributes,
					SCM_UNDEFINED);
	}
      }
  }

  /* The methods locally defined. */
  {
    int method_count;
    SCM * method_table;
    int methods_pos;
    int i;

    get_u2 (method_count);
    methods = scm_make_vector (MAKINUM (method_count), BOOL_F);
    method_table = VELTS (methods);

    for (i = 0; i < method_count; ++i)
      {
	int access_flags;
	int name_index;
	int signature_index;
	SCM method_attributes;

	get_u2 (access_flags);
	get_u2 (name_index);
	get_u2 (signature_index);

	method_attributes = get_attributes (&nleft, &pos, constants);
	if (method_attributes == BOOL_F)
	  goto too_short;

	{
	  SCM mname;
	  SCM msig;
	  mname = MAKINUM (name_index);
	  msig = MAKINUM (signature_index);
	  method_table[i] = scm_listify (MAKINUM (access_flags),
					 mname,
					 msig,
					 method_attributes,
					 SCM_UNDEFINED);
	}
      }
  }

  if (nleft)
    {
      attributes = get_attributes (&nleft, &pos, constants);
      if (attributes == BOOL_F)
	goto too_short;
    }
  else
    attributes = BOOL_F;


  {
    SCM answer;
    SCM * answer_table;
    answer = scm_make_vector (MAKINUM (9), BOOL_F);
    answer_table = VELTS (answer);
    answer_table[0] = constants;
    answer_table[1] = access;
    answer_table[2] = this;
    answer_table[3] = super;
    answer_table[4] = interfaces;
    answer_table[5] = fields;
    answer_table[6] = methods;
    answer_table[7] = attributes;
    /* 8 is a thunk that returns the containing universe of packages */
    return answer;
  }

 too_short:
  ASSERT (0, str, "premature end of string", s_parse_latte);
}




void
scm_init_lreader ()
{
  scm_make_gsubr ("parse-latte", 1, 0, 0, scm_parse_latte);

  sym_SourceFile = CAR (scm_intern0 ("SourceFile"));
  sym_ConstantValue = CAR (scm_intern0 ("ConstantValue"));
  sym_LineNumberTable = CAR (scm_intern0 ("LineNumberTable"));
  sym_LocalVariableTable = CAR (scm_intern0 ("LocalVariableTable"));
  sym_Code = CAR (scm_intern0 ("Code"));

  constant_type_names[CONSTANT_Unused0] = CAR (scm_intern0 ("Unused0"));
  constant_type_names[CONSTANT_Asciz] = CAR (scm_intern0 ("Asciz"));
  constant_type_names[CONSTANT_Unused1] = CAR (scm_intern0 ("Unused1"));
  constant_type_names[CONSTANT_Integer] = CAR (scm_intern0 ("Integer"));
  constant_type_names[CONSTANT_Float] = CAR (scm_intern0 ("Float"));
  constant_type_names[CONSTANT_Long] = CAR (scm_intern0 ("Long"));
  constant_type_names[CONSTANT_Double] = CAR (scm_intern0 ("Double"));
  constant_type_names[CONSTANT_Class] = CAR (scm_intern0 ("Class"));
  constant_type_names[CONSTANT_String] = CAR (scm_intern0 ("String"));
  constant_type_names[CONSTANT_Fieldref] = CAR (scm_intern0 ("Fieldref"));
  constant_type_names[CONSTANT_MethodRef] = CAR (scm_intern0 ("MethodRef"));
  constant_type_names[CONSTANT_InterfaceMethodref] =
    CAR (scm_intern0 ("InterfaceMethodref"));
  constant_type_names[CONSTANT_NameandType] =
    CAR (scm_intern0 ("NameandType"));
}



