]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
Merge from emacs-24; up to 2014-07-27T09:41:59Z!ttn@gnu.org
[gnu-emacs] / src / lread.c
index f32b60ad5881d2f9d025a5f92963072a6dd208b2..171a51acb3f40abee55b34ebfeebc4338a555f8f 100644 (file)
@@ -970,10 +970,8 @@ load_warn_old_style_backquotes (Lisp_Object file)
 {
   if (!NILP (Vold_style_backquotes))
     {
-      Lisp_Object args[2];
-      args[0] = build_string ("Loading `%s': old-style backquotes detected!");
-      args[1] = file;
-      Fmessage (2, args);
+      AUTO_STRING (format, "Loading `%s': old-style backquotes detected!");
+      Fmessage (2, (Lisp_Object []) {format, file});
     }
 }
 
@@ -2098,9 +2096,10 @@ DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
        doc: /* Read one Lisp expression which is represented as text by STRING.
 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
 FINAL-STRING-INDEX is an integer giving the position of the next
- remaining character in STRING.
-START and END optionally delimit a substring of STRING from which to read;
- they default to 0 and (length STRING) respectively.  */)
+remaining character in STRING.  START and END optionally delimit
+a substring of STRING from which to read;  they default to 0 and
+(length STRING) respectively.  Negative values are counted from
+the end of STRING.  */)
   (Lisp_Object string, Lisp_Object start, Lisp_Object end)
 {
   Lisp_Object ret;
@@ -2111,10 +2110,9 @@ START and END optionally delimit a substring of STRING from which to read;
 }
 
 /* Function to set up the global context we need in toplevel read
-   calls.  */
+   calls.  START and END only used when STREAM is a string.  */
 static Lisp_Object
 read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
-/* `start', `end' only used when stream is a string.  */
 {
   Lisp_Object retval;
 
@@ -2136,25 +2134,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
       else
        string = XCAR (stream);
 
-      if (NILP (end))
-       endval = SCHARS (string);
-      else
-       {
-         CHECK_NUMBER (end);
-         if (! (0 <= XINT (end) && XINT (end) <= SCHARS (string)))
-           args_out_of_range (string, end);
-         endval = XINT (end);
-       }
+      validate_subarray (string, start, end, SCHARS (string),
+                        &startval, &endval);
 
-      if (NILP (start))
-       startval = 0;
-      else
-       {
-         CHECK_NUMBER (start);
-         if (! (0 <= XINT (start) && XINT (start) <= endval))
-           args_out_of_range (string, start);
-         startval = XINT (start);
-       }
       read_from_string_index = startval;
       read_from_string_index_byte = string_char_to_byte (string, startval);
       read_from_string_limit = endval;
@@ -2891,11 +2873,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                  if (c == '=')
                    {
                      /* Make a placeholder for #n# to use temporarily.  */
-                     Lisp_Object placeholder;
-                     Lisp_Object cell;
-
-                     placeholder = Fcons (Qnil, Qnil);
-                     cell = Fcons (make_number (n), placeholder);
+                     AUTO_CONS (placeholder, Qnil, Qnil);
+                     Lisp_Object cell = Fcons (make_number (n), placeholder);
                      read_objects = Fcons (cell, read_objects);
 
                      /* Read the object itself.  */
@@ -3374,7 +3353,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
           substitute_in_interval contains part of the logic.  */
 
        INTERVAL root_interval = string_intervals (subtree);
-       Lisp_Object arg = Fcons (object, placeholder);
+       AUTO_CONS (arg, object, placeholder);
 
        traverse_intervals_noorder (root_interval,
                                    &substitute_in_interval, arg);
@@ -3681,8 +3660,10 @@ read_list (bool flag, Lisp_Object readcharfun)
               in the installed Lisp directory.
               We don't use Fexpand_file_name because that would make
               the directory absolute now.  */
-           elt = concat2 (build_string ("../lisp/"),
-                        Ffile_name_nondirectory (elt));
+           {
+             AUTO_STRING (dot_dot_lisp, "../lisp/");
+             elt = concat2 (dot_dot_lisp, Ffile_name_nondirectory (elt));
+           }
        }
       else if (EQ (elt, Vload_file_name)
               && ! NILP (elt)
@@ -3810,6 +3791,30 @@ check_obarray (Lisp_Object obarray)
   return obarray;
 }
 
+/* Intern a symbol with name STRING in OBARRAY using bucket INDEX.  */
+
+Lisp_Object
+intern_driver (Lisp_Object string, Lisp_Object obarray, ptrdiff_t index)
+{
+  Lisp_Object *ptr, sym = Fmake_symbol (string);
+
+  XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray)
+                            ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
+                            : SYMBOL_INTERNED);
+
+  if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray))
+    {
+      XSYMBOL (sym)->constant = 1;
+      XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
+      SET_SYMBOL_VAL (XSYMBOL (sym), sym);
+    }
+
+  ptr = aref_addr (obarray, index);
+  set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
+  *ptr = sym;
+  return sym;
+}
+
 /* Intern the C string STR: return a symbol with that name,
    interned in the current obarray.  */
 
@@ -3819,7 +3824,8 @@ intern_1 (const char *str, ptrdiff_t len)
   Lisp_Object obarray = check_obarray (Vobarray);
   Lisp_Object tem = oblookup (obarray, str, len, len);
 
-  return SYMBOLP (tem) ? tem : Fintern (make_string (str, len), obarray);
+  return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len),
+                                             obarray, XINT (tem));
 }
 
 Lisp_Object
@@ -3828,16 +3834,14 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
   Lisp_Object obarray = check_obarray (Vobarray);
   Lisp_Object tem = oblookup (obarray, str, len, len);
 
-  if (SYMBOLP (tem))
-    return tem;
-
-  if (NILP (Vpurify_flag))
-    /* 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.  */
-    emacs_abort ();
-
-  return Fintern (make_pure_c_string (str, len), obarray);
+  if (!SYMBOLP (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.  */
+      eassert (!NILP (Vpurify_flag));
+      tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem));
+    }
+  return tem;
 }
 \f
 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
@@ -3847,43 +3851,16 @@ A second optional argument specifies the obarray to use;
 it defaults to the value of `obarray'.  */)
   (Lisp_Object string, Lisp_Object obarray)
 {
-  register Lisp_Object tem, sym, *ptr;
-
-  if (NILP (obarray)) obarray = Vobarray;
-  obarray = check_obarray (obarray);
+  Lisp_Object tem;
 
+  obarray = check_obarray (NILP (obarray) ? Vobarray : obarray);
   CHECK_STRING (string);
 
-  tem = oblookup (obarray, SSDATA (string),
-                 SCHARS (string),
-                 SBYTES (string));
-  if (!INTEGERP (tem))
-    return tem;
-
-  if (!NILP (Vpurify_flag))
-    string = Fpurecopy (string);
-  sym = Fmake_symbol (string);
-
-  if (EQ (obarray, initial_obarray))
-    XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
-  else
-    XSYMBOL (sym)->interned = SYMBOL_INTERNED;
-
-  if ((SREF (string, 0) == ':')
-      && EQ (obarray, initial_obarray))
-    {
-      XSYMBOL (sym)->constant = 1;
-      XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
-      SET_SYMBOL_VAL (XSYMBOL (sym), sym);
-    }
-
-  ptr = aref_addr (obarray, XINT (tem));
-  if (SYMBOLP (*ptr))
-    set_symbol_next (sym, XSYMBOL (*ptr));
-  else
-    set_symbol_next (sym, NULL);
-  *ptr = sym;
-  return sym;
+  tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
+  if (!SYMBOLP (tem))
+    tem = intern_driver (NILP (Vpurify_flag) ? string
+                        : Fpurecopy (string), obarray, XINT (tem));
+  return tem;
 }
 
 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,