Subversion Repositories tendra.SVN

/*

 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.

 * All rights reserved.

 *

 * Redistribution and use in source and binary forms, with or without

 * modification, are permitted provided that the following conditions are met:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. Neither the name of The TenDRA Project nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific, prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS

 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,

 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR

 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,

 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *

 * $Id$

 */

/*

    Copyright (c) 1993 Open Software Foundation, Inc.

    All Rights Reserved

    Permission to use, copy, modify, and distribute this software

    and its documentation for any purpose and without fee is hereby

    granted, provided that the above copyright notice appears in all

    copies and that both the copyright notice and this permission

    notice appear in supporting documentation.

    OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING

    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A

    PARTICULAR PURPOSE.

    IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR

    CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM

    LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,

    NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION

    WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

*/

/*

    		 Crown Copyright (c) 1997

    This TenDRA(r) Computer Program is subject to Copyright

    owned by the United Kingdom Secretary of State for Defence

    acting through the Defence Evaluation and Research Agency

    (DERA).  It is made available to Recipients with a

    royalty-free licence for its use, reproduction, transfer

    to other parties and amendment for any purpose not excluding

    product development provided that any such use et cetera

    shall be deemed to be acceptance of the following conditions:-

        (1) Its Recipients shall ensure that this Notice is

        reproduced upon any copies or amended versions of it;

        (2) Any amended version of it shall be clearly marked to

        show both the nature of and the organisation responsible

        for the relevant amendment or amendments;

        (3) Its onward transfer from a recipient to another

        party shall be deemed to be that party's acceptance of

        these conditions;

        (4) DERA gives no warranty or assurance as to its

        quality or suitability for any purpose and DERA accepts

        no liability whatsoever in relation to any use to which

        it may be put.

*/

#include "config.h"

#ifdef DEBUG_POWERTRANS

#include "common_types.h"

#include "exptypes.h"

#include "expmacs.h"

#include "exp.h"

#include "tags.h"

#include "shapemacs.h"

#include "ash.h"

#include "addresstypes.h"

#include "locate.h"

#include "translat.h"

#include "pp.h"

/*

 * This file contains debugging tools used in debugging a translator

 */

void properties(int);

exp show_bro(int);

exp show_son(int);

exp show_current(int);

exp show_father(int);

exp show_pt(int);

exp recurse(int);

exp infotag(exp,int);

void showme(exp,int,int);

static exp last_exp_seen=NULL;

static exp last_exp_seen1=NULL;

static exp last_exp_seen2=NULL;

static exp last_exp_seen3=NULL;

static exp last_exp_seen4=NULL;

static exp last_exp_seen5=NULL;

static void exp_show(exp,int,int,int);

char *find_test_name(exp);

static void myprint(char *);

char *shape_name(int);

char *getname(int);

void ident_props(exp);

void proc_tag_props(exp);

void general_proc_tag_props(exp);

void solve_props(exp);

void movecont_props(exp);

void cont_props(exp);

void labst_props(exp);

void name_props(exp);

void string_props(exp);

void val_props(exp);

void rep_props(exp);

void apply_props(exp);

static exp stored_idents[1000];

static exp stored_labsts[1000];

static int store_ident(exp);

static int store_labst(exp);

static int no_of_idents_stored=0;

static int no_of_labsts_stored=0;

static int ident_no(exp);

static int labst_no(exp);

static int store_ident(exp e)

{

  no_of_idents_stored++;

  stored_idents[no_of_idents_stored] =e;

  return no_of_idents_stored;

}

static int store_labst(exp e)

{

  no_of_labsts_stored++;

  stored_labsts[no_of_labsts_stored] =e;

  return no_of_labsts_stored;

}

static int ident_no(exp e)

{

  int i;

  for (i=no_of_idents_stored;i>0;i--)

    if (stored_idents[i] ==e) return i;

  return 0;

}

static int labst_no(exp e)

{

  int i;

  for (i=no_of_labsts_stored;i>0;i--)

    if (stored_labsts[i] ==e) return i;

  return 0;

}

void scan_for_labsts(exp e)

{

  if (e==nilexp)

    return;

  switch (name(e))

  {

   case labst_tag:

    store_labst(e);

    break;

   case ident_tag:

    store_ident(e);

    break;

    /* don't scan sons of these tags */

   case name_tag:

   case env_offset_tag:

    if (!last(e))scan_for_labsts(bro(e));

    return;

    /* don't scan bros of these tags */

   case case_tag:

    scan_for_labsts(son(e));

    return;

  }

  scan_for_labsts(son(e));

  if (!last(e))scan_for_labsts(bro(e));

  return;

}

void showme(exp e, int depth_of_recursion, int flag)

{

  no_of_labsts_stored=0;

  no_of_idents_stored=0;

  if (name(e) ==labst_tag)

    store_labst(e);

  if (name(e) ==ident_tag)

    store_ident(e);

  scan_for_labsts(son(e));

  exp_show(e,0,depth_of_recursion,flag);

  return;

}

exp show_current(int i)

{

  exp l;

  switch (i)

  {

   case 0:l=last_exp_seen;break;

   case 1:l=last_exp_seen1;break;

   case 2:l=last_exp_seen2;break;

   case 3:l=last_exp_seen3;break;

   case 4:l=last_exp_seen4;break;

   case 5:l=last_exp_seen5;break;

  }

  if (l==NULL)

  {

    printf("No current exp for stored exp no %d\n",i);

  }

  else

  {

    infotag(l,i);

  }

  return l;

}

exp show_bro(int i)

{

  exp l;

  switch (i)

  {

   case 0:l=last_exp_seen;break;

   case 1:l=last_exp_seen1;break;

   case 2:l=last_exp_seen2;break;

   case 3:l=last_exp_seen3;break;

   case 4:l=last_exp_seen4;break;

   case 5:l=last_exp_seen5;break;

  }

  if (l==NULL)

  {

    printf("No current exp\n");

    return NULL;

  }

  if (bro(l)!=NULL)

  {

    infotag(bro(l),i);

  }

  else

  {

    printf("No brother field to stored exp no %d\n",i);

  }

  return l;

}

exp show_son(int i)

{

  exp l;

  switch (i)

  {

   case 0:l=last_exp_seen;break;

   case 1:l=last_exp_seen1;break;

   case 2:l=last_exp_seen2;break;

   case 3:l=last_exp_seen3;break;

   case 4:l=last_exp_seen4;break;

   case 5:l=last_exp_seen5;break;

  }

  if (l==NULL)

  {

    printf("No current exp\n");

    return 0;

  }

  if (son(l)!=NULL)

  {

    infotag(son(l),i);

  }

  else

  {

    printf("No son field to stored exp no %d\n",i);

  }

  return l;

}

exp show_father(int i)

{

  exp l;

  switch (i)

  {

   case 0:l=last_exp_seen;break;

   case 1:l=last_exp_seen1;break;

   case 2:l=last_exp_seen2;break;

   case 3:l=last_exp_seen3;break;

   case 4:l=last_exp_seen4;break;

   case 5:l=last_exp_seen5;break;

  }

  if (l==NULL)

  {

    printf("No current stored exp no %d\n",i);

    return NULL;

  }

  if (father(l)!=NULL)

  {

    infotag(father(l),i);

  }

  else

  {

    printf("Cannot find father of stored exp no %d\n",i);

  }

  return l;

}

exp show_pt(int i)

{

  exp l;

  switch (i)

  {

   case 0:l=last_exp_seen;break;

   case 1:l=last_exp_seen1;break;

   case 2:l=last_exp_seen2;break;

   case 3:l=last_exp_seen3;break;

   case 4:l=last_exp_seen4;break;

   case 5:l=last_exp_seen5;break;

  }

  if (l==NULL)

  {

    printf("No current exp\n");

    return 0;

  }

  if (pt(l)!=NULL)

  {

    infotag(pt(l),i);

  }

  else

  {

    printf("No pt field to stored exp no %d\n",i);

  }

  return l;

}

exp recurse(int i)

{

  exp l;

  switch (i)

  {

   case 0:l=last_exp_seen;break;

   case 1:l=last_exp_seen1;break;

   case 2:l=last_exp_seen2;break;

   case 3:l=last_exp_seen3;break;

   case 4:l=last_exp_seen4;break;

   case 5:l=last_exp_seen5;break;

  }

  if (l==NULL)

  {

    printf("No current exp for no %d (Use infotag)\n",i);

  }

  else

  {

    showme(l,-1,1);

  }

  return l;

}

char * getname(int n)

{

  char * tagname;

  switch (n) {

   case 0                    :tagname= "zero";break;

   case ident_tag            :tagname= "ident";break;

   case seq_tag              :tagname= "seq";break;

   case cond_tag             :tagname= "cond";break;

   case labst_tag            :tagname= "labst";break;

   case rep_tag              :tagname= "rep";break;

   case goto_tag             :tagname= "goto";break;

   case test_tag             :tagname= "test";break;

   case ass_tag              :tagname= "ass";break;

   case apply_tag            :tagname= "apply";break;

   case res_tag              :tagname= "res";break;

   case goto_lv_tag          :tagname= "goto_lv";break;

   case solve_tag            :tagname= "solve";break;

   case assvol_tag           :tagname= "assvol";break;

   case compound_tag         :tagname= "compound";break;

   case nof_tag              :tagname= "nof";break;

   case local_free_all_tag   :tagname= "local_free_all";break;

   case local_free_tag       :tagname= "local_free";break;

   case last_local_tag       :tagname= "last_local";break;

   case long_jump_tag        :tagname= "long_jump";break;

   case concatnof_tag        :tagname= "concatnof";break;

   case ncopies_tag          :tagname= "ncopies";break;

   case case_tag             :tagname= "case";break;

   case movecont_tag         :tagname= "movecont";break;

   case testbit_tag          :tagname= "testbit";break;

   case alloca_tag           :tagname= "alloca";break;

   case diagnose_tag         :tagname= "diagnose";break;

   case prof_tag             :tagname= "prof";break;

   case ignorable_tag        :tagname= "ignorable";break;

   case bfass_tag            :tagname= "bfass";break;

   case bfassvol_tag         :tagname= "bfassvol";break;

   case condassign_tag       :tagname= "condassign";break;

   case apply_general_tag    :tagname= "apply_general";break;

   case tail_call_tag        :tagname= "tail_call";break;

   case untidy_return_tag    :tagname= "untidy_return";break;

   case same_callees_tag     :tagname= "same_callees";break;

   case plus_tag             :tagname= "plus";break;

   case neg_tag              :tagname= "neg";break;

   case shl_tag              :tagname= "shl";break;

   case mod_tag              :tagname= "mod";break;

   case rem2_tag             :tagname= "rem2";break;

   case abs_tag              :tagname= "abs";break;

   case round_tag            :tagname= "round";break;

   case offset_pad_tag       :tagname= "offset_pad";break;

   case offset_div_tag       :tagname= "offset_div";break;

   case offset_max_tag       :tagname= "offset_max";break;

   case minptr_tag           :tagname= "minptr";break;

   case fpower_tag           :tagname= "fpower";break;

   case fplus_tag            :tagname= "fplus";break;

   case fminus_tag           :tagname= "fminus";break;

   case fmult_tag            :tagname= "fmult";break;

   case fdiv_tag             :tagname= "fdiv";break;

   case fabs_tag             :tagname= "fabs";break;

   case fneg_tag             :tagname= "fneg";break;

   case float_tag            :tagname= "float";break;

   case chfl_tag             :tagname= "chfl";break;

   case and_tag              :tagname= "and";break;

   case or_tag               :tagname= "or";break;

   case xor_tag              :tagname= "xor";break;

   case not_tag              :tagname= "not";break;

   case component_tag        :tagname= "component";break;

   case max_tag              :tagname= "max";break;

   case min_tag              :tagname= "min";break;

   case bitf_to_int_tag      :tagname= "bitf_to_int";break;

   case bfcont_tag           :tagname= "bfcont";break;

   case fmax_tag             :tagname= "fmax";break;

   case shr_tag              :tagname= "shr";break;

   case fmin_tag             :tagname= "fmin";break;

   case div0_tag             :tagname= "div0";break;

   case bfcontvol_tag        :tagname= "bfcontvol";break;

   case absbool_tag          :tagname= "absbool";break;

   case addptr_tag           :tagname= "addptr";break;

   case chvar_tag            :tagname= "chvar";break;

   case minus_tag            :tagname= "minus";break;

   case mult_tag             :tagname= "mult";break;

   case subptr_tag           :tagname= "subptr";break;

   case realpart_tag         :tagname= "realpart";break;

   case div1_tag             :tagname= "div1";break;

   case div2_tag             :tagname= "div2";break;

   case offset_add_tag       :tagname= "offset_add";break;

   case offset_div_by_int_tag:tagname= "offset_div_by_int";break;

   case offset_mult_tag      :tagname= "offset_mult";break;

   case offset_negate_tag    :tagname= "offset_negate";break;

   case offset_subtract_tag  :tagname= "offset_subtract";break;

   case rem0_tag             :tagname= "rem0";break;

   case rotl_tag             :tagname= "rotl";break;

   case rotr_tag             :tagname= "rotr";break;

   case power_tag            :tagname= "power";break;

   case imag_tag             :tagname= "imag";break;

   case make_complex_tag     :tagname= "make_complex";break;

   case int_to_bitf_tag      :tagname= "int_to_bitf";break;

   case hold_tag             :tagname= "hold";break;

   case hold2_tag            :tagname= "hold2";break;

   case cont_tag             :tagname= "cont";break;

   case field_tag            :tagname= "field";break;

   case val_tag              :tagname= "val";break;

   case reff_tag             :tagname= "reff";break;

   case name_tag             :tagname= "name";break;

   case proc_tag             :tagname= "proc";break;

   case top_tag              :tagname= "top";break;

   case contvol_tag          :tagname= "contvol";break;

   case current_env_tag      :tagname= "current_env";break;

   case env_offset_tag       :tagname= "env_offset";break;

   case make_lv_tag          :tagname= "make_lv";break;

   case clear_tag            :tagname= "clear";break;

   case null_tag             :tagname= "null";break;

   case real_tag             :tagname= "real";break;

   case string_tag           :tagname= "string";break;

   case general_proc_tag     :tagname= "general_proc";break;

   case env_size_tag         :tagname= "env_size";break;

   case give_stack_limit_tag :tagname= "give_stack_limit";break;

   case general_env_offset_tag:tagname= "general_env_offset";break;

   case caller_tag           :tagname= "caller";break;

   case caller_name_tag      :tagname= "caller_name";break;

   case make_dynamic_callee_tag:tagname="make_dynamic_callee";break;

   case make_callee_list_tag :tagname= "make_callee_list";break;

   case set_stack_limit_tag  :tagname= "set_stack_limit";break;

   case formal_callee_tag    :tagname= "formal_callee";break;

   case trap_tag             :tagname= "trap_tag";break;

    /* Powertrans specific */

   case locptr_tag          :tagname= "locptr_tag";break;

   default                    :tagname= "undefined";

  }

  return tagname;

}

exp infotag(exp e, int i)

{

  switch (i)

  {

   case 0:last_exp_seen=e;break;

   case 1:last_exp_seen1=e;break;

   case 2:last_exp_seen2=e;break;

   case 3:last_exp_seen3=e;break;

   case 4:last_exp_seen4=e;break;

   case 5:last_exp_seen5=e;break;

  }

  if (e==nilexp) {

    printf("Error 'nilexp'\n");

    return e;

  }

  printf("-------------------------------------------------------------------------------\n");

  printf("| %-17s 0x%-8x         | SHAPE information                    |\n",getname(name(e)), (unsigned int)e);

  printf("-------------------------------------------------------------------------------\n");

  printf("| no(e)        = %-15d       ",no(e));

  if (sh(e)!=NULL)

  {

    printf("| name(sh(e))        = %-15s |\n",shape_name(name(sh(e))));

  }

  else

  {

    printf("| No shape                             |\n");

  }

  printf("| props(e)     = ");

  {

    int i;

    unsigned short mask;

    for (i=15;i>=0;i--)

    {

      mask=1<<i;

      if (mask & props(e))

      {

	printf("1");

      }

      else

      {

	printf("0");

      }

      if (i%4 == 0)

      {

	printf(" ");

      }

    }

  }

  if (sh(e)!=NULL)

  {

    printf("  | shape_size(sh(e))  = %-8d        |\n",shape_size(sh(e)));

  }

  else

  {

    printf("  |                                      |\n");

  }

  printf("| bro(e)       = 0x%-8x            ",(unsigned int)bro(e));

  if (sh(e)!=NULL)

  {

    printf("| shape_align(sh(e)) = %-8d        |",(int)shape_align(sh(e)));

  }

  else

  {

    printf("|                                      |");

  }

  if (bro(e)!=NULL)

  {

    if (last(e))

    {

      printf("-->father:%s\n",getname(name(bro(e))));

    }

    else

    {

      printf("-->brother:%s\n",getname(name(bro(e))));

    }

  }

  else

  {

    printf("-->NULL\n");

  }

  printf("| sh(e)        = 0x%-8x            ",(unsigned int)sh(e));

  if (sh(e)!=NULL)

  {

    printf("| is_signed(sh(e))   = %-2d              |\n",is_signed(sh(e)));

  }

  else

  {

    printf("|                                      |\n");

  }

  printf("| pt(e)        = 0x%-8x            ",(unsigned int)pt(e));

  if (sh(e)!=NULL)

  {

    printf("| al1(sh(e))         = %-2d              |\n",(int)al1(sh(e)));

  }

  else

  {

    printf("|                                      |\n");

  }

  printf("| last(e)      = %d                     ",last(e));

  if (sh(e)!=NULL)

  {

    printf("| al2(sh(e))         = %-2d              |\n",(int)al2(sh(e)));

  }

  else

  {

    printf("|                                      |\n");

  }

  printf("-------------------------------------------------------------------------------\n");

  if (son(e)!=nilexp)

  {

    int finished=0;

    exp point=son(e);

    if (name(e) ==name_tag)

    {

      printf("son is ident 0x%-8x\n",(unsigned int)son(e));

      return e;

    }

    printf("                |\n");

    /* first line */

    while (!finished)

    {

      finished=last(point);

      printf("------------------------------   ");

      point=bro(point);

    }

    printf("\n");

    /* second line */

    point=son(e);

    finished=0;

    while (!finished)

    {

      finished=last(point);

      printf("| %-17s0x%-8x|   ",getname(name(point)), (unsigned int)point);

      point=bro(point);

    }

    printf("\n");

    /**/

    point=son(e);

    finished=0;

    while (!finished)

    {

      finished=last(point);

      printf("------------------------------   ");

      point=bro(point);

    }

    printf("\n");

    /* new line */

    point=son(e);

    finished=0;

    while (!finished)

    {

      finished=last(point);

      printf("| no          = %-10d   |   ",no(point));

      point=bro(point);

    }

    printf("\n");

    /* new line */

    point=son(e);

    finished=0;

    while (!finished)

    {

      finished=last(point);

      printf("| pt          = 0x%-8x   |   ",(unsigned int)pt(point));

      point=bro(point);

    }

    printf("\n");

    /* third line */

    point=son(e);

    finished=0;

    while (!finished)

    {

      finished=last(point);

      if (sh(point)!=NULL)

      {

	printf("| name(sh) = %-15s |",shape_name(name(sh(point))));

      }

      else

      {

	printf("|                            |");

      }

      if (finished==0)

      {

	printf("-->");

      }