文章目录
<2024-01-07 周日>
emacs源码分析（七）
这DEFUN宏就像胶水一样，它把c代码和emacs-lisp代码给联系起来。但是DEFUN宏看着怪恐怖的有没有！
cpp
/* 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行代码）。
关于这个工程要注意：
- 仅适用于
windows平台，为了编译方便，很多辅助宏能省略则省略。 - 设置
C++ Language Standard为ISO C++20 Standard (/std:c++20)。
挑了一个最简单的emacs-lisp函数eq：
cpp
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代码是：
cpp
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函数为例）：
- 声明一个静态变量
Seq，它应该会将要用于emacs-lisp代码中的某些地方，目前我还不清楚细节。 - 定义一个
c函数Feq。
我照着DEFUN宏展开后样子定义了一个没有使用DEFUN宏来定义的函数my-eq，它可以正常工作：
cpp
// 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;
}备注：
- 有一个
EXFUN宏要关注一下，这个代码我也抠出来了，它是用于声明Feq，否则编译器要报怨的：
text
error C2065: 'Feq': undeclared identifier- 在
emacs源代码中，大量EXFUN的函数声明在globals.h文件中。该文件的生成方法见："emacs源码分析（一）"。
附完整代码：
cpp
// 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");
}程序输出：
text
Feq(0, 0): true
Feq(0, 1): false
Fmy_eq(11, 11): true
Fmy_eq(10, 11): false