global.c

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

  ai = &g->u.proc.arg_info[argno];

  /* Maybe warn about previous references.  */

  if ((ai->t != NULL)
      && ffe_is_warn_globals ())
    {
      const char *refwhy = NULL;
      const char *defwhy = NULL;
      bool warn = FALSE;

      switch (as)
	{
	case FFEGLOBAL_argsummaryREF:
	  if ((ai->as != FFEGLOBAL_argsummaryREF)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
		  || (ai->bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      warn = TRUE;
	      refwhy = "passed by reference";
	    }
	  break;

	case FFEGLOBAL_argsummaryDESCR:
	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
		  || (bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      warn = TRUE;
	      refwhy = "passed by descriptor";
	    }
	  break;

	case FFEGLOBAL_argsummaryPROC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "a procedure";
	    }
	  break;

	case FFEGLOBAL_argsummarySUBR:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "a subroutine";
	    }
	  break;

	case FFEGLOBAL_argsummaryFUNC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "a function";
	    }
	  break;

	case FFEGLOBAL_argsummaryALTRTN:
	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      warn = TRUE;
	      refwhy = "an alternate-return label";
	    }
	  break;

	default:
	  break;
	}

      if ((refwhy != NULL) && (defwhy == NULL))
	{
	  /* Fill in the def info.  */

	  switch (ai->as)
	    {
	    case FFEGLOBAL_argsummaryNONE:
	      defwhy = "omitted";
	      break;

	    case FFEGLOBAL_argsummaryVAL:
	      defwhy = "passed by value";
	      break;

	    case FFEGLOBAL_argsummaryREF:
	      defwhy = "passed by reference";
	      break;

	    case FFEGLOBAL_argsummaryDESCR:
	      defwhy = "passed by descriptor";
	      break;

	    case FFEGLOBAL_argsummaryPROC:
	      defwhy = "a procedure";
	      break;

	    case FFEGLOBAL_argsummarySUBR:
	      defwhy = "a subroutine";
	      break;

	    case FFEGLOBAL_argsummaryFUNC:
	      defwhy = "a function";
	      break;

	    case FFEGLOBAL_argsummaryALTRTN:
	      defwhy = "an alternate-return label";
	      break;

#if 0
	    case FFEGLOBAL_argsummaryPTR:
	      defwhy = "a pointer";
	      break;
#endif

	    default:
	      defwhy = "???";
	      break;
	    }
	}

      if (!warn
	  && (bt != FFEINFO_basictypeHOLLERITH)
	  && (bt != FFEINFO_basictypeTYPELESS)
	  && (bt != FFEINFO_basictypeNONE)
	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
	  && (ai->bt != FFEINFO_basictypeTYPELESS)
	  && (ai->bt != FFEINFO_basictypeNONE))
	{
	  /* Check types.  */

	  if ((bt != ai->bt)
	      && ((bt != FFEINFO_basictypeREAL)
		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
	      && ((bt != FFEINFO_basictypeCOMPLEX)
		  || (ai->bt != FFEINFO_basictypeREAL)))
	    {
	      warn = TRUE;	/* We can cope with these differences. */
	      refwhy = "one type";
	      defwhy = "some other type";
	    }

	  if (!warn && (kt != ai->kt))
	    {
	      warn = TRUE;
	      refwhy = "one precision";
	      defwhy = "some other precision";
	    }
	}

      if (warn)
	{
	  char num[60];

	  if (name == NULL)
	    sprintf (&num[0], "%d", argno + 1);
	  else
	    {
	      if (strlen (name) < 30)
		sprintf (&num[0], "%d (named `%s')", argno + 1, name);
	      else
		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, name);
	    }
	  ffebad_start (FFEBAD_FILEWIDE_ARG_W);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_string (num);
	  ffebad_string (refwhy);
	  ffebad_string (defwhy);
	  ffebad_here (0, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t));
	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
	  ffebad_finish ();
	}
    }

  /* Define this argument.  */

  if (ai->t != NULL)
    ffelex_token_kill (ai->t);
  if ((as != FFEGLOBAL_argsummaryPROC)
      || (ai->t == NULL))
    ai->as = as;	/* Otherwise leave SUBR/FUNC info intact. */
  ai->t = ffelex_token_use (g->t);
  if (name == NULL)
    ai->name = NULL;
  else
    {
      ai->name = malloc_new_ks (malloc_pool_image (),
				"ffeglobalArgInfo_ name",
				strlen (name) + 1);
      strcpy (ai->name, name);
    }
  ai->bt = bt;
  ai->kt = kt;
  ai->array = array;
}

/* Collect info on #args a global accepts.  */

void
ffeglobal_proc_def_nargs (ffesymbol s, int n_args)
{
  ffeglobal g = ffesymbol_global (s);

  assert (g != NULL);

  if (g->type == FFEGLOBAL_typeANY)
    return;

  if (g->u.proc.n_args >= 0)
    {
      if (g->u.proc.n_args == n_args)
	return;

      if (ffe_is_warn_globals ())
	{
	  ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
	  ffebad_string (ffesymbol_text (s));
	  if (g->u.proc.n_args > n_args)
	    ffebad_string ("few");
	  else
	    ffebad_string ("many");
	  ffebad_here (0, ffelex_token_where_line (g->u.proc.other_t),
		       ffelex_token_where_column (g->u.proc.other_t));
	  ffebad_here (1, ffelex_token_where_line (g->t),
		       ffelex_token_where_column (g->t));
	  ffebad_finish ();
	}
    }

  /* This is new info we can use in cross-checking future references
     and a possible future definition.  */

  g->u.proc.n_args = n_args;
  g->u.proc.other_t = NULL;	/* No other reference yet. */

  if (n_args == 0)
    {
      g->u.proc.arg_info = NULL;
      return;
    }

  g->u.proc.arg_info
    = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (),
					 "ffeglobalArgInfo_",
					 n_args * sizeof (g->u.proc.arg_info[0]));
  while (n_args-- > 0)
    g->u.proc.arg_info[n_args].t = NULL;
}

/* Verify that the info for a global's argument is valid.  */

bool
ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
			ffeinfoBasictype bt, ffeinfoKindtype kt,
			bool array, ffelexToken t)
{
  ffeglobal g = ffesymbol_global (s);
  ffeglobalArgInfo_ ai;

  assert (g != NULL);

  if (g->type == FFEGLOBAL_typeANY)
    return FALSE;

  assert (g->u.proc.n_args >= 0);

  if (argno >= g->u.proc.n_args)
    return TRUE;	/* Already complained about this discrepancy. */

  ai = &g->u.proc.arg_info[argno];

  /* Warn about previous references.  */

  if (ai->t != NULL)
    {
      const char *refwhy = NULL;
      const char *defwhy = NULL;
      bool fail = FALSE;
      bool warn = FALSE;

      switch (as)
	{
	case FFEGLOBAL_argsummaryNONE:
	  if (g->u.proc.defined)
	    {
	      fail = TRUE;
	      refwhy = "omitted";
	      defwhy = "not optional";
	    }
	  break;

	case FFEGLOBAL_argsummaryVAL:
	  if (ai->as != FFEGLOBAL_argsummaryVAL)
	    {
	      fail = TRUE;
	      refwhy = "passed by value";
	    }
	  break;

	case FFEGLOBAL_argsummaryREF:
	  if ((ai->as != FFEGLOBAL_argsummaryREF)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
		  || (ai->bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      fail = TRUE;
	      refwhy = "passed by reference";
	    }
	  break;

	case FFEGLOBAL_argsummaryDESCR:
	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE)
	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
		  || (bt != FFEINFO_basictypeCHARACTER)
		  || (ai->bt == bt)))
	    {
	      fail = TRUE;
	      refwhy = "passed by descriptor";
	    }
	  break;

	case FFEGLOBAL_argsummaryPROC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a procedure";
	    }
	  break;

	case FFEGLOBAL_argsummarySUBR:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummarySUBR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a subroutine";
	    }
	  break;

	case FFEGLOBAL_argsummaryFUNC:
	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a function";
	    }
	  break;

	case FFEGLOBAL_argsummaryALTRTN:
	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "an alternate-return label";
	    }
	  break;

#if 0
	case FFEGLOBAL_argsummaryPTR:
	  if ((ai->as != FFEGLOBAL_argsummaryPTR)
	      && (ai->as != FFEGLOBAL_argsummaryNONE))
	    {
	      fail = TRUE;
	      refwhy = "a pointer";
	    }
	  break;
#endif

	default:
	  break;
	}

      if ((refwhy != NULL) && (defwhy == NULL))
	{
	  /* Fill in the def info.  */

	  switch (ai->as)
	    {
	    case FFEGLOBAL_argsummaryNONE:
	      defwhy = "omitted";
	      break;

	    case FFEGLOBAL_argsummaryVAL:
	      defwhy = "passed by value";
	      break;

	    case FFEGLOBAL_argsummaryREF:
	      defwhy = "passed by reference";
	      break;

	    case FFEGLOBAL_argsummaryDESCR:
	      defwhy = "passed by descriptor";
	      break;

	    case FFEGLOBAL_argsummaryPROC:
	      defwhy = "a procedure";
	      break;

	    case FFEGLOBAL_argsummarySUBR:
	      defwhy = "a subroutine";
	      break;

	    case FFEGLOBAL_argsummaryFUNC:
	      defwhy = "a function";
	      break;

	    case FFEGLOBAL_argsummaryALTRTN:
	      defwhy = "an alternate-return label";
	      break;

#if 0
	    case FFEGLOBAL_argsummaryPTR:
	      defwhy = "a pointer";
	      break;
#endif

	    default:
	      defwhy = "???";
	      break;
	    }
	}

      if (!fail && !warn
	  && (bt != FFEINFO_basictypeHOLLERITH)
	  && (bt != FFEINFO_basictypeTYPELESS)
	  && (bt != FFEINFO_basictypeNONE)
	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
	  && (ai->bt != FFEINFO_basictypeNONE)
	  && (ai->bt != FFEINFO_basictypeTYPELESS))
	{
	  /* Check types.  */

	  if ((bt != ai->bt)
	      && ((bt != FFEINFO_basictypeREAL)
		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
	      && ((bt != FFEINFO_basictypeCOMPLEX)
		  || (ai->bt != FFEINFO_basictypeREAL)))
	    {
	      if (((bt == FFEINFO_basictypeINTEGER)
		   && (ai->bt == FFEINFO_basictypeLOGICAL))
		  || ((bt == FFEINFO_basictypeLOGICAL)
		   && (ai->bt == FFEINFO_basictypeINTEGER)))
		warn = TRUE;	/* We can cope with these differences. */
	      else
		fail = TRUE;
	      refwhy = "one type";
	      defwhy = "some other type";
	    }

	  if (!fail && !warn && (kt != ai->kt))
	    {
	      fail = TRUE;
	      refwhy = "one precision";
	      defwhy = "some other precision";
	    }
	}

      if (fail && ! g->u.proc.defined)
	{
	  /* No point failing if we're worried only about invocations.  */
	  fail = FALSE;
	  warn = TRUE;
	}

      if (fail && ! ffe_is_globals ())
	{
	  warn = TRUE;
	  fail = FALSE;
	}

      if (fail || (warn && ffe_is_warn_globals ()))
	{
	  char num[60];

	  if (ai->name == NULL)
	    sprintf (&num[0], "%d", argno + 1);
	  else
	    {
	      if (strlen (ai->name) < 30)
		sprintf (&num[0], "%d (named `%s')", argno + 1, ai->name);
	      else
		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, ai->name);
	    }
	  ffebad_start (fail ? FFEBAD_FILEWIDE_ARG : FFEBAD_FILEWIDE_ARG_W);
	  ffebad_string (ffesymbol_text (s));
	  ffebad_string (num);
	  ffebad_string (refwhy);
	  ffebad_string (defwhy);
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
	  ffebad_finish ();
	  return (fail ? FALSE : TRUE);
	}

      if (warn)
	return TRUE;
    }

  /* Define this argument.  */

  if (ai->t != NULL)
    ffelex_token_kill (ai->t);
  if ((as != FFEGLOBAL_argsummaryPROC)
      || (ai->t == NULL))
    ai->as = as;
  ai->t = ffelex_token_use (g->t);
  ai->name = NULL;
  ai->bt = bt;
  ai->kt = kt;
  ai->array = array;
  return TRUE;
}

bool
ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t)