comparison src/lread.c @ 20548:e9733cb049d9

(readchar_backlog): New variable. (readchar): When fetching from buffer or marker, use readchar_backlog to fetch bytes from a character. (unreadchar): Increment readchar_backlog. (readevalloop, Fread): Init readchar_backlog.

20547:07053199a368

static int read_pure;

/* For use within read-from-string (this reader is non-reentrant!!)  */
static int read_from_string_index;
static int read_from_string_limit;

/* This contains the last string skipped with #@, but only on some systems.
     On other systems we can't put the string here.  */
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string.  */

  if (BUFFERP (readcharfun))
    {
      inbuffer = XBUFFER (readcharfun);

      if (BUF_PT (inbuffer) >= BUF_ZV (inbuffer))
	return -1;
      c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, BUF_PT (inbuffer));
      SET_BUF_PT (inbuffer, BUF_PT (inbuffer) + 1);

      return c;
    }
  if (MARKERP (readcharfun))
    {
      inbuffer = XMARKER (readcharfun)->buffer;

      mpos = marker_position (readcharfun);

      if (mpos > BUF_ZV (inbuffer) - 1)
	return -1;
      c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, mpos);
      if (mpos != BUF_GPT (inbuffer))
	XMARKER (readcharfun)->bufpos++;
      else
	Fset_marker (readcharfun, make_number (mpos + 1),
		     Fmarker_buffer (readcharfun));
      return c;
    }
  if (EQ (readcharfun, Qget_file_char))
    {
      c = getc (instream);
#ifdef EINTR

	 but that truncated -1 to a char on VMS.  */
      if (read_from_string_index < read_from_string_limit)
	c = XSTRING (readcharfun)->data[read_from_string_index++];
      else
	c = -1;
      return c;
    }

  tem = call0 (readcharfun);

  if (c == -1)
    /* Don't back up the pointer if we're unreading the end-of-input mark,
       since readchar didn't advance it when we read it.  */
    ;
  else if (BUFFERP (readcharfun))
    {
      if (XBUFFER (readcharfun) == current_buffer)
	SET_PT (PT - 1);
      else
	SET_BUF_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
    }
  else if (MARKERP (readcharfun))
    XMARKER (readcharfun)->bufpos--;
  else if (STRINGP (readcharfun))
    read_from_string_index--;
  else if (EQ (readcharfun, Qget_file_char))
    ungetc (c, instream);
  else
    call1 (readcharfun, make_number (c));
}

static Lisp_Object read0 (), read1 (), read_list (), read_vector ();

/* get a character from the tty */

extern Lisp_Object read_char ();

    b = XMARKER (readcharfun)->buffer;

  specbind (Qstandard_input, readcharfun);
  specbind (Qcurrent_load_list, Qnil);

  GCPRO1 (sourcename);

  LOADHIST_ATTACH (sourcename);

  while (1)

  if (NILP (stream))
    stream = Vstandard_input;
  if (EQ (stream, Qt))
    stream = Qread_char;

  new_backquote_flag = 0;
  read_objects = Qnil;

#ifndef standalone
  if (EQ (stream, Qread_char))

static char *read_buffer;

/* Read multibyte form and return it as a character.  C is a first
   byte of multibyte form, and rest of them are read from
   READCHARFUN.  */
static int
read_multibyte (c, readcharfun)
     register int c;
     Lisp_Object readcharfun;
{

	 && len < MAX_LENGTH_OF_MULTI_BYTE_FORM)
    str[len++] = c;
  UNREAD (c);
  return STRING_CHAR (str, len);
}

static int
read_escape (readcharfun)
     Lisp_Object readcharfun;
{

	if (c == '\\')
	  c = read_escape (readcharfun);
	else if (BASE_LEADING_CODE_P (c))
	  c = read_multibyte (c, readcharfun);
	XSETINT (val, c);

	return val;
      }

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

		    bcopy (str, p, length);
		    p += length;
		    continue;
		  }
	      }
	    /* c is -1 if \ newline has just been seen */
	    if (c == -1)
	      {
		if (p == read_buffer)
		  cancel = 1;

		if (c & ~0xff)
		  error ("Invalid modifier in string");
		*p++ = c;
	      }
	  }
	if (c < 0) return Fsignal (Qend_of_file, Qnil);

	/* If purifying, and string starts with \ newline,
	   return zero instead.  This is for doc strings
	   that we are really going to find in etc/DOC.nn.nn  */
	if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)

	int quoted = 0;

	{
	  register char *end = read_buffer + read_buffer_size;

	  while (c > 040 && 
		 !(c == '\"' || c == '\'' || c == ';' || c == '?'
		   || c == '(' || c == ')'
#ifndef LISP_FLOAT_TYPE
		   /* If we have floating-point support, then we need
		      to allow <digits><dot><digits>.  */
		   || c =='.'
#endif /* not LISP_FLOAT_TYPE */
		   || c == '[' || c == ']' || c == '#'
		   ))
	    {
	      if (p == end)
		{
		  register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
		  p += new - read_buffer;

	      if (c == '\\')
		{
		  c = READCHAR;
		  quoted = 1;
		}
	      *p++ = c;
	      c = READCHAR;
	    }

	  if (p == end)
	    {

      free_cons (otem);
    }
  return vector;
}
  
/* flag = 1 means check for ] to terminate rather than ) and .
   flag = -1 means check for starting with defun
    and make structure pure.  */

static Lisp_Object
read_list (flag, readcharfun)
     int flag;

20548:e9733cb049d9

static int read_pure;

/* For use within read-from-string (this reader is non-reentrant!!)  */
static int read_from_string_index;
static int read_from_string_limit;

/* Number of bytes left to read in the buffer character
   that `readchar' has already advanced over.  */
static int readchar_backlog;

/* This contains the last string skipped with #@, but only on some systems.
     On other systems we can't put the string here.  */
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string.  */

  if (BUFFERP (readcharfun))
    {
      inbuffer = XBUFFER (readcharfun);

      if (readchar_backlog == 0)
	{
	  int pt_byte = BUF_PT_BYTE (inbuffer);
	  int orig_pt_byte = pt_byte;

	  if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	    return -1;

	  if (! NILP (inbuffer->enable_multibyte_characters))
	    BUF_INC_POS (inbuffer, pt_byte);
	  else
	    pt_byte++;
	  SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
	  readchar_backlog = pt_byte - orig_pt_byte;
	}

      /* We get the address of the byte just passed,
	 which is the last byte of the character.
	 The other bytes in this character are consecutive with it,
	 because the gap can't be in the middle of a character.  */
      return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1)
	       - --readchar_backlog);
    }
  if (MARKERP (readcharfun))
    {
      inbuffer = XMARKER (readcharfun)->buffer;

      if (readchar_backlog == 0)
	{
	  int bytepos = marker_byte_position (readcharfun);
	  int orig_bytepos = bytepos;

	  if (bytepos >= BUF_ZV_BYTE (inbuffer))
	    return -1;

	  if (XMARKER (readcharfun)->bufpos == BUF_GPT_BYTE (inbuffer))
	    XMARKER (readcharfun)->bufpos += BUF_GAP_SIZE (inbuffer);

	  if (! NILP (inbuffer->enable_multibyte_characters))
	    INC_POS (bytepos);
	  else
	    bytepos++;
	  XMARKER (readcharfun)->bufpos += bytepos - orig_bytepos;
	  XMARKER (readcharfun)->charpos++;

	  readchar_backlog = bytepos - orig_bytepos;
	}

      /* Because we move ->bufpos across the gap before we advance it,
	 the gap never comes between the previous character and ->bufpos.  */
      return *(BUF_BEG_ADDR (inbuffer) + XMARKER (readcharfun)->bufpos
	       - readchar_backlog--);
    }
  if (EQ (readcharfun, Qget_file_char))
    {
      c = getc (instream);
#ifdef EINTR

	 but that truncated -1 to a char on VMS.  */
      if (read_from_string_index < read_from_string_limit)
	c = XSTRING (readcharfun)->data[read_from_string_index++];
      else
	c = -1;

      return c;
    }

  tem = call0 (readcharfun);

  if (c == -1)
    /* Don't back up the pointer if we're unreading the end-of-input mark,
       since readchar didn't advance it when we read it.  */
    ;
  else if (BUFFERP (readcharfun))
    readchar_backlog++;
  else if (MARKERP (readcharfun))
    readchar_backlog++;
  else if (STRINGP (readcharfun))
    read_from_string_index--;
  else if (EQ (readcharfun, Qget_file_char))
    ungetc (c, instream);
  else
    call1 (readcharfun, make_number (c));
}

static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
static int read_multibyte ();

/* get a character from the tty */

extern Lisp_Object read_char ();

    b = XMARKER (readcharfun)->buffer;

  specbind (Qstandard_input, readcharfun);
  specbind (Qcurrent_load_list, Qnil);

  readchar_backlog = 0;

  GCPRO1 (sourcename);

  LOADHIST_ATTACH (sourcename);

  while (1)

  if (NILP (stream))
    stream = Vstandard_input;
  if (EQ (stream, Qt))
    stream = Qread_char;

  readchar_backlog = 0;
  new_backquote_flag = 0;
  read_objects = Qnil;

#ifndef standalone
  if (EQ (stream, Qread_char))

static char *read_buffer;

/* Read multibyte form and return it as a character.  C is a first
   byte of multibyte form, and rest of them are read from
   READCHARFUN.  */

static int
read_multibyte (c, readcharfun)
     register int c;
     Lisp_Object readcharfun;
{

	 && len < MAX_LENGTH_OF_MULTI_BYTE_FORM)
    str[len++] = c;
  UNREAD (c);
  return STRING_CHAR (str, len);
}

/* Read a \-escape sequence, assuming we already read the `\'.  */

static int
read_escape (readcharfun)
     Lisp_Object readcharfun;
{

	if (c == '\\')
	  c = read_escape (readcharfun);
	else if (BASE_LEADING_CODE_P (c))
	  c = read_multibyte (c, readcharfun);

	return make_number (c);
      }

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

		    bcopy (str, p, length);
		    p += length;
		    continue;
		  }
	      }

	    /* c is -1 if \ newline has just been seen */
	    if (c == -1)
	      {
		if (p == read_buffer)
		  cancel = 1;

		if (c & ~0xff)
		  error ("Invalid modifier in string");
		*p++ = c;
	      }
	  }
	if (c < 0)
	  return Fsignal (Qend_of_file, Qnil);

	/* If purifying, and string starts with \ newline,
	   return zero instead.  This is for doc strings
	   that we are really going to find in etc/DOC.nn.nn  */
	if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)

	int quoted = 0;

	{
	  register char *end = read_buffer + read_buffer_size;

	  while (c > 040
		 && !(c == '\"' || c == '\'' || c == ';' || c == '?'
		      || c == '(' || c == ')'
#ifndef LISP_FLOAT_TYPE
		      /* If we have floating-point support, then we need
			 to allow <digits><dot><digits>.  */
		      || c =='.'
#endif /* not LISP_FLOAT_TYPE */
		      || c == '[' || c == ']' || c == '#'
		      ))
	    {
	      if (p == end)
		{
		  register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
		  p += new - read_buffer;

	      if (c == '\\')
		{
		  c = READCHAR;
		  quoted = 1;
		}

	      *p++ = c;

	      c = READCHAR;
	    }

	  if (p == end)
	    {

      free_cons (otem);
    }
  return vector;
}
  
/* FLAG = 1 means check for ] to terminate rather than ) and .
   FLAG = -1 means check for starting with defun
    and make structure pure.  */

static Lisp_Object
read_list (flag, readcharfun)
     int flag;