expr.c

gcc-2.95.3 Linux下最常用的C编译器

  TREE_CHAIN (decl1) = decl2;
  TREE_CHAIN (decl2) = NULL_TREE;
  decl2 = build_chill_struct_type (decl1);
  descr_type = build_decl (TYPE_DECL, get_identifier ("__tmp_DESCR_type"), decl2);
  pushdecl (descr_type);
  DECL_SOURCE_LINE (descr_type) = 0;
  satisfy_decl (descr_type, 0);
}

/* build a pointer to a descriptor.
 * descriptor = STRUCT (datap PTR,
 *			len ULONG);
 * This descriptor is build in variable descr_type.
 */

tree
build_chill_descr (expr)
    tree expr;
{
  if (pass == 2)
    {
      tree tuple, decl, descr_var, datap, len, tmp;
      int is_static;

      if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
	return error_mark_node;
      
      /* check for expression is referable */
      if (! CH_REFERABLE (expr))
	{
	  error ("expression for DESCR-builtin must be referable.");
	  return error_mark_node;
	}
      
      mark_addressable (expr);
#if 0
      datap = build1 (ADDR_EXPR, build_chill_pointer_type (descr_type), expr);
#else
      datap = build_chill_arrow_expr (expr, 1);
#endif
      len = size_in_bytes (TREE_TYPE (expr));
      
      descr_var = get_unique_identifier ("DESCR");
      tuple = build_nt (CONSTRUCTOR, NULL_TREE,
			tree_cons (NULL_TREE, datap,
				   tree_cons (NULL_TREE, len, NULL_TREE)));

      is_static = (current_function_decl == global_function_decl) && TREE_STATIC (expr);
      decl = decl_temp1 (descr_var, TREE_TYPE (descr_type), is_static,
			 tuple, 0, 0);
#if 0
      tmp = force_addr_of (decl);
#else
      tmp = build_chill_arrow_expr (decl, 1);
#endif
      return tmp;
    }
  return NULL_TREE;
}

/* this function process the builtin's
   MILLISECS, SECS, MINUTES, HOURS and DAYS.
   The built duration value is in milliseconds. */

tree
build_chill_duration (expr, multiplier, fnname, maxvalue)
     tree           expr;
     unsigned long  multiplier;
     tree           fnname;
     unsigned long  maxvalue;
{
  tree temp;

  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
    return error_mark_node;

  if (TREE_CODE (TREE_TYPE (expr)) != INTEGER_TYPE)
    {
      error ("argument to `%s' must be of integer type.", IDENTIFIER_POINTER (fnname));
      return error_mark_node;
    }

  temp = convert (duration_timing_type_node, expr);
  temp = fold (build (MULT_EXPR, duration_timing_type_node,
		      temp, build_int_2 (multiplier, 0)));

  if (range_checking)
    temp = check_range (temp, expr, integer_zero_node, build_int_2 (maxvalue, 0));

  return temp;
}

/* build function call to one of the floating point functions */
static tree
build_chill_floatcall (expr, chillname, funcname)
     tree expr;
     char *chillname;
     char *funcname;
{
  tree result;
  tree type;

  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
    return error_mark_node;

  /* look if expr is a REAL_TYPE */
  type = TREE_TYPE (expr);
  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
    return error_mark_node;
  if (TREE_CODE (type) != REAL_TYPE)
    {
      error ("argument 1 to `%s' must be of floating point mode", chillname);
      return error_mark_node;
    }
  result = build_chill_function_call (
             lookup_name (get_identifier (funcname)),
               tree_cons (NULL_TREE, expr, NULL_TREE));
  return result;
}

/* common function for ALLOCATE and GETSTACK */
static tree
build_allocate_getstack (mode, value, chill_name, fnname, filename, linenumber)
     tree mode;
     tree value;
     char *chill_name;
     char *fnname;
     tree filename;
     tree linenumber;
{
  tree type, result;
  tree expr = NULL_TREE;
  tree args, tmpvar, fncall, ptr, outlist = NULL_TREE;

  if (mode == NULL_TREE || TREE_CODE (mode) == ERROR_MARK)
    return error_mark_node;

  if (TREE_CODE (mode) == TYPE_DECL)
    type = TREE_TYPE (mode);
  else
    type = mode;

  /* check if we have a mode */
  if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
    {
      error ("First argument to `%s' must be a mode", chill_name);
      return error_mark_node;
    }

  /* check if we have a value if type is READonly */
  if (TYPE_READONLY_PROPERTY (type) && value == NULL_TREE)
    {
      error ("READonly modes for %s must have a value", chill_name);
      return error_mark_node;
    }

  if (value != NULL_TREE)
    {
      if (TREE_CODE (value) == ERROR_MARK)
	return error_mark_node;
      expr = chill_convert_for_assignment (type, value, "assignment");
    }

  /* build function arguments */
  if (filename == NULL_TREE)
    args = tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE);
  else
    args = tree_cons (NULL_TREE, size_in_bytes (type),
             tree_cons (NULL_TREE, force_addr_of (filename),
               tree_cons (NULL_TREE, linenumber, NULL_TREE)));

  ptr = build_chill_pointer_type (type);
  tmpvar = decl_temp1 (get_unique_identifier (chill_name),
		       ptr, 0, NULL_TREE, 0, 0);
  fncall = build_chill_function_call (
             lookup_name (get_identifier (fnname)), args);
  outlist = tree_cons (NULL_TREE,
               build_chill_modify_expr (tmpvar, fncall), outlist);
  if (expr == NULL_TREE)
    {
      /* set allocated memory to 0 */
      fncall = build_chill_function_call (
                 lookup_name (get_identifier ("memset")),
                   tree_cons (NULL_TREE, convert (ptr_type_node, tmpvar),
                     tree_cons (NULL_TREE, integer_zero_node,
                       tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE))));
      outlist = tree_cons (NULL_TREE, fncall, outlist);
    }
  else
    {
      /* write the init value to allocated memory */
      outlist = tree_cons (NULL_TREE,
                  build_chill_modify_expr (build_chill_indirect_ref (tmpvar, NULL_TREE, 0),
					   expr), 
			   outlist);
    }
  outlist = tree_cons (NULL_TREE, tmpvar, outlist);
  result = build_chill_compound_expr (nreverse (outlist));
  return result;
}

/* process the ALLOCATE built-in */
tree
build_chill_allocate (mode, value)
     tree mode;
     tree value;
{
  return build_allocate_getstack (mode, value, "ALLOCATE", "__allocate",
				  get_chill_filename (), get_chill_linenumber ());
}

/* process the GETSTACK built-in */
tree
build_chill_getstack (mode, value)
     tree mode;
     tree value;
{
  return build_allocate_getstack (mode, value, "GETSTACK", "__builtin_alloca",
				  NULL_TREE, NULL_TREE);
}

/* process the TERMINATE built-in */
tree
build_chill_terminate (ptr)
     tree ptr;
{
  tree result;
  tree type;

  if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
    return error_mark_node;

  type = TREE_TYPE (ptr);
  if (type == NULL_TREE || TREE_CODE (type) != POINTER_TYPE)
    {
      error ("argument to TERMINATE must be a reference primitive value");
      return error_mark_node;
    }
  result = build_chill_function_call (
	     lookup_name (get_identifier ("__terminate")),
	       tree_cons (NULL_TREE, convert (ptr_type_node, ptr),
                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
  return result;
}

/* build the type passed to _inttime function */
void
build_chill_inttime_type ()
{
  tree idxlist;
  tree arrtype;
  tree decl;

  idxlist = build_tree_list (NULL_TREE,
               build_chill_range_type (NULL_TREE,
				       integer_zero_node,
				       build_int_2 (5, 0)));
  arrtype = build_chill_array_type (ptr_type_node, idxlist, 0, NULL_TREE);

  decl = build_decl (TYPE_DECL, get_identifier ("__tmp_INTTIME_type"), arrtype);
  pushdecl (decl);
  DECL_SOURCE_LINE (decl) = 0;
  satisfy_decl (decl, 0);
}

tree
build_chill_inttime (t, loclist)
     tree t, loclist;
{
  int  had_errors = 0, cnt;
  tree tmp;
  tree init = NULL_TREE;
  int  numargs;
  tree tuple, var;

  if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
    return error_mark_node;
  if (loclist == NULL_TREE || TREE_CODE (loclist) == ERROR_MARK)
    return error_mark_node;

  /* check first argument to be NEWMODE TIME */
  if (TREE_TYPE (t) != abs_timing_type_node)
    {
      error ("argument 1 to INTTIME must be of mode TIME.");
      had_errors = 1;
    }

  cnt = 2;
  tmp = loclist;
  while (tmp != NULL_TREE)
    {
      tree loc = TREE_VALUE (tmp);
      char errmsg[200];
      char *p, *p1;
      int  write_error = 0;

      sprintf (errmsg, "argument %d to INTTIME must be ", cnt);
      p = errmsg + strlen (errmsg);
      p1 = p;
      
      if (loc == NULL_TREE || TREE_CODE (loc) == ERROR_MARK)
	had_errors = 1;
      else
	{
	  if (! CH_REFERABLE (loc))
	    {
	      strcpy (p, "referable");
	      p += strlen (p);
	      write_error = 1;
	      had_errors = 1;
	    }
	  if (TREE_CODE (TREE_TYPE (loc)) != INTEGER_TYPE)
	    {
	      if (p != p1)
		{
		  strcpy (p, " and ");
		  p += strlen (p);
		}
	      strcpy (p, "of integer type");
	      write_error = 1;
	      had_errors = 1;
	    }
	  /* FIXME: what's about ranges can't hold the result ?? */
	  if (write_error)
	    error ("%s.", errmsg);
	}
      /* next location */
      tmp = TREE_CHAIN (tmp);
      cnt++;
    }

  if (had_errors)
    return error_mark_node;

  /* make it always 6 arguments */
  numargs = list_length (loclist);
  for (cnt = numargs; cnt < 6; cnt++)
    init = tree_cons (NULL_TREE, null_pointer_node, init);

  /* append the given one's */
  tmp = loclist;
  while (tmp != NULL_TREE)
    {
      init = chainon (init,
		      build_tree_list (NULL_TREE,
				       build_chill_descr (TREE_VALUE (tmp))));
      tmp = TREE_CHAIN (tmp);
    }

  tuple = build_nt (CONSTRUCTOR, NULL_TREE, init);
  var = decl_temp1 (get_unique_identifier ("INTTIME"),
		    TREE_TYPE (lookup_name (get_identifier ("__tmp_INTTIME_type"))),
		    0, tuple, 0, 0);

  return build_chill_function_call (
    lookup_name (get_identifier ("_inttime")),
       tree_cons (NULL_TREE, t,
          tree_cons (NULL_TREE, force_addr_of (var),
		     NULL_TREE)));
}


/* Compute the runtime length of the given string variable
 * or expression.
 */
tree
build_chill_length (expr)
     tree expr;
{
  if (pass == 2)
    {
      tree type;
      
      if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
	return error_mark_node;
      
      if (TREE_CODE (expr) == IDENTIFIER_NODE)
	expr = lookup_name (expr);

      type = TREE_TYPE (expr);
      
      if (TREE_CODE(type) == ERROR_MARK)
	return type;
      if (chill_varying_type_p (type))
	{ 
	  tree temp = convert (integer_type_node,
			  build_component_ref (expr, var_length_id));
	  /* FIXME: should call
	   * cond_type_range_exception (temp);
	   */
	  return temp;
	}
      
      if ((TREE_CODE (type) == ARRAY_TYPE ||
	   /* should work for a bitstring too */
	   (TREE_CODE (type) == SET_TYPE && TREE_CODE (TREE_TYPE (type)) == BOOLEAN_TYPE)) &&
	  integer_zerop (TYPE_MIN_VALUE (TYPE_DOMAIN (type))))
	{
	  tree temp =  fold (build (PLUS_EXPR, chill_integer_type_node,
				    integer_one_node,
				    TYPE_MAX_VALUE (TYPE_DOMAIN (type))));
	  return convert (chill_integer_type_node, temp);
	}
      
      if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
        {
          tree len = max_queue_size (type);
          
          if (len == NULL_TREE)
            len = integer_minus_one_node;
          return len;
        }

      if (CH_IS_TEXT_MODE (type))
	{
	  if (TREE_CODE (expr) == TYPE_DECL)
	    {
	      /* text mode name */
	      return text_length (type);
	    }
	  else
	    {
	      /* text location */
	      tree temp = build_component_ref (
			    build_component_ref (expr, get_identifier ("tloc")),
                                var_length_id);
	      return convert (integer_type_node, temp);
	    }
	}
 
      error("LENGTH argument must be string, buffer, event mode, text location or mode");
      return error_mark_node;
    }
  return NULL_TREE;
}

/* Compute the declared minimum/maximum value of the variable,
 * expression or declared type
 */
static tree
build_chill_lower_or_upper (what, is_upper)
     tree what;
     int is_upper;  /* o -> LOWER; 1 -> UPPER */
{
  if (pass == 2)
    {
      tree type;
      struct ch_class class;

      if (what == NULL_TREE || TREE_CODE (what) == ERROR_MARK)
	return error_mark_node;
      
      if (TREE_CODE_CLASS (TREE_CODE (what)) == 't')
	type = what;
      else
	type = TREE_TYPE (what);
      if (type == NULL_TREE)
	{
	  if (is_upper)
	    error ("UPPER argument must have a mode, or be a mode");
	  else
	    error ("LOWER argument must have a mode, or be a mode");
	  return error_mark_node;
	}
      while (TREE_CODE (type) == REFERENCE_TYPE)
	type = TREE_TYPE (type);
      if (chill_varying_type_p (type))
	type = CH_VARYING_ARRAY_TYPE (type);
     
      if (discrete_type_p (type))
	{
	  tree val = is_upper ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type);
	  class.kind = CH_VALUE_CLASS;