store lisp structures in SCM objects
[bpt/emacs.git] / src / lread.c
index c24af0c..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'.
@@ -1420,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, 0);
+  int fd = openp (path, filename, suffixes, &file, predicate, false);
   if (NILP (predicate) && fd >= 0)
     emacs_close (fd);
   return file;
@@ -1450,24 +1455,28 @@ static Lisp_Object Qdir_ok;
    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.  */
+   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, int newer)
+       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;
+  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;
-  struct timespec save_mtime;
-  int save_fd = 0;
+  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);
 
@@ -1478,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))
     {
@@ -1555,13 +1563,13 @@ 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;
                    }
                }
@@ -1623,13 +1631,16 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
 
              if (fd >= 0)
                {
-                  if (newer)
+                  if (newer && !NATNUMP (predicate))
                     {
                       struct timespec mtime = get_stat_mtime (&st);
 
-                      if (!save_fd || timespec_cmp (save_mtime, mtime) < 0)
+                     if (timespec_cmp (mtime, save_mtime) <= 0)
+                       emacs_close (fd);
+                     else
                         {
-                          if (save_fd) emacs_close (save_fd);
+                         if (0 <= save_fd)
+                           emacs_close (save_fd);
                           save_fd = fd;
                           save_mtime = mtime;
                           save_string = string;
@@ -1646,7 +1657,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                }
 
               /* No more suffixes.  Return the newest.  */
-              if (newer && save_fd && ! CONSP (XCDR (tail)))
+             if (0 <= save_fd && ! CONSP (XCDR (tail)))
                 {
                   if (storeptr)
                     *storeptr = save_string;
@@ -1752,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'.
@@ -1919,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)
        {
@@ -2042,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: "));
 
@@ -2643,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;
@@ -2742,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)
@@ -3549,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.  */
@@ -3568,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;
 }
@@ -3814,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
@@ -3856,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;
@@ -3926,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.  */
 
@@ -3940,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;
@@ -4043,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
@@ -4052,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");  */
@@ -4333,7 +4357,7 @@ init_lread (void)
 #ifdef CANNOT_DUMP
   bool use_loadpath = true;
 #else
-  bool use_loadpath = !NILP (Vpurify_flag);
+  bool use_loadpath = NILP (Vpurify_flag);
 #endif
 
   if (use_loadpath && egetenv ("EMACSLOADPATH"))
@@ -4376,7 +4400,7 @@ init_lread (void)
             }
         }                       /* Fmemq (Qnil, Vload_path) */
     }
-  else                          /* Vpurify_flag || !EMACSLOADPATH */
+  else
     {
       Vload_path = load_path_default ();
 
@@ -4393,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;
 
@@ -4673,8 +4697,9 @@ variables, this must be set in the first line 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.  If this option is non-nil, it checks all suffixes and
-uses whichever file is newest.
+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;