store lisp structures in SCM objects
[bpt/emacs.git] / src / lread.c
index 89bce5e..704f3cf 100644 (file)
@@ -1,6 +1,7 @@
 /* Lisp parsing and input streams.
 
-Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation, Inc.
+Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation,
+Inc.
 
 This file is part of GNU Emacs.
 
@@ -212,7 +213,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
       else
        {
          c = BUF_FETCH_BYTE (inbuffer, pt_byte);
-         if (! ASCII_BYTE_P (c))
+         if (! ASCII_CHAR_P (c))
            c = BYTE8_TO_CHAR (c);
          pt_byte++;
        }
@@ -241,7 +242,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
       else
        {
          c = BUF_FETCH_BYTE (inbuffer, bytepos);
-         if (! ASCII_BYTE_P (c))
+         if (! ASCII_CHAR_P (c))
            c = BYTE8_TO_CHAR (c);
          bytepos++;
        }
@@ -323,7 +324,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
     return c;
   if (multibyte)
     *multibyte = 1;
-  if (ASCII_BYTE_P (c))
+  if (ASCII_CHAR_P (c))
     return c;
   if (emacs_mule_encoding)
     return read_emacs_mule_char (c, readbyte, readcharfun);
@@ -1029,6 +1030,10 @@ in `load-file-rep-suffixes'.  If MUST-SUFFIX is non-nil, only the
 return value of `get-load-suffixes' is used, i.e. the file name is
 required to have a non-empty suffix.
 
+When searching suffixes, this function normally stops at the first
+one that exists.  If the option `load-prefer-newer' is non-nil,
+however, it tries all suffixes, and uses whichever file is the newest.
+
 Loading a file records its definitions, and its `provide' and
 `require' calls, in an element of `load-history' whose
 car is the file name loaded.  See `load-history'.
@@ -1129,7 +1134,7 @@ Return t if the file exists and loads successfully.  */)
            }
        }
 
-      fd = openp (Vload_path, file, suffixes, &found, Qnil);
+      fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
       UNGCPRO;
     }
 
@@ -1252,29 +1257,36 @@ Return t if the file exists and loads successfully.  */)
 #ifdef DOS_NT
          fmode = "rb";
 #endif /* DOS_NT */
-         result = stat (SSDATA (efound), &s1);
-         if (result == 0)
-           {
-             SSET (efound, SBYTES (efound) - 1, 0);
-             result = stat (SSDATA (efound), &s2);
-             SSET (efound, SBYTES (efound) - 1, 'c');
-           }
 
-         if (result == 0
-             && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0)
-           {
-             /* Make the progress messages mention that source is newer.  */
-             newer = 1;
+          /* openp already checked for newness, no point doing it again.
+             FIXME would be nice to get a message when openp
+             ignores suffix order due to load_prefer_newer.  */
+          if (!load_prefer_newer)
+            {
+              result = stat (SSDATA (efound), &s1);
+              if (result == 0)
+                {
+                  SSET (efound, SBYTES (efound) - 1, 0);
+                  result = stat (SSDATA (efound), &s2);
+                  SSET (efound, SBYTES (efound) - 1, 'c');
+                }
 
-             /* If we won't print another message, mention this anyway.  */
-             if (!NILP (nomessage) && !force_load_messages)
-               {
-                 Lisp_Object msg_file;
-                 msg_file = Fsubstring (found, make_number (0), make_number (-1));
-                 message_with_string ("Source file `%s' newer than byte-compiled file",
-                                      msg_file, 1);
-               }
-           }
+              if (result == 0
+                  && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0)
+                {
+                  /* Make the progress messages mention that source is newer.  */
+                  newer = 1;
+
+                  /* If we won't print another message, mention this anyway.  */
+                  if (!NILP (nomessage) && !force_load_messages)
+                    {
+                      Lisp_Object msg_file;
+                      msg_file = Fsubstring (found, make_number (0), make_number (-1));
+                      message_with_string ("Source file `%s' newer than byte-compiled file",
+                                           msg_file, 1);
+                    }
+                }
+            } /* !load_prefer_newer */
          UNGCPRO;
        }
     }
@@ -1413,7 +1425,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them.  */)
   (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
 {
   Lisp_Object file;
-  int fd = openp (path, filename, suffixes, &file, predicate);
+  int fd = openp (path, filename, suffixes, &file, predicate, false);
   if (NILP (predicate) && fd >= 0)
     emacs_close (fd);
   return file;
@@ -1440,22 +1452,31 @@ static Lisp_Object Qdir_ok;
    nil is stored there on failure.
 
    If the file we find is remote, return -2
-   but store the found remote file name in *STOREPTR.  */
+   but store the found remote file name in *STOREPTR.
+
+   If NEWER is true, try all SUFFIXes and return the result for the
+   newest file that exists.  Does not apply to remote files,
+   or if PREDICATE is specified.  */
 
 int
 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
-       Lisp_Object *storeptr, Lisp_Object predicate)
+       Lisp_Object *storeptr, Lisp_Object predicate, bool newer)
 {
   ptrdiff_t fn_size = 100;
   char buf[100];
   char *fn = buf;
-  bool absolute = 0;
+  bool absolute;
   ptrdiff_t want_length;
   Lisp_Object filename;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
-  Lisp_Object string, tail, encoded_fn;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7;
+  Lisp_Object string, tail, encoded_fn, save_string;
   ptrdiff_t max_suffix_len = 0;
   int last_errno = ENOENT;
+  int save_fd = -1;
+
+  /* The last-modified time of the newest matching file found.
+     Initialize it to something less than all valid timestamps.  */
+  struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1);
 
   CHECK_STRING (str);
 
@@ -1466,14 +1487,13 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                            SBYTES (XCAR (tail)));
     }
 
-  string = filename = encoded_fn = Qnil;
-  GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
+  string = filename = encoded_fn = save_string = Qnil;
+  GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn);
 
   if (storeptr)
     *storeptr = Qnil;
 
-  if (complete_filename_p (str))
-    absolute = 1;
+  absolute = complete_filename_p (str);
 
   for (; CONSP (path); path = XCDR (path))
     {
@@ -1543,30 +1563,31 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                {
                  Lisp_Object tmp = call1 (predicate, string);
                  if (NILP (tmp))
-                   exists = 0;
+                   exists = false;
                  else if (EQ (tmp, Qdir_ok)
                           || NILP (Ffile_directory_p (string)))
-                   exists = 1;
+                   exists = true;
                  else
                    {
-                     exists = 0;
+                     exists = false;
                      last_errno = EISDIR;
                    }
                }
 
              if (exists)
                {
-                 /* We succeeded; return this descriptor and filename.  */
-                 if (storeptr)
-                   *storeptr = string;
-                 UNGCPRO;
-                 return -2;
+                  /* We succeeded; return this descriptor and filename.  */
+                  if (storeptr)
+                    *storeptr = string;
+                  UNGCPRO;
+                  return -2;
                }
            }
          else
            {
              int fd;
              const char *pfn;
+             struct stat st;
 
              encoded_fn = ENCODE_FILE (string);
              pfn = SSDATA (encoded_fn);
@@ -1597,7 +1618,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                    }
                  else
                    {
-                     struct stat st;
                      int err = (fstat (fd, &st) != 0 ? errno
                                 : S_ISDIR (st.st_mode) ? EISDIR : 0);
                      if (err)
@@ -1611,12 +1631,39 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
 
              if (fd >= 0)
                {
-                 /* We succeeded; return this descriptor and filename.  */
-                 if (storeptr)
-                   *storeptr = string;
-                 UNGCPRO;
-                 return fd;
+                  if (newer && !NATNUMP (predicate))
+                    {
+                      struct timespec mtime = get_stat_mtime (&st);
+
+                     if (timespec_cmp (mtime, save_mtime) <= 0)
+                       emacs_close (fd);
+                     else
+                        {
+                         if (0 <= save_fd)
+                           emacs_close (save_fd);
+                          save_fd = fd;
+                          save_mtime = mtime;
+                          save_string = string;
+                        }
+                    }
+                  else
+                    {
+                      /* We succeeded; return this descriptor and filename.  */
+                      if (storeptr)
+                        *storeptr = string;
+                      UNGCPRO;
+                      return fd;
+                    }
                }
+
+              /* No more suffixes.  Return the newest.  */
+             if (0 <= save_fd && ! CONSP (XCDR (tail)))
+                {
+                  if (storeptr)
+                    *storeptr = save_string;
+                  UNGCPRO;
+                  return save_fd;
+                }
            }
        }
       if (absolute)
@@ -1716,6 +1763,29 @@ end_of_file_error (void)
   xsignal0 (Qend_of_file);
 }
 
+static Lisp_Object
+readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
+{
+  /* If we macroexpand the toplevel form non-recursively and it ends
+     up being a `progn' (or if it was a progn to start), treat each
+     form in the progn as a top-level form.  This way, if one form in
+     the progn defines a macro, that macro is in effect when we expand
+     the remaining forms.  See similar code in bytecomp.el.  */
+  val = call2 (macroexpand, val, Qnil);
+  if (EQ (CAR_SAFE (val), Qprogn))
+    {
+      Lisp_Object subforms = XCDR (val);
+      val = Qnil;
+      for (; CONSP (subforms); subforms = XCDR (subforms))
+          val = readevalloop_eager_expand_eval (XCAR (subforms),
+                                                macroexpand);
+    }
+  else
+      val = eval_sub (call2 (macroexpand, val, Qt));
+
+  return val;
+}
+
 /* UNIBYTE specifies how to set load_convert_to_unibyte
    for this invocation.
    READFUN, if non-nil, is used instead of `read'.
@@ -1883,8 +1953,9 @@ readevalloop (Lisp_Object readcharfun,
 
       /* Now eval what we just read.  */
       if (!NILP (macroexpand))
-       val = call1 (macroexpand, val);
-      val = eval_sub (val);
+        val = readevalloop_eager_expand_eval (val, macroexpand);
+      else
+        val = eval_sub (val);
 
       if (printflag)
        {
@@ -2006,7 +2077,7 @@ STREAM or the value of `standard-input' may be:
   if (EQ (stream, Qt))
     stream = Qread_char;
   if (EQ (stream, Qread_char))
-    /* FIXME: ¿¡ When is this used !?  */
+    /* FIXME: ?! When is this used !?  */
     return call1 (intern ("read-minibuffer"),
                  build_string ("Lisp expression: "));
 
@@ -2607,9 +2678,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
          /* Accept compiled functions at read-time so that we don't have to
             build them using function calls.  */
          Lisp_Object tmp;
+         struct Lisp_Vector *vec;
          tmp = read_vector (readcharfun, 1);
-         struct Lisp_Vector* vec = XVECTOR (tmp);
-         if (vec->header.size==0)
+         vec = XVECTOR (tmp);
+         if (vec->header.size == 0)
            invalid_syntax ("Empty byte-code object");
          make_byte_code (vec);
          return tmp;
@@ -2706,7 +2778,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 
              if (saved_doc_string_size == 0)
                {
-                 saved_doc_string = xmalloc (nskip + extra);
+                 saved_doc_string = xmalloc_atomic (nskip + extra);
                  saved_doc_string_size = nskip + extra;
                }
              if (nskip > saved_doc_string_size)
@@ -3513,7 +3585,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag)
                  otem = XCONS (item);
                  bytestr = XCAR (item);
                  item = XCDR (item);
-                 free_cons (otem);
                }
 
              /* Now handle the bytecode slot.  */
@@ -3532,7 +3603,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag)
       ASET (vector, i, item);
       otem = XCONS (tem);
       tem = Fcdr (tem);
-      free_cons (otem);
     }
   return vector;
 }
@@ -3778,7 +3848,7 @@ it defaults to the value of `obarray'.  */)
       SET_SYMBOL_VAL (XSYMBOL (sym), sym);
     }
 
-  ptr = aref_addr (obarray, XINT(tem));
+  ptr = aref_addr (obarray, XINT (tem));
   if (SYMBOLP (*ptr))
     set_symbol_next (sym, XSYMBOL (*ptr));
   else
@@ -3820,7 +3890,8 @@ DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
 The value is t if a symbol was found and deleted, nil otherwise.
 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'.  */)
+OBARRAY, if nil, defaults to the value of the variable `obarray'.
+usage: (unintern NAME OBARRAY)  */)
   (Lisp_Object name, Lisp_Object obarray)
 {
   register Lisp_Object string, tem;
@@ -3890,7 +3961,8 @@ OBARRAY defaults to the value of the variable `obarray'.  */)
 \f
 /* Return the symbol in OBARRAY whose names matches the string
    of SIZE characters (SIZE_BYTE bytes) at PTR.
-   If there is no such symbol in OBARRAY, return nil.
+   If there is no such symbol, return the integer bucket number of
+   where the symbol would be if it were present.
 
    Also store the bucket number in oblookup_last_bucket_number.  */
 
@@ -3904,9 +3976,6 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
 
   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;
   bucket = AREF (obarray, hash);
   oblookup_last_bucket_number = hash;
@@ -4007,7 +4076,7 @@ init_obarray (void)
 
   DEFSYM (Qvariable_documentation, "variable-documentation");
 
-  read_buffer = xmalloc (size);
+  read_buffer = xmalloc_atomic (size);
   read_buffer_size = size;
 }
 \f
@@ -4016,21 +4085,12 @@ defsubr (struct Lisp_Subr *sname)
 {
   Lisp_Object sym, tem;
   sym = intern_c_string (sname->symbol_name);
+  SCM_NEWSMOB (sname->header.self, lisp_vectorlike_tag, sname);
   XSETPVECTYPE (sname, PVEC_SUBR);
   XSETSUBR (tem, sname);
   set_symbol_function (sym, tem);
 }
 
-#ifdef NOTDEF /* Use fset in subr.el now!  */
-void
-defalias (struct Lisp_Subr *sname, char *string)
-{
-  Lisp_Object sym;
-  sym = intern (string);
-  XSETSUBR (XSYMBOL (sym)->function, sname);
-}
-#endif /* NOTDEF */
-
 /* Define an "integer variable"; a symbol whose value is forwarded to a
    C variable of type EMACS_INT.  Sample call (with "xx" to fool make-docfile):
    DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation");  */
@@ -4293,8 +4353,14 @@ init_lread (void)
 {
   /* First, set Vload_path.  */
 
-  /* We explicitly ignore EMACSLOADPATH when dumping.  */
-  if (NILP (Vpurify_flag) && egetenv ("EMACSLOADPATH"))
+  /* Ignore EMACSLOADPATH when dumping.  */
+#ifdef CANNOT_DUMP
+  bool use_loadpath = true;
+#else
+  bool use_loadpath = NILP (Vpurify_flag);
+#endif
+
+  if (use_loadpath && egetenv ("EMACSLOADPATH"))
     {
       Vload_path = decode_env_path ("EMACSLOADPATH", 0, 1);
 
@@ -4334,7 +4400,7 @@ init_lread (void)
             }
         }                       /* Fmemq (Qnil, Vload_path) */
     }
-  else                          /* Vpurify_flag || !EMACSLOADPATH */
+  else
     {
       Vload_path = load_path_default ();
 
@@ -4351,7 +4417,7 @@ init_lread (void)
           sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
           if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
         }
-    }                           /* !Vpurify_flag && EMACSLOADPATH */
+    }
 
   Vvalues = Qnil;
 
@@ -4626,6 +4692,18 @@ variables, this must be set in the first line of a file.  */);
   Vold_style_backquotes = Qnil;
   DEFSYM (Qold_style_backquotes, "old-style-backquotes");
 
+  DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer,
+               doc: /* Non-nil means `load' prefers the newest version of a file.
+This applies when a filename suffix is not explicitly specified and
+`load' is trying various possible suffixes (see `load-suffixes' and
+`load-file-rep-suffixes').  Normally, it stops at the first file
+that exists unless you explicitly specify one or the other.  If this
+option is non-nil, it checks all suffixes and uses whichever file is
+newest.
+Note that if you customize this, obviously it will not affect files
+that are loaded before your customizations are read!  */);
+  load_prefer_newer = 0;
+
   /* Vsource_directory was initialized in init_lread.  */
 
   DEFSYM (Qcurrent_load_list, "current-load-list");