1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
| (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) '*) `((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) (setf (gethash (second expr) globals) 0) (values (append (jjcc2 (third expr) globals) `((movl %eax ,(get-operand expr 0)))) globals)) ((eq (first expr) '>) (let ((label-greater-than (intern (symbol-name (gensym)) :keyword)) (label-end (intern (symbol-name (gensym)) :keyword))) `((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) (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)) `((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) `((movl ,(get-operand expr 0) %eax) (ret))) ((eq (first expr) 'defun) (let ((init-asm '()) (params (caddr expr)) (registers '(%rdi %rsi %rdx %rcx %r8 %r9))) (dolist (param params) (setf (gethash param globals) 0)) (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 (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))) `(,@(nreverse instructions) (pushq %rsp) (and ,(format nil "$0x~X" #XFFFFFFFFFFFFFFF0) %rsp) (call ,(first expr)) (popq %rsp))))))
|