guile-elisp bootstrap (C)

* src/alloc.c (allocate_string): Return a Lisp_Object. All callers changed.

  (allocate_string_data): Take a Lisp_Object as first argument. All
  callers changed.

* src/callint.c (Finteractive): Remove.

* src/data.c (Finteractive_form): Handle a nil interactive-form
  correctly.

* src/emacs.c (main2): Set `lisp-string?'.

* src/eval.c (Fwhile): Remove.

  (Fcommandp): Handle a nil interactive-form correctly.

* src/lisp.h (struct Lisp_String): Move definition.

6 files changed, 33 insertions, 128 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 63ba7b9a30..30f09d32fc 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -444,14 +444,10 @@ init_strings (void)
 
 /* Return a new Lisp_String.  */
 
-static struct Lisp_String *
+static Lisp_Object
 allocate_string (void)
 {
-  struct Lisp_String *p;
-
-  p = xmalloc (sizeof *p);
-  SCM_NEWSMOB (p->self, lisp_string_tag, p);
-  return p;
+  return scm_make_smob (lisp_string_tag);
 }
 
 
@@ -462,9 +458,10 @@ allocate_string (void)
    S->data if it was initially non-null.  */
 
 void
-allocate_string_data (struct Lisp_String *s,
+allocate_string_data (Lisp_Object string,
 		      EMACS_INT nchars, EMACS_INT nbytes)
 {
+  struct Lisp_String *s = (void *) SCM_SMOB_DATA (string);
   unsigned char *data;
 
   if (STRING_BYTES_BOUND < nbytes)
@@ -487,11 +484,9 @@ static Lisp_Object
 make_empty_string (int multibyte)
 {
   Lisp_Object string;
-  struct Lisp_String *s;
 
-  s = allocate_string ();
-  allocate_string_data (s, 0, 0);
-  XSETSTRING (string, s);
+  string = allocate_string ();
+  allocate_string_data (string, 0, 0);
   if (! multibyte)
     STRING_SET_UNIBYTE (string);
 
@@ -734,17 +729,15 @@ Lisp_Object
 make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
 {
   Lisp_Object string;
-  struct Lisp_String *s;
 
   if (nchars < 0)
     emacs_abort ();
   if (!nbytes)
     return empty_multibyte_string;
 
-  s = allocate_string ();
-  s->intervals = NULL;
-  allocate_string_data (s, nchars, nbytes);
-  XSETSTRING (string, s);
+  string = allocate_string ();
+  ((struct Lisp_String *) SCM_SMOB_DATA (string))->intervals = NULL;
+  allocate_string_data (string, nchars, nbytes);
   return string;
 }
 
@@ -1621,7 +1614,8 @@ void
 init_alloc_once (void)
 {
   lisp_misc_tag = scm_make_smob_type ("elisp-misc", 0);
-  lisp_string_tag = scm_make_smob_type ("elisp-string", 0);
+  lisp_string_tag = scm_make_smob_type ("elisp-string",
+                                        sizeof (struct Lisp_String));
   lisp_vectorlike_tag = scm_make_smob_type ("elisp-vectorlike", 0);
 
   /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
diff --git a/src/callint.c b/src/callint.c
index bccea7f38c..212c4ece2a 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -48,77 +48,6 @@ static Lisp_Object point_marker;
 /* String for the prompt text used in Fcall_interactively.  */
 static Lisp_Object callint_message;
 
-/* ARGSUSED */
-DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
-       doc: /* Specify a way of parsing arguments for interactive use of a function.
-For example, write
- (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
- to make ARG be the raw prefix argument, and set BUF to an existing buffer,
- when `foo' is called as a command.
-The "call" to `interactive' is actually a declaration rather than a function;
- it tells `call-interactively' how to read arguments
- to pass to the function.
-When actually called, `interactive' just returns nil.
-
-Usually the argument of `interactive' is a string containing a code letter
- followed optionally by a prompt.  (Some code letters do not use I/O to get
- the argument and do not use prompts.)  To get several arguments, concatenate
- the individual strings, separating them by newline characters.
-Prompts are passed to format, and may use % escapes to print the
- arguments that have already been read.
-If the argument is not a string, it is evaluated to get a list of
- arguments to pass to the function.
-Just `(interactive)' means pass no args when calling interactively.
-
-Code letters available are:
-a -- Function name: symbol with a function definition.
-b -- Name of existing buffer.
-B -- Name of buffer, possibly nonexistent.
-c -- Character (no input method is used).
-C -- Command name: symbol with interactive function definition.
-d -- Value of point as number.  Does not do I/O.
-D -- Directory name.
-e -- Parameterized event (i.e., one that's a list) that invoked this command.
-     If used more than once, the Nth `e' returns the Nth parameterized event.
-     This skips events that are integers or symbols.
-f -- Existing file name.
-F -- Possibly nonexistent file name.
-G -- Possibly nonexistent file name, defaulting to just directory name.
-i -- Ignored, i.e. always nil.  Does not do I/O.
-k -- Key sequence (downcase the last event if needed to get a definition).
-K -- Key sequence to be redefined (do not downcase the last event).
-m -- Value of mark as number.  Does not do I/O.
-M -- Any string.  Inherits the current input method.
-n -- Number read using minibuffer.
-N -- Numeric prefix arg, or if none, do like code `n'.
-p -- Prefix arg converted to number.  Does not do I/O.
-P -- Prefix arg in raw form.  Does not do I/O.
-r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
-s -- Any string.  Does not inherit the current input method.
-S -- Any symbol.
-U -- Mouse up event discarded by a previous k or K argument.
-v -- Variable name: symbol that is `custom-variable-p'.
-x -- Lisp expression read but not evaluated.
-X -- Lisp expression read and evaluated.
-z -- Coding system.
-Z -- Coding system, nil if no prefix arg.
-
-In addition, if the string begins with `*', an error is signaled if
-  the buffer is read-only.
-If `@' appears at the beginning of the string, and if the key sequence
- used to invoke the command includes any mouse events, then the window
- associated with the first of those events is selected before the
- command is run.
-If the string begins with `^' and `shift-select-mode' is non-nil,
- Emacs first calls the function `handle-shift-selection'.
-You may use `@', `*', and `^' together.  They are processed in the
- order that they appear, before reading any arguments.
-usage: (interactive &optional ARGS)  */)
-  (Lisp_Object args)
-{
-  return Qnil;
-}
-
 /* Quotify EXP: if EXP is constant, return it.
    If EXP is not constant, return (quote EXP).  */
 static Lisp_Object
diff --git a/src/data.c b/src/data.c
index bd79e3cab3..03a2a12ff9 100644
--- a/src/data.c
+++ b/src/data.c
@@ -803,9 +803,10 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
 
   if (scm_is_true (scm_procedure_p (fun)))
     {
-      Lisp_Object tem = scm_procedure_property (fun, Qinteractive_form);
-      if (scm_is_true (tem))
-        return list2 (Qinteractive, tem);
+      Lisp_Object tem = scm_assq (Qinteractive_form,
+                                  scm_procedure_properties (fun));
+      if (scm_is_pair (tem))
+        return list2 (Qinteractive, scm_cdr (tem));
     }
   else if (COMPILEDP (fun))
     {
@@ -2190,7 +2191,7 @@ bool-vector.  IDX starts at 0.  */)
 	      unsigned char *str = SAFE_ALLOCA (nbytes);
 
 	      memcpy (str, SDATA (array), nbytes);
-	      allocate_string_data (XSTRING (array), nchars,
+	      allocate_string_data (array, nchars,
 				    nbytes + new_bytes - prev_bytes);
 	      memcpy (SDATA (array), str, idxval_byte);
 	      p1 = SDATA (array) + idxval_byte;
diff --git a/src/emacs.c b/src/emacs.c
index 9e12a7c4f8..89cdf27f78 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1189,10 +1189,15 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       scm_set_current_module (scm_c_resolve_module ("guile-user"));
 
       init_alloc_once ();
-      scm_c_module_define (scm_c_resolve_module ("language elisp lexer"),
+
+      scm_c_module_define (scm_c_resolve_module ("language elisp runtime"),
                            "make-lisp-string",
                            scm_c_make_gsubr ("make-lisp-string", 1, 0, 0,
                                              string_from_scheme));
+      scm_c_module_define (scm_c_resolve_module ("language elisp runtime"),
+                           "lisp-string?",
+                           scm_c_make_gsubr ("stringp", 1, 0, 0, Fstringp));
+
       init_guile ();
       init_fns_once ();
       init_obarray ();
diff --git a/src/eval.c b/src/eval.c
index cf086a8a3c..da416b9ec6 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -860,30 +860,6 @@ usage: (let VARLIST BODY...)  */)
   return elt;
 }
 
-DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
-       doc: /* If TEST yields non-nil, eval BODY... and repeat.
-The order of execution is thus TEST, BODY, TEST, BODY and so on
-until TEST returns nil.
-usage: (while TEST BODY...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object test, body;
-  struct gcpro gcpro1, gcpro2;
-
-  GCPRO2 (test, body);
-
-  test = XCAR (args);
-  body = XCDR (args);
-  while (!NILP (eval_sub (test)))
-    {
-      QUIT;
-      Fprogn (body);
-    }
-
-  UNGCPRO;
-  return Qnil;
-}
-
 DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
        doc: /* Return result of expanding macros at top level of FORM.
 If FORM is not a macro call, it is returned unchanged.
@@ -1747,7 +1723,8 @@ then strings and vectors are not accepted.  */)
     }
 
   if (scm_is_true (scm_procedure_p (fun)))
-    return (scm_is_true (scm_procedure_property (fun, Qinteractive_form))
+    return (scm_is_pair (scm_assq (Qinteractive_form,
+                                   scm_procedure_properties (fun)))
             ? Qt : if_prop);
   /* Bytecode objects are interactive if they are long enough to
      have an element whose index is COMPILED_INTERACTIVE, which is
diff --git a/src/lisp.h b/src/lisp.h
index 3a18ce06c5..9a9b31e85f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -767,6 +767,14 @@ LISP_MACRO_DEFUN_VOID (CHECK_TYPE,
 
 typedef struct interval *INTERVAL;
 
+struct Lisp_String
+  {
+    ptrdiff_t size;
+    ptrdiff_t size_byte;
+    INTERVAL intervals;		/* Text properties in this string.  */
+    unsigned char *data;
+  };
+
 LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c))
 LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c))
 
@@ -815,15 +823,6 @@ CDR_SAFE (Lisp_Object c)
 
 /* In a string or vector, the sign bit of the `size' is the gc mark bit.  */
 
-struct Lisp_String
-  {
-    Lisp_Object self;
-    ptrdiff_t size;
-    ptrdiff_t size_byte;
-    INTERVAL intervals;		/* Text properties in this string.  */
-    unsigned char *data;
-  };
-
 /* True if STR is a multibyte string.  */
 INLINE bool
 STRING_MULTIBYTE (Lisp_Object str)
@@ -3100,7 +3099,7 @@ extern void memory_warnings (void *, void (*warnfun) (const char *));
 /* Defined in alloc.c.  */
 extern void check_pure_size (void);
 extern void free_misc (Lisp_Object);
-extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
+extern void allocate_string_data (Lisp_Object, EMACS_INT, EMACS_INT);
 extern void malloc_warning (const char *);
 extern _Noreturn void memory_full (size_t);
 extern _Noreturn void buffer_memory_full (ptrdiff_t);