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
|
(in-package :cl-forth)
(defparameter *operations* (make-hash-table))
(eval-always
(defun normalize-op-list (lst)
(cons 'list
(mapcar (lambda (el) (cond ((stringp el) el)
((listp el) `(format nil ,@el))))
lst))))
(defmacro defop (op-name args &body asm-strings)
`(setf (gethash ',op-name *operations*)
(lambda (out-stream ,@args)
(format out-stream "~{ ~a~%~}"
,(normalize-op-list asm-strings)))))
(defop push (a)
("push ~d" a))
(defop + ()
"pop rax"
"pop rbx"
"add rax, rbx"
"push rax")
(defop - ()
"pop rax"
"pop rbx"
"sub rbx, rax"
"push rbx")
(defop |.| ()
"pop rdi"
"call dump")
(defun gen-dump (str)
(format str "~{~a~%~}"
'("dump:"
" mov r9, -3689348814741910323"
" sub rsp, 40"
" mov BYTE [rsp+31], 10"
" lea rcx, [rsp+30]"
".L2:"
" mov rax, rdi"
" lea r8, [rsp+32]"
" mul r9"
" mov rax, rdi"
" sub r8, rcx"
" shr rdx, 3"
" lea rsi, [rdx+rdx*4]"
" add rsi, rsi"
" sub rax, rsi"
" add eax, 48"
" mov BYTE [rcx], al"
" mov rax, rdi"
" mov rdi, rdx"
" mov rdx, rcx"
" sub rcx, 1"
" cmp rax, 9"
" ja .L2"
" lea rax, [rsp+32]"
" mov edi, 1"
" sub rdx, rax"
" xor eax, eax"
" lea rsi, [rsp+32+rdx]"
" mov rdx, r8"
" mov rax, 1"
" syscall"
" add rsp, 40"
" ret")))
|
