target.c

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

  if (size == 0)
    res->text = NULL;
  else
    {
      res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
      res->text[size] = '\0';
      if (((size_t) size) <= size_of)
	{
	  int i = size_of - size;

	  memcpy (res->text, p + i, size);
	  for (; i > 0; ++p, --i)
	    if (*p != 0)
	      return FFEBAD_TRUNCATING_TYPELESS;
	}
      else
	{
	  int i = size - size_of;

	  memset (res->text, 0, i);
	  memcpy (res->text + i, p, size_of);
	}
    }

  if (l1 != l)
    return FFEBAD_TRUNCATING_TYPELESS;
  return FFEBAD;
}

#endif
/* ffetarget_divide_complex1 -- Divide function

   See prototype.  */

#if FFETARGET_okCOMPLEX1
ffebad
ffetarget_divide_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
			   ffetargetComplex1 r)
{
  ffebad bad;
  ffetargetReal1 tmp1, tmp2, tmp3, tmp4;

  bad = ffetarget_multiply_real1 (&tmp1, r.real, r.real);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_multiply_real1 (&tmp2, r.imaginary, r.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_add_real1 (&tmp3, tmp1, tmp2);
  if (bad != FFEBAD)
    return bad;

  if (ffetarget_iszero_real1 (tmp3))
    {
      ffetarget_real1_zero (&(res)->real);
      ffetarget_real1_zero (&(res)->imaginary);
      return FFEBAD_DIV_BY_ZERO;
    }

  bad = ffetarget_multiply_real1 (&tmp1, l.real, r.real);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, r.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_add_real1 (&tmp4, tmp1, tmp2);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_divide_real1 (&res->real, tmp4, tmp3);
  if (bad != FFEBAD)
    return bad;

  bad = ffetarget_multiply_real1 (&tmp1, r.real, l.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_multiply_real1 (&tmp2, l.real, r.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_subtract_real1 (&tmp4, tmp1, tmp2);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_divide_real1 (&res->imaginary, tmp4, tmp3);

  return FFEBAD;
}

#endif
/* ffetarget_divide_complex2 -- Divide function

   See prototype.  */

#if FFETARGET_okCOMPLEX2
ffebad
ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
			   ffetargetComplex2 r)
{
  ffebad bad;
  ffetargetReal2 tmp1, tmp2, tmp3, tmp4;

  bad = ffetarget_multiply_real2 (&tmp1, r.real, r.real);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_multiply_real2 (&tmp2, r.imaginary, r.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_add_real2 (&tmp3, tmp1, tmp2);
  if (bad != FFEBAD)
    return bad;

  if (ffetarget_iszero_real2 (tmp3))
    {
      ffetarget_real2_zero (&(res)->real);
      ffetarget_real2_zero (&(res)->imaginary);
      return FFEBAD_DIV_BY_ZERO;
    }

  bad = ffetarget_multiply_real2 (&tmp1, l.real, r.real);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, r.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_add_real2 (&tmp4, tmp1, tmp2);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_divide_real2 (&res->real, tmp4, tmp3);
  if (bad != FFEBAD)
    return bad;

  bad = ffetarget_multiply_real2 (&tmp1, r.real, l.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_multiply_real2 (&tmp2, l.real, r.imaginary);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_subtract_real2 (&tmp4, tmp1, tmp2);
  if (bad != FFEBAD)
    return bad;
  bad = ffetarget_divide_real2 (&res->imaginary, tmp4, tmp3);

  return FFEBAD;
}

#endif
/* ffetarget_hollerith -- Convert token to a hollerith constant

   Always append a null byte to the end, in case this is wanted in
   a special case such as passing a string as a FORMAT or %REF.
   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
   because it isn't a "feature" that is self-documenting.  Use the
   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
   in the code.  */

bool
ffetarget_hollerith (ffetargetHollerith *val, ffelexToken integer,
		     mallocPool pool)
{
  val->length = ffelex_token_length (integer);
  val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length + 1);
  memcpy (val->text, ffelex_token_text (integer), val->length);
  val->text[val->length] = '\0';

  return TRUE;
}

/* ffetarget_integer_bad_magical -- Complain about a magical number

   Just calls ffebad with the arguments.  */

void
ffetarget_integer_bad_magical (ffelexToken t)
{
  ffebad_start (FFEBAD_BAD_MAGICAL);
  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
  ffebad_finish ();
}

/* ffetarget_integer_bad_magical_binary -- Complain about a magical number

   Just calls ffebad with the arguments.  */

void
ffetarget_integer_bad_magical_binary (ffelexToken integer,
				      ffelexToken minus)
{
  ffebad_start (FFEBAD_BAD_MAGICAL_BINARY);
  ffebad_here (0, ffelex_token_where_line (integer),
	       ffelex_token_where_column (integer));
  ffebad_here (1, ffelex_token_where_line (minus),
	       ffelex_token_where_column (minus));
  ffebad_finish ();
}

/* ffetarget_integer_bad_magical_precedence -- Complain about a magical
						   number

   Just calls ffebad with the arguments.  */

void
ffetarget_integer_bad_magical_precedence (ffelexToken integer,
					  ffelexToken uminus,
					  ffelexToken higher_op)
{
  ffebad_start (FFEBAD_BAD_MAGICAL_PRECEDENCE);
  ffebad_here (0, ffelex_token_where_line (integer),
	       ffelex_token_where_column (integer));
  ffebad_here (1, ffelex_token_where_line (uminus),
	       ffelex_token_where_column (uminus));
  ffebad_here (2, ffelex_token_where_line (higher_op),
	       ffelex_token_where_column (higher_op));
  ffebad_finish ();
}

/* ffetarget_integer_bad_magical_precedence_binary -- Complain...

   Just calls ffebad with the arguments.  */

void
ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer,
						 ffelexToken minus,
						 ffelexToken higher_op)
{
  ffebad_start (FFEBAD_BAD_MAGICAL_PRECEDENCE_BINARY);
  ffebad_here (0, ffelex_token_where_line (integer),
	       ffelex_token_where_column (integer));
  ffebad_here (1, ffelex_token_where_line (minus),
	       ffelex_token_where_column (minus));
  ffebad_here (2, ffelex_token_where_line (higher_op),
	       ffelex_token_where_column (higher_op));
  ffebad_finish ();
}

/* ffetarget_integer1 -- Convert token to an integer

   See prototype.

   Token use count not affected overall.  */

#if FFETARGET_okINTEGER1
bool
ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer)
{
  ffetargetInteger1 x;
  char *p;
  char c;

  assert (ffelex_token_type (integer) == FFELEX_typeNUMBER);

  p = ffelex_token_text (integer);
  x = 0;

  /* Skip past leading zeros. */

  while (((c = *p) != '\0') && (c == '0'))
    ++p;

  /* Interpret rest of number. */

  while (c != '\0')
    {
      if ((x == FFETARGET_integerALMOST_BIG_MAGICAL)
	  && (c == '0' + FFETARGET_integerFINISH_BIG_MAGICAL)
	  && (*(p + 1) == '\0'))
	{
	  *val = (ffetargetInteger1) FFETARGET_integerBIG_MAGICAL;
	  return TRUE;
	}
      else if (x == FFETARGET_integerALMOST_BIG_MAGICAL)
	{
	  if ((c > '0' + FFETARGET_integerFINISH_BIG_MAGICAL)
	      || (*(p + 1) != '\0'))
	    {
	      ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
	      ffebad_here (0, ffelex_token_where_line (integer),
			   ffelex_token_where_column (integer));
	      ffebad_finish ();
	      *val = 0;
	      return FALSE;
	    }
	}
      else if (x > FFETARGET_integerALMOST_BIG_MAGICAL)
	{
	  ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
	  ffebad_here (0, ffelex_token_where_line (integer),
		       ffelex_token_where_column (integer));
	  ffebad_finish ();
	  *val = 0;
	  return FALSE;
	}
      x = x * 10 + c - '0';
      c = *(++p);
    };

  *val = x;
  return TRUE;
}

#endif
/* ffetarget_integerbinary -- Convert token to a binary integer

   ffetarget_integerbinary x;
   if (ffetarget_integerdefault_8(&x,integer_token))
       // conversion ok.

   Token use count not affected overall.  */

bool
ffetarget_integerbinary (ffetargetIntegerDefault *val, ffelexToken integer)
{
  ffetargetIntegerDefault x;
  char *p;
  char c;
  bool bad_digit;

  assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
	  || (ffelex_token_type (integer) == FFELEX_typeNUMBER));

  p = ffelex_token_text (integer);
  x = 0;

  /* Skip past leading zeros. */

  while (((c = *p) != '\0') && (c == '0'))
    ++p;

  /* Interpret rest of number. */

  bad_digit = FALSE;
  while (c != '\0')
    {
      if ((c >= '0') && (c <= '1'))
	c -= '0';
      else
	{
	  bad_digit = TRUE;
	  c = 0;
	}

#if 0				/* Don't complain about signed overflow; just
				   unsigned overflow. */
      if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
	  && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY)
	  && (*(p + 1) == '\0'))
	{
	  *val = FFETARGET_integerBIG_OVERFLOW_BINARY;
	  return TRUE;
	}
      else
#endif
#if FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY == 0
      if ((x & FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY) != 0)
#else
      if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
	{
	  if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY)
	      || (*(p + 1) != '\0'))
	    {
	      ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
	      ffebad_here (0, ffelex_token_where_line (integer),
			   ffelex_token_where_column (integer));
	      ffebad_finish ();
	      *val = 0;
	      return FALSE;
	    }
	}
      else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
#endif
	{
	  ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
	  ffebad_here (0, ffelex_token_where_line (integer),
		       ffelex_token_where_column (integer));
	  ffebad_finish ();
	  *val = 0;
	  return FALSE;
	}
      x = (x << 1) + c;
      c = *(++p);
    };

  if (bad_digit)
    {
      ffebad_start (FFEBAD_INVALID_BINARY_DIGIT);
      ffebad_here (0, ffelex_token_where_line (integer),
		   ffelex_token_where_column (integer));
      ffebad_finish ();
    }

  *val = x;
  return !bad_digit;
}

/* ffetarget_integerhex -- Convert token to a hex integer

   ffetarget_integerhex x;
   if (ffetarget_integerdefault_8(&x,integer_token))
       // conversion ok.

   Token use count not affected overall.  */

bool
ffetarget_integerhex (ffetargetIntegerDefault *val, ffelexToken integer)
{
  ffetargetIntegerDefault x;
  char *p;
  char c;
  bool bad_digit;

  assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
	  || (ffelex_token_type (integer) == FFELEX_typeNUMBER));

  p = ffelex_token_text (integer);
  x = 0;

  /* Skip past leading zeros. */

  while (((c = *p) != '\0') && (c == '0'))
    ++p;

  /* Interpret rest of number. */

  bad_digit = FALSE;
  while (c != '\0')
    {
      if ((c >= 'A') && (c <= 'F'))
	c = c - 'A' + 10;
      else if ((c >= 'a') && (c <= 'f'))
	c = c - 'a' + 10;
      else if ((c >= '0') && (c <= '9'))
	c -= '0';
      else
	{
	  bad_digit = TRUE;
	  c = 0;
	}

#if 0				/* Don't complain about signed overflow; just
				   unsigned overflow. */
      if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
	  && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_HEX)
	  && (*(p + 1) == '\0'))
	{
	  *val = FFETARGET_integerBIG_OVERFLOW_HEX;
	  return TRUE;
	}
      else
#endif
#if FFETARGET_integerFINISH_BIG_OVERFLOW_HEX == 0
      if (x >= FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
#else
      if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
	{
	  if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_HEX)
	      || (*(p + 1) != '\0'))
	    {
	      ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
	      ffebad_here (0, ffelex_token_where_line (integer),
			   ffelex_token_where_column (integer));
	      ffebad_finish ();
	      *val = 0;
	      return FALSE;
	    }
	}
      else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
#endif
	{
	  ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
	  ffebad_here (0, ffelex_token_where_line (integer),
		       ffelex_token_where_column (integer));
	  ffebad_finish ();
	  *val = 0;
	  return FALSE;
	}
      x = (x << 4) + c;
      c = *(++p);
    };

  if (bad_digit)
    {
      ffebad_start (FFEBAD_INVALID_HEX_DIGIT);
      ffebad_here (0, ffelex_token_where_line (integer),
		   ffelex_token_where_column (integer));
      ffebad_finish ();
    }

  *val = x;
  return !bad_digit;
}

/* ffetarget_integeroctal -- Convert token to an octal integer

   ffetarget_integeroctal x;
   if (ffetarget_integerdefault_8(&x,integer_token))
       // conversion ok.

   Token use count not affected overall.  */

bool
ffetarget_integeroctal (ffetargetIntegerDefault *val, ffelexToken integer)
{
  ffetargetIntegerDefault x;
  char *p;
  char c;
  bool bad_digit;

  assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
	  || (ffelex_token_type (integer) == FFELEX_typeNUMBER));

  p = ffelex_token_text (integer);
  x = 0;

  /* Skip past leading zeros. */

  while (((c = *p) != '\0') && (c == '0'))