comparison src/lread.c @ 71984:bb119ed4db49

(Fload): Use xsignal2, signal_error. (end_of_file_error): Use xsignal0, xsignal1. (read0): Use xsignal1. (invalid_syntax): New error function marked no-return. (read_integer, read1, read_list): Use it.

71983:d9eba6509dd1

			      Lisp_Object (*) (), int,
			      Lisp_Object, Lisp_Object,
			      Lisp_Object, Lisp_Object));
static Lisp_Object load_unwind P_ ((Lisp_Object));
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));


/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
   UNREAD(c) to unread c to be read again.

    }

  if (fd == -1)
    {
      if (NILP (noerror))
	Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
				     Fcons (file, Qnil)));
      else
	return Qnil;
    }

  /* Tell startup.el whether or not we found the user's init file.  */
  if (EQ (Qt, Vuser_init_file))
    Vuser_init_file = found;

	count++;
    if (count > 3)
      {
	if (fd >= 0)
	  emacs_close (fd);
	Fsignal (Qerror, Fcons (build_string ("Recursive load"),
				Fcons (found, Vloads_in_progress)));
      }
    record_unwind_protect (record_load_unwind, Vloads_in_progress);
    Vloads_in_progress = Fcons (found, Vloads_in_progress);
  }

end_of_file_error ()
{
  Lisp_Object data;

  if (STRINGP (Vload_file_name))
    data = Fcons (Vload_file_name, Qnil);
  else
    data = Qnil;

  Fsignal (Qend_of_file, data);
}

/* UNIBYTE specifies how to set load_convert_to_unibyte
   for this invocation.
   READFUN, if non-nil, is used instead of `read'.

      || EQ (Vread_with_symbol_positions, stream))
    Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
  return retval;
}

/* Use this for recursive reads, in contexts where internal tokens
   are not allowed. */

static Lisp_Object
read0 (readcharfun)

{
  register Lisp_Object val;
  int c;

  val = read1 (readcharfun, &c, 0);
  if (c)
    Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1),
							make_number (c)),
					  Qnil));

  return val;
}

static int read_buffer_size;
static char *read_buffer;

	c = read_multibyte (c, readcharfun);
      return c;
    }
}


/* Read an integer in radix RADIX using READCHARFUN to read
   characters.  RADIX must be in the interval [2..36]; if it isn't, a
   read error is signaled .  Value is the integer read.  Signals an
   error if encountering invalid read syntax or if RADIX is out of
   range.  */

  if (ndigits == 0 || invalid_p)
    {
      char buf[50];
      sprintf (buf, "integer, radix %d", radix);
      Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
    }

  return make_number (sign * number);
}

		    error ("Invalid size char-table");
		  XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
		  XCHAR_TABLE (tmp)->top = Qnil;
		  return tmp;
		}
	      Fsignal (Qinvalid_read_syntax,
		       Fcons (make_string ("#^^", 3), Qnil));
	    }
	  Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil));
	}
      if (c == '&')
	{
	  Lisp_Object length;
	  length = read1 (readcharfun, pch, first_in_list);

		  /* We used to print 1 char too many
		     when the number of bits was a multiple of 8.
		     Accept such input in case it came from an old version.  */
		  && ! (XFASTINT (length)
			== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
		Fsignal (Qinvalid_read_syntax,
			 Fcons (make_string ("#&...", 5), Qnil));

	      val = Fmake_bool_vector (length, Qnil);
	      bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
		     size_in_chars);
	      /* Clear the extraneous bits in the last byte.  */
	      if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
		XBOOL_VECTOR (val)->data[size_in_chars - 1]
		  &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
	      return val;
	    }
	  Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
						Qnil));
	}
      if (c == '[')
	{
	  /* Accept compiled functions at read-time so that we don't have to
	     build them using function calls.  */

	  int ch;

	  /* Read the string itself.  */
	  tmp = read1 (readcharfun, &ch, 0);
	  if (ch != 0 || !STRINGP (tmp))
	    Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
	  GCPRO1 (tmp);
	  /* Read the intervals and their properties.  */
	  while (1)
	    {
	      Lisp_Object beg, end, plist;

	      if (ch == 0)
		end = read1 (readcharfun, &ch, 0);
	      if (ch == 0)
		plist = read1 (readcharfun, &ch, 0);
	      if (ch)
		Fsignal (Qinvalid_read_syntax,
			 Fcons (build_string ("invalid string property list"),
				Qnil));
	      Fset_text_properties (beg, end, plist, tmp);
	    }
	  UNGCPRO;
	  return tmp;
	}

	return read_integer (readcharfun, 8);
      else if (c == 'b' || c == 'B')
	return read_integer (readcharfun, 2);

      UNREAD (c);
      Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));

    case ';':
      while ((c = READCHAR) >= 0 && c != '\n');
      goto retry;

		      && (index ("\"';()[]#?", next_char)
			  || (!first_in_list && next_char == '`')
			  || (new_backquote_flag && next_char == ','))));
	  }
	UNREAD (next_char);
	if (!ok)
	  Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));

	return make_number (c);
      }

    case '"':
      {
	char *p = read_buffer;

	{
	  if (flag > 0)
	    {
	      if (ch == ']')
		return val;
	      Fsignal (Qinvalid_read_syntax,
		       Fcons (make_string (") or . in a vector", 18), Qnil));
	    }
	  if (ch == ')')
	    return val;
	  if (ch == '.')
	    {

			return get_doc_string (val, 0, 0);
		    }

		  return val;
		}
	      return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
	    }
	  return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
	}
      tem = (read_pure && flag <= 0
	     ? pure_cons (elt, Qnil)
	     : Fcons (elt, Qnil));
      if (!NILP (tail))

71984:bb119ed4db49

			      Lisp_Object (*) (), int,
			      Lisp_Object, Lisp_Object,
			      Lisp_Object, Lisp_Object));
static Lisp_Object load_unwind P_ ((Lisp_Object));
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));

static void invalid_syntax P_ ((const char *, int)) NO_RETURN;


/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
   UNREAD(c) to unread c to be read again.

    }

  if (fd == -1)
    {
      if (NILP (noerror))
	xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
      return Qnil;
    }

  /* Tell startup.el whether or not we found the user's init file.  */
  if (EQ (Qt, Vuser_init_file))
    Vuser_init_file = found;

	count++;
    if (count > 3)
      {
	if (fd >= 0)
	  emacs_close (fd);
	signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
      }
    record_unwind_protect (record_load_unwind, Vloads_in_progress);
    Vloads_in_progress = Fcons (found, Vloads_in_progress);
  }

end_of_file_error ()
{
  Lisp_Object data;

  if (STRINGP (Vload_file_name))
    xsignal1 (Qend_of_file, Vload_file_name);

  xsignal0 (Qend_of_file);
}

/* UNIBYTE specifies how to set load_convert_to_unibyte
   for this invocation.
   READFUN, if non-nil, is used instead of `read'.

      || EQ (Vread_with_symbol_positions, stream))
    Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
  return retval;
}


/* Signal Qinvalid_read_syntax error.
   S is error string of length N (if > 0)  */

static void
invalid_syntax (s, n)
     const char *s;
     int n;
{
  if (!n)
    n = strlen (s);
  xsignal1 (Qinvalid_read_syntax, make_string (s, n));
}


/* Use this for recursive reads, in contexts where internal tokens
   are not allowed. */

static Lisp_Object
read0 (readcharfun)

{
  register Lisp_Object val;
  int c;

  val = read1 (readcharfun, &c, 0);
  if (!c)
    return val;

  xsignal1 (Qinvalid_read_syntax,
	    Fmake_string (make_number (1), make_number (c)));
}

static int read_buffer_size;
static char *read_buffer;

	c = read_multibyte (c, readcharfun);
      return c;
    }
}

/* Read an integer in radix RADIX using READCHARFUN to read
   characters.  RADIX must be in the interval [2..36]; if it isn't, a
   read error is signaled .  Value is the integer read.  Signals an
   error if encountering invalid read syntax or if RADIX is out of
   range.  */

  if (ndigits == 0 || invalid_p)
    {
      char buf[50];
      sprintf (buf, "integer, radix %d", radix);
      invalid_syntax (buf, 0);
    }

  return make_number (sign * number);
}

		    error ("Invalid size char-table");
		  XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
		  XCHAR_TABLE (tmp)->top = Qnil;
		  return tmp;
		}
	      invalid_syntax ("#^^", 3);
	    }
	  invalid_syntax ("#^", 2);
	}
      if (c == '&')
	{
	  Lisp_Object length;
	  length = read1 (readcharfun, pch, first_in_list);

		  /* We used to print 1 char too many
		     when the number of bits was a multiple of 8.
		     Accept such input in case it came from an old version.  */
		  && ! (XFASTINT (length)
			== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
		invalid_syntax ("#&...", 5);

	      val = Fmake_bool_vector (length, Qnil);
	      bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
		     size_in_chars);
	      /* Clear the extraneous bits in the last byte.  */
	      if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
		XBOOL_VECTOR (val)->data[size_in_chars - 1]
		  &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
	      return val;
	    }
	  invalid_syntax ("#&...", 5);
	}
      if (c == '[')
	{
	  /* Accept compiled functions at read-time so that we don't have to
	     build them using function calls.  */

	  int ch;

	  /* Read the string itself.  */
	  tmp = read1 (readcharfun, &ch, 0);
	  if (ch != 0 || !STRINGP (tmp))
	    invalid_syntax ("#", 1);
	  GCPRO1 (tmp);
	  /* Read the intervals and their properties.  */
	  while (1)
	    {
	      Lisp_Object beg, end, plist;

	      if (ch == 0)
		end = read1 (readcharfun, &ch, 0);
	      if (ch == 0)
		plist = read1 (readcharfun, &ch, 0);
	      if (ch)
		invalid_syntax ("Invalid string property list", 0);
	      Fset_text_properties (beg, end, plist, tmp);
	    }
	  UNGCPRO;
	  return tmp;
	}

	return read_integer (readcharfun, 8);
      else if (c == 'b' || c == 'B')
	return read_integer (readcharfun, 2);

      UNREAD (c);
      invalid_syntax ("#", 1);

    case ';':
      while ((c = READCHAR) >= 0 && c != '\n');
      goto retry;

		      && (index ("\"';()[]#?", next_char)
			  || (!first_in_list && next_char == '`')
			  || (new_backquote_flag && next_char == ','))));
	  }
	UNREAD (next_char);
	if (ok)
	  return make_number (c);

	invalid_syntax ("?", 1);
      }

    case '"':
      {
	char *p = read_buffer;

	{
	  if (flag > 0)
	    {
	      if (ch == ']')
		return val;
	      invalid_syntax (") or . in a vector", 18);
	    }
	  if (ch == ')')
	    return val;
	  if (ch == '.')
	    {

			return get_doc_string (val, 0, 0);
		    }

		  return val;
		}
	      invalid_syntax (". in wrong context", 18);
	    }
	  invalid_syntax ("] in a list", 11);
	}
      tem = (read_pure && flag <= 0
	     ? pure_cons (elt, Qnil)
	     : Fcons (elt, Qnil));
      if (!NILP (tail))