5 files changed, 149 insertions, 94 deletions

diff --git a/src/callint.c b/src/callint.c
index b31faba8704..9d6f2ab2888 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -319,10 +319,10 @@ invoke it (via an `interactive' spec that contains, for instance, an
     {
       Lisp_Object funval = Findirect_function (function, Qt);
       uintmax_t events = num_input_events;
+      Lisp_Object env = CLOSUREP (funval) && CONSP (AREF (funval, CLOSURE_CODE))
+                        ? AREF (funval, CLOSURE_CONSTANTS) : Qnil;
       /* Compute the arg values using the user's expression.  */
-      specs = Feval (specs,
-                     CONSP (funval) && EQ (Qclosure, XCAR (funval))
-                     ? CAR_SAFE (XCDR (funval)) : Qnil);
+      specs = Feval (specs, env);
       if (events != num_input_events || !NILP (record_flag))
         {
           /* We should record this command on the command history.
diff --git a/src/data.c b/src/data.c
index 681054ff8cb..ea611ad1abf 100644
--- a/src/data.c
+++ b/src/data.c
@@ -248,7 +248,9 @@ a fixed set of types.  */)
           return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form
                  : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp
                  : Qprimitive_function;
-        case PVEC_CLOSURE: return Qcompiled_function;
+        case PVEC_CLOSURE:
+          return CONSP (AREF (object, CLOSURE_CODE))
+                 ? Qinterpreted_function : Qbyte_code_function;
         case PVEC_BUFFER: return Qbuffer;
         case PVEC_CHAR_TABLE: return Qchar_table;
         case PVEC_BOOL_VECTOR: return Qbool_vector;
@@ -518,12 +520,32 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
   return Qnil;
 }
 
+DEFUN ("closurep", Fclosurep, Sclosurep,
+       1, 1, 0,
+       doc: /* Return t if OBJECT is a function of type `closure'.  */)
+  (Lisp_Object object)
+{
+  if (CLOSUREP (object))
+    return Qt;
+  return Qnil;
+}
+
 DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
        1, 1, 0,
        doc: /* Return t if OBJECT is a byte-compiled function object.  */)
   (Lisp_Object object)
 {
-  if (CLOSUREP (object))
+  if (CLOSUREP (object) && STRINGP (AREF (object, CLOSURE_CODE)))
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("interpreted-function-p", Finterpreted_function_p,
+       Sinterpreted_function_p, 1, 1, 0,
+       doc: /* Return t if OBJECT is a function of type `interpreted-function'.  */)
+  (Lisp_Object object)
+{
+  if (CLOSUREP (object) && CONSP (AREF (object, CLOSURE_CODE)))
     return Qt;
   return Qnil;
 }
@@ -1174,17 +1196,11 @@ Value, if non-nil, is a list (interactive SPEC).  */)
   else if (CONSP (fun))
     {
       Lisp_Object funcar = XCAR (fun);
-      if (EQ (funcar, Qclosure)
-          || EQ (funcar, Qlambda))
+      if (EQ (funcar, Qlambda))
         {
           Lisp_Object form = Fcdr (XCDR (fun));
-          if (EQ (funcar, Qclosure))
-            form = Fcdr (form);
           Lisp_Object spec = Fassq (Qinteractive, form);
-          if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form)))
-            /* A "docstring" is a sign that we may have an OClosure.  */
-            genfun = true;
-          else if (NILP (Fcdr (Fcdr (spec))))
+          if (NILP (Fcdr (Fcdr (spec))))
             return spec;
           else
             return list2 (Qinteractive, Fcar (Fcdr (spec)));
@@ -1257,12 +1273,9 @@ The value, if non-nil, is a list of mode name symbols.  */)
   else if (CONSP (fun))
     {
       Lisp_Object funcar = XCAR (fun);
-      if (EQ (funcar, Qclosure)
-          || EQ (funcar, Qlambda))
+      if (EQ (funcar, Qlambda))
         {
           Lisp_Object form = Fcdr (XCDR (fun));
-          if (EQ (funcar, Qclosure))
-            form = Fcdr (form);
           return Fcdr (Fcdr (Fassq (Qinteractive, form)));
         }
     }
@@ -4224,7 +4237,8 @@ syms_of_data (void)
   DEFSYM (Qspecial_form, "special-form");
   DEFSYM (Qprimitive_function, "primitive-function");
   DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
-  DEFSYM (Qcompiled_function, "compiled-function");
+  DEFSYM (Qbyte_code_function, "byte-code-function");
+  DEFSYM (Qinterpreted_function, "interpreted-function");
   DEFSYM (Qbuffer, "buffer");
   DEFSYM (Qframe, "frame");
   DEFSYM (Qvector, "vector");
@@ -4289,6 +4303,8 @@ syms_of_data (void)
   defsubr (&Smarkerp);
   defsubr (&Ssubrp);
   defsubr (&Sbyte_code_function_p);
+  defsubr (&Sinterpreted_function_p);
+  defsubr (&Sclosurep);
   defsubr (&Smodule_function_p);
   defsubr (&Schar_or_string_p);
   defsubr (&Sthreadp);
diff --git a/src/eval.c b/src/eval.c
index a7d860114cf..fd388706108 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -510,6 +510,33 @@ usage: (quote ARG)  */)
   return XCAR (args);
 }
 
+DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
+       Smake_interpreted_closure, 3, 5, 0,
+       doc: /* Make an interpreted closure.
+ARGS should be the list of formal arguments.
+BODY should be a non-empty list of forms.
+ENV should be a lexical environment, like the second argument of `eval'.
+IFORM if non-nil should be of the form (interactive ...).  */)
+  (Lisp_Object args, Lisp_Object body, Lisp_Object env,
+   Lisp_Object docstring, Lisp_Object iform)
+{
+  CHECK_CONS (body);          /* Make sure it's not confused with byte-code! */
+  CHECK_LIST (args);
+  CHECK_LIST (iform);
+  Lisp_Object ifcdr = Fcdr (iform);
+  Lisp_Object slots[] = { args,  body, env, Qnil, docstring,
+                          NILP (Fcdr (ifcdr))
+                          ? Fcar (ifcdr)
+                          : CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr)) };
+  /* Adjusting the size is indispensable since, as for byte-code objects,
+     we distinguish interactive functions by the presence or absence of the
+     iform slot.  */
+  Lisp_Object val
+    = Fvector (!NILP (iform) ? 6 : !NILP (docstring) ? 5 : 3, slots);
+  XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
+  return val;
+}
+
 DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
        doc: /* Like `quote', but preferred for objects which are functions.
 In byte compilation, `function' causes its argument to be handled by
@@ -525,33 +552,55 @@ usage: (function ARG)  */)
   if (!NILP (XCDR (args)))
     xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
 
-  if (!NILP (Vinternal_interpreter_environment)
-      && CONSP (quoted)
+  if (CONSP (quoted)
       && EQ (XCAR (quoted), Qlambda))
     { /* This is a lambda expression within a lexical environment;
          return an interpreted closure instead of a simple lambda.  */
       Lisp_Object cdr = XCDR (quoted);
-      Lisp_Object tmp = cdr;
-      if (CONSP (tmp)
-          && (tmp = XCDR (tmp), CONSP (tmp))
-          && (tmp = XCAR (tmp), CONSP (tmp))
-          && (EQ (QCdocumentation, XCAR (tmp))))
-        { /* Handle the special (:documentation <form>) to build the docstring
+      Lisp_Object args = Fcar (cdr);
+      cdr = Fcdr (cdr);
+      Lisp_Object docstring = Qnil, iform = Qnil;
+      if (CONSP (cdr))
+        {
+          docstring = XCAR (cdr);
+          if (STRINGP (docstring))
+            {
+              Lisp_Object tmp = XCDR (cdr);
+              if (!NILP (tmp))
+                cdr = tmp;
+              else     /* It's not a docstring, it's a return value.  */
+                docstring = Qnil;
+            }
+          /* Handle the special (:documentation <form>) to build the docstring
              dynamically.  */
-          Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp)));
-          if (SYMBOLP (docstring) && !NILP (docstring))
-            /* Hack for OClosures: Allow the docstring to be a symbol
-             * (the OClosure's type).  */
-            docstring = Fsymbol_name (docstring);
-          CHECK_STRING (docstring);
-          cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
-        }
-      if (NILP (Vinternal_make_interpreted_closure_function))
-        return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr));
+          else if (CONSP (docstring)
+                   && EQ (QCdocumentation, XCAR (docstring))
+                   && (docstring = eval_sub (Fcar (XCDR (docstring))),
+                       true))
+            cdr = XCDR (cdr);
+          else
+            docstring = Qnil;   /* Not a docstring after all.  */
+        }
+      if (CONSP (cdr))
+        {
+          iform = XCAR (cdr);
+          if (CONSP (iform)
+              && EQ (Qinteractive, XCAR (iform)))
+            cdr = XCDR (cdr);
+          else
+            iform = Qnil;   /* Not an interactive-form after all.  */
+        }
+      if (NILP (cdr))
+        cdr = Fcons (Qnil, Qnil); /* Make sure the body is never empty! */
+
+      if (NILP (Vinternal_interpreter_environment)
+          || NILP (Vinternal_make_interpreted_closure_function))
+        return Fmake_interpreted_closure
+            (args, cdr, Vinternal_interpreter_environment, docstring, iform);
       else
-        return call2 (Vinternal_make_interpreted_closure_function,
-                      Fcons (Qlambda, cdr),
-                      Vinternal_interpreter_environment);
+        return call5 (Vinternal_make_interpreted_closure_function,
+                      args, cdr, Vinternal_interpreter_environment,
+                      docstring, iform);
     }
   else
     /* Simply quote the argument.  */
@@ -2193,15 +2242,12 @@ then strings and vectors are not accepted.  */)
       else
         {
           Lisp_Object body = CDR_SAFE (XCDR (fun));
-          if (EQ (funcar, Qclosure))
-            body = CDR_SAFE (body);
-          else if (!EQ (funcar, Qlambda))
+          if (!EQ (funcar, Qlambda))
             return Qnil;
           if (!NILP (Fassq (Qinteractive, body)))
             return Qt;
-          else if (VALID_DOCSTRING_P (CAR_SAFE (body)))
-            /* A "docstring" is a sign that we may have an OClosure.  */
-            genfun = true;
+          else
+            return Qnil;
         }
     }
 
@@ -2611,8 +2657,7 @@ eval_sub (Lisp_Object form)
           exp = unbind_to (count1, exp);
           val = eval_sub (exp);
         }
-      else if (EQ (funcar, Qlambda)
-               || EQ (funcar, Qclosure))
+      else if (EQ (funcar, Qlambda))
         return apply_lambda (fun, original_args, count);
       else
         xsignal1 (Qinvalid_function, original_fun);
@@ -2950,7 +2995,7 @@ FUNCTIONP (Lisp_Object object)
   else if (CONSP (object))
     {
       Lisp_Object car = XCAR (object);
-      return EQ (car, Qlambda) || EQ (car, Qclosure);
+      return EQ (car, Qlambda);
     }
   else
     return false;
@@ -2980,8 +3025,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args)
       Lisp_Object funcar = XCAR (fun);
       if (!SYMBOLP (funcar))
         xsignal1 (Qinvalid_function, original_fun);
-      if (EQ (funcar, Qlambda)
-          || EQ (funcar, Qclosure))
+      if (EQ (funcar, Qlambda))
         return funcall_lambda (fun, numargs, args);
       else if (EQ (funcar, Qautoload))
         {
@@ -3165,16 +3209,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
 
   if (CONSP (fun))
     {
-      if (EQ (XCAR (fun), Qclosure))
-        {
-          Lisp_Object cdr = XCDR (fun); /* Drop `closure'.  */
-          if (! CONSP (cdr))
-            xsignal1 (Qinvalid_function, fun);
-          fun = cdr;
-          lexenv = XCAR (fun);
-        }
-      else
-        lexenv = Qnil;
+      lexenv = Qnil;
       syms_left = XCDR (fun);
       if (CONSP (syms_left))
         syms_left = XCAR (syms_left);
@@ -3189,10 +3224,12 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
          engine directly.  */
       if (FIXNUMP (syms_left))
         return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector);
-      /* Otherwise the bytecode object uses dynamic binding and the
-         ARGLIST slot contains a standard formal argument list whose
-         variables are bound dynamically below.  */
-      lexenv = Qnil;
+      /* Otherwise the closure either is interpreted
+         or uses dynamic binding and the ARGLIST slot contains a standard
+         formal argument list whose variables are bound dynamically below.  */
+      lexenv = CONSP (AREF (fun, CLOSURE_CODE))
+               ? AREF (fun, CLOSURE_CONSTANTS)
+               : Qnil;
     }
 #ifdef HAVE_MODULES
   else if (MODULE_FUNCTIONP (fun))
@@ -3280,7 +3317,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
       val = XSUBR (fun)->function.a0 ();
     }
   else
-    val = exec_byte_code (fun, 0, 0, NULL);
+    {
+      eassert (CLOSUREP (fun));
+      val = CONSP (AREF (fun, CLOSURE_CODE))
+            /* Interpreted function.  */
+            ? Fprogn (AREF (fun, CLOSURE_CODE))
+            /* Dynbound bytecode.  */
+            : exec_byte_code (fun, 0, 0, NULL);
+    }
 
   return unbind_to (count, val);
 }
@@ -3330,8 +3374,7 @@ function with `&rest' args, or `unevalled' for a special form.  */)
       funcar = XCAR (function);
       if (!SYMBOLP (funcar))
         xsignal1 (Qinvalid_function, original);
-      if (EQ (funcar, Qlambda)
-          || EQ (funcar, Qclosure))
+      if (EQ (funcar, Qlambda))
         result = lambda_arity (function);
       else if (EQ (funcar, Qautoload))
         {
@@ -3352,11 +3395,6 @@ lambda_arity (Lisp_Object fun)
 
   if (CONSP (fun))
     {
-      if (EQ (XCAR (fun), Qclosure))
-        {
-          fun = XCDR (fun);     /* Drop `closure'.  */
-          CHECK_CONS (fun);
-        }
       syms_left = XCDR (fun);
       if (CONSP (syms_left))
         syms_left = XCAR (syms_left);
@@ -4265,7 +4303,6 @@ before making `inhibit-quit' nil.  */);
   DEFSYM (Qcommandp, "commandp");
   DEFSYM (Qand_rest, "&rest");
   DEFSYM (Qand_optional, "&optional");
-  DEFSYM (Qclosure, "closure");
   DEFSYM (QCdocumentation, ":documentation");
   DEFSYM (Qdebug, "debug");
   DEFSYM (Qdebug_early, "debug-early");
@@ -4423,6 +4460,7 @@ alist of active lexical bindings.  */);
   defsubr (&Ssetq);
   defsubr (&Squote);
   defsubr (&Sfunction);
+  defsubr (&Smake_interpreted_closure);
   defsubr (&Sdefault_toplevel_value);
   defsubr (&Sset_default_toplevel_value);
   defsubr (&Sdefvar);
diff --git a/src/lread.c b/src/lread.c
index 8b614e6220e..983fdb883ff 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3523,25 +3523,32 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
         }
     }
 
-  if (!(size >= CLOSURE_STACK_DEPTH + 1 && size <= CLOSURE_INTERACTIVE + 1
+  if (!(size >= CLOSURE_STACK_DEPTH && size <= CLOSURE_INTERACTIVE + 1
         && (FIXNUMP (vec[CLOSURE_ARGLIST])
             || CONSP (vec[CLOSURE_ARGLIST])
             || NILP (vec[CLOSURE_ARGLIST]))
-        && STRINGP (vec[CLOSURE_CODE])
-        && VECTORP (vec[CLOSURE_CONSTANTS])
-        && FIXNATP (vec[CLOSURE_STACK_DEPTH])))
+        && ((STRINGP (vec[CLOSURE_CODE]) /* Byte-code function.  */
+             && VECTORP (vec[CLOSURE_CONSTANTS])
+             && size > CLOSURE_STACK_DEPTH
+             && (FIXNATP (vec[CLOSURE_STACK_DEPTH])))
+            || (CONSP (vec[CLOSURE_CODE]) /* Interpreted function.  */
+                && (CONSP (vec[CLOSURE_CONSTANTS])
+                    || NILP (vec[CLOSURE_CONSTANTS]))))))
     invalid_syntax ("Invalid byte-code object", readcharfun);
 
-  if (STRING_MULTIBYTE (vec[CLOSURE_CODE]))
-    /* BYTESTR must have been produced by Emacs 20.2 or earlier
-       because it produced a raw 8-bit string for byte-code and
-       now such a byte-code string is loaded as multibyte with
-       raw 8-bit characters converted to multibyte form.
-       Convert them back to the original unibyte form.  */
-    vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]);
-
-  /* Bytecode must be immovable.  */
-  pin_string (vec[CLOSURE_CODE]);
+  if (STRINGP (vec[CLOSURE_CODE]))
+    {
+      if (STRING_MULTIBYTE (vec[CLOSURE_CODE]))
+        /* BYTESTR must have been produced by Emacs 20.2 or earlier
+           because it produced a raw 8-bit string for byte-code and
+           now such a byte-code string is loaded as multibyte with
+           raw 8-bit characters converted to multibyte form.
+           Convert them back to the original unibyte form.  */
+        vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]);
+
+      /* Bytecode must be immovable.  */
+      pin_string (vec[CLOSURE_CODE]);
+    }
 
   XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE);
   return obj;
diff --git a/src/profiler.c b/src/profiler.c
index ac23a97b672..6e1dc46abd3 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -170,9 +170,7 @@ trace_hash (Lisp_Object *trace, int depth)
     {
       Lisp_Object f = trace[i];
       EMACS_UINT hash1
-        = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE))
-           : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f)))
-           ? XHASH (XCDR (XCDR (f))) : XHASH (f));
+        = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) : XHASH (f));
       hash = sxhash_combine (hash, hash1);
     }
   return hash;
@@ -677,10 +675,6 @@ the same lambda expression, or are really unrelated function.  */)
     res = true;
   else if (CLOSUREP (f1) && CLOSUREP (f2))
     res = EQ (AREF (f1, CLOSURE_CODE), AREF (f2, CLOSURE_CODE));
-  else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2))
-           && EQ (Qclosure, XCAR (f1))
-           && EQ (Qclosure, XCAR (f2)))
-    res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2)));
   else
     res = false;
   return res ? Qt : Qnil;