emacs 源码分析（七）

<2024-01-07 周日>

emacs源码分析（七）

这DEFUN宏就像胶水一样，它把c代码和emacs-lisp代码给联系起来。但是DEFUN宏看着怪恐怖的有没有！

/* This version of DEFUN declares a function prototype with the right
   arguments, so we can catch errors with maxargs at compile-time.  */
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
  SUBR_SECTION_ATTRIBUTE                                            \
  static union Aligned_Lisp_Subr sname =                            \
     {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },                     \
       { .a ## maxargs = fnname },                                  \
       minargs, maxargs, lname, {intspec}, 0}};                     \
   Lisp_Object fnname

自己动手把emacs的DEFUN宏抠出来

为了方便理解，我把DEFUN宏给抠了出来，放在一个单独的工程里：ysouyno/t_emacs_defun，如果不想下载工程，本篇结尾会附上所有源码（仅一个文件，不到300行代码）。

关于这个工程要注意：

1. 仅适用于windows平台，为了编译方便，很多辅助宏能省略则省略。
2. 设置C++ Language Standard为ISO C++20 Standard (/std:c++20)。

挑了一个最简单的emacs-lisp函数eq：

DEFUN ("eq", Feq, Seq, 2, 2, 0,
       doc: /* Return t if the two args are the same Lisp object.  */
       attributes: const)
  (Lisp_Object obj1, Lisp_Object obj2)
{
  if (EQ (obj1, obj2))
    return Qt;
  return Qnil;
}

展开后的eq代码是：

static union Aligned_Lisp_Subr Seq =
{
  {
    { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, // struct Lisp_Subr::header
    {.a2 = Feq },                            // struct Lisp_Subr::function
    2,                                       // struct Lisp_Subr::min_args
    2,                                       // struct Lisp_Subr::max_args
    "eq",                                    // struct Lisp_Subr::symbol_name
    {0},                                     // struct Lisp_Subr::intspec
    0                                        // struct Lisp_Subr::doc
  }
};

Lisp_Object Feq(Lisp_Object obj1, Lisp_Object obj2)
{
  if (EQ(obj1, obj2))
    return Qt;
  return Qnil;
}

从上可得，DEFUN有两个任务以（eq函数为例）：

1. 声明一个静态变量Seq，它应该会将要用于emacs-lisp代码中的某些地方，目前我还不清楚细节。
2. 定义一个c函数Feq。

我照着DEFUN宏展开后样子定义了一个没有使用DEFUN宏来定义的函数my-eq，它可以正常工作：

// DEFUN("my-eq", ...)
static union Aligned_Lisp_Subr Smy_eq =
{ {{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },
  {.a2 = Fmy_eq },
  2, 2, "my-eq", {0}, 0} };
Lisp_Object Fmy_eq(Lisp_Object obj1, Lisp_Object obj2)
{
  if (EQ(obj1, obj2))
    return Qt;
  return Qnil;
}

备注：

1. 有一个EXFUN宏要关注一下，这个代码我也抠出来了，它是用于声明Feq，否则编译器要报怨的：

error C2065: 'Feq': undeclared identifier

2. 在emacs源代码中，大量EXFUN的函数声明在globals.h文件中。该文件的生成方法见：“emacs源码分析（一）”。

附完整代码：

// t_emacs_defun.cpp : This file contains the 'main' function. Program execution begins and ends there.
//

#include <stddef.h> // for ptrdiff_t
#include <stdio.h>

typedef long long EMACS_INT;
typedef EMACS_INT Lisp_Word;

#define SUBR_SECTION_ATTRIBUTE

/* Minimum alignment requirement for Lisp objects, imposed by the
   internal representation of tagged pointers.  It is 2**GCTYPEBITS if
   USE_LSB_TAG, 1 otherwise.  It must be a literal integer constant,
   for older versions of GCC (through at least 4.9).  */
#if USE_LSB_TAG
# define GCALIGNMENT 8
# if GCALIGNMENT != 1 << GCTYPEBITS
#  error "GCALIGNMENT and GCTYPEBITS are inconsistent"
# endif
#else
# define GCALIGNMENT 1
#endif

#define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned;

#if HAVE_STRUCT_ATTRIBUTE_ALIGNED
# define GCALIGNED_STRUCT __attribute__ ((aligned (GCALIGNMENT)))
#else
# define GCALIGNED_STRUCT
#endif

union vectorlike_header
{
  /* The main member contains various pieces of information:
     - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
     - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
       vector (0) or a pseudovector (1).
     - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number
       of slots) of the vector.
     - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields:
 - a) pseudovector subtype held in PVEC_TYPE_MASK field;
 - b) number of Lisp_Objects slots at the beginning of the object
   held in PSEUDOVECTOR_SIZE_MASK field.  These objects are always
   traced by the GC;
 - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and
   measured in word_size units.  Rest fields may also include
   Lisp_Objects, but these objects usually needs some special treatment
   during GC.
 There are some exceptions.  For PVEC_FREE, b) is always zero.  For
 PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero.
 Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots.  */
  ptrdiff_t size;
};

/* A Lisp_Object is a tagged pointer or integer.  Ordinarily it is a
   Lisp_Word.  However, if CHECK_LISP_OBJECT_TYPE, it is a wrapper
   around Lisp_Word, to help catch thinkos like 'Lisp_Object x = 0;'.

   LISP_INITIALLY (W) initializes a Lisp object with a tagged value
   that is a Lisp_Word W.  It can be used in a static initializer.  */

#ifdef CHECK_LISP_OBJECT_TYPE
typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object;
# define LISP_OBJECT_IS_STRUCT
# define LISP_INITIALLY(w) {w}
# undef CHECK_LISP_OBJECT_TYPE
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
#else
typedef Lisp_Word Lisp_Object;
# define LISP_INITIALLY(w) (w)
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
#endif

/* 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
{
  union 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;
  union {
    const char* intspec;
    Lisp_Object native_intspec;
  };
  EMACS_INT doc;
#ifdef HAVE_NATIVE_COMP
  Lisp_Object native_comp_u;
  char* native_c_name;
  Lisp_Object lambda_list;
  Lisp_Object type;
#endif
} GCALIGNED_STRUCT;

union Aligned_Lisp_Subr
{
  struct Lisp_Subr s;
  GCALIGNED_UNION_MEMBER
};

enum pvec_type
{
  PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj.  */
  PVEC_FREE,
  PVEC_BIGNUM,
  PVEC_MARKER,
  PVEC_OVERLAY,
  PVEC_FINALIZER,
  PVEC_MISC_PTR,
  PVEC_USER_PTR,
  PVEC_PROCESS,
  PVEC_FRAME,
  PVEC_WINDOW,
  PVEC_BOOL_VECTOR,
  PVEC_BUFFER,
  PVEC_HASH_TABLE,
  PVEC_TERMINAL,
  PVEC_WINDOW_CONFIGURATION,
  PVEC_SUBR,
  PVEC_OTHER, /* Should never be visible to Elisp code.  */
  PVEC_XWIDGET,
  PVEC_XWIDGET_VIEW,
  PVEC_THREAD,
  PVEC_MUTEX,
  PVEC_CONDVAR,
  PVEC_MODULE_FUNCTION,
  PVEC_NATIVE_COMP_UNIT,

  /* These should be last, for internal_equal and sxhash_obj.  */
  PVEC_COMPILED,
  PVEC_CHAR_TABLE,
  PVEC_SUB_CHAR_TABLE,
  PVEC_RECORD,
  PVEC_FONT /* Should be last because it's used for range checking.  */
};

enum More_Lisp_Bits
{
  /* For convenience, we also store the number of elements in these bits.
     Note that this size is not necessarily the memory-footprint size, but
     only the number of Lisp_Object fields (that need to be traced by GC).
     The distinction is used, e.g., by Lisp_Process, which places extra
     non-Lisp_Object fields at the end of the structure.  */
  PSEUDOVECTOR_SIZE_BITS = 12,
  PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,

  /* To calculate the memory footprint of the pseudovector, it's useful
     to store the size of non-Lisp area in word_size units here.  */
  PSEUDOVECTOR_REST_BITS = 12,
  PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1)
  << PSEUDOVECTOR_SIZE_BITS),

  /* Used to extract pseudovector subtype information.  */
  PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
  PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS
};

/* This version of DEFUN declares a function prototype with the right
   arguments, so we can catch errors with maxargs at compile-time.  */
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
  SUBR_SECTION_ATTRIBUTE                                            \
  static union Aligned_Lisp_Subr sname =                            \
     {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },                     \
       { .a ## maxargs = fnname },                                  \
       minargs, maxargs, lname, {intspec}, 0}};                     \
   Lisp_Object fnname

enum maxargs
{
  MANY = -2,
  UNEVALLED = -1
};

#define EXFUN(fnname, maxargs) \
  extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs

/* Note that the weird token-substitution semantics of ANSI C makes
   this work for MANY and UNEVALLED.  */
#define DEFUN_ARGS_MANY		(ptrdiff_t, Lisp_Object *)
#define DEFUN_ARGS_UNEVALLED	(Lisp_Object)
#define DEFUN_ARGS_0	(void)
#define DEFUN_ARGS_1	(Lisp_Object)
#define DEFUN_ARGS_2	(Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_3	(Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_4	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_5	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object)
#define DEFUN_ARGS_6	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_7	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_8	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
			 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)

EXFUN(Feq, 2); // for error C2065: 'Feq': undeclared identifier
EXFUN(Fmy_eq, 2);

#define lisp_h_XLI(o) (o)
#define XLI(o) lisp_h_XLI (o)
#define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
#define EQ(x, y) lisp_h_EQ (x, y)

#define Qt (Lisp_Object)1
#define Qnil (Lisp_Object)0

/*
static union Aligned_Lisp_Subr Seq =
{
  {
    { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, // struct Lisp_Subr::header
    {.a2 = Feq },                            // struct Lisp_Subr::function
    2,                                       // struct Lisp_Subr::min_args
    2,                                       // struct Lisp_Subr::max_args
    "eq",                                    // struct Lisp_Subr::symbol_name
    {0},                                     // struct Lisp_Subr::intspec
    0                                        // struct Lisp_Subr::doc
  }
};

Lisp_Object Feq(Lisp_Object obj1, Lisp_Object obj2)
{
  if (EQ(obj1, obj2))
    return Qt;
  return Qnil;
}
*/

// error C7555: use of designated initializers requires at least '/std:c++20'
DEFUN("eq", Feq, Seq, 2, 2, 0,
  doc: /* Return t if the two args are the same Lisp object.  */
attributes: const)
(Lisp_Object obj1, Lisp_Object obj2)
{
  if (EQ(obj1, obj2))
    return Qt;
  return Qnil;
}

// DEFUN("my-eq", ...)
static union Aligned_Lisp_Subr Smy_eq =
{ {{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },
  {.a2 = Fmy_eq },
  2, 2, "my-eq", {0}, 0} };
Lisp_Object Fmy_eq(Lisp_Object obj1, Lisp_Object obj2)
{
  if (EQ(obj1, obj2))
    return Qt;
  return Qnil;
}

int main() {
  printf("Feq(0, 0): %s\n", Feq(0, 0) ? "true" : "false");
  printf("Feq(0, 1): %s\n", Feq(0, 1) ? "true" : "false");
  printf("Fmy_eq(11, 11): %s\n", Fmy_eq(0, 0) ? "true" : "false");
  printf("Fmy_eq(10, 11): %s\n", Fmy_eq(0, 1) ? "true" : "false");
}

程序输出：

Feq(0, 0): true
Feq(0, 1): false
Fmy_eq(11, 11): true
Fmy_eq(10, 11): false