/* This file is part of cqual.
   Copyright (C) 2003 The Regents of the University of California.

   cqual 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.

   cqual 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 cqual; see the file COPYING.  If not, write to
   the Free Software Foundation, 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA. */

/* sfg: 10/29/02
As it stands right now, this port is mostly complete.  Outstanding issues:

-the flow insensitive pass

-printing locations of uses of variables (see analyze_lvalue)
 the code is there, but CIL doesn't carry the locations

-other CIL locations may not be quite right

-CIL replaces references to enum items with integers

-CIL leaves no place in its AST for qtypes, so I attach a cil_extra
 structure to an unused boolean field in some places to store qtypes and
 translated locations.  Hashing is a possible alternative (see commented
 out shadow_node code)

-This code should use the CAMLparam, CAMLlocal and CAMLreturn
 macros so that a gc won't break everything.  As it stands, we just don't
 ever call ocaml so gc can't happen.  The issue below complicates this one.

-The way the code is factored, qtype.c and other shared files are only
 compiled once.  That means that both tree walks have to use the same macros
 (i.e. not use macros in many cases) and any data structures with the same
 name have to be compatible, or better yet, used completely abstractly
 (e.g. types).  This situation is kind of messy.

-I've only recently got the regressions running in a meaningful way, so
 I haven't done  thorough testing, especially of some of the corner cases.

-some error messages are different (e.g. CIL gives back a parse error)

-var args stuff

-restrict

-magic function call

-user specified polymorphism

-readonly, confine

-anything that has a DIE (DIE is #defined as assert(0)) for its function
 body :-) (none of these DIEs seem to actually cause any of my simple test
 cases to abort) 

-anything labeled with ... or xxx in comments

*/


#define CIL_PARSER
#include "cil-ast.h"

#include "hash.h"
#include "analyze.h"
#include "cqual.h"
#include "qerror.h"
#include "qtype.h"
#include "utils.h"
#include "pam.h"
#include "effect.h"
#include "dd_list.h"
#include "flags.h"

#include "user-qual.h"
#include "common-analyze.h"

#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/callback.h>

#include <string.h>
#include <stdio.h> /* only for dump_value && debugging */


/****************************************************************/

#define myerror printf
#define DIE assert(0);

extern region parse_region;
extern hash_table globals;
extern effect global_env;
extern effect global_effect;

//extern type mk_type2(int tag, int f1);

/****************************************************************
 *
 * function prototypes
 *
 ****************************************************************/

/*xxx these probably belong in a header */
extern bool type_function(type);
extern bool type_array(type);
extern bool type_union(type);
extern bool type_struct(type);
extern bool type_aggregate(type);
extern cil_attributes type_attr(type);
extern type make_pointer_type(type);
extern type make_dummy_number_type(int tag, value kind);

void analyze(declaration);
static dinfo analyze_global(cil_global, effect, dd_list);
static dinfo analyze_vardecl(cil_location, varinfo, cil_init*, bool isglobal, effect, dd_list);
static sinfo analyze_init(location, qtype, cil_init, effect, dd_list);
static sinfo analyze_block(cil_block, effect, dd_list);
static sinfo analyze_stmt(cil_stmt, effect, dd_list);
static sinfo analyze_instr(cil_instr, effect, dd_list);
static einfo analyze_exp(location, cil_exp, context, effect, dd_list);
static einfo analyze_lval(location, cil_lval, context, effect, dd_list);
static einfo follow_offset(location loc, cil_offset off, context context, qtype qt, effect eff, effect env, dd_list drinfolist, bool structptr);
static void analyze_enuminfo(enuminfo ei);

static void init_magic();
/*static einfo analyze_magic_function_call(const char *fname, qtype fqt,
					 location floc, effect arg_eff,
                                         effect env, dd_list
                                         drinfolist);
*/
static bool magic_change_or_assert_type(struct Call*, location,
					 effect, dd_list, sinfo*);


bool is_exp_string(cil_exp e);
bool is_lval_function(cil_lval lv);
bool definite_null(cil_exp e);

static inline operator find_unary_op_kind(cil_unop_tag k);
static inline operator find_binary_op_kind(cil_binop_tag k);

static void add_varinfo_overlay(varinfo vi);
/* static void add_fieldinfo_overlay(fieldinfo fi); */

/* cil_typ unroll_type_deep(cil_typ t); */
static qtype add_cildecl_qtype(type, location loc, const char *name, bool is_enum);
static inline location location_from_cil_location(region r, const cil_location cloc);
static inline qtype cur_function_qtype(void);
static qtype cur_return_qtype(void);
qual cur_function_qual(void);


/************************************************************************
 *
 * The cil ast doesn't have everything we need, so we attach extras to
 * varinfos and compinfos
 * 
 * The commented code is for keeping a hash table, keyed on pointers to 
 * the CIL ast.  It's a nasty hack that gc would break.  It's not used.
 *
 ************************************************************************/
/*
static hash_table shadow_ast;

typedef struct {
  qtype    qtype;
  location loc;
} *shadow_node;

static region shadow_ast_region;

#define SHADOW_AST_SIZE (1024*16)

unsigned long shadow_node_hash_fn(hash_key k)
{
  return ((unsigned long)k >> 2) % (SHADOW_AST_SIZE);
}

bool shadow_node_keyeq(hash_key k1, hash_key k2)
{
  return k1 == k2;
}

static void init_shadow_ast()
{
  shadow_ast_region = parse_region;
  shadow_ast = make_hash_table(shadow_ast_region, 
			       SHADOW_AST_SIZE, 
			       shadow_node_hash_fn,
			       shadow_node_keyeq);
}


static inline shadow_node get_shadow_node(hash_key key)
{
  shadow_node result;
  hash_table_lookup(shadow_ast, key, (hash_data*) &result);
  return result;
}

static inline void store_shadow_node(hash_key key, hash_data sn)
{
  hash_table_insert(shadow_ast, key, sn);
}
*/


static void vi_attach_extra(varinfo vi, qtype qt, location loc)
{
  if ( extra_null(vi->extra) ) /* make this fn idempotent */
    {
      assert( vi->extra = ralloc(parse_region, struct cil_extra) );
      vi->extra->loc = loc;
      vi->extra->qtype = qt;
    }
}

static inline location vi_get_loc(varinfo vi)
{
  assert(!extra_null(vi->extra));
  return vi->extra->loc;
}
static inline qtype vi_get_qtype(varinfo vi)
{
  assert(!extra_null(vi->extra));
  return vi->extra->qtype;
}
static inline void vi_update_qtype(varinfo vi, qtype qt)
{
  assert(!extra_null(vi->extra)); /* rule out Val_int(1) etc */
  vi->extra->qtype = qt;
}

static void ci_attach_extra(compinfo ci, qtype qt, location loc)
{
  if ( extra_null(ci->extra) ) /* make this fn idempotent */
    {
      assert( ci->extra = ralloc(parse_region, struct cil_extra) );
      ci->extra->loc = loc;
      ci->extra->qtype = qt;
    }
}
/*
static inline location ci_get_loc(compinfo ci)
{
  assert(!extra_null(ci->extra));
  return ci->extra->loc;
}
*/
static inline qtype ci_get_qtype(compinfo ci)
{
  assert(!extra_null(ci->extra));
  return ci->extra->qtype;
}
static inline void ci_update_qtype(compinfo ci, qtype qt)
{
  assert(!extra_null(ci->extra));
  ci->extra->qtype = qt;
}


/* enum items still use the awful hash table hack */
/* ...or they would if there was any reason to keep them around
 * CIL convert uses of enum items to integers */
/*
static void ei_new_shadow_node(cil_enumitem ei, qtype qt, location loc)
{
  shadow_node result;
  assert( result = ralloc(shadow_ast_region, shadow_node) );
  result->loc = loc;
  result->qtype = qt;
  store_shadow_node(ei, result);
}
static inline qtype ei_get_qtype(cil_enumitem ei)
{
  shadow_node sn;
  sn = get_shadow_node(ei);
  return sn ? sn->qtype : NULL;
}
static inline void ei_update_qtype(cil_enumitem ei, qtype qt)
{
  shadow_node sn;
  
  sn = get_shadow_node(ei);
  if (sn == NULL)
    ei_new_shadow_node(ei, qt, NULL);
  else 
    {
      sn->qtype = qt;
      store_shadow_node(ei, sn);
    }
}
*/

/****************************************************************
 *
 * debugging stuff
 *
 ****************************************************************/

void print_indent(int indent)
{
  int i;
  for(i=0; i<indent; i++) 
    putchar(' ');
}

void dump_value(value v, int indent)
{
  CAMLparam1(v);
  int i;
  caml__dummy_v = caml__dummy_v;
  putchar('\n');
  print_indent(indent);
 
  if (Is_long(v)) {
    printf("integer: %d", Int_val(v));
  } 
  else if (v == (value)0) {
    printf("<<null value>>");
  }
  else if (Tag_val(v) == Custom_tag) {
    printf("<<custom tag length:%ld>>", Wosize_val(v));
  }
  else if (Tag_val(v) == String_tag) {
    printf("(string length:%ld) '%s'", Wosize_val(v), String_val(v));
  }
  else if (Tag_val(v) == Closure_tag) {
    printf("<closure>\n");
  }
  else if (Is_block(v) && Tag_val(v) < No_scan_tag) { 
    {
      printf("(block tag:%d length:%ld)", Tag_val(v), Wosize_val(v));
      for(i=0; i<Wosize_val(v); i++) {
	dump_value(Field(v, i), indent+3);
      }
    }
  } 
  else {
    printf("<<none of the above>>");
  }    

  CAMLreturn0;
}

void dump_cil_list(value l, int indent)
{
  value h;
  cil_list iter;

  cil_scanlist(h, iter, (cil_list)l) 
    {
      //printf(":: ");
      if (h>1)
	dump_value(*((value*)h), indent+3);
    }
  //printf("::NIL");
}

/* print a CIL type */
void print_cil_type(cil_typ t)
{
  switch (Tag_val(t))
    {
    case TVoid:
      {
	printf("<void>");
	dump_cil_list((value)(t->tvoid.attr), 3);
	break;
      }
    case TInt:
      {
	printf("int");
	dump_cil_list((value)(t->tint.attr), 3);
	break;
      }
    case TFloat:
      {
	printf("float");
	dump_cil_list((value)(t->tfloat.attr), 3);
	break;
      }
    case TPtr:
      {
	printf(" *");
	dump_cil_list((value)(t->tptr.attr), 3);
	print_cil_type(t->tptr.ptsto);
	break;
      }
    case TArray:
      {
	print_cil_type(t->tarray.arrayof);
	printf(" []");
	dump_cil_list((value)(t->tarray.attr), 3);
	break;
      }
    case TFun:
      {
	cil_formal formal;
	cil_formal_list iter;
	printf("( (");
	if (t->tfun.args != NIL)
	  cil_scanlist(formal, iter, *(t->tfun.args))
	  {
	    print_cil_type(formal->type);
	    printf(", ");
	  }
	printf(") -> ");
	print_cil_type(t->tfun.rettype);
	printf(")");
	dump_cil_list((value)(t->tfun.attr), 3);

	break;
      }
    case TNamed:
      {
	printf("<named...>");
	//printf(" [ ");
	dump_cil_list((value)(t->tnamed.attr), 3);
	//printf(" ] ");
	break;
      }
    case TComp:
      {
	compinfo ci = CIL_CHECK_VAL(compinfo, t->tcomp.ci);
	if (type_struct(t))
	  printf("struct");
	else if (type_union(t))
	  printf("union");
	printf(" %s", String_val(ci->cname));
	//printf(" [ ");
	dump_cil_list((value)(t->tcomp.attr), 3);
	//printf(" ] ");
	break;
      }
    case TEnum:
      {
	enuminfo ei = CIL_CHECK_VAL(enuminfo, t->tenum.ei);
	printf("enum %s", String_val(ei->ename));
	//printf(" [ ");
	dump_cil_list((value)(t->tenum.attr), 3);
	//printf(" ] ");
	break;
      }
    case TBuiltin_va_list:
      {
	printf("<builtin va list...>");
	//printf(" [ ");
	dump_cil_list((value)(t->tbuiltin_va_list.attr), 3);
	//printf(" ] ");
	break;
      }
    default:
      printf("Unexpected tag on cil_type: %d\n", Tag_val(t));
    }
}

/* easy to call from gdb */
void pp(cil_typ t)
{
  printf("\n\n");
  print_cil_type(t);
  printf("\n\n");
}




/***************************************************************
 *
 * the tree walk: analyze_* functions and init_ and finish_analyze
 *
 ***************************************************************/
cil_fundec current_function_decl;

/*dd_list definitions; 
  used in analyze.c to check for fns that are declared but not defined */

void init_analyze() 
{
  current_function_decl = NULL;

  /* init_shadow_ast(); */
  init_magic();

  global_effect = effect_var("<global>");
  global_env = effect_var("<global-alocs>");

}

void finish_analyze() 
{
  /* free shadow_ast?? */

  /*xxx check for fns that declared but not defined */
}


void analyze(declaration program)
{
  CAMLparam1(program);
  cil_global g;
  cil_global_list gl;
  dinfo next_info;
  dd_list global_drinfolist;
  cil_file prog = CIL_CAST(cil_file, program);

  caml__dummy_program = caml__dummy_program; /* supress warning */

  /* debug */
  /* dump_value(program, 0);
     printf("\n\n"); 
   */

  global_drinfolist = dd_new_list(parse_region);
  pam_add_file(String_val(prog->filename));

  cil_scanlist(g, gl, prog->globals)
    {
      next_info = analyze_global(g, global_env, global_drinfolist);
      mk_effect_leq_global_effect(next_info.eff);
      mk_effect_leq_global_env(next_info.alocs);
    }

  CAMLreturn0;
}


static dinfo analyze_global(cil_global g, effect env, dd_list drinfolist)
{
  switch(Tag_val(g)) 
    {
    case GType: /* a typedef */
      return mkdinfo(effect_empty, effect_empty);

    case GEnumTag: /* an enumeration tag (type) with fields */
      {
	enuminfo ei = CIL_CHECK_VAL(enuminfo, g->genumtag.ei);
	analyze_enuminfo(ei);
	return mkdinfo(effect_empty, effect_empty);
      }
      
    case GEnumTagDecl: /* enumeration type forward declaration */
      return mkdinfo(effect_empty, effect_empty);

    case GCompTag: /* a struct or union with fields */
      /* could give all the fields qtypes here, but like 
         analyze.c::analyze_tag_ref, we don't
         we do allocate a shadow node and put the loc into it
      */
      {
        compinfo ci = CIL_CHECK_VAL(compinfo, g->gcomptag.ci);
        cil_location cloc = CIL_CHECK_VAL(cil_location, g->gcomptag.loc);
        location loc = location_from_cil_location(parse_region, cloc);
        
        ci_attach_extra(ci, NULL, loc);
        return mkdinfo(effect_empty, effect_empty);
      }

    case GCompTagDecl: /* struct/union forward declaration */
      {
        compinfo ci = CIL_CHECK_VAL(compinfo, g->gcomptag.ci);
        cil_location cloc = CIL_CHECK_VAL(cil_location, g->gcomptag.loc);
        location loc = location_from_cil_location(parse_region, cloc);
        
	/* sfg: need to allocate the "extra" here so we can be sure it's around later*/
        ci_attach_extra(ci, NULL, loc);
        return mkdinfo(effect_empty, effect_empty);
      }
    case GVarDecl: /* variable forward declaration, includes fn decls */
      {
	varinfo vi = CIL_CHECK_VAL(varinfo, g->gvardecl.vi);
	cil_location cloc = CIL_CHECK_VAL(cil_location, g->gvardecl.loc);

	return analyze_vardecl(cloc, vi, NONE, TRUE, env, drinfolist);
      }

    case GVar:  /* a variable definition, can include an initialization */
      {
	varinfo vi = CIL_CHECK_VAL(varinfo, g->gvar.vi);
	cil_location cloc = CIL_CHECK_VAL(cil_location, g->gvar.loc);
	cil_init *init = g->gvar.init;

	return analyze_vardecl(cloc, vi, init, TRUE, env, drinfolist);
      }

    case GFun:	/* a function definition */
      {
	cil_fundec fundec = CIL_CHECK_VAL(cil_fundec, g->gfun.fd);
	varinfo vi = CIL_CHECK_VAL(varinfo, fundec->svar);
	cil_fundec old_function_decl;

	/* could also get the loc from fn's varinfo (vi) */
	cil_location cloc = CIL_CHECK_VAL(cil_location, g->gfun.loc); 
	location loc = location_from_cil_location(parse_region, cloc);
	qtype ret_qtype, fqtype;
	effect param_rtype_alocs; /* alocs in params */
	effect alocs, local_env, eff;

	/* debug: print info for each fn defined */
	/* printf("<<<fundef %s : ", String_val((fundec->svar->vname)));
	 * print_cil_type(fundec->svar->vtype);
	 * printf(">>>\n");
	 */

	/* give the function a qtype */
	fqtype = add_cildecl_qtype(vi->vtype, loc, String_val(vi->vname), FALSE /*is_enum*/);
	vi_attach_extra(vi, fqtype, loc);

	/*prelude */
	/* polymorphic defn for fn in prelude */
	/*xxx...*/	    

	alocs = alocs_qtype(fqtype);
        
        /* add PAM markup for function name */
        if (flag_pam_mode || flag_print_results)
          add_varinfo_overlay(vi);        

	old_function_decl = current_function_decl;
	current_function_decl = fundec;
	ret_qtype = return_qtype(fqtype);
	/* add effect of "allocating" this fn */
	mk_effect_leq_global_effect(effect_qtype(fqtype));
	
	/* 2p: Add effect of allocation the function to the global effect */
        mk_effect_leq_global_effect(defn_effect_qtype(fqtype));


	local_env = env;
	eff = effect_empty;
        param_rtype_alocs = effect_empty;

	/* scan formals */
	{
	  varinfo_list iter;
	  varinfo arg_vi;
	  qtypelist_scanner old_qtypes;
	  int i;

	  i=1;
	  qtypelist_scan(arg_qtypes(fqtype), &old_qtypes);

	  cil_scanlist(arg_vi, iter, fundec->sformals) 
	    {
	      qtype old_qtype, arg_qt, larg_qt;
              cil_location argcloc = CIL_CHECK_VAL(cil_location, arg_vi->vdecl);
	      location argloc = location_from_cil_location(parse_region, argcloc);
	      	      	      
	      /* new left qtype for param, unify its right type with declared type */
	      larg_qt = add_cildecl_qtype(arg_vi->vtype, argloc, String_val(arg_vi->vname), FALSE);
	      vi_attach_extra(arg_vi, larg_qt, argloc);
	      arg_qt = points_to_qtype(larg_qt); /*sfg: rval type for local we just created*/
	      old_qtype = qtypelist_next(&old_qtypes); /*sfg: the declared type*/

	      if (old_qtype && unify_qtype(argloc, old_qtype, arg_qt))
		report_qerror(argloc, sev_err, PARAM_TYPE_NO_MATCH_d, i);
	      else if (!old_qtype)
		report_qerror(argloc, sev_err, PARAM_NO_APPEAR_d, i);
	      /*sfg: declare w/o qual, define induce qual, need to complain*/

	      if (old_qtype)
		param_rtype_alocs = effect_union(param_rtype_alocs,
						 alocs_qtype(old_qtype));

	      /* 2p:  Add the effect of allocating space for parameter */
	      eff = effect_union(eff, defn_effect_qtype(larg_qt));
	      /*sfg: eff is effect for fn*/

	      /*sfg: local_env used for checking restrict (and other stuff) - adds all abs locs appearing in type to env -- env vars in restrict ech report */
	      local_env = effect_union(local_env,
				       alocs_qtype(larg_qt));
	      /*xxx... restrict stuff */

              /* add PAM markup for formal parameter */
              if (flag_pam_mode || flag_print_results)
                add_varinfo_overlay(arg_vi);
              
	      i++;
	    }

	  if (qtypelist_next(&old_qtypes))
            report_qerror(loc, sev_err, 
			  INCONSISTENT_NUM_ARGS_s, 
                          String_val(vi->vname));
	}

	/* handle declarations (CIL puts decls of all locals with
	   the fundec) */ 
	{
	  varinfo local;
	  varinfo_list iter;
	  cil_scanlist(local, iter, fundec->slocals)
	    {
	      dinfo next;
	      next = analyze_vardecl(cloc, local, NONE, FALSE, local_env, drinfolist);
	      eff = effect_union(eff, next.eff); /*??? is this what I want?*/
	      local_env = effect_union (local_env, next.alocs);
	    }
	}

	/* do body */
	{
	  sinfo body;
	  body = analyze_block(fundec->sbody, local_env, drinfolist);
	  eff = effect_union(eff, body.eff);
	  /* eff = effect_union(eff,
		  	        enforce_restricts(?, 
			                          body.eff,
			                          ret_qtype));
	     enforce_readonly(??, eff);*/
	}
	/* apply Down to filter locations that appear in neither
	   parameters (param_rtype_alocs) nor return values */
	/*xxx...*/

	current_function_decl = old_function_decl;
	return mkdinfo(effect_empty, alocs);
      };

    case GPragma: /* fallthru */
    case GText:   /* fallthru */
    case GAsm:
      {
	return mkdinfo(effect_empty, effect_empty);
      };
    default:
      myerror("Unexpected tag on global %d\n", Tag_val(g));
      return mkdinfo(effect_empty, effect_empty);
    }
}

/* declaration for variable with or without initializer, 
 * also handles declartion of a fn */
static dinfo analyze_vardecl(cil_location fooloc /*ignored*/, varinfo vi, 
			     cil_init * /*option*/ init, 
			     bool isglobal, effect env, dd_list drinfolist)  
{
	effect eff, alocs;
	qtype qt;
	cil_location cloc = CIL_CHECK_VAL(cil_location, vi->vdecl);
	location loc = location_from_cil_location(parse_region, cloc);

	/* ignore CIL generated prototypes for change_type and
	   assert_type if they appear */
	if ( !strcmp(String_val(vi->vname), "change_type")
	     || !strcmp(String_val(vi->vname), "assert_type") )
	  return mkdinfo(effect_empty, effect_empty);

	eff = effect_empty;
	alocs = effect_empty;

	/* debug: print info for each declared variable */
	/*printf("%s[%ld]:%ld:  variable << %s : ", 
               loc->filename, loc->filepos, loc->lineno, String_val(vi->vname));
        print_cil_type(vi->vtype);
        printf(" >>\n");
	*/

	/* give it a qtype */
	qt = add_cildecl_qtype(vi->vtype, loc, String_val(vi->vname), FALSE);
	vi_attach_extra(vi, qt, loc);

	if (isglobal)
	  {
	    /* add alocs from this qtype to global effects */
	    mk_effect_leq_global_env(alocs_qtype(qt));
	    mk_effect_leq_global_effect(defn_effect_qtype(qt));
	  }
	else 
	  {
	    alocs = effect_union(alocs_qtype(qt), alocs);
	    eff = effect_union(defn_effect_qtype(qt), eff);
	  }

	/* handle restrict */
	/* tachio sez: ignore readonly */

	/* analyze initializer if any */
	if (init != NONE)
	  {
	    sinfo arg1;
	    qtype init_qt;

	    /*xxx some restrict stuff should happen here*/
	    init_qt = qt;

	    if (!qtype_array(init_qt))
              init_qt = points_to_qtype(init_qt);

	    arg1 = analyze_init(loc, init_qt, *init, env, drinfolist);
	    if (isglobal)
	      eff = effect_union(eff, arg1.eff);
	  }
	/* If we restricted this loc, replace its qtype with its
           restricted qtype, which we'll see from now on ...*/

        /* If attribute alias, unify aliased qtype ...*/

	/* set sleepy qual ...*/

	/* add PAM markup for variable declaration */
        if (flag_pam_mode || flag_print_results)
          add_varinfo_overlay(vi);

        /*
          printf("Effect of declaring %s: ", String_val(vi->vname));
          print_effect(printf, eff);
          printf("\n");
        */

	return mkdinfo(eff, alocs);
}


static sinfo analyze_block(cil_block b, effect env, dd_list drinfolist)
{
  cil_stmt stmt;
  cil_stmt_list iter;
  effect eff, local_env;
  dd_list new_drinfolist, old_drinfolist;
  
  old_drinfolist = drinfolist;
  new_drinfolist = dd_copy(parse_region, drinfolist);
  /*enc */
  assert(Wosize_val(b) == 2);

  eff = effect_empty;
  local_env = env;

  /* no decls to analyze - CIL pushes them up to the fundef */

  /* analyze the statements, gathering up the effects */
  cil_scanlist(stmt, iter, b->bstmts)
    {
      sinfo next = analyze_stmt(stmt, local_env, new_drinfolist);
      eff = effect_union(eff, next.eff);
    }

  /* add constraints from effects -- seems to be related to decls */
  /*  eff = enforce_restricts(?, eff, NULL);
   * enforce_readonly(?, eff);
   */

  /* handle deep restricts */
  /*dr */

  return mksinfo(eff);
}


static sinfo analyze_stmt(cil_stmt stmt, effect env, dd_list drinfolist)
{
  switch(Tag_val(stmt->skind)) 
    {
    case Block:
      {
	return analyze_block(&stmt->skind->sblock, env, drinfolist);
      }

    case Instr:
      {
	/* a list of "instructions" - statements with no control flow 
	 * handled much like a block */
	cil_instr instr;
	cil_instr_list iter;
	effect eff, local_env;
	dd_list new_drinfolist, old_drinfolist;
		
	old_drinfolist = drinfolist;
	new_drinfolist = dd_copy(parse_region, drinfolist);
	eff = effect_empty;
	local_env = env;
		
	assert(Wosize_val(stmt->skind) == 1);
	cil_scanlist(instr, iter, stmt->skind->sinstr)
	  {
	    sinfo next;

	    next = analyze_instr(instr, local_env, new_drinfolist);
	    eff = effect_union(eff, next.eff);
	  }
		
	/*dr deal with deep restricts */
		
	return mksinfo(eff);
      }

    case Return:
      {
	struct Return *rs = CIL_CHECK_VAL(Return, &stmt->skind->sreturn);
	cil_location cloc = CIL_CHECK_VAL(cil_location, rs->loc);
	location loc = location_from_cil_location(parse_region, cloc);
	qtype ret_qtype;
	effect eff;

	ret_qtype = cur_return_qtype();
	eff = effect_empty;

	if (rs->exp != NONE) 
	  {
	    einfo arg;

	    arg = analyze_exp(loc, *(rs->exp), rpos, env, drinfolist);
	    eff = effect_union(eff, arg.eff);
	    if (mkleq_assign_convert(loc, arg.qt, ret_qtype))
	      report_qerror(loc, sev_err, BAD_RETURN);
	  }

	return mksinfo(eff);
      }	 

    case Goto:
      {
	CIL_CHECK(Goto, &stmt->skind->sgoto);
	return mksinfo(effect_empty);
      }	 
	  
    case Break:
      {
	assert(Wosize_val(&stmt->skind->sbreak) == 1);
	/*enc */
	return mksinfo(effect_empty);
      }	 
	  
    case Continue:
      {
	assert(Wosize_val(&stmt->skind->scontinue) == 1);
	/*enc */
	return mksinfo(effect_empty);
      }	 
	
    case If:
      {
	struct If *is = CIL_CHECK_VAL(If, &stmt->skind->sif);
	cil_location cloc = CIL_CHECK_VAL(cil_location, is->loc);
	location loc = location_from_cil_location(parse_region, cloc);
	einfo guard;
	sinfo then, els;
	effect eff;

	guard = analyze_exp(loc, is->pred, rpos, env, drinfolist);
	then = analyze_block(is->block1, env, drinfolist);
	eff = effect_union(guard.eff, then.eff);
	els = analyze_block((is->block2), env, drinfolist);
	eff = effect_union(eff, els.eff);

	return mksinfo(eff);
      }	 
	  
    case Switch:
      {
	struct Switch *ss = CIL_CHECK_VAL(Switch, &stmt->skind->sswitch);
	cil_location cloc = CIL_CHECK_VAL(cil_location, ss->loc);
	location loc = location_from_cil_location(parse_region, cloc);
	einfo guard;
	sinfo body;
	effect eff;

	/*enc */

	guard = analyze_exp(loc, ss->condition, rpos, env, drinfolist);
	body = analyze_block(ss->body, env, drinfolist);
	eff = effect_union(guard.eff, body.eff);

	return mksinfo(eff);
      }	 
	  
    case Loop:
      {
	struct Loop *ls = CIL_CHECK_VAL(Loop, &stmt->skind->sloop);

	/*enc */

	return analyze_block(ls->body, env, drinfolist);
      }	 
	  
    default:
      myerror("Unexpected tag on stmt %d\n", Tag_val(stmt));
      return mksinfo(env);
    }
}


static sinfo analyze_instr(cil_instr instr, effect env, dd_list drinfolist)
{
  switch(Tag_val(instr)) 
    {
    case Set:
      {
	struct Set *ss = CIL_CHECK_VAL(Set, &instr->iset);
	cil_location cloc = CIL_CHECK_VAL(cil_location, ss->loc);
	location loc = location_from_cil_location(parse_region, cloc);
	effect eff;
	einfo lhs, rhs, einf;

	lhs = analyze_lval(loc, ss->lhs, lpos, env, drinfolist);
	rhs = analyze_exp(loc, ss->rhs, rpos, env, drinfolist);
	eff = effect_union(lhs.eff, rhs.eff);

	if (qtype_error(lhs.qt) || qtype_error(rhs.qt))
	  return mksinfo(eff); 

	einf = do_assign(lhs, rhs, loc, eff);

	return mksinfo(einf.eff);
      }

    case Call:
      {
	struct Call *cs = CIL_CHECK_VAL(Call, &instr->icall);
	cil_location cloc = CIL_CHECK_VAL(cil_location, cs->loc);
	location loc = location_from_cil_location(parse_region, cloc);
	einfo f_info;//, magic_info;
	sinfo magic_ca_info;
	qtype fqt;
	qtypelist args;
	qtypelist_scanner args_qs;
	int i;
	effect eff;

	/* check to see if this is a change or assert type */
	if ( magic_change_or_assert_type(cs, loc, env, drinfolist, &magic_ca_info) )
	  return magic_ca_info;
	

	/* Extract the function type of the expr in fun posn.  Note
	   that arg1 must be a pointer to a function.  From C9X:
	   
	   [#1]  The  expression  that  denotes  the called function
	   shall have  type  pointer  to  function  returning  void  or
	   returning an object type other than an array type. */
	
	/* xxx varargs stuff */
	//assert(context == rpos);
	/* special case for call to __builtin_va_arg */
	//      if (fc->va_arg_call)
	// {
	//  qtype va_arg_qtype;
	//
	//  /* Magic call to __builtin_va_arg(args, fc->va_arg_call) */
	//  va_arg_qtype = type_to_qtype(fc->va_arg_call->type,
	//                               "_va_arg",
	//                               loc);
	//
	//  result = mkeinfo(va_arg_qtype, effect_empty, FALSE);
	//  break;
	//}

	f_info = analyze_exp(loc, cs->f, rpos, env, drinfolist);
	fqt = points_to_qtype(f_info.qt);
	args = arg_qtypes(fqt);

	//magic_info = analyze_magic_function_call(, fqt, env, drinfolist);
	//if (magic_info.qt)
	//  {
	//    magic_info.eff = effect_union(f_info.eff, magic_info.eff);
	//    result = magic_info;
	//    break;
	//  }

	eff = effect_union(f_info.eff, effect_qtype(fqt));

	{
	  cil_exp arg;
	  cil_exp_list iter;

	  /* Analyze each actual argument, making a constraint with the
	     corresponding formal paramter */
	  qtypelist_scan(args, &args_qs);      
	  i = 1;

	  cil_scanlist(arg, iter, cs->args)
	  {
	    einfo arg_info;
	    qtype formal_qt;
	    bool warned_oldstyle;
	  
	    arg_info = analyze_exp(loc, arg, rpos, env, drinfolist);
	    eff = effect_union(eff, arg_info.eff);
	    formal_qt = qtypelist_next(&args_qs);
	    warned_oldstyle = FALSE;
	  
	    if (!formal_qt)
	      {
		if (!qtype_varargs(fqt) && !qtype_oldstyle(fqt))
		  report_qerror(loc, sev_err, TOO_MANY_ACTUAL_ARGS);
				

		/* If func is varargs, then only add constraints if func
		   has a varargs qualifier. */
		if (qtype_varargs(fqt) && vqual_qtype(fqt))
		  {
		    qual vq;

		    vq = vqual_qtype(fqt);
		    if (varargs_constrain_quals_qtype(loc,
						      arg_info.qt, vq))
		      report_qerror(loc, sev_err, 
				    ACTUAL_NOMATCH_VARARGQ_d, i);
		  }
	      }
	    else
	      if (mkleq_assign_convert(loc, arg_info.qt, formal_qt))
		report_qerror(loc, sev_err, ACTUAL_NOMATCH_FORMAL_d, i);
	    i++;
	  }
	}
	if (qtypelist_next(&args_qs))
	  user_error_loc(loc, TOO_FEW_ACTUAL_ARGS, 0);
      
	/* the fn return value is assigned here */
	if (cs->ret != NONE)
	  {
	    einfo ret_info;
	    ret_info = analyze_lval(loc, *(cs->ret), lpos, env, drinfolist);
	    eff = effect_union(eff, ret_info.eff);
	    eff = (do_assign(ret_info, f_info, loc, eff)).eff;
	  }
      
	return mksinfo(eff);
      }
	  
    case Asm:
      {
	CIL_CHECK(Asm, &instr->iasm);
	return mksinfo(effect_empty);
      }

    default:
      {
	myerror("Unexpected tag on instruction: %d\n", Tag_val(instr));
	return mksinfo(effect_empty);
      }
    }
}

static einfo analyze_exp(location loc, cil_exp exp, context context,
			 effect env, dd_list drinfolist)
{

  /*dr - lots of deep restrict stuff to deal with */

  switch(Tag_val(exp))
    {
    case Const: 
      {
	cil_const c = exp->econst;
	qtype qt;
	type t;
	assert(context == rpos);

	switch(Tag_val(c))
	  {
	  case CStr:
	      {
		/* Could use string name -- see string_to_charp */
		qtype points_to;
		aloc aloc;
		
		points_to = mkqtype_char(make_qvar("__string_p", loc, FALSE,TRUE));
		aloc = make_aloc("__string", points_to,TRUE);
		mk_effect_leq_global_env(effect_single(aloc));
		qt = mkqtype_pointer(make_qvar("__string", loc, FALSE,TRUE),
				     points_to,
				     aloc);

		/* Add effect of allocating this string to the global effect. */
		mk_effect_leq_global_effect(effect_alloc(aloc));
		
		return mkeinfo(qt, effect_empty, FALSE);
	      };
	    break;

	    /* ugly: cil doesn't directly attach types to constants,
	       so we use a dummy type in order to use type_to_qtype 
	    */
	
	  case CInt64: 
	    {
	      t = make_dummy_number_type(TInt, c->cint64.kind);
	    }
	    break;
	  case CChr:
	    {
	      t = make_dummy_number_type(TInt, Val_int(IChar));
	    }
	    break;
	  case CReal:
	    {
	      t = make_dummy_number_type(TFloat, c->creal.kind);
	    }
	    break;
	    
	  default:
	    myerror("Unexpected tag on constant: %d\n", Tag_val(c));
	    assert(0);
	  }
	/* If you assign a special type to the constant ``1'', also
	   modify pre/post inc/decrement.
	   If you assign a special type to the constant ``0'', also
	   modify mkleq_assign_convert.
	*/
  
	qt = type_to_qtype(t, "__cst", loc);

	return mkeinfo(qt, effect_empty, FALSE);
      }
    case Lval: 
      {
	cil_lval lv = exp->elval;
	return analyze_lval(loc, lv, context, env, drinfolist);
      }
    case UnOp: 
      {
	cil_exp e = exp->eunop.e;
	cil_unop_tag tag = exp->eunop.tag;
	operator op;

	assert(context == rpos);
	
	op = find_unary_op_kind(tag);  /* Look up the signature of this operator */

	switch (tag)
	  {
	  case Neg:  /* fallthru */
	  case BNot:
	    {
	      /* these ops do not change types */
	      return analyze_exp(loc, e, rpos, env, drinfolist);	      
	    }
	  case LNot:
	    {      
	      einfo arg1;
	      qtype qt;

	      arg1 = analyze_exp(loc, e, rpos, env, drinfolist);
	      qt = mkqtype_bool(make_qvar("!", loc, FALSE,FALSE));
	      return mkeinfo(qt, arg1.eff, FALSE);
	    }
	  default:
	    {
	      myerror("Unexpected tag on UnOp: %d\n", tag);
	      assert(0);
	    }
	  }
      }

    case BinOp: /* xxx... it seems like I should be checking compatibility
		   with these operators */
      {
	cil_exp e1 = exp->ebinop.e1;
	cil_exp e2 = exp->ebinop.e2;
	cil_binop_tag tag = Int_val(exp->ebinop.tag);

	einfo arg1, arg2;
	operator op;
	effect eff;
	qtype qt;
	
	assert(context == rpos);
	op = find_binary_op_kind(tag);  /* Look up the signature of this operator */
	arg1 = analyze_exp(loc, e1, rpos, env, drinfolist);
	arg2 = analyze_exp(loc, e2, rpos, env, drinfolist);
	eff = effect_union(arg1.eff, arg2.eff);
	
	if (qtype_error(arg1.qt) || qtype_error(arg2.qt))
	  return mkeinfo(error_qtype, eff, FALSE);

	switch (tag)
	  {
	   case PlusA:
	   case MinusA:
	   case Mult:
	   case Div:
	   case BAnd:
	   case BXor:
	   case BOr:
	     if (mkeq_qtype(loc, arg1.qt, arg2.qt))
	       report_qerror(loc, sev_err, INCOMPAT_OP_s, "+-*/&|^"); /*...*/
	     return mkeinfo(arg1.qt, eff, FALSE);

	   case PlusPI:
	   case IndexPI: /* semantically same as PlusPI (see cil.mli) */
	   case MinusPI:
	     return mkeinfo(arg1.qt, eff, FALSE);

	   case MinusPP:
	     qt = mkqtype_ptrdiff_t(make_qvar("__ptr diff", loc, FALSE,FALSE));
	     return mkeinfo(qt, eff, FALSE);

	   case Mod:
	   case Shiftlt:
	   case Shiftrt:
	     return mkeinfo(arg1.qt, eff, FALSE);

	   case Lt:
	   case Gt:
	   case Le:
	   case Ge:
	     return do_boolop(loc, TRUE, definite_null(e1), definite_null(e2),
			      arg1, arg2, eff, op);

	   case Eq:
	   case Ne:
	     return do_boolop(loc, FALSE, definite_null(e1), definite_null(e2),
			      arg1, arg2, eff, op);

	   default:
	     {
	       myerror("Unexpected tag on binop: %d\n", tag);
	       assert(0);
	     }
	   }

      }

    case CastE:
      {
	einfo arg1;

	arg1 = analyze_exp(loc, exp->ecaste.e, context, env, drinfolist);
	return do_cast(arg1, exp->ecaste.type, loc, context);      
      }

    case AddrOf: 
      {
	cil_lval ae = exp->eaddrof;

	/* &e can only appear in an r-context.  We analyze the
           subexpression in an l-context (thus the subexpression type
           with have a ptr at the outside) and silently convert the
           l-type to an r-type.  On the other hand, taking the address
           of a function type is a no-op. */
	assert(context == rpos);
	if (is_lval_function(ae))
	  /* using fn name for ptr always represented in CIL as '&fn' */
	  return analyze_lval(loc, ae, rpos, env, drinfolist);
	else
	  return analyze_lval(loc, ae, apos, env, drinfolist);
      }
    case StartOf: 
      {
	cil_lval se = exp->estartof;
	assert(context == rpos);
	return analyze_lval(loc, se, context, env, drinfolist);
      }
    case SizeOf:
	return do_sizealign_of("sizeof_type", loc, context);
    case SizeOfE:
	return do_sizealign_of("sizeof", loc, context);
    case AlignOf:
	return do_sizealign_of("alignof_type", loc, context);
    case AlignOfE:
	return do_sizealign_of("alignof", loc, context);

    default:
      {
	myerror("Unexpected tag on expression: %d\n", Tag_val(exp));
	return mkeinfo(0, env, FALSE);
      }
    }


}


static sinfo analyze_init(location loc, qtype lhs_qtype, cil_init init, 
			  effect env, dd_list drinfolist)
{
  switch (Tag_val(init))
    {
    case SingleInit:
      {
	cil_exp rhs = init->singleinit;
	einfo rhs_info;
	
	rhs_info = analyze_exp(loc, rhs, rpos, env, drinfolist);
	if (is_exp_string(rhs)) /* special hack for strings */
	  {
	    if (init_string(loc, lhs_qtype, rhs_info.qt))
	      report_qerror(loc, sev_err, INCOMPAT_INIT);      
	  }
	else /* normal case */
	  {
	    if (mkleq_assign_convert(loc, rhs_info.qt, lhs_qtype))
	      report_qerror(loc, sev_err, INCOMPAT_INIT);
	  }

	return mksinfo(rhs_info.eff);
      }
    case CompoundInit:
      {
	cil_offsetinit_list l = init->compoundinit.l;
	cil_offsetinit_list iter;
	cil_offsetinit i;
	effect eff;

	eff = effect_empty;
	cil_scanlist(i, iter, l)
	  {
	    /* each i in l is an assignment */
	    einfo lhs;
	    sinfo asn;
	    lhs = follow_offset(loc, i->offset, lpos, lhs_qtype, effect_empty, env, drinfolist, FALSE);
	    asn = analyze_init(loc, points_to_qtype(lhs.qt), i->init, env, drinfolist);
	    eff = effect_union(eff, lhs.eff);
	    eff = effect_union(eff, asn.eff);
	  }

	return mksinfo(eff);
      }
    default:
      myerror("Unexpected tag on global variable initializer: %d\n", 
	      Tag_val(init));
      return mksinfo(effect_empty);
    }
}


static einfo analyze_lval(location loc, cil_lval lval, context context, 
			  effect env, dd_list drinfolist)
{
  cil_lhost lhost = lval->lhost;
  cil_offset off = lval->offset;
  einfo result;
  qtype qt;
  effect eff;

  switch (Tag_val(lhost))
    {
    case lhVar: /* a variable */
      {
	varinfo vi = CIL_CHECK_VAL(varinfo, lhost->var);

	qt = vi_get_qtype(vi);
	if (!qt)
	  {
	    /*xxx not sure how __PRETTY_FUNCTION__, __FUNCTION__
	      and =va_arg are represented by cil 	 */
	    user_error_loc(loc, USE_BEFORE_DECLARATION, 0);
	  }

	if (qtype_scheme(qt))
	  qt = instantiate_qtype(qt, loc);

	/* add PAM markup for variable/struct field use */
        /* xxx want locations for lvalues - i.e. references to variables */
        //if (flag_pam_mode || flag_print_results)
        //  pam_add_overlay_file(loc, String_val(vi->vname), qt);

	eff = effect_empty;
      }
      break;
    case lhMem: /* an object of type T; expression has type ptr(T) */
      {       
	cil_exp mem = lhost->mem;
	 
	/* sfg: I think rpos is correct here b/c these lhosts are
	   always dereferenced */
	result = analyze_exp(loc, mem, rpos, env, drinfolist);
	eff = result.eff;
	qt = result.qt;
      }
      break;
    default:
      {
	myerror("Unexpected tag for lhost: %d", Tag_val(lhost));
	assert(0);
      }
    }

  return follow_offset(loc, off, context, qt, eff, env, drinfolist, TRUE);
}

static einfo follow_offset(location loc, cil_offset off, context context, 
			   qtype qt, effect eff, 
			   effect env, dd_list drinfolist, bool structptr)
{
  einfo result;

  if (off == (cil_offset)(Val_int(0))) /* NoOffset */
    {
      /*xxx a hack - special case for initializers of the form
       * struct { char s[10] } x = { "foo" };
       * which would otherwise cause an error by calling
       * put_id_in_context(..., lpos) */
      if (context == lpos && qtype_array(qt)) 
        context = apos;
      return put_id_in_context(loc, mkeinfo(qt, eff, FALSE), context);
    }
  
  switch(Tag_val(off))
    {
    case Field: /* new type is field's type */
      {
	fieldinfo fi = CIL_CHECK_VAL(fieldinfo, off->field.fi);
	cil_offset new_off = off->field.offset;
	cstring fname = str2cstring(parse_region, String_val(fi->fname));

	/* printf("Field '%s'\n", String_val(fi->fname)); */

	if (structptr)
	  /* qt is a ptr to struct, get field qt */
	  qt = field_qtype(points_to_qtype(qt), fname);
	else
	  qt = field_qtype(qt, fname);
	assert(qt);

	return follow_offset(loc, new_off, context, qt, eff, env, drinfolist, TRUE);
      }
      break;
    case Index: /* implies dereference */
      {
	cil_exp index_exp = off->index.e;
	cil_offset new_off = off->index.offset;

	assert( qtype_array(qt) );
	result = analyze_exp(loc, index_exp, rpos, env, drinfolist);
	eff = effect_union(eff, result.eff);

	/* a bit of a hack */
	if (qtype_array(array_of_qtype(qt)))
	  /* don't need extra ptr layer if next thing is an array */
	  qt = array_of_qtype(qt); 
	else
	   /* array -> ptr */
	  qt = default_conversion_qtype(qt);

	return follow_offset(loc, new_off, context, qt, eff, env, drinfolist, TRUE);
      }
      break;
    default:
      {
	myerror("Unexpected tag for offset: %d", Tag_val(off));
	assert(0);
      }
    }
}

/* CIL turns enum items into ints, so we won't ever see a 
 * reference to an enum item */
static void analyze_enuminfo(enuminfo ei) 
{
  cil_enumitem item;
  cil_enumitem_list iter;
  qtype qt;
  
  /* give the enumeration constants qtypes */
  cil_scanlist(item, iter, ei->eitems)
    {      
      cil_location cloc = CIL_CHECK_VAL(cil_location, item->loc);
      location loc = location_from_cil_location(parse_region, cloc);
      qt = add_cildecl_qtype( make_dummy_number_type(TInt, Val_int(IInt)), 
			      loc, 
			      String_val(item->name), 
			      TRUE /*is_enum*/);
      /* ei_new_shadow_node(item, qt, loc); */
      
      /* add PAM markup for enum item declaration */
      if (flag_pam_mode || flag_print_results) 
	{
	  /*  printf("enum item [%s] at line %ld, btye %ld\n", 
	   *       String_val(item->name), loc->lineno, loc->filepos);
	   */
	  pam_add_overlay_file(loc, String_val(item->name), qt);
	}
    }
}


/* Analyze a field declaration (this fn only called from qtype.c) */
qtype analyze_field_declaration(const char *compname, field_declaration fi) 
{ 
  qtype qt;
  const char *fname = String_val(fi->fname);
  cil_location cfloc = CIL_CHECK_VAL(cil_location, fi->floc);
  location floc = location_from_cil_location(parse_region, cfloc);

  qt = get_fdecl_qtype(compname, fi, fi->ftype, floc);

  /* add PAM markup for struct/union field declaration */
  if ((flag_pam_mode || flag_print_results) && (fname != NONE))
    {
      /*printf("struct/union field [%s] at line %ld, btye %ld\n", 
       *       fname, floc->lineno, floc->filepos); 
       */
      pam_add_overlay_file(floc, fname, qt);
    }

  mk_effect_leq_global_effect(defn_effect_qtype(qt));
  mk_effect_leq_global_env(effect_single(aloc_qtype(qt)));
  return qt;
}

/* Analyze a enum { ... } declaration. 
 * this fn only called from qtype.c
 * slightly different from analyze.c::analyze_tag_ref */
void analyze_tag_ref(tag_ref tr) 
{
  assert(Tag_val(tr) == TEnum);
  analyze_enuminfo(tr->tenum.ei);
}


/**************************************************************************
 *                                                                        *
 * Magic -- special interpretations of certain syntax                     *
 *                                                                        *
 **************************************************************************/

static int fopen_count = 0;
static int alloc_count = 0;
bool have_stream_quals = FALSE;
bool have_sleepy_quals = FALSE;
qual open_unchecked_qual = NULL;
qual read_unchecked_qual = NULL;
qual write_unchecked_qual = NULL;
qual readwrite_unchecked_qual = NULL;
qual open_qual = NULL;
qual read_qual = NULL;
qual write_qual = NULL;
qual readwrite_qual = NULL;
qual closed_qual = NULL;
qual enabled_qual = NULL;
qual disabled_qual = NULL;
qual readonly_qual = NULL;
qtype interrupt_status_qtype = NULL;

static void init_magic(void)
{
  fopen_count = 0;
  alloc_count = 0;
  open_unchecked_qual = find_qual("$open_unchecked");
  read_unchecked_qual = find_qual("$read_unchecked");
  write_unchecked_qual = find_qual("$write_unchecked");
  readwrite_unchecked_qual = find_qual("$readwrite_unchecked");
  open_qual = find_qual("$open");
  read_qual = find_qual("$read");
  write_qual = find_qual("$write");
  readwrite_qual = find_qual("$readwrite");
  closed_qual = find_qual("$closed");
  have_stream_quals = (open_unchecked_qual &&
                       read_unchecked_qual &&
                       write_unchecked_qual &&
                       readwrite_unchecked_qual &&
                       open_qual &&
                       read_qual &&
                       write_qual &&
                       readwrite_qual &&
                       closed_qual);
  enabled_qual = find_qual("$enabled");
  disabled_qual = find_qual("$disabled");
  have_sleepy_quals = (enabled_qual && disabled_qual);
  readonly_qual = find_qual("$readonly");
}

/*... left for later */
/*
static einfo analyze_magic_function_call(const char *fname, qtype fqt,
					 location floc, effect arg_eff,
                                         effect env, dd_list drinfolist)
{
  if ((!strcmp(fname, "fopen") ||
       !strcmp(fname, "fdopen") ||
       !strcmp(fname, "tmpfile") ||
       !strcmp(fname, "safefopen") ||
       !strcmp(fname, "popen") ||
       !strcmp(fname, "my_popen")) &&
      have_stream_quals)
    {
      effect eff;
      qtype ret_qt, file_qt, result_qt;
      const char *count, *new_al_name, *new_qual_name;
      qual new_qual;
      aloc new_al;

      ret_qt = return_qtype(fqt);
      file_qt = points_to_qtype(ret_qt);
      count = inttostr(parse_region, fopen_count++);
      new_al_name = rstrscat(parse_region, name_aloc(aloc_qtype(ret_qt)),
			     "_inst", count, NULL);
      new_qual_name = rstrscat(parse_region, name_qual(qual_qtype(ret_qt)),
			       "_inst", count, NULL);
      new_al = make_aloc(new_al_name, file_qt, FALSE);
      mark_aloc_interesting(new_al);
      eff = effect_union(arg_eff, effect_alloc(new_al));
      new_qual = make_qvar(new_qual_name, floc, TRUE,FALSE);
      result_qt = mkqtype_pointer(new_qual, file_qt, new_al);
      return mkeinfo(result_qt, eff, FALSE);
    }

  if (!strcmp(fname, "malloc") ||
      !strcmp(fname, "xmalloc") ||
      !strcmp(fname, "vmalloc") ||
      !strcmp(fname, "kmalloc") ||
      !strcmp(fname, "ioremap") ||
      !strcmp(fname, "kmem_cache_alloc"))
    {
      qtype ret_qt, pointsto;
      aloc aloc;
      effect eff;
      const char *count;
      const char *new_void_name, *new_aloc_name, *new_void_pointer_name;

      //eff = effect_empty;
      //scan_expression(arg, fc->args)
      //{
      //  einfo arg_info = analyze_exp(aloc, arg, rpos, env, drinfolist);
      //  eff = effect_union(eff, arg_info.eff);
      //}

      count = inttostr(parse_region, alloc_count++);
      new_void_name = rstrcat(parse_region, "alloc_p_inst", count);
      new_aloc_name = rstrcat(parse_region, "alloc_inst", count);
      new_void_pointer_name = rstrcat(parse_region, "alloc_inst", count);
      pointsto = mkqtype_void(make_qvar(new_void_name, floc, FALSE,FALSE));
      aloc = make_aloc(new_aloc_name, pointsto, TRUE);
      ret_qt = mkqtype_pointer(make_qvar(new_void_pointer_name, floc,
					 FALSE,FALSE),
			       pointsto,
			       aloc);
                      
      eff = effect_union(effect_alloc(aloc), arg_eff);

      if (!strcmp(fname, "kmalloc") && have_sleepy_quals)
	{
	  assert(interrupt_status_qtype != NULL);
	  eff = effect_union(effect_wr(aloc_qtype(interrupt_status_qtype)),
			     eff);
	}

      return mkeinfo(ret_qt, eff, TRUE);
    }

  else
    return mkeinfo(NULL, NULL, FALSE);
}
*/


/* change_type and assert_type are parsed as a function call with the
 *  type represented as a sizeof(type) expression : *_type(sizeof(t), e)
 *
 * since fn call has to return an einfo, return the qtype for e
 */
static bool magic_change_or_assert_type(struct Call *cs, location loc,
					effect env, dd_list drinfolist,
					sinfo *result)
{
  const char *fname;

  if ( Tag_val(cs->f) == Lval 
       && is_lval_function(cs->f->elval)
       && (fname = String_val(cs->f->elval->lhost->var->vname)) != NONE )
    {
      bool ct = !strcmp(fname, "change_type");
      bool at = !strcmp(fname, "assert_type");

      if (ct || at)
	{
	  cil_exp e, szofe;
	  cil_typ t;
	  einfo einfo;
	  qtype qt = NULL;
	  
	  assert(result);
	  if (cs->args == NIL 
	      || cs->args->tail == NIL 
	      || cs->args->tail->tail != NIL)
	    {
	      report_qerror(loc, sev_err, "%s expects 2 parameters\n", 
			    ct ? "change_type" : "assert_type");
	      *result = mksinfo(effect_empty);
	      return TRUE;
	    }
	  szofe = cs->args->tail->head;
	  if (Tag_val(szofe) != SizeOf)
	    {
	      report_qerror(loc, sev_err, 
			    "%s()'s second parameter must be a sizeof(type)\n", 
			    ct ? "change_type" : "assert_type");
	      *result = mksinfo(effect_empty);
	      return TRUE;
	    }
	  t = szofe->esizeof;

	  e = cs->args->head;
	  
	  if (ct)
	    { /* change type */
	      einfo = analyze_exp(loc, e, lpos, env, drinfolist);
	      *result = do_change_type(einfo, t, &qt, loc);
	    }
	  else
	    { /* assert type */
	      einfo = analyze_exp(loc, e, rpos, env, drinfolist);
	      *result = do_assert_type(einfo, t, &qt, loc, loc);
	    }
	  return TRUE;
	}
      else
	return FALSE;
    }
  else
    return FALSE;
}


/********************************************************************************
 *
 * pam markup helpers
 *
 ********************************************************************************/

static void add_varinfo_overlay(varinfo vi)
{
  const char *vname = String_val(vi->vname);
  qtype       qt    = vi_get_qtype(vi);
  location    loc   = vi_get_loc(vi);
  assert(vname);
  assert(qt);
  assert(loc);
  /* printf("varinfo [%s] at line %lu, byte %lx\n", 
         vname, loc->lineno, loc->filepos); //debug
   */
  pam_add_overlay_file(loc, vname, qt);
}


/*********************************************************************************
 *
 * utilities
 *
 *********************************************************************************/
/*
cil_typ unroll_type_deep(cil_typ t)
{
  CAMLparam0();
  static value *unroll_fn = NULL;
  cil_typ unrolled_t;

  if (!unroll_fn)
    unroll_fn = caml_named_value("unroll_type_deep");

  unrolled_t = (cil_typ)callback(*unroll_fn, (value)t);

  CAMLreturn(unrolled_t);
}
*/

static qtype add_cildecl_qtype(type t, location loc, const char *name, 
			       bool is_enum)
{
  type lifted_t;
  qtype qtype;

  /* functions, arrays and enumeration constants cannot be ltypes */
  if (type_function(t) || type_array(t) || is_enum) 
    lifted_t = t;
  else
    lifted_t = make_pointer_type(t);

  qtype = decl_to_qtype(lifted_t, 
			loc, 
			name, 
			FALSE, /* preferred, */
			FALSE, /* isglobal */ /* FIXME */
			FALSE, /* generalize, */
			FALSE, /* noreturn, */
			FALSE /* __init */ );
  return qtype;
}


static inline location location_from_cil_location(region r, const cil_location cloc)
{
  location loc;

  if (cloc)
    {
      loc = ralloc(r, struct Location);
      assert(loc);
      loc->filename = String_val(cloc->file);
      loc->lineno = Long_val(cloc->line);
      loc->filepos = Long_val(cloc->byte);
      loc->in_system_header = FALSE;
      return loc;  
    }
  else
    return NULL;
}


static inline qtype cur_function_qtype(void)
{
  qtype qt;
  //assert(current_function_decl);
  if (!current_function_decl)
    return NULL;
  qt = vi_get_qtype(current_function_decl->svar);
  assert(qt);
  return qt;
}

/* Return the range qtype of the current function */
static qtype cur_return_qtype(void)
{
  assert(current_function_decl);
  return return_qtype(cur_function_qtype());
}

/* Return the qualifier on the current function */
qual cur_function_qual(void)
{
  assert(current_function_decl);
  return qual_qtype(cur_function_qtype());
}



static inline operator find_unary_op_kind(cil_unop_tag k)
{
  operator op;
  switch (k)
    {
    case Neg:   op = operators+0; break;
    case BNot:  op = operators+2; break;
    case LNot:  op = operators+3; break;
    default: op = NULL;
    }  
  if (op && op->qt)
    return op;
  else
    return NULL;
}


static inline operator find_binary_op_kind(cil_binop_tag k)
{
  operator op;
  switch (k)
    {
      /*    case PlusA:    
	    case PlusPI:   
	    case IndexPI:
	    case MinusA:
	    case MinusPI:
	    case MinusPP:
      */
    case Mult:     op = operators+4;
    case Div:      op = operators+5;
    case Mod:      op = operators+6;
    case Shiftlt:  op = operators+7;
    case Shiftrt:  op = operators+8;
    case Lt:       op = operators+9;
    case Gt:       op = operators+10;
    case Le:       op = operators+11;
    case Ge:       op = operators+12;
    case Eq:       op = operators+13;
    case Ne:       op = operators+14;
    case BAnd:     op = operators+15;
    case BXor:     op = operators+16;
    case BOr:      op = operators+17;

    default: op = NULL;
    }  
  if (op && op->qt)
    return op;
  else
    return NULL;
}

/************************************************************************
 * 
 *some functions to handle tag_declarations abstractly (for qtype.c) 
 *  tag_declaration == cil_typ and field_declaration == fieldinfo 
 *
 ************************************************************************/

tag_declaration type_tag(type t) 
{ 
  assert(Tag_val(t) == TComp || Tag_val(t) == TEnum);
  return t;
}
tag_ref tag_decl_to_tag_ref(tag_declaration td)
{
  return td;
}
bool is_tag_enum(tag_declaration td)
{
  if (Tag_val(td) == TEnum)
    return TRUE;
  else if (Tag_val(td) == TComp)
    return FALSE;
  else 
    assert(0);
}

/* for struct/union only */
qtype tag_decl_qtype(tag_declaration td)
{
  assert( !is_tag_enum(td) );
  return ci_get_qtype(td->tcomp.ci);
}
void tag_decl_set_qtype(tag_declaration td, qtype qt)
{
  assert( !is_tag_enum(td) );
  ci_update_qtype(td->tcomp.ci, qt);
}
bool tag_decl_is_defined(tag_declaration td)
{
  if (is_tag_enum(td))
    DIE //return td->tenum.ei->ereferenced;
  else 
    return Bool_val(td->tcomp.ci->cdefined);
}
const char * tag_decl_name(tag_declaration td)
{  
  const char * name;
  if (is_tag_enum(td))
    name = String_val(td->tenum.ei->ename);
  else 
    name = String_val(td->tcomp.ci->cname);
  return name;
}
const char * field_decl_name(field_declaration fd)
{
  const char *name = String_val(fd->fname);
  return name == NONE ? NULL : name;
}

void tag_decl_scan(tag_declaration td, tag_decl_scanner *scanner)
{
  assert(Tag_val(td) == TComp);
  assert(scanner);
  *scanner = td->tcomp.ci->cfields;
}

fieldinfo tag_decl_next(tag_decl_scanner *scanner)
{
  assert (scanner);
  if ( *scanner == NIL )
    return NULL;
  else
    {
      field_declaration result;
      result = (*scanner)->head;
      *scanner = (*scanner)->tail;
      return result;
    }
}



/***************************************************
 *
 * predicates on ast structure
 *
 ***************************************************/

bool is_lval_function(cil_lval lv)
{
  bool result;
  result = ( lv 
	     && (Tag_val(lv->lhost) == lhVar)
	     && (lv->offset == NIL)
	     && type_function(lv->lhost->var->vtype) ); 
  
  return result;
}

bool is_exp_string(cil_exp e)
{
  return e
    && Tag_val(e) == Const
    && Tag_val(e->econst) == CStr;
} 

bool definite_null(cil_exp e) { return FALSE; } //implement me
bool file_pointer_qtype(qtype qt) { return FALSE; } //implement me



/***************************************************
 *
 * non-shared user qual stuff 
 *
 ***************************************************/

static struct Location lu = { filename:"unknown", lineno:-1, filepos:-1, in_system_header:FALSE };

user_qual new_user_qual(region r, location loc, cstring cstring)
{
  user_qual res;
  res = ralloc(r, struct AST_user_qual);
  assert(res);
  res->loc = loc;
  res->cstring = cstring;
  return res;
}

/* figure out which of t's attributes are user quals and return them in
   a user_qual_list  */
user_qual_list type_user_quals(type t) 
{ 
  cil_attributes iter;
  cil_attribute a;
  cil_attributes as;
  user_qual_list l = NULL;
  char aname$[102]; /* avoid allocating */
  
  as = type_attr(t);
  cil_scanlist(a, iter, as)
    {
      user_qual qual;
      cstring cs;
      const char *aname = String_val(a->name);

      /* 'attrib' not a user qual, try again with '$attrib' */
      if (!find_qual(aname))
	{
	  aname$[0] = '$';
	  strncpy(aname$+1, aname, 100);
	  aname$[101] = '\0';
	  aname = aname$;
	}

      /* silently ignore anything we don't recognize as a qualifier */
      if (find_qual(aname))
	{
	  cs = str2cstring(parse_region, aname);
	  qual = new_user_qual(parse_region, &lu, cs);
	  l = new_user_qual_list(qual, l);
	}
    }

  return l; 
} 



/****** stuff below put here to make it link *****/


/* Follow the shadow links to the outermost ddecl this ddecl shadows. */
data_declaration root_ddecl(data_declaration ddecl)
{ return ddecl; }

/* Given a declarator, return a good location for it, i.e., the
   location of the identifier it declares (if any). */
location location_declaration(declaration d)
{
  location result = (location)0;
  DIE;
  return result;
}

void prt_expression(expression e, int n)
{ DIE; }

bool is_unannotated_global(data_declaration ddecl, store s)
{ DIE; return TRUE; }

bool is_undefined_global(data_declaration ddecl, store s)
{ DIE; return TRUE; }


void confine_inf(declaration prog) {}


