#include <sys/file.h>
#include <errno.h>
#include <limits.h> /* For CHAR_BIT. */
-#include <setjmp.h>
#include <stat-time.h>
#include "lisp.h"
#include "intervals.h"
#include "msdos.h"
#endif
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#include <unistd.h>
-#include <math.h>
#ifdef HAVE_SETLOCALE
#include <locale.h>
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
static Lisp_Object Qinhibit_file_name_operation;
static Lisp_Object Qeval_buffer_list;
-static Lisp_Object Qlexical_binding;
+Lisp_Object Qlexical_binding;
static 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 Qinternal_interpreter_environment;
-
static Lisp_Object Qload_in_progress;
/* The association list of objects read with the #n=object form.
static int unread_char;
static int
-readchar (Lisp_Object readcharfun, int *multibyte)
+readchar (Lisp_Object readcharfun, bool *multibyte)
{
Lisp_Object tem;
register int c;
{
if (load_each_byte)
{
- BLOCK_INPUT;
+ block_input ();
ungetc (c, instream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
unread_char = c;
{
if (c >= 0)
{
- BLOCK_INPUT;
+ block_input ();
ungetc (c, instream);
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
- BLOCK_INPUT;
+ block_input ();
c = getc (instream);
#ifdef EINTR
/* Interrupted reads have been observed while reading over the network. */
while (c == EOF && ferror (instream) && errno == EINTR)
{
- UNBLOCK_INPUT;
+ unblock_input ();
QUIT;
- BLOCK_INPUT;
+ block_input ();
clearerr (instream);
c = getc (instream);
}
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
return (c == EOF ? -1 : c);
}
{
double duration = extract_float (seconds);
EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
- EMACS_GET_TIME (end_time);
- EMACS_ADD_TIME (end_time, end_time, wait_time);
+ end_time = add_emacs_time (current_emacs_time (), wait_time);
}
/* Read until we get an acceptable event. */
(void)
{
register Lisp_Object val;
- BLOCK_INPUT;
+ block_input ();
XSETINT (val, getc (instream));
- UNBLOCK_INPUT;
+ unblock_input ();
return val;
}
if (i >= nbytes
|| fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
- buf + i) < 0)
+ buf + i, nbytes - i) < 0)
safe_p = 0;
}
if (safe_p)
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
if (stream != NULL)
{
- BLOCK_INPUT;
+ block_input ();
fclose (stream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return Qnil;
}
for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- ptrdiff_t lsuffix = SBYTES (XCAR (tail));
+ ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
Lisp_Object handler;
int exists;
/* Concatenate path element/specified name with the suffix.
If the directory starts with /:, remove that. */
- if (SCHARS (filename) > 2
- && SREF (filename, 0) == '/'
- && SREF (filename, 1) == ':')
- {
- strncpy (fn, SSDATA (filename) + 2,
- SBYTES (filename) - 2);
- fn[SBYTES (filename) - 2] = 0;
- }
- else
- {
- strncpy (fn, SSDATA (filename),
- SBYTES (filename));
- fn[SBYTES (filename)] = 0;
- }
-
- if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
- strncat (fn, SSDATA (XCAR (tail)), lsuffix);
-
+ int prefixlen = ((SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
+ ? 2 : 0);
+ fnlen = SBYTES (filename) - prefixlen;
+ memcpy (fn, SDATA (filename) + prefixlen, fnlen);
+ memcpy (fn + fnlen, SDATA (XCAR (tail)), lsuffix + 1);
+ fnlen += lsuffix;
/* Check that the file exists and is not a directory. */
/* We used to only check for handlers on non-absolute file names:
if (absolute)
handler = Ffind_file_name_handler (filename, Qfile_exists_p);
It's not clear why that was the case and it breaks things like
(load "/bar.el") where the file is actually "/bar.el.gz". */
- string = build_string (fn);
+ string = make_string (fn, fnlen);
handler = Ffind_file_name_handler (string, Qfile_exists_p);
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
int whole_buffer = 0;
/* 1 on the first time around. */
int first_sexp = 1;
+ Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
+
+ if (NILP (Ffboundp (macroexpand))
+ /* Don't macroexpand in .elc files, since it should have been done
+ already. We actually don't know whether we're in a .elc file or not,
+ so we use circumstancial evidence: .el files normally go through
+ Vload_source_file_function -> load-with-code-conversion
+ -> eval-buffer. */
+ || EQ (readcharfun, Qget_file_char)
+ || EQ (readcharfun, Qget_emacs_mule_file_char))
+ macroexpand = Qnil;
if (MARKERP (readcharfun))
{
/* We assume START is nil when input is not from a buffer. */
if (! NILP (start) && !b)
- abort ();
+ emacs_abort ();
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
{
ptrdiff_t count1 = SPECPDL_INDEX ();
- if (b != 0 && NILP (BVAR (b, name)))
+ if (b != 0 && !BUFFER_LIVE_P (b))
error ("Reading from killed buffer");
if (!NILP (start))
unbind_to (count1, Qnil);
/* Now eval what we just read. */
+ if (!NILP (macroexpand))
+ val = call1 (macroexpand, val);
val = eval_sub (val);
if (printflag)
static Lisp_Object
read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
- register int c;
- unsigned uninterned_symbol = 0;
- int multibyte;
+ int c;
+ bool uninterned_symbol = 0;
+ bool multibyte;
*pch = 0;
load_each_byte = 0;
/* No symbol character follows, this is the empty
symbol. */
UNREAD (c);
- return Fmake_symbol (build_string (""));
+ return Fmake_symbol (empty_unibyte_string);
}
goto read_symbol;
}
/* ## is the empty symbol. */
if (c == '#')
- return Fintern (build_string (""), Qnil);
+ return Fintern (empty_unibyte_string, Qnil);
/* Reader forms that can reuse previously read objects. */
if (c >= '0' && c <= '9')
{
/* Check for text properties in each interval.
substitute_in_interval contains part of the logic. */
- INTERVAL root_interval = STRING_INTERVALS (subtree);
- Lisp_Object arg = Fcons (object, placeholder);
+ INTERVAL root_interval = string_intervals (subtree);
+ Lisp_Object arg = Fcons (object, placeholder);
traverse_intervals_noorder (root_interval,
&substitute_in_interval, arg);
Lisp_Object object = Fcar (arg);
Lisp_Object placeholder = Fcdr (arg);
- SUBSTITUTE (interval->plist, interval->plist = true_value);
+ SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
}
\f
/* Delay handling the bytecode slot until we know whether
it is lazily-loaded (we can tell by whether the
constants slot is nil). */
- ptr[COMPILED_CONSTANTS] = item;
+ ASET (vector, COMPILED_CONSTANTS, item);
item = Qnil;
}
else if (i == COMPILED_CONSTANTS)
}
/* Now handle the bytecode slot. */
- ptr[COMPILED_BYTECODE] = bytestr;
+ ASET (vector, COMPILED_BYTECODE, bytestr);
}
else if (i == COMPILED_DOC_STRING
&& STRINGP (item)
item = Fstring_as_multibyte (item);
}
}
- ptr[i] = item;
+ ASET (vector, i, item);
otem = XCONS (tem);
tem = Fcdr (tem);
free_cons (otem);
interned in the current obarray. */
Lisp_Object
-intern (const char *str)
+intern_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
- if (SYMBOLP (tem))
- return tem;
- return Fintern (make_string (str, len), obarray);
+ return SYMBOLP (tem) ? tem : Fintern (make_string (str, len), obarray);
}
Lisp_Object
-intern_c_string (const char *str)
+intern_c_string_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
if (SYMBOLP (tem))
return tem;
/* Creating a non-pure string from a string literal not
implemented yet. We could just use make_string here and live
with the extra copy. */
- abort ();
+ emacs_abort ();
- return Fintern (make_pure_c_string (str), obarray);
+ return Fintern (make_pure_c_string (str, len), obarray);
}
\f
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
- ptr = &AREF (obarray, XINT(tem));
+ ptr = aref_addr (obarray, XINT(tem));
if (SYMBOLP (*ptr))
- XSYMBOL (sym)->next = XSYMBOL (*ptr);
+ set_symbol_next (sym, XSYMBOL (*ptr));
else
- XSYMBOL (sym)->next = 0;
+ set_symbol_next (sym, NULL);
*ptr = sym;
return sym;
}
if (EQ (AREF (obarray, hash), tem))
{
if (XSYMBOL (tem)->next)
- XSETSYMBOL (AREF (obarray, hash), XSYMBOL (tem)->next);
+ {
+ Lisp_Object sym;
+ XSETSYMBOL (sym, XSYMBOL (tem)->next);
+ ASET (obarray, hash, sym);
+ }
else
- XSETINT (AREF (obarray, hash), 0);
+ ASET (obarray, hash, make_number (0));
}
else
{
XSETSYMBOL (following, XSYMBOL (tail)->next);
if (EQ (following, tem))
{
- XSYMBOL (tail)->next = XSYMBOL (following)->next;
+ set_symbol_next (tail, XSYMBOL (following)->next);
break;
}
}
register Lisp_Object tail;
Lisp_Object bucket, tem;
- if (!VECTORP (obarray)
- || (obsize = ASIZE (obarray)) == 0)
- {
- obarray = check_obarray (obarray);
- obsize = ASIZE (obarray);
- }
+ obarray = check_obarray (obarray);
+ obsize = ASIZE (obarray);
+
/* This is sometimes needed in the middle of GC. */
obsize &= ~ARRAY_MARK_FLAG;
hash = hash_string (ptr, size_byte) % obsize;
initial_obarray = Vobarray;
staticpro (&initial_obarray);
- Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
+ Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
/* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
NILP (Vpurify_flag) check in intern_c_string. */
Qnil = make_number (-1); Vpurify_flag = make_number (1);
/* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
so those two need to be fixed manually. */
SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
- XSYMBOL (Qunbound)->function = Qunbound;
- XSYMBOL (Qunbound)->plist = Qnil;
- /* XSYMBOL (Qnil)->function = Qunbound; */
+ set_symbol_function (Qunbound, Qunbound);
+ set_symbol_plist (Qunbound, Qnil);
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
XSYMBOL (Qnil)->constant = 1;
XSYMBOL (Qnil)->declared_special = 1;
- XSYMBOL (Qnil)->plist = Qnil;
+ set_symbol_plist (Qnil, Qnil);
Qt = intern_c_string ("t");
SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
void
defsubr (struct Lisp_Subr *sname)
{
- Lisp_Object sym;
+ Lisp_Object sym, tem;
sym = intern_c_string (sname->symbol_name);
XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR);
- XSETSUBR (XSYMBOL (sym)->function, sname);
+ XSETSUBR (tem, sname);
+ set_symbol_function (sym, tem);
}
#ifdef NOTDEF /* Use fset in subr.el now! */
nil if address contains 0. */
void
defvar_bool (struct Lisp_Boolfwd *b_fwd,
- const char *namestring, int *address)
+ const char *namestring, bool *address)
{
Lisp_Object sym;
sym = intern_c_string (namestring);
const char *normal;
#ifdef CANNOT_DUMP
+#ifdef HAVE_NS
+ const char *loadpath = ns_load_path ();
+#endif
+
normal = PATH_LOADSEARCH;
+#ifdef HAVE_NS
+ Vload_path = decode_env_path ("EMACSLOADPATH", loadpath ? loadpath : normal);
+#else
Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+#endif
load_path_check ();
sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
}
-#else
+#else /* !CANNOT_DUMP */
if (NILP (Vpurify_flag))
{
normal = PATH_LOADSEARCH;
}
else
{
+#ifdef HAVE_NS
+ const char *loadpath = ns_load_path ();
+ Vload_path = decode_env_path (0, loadpath ? loadpath : normal);
+#else
Vload_path = decode_env_path (0, normal);
+#endif
if (!NILP (Vinstallation_directory))
{
Lisp_Object tem, tem1;
{
tem = Fexpand_file_name (build_string ("site-lisp"),
Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
}
}
} /* Vinstallation_directory != Vsource_directory */
be missing unless something went extremely (and improbably)
wrong, in which case the build will fail in obvious ways. */
}
-#endif /* CANNOT_DUMP */
+#endif /* !CANNOT_DUMP */
Vvalues = Qnil;
/* Don't log the warning before we've initialized!! */
if (initialized)
{
- char *buffer;
- ptrdiff_t message_len;
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (buffer, char *,
- SBYTES (dirname) + strlen (format) - (sizeof "%s" - 1) + 1);
- message_len = esprintf (buffer, format, SDATA (dirname));
+ char *buffer = SAFE_ALLOCA (SBYTES (dirname)
+ + strlen (format) - (sizeof "%s" - 1) + 1);
+ ptrdiff_t message_len = esprintf (buffer, format, SDATA (dirname));
message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
SAFE_FREE ();
}
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
- Vload_suffixes = Fcons (make_pure_c_string (".elc"),
- Fcons (make_pure_c_string (".el"), Qnil));
+ Vload_suffixes = Fcons (build_pure_c_string (".elc"),
+ Fcons (build_pure_c_string (".el"), Qnil));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
When the regular expression matches, the file is considered to be safe
to load. See also `load-dangerous-libraries'. */);
Vbytecomp_version_regexp
- = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
+ = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
- Qlexical_binding = intern ("lexical-binding");
- staticpro (&Qlexical_binding);
+ DEFSYM (Qlexical_binding, "lexical-binding");
DEFVAR_LISP ("lexical-binding", Vlexical_binding,
doc: /* Whether to use lexical binding when evaluating code.
Non-nil means that the code in the current buffer should be evaluated
This variable is automatically set from the file variables of an
interpreted Lisp file read using `load'. Unlike other file local
variables, this must be set in the first line of a file. */);
+ Vlexical_binding = Qnil;
Fmake_variable_buffer_local (Qlexical_binding);
DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,