Lisp_Object Qweakness;
Lisp_Object Qrehash_size;
Lisp_Object Qrehash_threshold;
-extern Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
Lisp_Object Qinhibit_file_name_operation;
Lisp_Object Qeval_buffer_list, Veval_buffer_list;
+Lisp_Object Qlexical_binding;
Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
/* Used instead of Qget_file_char while loading *.elc files compiled
static Lisp_Object Qload_force_doc_strings;
-extern Lisp_Object Qevent_symbol_element_mask;
-extern Lisp_Object Qfile_exists_p;
+extern Lisp_Object Qinternal_interpreter_environment;
/* non-zero if inside `load' */
int load_in_progress;
/* List of (SYMBOL . POSITION) accumulated so far. */
Lisp_Object Vread_symbol_positions_list;
+/* If non-nil `readevalloop' evaluates code in a lexical environment. */
+Lisp_Object Vlexical_binding;
+
/* List of descriptors now open for Fload. */
static Lisp_Object load_descriptor_list;
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_index_byte;
-static int read_from_string_limit;
+static EMACS_INT read_from_string_index;
+static EMACS_INT read_from_string_index_byte;
+static EMACS_INT read_from_string_limit;
/* Number of characters read in the current call to Fread or
Fread_from_string. */
-static int readchar_count;
+static EMACS_INT readchar_count;
/* This contains the last string skipped with #@. */
static char *saved_doc_string;
Lisp_Object);
static void readevalloop (Lisp_Object, FILE*, Lisp_Object,
- Lisp_Object (*) (), int,
+ Lisp_Object (*) (Lisp_Object), int,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
static Lisp_Object load_unwind (Lisp_Object);
static Lisp_Object load_descriptor_unwind (Lisp_Object);
static void invalid_syntax (const char *, int) NO_RETURN;
-static void end_of_file_error () NO_RETURN;
+static void end_of_file_error (void) NO_RETURN;
\f
/* Functions that read one byte from the current source READCHARFUN
static int unread_char;
static int
-readchar (readcharfun, multibyte)
- Lisp_Object readcharfun;
- int *multibyte;
+readchar (Lisp_Object readcharfun, int *multibyte)
{
Lisp_Object tem;
register int c;
{
register struct buffer *inbuffer = XBUFFER (readcharfun);
- int pt_byte = BUF_PT_BYTE (inbuffer);
+ EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
if (pt_byte >= BUF_ZV_BYTE (inbuffer))
return -1;
{
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
- int bytepos = marker_byte_position (readcharfun);
+ EMACS_INT bytepos = marker_byte_position (readcharfun);
if (bytepos >= BUF_ZV_BYTE (inbuffer))
return -1;
If the stream is a user function, call it with the char as argument. */
static void
-unreadchar (readcharfun, c)
- Lisp_Object readcharfun;
- int c;
+unreadchar (Lisp_Object readcharfun, int c)
{
readchar_count--;
if (c == -1)
else if (BUFFERP (readcharfun))
{
struct buffer *b = XBUFFER (readcharfun);
- int bytepos = BUF_PT_BYTE (b);
+ EMACS_INT bytepos = BUF_PT_BYTE (b);
BUF_PT (b)--;
if (! NILP (b->enable_multibyte_characters))
else if (MARKERP (readcharfun))
{
struct buffer *b = XMARKER (readcharfun)->buffer;
- int bytepos = XMARKER (readcharfun)->bytepos;
+ EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
XMARKER (readcharfun)->charpos--;
if (! NILP (b->enable_multibyte_characters))
}
static int
-readbyte_for_lambda (c, readcharfun)
- int c;
- Lisp_Object readcharfun;
+readbyte_for_lambda (int c, Lisp_Object readcharfun)
{
return read_bytecode_char (c >= 0);
}
static int
-readbyte_from_file (c, readcharfun)
- int c;
- Lisp_Object readcharfun;
+readbyte_from_file (int c, Lisp_Object readcharfun)
{
if (c >= 0)
{
}
static int
-readbyte_from_string (c, readcharfun)
- int c;
- Lisp_Object readcharfun;
+readbyte_from_string (int c, Lisp_Object readcharfun)
{
Lisp_Object string = XCAR (readcharfun);
extern char emacs_mule_bytes[256];
static int
-read_emacs_mule_char (c, readbyte, readcharfun)
- int c;
- int (*readbyte) (int, Lisp_Object);
- Lisp_Object readcharfun;
+read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
{
/* Emacs-mule coding uses at most 4-byte for one character. */
unsigned char buf[4];
return Qnil if no input arrives within that time. */
Lisp_Object
-read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
- input_method, seconds)
- int no_switch_frame, ascii_required, error_nonascii, input_method;
- Lisp_Object seconds;
+read_filtered_event (int no_switch_frame, int ascii_required,
+ int error_nonascii, int input_method, Lisp_Object seconds)
{
Lisp_Object val, delayed_switch_frame;
EMACS_TIME end_time;
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value. */)
- (prompt, inherit_input_method, seconds)
- Lisp_Object prompt, inherit_input_method, seconds;
+ (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value. */)
- (prompt, inherit_input_method, seconds)
- Lisp_Object prompt, inherit_input_method, seconds;
+ (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value. */)
- (prompt, inherit_input_method, seconds)
- Lisp_Object prompt, inherit_input_method, seconds;
+ (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
doc: /* Don't use this yourself. */)
- ()
+ (void)
{
register Lisp_Object val;
BLOCK_INPUT;
}
+\f
+
+/* Return true if the lisp code read using READCHARFUN defines a non-nil
+ `lexical-binding' file variable. After returning, the stream is
+ positioned following the first line, if it is a comment, otherwise
+ nothing is read. */
+
+static int
+lisp_file_lexically_bound_p (Lisp_Object readcharfun)
+{
+ int ch = READCHAR;
+ if (ch != ';')
+ /* The first line isn't a comment, just give up. */
+ {
+ UNREAD (ch);
+ return 0;
+ }
+ else
+ /* Look for an appropriate file-variable in the first line. */
+ {
+ int rv = 0;
+ enum {
+ NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
+ } beg_end_state = NOMINAL;
+ int in_file_vars = 0;
+
+#define UPDATE_BEG_END_STATE(ch) \
+ if (beg_end_state == NOMINAL) \
+ beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
+ else if (beg_end_state == AFTER_FIRST_DASH) \
+ beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
+ else if (beg_end_state == AFTER_ASTERIX) \
+ { \
+ if (ch == '-') \
+ in_file_vars = !in_file_vars; \
+ beg_end_state = NOMINAL; \
+ }
+
+ /* Skip until we get to the file vars, if any. */
+ do
+ {
+ ch = READCHAR;
+ UPDATE_BEG_END_STATE (ch);
+ }
+ while (!in_file_vars && ch != '\n' && ch != EOF);
+
+ while (in_file_vars)
+ {
+ char var[100], *var_end, val[100], *val_end;
+
+ ch = READCHAR;
+
+ /* Read a variable name. */
+ while (ch == ' ' || ch == '\t')
+ ch = READCHAR;
+
+ var_end = var;
+ while (ch != ':' && ch != '\n' && ch != EOF)
+ {
+ if (var_end < var + sizeof var - 1)
+ *var_end++ = ch;
+ UPDATE_BEG_END_STATE (ch);
+ ch = READCHAR;
+ }
+
+ while (var_end > var
+ && (var_end[-1] == ' ' || var_end[-1] == '\t'))
+ var_end--;
+ *var_end = '\0';
+
+ if (ch == ':')
+ {
+ /* Read a variable value. */
+ ch = READCHAR;
+
+ while (ch == ' ' || ch == '\t')
+ ch = READCHAR;
+
+ val_end = val;
+ while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
+ {
+ if (val_end < val + sizeof val - 1)
+ *val_end++ = ch;
+ UPDATE_BEG_END_STATE (ch);
+ ch = READCHAR;
+ }
+ if (! in_file_vars)
+ /* The value was terminated by an end-marker, which
+ remove. */
+ val_end -= 3;
+ while (val_end > val
+ && (val_end[-1] == ' ' || val_end[-1] == '\t'))
+ val_end--;
+ *val_end = '\0';
+
+ if (strcmp (var, "lexical-binding") == 0)
+ /* This is it... */
+ {
+ rv = (strcmp (val, "nil") != 0);
+ break;
+ }
+ }
+ }
+
+ while (ch != '\n' && ch != EOF)
+ ch = READCHAR;
+
+ return rv;
+ }
+}
+
\f
/* Value is a version number of byte compiled code if the file
associated with file descriptor FD is a compiled Lisp file that's
because of an incompatible change in the byte compiler. */
static int
-safe_to_load_p (fd)
- int fd;
+safe_to_load_p (int fd)
{
char buf[512];
int nbytes, i;
after loading a file successfully. */
static Lisp_Object
-record_load_unwind (old)
- Lisp_Object old;
+record_load_unwind (Lisp_Object old)
{
return Vloads_in_progress = old;
}
/* This handler function is used via internal_condition_case_1. */
static Lisp_Object
-load_error_handler (data)
- Lisp_Object data;
+load_error_handler (Lisp_Object data)
{
return Qnil;
}
static Lisp_Object
-load_warn_old_style_backquotes (file)
- Lisp_Object file;
+load_warn_old_style_backquotes (Lisp_Object file)
{
if (!NILP (Vold_style_backquotes))
{
doc: /* Return the suffixes that `load' should try if a suffix is \
required.
This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
- ()
+ (void)
{
Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
while (CONSP (suffixes))
car is the file name loaded. See `load-history'.
Return t if the file exists and loads successfully. */)
- (file, noerror, nomessage, nosuffix, must_suffix)
- Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
+ (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
{
register FILE *stream;
register int fd = -1;
int compiled = 0;
Lisp_Object handler;
int safe_p = 1;
- char *fmode = "r";
+ const char *fmode = "r";
Lisp_Object tmp[2];
int version;
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
+ /* All loads are by default dynamic, unless the file itself specifies
+ otherwise using a file-variable in the first line. This is bound here
+ so that it takes effect whether or not we use
+ Vload_source_file_function. */
+ specbind (Qlexical_binding, Qnil);
+
/* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
- if (!bcmp (SDATA (found) + SBYTES (found) - 4,
- ".elc", 4)
+ if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
|| (fd >= 0 && (version = safe_to_load_p (fd)) > 0))
/* Load .elc files directly, but not when they are
remote and have no handler! */
specbind (Qinhibit_file_name_operation, Qnil);
load_descriptor_list
= Fcons (make_number (fileno (stream)), load_descriptor_list);
+
specbind (Qload_in_progress, Qt);
+
+ instream = stream;
+ if (lisp_file_lexically_bound_p (Qget_file_char))
+ Fset (Qlexical_binding, Qt);
+
if (! version || version >= 22)
readevalloop (Qget_file_char, stream, hist_file_name,
Feval, 0, Qnil, Qnil, Qnil, Qnil);
}
static Lisp_Object
-load_unwind (arg) /* used as unwind-protect function in load */
- Lisp_Object arg;
+load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */
{
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
if (stream != NULL)
}
static Lisp_Object
-load_descriptor_unwind (oldlist)
- Lisp_Object oldlist;
+load_descriptor_unwind (Lisp_Object oldlist)
{
load_descriptor_list = oldlist;
return Qnil;
This is used when starting a subprocess. */
void
-close_load_descs ()
+close_load_descs (void)
{
#ifndef WINDOWSNT
Lisp_Object tail;
}
\f
static int
-complete_filename_p (pathname)
- Lisp_Object pathname;
+complete_filename_p (Lisp_Object pathname)
{
register const unsigned char *s = SDATA (pathname);
return (IS_DIRECTORY_SEP (s[0])
If non-nil, PREDICATE is used instead of `file-readable-p'.
PREDICATE can also be an integer to pass to the access(2) function,
in which case file-name-handlers are ignored. */)
- (filename, path, suffixes, predicate)
- Lisp_Object filename, path, suffixes, predicate;
+ (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
{
Lisp_Object file;
int fd = openp (path, filename, suffixes, &file, predicate);
but store the found remote file name in *STOREPTR. */
int
-openp (path, str, suffixes, storeptr, predicate)
- Lisp_Object path, str;
- Lisp_Object suffixes;
- Lisp_Object *storeptr;
- Lisp_Object predicate;
+openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
{
register int fd;
int fn_size = 100;
ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
static void
-build_load_history (filename, entire)
- Lisp_Object filename;
- int entire;
+build_load_history (Lisp_Object filename, int entire)
{
register Lisp_Object tail, prev, newelt;
register Lisp_Object tem, tem2;
Vload_history);
}
-Lisp_Object
-unreadpure (junk) /* Used as unwind-protect function in readevalloop */
- Lisp_Object junk;
+static Lisp_Object
+unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */
{
read_pure = 0;
return Qnil;
}
static Lisp_Object
-readevalloop_1 (old)
- Lisp_Object old;
+readevalloop_1 (Lisp_Object old)
{
load_convert_to_unibyte = ! NILP (old);
return Qnil;
information. */
static void
-end_of_file_error ()
+end_of_file_error (void)
{
if (STRINGP (Vload_file_name))
xsignal1 (Qend_of_file, Vload_file_name);
If the input is not from a buffer, they must be nil. */
static void
-readevalloop (readcharfun, stream, sourcename, evalfun,
- printflag, unibyte, readfun, start, end)
- Lisp_Object readcharfun;
- FILE *stream;
- Lisp_Object sourcename;
- Lisp_Object (*evalfun) ();
- int printflag;
- Lisp_Object unibyte, readfun;
- Lisp_Object start, end;
+readevalloop (Lisp_Object readcharfun,
+ FILE *stream,
+ Lisp_Object sourcename,
+ Lisp_Object (*evalfun) (Lisp_Object),
+ int printflag,
+ Lisp_Object unibyte, Lisp_Object readfun,
+ Lisp_Object start, Lisp_Object end)
{
register int c;
register Lisp_Object val;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
int continue_reading_p;
+ Lisp_Object lex_bound;
/* Nonzero if reading an entire buffer. */
int whole_buffer = 0;
/* 1 on the first time around. */
record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
load_convert_to_unibyte = !NILP (unibyte);
+ /* If lexical binding is active (either because it was specified in
+ the file's header, or via a buffer-local variable), create an empty
+ lexical environment, otherwise, turn off lexical binding. */
+ lex_bound = find_symbol_value (Qlexical_binding);
+ if (NILP (lex_bound) || EQ (lex_bound, Qunbound))
+ specbind (Qinternal_interpreter_environment, Qnil);
+ else
+ specbind (Qinternal_interpreter_environment, Fcons (Qt, Qnil));
+
GCPRO4 (sourcename, readfun, start, end);
/* Try to ensure sourcename is a truename, except whilst preloading. */
functions should work normally even if PRINTFLAG is nil.
This function preserves the position of point. */)
- (buffer, printflag, filename, unibyte, do_allow_print)
- Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
+ (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
{
int count = SPECPDL_INDEX ();
Lisp_Object tem, buf;
specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
specbind (Qstandard_output, tem);
+ specbind (Qlexical_binding, Qnil);
record_unwind_protect (save_excursion_restore, save_excursion_save ());
BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+ if (lisp_file_lexically_bound_p (buf))
+ Fset (Qlexical_binding, Qt);
readevalloop (buf, 0, filename, Feval,
!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
which is the input stream for reading characters.
This function does not move point. */)
- (start, end, printflag, read_function)
- Lisp_Object start, end, printflag, read_function;
+ (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
{
int count = SPECPDL_INDEX ();
Lisp_Object tem, cbuf;
a string (takes text from string, starting at the beginning)
t (read text line using minibuffer and use it, or read from
standard input in batch mode). */)
- (stream)
- Lisp_Object stream;
+ (Lisp_Object stream)
{
if (NILP (stream))
stream = Vstandard_input;
Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
START and END optionally delimit a substring of STRING from which to read;
they default to 0 and (length STRING) respectively. */)
- (string, start, end)
- Lisp_Object string, start, end;
+ (Lisp_Object string, Lisp_Object start, Lisp_Object end)
{
Lisp_Object ret;
CHECK_STRING (string);
/* Function to set up the global context we need in toplevel read
calls. */
static Lisp_Object
-read_internal_start (stream, start, end)
- Lisp_Object stream;
- Lisp_Object start; /* Only used when stream is a string. */
- Lisp_Object end; /* Only used when stream is a string. */
+read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
+/* start, end only used when stream is a string. */
{
Lisp_Object retval;
if (STRINGP (stream)
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
{
- int startval, endval;
+ EMACS_INT startval, endval;
Lisp_Object string;
if (STRINGP (stream))
S is error string of length N (if > 0) */
static void
-invalid_syntax (s, n)
- const char *s;
- int n;
+invalid_syntax (const char *s, int n)
{
if (!n)
n = strlen (s);
are not allowed. */
static Lisp_Object
-read0 (readcharfun)
- Lisp_Object readcharfun;
+read0 (Lisp_Object readcharfun)
{
register Lisp_Object val;
int c;
If the escape sequence forces unibyte, return eight-bit char. */
static int
-read_escape (readcharfun, stringp)
- Lisp_Object readcharfun;
- int stringp;
+read_escape (Lisp_Object readcharfun, int stringp)
{
register int c = READCHAR;
/* \u allows up to four hex digits, \U up to eight. Default to the
range. */
static Lisp_Object
-read_integer (readcharfun, radix)
- Lisp_Object readcharfun;
- int radix;
+read_integer (Lisp_Object readcharfun, int radix)
{
int ndigits = 0, invalid_p, c, sign = 0;
/* We use a floating point number because */
FIRST_IN_LIST is nonzero if this is the first element of a list. */
static Lisp_Object
-read1 (readcharfun, pch, first_in_list)
- register Lisp_Object readcharfun;
- int *pch;
- int first_in_list;
+read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
register int c;
int uninterned_symbol = 0;
/* This is repetitive but fast and simple. */
params[param_count] = QCsize;
params[param_count+1] = Fplist_get (tmp, Qsize);
- if (!NILP (params[param_count+1]))
- param_count+=2;
+ if (!NILP (params[param_count + 1]))
+ param_count += 2;
params[param_count] = QCtest;
params[param_count+1] = Fplist_get (tmp, Qtest);
- if (!NILP (params[param_count+1]))
- param_count+=2;
+ if (!NILP (params[param_count + 1]))
+ param_count += 2;
params[param_count] = QCweakness;
params[param_count+1] = Fplist_get (tmp, Qweakness);
- if (!NILP (params[param_count+1]))
- param_count+=2;
+ if (!NILP (params[param_count + 1]))
+ param_count += 2;
params[param_count] = QCrehash_size;
params[param_count+1] = Fplist_get (tmp, Qrehash_size);
- if (!NILP (params[param_count+1]))
- param_count+=2;
+ if (!NILP (params[param_count + 1]))
+ param_count += 2;
params[param_count] = QCrehash_threshold;
params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
- if (!NILP (params[param_count+1]))
- param_count+=2;
+ if (!NILP (params[param_count + 1]))
+ param_count += 2;
/* This is the hashtable data. */
data = Fplist_get (tmp, Qdata);
return ht;
}
+ UNREAD (c);
+ invalid_syntax ("#", 1);
}
if (c == '^')
{
invalid_syntax ("#&...", 5);
val = Fmake_bool_vector (length, Qnil);
- bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
- size_in_chars);
+ memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), 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]
invalid_syntax ("#&...", 5);
}
if (c == '[')
- {
- /* Accept compiled functions at read-time so that we don't have to
- build them using function calls. */
- Lisp_Object tmp;
- tmp = read_vector (readcharfun, 1);
- return Fmake_byte_code (XVECTOR (tmp)->size,
- XVECTOR (tmp)->contents);
- }
+ /* `function vector' objects, including byte-compiled functions. */
+ return read_vector (readcharfun, 1);
if (c == '(')
{
Lisp_Object tmp;
}
case '`':
- /* Transition from old-style to new-style:
- If we see "(`" it used to mean old-style, which usually works
- fine because ` should almost never appear in such a position
- for new-style. But occasionally we need "(`" to mean new
- style, so we try to distinguish the two by the fact that we
- can either write "( `foo" or "(` foo", where the first
- intends to use new-style whereas the second intends to use
- old-style. For Emacs-25, we should completely remove this
- first_in_list exception (old-style can still be obtained via
- "(\`" anyway). */
- if (first_in_list && (c = READCHAR, UNREAD (c), c == ' '))
- {
- Vold_style_backquotes = Qt;
- goto default_label;
- }
- else
- {
- Lisp_Object value;
-
- new_backquote_flag++;
- value = read0 (readcharfun);
- new_backquote_flag--;
+ {
+ int next_char = READCHAR;
+ UNREAD (next_char);
+ /* Transition from old-style to new-style:
+ If we see "(`" it used to mean old-style, which usually works
+ fine because ` should almost never appear in such a position
+ for new-style. But occasionally we need "(`" to mean new
+ style, so we try to distinguish the two by the fact that we
+ can either write "( `foo" or "(` foo", where the first
+ intends to use new-style whereas the second intends to use
+ old-style. For Emacs-25, we should completely remove this
+ first_in_list exception (old-style can still be obtained via
+ "(\`" anyway). */
+ if (first_in_list && next_char == ' ')
+ {
+ Vold_style_backquotes = Qt;
+ goto default_label;
+ }
+ else
+ {
+ Lisp_Object value;
- return Fcons (Qbackquote, Fcons (value, Qnil));
- }
+ new_backquote_flag++;
+ value = read0 (readcharfun);
+ new_backquote_flag--;
+ return Fcons (Qbackquote, Fcons (value, Qnil));
+ }
+ }
case ',':
if (new_backquote_flag)
{
ok = (next_next_char <= 040
|| (next_next_char < 0200
- && (index ("\"';([#?", next_next_char)
+ && (strchr ("\"';([#?", next_next_char)
|| (!first_in_list && next_next_char == '`')
|| (new_backquote_flag && next_next_char == ','))));
}
{
ok = (next_char <= 040
|| (next_char < 0200
- && (index ("\"';()[]#?", next_char)
+ && (strchr ("\"';()[]#?", next_char)
|| (!first_in_list && next_char == '`')
|| (new_backquote_flag && next_char == ','))));
}
if (next_char <= 040
|| (next_char < 0200
- && (index ("\"';([#?", next_char)
+ && (strchr ("\"';([#?", next_char)
|| (!first_in_list && next_char == '`')
|| (new_backquote_flag && next_char == ','))))
{
while (c > 040
&& c != 0x8a0 /* NBSP */
&& (c >= 0200
- || (!index ("\"';()[]#", c)
+ || (!strchr ("\"';()[]#", c)
&& !(!first_in_list && c == '`')
&& !(new_backquote_flag && c == ','))))
{
static Lisp_Object seen_list;
static void
-substitute_object_in_subtree (object, placeholder)
- Lisp_Object object;
- Lisp_Object placeholder;
+substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
{
Lisp_Object check_object;
} while (0)
static Lisp_Object
-substitute_object_recurse (object, placeholder, subtree)
- Lisp_Object object;
- Lisp_Object placeholder;
- Lisp_Object subtree;
+substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
{
/* If we find the placeholder, return the target object. */
if (EQ (placeholder, subtree))
/* Helper function for substitute_object_recurse. */
static void
-substitute_in_interval (interval, arg)
- INTERVAL interval;
- Lisp_Object arg;
+substitute_in_interval (INTERVAL interval, Lisp_Object arg)
{
Lisp_Object object = Fcar (arg);
Lisp_Object placeholder = Fcdr (arg);
#define EXP_INT 16
int
-isfloat_string (cp, ignore_trailing)
- register char *cp;
- int ignore_trailing;
+isfloat_string (const char *cp, int ignore_trailing)
{
- register int state;
-
- char *start = cp;
+ int state;
+ const char *start = cp;
state = 0;
if (*cp == '+' || *cp == '-')
}
return ((ignore_trailing
- || (*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
+ || *cp == 0 || *cp == ' ' || *cp == '\t' || *cp == '\n'
+ || *cp == '\r' || *cp == '\f')
&& (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
|| state == (DOT_CHAR|TRAIL_INT)
|| state == (LEAD_INT|E_CHAR|EXP_INT)
\f
static Lisp_Object
-read_vector (readcharfun, bytecodeflag)
- Lisp_Object readcharfun;
- int bytecodeflag;
+read_vector (Lisp_Object readcharfun, int read_funvec)
{
register int i;
register int size;
register Lisp_Object tem, item, vector;
register struct Lisp_Cons *otem;
Lisp_Object len;
+ /* If we're reading a funvec object we start out assuming it's also a
+ byte-code object (a subset of funvecs), so we can do any special
+ processing needed. If it's just an ordinary funvec object, we'll
+ realize that as soon as we've read the first element. */
+ int read_bytecode = read_funvec;
tem = read_list (1, readcharfun);
len = Flength (tem);
for (i = 0; i < size; i++)
{
item = Fcar (tem);
+
+ /* If READ_BYTECODE is set, check whether this is really a byte-code
+ object, or just an ordinary `funvec' object -- non-byte-code
+ funvec objects use the same reader syntax. We can tell from the
+ first element which one it is. */
+ if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item))
+ read_bytecode = 0; /* Nope. */
+
/* If `load-force-doc-strings' is t when reading a lazily-loaded
bytecode object, the docstring containing the bytecode and
constants values must be treated as unibyte and passed to
Fread, to get the actual bytecode string and constants vector. */
- if (bytecodeflag && load_force_doc_strings)
+ if (read_bytecode && load_force_doc_strings)
{
if (i == COMPILED_BYTECODE)
{
tem = Fcdr (tem);
free_cons (otem);
}
+
+ if (read_bytecode && size >= 4)
+ /* Convert this vector to a bytecode object. */
+ vector = Fmake_byte_code (size, XVECTOR (vector)->contents);
+ else if (read_funvec && size >= 1)
+ /* Convert this vector to an ordinary funvec object. */
+ XSETFUNVEC (vector, XVECTOR (vector));
+
return vector;
}
and make structure pure. */
static Lisp_Object
-read_list (flag, readcharfun)
- int flag;
- register Lisp_Object readcharfun;
+read_list (int flag, register Lisp_Object readcharfun)
{
/* -1 means check next element for defun,
0 means don't check,
int oblookup_last_bucket_number;
-static int hash_string ();
+static int hash_string (const unsigned char *ptr, int len);
/* Get an error if OBARRAY is not an obarray.
If it is one, return it. */
Lisp_Object
-check_obarray (obarray)
- Lisp_Object obarray;
+check_obarray (Lisp_Object obarray)
{
if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
{
interned in the current obarray. */
Lisp_Object
-intern (str)
- const char *str;
+intern (const char *str)
{
Lisp_Object tem;
int len = strlen (str);
/* Create an uninterned symbol with name STR. */
Lisp_Object
-make_symbol (str)
- char *str;
+make_symbol (const char *str)
{
int len = strlen (str);
- return Fmake_symbol ((!NILP (Vpurify_flag)
- ? make_pure_string (str, len, len, 0)
- : make_string (str, len)));
+ return Fmake_symbol (!NILP (Vpurify_flag)
+ ? make_pure_string (str, len, len, 0)
+ : make_string (str, len));
}
\f
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
If there is none, one is created by this function and returned.
A second optional argument specifies the obarray to use;
it defaults to the value of `obarray'. */)
- (string, obarray)
- Lisp_Object string, obarray;
+ (Lisp_Object string, Lisp_Object obarray)
{
register Lisp_Object tem, sym, *ptr;
symbol is searched for.
A second optional argument specifies the obarray to use;
it defaults to the value of `obarray'. */)
- (name, obarray)
- Lisp_Object name, obarray;
+ (Lisp_Object name, Lisp_Object obarray)
{
register Lisp_Object tem, string;
NAME may be a string or a symbol. If it is a symbol, that symbol
is deleted, if it belongs to OBARRAY--no other symbol is deleted.
OBARRAY defaults to the value of the variable `obarray'. */)
- (name, obarray)
- Lisp_Object name, obarray;
+ (Lisp_Object name, Lisp_Object obarray)
{
register Lisp_Object string, tem;
int hash;
Also store the bucket number in oblookup_last_bucket_number. */
Lisp_Object
-oblookup (obarray, ptr, size, size_byte)
- Lisp_Object obarray;
- register const char *ptr;
- int size, size_byte;
+oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
{
int hash;
int obsize;
{
if (SBYTES (SYMBOL_NAME (tail)) == size_byte
&& SCHARS (SYMBOL_NAME (tail)) == size
- && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
+ && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
return tail;
else if (XSYMBOL (tail)->next == 0)
break;
}
static int
-hash_string (ptr, len)
- const unsigned char *ptr;
- int len;
+hash_string (const unsigned char *ptr, int len)
{
register const unsigned char *p = ptr;
register const unsigned char *end = p + len;
}
\f
void
-map_obarray (obarray, fn, arg)
- Lisp_Object obarray;
- void (*fn) (Lisp_Object, Lisp_Object);
- Lisp_Object arg;
+map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
{
register int i;
register Lisp_Object tail;
}
}
-void
-mapatoms_1 (sym, function)
- Lisp_Object sym, function;
+static void
+mapatoms_1 (Lisp_Object sym, Lisp_Object function)
{
call1 (function, sym);
}
DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
doc: /* Call FUNCTION on every symbol in OBARRAY.
OBARRAY defaults to the value of `obarray'. */)
- (function, obarray)
- Lisp_Object function, obarray;
+ (Lisp_Object function, Lisp_Object obarray)
{
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
#define OBARRAY_SIZE 1511
void
-init_obarray ()
+init_obarray (void)
{
Lisp_Object oblength;
}
\f
void
-defsubr (sname)
- struct Lisp_Subr *sname;
+defsubr (struct Lisp_Subr *sname)
{
Lisp_Object sym;
sym = intern_c_string (sname->symbol_name);
sym = intern_c_string (namestring);
i_fwd->type = Lisp_Fwd_Int;
i_fwd->intvar = address;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
}
sym = intern_c_string (namestring);
b_fwd->type = Lisp_Fwd_Bool;
b_fwd->boolvar = address;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
sym = intern_c_string (namestring);
o_fwd->type = Lisp_Fwd_Obj;
o_fwd->objvar = address;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
}
staticpro (address);
}
+
/* Similar but define a variable whose value is the Lisp Object stored
at a particular offset in the current kboard object. */
sym = intern_c_string (namestring);
ko_fwd->type = Lisp_Fwd_Kboard_Obj;
ko_fwd->offset = offset;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
static Lisp_Object dump_path;
void
-init_lread ()
+init_lread (void)
{
- char *normal;
+ const char *normal;
int turn_off_warning = 0;
/* Compute the default load-path. */
does not exist. Print it on stderr and put it in *Messages*. */
void
-dir_warning (format, dirname)
- char *format;
- Lisp_Object dirname;
+dir_warning (const char *format, Lisp_Object dirname)
{
char *buffer
= (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
}
void
-syms_of_lread ()
+syms_of_lread (void)
{
defsubr (&Sread);
defsubr (&Sread_from_string);
Vbytecomp_version_regexp
= make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
+ Qlexical_binding = intern ("lexical-binding");
+ staticpro (&Qlexical_binding);
+ DEFVAR_LISP ("lexical-binding", &Vlexical_binding,
+ doc: /* If non-nil, use lexical binding when evaluating code.
+This only applies to code evaluated by `eval-buffer' and `eval-region'.
+This variable is automatically set from the file variables of an interpreted
+ lisp file read using `load'.
+This variable automatically becomes buffer-local when set. */);
+ Fmake_variable_buffer_local (Qlexical_binding);
+
DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
Veval_buffer_list = Qnil;