如何编译defun

37次阅读

共计 5478 个字符,预计需要花费 14 分钟才能阅读完成。

本文讲解如何编译 defun。在 Common Lisp 中,defun 用于定义函数。例如,下列的代码定义了函数foo

(defun foo (a)
  "一个名为 FOO 的函数"
  (declare (ignorable a))
  (1+ 1))

defun 的语法中,第一行的字符串是这个函数的文档,可以用 documentation 函数获取;第二行是 declaration。(不管是 documentation 还是 declaration,也许要等到自举的那一天才能够支持了)目前只打算支持如下这般朴素的 defun 用法:

(defun a (x)
  (+ x 1))

可以想象,编译上面这段代码后,首先应当有一个函数名的 label,比如就叫做A。紧接着这个 label 的是函数体的代码,按照我这赶鸭子上架的做法看回来的说法,起码要有参数的处理——比如从寄存器中复制到内存中,还要有 callee-saved 的寄存器的保护,函数体的处理逻辑代码,以及收拾残局并返回到调用者的代码等等。

慢着,要将寄存器中的参数值复制到内存中,是需要在栈上开辟空间的。要这么做的话,就得先计算出一共需要多少字节的存储空间,还要计算出每一个参数在栈上的偏移。并且,为了可以在函数体内正确地使用参数的偏移,还需要提供一个环境(类似于编译原理的教程中常常出现的符号表)以便在递归地编译函数体的过程中查询才行——这一系列的东西对 jjcc2 的改动比较大。

所以,我用了一个简单但局限性较大的方法:将每一个参数都视为一个同名的全局变量。这样寄存器中的参数值就不需要复制到栈上,而是直接复制到参数名所代表的内存地址中。

如此,要编译 defun 就很简单了。拓展后的 jjcc2 函数的代码如下

(defun jjcc2 (expr globals)
  "支持两个数的四则运算的编译器"
  (check-type globals hash-table)
  (cond ((eq (first expr) '+)
         `((movl ,(get-operand expr 0) %eax)
           (movl ,(get-operand expr 1) %ebx)
           (addl %ebx %eax)))
        ((eq (first expr) '-)
         `((movl ,(get-operand expr 0) %eax)
           (movl ,(get-operand expr 1) %ebx)
           (subl %ebx %eax)))
        ((eq (first expr) '*)
         ;; 将两个数字相乘的结果放到第二个操作数所在的寄存器中
         ;; 因为约定了用 EAX 寄存器作为存放最终结果给 continuation 用的寄存器,所以第二个操作数应当为 EAX
         `((movl ,(get-operand expr 0) %eax)
           (movl ,(get-operand expr 1) %ebx)
           (imull %ebx %eax)))
        ((eq (first expr) '/)
         `((movl ,(get-operand expr 0) %eax)
           (cltd)
           (movl ,(get-operand expr 1) %ebx)
           (idivl %ebx)))
        ((eq (first expr) 'progn)
         (let ((result '()))
           (dolist (expr (rest expr))
             (setf result (append result (jjcc2 expr globals))))
           result))
        ((eq (first expr) 'setq)
         ;; 编译赋值语句的方式比较简单,就是将被赋值的符号视为一个全局变量,然后将 eax 寄存器中的内容移动到这里面去
         ;; TODO: 这里 expr 的 second 的结果必须是一个符号才行
         ;; FIXME: 不知道应该赋值什么比较好,先随便写个 0 吧
         (setf (gethash (second expr) globals) 0)
         (values (append (jjcc2 (third expr) globals)
                         ;; 为了方便 stringify 函数的实现,这里直接构造出 RIP-relative 形式的字符串
                         `((movl %eax ,(get-operand expr 0))))
                 globals))
        ;; ((eq (first expr) '_exit)
        ;;  ;; 因为知道_exit 只需要一个参数,所以将它的第一个操作数塞到 EDI 寄存器里面就可以了
        ;;  ;; TODO: 更好的写法,应该是有一个单独的函数来处理这种参数传递的事情(以符合 calling convention 的方式);;  `((movl ,(get-operand expr 0) %edi)
        ;;    (movl #x2000001 %eax)
        ;;    (syscall)))
        ((eq (first expr) '>)
         ;; 为了可以把比较之后的结果放入到 EAX 寄存器中,以我目前不完整的汇编语言知识,可以想到的方法如下
         (let ((label-greater-than (intern (symbol-name (gensym)) :keyword))
               (label-end (intern (symbol-name (gensym)) :keyword)))
           ;; 根据这篇文章(https://en.wikibooks.org/wiki/X86_Assembly/Control_Flow#Comparison_Instructions)中的说法,大于号左边的数字应该放在 CMP 指令的第二个操作数中,右边的放在第一个操作数中
           `((movl ,(get-operand expr 0) %eax)
             (movl ,(get-operand expr 1) %ebx)
             (cmpl %ebx %eax)
             (jg ,label-greater-than)
             (movl $0 %eax)
             (jmp ,label-end)
             ,label-greater-than
             (movl $1 %eax)
             ,label-end)))
        ((eq (first expr) 'if)
         ;; 假定 if 语句的测试表达式的结果也是放在 %eax 寄存器中的,所以只需要拿 %eax 寄存器中的值跟 0 做比较即可(类似于 C 语言)(let ((label-else (intern (symbol-name (gensym)) :keyword))
               (label-end (intern (symbol-name (gensym)) :keyword)))
           (append (jjcc2 (second expr) globals)
                   `((cmpl $0 %eax)
                     (je ,label-else))
                   (jjcc2 (third expr) globals)
                   `((jmp ,label-end)
                     ,label-else)
                   (jjcc2 (fourth expr) globals)
                   `(,label-end))))
        ((member (first expr) '(_exit exit))
         ;; 暂时以硬编码的方式识别一个函数是否来自于 C 语言的标准库
         `((movl ,(get-operand expr 0) %edi)
           ;; 据这篇回答(https://stackoverflow.com/questions/12678230/how-to-print-argv0-in-nasm)所说,在 macOS 上调用 C 语言函数,需要将栈对齐到 16 位
           ;; 假装要对齐的是栈顶地址。因为栈顶地址是往低地址增长的,所以只需要将地址的低 16 位抹掉就可以了
           (and ,(format nil "$0x~X" #XFFFFFFFFFFFFFFF0) %rsp)
           (call :|_exit|)))
        ((eq (first expr) 'return)
         ;; 由于经过 inside-out 的处理之后,return 的参数就是一个“原子”了,因此不再需要调用 jjcc2 来处理一遍
         `((movl ,(get-operand expr 0) %eax)
           (ret)))
        ((eq (first expr) 'defun)
         ;; defun 的编译过程是:;; 1. 根据函数参数生成相应的 MOV 指令
         ;; 2. 编译 body 的部分,生成一系列的汇编代码的 S 表达式
         ;; 3. 以 defun 的函数名和刚生成的 S 表达式组成 cons
         ;; 4. 添加到 *udfs* 中
         (let ((init-asm '())
               (params (caddr expr))
               (registers '(%rdi %rsi %rdx %rcx %r8 %r9)))
           (dolist (param params)
             (setf (gethash param globals) 0))
           ;; 生成一系列 MOV 指令,将寄存器中的参数值放入到特定的内存位置中
           (dotimes (i (length params))
             (when (nth i registers)
               (push `(movq ,(nth i registers)
                            ,(format nil "~A(%RIP)" (nth i params)))
                     init-asm)))

           (let ((asm (jjcc2 (cons 'progn (cdddr expr)) globals)))
             (push (cons (cadr expr)
                         (append init-asm asm '((ret))))
                   *udfs*)
             nil)))
        (t
         ;; 按照这里(https://www3.nd.edu/~dthain/courses/cse40243/fall2015/intel-intro.html)所给的函数调用约定来传递参数
         (let ((instructions '())
               (registers '(%rdi %rsi %rdx %rcx %r8 %r9)))
           (dotimes (i (length (rest expr)))
             (if (nth i registers)
                 (push `(movq ,(get-operand expr i) ,(nth i registers)) instructions)
                 (push `(pushq ,(get-operand expr i)) instructions)))
           ;; 经过一番尝试后,我发现必须在完成函数调用后恢复 RSP 寄存器才不会导致段错误
           `(,@(nreverse instructions)
             (pushq %rsp)
             (and ,(format nil "$0x~X" #XFFFFFFFFFFFFFFF0) %rsp)
             (call ,(first expr))
             (popq %rsp))))))

在上面的代码中,使用了一个叫做 *udfs* 的变量。它在我的 .lisp 文件中的定义如下

(defparameter *udfs*
  (list (cons '|lt1|'((movl 1 %eax)
                (ret)))))

实际上它就是一个很简单的、函数名到函数体代码的 alist 而已,在生成汇编代码字符串的时候,将其一股脑地写入到流中即可。为此,stringify函数也做了一番修改,拆分为了如下的两个函数

(defun stringify-asm (asm)
  "根据汇编代码 ASM 生成相应的汇编语言字符串"
  (dolist (ins asm)
    (cond ((keywordp ins)
           (format t "~A:~%" ins))
          ((= (length ins) 3)
           (format t "~A ~A, ~A~%"
                   (first ins)
                   (if (numberp (second ins))
                       (format nil "$~A" (second ins))
                       (second ins))
                   (if (numberp (third ins))
                       (format nil "$~A" (third ins))
                       (third ins))))
          ((= (length ins) 2)
           (format t "~A ~A~%"
                   (first ins)
                   (if (numberp (second ins))
                       (format nil "$~A" (second ins))
                       (second ins))))
          ((= (length ins) 1)
           (format t "~A~%" (first ins))))))

(defun stringify (asm globals)
  "根据 jjcc2 产生的 S 表达式生成汇编代码字符串"
  (check-type globals hash-table)
  ;; 输出 globals 中的所有变量
  ;; FIXME: 暂时只支持输出数字
  (format t ".data~%")
  (maphash (lambda (k v)
             (format t "~A: .long ~D~%" k v))
           globals)

  (format t ".section __TEXT,__text,regular,pure_instructions~%")
  (format t ".globl _main~%")
  ;; 输出用户自定义的函数
  (dolist (e *udfs*)
    (destructuring-bind (label . asm) e
      (format t "~A:~%" label)
      (stringify-asm asm)))

  (format t "_main:~%")
  (stringify-asm asm))

现在,可以继续用以前的 fb 函数来编译了,示例代码如下

(setf *udfs* nil)
(fb '(progn (defun a (x) (+ x 1)) (_exit (a 2))))

生成的汇编代码如下

        .data
X: .long 0
G606: .long 0
        .section __TEXT,__text,regular,pure_instructions
        .globl _main
A:
        MOVQ %RDI, X(%RIP)
        MOVL X(%RIP), %EAX
        MOVL $1, %EBX
        ADDL %EBX, %EAX
        RET
_main:
        MOVQ $2, %RDI
        PUSHQ %RSP
        AND $0xFFFFFFFFFFFFFFF0, %RSP
        CALL A
        POPQ %RSP
        MOVL %EAX, G606(%RIP)
        MOVL G606(%RIP), %EDI
        AND $0xFFFFFFFFFFFFFFF0, %RSP
        CALL _exit

编译运行即可得到返回码为 3。

全文完

阅读原文

正文完
 0