use guile subrs

* src/data.c (Qspecial_operator): New variable.
  (CHECK_SUBR, Ftype_of, Fsubrp, Fsubr_arity, Finteractive_form):
  Update for new subr representation.

* src/emacs.c (main2): Call `syms_of_data' early.

* src/lisp.h (XSUBR, SUBRP): Remove. All callers changed.
  (DEFUN): Define subrs as Guile procedures.
  (functionp): Update for new subr representation.

* src/lread.c (defsubr): Update for new subr representation. Take
  relevant subr properties as direct arguments instead of accepting a
  `Lisp_Subr' struct; all callers changed.

* src/doc.c (Fdocumentation, store_function_docstring):
* src/eval.c (Fcommandp, eval_sub_1, Fapply, Ffuncall1):
* src/print.c (print_object):
* src/xmenu.c: Update for new subr representation.

8 files changed, 157 insertions, 330 deletions

diff --git a/src/data.c b/src/data.c
index 426bae133a..7422f4e8b8 100644
--- a/src/data.c
+++ b/src/data.c
@@ -87,6 +87,7 @@ static Lisp_Object Qmany, Qunevalled;
 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
 static Lisp_Object Qdefun;
 
+Lisp_Object Qspecial_operator;
 Lisp_Object Qinteractive_form;
 static Lisp_Object Qdefalias_fset_function;
 
@@ -141,7 +142,7 @@ XOBJFWD (union Lisp_Fwd *a)
 static void
 CHECK_SUBR (Lisp_Object x)
 {
-  CHECK_TYPE (SUBRP (x), Qsubrp, x);
+  CHECK_TYPE (! NILP (Fsubrp (x)), Qsubrp, x);
 }
 
 static void
@@ -274,8 +275,6 @@ for example, (type-of 1) returns `integer'.  */)
 	return Qprocess;
       if (WINDOWP (object))
 	return Qwindow;
-      if (SUBRP (object))
-	return Qsubr;
       if (COMPILEDP (object))
 	return Qcompiled_function;
       if (BUFFERP (object))
@@ -298,6 +297,8 @@ for example, (type-of 1) returns `integer'.  */)
     }
   else if (FLOATP (object))
     return Qfloat;
+  else if (! NILP (Fsubrp (object)))
+    return Qsubr;
   else
     return Qt;
 }
@@ -469,7 +470,9 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
        doc: /* Return t if OBJECT is a built-in function.  */)
   (Lisp_Object object)
 {
-  if (SUBRP (object))
+  if (CONSP (object) && EQ (XCAR (object), Qspecial_operator))
+    object = XCDR (object);
+  if (SCM_PRIMITIVE_P (object))
     return Qt;
   return Qnil;
 }
@@ -800,14 +803,27 @@ of args.  MAX is the maximum number or the symbol `many', for a
 function with `&rest' args, or `unevalled' for a special form.  */)
   (Lisp_Object subr)
 {
-  short minargs, maxargs;
+  Lisp_Object min, max;
+  Lisp_Object arity;
+  bool special = false;
+
   CHECK_SUBR (subr);
-  minargs = XSUBR (subr)->min_args;
-  maxargs = XSUBR (subr)->max_args;
-  return Fcons (make_number (minargs),
-		maxargs == MANY ?        Qmany
-		: maxargs == UNEVALLED ? Qunevalled
-		:                        make_number (maxargs));
+  if (CONSP (subr) && EQ (XCAR (subr), Qspecial_operator))
+    {
+      subr = XCDR (subr);
+      special = true;
+    }
+  arity = scm_procedure_minimum_arity (subr);
+  if (scm_is_false (arity))
+    return Qnil;
+  min = XCAR (arity);
+  if (special)
+    max = Qunevalled;
+  else if (scm_is_true (XCAR (XCDR (XCDR (arity)))))
+    max = Qmany;
+  else
+    max = scm_sum (min, XCAR (XCDR (arity)));
+  return Fcons (min, max);
 }
 
 DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -815,10 +831,10 @@ DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
 SUBR must be a built-in function.  */)
   (Lisp_Object subr)
 {
-  const char *name;
   CHECK_SUBR (subr);
-  name = XSUBR (subr)->symbol_name;
-  return build_string (name);
+  if (CONSP (subr) && EQ (XCAR (subr), Qspecial_operator))
+    subr = XCDR (subr);
+  return Fsymbol_name (SCM_SUBR_NAME (subr));
 }
 
 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
@@ -844,13 +860,11 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
 	fun = Fsymbol_function (fun);
     }
 
-  if (SUBRP (fun))
+  if (scm_is_true (scm_procedure_p (fun)))
     {
-      const char *spec = XSUBR (fun)->intspec;
-      if (spec)
-	return list2 (Qinteractive,
-		      (*spec != '(') ? build_string (spec) :
-		      Fcar (Fread_from_string (build_string (spec), Qnil, Qnil)));
+      Lisp_Object tem = scm_procedure_property (fun, Qinteractive_form);
+      if (scm_is_true (tem))
+        return list2 (Qinteractive, tem);
     }
   else if (COMPILEDP (fun))
     {
@@ -3387,6 +3401,10 @@ syms_of_data (void)
 {
   Lisp_Object error_tail, arith_tail;
 
+  /* Used by defsubr.  */
+  DEFSYM (Qspecial_operator, "special-operator");
+  DEFSYM (Qinteractive_form, "interactive-form");
+
 #include "data.x"
 
   DEFSYM (Qquote, "quote");
@@ -3553,7 +3571,6 @@ syms_of_data (void)
   DEFSYM (Qfont_entity, "font-entity");
   DEFSYM (Qfont_object, "font-object");
 
-  DEFSYM (Qinteractive_form, "interactive-form");
   DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
 
   set_symbol_function (Qwholenump, SYMBOL_FUNCTION (Qnatnump));
diff --git a/src/doc.c b/src/doc.c
index 4d9434ce9f..a0d01c2b73 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -350,18 +350,17 @@ string is passed through `substitute-command-keys'.  */)
     }
 
   fun = Findirect_function (function, Qnil);
-  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+  if (CONSP (fun)
+      && (EQ (XCAR (fun), Qmacro)
+          || EQ (XCAR (fun), Qspecial_operator)))
     fun = XCDR (fun);
-  if (SUBRP (fun))
+  if (scm_is_true (scm_procedure_p (fun)))
     {
-      if (XSUBR (fun)->doc == 0)
-	return Qnil;
-      /* FIXME: This is not portable, as it assumes that string
-	 pointers have the top bit clear.  */
-      else if ((intptr_t) XSUBR (fun)->doc >= 0)
-	doc = build_string (XSUBR (fun)->doc);
+      Lisp_Object tem = scm_procedure_property (fun, intern ("emacs-documentation"));
+      if (scm_is_true (tem))
+        doc = tem;
       else
-	doc = make_number ((intptr_t) XSUBR (fun)->doc);
+        return Qnil;
     }
   else if (COMPILEDP (fun))
     {
@@ -501,11 +500,12 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
 
   /* The type determines where the docstring is stored.  */
 
-  /* Lisp_Subrs have a slot for it.  */
-  if (SUBRP (fun))
+
+  if (scm_is_true (scm_procedure_p (fun)))
     {
-      intptr_t negative_offset = - offset;
-      XSUBR (fun)->doc = (char *) negative_offset;
+      scm_set_procedure_property_x (fun,
+                                    intern ("emacs-documentation"),
+                                    make_number (offset));
     }
 
   /* If it's a lisp form, stick it in the form.  */
@@ -523,7 +523,7 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
 	       correctness is quite delicate.  */
 	    XSETCAR (tem, make_number (offset));
 	}
-      else if (EQ (tem, Qmacro))
+      else if (EQ (tem, Qmacro) || EQ (tem, Qspecial_operator))
 	store_function_docstring (XCDR (fun), offset);
     }
 
diff --git a/src/emacs.c b/src/emacs.c
index d4611f85ea..01b8368298 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1198,6 +1198,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       init_minibuf_once ();	/* Create list of minibuffers.  */
 				/* Must precede init_window_once.  */
 
+      /* Called before syms_of_fileio, because it sets up
+         Qerror_condition.  Called before other symbol-initialization
+         functions because it sets up symbols used by defsubr.  */
+      syms_of_data ();
+
       /* Call syms_of_xfaces before init_window_once because that
 	 function creates Vterminal_frame.  Termcap frames now use
 	 faces, and the face implementation uses some symbols as
@@ -1212,8 +1217,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
 	 CANNOT_DUMP is defined.  */
       syms_of_keyboard ();
 
-      /* Called before syms_of_fileio, because it sets up Qerror_condition.  */
-      syms_of_data ();
       syms_of_fns ();	   /* Before syms_of_charset which uses hashtables.  */
       syms_of_fileio ();
       /* Before syms_of_coding to initialize Vgc_cons_threshold.  */
diff --git a/src/eval.c b/src/eval.c
index e6b39a5064..d1397e0ab2 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1872,11 +1872,9 @@ then strings and vectors are not accepted.  */)
       fun = Fsymbol_function (fun);
     }
 
-  /* Emacs primitives are interactive if their DEFUN specifies an
-     interactive spec.  */
-  if (SUBRP (fun))
-    return XSUBR (fun)->intspec ? Qt : if_prop;
-
+  if (scm_is_true (scm_procedure_p (fun)))
+    return (scm_is_true (scm_procedure_property (fun, Qinteractive_form))
+            ? Qt : if_prop);
   /* Bytecode objects are interactive if they are long enough to
      have an element whose index is COMPILED_INTERACTIVE, which is
      where the interactive spec is stored.  */
@@ -2180,119 +2178,13 @@ eval_sub_1 (Lisp_Object form)
           args[argnum++] = eval_sub (Fcar (args_left));
           args_left = Fcdr (args_left);
         }
+      set_backtrace_args (specpdl_ptr - 1, args);
+      set_backtrace_nargs (specpdl_ptr - 1, argnum);
       val = scm_call_n (fun, args, argnum);
     }
-  else if (SUBRP (fun))
+  else if (CONSP (fun) && EQ (XCAR (fun), Qspecial_operator))
     {
-      Lisp_Object numargs;
-      Lisp_Object argvals[8];
-      Lisp_Object args_left;
-      register int i, maxargs;
-
-      args_left = original_args;
-      numargs = Flength (args_left);
-
-      if (XINT (numargs) < XSUBR (fun)->min_args
-	  || (XSUBR (fun)->max_args >= 0
-	      && XSUBR (fun)->max_args < XINT (numargs)))
-	xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
-
-      else if (XSUBR (fun)->max_args == UNEVALLED)
-	val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
-      else if (XSUBR (fun)->max_args == MANY)
-	{
-	  /* Pass a vector of evaluated arguments.  */
-	  Lisp_Object *vals;
-	  ptrdiff_t argnum = 0;
-	  USE_SAFE_ALLOCA;
-
-	  SAFE_ALLOCA_LISP (vals, XINT (numargs));
-
-	  GCPRO3 (args_left, fun, fun);
-	  gcpro3.var = vals;
-	  gcpro3.nvars = 0;
-
-	  while (!NILP (args_left))
-	    {
-	      vals[argnum++] = eval_sub (Fcar (args_left));
-	      args_left = Fcdr (args_left);
-	      gcpro3.nvars = argnum;
-	    }
-
-	  set_backtrace_args (specpdl_ptr - 1, vals);
-	  set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
-
-	  val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
-	  UNGCPRO;
-	  SAFE_FREE ();
-	}
-      else
-	{
-	  GCPRO3 (args_left, fun, fun);
-	  gcpro3.var = argvals;
-	  gcpro3.nvars = 0;
-
-	  maxargs = XSUBR (fun)->max_args;
-	  for (i = 0; i < maxargs; args_left = Fcdr (args_left))
-	    {
-	      argvals[i] = eval_sub (Fcar (args_left));
-	      gcpro3.nvars = ++i;
-	    }
-
-	  UNGCPRO;
-
-	  set_backtrace_args (specpdl_ptr - 1, argvals);
-	  set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
-
-	  switch (i)
-	    {
-	    case 0:
-	      val = (XSUBR (fun)->function.a0 ());
-	      break;
-	    case 1:
-	      val = (XSUBR (fun)->function.a1 (argvals[0]));
-	      break;
-	    case 2:
-	      val = (XSUBR (fun)->function.a2 (argvals[0], argvals[1]));
-	      break;
-	    case 3:
-	      val = (XSUBR (fun)->function.a3
-		     (argvals[0], argvals[1], argvals[2]));
-	      break;
-	    case 4:
-	      val = (XSUBR (fun)->function.a4
-		     (argvals[0], argvals[1], argvals[2], argvals[3]));
-	      break;
-	    case 5:
-	      val = (XSUBR (fun)->function.a5
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4]));
-	      break;
-	    case 6:
-	      val = (XSUBR (fun)->function.a6
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4], argvals[5]));
-	      break;
-	    case 7:
-	      val = (XSUBR (fun)->function.a7
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4], argvals[5], argvals[6]));
-	      break;
-
-	    case 8:
-	      val = (XSUBR (fun)->function.a8
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4], argvals[5], argvals[6], argvals[7]));
-	      break;
-
-	    default:
-	      /* Someone has created a subr that takes more arguments than
-		 is supported by this code.  We need to either rewrite the
-		 subr to use a different argument protocol, or add more
-		 cases to this switch.  */
-	      emacs_abort ();
-	    }
-	}
+      val = scm_apply_0 (XCDR (fun), original_args);
     }
   else if (COMPILEDP (fun))
     val = apply_lambda (fun, original_args);
@@ -2413,26 +2305,8 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
     {
       /* Let funcall get the error.  */
       fun = args[0];
-      goto funcall;
     }
 
-  if (SUBRP (fun))
-    {
-      if (numargs < XSUBR (fun)->min_args
-	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
-	goto funcall;		/* Let funcall get the error.  */
-      else if (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args > numargs)
-	{
-	  /* Avoid making funcall cons up a yet another new vector of arguments
-	     by explicitly supplying nil's for optional values.  */
-	  SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
-	  for (i = numargs; i < XSUBR (fun)->max_args;)
-	    funcall_args[++i] = Qnil;
-	  GCPRO1 (*funcall_args);
-	  gcpro1.nvars = 1 + XSUBR (fun)->max_args;
-	}
-    }
- funcall:
   /* We add 1 to numargs because funcall_args includes the
      function itself as well as its arguments.  */
   if (!funcall_args)
@@ -2889,86 +2763,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
     {
       val = scm_call_n (fun, args + 1, numargs);
     }
-  else if (SUBRP (fun))
-    {
-      if (numargs < XSUBR (fun)->min_args
-	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
-	{
-	  XSETFASTINT (lisp_numargs, numargs);
-	  xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
-	}
-
-      else if (XSUBR (fun)->max_args == UNEVALLED)
-	xsignal1 (Qinvalid_function, original_fun);
-
-      else if (XSUBR (fun)->max_args == MANY)
-	val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
-      else
-	{
-	  if (XSUBR (fun)->max_args > numargs)
-	    {
-	      internal_args = alloca (XSUBR (fun)->max_args
-				      * sizeof *internal_args);
-	      memcpy (internal_args, args + 1, numargs * word_size);
-	      for (i = numargs; i < XSUBR (fun)->max_args; i++)
-		internal_args[i] = Qnil;
-	    }
-	  else
-	    internal_args = args + 1;
-	  switch (XSUBR (fun)->max_args)
-	    {
-	    case 0:
-	      val = (XSUBR (fun)->function.a0 ());
-	      break;
-	    case 1:
-	      val = (XSUBR (fun)->function.a1 (internal_args[0]));
-	      break;
-	    case 2:
-	      val = (XSUBR (fun)->function.a2
-		     (internal_args[0], internal_args[1]));
-	      break;
-	    case 3:
-	      val = (XSUBR (fun)->function.a3
-		     (internal_args[0], internal_args[1], internal_args[2]));
-	      break;
-	    case 4:
-	      val = (XSUBR (fun)->function.a4
-		     (internal_args[0], internal_args[1], internal_args[2],
-		     internal_args[3]));
-	      break;
-	    case 5:
-	      val = (XSUBR (fun)->function.a5
-		     (internal_args[0], internal_args[1], internal_args[2],
-		      internal_args[3], internal_args[4]));
-	      break;
-	    case 6:
-	      val = (XSUBR (fun)->function.a6
-		     (internal_args[0], internal_args[1], internal_args[2],
-		      internal_args[3], internal_args[4], internal_args[5]));
-	      break;
-	    case 7:
-	      val = (XSUBR (fun)->function.a7
-		     (internal_args[0], internal_args[1], internal_args[2],
-		      internal_args[3], internal_args[4], internal_args[5],
-		      internal_args[6]));
-	      break;
-
-	    case 8:
-	      val = (XSUBR (fun)->function.a8
-		     (internal_args[0], internal_args[1], internal_args[2],
-		      internal_args[3], internal_args[4], internal_args[5],
-		      internal_args[6], internal_args[7]));
-	      break;
-
-	    default:
-
-	      /* If a subr takes more than 8 arguments without using MANY
-		 or UNEVALLED, we need to extend this function to support it.
-		 Until this is done, there is no way to call the function.  */
-	      emacs_abort ();
-	    }
-	}
-    }
   else if (COMPILEDP (fun))
     val = funcall_lambda (fun, numargs, args + 1);
   else
diff --git a/src/lisp.h b/src/lisp.h
index 0143506736..e0a4cdfee1 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -440,7 +440,6 @@ enum pvec_type
   PVEC_HASH_TABLE,
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
-  PVEC_SUBR,
   PVEC_OTHER,
   /* These should be last, check internal_equal to see why.  */
   PVEC_COMPILED,
@@ -566,7 +565,6 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
 					      Lisp_Object);
 INLINE bool STRINGP (Lisp_Object);
 INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
-INLINE bool SUBRP (Lisp_Object);
 INLINE bool (SYMBOLP) (Lisp_Object);
 INLINE bool (VECTORLIKEP) (Lisp_Object);
 INLINE bool WINDOWP (Lisp_Object);
@@ -685,13 +683,6 @@ XTERMINAL (Lisp_Object a)
   return SMOB_PTR (a);
 }
 
-INLINE struct Lisp_Subr *
-XSUBR (Lisp_Object a)
-{
-  eassert (SUBRP (a));
-  return SMOB_PTR (a);
-}
-
 INLINE struct buffer *
 XBUFFER (Lisp_Object a)
 {
@@ -1240,32 +1231,6 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
     char_table_set (ct, idx, val);
 }
 
-/* This structure describes a built-in function.
-   It is generated by the DEFUN macro only.
-   defsubr makes it into a Lisp object.  */
-
-struct Lisp_Subr
-  {
-    struct vectorlike_header header;
-    union {
-      Lisp_Object (*a0) (void);
-      Lisp_Object (*a1) (Lisp_Object);
-      Lisp_Object (*a2) (Lisp_Object, Lisp_Object);
-      Lisp_Object (*a3) (Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a4) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a5) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a6) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*aUNEVALLED) (Lisp_Object args);
-      Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
-    } function;
-    short min_args, max_args;
-    const char *symbol_name;
-    const char *intspec;
-    const char *doc;
-  };
-
 /* This is the number of slots that every char table must have.  This
    counts the ordinary slots and the top, defalt, parent, and purpose
    slots.  */
@@ -2135,12 +2100,6 @@ TERMINALP (Lisp_Object a)
 }
 
 INLINE bool
-SUBRP (Lisp_Object a)
-{
-  return PSEUDOVECTORP (a, PVEC_SUBR);
-}
-
-INLINE bool
 COMPILEDP (Lisp_Object a)
 {
   return PSEUDOVECTORP (a, PVEC_COMPILED);
@@ -2350,28 +2309,71 @@ CHECK_NUMBER_CDR (Lisp_Object x)
 
 /* This version of DEFUN declares a function prototype with the right
    arguments, so we can catch errors with maxargs at compile-time.  */
-#ifdef _MSC_VER
-#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)	\
-   SCM_SNARF_INIT (defsubr (&sname);)                                   \
-   Lisp_Object fnname DEFUN_ARGS_ ## maxargs ;				\
-   static struct Lisp_Subr alignas (GCALIGNMENT) sname =		\
-   { { NULL,                                                            \
-       (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS)                            \
-       | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) },		\
-     { (Lisp_Object (__cdecl *)(void))fnname },                         \
-     minargs, maxargs, lname, intspec, 0};				\
-   Lisp_Object fnname
-#else  /* not _MSC_VER */
 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)	\
-   SCM_SNARF_INIT (defsubr (&sname);)                                   \
+  SCM_SNARF_INIT (defsubr (lname, gsubr_ ## fnname, minargs, maxargs, intspec)) \
    Lisp_Object fnname DEFUN_ARGS_ ## maxargs ;				\
-   static struct Lisp_Subr alignas (GCALIGNMENT) sname =		\
-   { { .self = NULL,                                                    \
-       .size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },                   \
-     { .a ## maxargs = fnname },                                        \
-     minargs, maxargs, lname, intspec, 0};				\
+   DEFUN_GSUBR_ ## maxargs (lname, fnname, minargs, maxargs)            \
    Lisp_Object fnname
-#endif
+
+#define GSUBR_ARGS_1(f) f (arg1)
+#define GSUBR_ARGS_2(f) GSUBR_ARGS_1 (f), f (arg2)
+#define GSUBR_ARGS_3(f) GSUBR_ARGS_2 (f), f (arg3)
+#define GSUBR_ARGS_4(f) GSUBR_ARGS_3 (f), f (arg4)
+#define GSUBR_ARGS_5(f) GSUBR_ARGS_4 (f), f (arg5)
+#define GSUBR_ARGS_6(f) GSUBR_ARGS_5 (f), f (arg6)
+#define GSUBR_ARGS_7(f) GSUBR_ARGS_6 (f), f (arg7)
+#define GSUBR_ARGS_8(f) GSUBR_ARGS_7 (f), f (arg8)
+
+#define GSUBR_ARGS(n) GSUBR_ARGS_PASTE (GSUBR_ARGS_, n)
+#define GSUBR_ARGS_PASTE(a, b) a ## b
+
+#define DEFUN_GSUBR_N(fn, maxargs)                              \
+  Lisp_Object                                                   \
+  gsubr_ ## fn                                                  \
+  (GSUBR_ARGS (maxargs) (Lisp_Object))                          \
+  {                                                             \
+    return fn (GSUBR_ARGS (maxargs) (GSUBR_ARG));               \
+  }
+#define GSUBR_ARG(x) (SCM_UNBNDP (x) ? Qnil : x)
+
+#define DEFUN_GSUBR_0(lname, fn, minargs, maxargs)       \
+  Lisp_Object gsubr_ ## fn (void) { return fn (); }
+#define DEFUN_GSUBR_1(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_2(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_3(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_4(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_5(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_6(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_7(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_8(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+
+#define DEFUN_GSUBR_UNEVALLED(lname, fn, minargs, maxargs)  \
+  Lisp_Object                                               \
+  gsubr_ ## fn (Lisp_Object rest)                           \
+  {                                                         \
+    Lisp_Object len = Flength (rest);                       \
+    if (XINT (len) < minargs)                               \
+      xsignal2 (Qwrong_number_of_arguments,                 \
+                intern (lname), len);                       \
+    return fn (rest);                                       \
+  }
+#define DEFUN_GSUBR_MANY(lname, fn, minargs, maxargs)        \
+  Lisp_Object                                               \
+  gsubr_ ## fn (Lisp_Object rest)                           \
+  {                                                         \
+    int len = scm_to_int (scm_length (rest));               \
+    Lisp_Object *args;                                      \
+    SAFE_ALLOCA_LISP (args, len);                           \
+    int i;                                                  \
+    for (i = 0;                                             \
+         i < len && scm_is_pair (rest);                     \
+         i++, rest = SCM_CDR (rest))                        \
+      args[i] = SCM_CAR (rest);                             \
+    if (i < minargs)                                        \
+      xsignal2 (Qwrong_number_of_arguments,                 \
+                intern (lname), make_number (i));           \
+    return fn (i, args);                                    \
+  }
 
 /* Note that the weird token-substitution semantics of ANSI C makes
    this work for MANY and UNEVALLED.  */
@@ -2400,7 +2402,7 @@ FUNCTIONP (Lisp_Object obj)
 
 /* defsubr (Sname);
    is how we define the symbol for function `name' at start-up time.  */
-extern void defsubr (struct Lisp_Subr *);
+extern void defsubr (const char *, scm_t_subr, short, short, const char *);
 
 enum maxargs
   {
@@ -2850,6 +2852,7 @@ extern Lisp_Object Qcircular_list;
 extern Lisp_Object Qsequencep;
 extern Lisp_Object Qchar_or_string_p, Qinteger_or_marker_p;
 extern Lisp_Object Qfboundp;
+extern Lisp_Object Qspecial_operator;
 
 extern Lisp_Object Qcdr;
 
@@ -3996,8 +3999,8 @@ functionp (Lisp_Object object)
 	}
     }
 
-  if (SUBRP (object))
-    return XSUBR (object)->max_args != UNEVALLED;
+  if (scm_is_true (scm_procedure_p (object)))
+    return 1;
   else if (COMPILEDP (object))
     return true;
   else if (CONSP (object))
@@ -4005,8 +4008,6 @@ functionp (Lisp_Object object)
       Lisp_Object car = XCAR (object);
       return EQ (car, Qlambda) || EQ (car, Qclosure);
     }
-  else
-    return scm_is_true (scm_procedure_p (object));
 }
 
 INLINE_HEADER_END
diff --git a/src/lread.c b/src/lread.c
index d883cda62f..a57cab6f79 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4035,14 +4035,32 @@ init_obarray (void)
 }
 
 void
-defsubr (struct Lisp_Subr *sname)
+defsubr (const char *lname, scm_t_subr gsubr_fn, short min_args, short max_args, const char *intspec)
 {
-  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);
+  Lisp_Object sym = intern_c_string (lname);
+  Lisp_Object fn;
+  switch (max_args)
+    {
+    case MANY:
+      fn = scm_c_make_gsubr (lname, 0, 0, 1, gsubr_fn);
+      break;
+    case UNEVALLED:
+      fn = Fcons (Qspecial_operator,
+                  scm_c_make_gsubr (lname, 0, 0, 1, gsubr_fn));
+      break;
+    default:
+      fn = scm_c_make_gsubr (lname, min_args, max_args - min_args, 0, gsubr_fn);
+      break;
+    }
+  set_symbol_function (sym, fn);
+  if (intspec)
+    {
+      Lisp_Object tem = ((*intspec != '(')
+                         ? build_string (intspec)
+                         : Fcar (Fread_from_string (build_string (intspec),
+                                                    Qnil, Qnil)));
+      scm_set_procedure_property_x (fn, Qinteractive_form, tem);
+    }
 }
 
 /* Define an "integer variable"; a symbol whose value is forwarded to a
diff --git a/src/print.c b/src/print.c
index 672a780792..05a5dd70ae 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1768,12 +1768,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 
 	  UNGCPRO;
 	}
-      else if (SUBRP (obj))
-	{
-	  strout ("#<subr ", -1, -1, printcharfun);
-	  strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
-	  PRINTCHAR ('>');
-	}
       else if (WINDOWP (obj))
 	{
 	  int len;
@@ -2206,7 +2200,7 @@ void
 init_print_once (void)
 {
   DEFSYM (Qexternal_debugging_output, "external-debugging-output");
-  defsubr (&Sexternal_debugging_output);
+  defsubr ("external-debugging-output", gsubr_Fexternal_debugging_output, 1, 1, 0);
 }
 
 void
diff --git a/src/xmenu.c b/src/xmenu.c
index aa208f871a..0de8faaf36 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -2346,6 +2346,6 @@ syms_of_xmenu (void)
 
 #if defined (USE_GTK) || defined (USE_X_TOOLKIT)
   Ffset (intern_c_string ("accelerate-menu"),
-	 intern_c_string (Sx_menu_bar_open_internal.symbol_name));
+         intern_c_string ("x-menu-bar-open-internal"));
 #endif
 }