[deliverable/binutils-gdb.git] / gas / config / atof-vax.c

/* atof_vax.c - turn a Flonum into a VAX floating point number
   Copyright 1987, 1992, 1993, 1995, 1997, 1999, 2000
   Free Software Foundation, Inc.

   This file is part of GAS, the GNU Assembler.

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

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

#include "as.h"

static int atof_vax_sizeof PARAMS ((int));
static int next_bits PARAMS ((int));
static void make_invalid_floating_point_number PARAMS ((LITTLENUM_TYPE *));
static int what_kind_of_float PARAMS ((int, int *, long *));
static char *atof_vax PARAMS ((char *, int, LITTLENUM_TYPE *));

/* Precision in LittleNums.  */
#define MAX_PRECISION (8)
#define H_PRECISION (8)
#define G_PRECISION (4)
#define D_PRECISION (4)
#define F_PRECISION (2)

/* Length in LittleNums of guard bits.  */
#define GUARD (2)

int flonum_gen2vax PARAMS ((int format_letter, FLONUM_TYPE * f,
			    LITTLENUM_TYPE * words));

/* Number of chars in flonum type 'letter'.  */
static int
atof_vax_sizeof (letter)
     int letter;
{
  int return_value;

  /*
   * Permitting uppercase letters is probably a bad idea.
   * Please use only lower-cased letters in case the upper-cased
   * ones become unsupported!
   */
  switch (letter)
    {
    case 'f':
    case 'F':
      return_value = 4;
      break;

    case 'd':
    case 'D':
    case 'g':
    case 'G':
      return_value = 8;
      break;

    case 'h':
    case 'H':
      return_value = 16;
      break;

    default:
      return_value = 0;
      break;
    }
  return (return_value);
}				/* atof_vax_sizeof */

static const long mask[] =
{
  0x00000000,
  0x00000001,
  0x00000003,
  0x00000007,
  0x0000000f,
  0x0000001f,
  0x0000003f,
  0x0000007f,
  0x000000ff,
  0x000001ff,
  0x000003ff,
  0x000007ff,
  0x00000fff,
  0x00001fff,
  0x00003fff,
  0x00007fff,
  0x0000ffff,
  0x0001ffff,
  0x0003ffff,
  0x0007ffff,
  0x000fffff,
  0x001fffff,
  0x003fffff,
  0x007fffff,
  0x00ffffff,
  0x01ffffff,
  0x03ffffff,
  0x07ffffff,
  0x0fffffff,
  0x1fffffff,
  0x3fffffff,
  0x7fffffff,
  0xffffffff
};
\f

/* Shared between flonum_gen2vax and next_bits */
static int bits_left_in_littlenum;
static LITTLENUM_TYPE *littlenum_pointer;
static LITTLENUM_TYPE *littlenum_end;

static int
next_bits (number_of_bits)
     int number_of_bits;
{
  int return_value;

  if (littlenum_pointer < littlenum_end)
    return 0;
  if (number_of_bits >= bits_left_in_littlenum)
    {
      return_value = mask[bits_left_in_littlenum] & *littlenum_pointer;
      number_of_bits -= bits_left_in_littlenum;
      return_value <<= number_of_bits;
      bits_left_in_littlenum = LITTLENUM_NUMBER_OF_BITS - number_of_bits;
      littlenum_pointer--;
      if (littlenum_pointer >= littlenum_end)
	return_value |= ((*littlenum_pointer) >> (bits_left_in_littlenum)) & mask[number_of_bits];
    }
  else
    {
      bits_left_in_littlenum -= number_of_bits;
      return_value = mask[number_of_bits] & ((*littlenum_pointer) >> bits_left_in_littlenum);
    }
  return (return_value);
}

static void
make_invalid_floating_point_number (words)
     LITTLENUM_TYPE *words;
{
  *words = 0x8000;		/* Floating Reserved Operand Code */
}
\f
static int			/* 0 means letter is OK.  */
what_kind_of_float (letter, precisionP, exponent_bitsP)
     int letter;		/* In: lowercase please. What kind of float? */
     int *precisionP;		/* Number of 16-bit words in the float.  */
     long *exponent_bitsP;	/* Number of exponent bits.  */
{
  int retval;			/* 0: OK.  */

  retval = 0;
  switch (letter)
    {
    case 'f':
      *precisionP = F_PRECISION;
      *exponent_bitsP = 8;
      break;

    case 'd':
      *precisionP = D_PRECISION;
      *exponent_bitsP = 8;
      break;

    case 'g':
      *precisionP = G_PRECISION;
      *exponent_bitsP = 11;
      break;

    case 'h':
      *precisionP = H_PRECISION;
      *exponent_bitsP = 15;
      break;

    default:
      retval = 69;
      break;
    }
  return (retval);
}
\f
/***********************************************************************\
 *									*
 *	Warning: this returns 16-bit LITTLENUMs, because that is	*
 *	what the VAX thinks in. It is up to the caller to figure	*
 *	out any alignment problems and to conspire for the bytes/word	*
 *	to be emitted in the right order. Bigendians beware!		*
 *									*
 \***********************************************************************/

static char *				/* Return pointer past text consumed.  */
atof_vax (str, what_kind, words)
     char *str;			/* Text to convert to binary.  */
     int what_kind;		/* 'd', 'f', 'g', 'h' */
     LITTLENUM_TYPE *words;	/* Build the binary here.  */
{
  FLONUM_TYPE f;
  LITTLENUM_TYPE bits[MAX_PRECISION + MAX_PRECISION + GUARD];
  /* Extra bits for zeroed low-order bits.  */
  /* The 1st MAX_PRECISION are zeroed, */
  /* the last contain flonum bits.  */
  char *return_value;
  int precision;		/* Number of 16-bit words in the format.  */
  long exponent_bits;

  return_value = str;
  f.low = bits + MAX_PRECISION;
  f.high = NULL;
  f.leader = NULL;
  f.exponent = 0;
  f.sign = '\0';

  if (what_kind_of_float (what_kind, &precision, &exponent_bits))
    {
      return_value = NULL;	/* We lost.  */
      make_invalid_floating_point_number (words);
    }

  if (return_value)
    {
      memset (bits, '\0', sizeof (LITTLENUM_TYPE) * MAX_PRECISION);

      /* Use more LittleNums than seems */
      /* necessary: the highest flonum may have */
      /* 15 leading 0 bits, so could be useless.  */
      f.high = f.low + precision - 1 + GUARD;

      if (atof_generic (&return_value, ".", "eE", &f))
	{
	  make_invalid_floating_point_number (words);
	  return_value = NULL;	/* we lost */
	}
      else
	{
	  if (flonum_gen2vax (what_kind, &f, words))
	    {
	      return_value = NULL;
	    }
	}
    }
  return (return_value);
}				/* atof_vax() */
\f
/*
 * In: a flonum, a vax floating point format.
 * Out: a vax floating-point bit pattern.
 */

int				/* 0: OK.  */
flonum_gen2vax (format_letter, f, words)
     int format_letter;		/* One of 'd' 'f' 'g' 'h'.  */
     FLONUM_TYPE *f;
     LITTLENUM_TYPE *words;	/* Deliver answer here.  */
{
  LITTLENUM_TYPE *lp;
  int precision;
  long exponent_bits;
  int return_value;		/* 0 == OK.  */

  return_value = what_kind_of_float (format_letter, &precision, &exponent_bits);

  if (return_value != 0)
    {
      make_invalid_floating_point_number (words);
    }
  else
    {
      if (f->low > f->leader)
	{
	  /* 0.0e0 seen.  */
	  memset (words, '\0', sizeof (LITTLENUM_TYPE) * precision);
	}
      else
	{
	  long exponent_1;
	  long exponent_2;
	  long exponent_3;
	  long exponent_4;
	  int exponent_skippage;
	  LITTLENUM_TYPE word1;

	  /* JF: Deal with new Nan, +Inf and -Inf codes */
	  if (f->sign != '-' && f->sign != '+')
	    {
	      make_invalid_floating_point_number (words);
	      return return_value;
	    }
	  /*
			 * All vaxen floating_point formats (so far) have:
			 * Bit 15 is sign bit.
			 * Bits 14:n are excess-whatever exponent.
			 * Bits n-1:0 (if any) are most significant bits of fraction.
			 * Bits 15:0 of the next word are the next most significant bits.
			 * And so on for each other word.
			 *
			 * All this to be compatible with a KF11?? (Which is still faster
			 * than lots of vaxen I can think of, but it also has higher
			 * maintenance costs ... sigh).
			 *
			 * So we need: number of bits of exponent, number of bits of
			 * mantissa.
			 */

#ifdef NEVER			/******* This zeroing seems redundant - Dean 3may86 **********/
	  /*
			 * No matter how few bits we got back from the atof()
			 * routine, add enough zero littlenums so the rest of the
			 * code won't run out of "significant" bits in the mantissa.
			 */
	  {
	    LITTLENUM_TYPE *ltp;
	    for (ltp = f->leader + 1;
		 ltp <= f->low + precision;
		 ltp++)
	      {
		*ltp = 0;
	      }
	  }
#endif

	  bits_left_in_littlenum = LITTLENUM_NUMBER_OF_BITS;
	  littlenum_pointer = f->leader;
	  littlenum_end = f->low;
	  /* Seek (and forget) 1st significant bit */
	  for (exponent_skippage = 0;
	       !next_bits (1);
	       exponent_skippage++);;

	  exponent_1 = f->exponent + f->leader + 1 - f->low;
	  /* Radix LITTLENUM_RADIX, point just higher than f->leader.  */
	  exponent_2 = exponent_1 * LITTLENUM_NUMBER_OF_BITS;
	  /* Radix 2.  */
	  exponent_3 = exponent_2 - exponent_skippage;
	  /* Forget leading zeros, forget 1st bit.  */
	  exponent_4 = exponent_3 + (1 << (exponent_bits - 1));
	  /* Offset exponent.  */

	  if (exponent_4 & ~mask[exponent_bits])
	    {
	      /*
				 * Exponent overflow. Lose immediately.
				 */

	      make_invalid_floating_point_number (words);

	      /*
				 * We leave return_value alone: admit we read the
				 * number, but return a floating exception
				 * because we can't encode the number.
				 */
	    }
	  else
	    {
	      lp = words;

	      /* Word 1. Sign, exponent and perhaps high bits.  */
	      /* Assume 2's complement integers.  */
	      word1 = (((exponent_4 & mask[exponent_bits]) << (15 - exponent_bits))
		       | ((f->sign == '+') ? 0 : 0x8000)
		       | next_bits (15 - exponent_bits));
	      *lp++ = word1;

	      /* The rest of the words are just mantissa bits.  */
	      for (; lp < words + precision; lp++)
		{
		  *lp = next_bits (LITTLENUM_NUMBER_OF_BITS);
		}

	      if (next_bits (1))
		{
		  /*
					 * Since the NEXT bit is a 1, round UP the mantissa.
					 * The cunning design of these hidden-1 floats permits
					 * us to let the mantissa overflow into the exponent, and
					 * it 'does the right thing'. However, we lose if the
					 * highest-order bit of the lowest-order word flips.
					 * Is that clear?
					 */

		  unsigned long carry;

		  /*
					  #if (sizeof(carry)) < ((sizeof(bits[0]) * BITS_PER_CHAR) + 2)
					  Please allow at least 1 more bit in carry than is in a LITTLENUM.
					  We need that extra bit to hold a carry during a LITTLENUM carry
					  propagation. Another extra bit (kept 0) will assure us that we
					  don't get a sticky sign bit after shifting right, and that
					  permits us to propagate the carry without any masking of bits.
					  #endif
					  */
		  for (carry = 1, lp--;
		       carry && (lp >= words);
		       lp--)
		    {
		      carry = *lp + carry;
		      *lp = carry;
		      carry >>= LITTLENUM_NUMBER_OF_BITS;
		    }

		  if ((word1 ^ *words) & (1 << (LITTLENUM_NUMBER_OF_BITS - 1)))
		    {
		      make_invalid_floating_point_number (words);
		      /*
						 * We leave return_value alone: admit we read the
						 * number, but return a floating exception
						 * because we can't encode the number.
						 */
		    }
		}		/* if (we needed to round up) */
	    }			/* if (exponent overflow) */
	}			/* if (0.0e0) */
    }				/* if (float_type was OK) */
  return (return_value);
}				/* flonum_gen2vax() */

/* JF this used to be in vax.c but this looks like a better place for it */

/*
 *		md_atof()
 *
 * In:	input_line_pointer->the 1st character of a floating-point
 *		number.
 *	1 letter denoting the type of statement that wants a
 *		binary floating point number returned.
 *	Address of where to build floating point literal.
 *		Assumed to be 'big enough'.
 *	Address of where to return size of literal (in chars).
 *
 * Out:	Input_line_pointer->of next char after floating number.
 *	Error message, or 0.
 *	Floating point literal.
 *	Number of chars we used for the literal.
 */

#define MAXIMUM_NUMBER_OF_LITTLENUMS (8)	/* For .hfloats.  */

char *
md_atof (what_statement_type, literalP, sizeP)
     int what_statement_type;
     char *literalP;
     int *sizeP;
{
  LITTLENUM_TYPE words[MAXIMUM_NUMBER_OF_LITTLENUMS];
  register char kind_of_float;
  register int number_of_chars;
  register LITTLENUM_TYPE *littlenumP;

  switch (what_statement_type)
    {
    case 'F':			/* .float */
    case 'f':			/* .ffloat */
      kind_of_float = 'f';
      break;

    case 'D':			/* .double */
    case 'd':			/* .dfloat */
      kind_of_float = 'd';
      break;

    case 'g':			/* .gfloat */
      kind_of_float = 'g';
      break;

    case 'h':			/* .hfloat */
      kind_of_float = 'h';
      break;

    default:
      kind_of_float = 0;
      break;
    };

  if (kind_of_float)
    {
      register LITTLENUM_TYPE *limit;

      input_line_pointer = atof_vax (input_line_pointer,
				     kind_of_float,
				     words);
      /*
       * The atof_vax() builds up 16-bit numbers.
       * Since the assembler may not be running on
       * a little-endian machine, be very careful about
       * converting words to chars.
       */
      number_of_chars = atof_vax_sizeof (kind_of_float);
      know (number_of_chars <= MAXIMUM_NUMBER_OF_LITTLENUMS * sizeof (LITTLENUM_TYPE));
      limit = words + (number_of_chars / sizeof (LITTLENUM_TYPE));
      for (littlenumP = words; littlenumP < limit; littlenumP++)
	{
	  md_number_to_chars (literalP, *littlenumP, sizeof (LITTLENUM_TYPE));
	  literalP += sizeof (LITTLENUM_TYPE);
	};
    }
  else
    {
      number_of_chars = 0;
    };

  *sizeP = number_of_chars;
  return kind_of_float ? NULL : _("Bad call to md_atof()");
}

/* end of atof-vax.c */
Commit	Line	Data
252b5132	1	/* atof_vax.c - turn a Flonum into a VAX floating point number
f7e42eb4	2	Copyright 1987, 1992, 1993, 1995, 1997, 1999, 2000
12951dca	3	Free Software Foundation, Inc.
252b5132 RH	4
	5	This file is part of GAS, the GNU Assembler.
	6
	7	GAS is free software; you can redistribute it and/or modify
	8	it under the terms of the GNU General Public License as published by
	9	the Free Software Foundation; either version 2, or (at your option)
	10	any later version.
	11
	12	GAS is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
	17	You should have received a copy of the GNU General Public License
	18	along with GAS; see the file COPYING. If not, write to the Free
	19	Software Foundation, 59 Temple Place - Suite 330, Boston, MA
	20	02111-1307, USA. */
	21
	22	#include "as.h"
	23
	24	static int atof_vax_sizeof PARAMS ((int));
	25	static int next_bits PARAMS ((int));
	26	static void make_invalid_floating_point_number PARAMS ((LITTLENUM_TYPE *));
	27	static int what_kind_of_float PARAMS ((int, int , long ));
	28	static char atof_vax PARAMS ((char , int, LITTLENUM_TYPE *));
	29
4a1805b1	30	/* Precision in LittleNums. */
252b5132 RH	31	#define MAX_PRECISION (8)
	32	#define H_PRECISION (8)
	33	#define G_PRECISION (4)
	34	#define D_PRECISION (4)
	35	#define F_PRECISION (2)
	36
4a1805b1	37	/* Length in LittleNums of guard bits. */
252b5132 RH	38	#define GUARD (2)
	39
	40	int flonum_gen2vax PARAMS ((int format_letter, FLONUM_TYPE * f,
	41	LITTLENUM_TYPE * words));
	42
4a1805b1	43	/* Number of chars in flonum type 'letter'. */
252b5132 RH	44	static int
	45	atof_vax_sizeof (letter)
	46	int letter;
	47	{
	48	int return_value;
	49
	50	/*
	51	* Permitting uppercase letters is probably a bad idea.
	52	* Please use only lower-cased letters in case the upper-cased
	53	* ones become unsupported!
	54	*/
	55	switch (letter)
	56	{
	57	case 'f':
	58	case 'F':
	59	return_value = 4;
	60	break;
	61
	62	case 'd':
	63	case 'D':
	64	case 'g':
	65	case 'G':
	66	return_value = 8;
	67	break;
	68
	69	case 'h':
	70	case 'H':
	71	return_value = 16;
	72	break;
	73
	74	default:
	75	return_value = 0;
	76	break;
	77	}
	78	return (return_value);
	79	} /* atof_vax_sizeof */
	80
	81	static const long mask[] =
	82	{
	83	0x00000000,
	84	0x00000001,
	85	0x00000003,
	86	0x00000007,
	87	0x0000000f,
	88	0x0000001f,
	89	0x0000003f,
	90	0x0000007f,
	91	0x000000ff,
	92	0x000001ff,
	93	0x000003ff,
	94	0x000007ff,
	95	0x00000fff,
	96	0x00001fff,
	97	0x00003fff,
	98	0x00007fff,
	99	0x0000ffff,
	100	0x0001ffff,
	101	0x0003ffff,
	102	0x0007ffff,
	103	0x000fffff,
	104	0x001fffff,
	105	0x003fffff,
	106	0x007fffff,
	107	0x00ffffff,
108	0x01ffffff,
109	0x03ffffff,
110	0x07ffffff,
111	0x0fffffff,
112	0x1fffffff,
113	0x3fffffff,
114	0x7fffffff,
115	0xffffffff
116	};
117	\f
118
119	/* Shared between flonum_gen2vax and next_bits */
120	static int bits_left_in_littlenum;
121	static LITTLENUM_TYPE *littlenum_pointer;
122	static LITTLENUM_TYPE *littlenum_end;
123
124	static int
125	next_bits (number_of_bits)
126	int number_of_bits;
127	{
128	int return_value;
129
130	if (littlenum_pointer < littlenum_end)
131	return 0;
132	if (number_of_bits >= bits_left_in_littlenum)
133	{
134	return_value = mask[bits_left_in_littlenum] & *littlenum_pointer;
135	number_of_bits -= bits_left_in_littlenum;
136	return_value <<= number_of_bits;
137	bits_left_in_littlenum = LITTLENUM_NUMBER_OF_BITS - number_of_bits;
138	littlenum_pointer--;
139	if (littlenum_pointer >= littlenum_end)
140	return_value \|= ((*littlenum_pointer) >> (bits_left_in_littlenum)) & mask[number_of_bits];
141	}
142	else
143	{
144	bits_left_in_littlenum -= number_of_bits;
145	return_value = mask[number_of_bits] & ((*littlenum_pointer) >> bits_left_in_littlenum);
146	}
147	return (return_value);
148	}
149
150	static void
151	make_invalid_floating_point_number (words)
152	LITTLENUM_TYPE *words;
153	{
154	words = 0x8000; / Floating Reserved Operand Code */
155	}
156	\f
4a1805b1	157	static int /* 0 means letter is OK. */
252b5132 RH	158	what_kind_of_float (letter, precisionP, exponent_bitsP)
252b5132 RH	159	int letter; /* In: lowercase please. What kind of float? */
4a1805b1 KH	160	int precisionP; / Number of 16-bit words in the float. */
4a1805b1 KH	161	long exponent_bitsP; / Number of exponent bits. */
252b5132	162	{
4a1805b1	163	int retval; /* 0: OK. */
252b5132 RH	164
	165	retval = 0;
	166	switch (letter)
	167	{
	168	case 'f':
	169	*precisionP = F_PRECISION;
	170	*exponent_bitsP = 8;
	171	break;
	172
	173	case 'd':
	174	*precisionP = D_PRECISION;
	175	*exponent_bitsP = 8;
	176	break;
	177
	178	case 'g':
	179	*precisionP = G_PRECISION;
	180	*exponent_bitsP = 11;
	181	break;
	182
	183	case 'h':
	184	*precisionP = H_PRECISION;
	185	*exponent_bitsP = 15;
	186	break;
	187
	188	default:
	189	retval = 69;
	190	break;
	191	}
	192	return (retval);
	193	}
	194	\f
	195	/***********************************************************************\
	196	* *
	197	* Warning: this returns 16-bit LITTLENUMs, because that is *
	198	* what the VAX thinks in. It is up to the caller to figure *
	199	* out any alignment problems and to conspire for the bytes/word *
	200	* to be emitted in the right order. Bigendians beware! *
	201	* *
	202	\***********************************************************************/
	203
4a1805b1	204	static char * /* Return pointer past text consumed. */
252b5132	205	atof_vax (str, what_kind, words)
4a1805b1	206	char str; / Text to convert to binary. */
252b5132	207	int what_kind; /* 'd', 'f', 'g', 'h' */
4a1805b1	208	LITTLENUM_TYPE words; / Build the binary here. */
252b5132 RH	209	{
	210	FLONUM_TYPE f;
	211	LITTLENUM_TYPE bits[MAX_PRECISION + MAX_PRECISION + GUARD];
4a1805b1	212	/* Extra bits for zeroed low-order bits. */
252b5132	213	/* The 1st MAX_PRECISION are zeroed, */
4a1805b1	214	/* the last contain flonum bits. */
252b5132	215	char *return_value;
4a1805b1	216	int precision; /* Number of 16-bit words in the format. */
252b5132 RH	217	long exponent_bits;
	218
	219	return_value = str;
	220	f.low = bits + MAX_PRECISION;
	221	f.high = NULL;
	222	f.leader = NULL;
	223	f.exponent = 0;
	224	f.sign = '\0';
	225
	226	if (what_kind_of_float (what_kind, &precision, &exponent_bits))
	227	{
4a1805b1	228	return_value = NULL; /* We lost. */
252b5132 RH	229	make_invalid_floating_point_number (words);
	230	}
	231
	232	if (return_value)
	233	{
	234	memset (bits, '\0', sizeof (LITTLENUM_TYPE) * MAX_PRECISION);
	235
	236	/* Use more LittleNums than seems */
	237	/* necessary: the highest flonum may have */
4a1805b1	238	/* 15 leading 0 bits, so could be useless. */
252b5132 RH	239	f.high = f.low + precision - 1 + GUARD;
	240
	241	if (atof_generic (&return_value, ".", "eE", &f))
	242	{
	243	make_invalid_floating_point_number (words);
	244	return_value = NULL; /* we lost */
	245	}
	246	else
	247	{
	248	if (flonum_gen2vax (what_kind, &f, words))
	249	{
	250	return_value = NULL;
	251	}
	252	}
	253	}
	254	return (return_value);
	255	} /* atof_vax() */
	256	\f
	257	/*
	258	* In: a flonum, a vax floating point format.
	259	* Out: a vax floating-point bit pattern.
	260	*/
	261
4a1805b1	262	int /* 0: OK. */
252b5132	263	flonum_gen2vax (format_letter, f, words)
4a1805b1	264	int format_letter; /* One of 'd' 'f' 'g' 'h'. */
252b5132	265	FLONUM_TYPE *f;
4a1805b1	266	LITTLENUM_TYPE words; / Deliver answer here. */
252b5132 RH	267	{
	268	LITTLENUM_TYPE *lp;
	269	int precision;
	270	long exponent_bits;
4a1805b1	271	int return_value; /* 0 == OK. */
252b5132 RH	272
	273	return_value = what_kind_of_float (format_letter, &precision, &exponent_bits);
	274
	275	if (return_value != 0)
	276	{
	277	make_invalid_floating_point_number (words);
	278	}
	279	else
	280	{
	281	if (f->low > f->leader)
	282	{
4a1805b1	283	/* 0.0e0 seen. */
252b5132 RH	284	memset (words, '\0', sizeof (LITTLENUM_TYPE) * precision);
	285	}
	286	else
	287	{
	288	long exponent_1;
	289	long exponent_2;
	290	long exponent_3;
	291	long exponent_4;
	292	int exponent_skippage;
	293	LITTLENUM_TYPE word1;
	294
	295	/* JF: Deal with new Nan, +Inf and -Inf codes */
	296	if (f->sign != '-' && f->sign != '+')
	297	{
	298	make_invalid_floating_point_number (words);
	299	return return_value;
	300	}
	301	/*
	302	* All vaxen floating_point formats (so far) have:
	303	* Bit 15 is sign bit.
	304	* Bits 14:n are excess-whatever exponent.
	305	* Bits n-1:0 (if any) are most significant bits of fraction.
	306	* Bits 15:0 of the next word are the next most significant bits.
	307	* And so on for each other word.
	308	*
	309	* All this to be compatible with a KF11?? (Which is still faster
	310	* than lots of vaxen I can think of, but it also has higher
	311	* maintenance costs ... sigh).
	312	*
	313	* So we need: number of bits of exponent, number of bits of
	314	* mantissa.
	315	*/
	316
	317	#ifdef NEVER /***** This zeroing seems redundant - Dean 3may86 ********/
	318	/*
	319	* No matter how few bits we got back from the atof()
	320	* routine, add enough zero littlenums so the rest of the
	321	* code won't run out of "significant" bits in the mantissa.
	322	*/
	323	{
	324	LITTLENUM_TYPE *ltp;
	325	for (ltp = f->leader + 1;
	326	ltp <= f->low + precision;
	327	ltp++)
	328	{
	329	*ltp = 0;
	330	}
	331	}
	332	#endif
	333
	334	bits_left_in_littlenum = LITTLENUM_NUMBER_OF_BITS;
	335	littlenum_pointer = f->leader;
	336	littlenum_end = f->low;
	337	/* Seek (and forget) 1st significant bit */
	338	for (exponent_skippage = 0;
	339	!next_bits (1);
	340	exponent_skippage++);;
	341
	342	exponent_1 = f->exponent + f->leader + 1 - f->low;
4a1805b1	343	/* Radix LITTLENUM_RADIX, point just higher than f->leader. */
252b5132	344	exponent_2 = exponent_1 * LITTLENUM_NUMBER_OF_BITS;
4a1805b1	345	/* Radix 2. */
252b5132	346	exponent_3 = exponent_2 - exponent_skippage;
4a1805b1	347	/* Forget leading zeros, forget 1st bit. */
252b5132	348	exponent_4 = exponent_3 + (1 << (exponent_bits - 1));
4a1805b1	349	/* Offset exponent. */
252b5132 RH	350
	351	if (exponent_4 & ~mask[exponent_bits])
	352	{
	353	/*
	354	* Exponent overflow. Lose immediately.
	355	*/
	356
	357	make_invalid_floating_point_number (words);
	358
	359	/*
	360	* We leave return_value alone: admit we read the
	361	* number, but return a floating exception
	362	* because we can't encode the number.
	363	*/
	364	}
	365	else
	366	{
	367	lp = words;
	368
4a1805b1 KH	369	/* Word 1. Sign, exponent and perhaps high bits. */
4a1805b1 KH	370	/* Assume 2's complement integers. */
252b5132 RH	371	word1 = (((exponent_4 & mask[exponent_bits]) << (15 - exponent_bits))
	372	\| ((f->sign == '+') ? 0 : 0x8000)
	373	\| next_bits (15 - exponent_bits));
	374	*lp++ = word1;
	375
4a1805b1	376	/* The rest of the words are just mantissa bits. */
252b5132 RH	377	for (; lp < words + precision; lp++)
	378	{
	379	*lp = next_bits (LITTLENUM_NUMBER_OF_BITS);
	380	}
	381
	382	if (next_bits (1))
	383	{
	384	/*
	385	* Since the NEXT bit is a 1, round UP the mantissa.
	386	* The cunning design of these hidden-1 floats permits
	387	* us to let the mantissa overflow into the exponent, and
	388	* it 'does the right thing'. However, we lose if the
	389	* highest-order bit of the lowest-order word flips.
	390	* Is that clear?
	391	*/
	392
	393	unsigned long carry;
	394
	395	/*
	396	#if (sizeof(carry)) < ((sizeof(bits[0]) * BITS_PER_CHAR) + 2)
	397	Please allow at least 1 more bit in carry than is in a LITTLENUM.
	398	We need that extra bit to hold a carry during a LITTLENUM carry
	399	propagation. Another extra bit (kept 0) will assure us that we
	400	don't get a sticky sign bit after shifting right, and that
	401	permits us to propagate the carry without any masking of bits.
	402	#endif
	403	*/
	404	for (carry = 1, lp--;
	405	carry && (lp >= words);
	406	lp--)
	407	{
	408	carry = *lp + carry;
	409	*lp = carry;
	410	carry >>= LITTLENUM_NUMBER_OF_BITS;
	411	}
	412
	413	if ((word1 ^ *words) & (1 << (LITTLENUM_NUMBER_OF_BITS - 1)))
	414	{
	415	make_invalid_floating_point_number (words);
	416	/*
	417	* We leave return_value alone: admit we read the
	418	* number, but return a floating exception
	419	* because we can't encode the number.
	420	*/
	421	}
	422	} /* if (we needed to round up) */
	423	} /* if (exponent overflow) */
	424	} /* if (0.0e0) */
	425	} /* if (float_type was OK) */
	426	return (return_value);
	427	} /* flonum_gen2vax() */
	428
252b5132 RH	429	/* JF this used to be in vax.c but this looks like a better place for it */
	430
	431	/*
	432	* md_atof()
	433	*
	434	* In: input_line_pointer->the 1st character of a floating-point
	435	* number.
	436	* 1 letter denoting the type of statement that wants a
	437	* binary floating point number returned.
	438	* Address of where to build floating point literal.
	439	* Assumed to be 'big enough'.
	440	* Address of where to return size of literal (in chars).
	441	*
	442	* Out: Input_line_pointer->of next char after floating number.
	443	* Error message, or 0.
	444	* Floating point literal.
	445	* Number of chars we used for the literal.
	446	*/
	447
4a1805b1	448	#define MAXIMUM_NUMBER_OF_LITTLENUMS (8) /* For .hfloats. */
252b5132 RH	449
	450	char *
	451	md_atof (what_statement_type, literalP, sizeP)
	452	int what_statement_type;
	453	char *literalP;
	454	int *sizeP;
	455	{
	456	LITTLENUM_TYPE words[MAXIMUM_NUMBER_OF_LITTLENUMS];
	457	register char kind_of_float;
	458	register int number_of_chars;
	459	register LITTLENUM_TYPE *littlenumP;
	460
	461	switch (what_statement_type)
	462	{
	463	case 'F': /* .float */
	464	case 'f': /* .ffloat */
	465	kind_of_float = 'f';
	466	break;
	467
	468	case 'D': /* .double */
	469	case 'd': /* .dfloat */
	470	kind_of_float = 'd';
	471	break;
	472
	473	case 'g': /* .gfloat */
	474	kind_of_float = 'g';
	475	break;
	476
	477	case 'h': /* .hfloat */
	478	kind_of_float = 'h';
	479	break;
	480
	481	default:
	482	kind_of_float = 0;
	483	break;
	484	};
	485
	486	if (kind_of_float)
	487	{
	488	register LITTLENUM_TYPE *limit;
	489
	490	input_line_pointer = atof_vax (input_line_pointer,
	491	kind_of_float,
	492	words);
	493	/*
	494	* The atof_vax() builds up 16-bit numbers.
	495	* Since the assembler may not be running on
	496	* a little-endian machine, be very careful about
	497	* converting words to chars.
	498	*/
	499	number_of_chars = atof_vax_sizeof (kind_of_float);
	500	know (number_of_chars <= MAXIMUM_NUMBER_OF_LITTLENUMS * sizeof (LITTLENUM_TYPE));
	501	limit = words + (number_of_chars / sizeof (LITTLENUM_TYPE));
	502	for (littlenumP = words; littlenumP < limit; littlenumP++)
	503	{
	504	md_number_to_chars (literalP, *littlenumP, sizeof (LITTLENUM_TYPE));
	505	literalP += sizeof (LITTLENUM_TYPE);
	506	};
	507	}
	508	else
	509	{
	510	number_of_chars = 0;
	511	};
	512
513	*sizeP = number_of_chars;
2ab9b79e	514	return kind_of_float ? NULL : _("Bad call to md_atof()");
252b5132 RH	515	}
	516
	517	/* end of atof-vax.c */