本文讲解如何编译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。
全文完
