as.scm 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781
  1. ;;; GNU Mes --- Maxwell Equations of Software
  2. ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Mes.
  5. ;;;
  6. ;;; GNU Mes is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Mes is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;;; Define x86_64 M1 assembly
  20. ;;; Code:
  21. (define-module (mescc x86_64 as)
  22. #:use-module (mes guile)
  23. #:use-module (mescc as)
  24. #:use-module (mescc info)
  25. #:use-module (mescc x86_64 info)
  26. #:export (
  27. x86_64:instructions
  28. ))
  29. (define (r->e o)
  30. (string-append "e" (string-drop o 1)))
  31. (define (r->x o)
  32. (string-drop o 1))
  33. (define (r->l o)
  34. (assoc-ref
  35. '(("rax" . "al")
  36. ("rdi" . "dil")
  37. ("rsi" . "sil")
  38. ("rdx" . "dl")
  39. ("rcx" . "cl")
  40. ("r8" . "r8b")
  41. ("r9" . "r9b"))
  42. o))
  43. ;; AMD
  44. (define (x86_64:function-preamble info . rest)
  45. `(("push___%rbp")
  46. ("mov____%rsp,%rbp")
  47. ("sub____$i32,%rbp" "%0x80")
  48. ,@(list-head
  49. '(("mov____%rdi,0x8(%rbp)" "!0x10")
  50. ("mov____%rsi,0x8(%rbp)" "!0x18")
  51. ("mov____%rdx,0x8(%rbp)" "!0x20")
  52. ("mov____%rcx,0x8(%rbp)" "!0x28")
  53. ("mov____%r8,0x8(%rbp)" "!0x30")
  54. ("mov____%r9,0x8(%rbp)" "!0x38"))
  55. (length (car rest)))))
  56. ;; traditional
  57. (define (x86_64:function-preamble info . rest)
  58. `(("push___%rbp")
  59. ("mov____%rsp,%rbp")))
  60. (define (x86_64:function-locals . rest)
  61. `(
  62. ;; FIXME: how on x86_64?
  63. ("sub____$i32,%rsp" (#:immediate ,(+ (* 4 1025) (* 20 8))))
  64. )) ; 4*1024 buf, 20 local vars
  65. (define (x86_64:r->local info n)
  66. (let ((r (get-r info))
  67. (n (- 0 (* 8 n))))
  68. `(,(if (< (abs n) #x80)
  69. `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
  70. `(,(string-append "mov____%" r ",0x32(%rbp)") (#:immediate ,n))))))
  71. (define (x86_64:value->r info v)
  72. (or v (error "invalid value: x86_64:value->r: " v))
  73. (let ((r (get-r info)))
  74. (if (and (>= v 0)
  75. (< v #xffffffff))
  76. `((,(string-append "mov____$i32,%" r) (#:immediate ,v)))
  77. `((,(string-append "mov____$i64,%" r) (#:immediate8 ,v))))))
  78. ;; AMD
  79. (define (x86_64:ret . rest)
  80. '(("add____$i32,%rbp" "%0x80")
  81. ("mov____%rbp,%rsp")
  82. ("pop____%rbp")
  83. ("ret")))
  84. ;; traditional
  85. (define (x86_64:ret . rest)
  86. '(("mov____%rbp,%rsp")
  87. ("pop____%rbp")
  88. ("ret")))
  89. (define (x86_64:r-zero? info)
  90. (let ((r (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
  91. `((,(string-append "test___%" r "," "%" r)))))
  92. (define (x86_64:local->r info n)
  93. (let ((r (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
  94. (n (- 0 (* 8 n))))
  95. `(,(if (< (abs n) #x80) `(,(string-append "mov____0x8(%rbp),%" r) (#:immediate1 ,n))
  96. `(,(string-append "mov____0x32(%rbp),%" r) (#:immediate ,n))))))
  97. (define (x86_64:call-label info label n)
  98. `((call32 (#:offset ,label))
  99. ("add____$i8,%rsp" (#:immediate1 ,(* n 8))) ;; NOT AMD
  100. ))
  101. (define x86_64:calling-convention-registers '("rax" "rdi" "rsi" "rdx" "rcx" "r8" "r9"))
  102. ;; AMD
  103. (define (x86_64:r->arg info i)
  104. (let ((r (get-r info))
  105. (r1 (list-ref x86_64:calling-convention-registers (1+ i))))
  106. `((,(string-append "mov____%" r ",%" r1))))) ; debug fail-safe check
  107. (define (x86_64:label->arg info label i)
  108. (let ((r0 (list-ref x86_64:registers (1+ i))))
  109. (if (< label #x80000000)
  110. `((,(string-append "mov____$i32,%" r0) (#:address ,label)))
  111. `((,(string-append "mov____$i64,%" r0) (#:address8 ,label))))))
  112. ;; traditional
  113. (define (x86_64:r->arg info i)
  114. (let ((r (get-r info)))
  115. `((,(string-append "push___%" r)))))
  116. (define (x86_64:label->arg info label i)
  117. `(("push___$i32" (#:address ,label))))
  118. ;; FIXME?
  119. ;; (define (x86_64:label->arg info label i)
  120. ;; `((,(string-append "mov____$i64,%r15") (#:address8 ,label))
  121. ;; ("push___%r15" (#:address ,label))))
  122. (define (x86_64:r0+r1 info)
  123. (let ((r1 (get-r1 info))
  124. (r0 (get-r0 info)))
  125. `((,(string-append "add____%" r1 ",%" r0)))))
  126. (define (x86_64:r-negate info)
  127. (let* ((r (get-r info))
  128. (l (r->l r)))
  129. `((,(string-append "sete___%" l))
  130. (,(string-append "movzbq_%" l ",%" r)))))
  131. (define (x86_64:r0-r1 info)
  132. (let ((r0 (get-r0 info))
  133. (r1 (get-r1 info)))
  134. `((,(string-append "sub____%" r1 ",%" r0)))))
  135. (define (x86_64:zf->r info)
  136. (let* ((r (get-r info))
  137. (l (r->l r)))
  138. `((,(string-append "sete___%" l))
  139. (,(string-append "movzbq_%" l ",%" r)))))
  140. (define (x86_64:xor-zf info)
  141. '(("lahf")
  142. ("xor____$i8,%ah" (#:immediate1 #x40))
  143. ("sahf")))
  144. (define (x86_64:r->local+n info id n)
  145. (let ((n (+ (- 0 (* 8 id)) n))
  146. (r (get-r info)))
  147. `(,(if (< (abs n) #x80) `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
  148. `(,(string-append "mov____%" r ",0x32(%rbp)") (#:immediate ,n))))))
  149. (define (x86_64:r-mem-add info v)
  150. (let ((r (get-r info)))
  151. `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,(%" r ")") (#:immediate1 ,v))
  152. `(,(string-append "add____$i32,(%" r ")") (#:immediate ,v)))))) ;; FIXME 64bit
  153. (define (x86_64:r-byte-mem-add info v)
  154. (let ((r (get-r info)))
  155. `((,(string-append "addb___$i8,(%" r ")") (#:immediate1 ,v)))))
  156. (define (x86_64:r-word-mem-add info v)
  157. (let ((r (get-r info)))
  158. `((,(string-append "addw___$i8,(%" r ")") (#:immediate2 ,v)))))
  159. (define (x86_64:local-ptr->r info n)
  160. (let ((r (get-r info)))
  161. (let ((n (- 0 (* 8 n))))
  162. `((,(string-append "mov____%rbp,%" r))
  163. ,(if (< (abs n) #x80) `(,(string-append "add____$i8,%" r) (#:immediate1 ,n))
  164. `(,(string-append "add____$i32,%" r) (#:immediate ,n))))))) ;; FIXME 64bit
  165. (define (x86_64:label->r info label)
  166. (let ((r (get-r info)))
  167. `((,(string-append "mov____$i64,%" r) (#:address8 ,label)))))
  168. (define (x86_64:r0->r1 info)
  169. (let ((r0 (get-r0 info))
  170. (r1 (get-r1 info)))
  171. `((,(string-append "mov____%" r0 ",%" r1)))))
  172. (define (x86_64:byte-mem->r info)
  173. (let ((r (get-r info)))
  174. `((,(string-append "movzbq_(%" r "),%" r)))))
  175. (define (x86_64:byte-r info)
  176. (let* ((r (get-r info))
  177. (l (r->l r)))
  178. `((,(string-append "movzbq_%" l ",%" r)))))
  179. (define (x86_64:byte-signed-r info)
  180. (let* ((r (get-r info))
  181. (l (r->l r)))
  182. `((,(string-append "movsbq_%" l ",%" r)))))
  183. (define (x86_64:word-r info)
  184. (let* ((r (get-r info))
  185. (x (r->x r)))
  186. `((,(string-append "movzwq_%" x ",%" r)))))
  187. (define (x86_64:word-signed-r info)
  188. (let* ((r (get-r info))
  189. (x (r->x r)))
  190. `((,(string-append "movswq_%" x ",%" r)))))
  191. (define (x86_64:long-r info)
  192. (let* ((r (get-r info))
  193. (e (r->e r)))
  194. `((,(string-append "movzlq_%" e ",%" r)))))
  195. (define (x86_64:long-signed-r info)
  196. (let* ((r (get-r info))
  197. (e (r->e r)))
  198. `((,(string-append "movslq_%" e ",%" r)))))
  199. (define (x86_64:jump info label)
  200. `(("jmp32 " (#:offset ,label))))
  201. (define (x86_64:jump-nz info label)
  202. `(("jne32 " (#:offset ,label))))
  203. (define (x86_64:jump-z info label)
  204. `(("je32 " (#:offset ,label))))
  205. (define (x86_64:jump-byte-z info label)
  206. `(("test___%al,%al")
  207. ("je32 " (#:offset ,label))))
  208. ;; signed
  209. (define (x86_64:jump-g info label)
  210. `(("jg32 " (#:offset ,label))))
  211. (define (x86_64:jump-ge info label)
  212. `(("jge32 " (#:offset ,label))))
  213. (define (x86_64:jump-l info label)
  214. `(("jl32 " (#:offset ,label))))
  215. (define (x86_64:jump-le info label)
  216. `(("jle32 " (#:offset ,label))))
  217. ;; unsigned
  218. (define (x86_64:jump-a info label)
  219. `(("ja32 " (#:offset ,label))))
  220. (define (x86_64:jump-ae info label)
  221. `(("jae32 " (#:offset ,label))))
  222. (define (x86_64:jump-b info label)
  223. `(("jb32 " (#:offset ,label))))
  224. (define (x86_64:jump-be info label)
  225. `(("jbe32 " (#:offset ,label))))
  226. (define (x86_64:byte-r0->r1-mem info)
  227. (let* ((r0 (get-r0 info))
  228. (r1 (get-r1 info))
  229. (l0 (r->l r0)))
  230. `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
  231. (define (x86_64:label-mem->r info label)
  232. (let ((r (get-r info)))
  233. `((,(string-append "mov____0x32,%" r) (#:address ,label)))))
  234. (define (x86_64:word-mem->r info)
  235. (let ((r (get-r info)))
  236. `((,(string-append "movzwq_(%" r "),%" r)))))
  237. (define (x86_64:long-mem->r info)
  238. (let ((r (get-r info)))
  239. `((,(string-append "movzlq_(%" r "),%" r)))))
  240. (define (x86_64:mem->r info)
  241. (let ((r (get-r info)))
  242. `((,(string-append "mov____(%" r "),%" r)))))
  243. (define (x86_64:local-add info n v)
  244. (let ((n (- 0 (* 8 n))))
  245. `(,(if (and (< (abs n) #x80)
  246. (< (abs v) #x80)) `("add____$i8,0x8(%rbp)" (#:immediate1 ,n) (#:immediate1 ,v))
  247. `("add____$i32,0x32(%rbp)" (#:immediate ,n) (#:immediate ,v)))))) ;; FIXME: 64b
  248. (define (x86_64:label-mem-add info label v)
  249. `(,(if (< (abs v) #x80) `("add____$i8,0x32" (#:address ,label) (#:immediate1 ,v))
  250. `("add____$i32,0x32" (#:address ,label) (#:immediate ,v))))) ;; FIXME: 64b
  251. (define (x86_64:nop info)
  252. '(("nop")))
  253. (define (x86_64:swap-r0-r1 info)
  254. (let ((r0 (get-r0 info))
  255. (r1 (get-r1 info)))
  256. `((,(string-append "xchg___%" r0 ",%" r1)))))
  257. ;; signed
  258. (define (x86_64:g?->r info)
  259. (let* ((r (get-r info))
  260. (l (r->l r)))
  261. `((,(string-append "setg___%" l))
  262. (,(string-append "movzbq_%" l ",%" r)))))
  263. (define (x86_64:ge?->r info)
  264. (let* ((r (get-r info))
  265. (l (r->l r)))
  266. `((,(string-append "setge__%" l))
  267. (,(string-append "movzbq_%" l ",%" r)))))
  268. (define (x86_64:l?->r info)
  269. (let* ((r (get-r info))
  270. (l (r->l r)))
  271. `((,(string-append "setl___%" l))
  272. (,(string-append "movzbq_%" l ",%" r)))))
  273. (define (x86_64:le?->r info)
  274. (let* ((r (get-r info))
  275. (l (r->l r)))
  276. `((,(string-append "setle__%" l))
  277. (,(string-append "movzbq_%" l ",%" r)))))
  278. ;; unsigned
  279. (define (x86_64:a?->r info)
  280. (let* ((r (get-r info))
  281. (l (r->l r)))
  282. `((,(string-append "seta___%" l))
  283. (,(string-append "movzbq_%" l ",%" r)))))
  284. (define (x86_64:ae?->r info)
  285. (let* ((r (get-r info))
  286. (l (r->l r)))
  287. `((,(string-append "setae__%" l))
  288. (,(string-append "movzbq_%" l ",%" r)))))
  289. (define (x86_64:b?->r info)
  290. (let* ((r (get-r info))
  291. (l (r->l r)))
  292. `((,(string-append "setb___%" l))
  293. (,(string-append "movzbq_%" l ",%" r)))))
  294. (define (x86_64:be?->r info)
  295. (let* ((r (get-r info))
  296. (l (r->l r)))
  297. `((,(string-append "setbe__%" l))
  298. (,(string-append "movzbq_%" l ",%" r)))))
  299. (define (x86_64:test-r info)
  300. (let ((r (get-r info)))
  301. `((,(string-append "test___%" r ",%" r)))))
  302. (define (x86_64:r->label info label)
  303. (let ((r (get-r info)))
  304. `((,(string-append "mov____%" r ",0x32") (#:address ,label))))) ;; FIXME: 64 bits
  305. (define (x86_64:r->byte-label info label)
  306. (let* ((r (get-r info))
  307. (l (r->l r)))
  308. `((,(string-append "movb___%" l ",0x32") (#:address ,label)))))
  309. (define (x86_64:r->word-label info label)
  310. (let* ((r (get-r info))
  311. (x (r->x r)))
  312. `((,(string-append "movw___%" x ",0x32") (#:address ,label)))))
  313. (define (x86_64:r->long-label info label)
  314. (let* ((r (get-r info))
  315. (e (r->e r)))
  316. `((,(string-append "movl___%" e ",0x32") (#:address ,label)))))
  317. (define (x86_64:call-r info n)
  318. (let ((r (get-r info)))
  319. `((,(string-append "call___*%" r))
  320. ("add____$i8,%rsp" (#:immediate1 ,(* n 8)))))) ;; NOT AMD
  321. (define (x86_64:r0*r1 info)
  322. (let ((allocated (.allocated info))
  323. (r0 (get-r0 info))
  324. (r1 (get-r1 info)))
  325. (if (not (member "rdx" allocated))
  326. `(,@(if (equal? r0 "rax") '()
  327. `(("push___%rax"
  328. ,(string-append "mov____%" r0 ",%rax"))))
  329. (,(string-append "mul____%" r1))
  330. ,@(if (equal? r0 "rax") '()
  331. `((,(string-append "mov____%rax,%" r0)
  332. "pop____%rax"))))
  333. `(("push___%rax")
  334. ("push___%rdi")
  335. ("push___%rdx")
  336. (,(string-append "mov____%" r1 ",%rdi"))
  337. (,(string-append "mov____%" r0 ",%rax"))
  338. (,(string-append "mul____%" r1))
  339. ("pop____%rdx")
  340. ("pop____%rdi")
  341. (,(string-append "mov____%rax,%" r0))
  342. ("pop____%rax")))))
  343. (define (x86_64:r0<<r1 info)
  344. (let ((r0 (get-r0 info))
  345. (r1 (get-r1 info)))
  346. `((,(string-append "mov____%" r1 ",%rcx"))
  347. (,(string-append "shl____%cl,%" r0)))))
  348. (define (x86_64:r0>>r1 info)
  349. (let ((r0 (get-r0 info))
  350. (r1 (get-r1 info)))
  351. `((,(string-append "mov____%" r1 ",%rcx"))
  352. (,(string-append "shr____%cl,%" r0)))))
  353. (define (x86_64:r0-and-r1 info)
  354. (let ((r0 (get-r0 info))
  355. (r1 (get-r1 info)))
  356. `((,(string-append "and____%" r1 ",%" r0)))))
  357. (define (x86_64:r0/r1 info signed?)
  358. (let ((allocated (.allocated info))
  359. (r0 (get-r0 info))
  360. (r1 (get-r1 info)))
  361. (if (not (member "rdx" allocated))
  362. `(,@(if (equal? r0 "rax") '()
  363. `(("push___%rax")
  364. (,(string-append "mov____%" r0 ",%rax"))))
  365. ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
  366. ,(if signed? `(,(string-append "idiv___%" r1)) `(,(string-append "div___%" r1)))
  367. ,@(if (equal? r0 "rax") '()
  368. `((,(string-append "mov____%rax,%" r0))
  369. ("pop____%rax"))))
  370. `(("push___%rax")
  371. ("push___%rdi")
  372. ("push___%rdx")
  373. (,(string-append "mov____%" r1 ",%rdi"))
  374. (,(string-append "mov____%" r0 ",%rax"))
  375. ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
  376. ,(if signed? `(,(string-append "idiv___%rdi")) `(,(string-append "div___%rdi")))
  377. ("pop____%rdx")
  378. ("pop____%rdi")
  379. (,(string-append "mov____%rax,%" r0))
  380. ("pop____%rax")))))
  381. (define (x86_64:r0%r1 info signed?)
  382. (let ((allocated (.allocated info))
  383. (r0 (get-r0 info))
  384. (r1 (get-r1 info)))
  385. (if (not (member "rdx" allocated))
  386. `(,@(if (equal? r0 "rax") '()
  387. `(("push___%rax")
  388. (,(string-append "mov____%" r0 ",%rax"))))
  389. ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
  390. ,(if signed? `(,(string-append "idiv___%" r1)) `(,(string-append "div___%" r1)))
  391. (,(string-append "mov____%rdx,%" r0)))
  392. `(("push___%rax")
  393. ("push___%rdi")
  394. ("push___%rdx")
  395. (,(string-append "mov____%" r1 ",%rdi"))
  396. (,(string-append "mov____%" r0 ",%rax"))
  397. ,(if signed? '("cqto") '("xor____%rdx,%rdx"))
  398. ,(if signed? `(,(string-append "idiv___%rdi")) `(,(string-append "div___%rdi")))
  399. ("pop____%rdx")
  400. ("pop____%rdi")
  401. (,(string-append "mov____%rdx,%" r0))
  402. ("pop____%rax")))))
  403. (define (x86_64:r+value info v)
  404. (let ((r (get-r info)))
  405. (cond ((< (abs v) #x80)
  406. `((,(string-append "add____$i8,%" r) (#:immediate1 ,v))))
  407. ((< (abs v) #x80000000)
  408. `((,(string-append "add____$i32,%" r) (#:immediate ,v))))
  409. (else
  410. `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
  411. (,(string-append "add____%r15,%" r)))))))
  412. (define (x86_64:r0->r1-mem info)
  413. (let ((r0 (get-r0 info))
  414. (r1 (get-r1 info)))
  415. `((,(string-append "mov____%" r0 ",(%" r1 ")")))))
  416. (define (x86_64:byte-r0->r1-mem info)
  417. (let* ((r0 (get-r0 info))
  418. (r1 (get-r1 info))
  419. (l0 (r->l r0)))
  420. `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
  421. (define (x86_64:word-r0->r1-mem info)
  422. (let* ((r0 (get-r0 info))
  423. (r1 (get-r1 info))
  424. (x0 (r->x r0)))
  425. `((,(string-append "mov____%" x0 ",(%" r1 ")")))))
  426. (define (x86_64:long-r0->r1-mem info)
  427. (let* ((r0 (get-r0 info))
  428. (r1 (get-r1 info))
  429. (e0 (r->e r0)))
  430. `((,(string-append "mov____%" e0 ",(%" r1 ")")))))
  431. (define (x86_64:r-cmp-value info v)
  432. (let ((r (get-r info)))
  433. (cond ((< (abs v) #x80)
  434. `((,(string-append "cmp____$i8,%" r) (#:immediate1 ,v))))
  435. ((and (>= v 0)
  436. (< v #xffffffff))
  437. `((,(string-append "cmp____$i32,%" r) (#:immediate ,v))))
  438. (else
  439. `(,(string-append "mov____$i64,%r15") (#:immediate8 ,v)
  440. ,(string-append "cmp____%r15,%" r))))))
  441. (define (x86_64:push-register info r)
  442. `((,(string-append "push___%" r))))
  443. (define (x86_64:pop-register info r)
  444. `((,(string-append "pop____%" r))))
  445. (define (x86_64:return->r info)
  446. (let ((r (car (.allocated info))))
  447. (if (equal? r "rax") '()
  448. `((,(string-append "mov____%rax,%" r))))))
  449. (define (x86_64:r0-or-r1 info)
  450. (let ((r0 (get-r0 info))
  451. (r1 (get-r1 info)))
  452. `((,(string-append "or_____%" r1 ",%" r0)))))
  453. (define (x86_64:shl-r info n)
  454. (let ((r (get-r info)))
  455. `((,(string-append "shl____$i8,%" r) (#:immediate1 ,n)))))
  456. (define (x86_64:r+r info)
  457. (let ((r (get-r info)))
  458. `((,(string-append "add____%" r ",%" r)))))
  459. (define (x86_64:not-r info)
  460. (let ((r (get-r info)))
  461. `((,(string-append "not____%" r)))))
  462. (define (x86_64:r0-xor-r1 info)
  463. (let ((r0 (get-r0 info))
  464. (r1 (get-r1 info)))
  465. `((,(string-append "xor____%" r1 ",%" r0)))))
  466. (define (x86_64:r0-mem->r1-mem info)
  467. (let* ((registers (.registers info))
  468. (r0 (get-r0 info))
  469. (r1 (get-r1 info))
  470. (r2 (car registers)))
  471. `((,(string-append "mov____(%" r0 "),%" r2))
  472. (,(string-append "mov____%" r2 ",(%" r1 ")")))))
  473. (define (x86_64:byte-r0-mem->r1-mem info)
  474. (let* ((registers (.registers info))
  475. (r0 (get-r0 info))
  476. (r1 (get-r1 info))
  477. (r2 (car registers))
  478. (l2 (r->l r2)))
  479. `((,(string-append "mov____(%" r0 "),%" l2))
  480. (,(string-append "mov____%" l2 ",(%" r1 ")")))))
  481. (define (x86_64:word-r0-mem->r1-mem info)
  482. (let* ((registers (.registers info))
  483. (r0 (get-r0 info))
  484. (r1 (get-r1 info))
  485. (r2 (car registers))
  486. (x2 (r->x r2)))
  487. `((,(string-append "mov____(%" r0 "),%" x2))
  488. (,(string-append "mov____%" x2 ",(%" r1 ")")))))
  489. (define (x86_64:long-r0-mem->r1-mem info)
  490. (let* ((registers (.registers info))
  491. (r0 (get-r0 info))
  492. (r1 (get-r1 info))
  493. (r2 (car registers))
  494. (e2 (r->e r2)))
  495. `((,(string-append "mov____(%" r0 "),%" e2))
  496. (,(string-append "mov____%" e2 ",(%" r1 ")")))))
  497. (define (x86_64:r0+value info v)
  498. (let ((r0 (get-r0 info)))
  499. `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r0) (#:immediate1 ,v))
  500. `(,(string-append "add____$i32,%" r0) (#:immediate ,v)))))) ; FIXME: 64bit
  501. (define (x86_64:value->r0 info v)
  502. (let ((r0 (get-r0 info)))
  503. `((,(string-append "mov____$i32,%" r0) (#:immediate ,v)))))
  504. (define (x86_64:r-long-mem-add info v)
  505. (let ((r (get-r info)))
  506. (cond ((< (abs v) #x80)
  507. `((,(string-append "addl___$i8,(%" r ")") (#:immediate1 ,v))))
  508. ((and (>= v 0)
  509. (< v #xffffffff))
  510. `((,(string-append "addl___$i32,(%" r ")") (#:immediate ,v))))
  511. (else
  512. `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
  513. (,(string-append "add____%r15,(%" r ")")))))))
  514. (define (x86_64:byte-r->local+n info id n)
  515. (let* ((n (+ (- 0 (* 8 id)) n))
  516. (r (get-r info))
  517. (l (r->l r) ))
  518. `(,(if (< (abs n) #x80) `(,(string-append "mov____%" l ",0x8(%rbp)") (#:immediate1 ,n))
  519. `(,(string-append "mov____%" l ",0x32(%rbp)") (#:immediate ,n))))))
  520. (define (x86_64:word-r->local+n info id n)
  521. (let* ((n (+ (- 0 (* 8 id)) n))
  522. (r (get-r info))
  523. (x (r->x r) ))
  524. `(,(if (< (abs n) #x80) `(,(string-append "mov____%" x ",0x8(%rbp)") (#:immediate1 ,n))
  525. `(,(string-append "mov____%" x ",0x32(%rbp)") (#:immediate ,n))))))
  526. (define (x86_64:long-r->local+n info id n)
  527. (let* ((n (+ (- 0 (* 8 id)) n))
  528. (r (get-r info))
  529. (e (r->e r)))
  530. `(,(if (< (abs n) #x80) `(,(string-append "mov____%" e ",0x8(%rbp)") (#:immediate1 ,n))
  531. `(,(string-append "mov____%" e ",0x32(%rbp)") (#:immediate ,n))))))
  532. (define (x86_64:r-and info v)
  533. (let ((r (get-r info)))
  534. (if (and (>= v 0)
  535. (< v #xffffffff))
  536. `((,(string-append "and____$i32,%" r) (#:immediate ,v)))
  537. `((,(string-append "mov____$i64,%r15") (#:immediate8 ,v))
  538. (,(string-append "and____%r15,%" r))))))
  539. (define (x86_64:push-r0 info)
  540. (let ((r0 (get-r0 info)))
  541. `((,(string-append "push___%" r0)))))
  542. (define (x86_64:r1->r0 info)
  543. (let ((r0 (get-r0 info))
  544. (r1 (get-r1 info)))
  545. `((,(string-append "mov____%" r1 ",%" r0)))))
  546. (define (x86_64:pop-r0 info)
  547. (let ((r0 (get-r0 info)))
  548. `((,(string-append "pop____%" r0)))))
  549. (define (x86_64:swap-r-stack info)
  550. (let ((r (get-r info)))
  551. `((,(string-append "xchg___%" r ",(%rsp)")))))
  552. (define (x86_64:swap-r1-stack info)
  553. (let ((r0 (get-r0 info)))
  554. `((,(string-append "xchg___%" r0 ",(%rsp)")))))
  555. (define (x86_64:r2->r0 info)
  556. (let ((r0 (get-r0 info))
  557. (r1 (get-r1 info))
  558. (allocated (.allocated info)))
  559. (if (> (length allocated) 2)
  560. (let ((r2 (cadddr allocated)))
  561. `((,(string-append "mov____%" r2 ",%" r1))))
  562. `((,(string-append "pop____%" r0))
  563. (,(string-append "push___%" r0))))))
  564. (define x86_64:instructions
  565. `(
  566. (a?->r . ,x86_64:a?->r)
  567. (ae?->r . ,x86_64:ae?->r)
  568. (b?->r . ,x86_64:b?->r)
  569. (be?->r . ,x86_64:be?->r)
  570. (byte-mem->r . ,x86_64:byte-mem->r)
  571. (byte-r . ,x86_64:byte-r)
  572. (byte-r->local+n . ,x86_64:byte-r->local+n)
  573. (byte-r0->r1-mem . ,x86_64:byte-r0->r1-mem)
  574. (byte-r0-mem->r1-mem . ,x86_64:byte-r0-mem->r1-mem)
  575. (byte-signed-r . ,x86_64:byte-signed-r)
  576. (call-label . ,x86_64:call-label)
  577. (call-r . ,x86_64:call-r)
  578. (function-locals . ,x86_64:function-locals)
  579. (function-preamble . ,x86_64:function-preamble)
  580. (g?->r . ,x86_64:g?->r)
  581. (ge?->r . ,x86_64:ge?->r)
  582. (jump . ,x86_64:jump)
  583. (jump-a . ,x86_64:jump-a)
  584. (jump-ae . ,x86_64:jump-ae)
  585. (jump-b . ,x86_64:jump-b)
  586. (jump-be . ,x86_64:jump-be)
  587. (jump-byte-z . ,x86_64:jump-byte-z)
  588. (jump-g . , x86_64:jump-g)
  589. (jump-ge . , x86_64:jump-ge)
  590. (jump-l . ,x86_64:jump-l)
  591. (jump-le . ,x86_64:jump-le)
  592. (jump-nz . ,x86_64:jump-nz)
  593. (jump-z . ,x86_64:jump-z)
  594. (l?->r . ,x86_64:l?->r)
  595. (label->arg . ,x86_64:label->arg)
  596. (label->r . ,x86_64:label->r)
  597. (label-mem->r . ,x86_64:label-mem->r)
  598. (label-mem-add . ,x86_64:label-mem-add)
  599. (le?->r . ,x86_64:le?->r)
  600. (local->r . ,x86_64:local->r)
  601. (local-add . ,x86_64:local-add)
  602. (local-ptr->r . ,x86_64:local-ptr->r)
  603. (long-mem->r . ,x86_64:long-mem->r)
  604. (long-r . ,x86_64:long-r)
  605. (long-r->local+n . ,x86_64:long-r->local+n)
  606. (long-r0->r1-mem . ,x86_64:long-r0->r1-mem)
  607. (long-r0-mem->r1-mem . ,x86_64:long-r0-mem->r1-mem)
  608. (long-signed-r . ,x86_64:long-signed-r)
  609. (mem->r . ,x86_64:mem->r)
  610. (nop . ,x86_64:nop)
  611. (not-r . ,x86_64:not-r)
  612. (pop-r0 . ,x86_64:pop-r0)
  613. (pop-register . ,x86_64:pop-register)
  614. (push-r0 . ,x86_64:push-r0)
  615. (push-register . ,x86_64:push-register)
  616. (quad-r0->r1-mem . ,x86_64:r0->r1-mem)
  617. (r+r . ,x86_64:r+r)
  618. (r+value . ,x86_64:r+value)
  619. (r->arg . ,x86_64:r->arg)
  620. (r->byte-label . ,x86_64:r->byte-label)
  621. (r->label . ,x86_64:r->label)
  622. (r->local . ,x86_64:r->local)
  623. (r->local+n . ,x86_64:r->local+n)
  624. (r->long-label . ,x86_64:r->long-label)
  625. (r->word-label . ,x86_64:r->word-label)
  626. (r-and . ,x86_64:r-and)
  627. (r-byte-mem-add . ,x86_64:r-byte-mem-add)
  628. (r-cmp-value . ,x86_64:r-cmp-value)
  629. (r-long-mem-add . ,x86_64:r-long-mem-add)
  630. (r-mem-add . ,x86_64:r-mem-add)
  631. (r-negate . ,x86_64:r-negate)
  632. (r-word-mem-add . ,x86_64:r-word-mem-add)
  633. (r-zero? . ,x86_64:r-zero?)
  634. (r0%r1 . ,x86_64:r0%r1)
  635. (r0*r1 . ,x86_64:r0*r1)
  636. (r0+r1 . ,x86_64:r0+r1)
  637. (r0+value . ,x86_64:r0+value)
  638. (r0->r1 . ,x86_64:r0->r1)
  639. (r0->r1-mem . ,x86_64:r0->r1-mem)
  640. (r0-and-r1 . ,x86_64:r0-and-r1)
  641. (r0-mem->r1-mem . ,x86_64:r0-mem->r1-mem)
  642. (r0-or-r1 . ,x86_64:r0-or-r1)
  643. (r0-r1 . ,x86_64:r0-r1)
  644. (r0-xor-r1 . ,x86_64:r0-xor-r1)
  645. (r0/r1 . ,x86_64:r0/r1)
  646. (r0<<r1 . ,x86_64:r0<<r1)
  647. (r0>>r1 . ,x86_64:r0>>r1)
  648. (r1->r0 . ,x86_64:r1->r0)
  649. (r2->r0 . ,x86_64:r2->r0)
  650. (ret . ,x86_64:ret)
  651. (return->r . ,x86_64:return->r)
  652. (shl-r . ,x86_64:shl-r)
  653. (swap-r-stack . ,x86_64:swap-r-stack)
  654. (swap-r0-r1 . ,x86_64:swap-r0-r1)
  655. (swap-r1-stack . ,x86_64:swap-r1-stack)
  656. (test-r . ,x86_64:test-r)
  657. (value->r . ,x86_64:value->r)
  658. (value->r0 . ,x86_64:value->r0)
  659. (word-mem->r . ,x86_64:word-mem->r)
  660. (word-r . ,x86_64:word-r)
  661. (word-r->local+n . ,x86_64:word-r->local+n)
  662. (word-r0->r1-mem . ,x86_64:word-r0->r1-mem)
  663. (word-r0-mem->r1-mem . ,x86_64:word-r0-mem->r1-mem)
  664. (word-signed-r . ,x86_64:word-signed-r)
  665. (xor-zf . ,x86_64:xor-zf)
  666. (zf->r . ,x86_64:zf->r)
  667. ))