mescc: Beginning of expression and test template.
[mes.git] / module / mes / libc-i386.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; This file is part of Mes.
7 ;;;
8 ;;; Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; libc-i386.mes defines C library routines
24
25 ;;; Code:
26
27 (define (i386:function-preamble)
28   '(#x55                                ; push   %ebp
29     #x89 #xe5))                         ; mov    %esp,%ebp
30
31 (define (i386:function-locals)
32   '(#x83 #xec #x10))               ; sub    $0x10,%esp -- 4 local vars
33
34 (define (i386:ref-global o)
35   `(#x68 ,@(int->bv32 o)))               ; push  $0x<o>
36
37 (define (i386:ref-local n)
38   (or n rl)
39   `(#xff #x75 ,(- 0 (* 4 n))))          ; pushl  0x<n>(%ebp)
40
41 (define (i386:push-accu)
42   `(#x50))                              ; push %eax
43
44 (define (i386:push-arg f g t d)
45   (lambda (o)
46     (cond ((number? o)
47            `(#x68 ,@(int->bv32 o)))     ; push $<o>
48           ((pair? o) o)
49           ((procedure? o) (o f g t d))
50           (_ barf))))
51
52 (define (i386:ret . rest)
53   (lambda (f g t d)
54     `(
55       ,@(cond ((null? rest) '())
56               ((number? (car rest))
57                `(#xb8                     ; mov    $<>,%eax
58                  ,@(int->bv32 (car rest))))
59               ((pair? (car rest)) (car rest))
60               ((procedure? (car rest))
61                ((car rest) f g t d)))
62     #xc9                                ; leave
63     #xc3                                ; ret
64     )))
65
66 (define (i386:accu->local n)
67   (or n al)
68   `(#x89 #x45 ,(- 0 (* 4 n))))          ; mov    ,%eax,-<0xn>(%ebp)
69
70 (define (i386:accu-zero?)
71   `(#x85 #xc0))                         ; cmpl   %eax,%eax
72
73 (define (i386:accu-non-zero?)
74   (append '(#x85 #xc0)                  ; cmpl   %eax,%eax
75           (i386:xor-zf)))
76
77 (define (i386:local->accu n)
78   (or n la)
79   `(#x8b #x45 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%eax
80
81 (define (i386:local->base n)
82   (or n lb)
83   `(#x8b #x55 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%edx
84
85 (define (i386:byte-mem->accu)
86   '(#x01 #xd0                           ; add    %edx,%eax
87          #x0f #xb6 #x00))               ; movzbl (%eax),%eax
88
89 (define (i386:byte-mem->base)
90   '(#x0f #xb6 #x10))                    ; movzbl (%eax),%edx
91
92 (define (i386:mem->accu)
93   '(#x01 #xd0                           ; add    %edx,%eax
94          #x8b #x00))                    ; mov    (%eax),%eax
95
96 (define (i386:value->accu v)
97   `(#xb8 ,@(int->bv32 v)))              ; mov    $<v>,%eax
98
99 (define (i386:value->base v)
100   `(#xba ,@(int->bv32 v)))              ; mov    $<v>,%edx
101
102 (define (i386:local-add n v)
103   (or n ladd)
104   `(#x83 #x45 ,(- 0 (* 4 n)) ,v))       ; addl   $<v>,0x<n>(%ebp)
105     
106 (define (i386:local-assign n v)
107   (or n lassign)
108   `(#xc7 #x45 ,(- 0 (* 4 n))            ; movl   $<v>,0x<n>(%ebp)
109          ,@(int->bv32 v)))
110
111 (define (i386:local-test n v)
112   (or n lt)
113   `(#x83 #x7d ,(- 0 (* 4 n)) ,v))       ; cmpl   $<v>,0x<n>(%ebp)
114
115 (define (i386:ret-local n)
116   (or n rl)
117   `(
118     #x89 #x45 ,(- 0 (* 4 n))            ; mov    %eax,-0x<n>(%ebp)
119     ))
120
121 (define (i386:call f g t d address . arguments)
122   (let* ((pushes (append-map (i386:push-arg f g t d) (reverse arguments)))
123          (s (length pushes))
124          (n (length arguments)))
125    `(
126      ,@pushes                           ; push args
127      #xe8 ,@(int->bv32 (- address 5 s)) ; call relative
128      #x83 #xc4 ,(* n 4)                 ; add    $00,%esp
129      )))
130   
131 (define (i386:xor-zf)
132   '(#x9f                                ; lahf   
133     #x80 #xf4 #x40                      ; xor    $0x40,%ah
134     #x9e))                              ; sahf   
135
136 (define (i386:test-accu)
137   '(#x85 #xc0))                         ; test   %eax,%eax
138
139 (define (i386:jump n)
140   `(#xeb ,(if (>= n 0) (- n 2) (- n 2))))   ; jmp <n>
141
142 (define (i386:jump-c n)
143   `(#x72 ,(if (>= n 0) n (- n 2))))     ; jc <n>
144
145 (define (i386:jump-cz n)
146   `(#x76 ,(if (>= n 0) n (- n 2))))     ; jna <n>
147
148 (define (i386:jump-ncz n)
149   `(#x77 ,(if (>= n 0) n (- n 2))))     ; ja <n>
150
151 (define (i386:jump-nc n)
152   `(#x73 ,(if (>= n 0) n (- n 2))))     ; jnc <n>
153
154 (define (i386:jump-z n)
155   `(#x74 ,(if (>= n 0) n (- n 2)))) ; jz <n>
156
157 (define (i386:jump-nz n)
158   `(#x75 ,(if (>= n 0) n (- n 2)))) ; jnz <n>
159
160 (define (i386:test-jump-z n)
161   `(#x85 #xc0                           ; test   %eax,%eax
162     #x74 ,(if (>= n 0) n (- n 4))))     ; jz <n>
163
164 (define (i386:jump-byte-nz n)
165   `(#x84 #xc0                           ; test   %al,%al
166     #x75 ,(if (>= n 0) n (- n 4))))     ; jne <n>
167
168 (define (i386:jump-byte-z n)
169   `(#x84 #xc0                           ; test   %al,%al
170     #x74 ,(if (>= n 0) n (- n 4))))     ; jne <n>
171
172 (define (i386:byte-test-base)
173   `(#x38 #xc2))                         ; cmp    %al,%dl
174
175 (define (i386:test-base)
176   `(#x39 #xd0))                         ; cmp    %edx,%eax
177
178 (define (i386:byte-sub-base)
179   `(#x28 #xd0))                         ; sub    %dl,%al
180
181 (define (i386:byte-base-sub)
182   `(#x28 #xd0))                         ; sub    %al,%dl
183
184 (define (i386:sub-base)
185   `(#x29 #xd0))                         ; sub    %edx,%eax
186
187 (define (i386:base-sub)
188   `(#x29 #xc2))                         ; sub    %eax,%edx
189
190 ;;;\f libc bits
191 (define (i386:exit f g t d)
192   `(
193     #x5b                                ; pop    %ebx
194     #x5b                                ; pop    %ebx
195     #xb8 #x01 #x00 #x00 #x00            ; mov    $0x1,%eax
196     #xcd #x80                           ; int    $0x80
197     ))
198
199 (define (i386:write f g t d)
200   `(
201     #x55                                ; push   %ebp
202     #x89 #xe5                           ; mov    %esp,%ebp
203
204     #x8b #x5d #x08                      ; mov    $0x8(%ebp),%ebx
205     #x8b #x4d #x0c                      ; mov    $0xc(%ebp),%ecx
206     #x8b #x55 #x10                      ; mov    $0x4(%ebp),%edx
207
208     #xb8 #x04 #x00 #x00 #x00            ; mov    $0x4,%eax
209     #xcd #x80                           ; int    $0x80
210
211     #xc9                                ; leave
212     #xc3                                ; ret
213     ))