mescc: Formals, local variables.
* module/language/c99/compiler.mes (statement->text+symbols+locals): Rename from statement->text+symbols. Handle locals. (formals->text): Add proper function preamble. (formals->locals): Add formals as locals. (expr->accu, ident->accu, ident->base, ident-ref, global-ref): New functions. (strlen, eputs, fputs, puts): New functions. (libc): New variable. (i386:libc): Rename from libc. Remove eputs and puts. * module/mes/libc-i386.mes (i386:eputs, i386:puts: Remove. (i386:call, i386:ret): Handle locals as argument. (i386:function-locals, i386:function-preamble, i386:jump, i386:local->accu, i386:local-add, i386:local-assign, i386:local->base, i386:ref-global, i386:ref-local, i386:ret-local, i386:mem-byte->accu, i386:test-jump, i386:write): New functions. * module/mes/libc-i386.scm: Export them.
This commit is contained in:
parent
57e11b3147
commit
109cbdd1e7
|
@ -36,6 +36,14 @@
|
|||
(mes-use-module (mes elf))
|
||||
(mes-use-module (mes libc-i386))))
|
||||
|
||||
(define (logf port string . rest)
|
||||
(apply format (cons* port string rest))
|
||||
(force-output port)
|
||||
#t)
|
||||
|
||||
(define (stderr string . rest)
|
||||
(apply logf (cons* (current-error-port) string rest)))
|
||||
|
||||
(define (gnuc-xdef? name mode) (if (equal? name "__GNUC__") #f (eq? mode 'code)))
|
||||
;;(define (gnuc-xdef? name mode) (equal? name "__GNUC__"))
|
||||
;; (define (gnuc-xdef? name mode)
|
||||
|
@ -58,67 +66,215 @@
|
|||
(define (.name o)
|
||||
(pmatch o
|
||||
((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
|
||||
((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) _) name)))
|
||||
((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) _) name)
|
||||
((param-decl _ (param-declr (ident ,name))) name)
|
||||
((param-decl _ (param-declr (ptr-declr (pointer) (ident ,name)))) name)
|
||||
((param-decl _ (param-declr (ptr-declr (pointer) (array-of (ident ,name))))) name)
|
||||
(_
|
||||
(format (current-error-port) "SKIP .name =~a\n" o))))
|
||||
|
||||
(define (.statements o)
|
||||
(pmatch o
|
||||
((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements)
|
||||
((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)))
|
||||
|
||||
(define (expr->arg symbols) ;; FIXME: get Mes curried-definitions
|
||||
(define (ident-ref locals)
|
||||
(lambda (o)
|
||||
(i386:ref-local (assoc-ref locals o))))
|
||||
|
||||
(define (global-ref symbols)
|
||||
(lambda (o)
|
||||
(lambda (s t d)
|
||||
(i386:ref-global (+ (data-offset o symbols) d)))))
|
||||
|
||||
(define (expr->arg symbols locals) ;; FIXME: get Mes curried-definitions
|
||||
(lambda (o)
|
||||
(pmatch o
|
||||
((p-expr (fixed ,value)) (string->number value))
|
||||
((p-expr (string ,string)) (data-offset symbols string))
|
||||
((p-expr (string ,string)) ((global-ref symbols) string))
|
||||
((p-expr (ident ,name)) ((ident-ref locals) name))
|
||||
(_
|
||||
(format (current-error-port) "SKIPPING expr=~a\n" o)
|
||||
(format (current-error-port) "SKIP expr->arg=~a\n" o)
|
||||
0))))
|
||||
|
||||
(define (ident->accu locals)
|
||||
(lambda (o)
|
||||
(i386:local->accu (assoc-ref locals o))))
|
||||
|
||||
(define (ident->base locals)
|
||||
(lambda (o)
|
||||
(i386:local->base (assoc-ref locals o))))
|
||||
|
||||
;; (define (global-accu symbols)
|
||||
;; (lambda (o)
|
||||
;; (lambda (s t d)
|
||||
;; (i386:accu-global (+ (data-offset o symbols) d)))))
|
||||
|
||||
(define (expr->accu symbols locals)
|
||||
(lambda (o)
|
||||
(pmatch o
|
||||
((p-expr (fixed ,value)) (string->number value))
|
||||
((p-expr (ident ,name)) ((ident->accu locals) name))
|
||||
(_
|
||||
(format (current-error-port) "SKIP expr-accu=~a\n" o)
|
||||
0)
|
||||
)))
|
||||
|
||||
(define (expr->symbols o)
|
||||
(pmatch o
|
||||
((p-expr (string ,string)) (string->symbols string))
|
||||
(_ #f)))
|
||||
|
||||
(define make-text+symbols cons)
|
||||
(define make-text+symbols+locals cons*)
|
||||
(define .text car)
|
||||
(define .symbols cdr)
|
||||
(define .symbols cadr)
|
||||
(define .locals cddr)
|
||||
|
||||
(define (dec->hex o)
|
||||
(number->string o 16))
|
||||
|
||||
(define (statement->text+symbols text+symbols)
|
||||
(define (text->list o)
|
||||
(append-map (lambda (f) (f '() 0 0)) o))
|
||||
|
||||
(define (statement->text+symbols+locals text+symbols+locals)
|
||||
(lambda (o)
|
||||
(let* ((text (.text text+symbols))
|
||||
(symbols (.symbols text+symbols))
|
||||
(text-list (append-map (lambda (f) (f '() 0 0)) text))
|
||||
;;(stderr "S=~a\n" o)
|
||||
(let* ((text (.text text+symbols+locals))
|
||||
(symbols (.symbols text+symbols+locals))
|
||||
(locals (.locals text+symbols+locals))
|
||||
(text-list (text->list text))
|
||||
(prefix-list (symbols->text symbols 0 0))
|
||||
(statement-offset (- (+ (length prefix-list) (length text-list)))))
|
||||
;; (stderr " tsl=~a\n" text+symbols+locals)
|
||||
;; (stderr " locals=~s\n" locals)
|
||||
(pmatch o
|
||||
((expr-stmt (fctn-call (p-expr (ident ,name))
|
||||
(expr-list (p-expr (string ,string)))))
|
||||
(make-text+symbols
|
||||
;;(stderr "S1 string=~a\n" string)
|
||||
(make-text+symbols+locals
|
||||
(append text
|
||||
(list (lambda (s t d)
|
||||
(i386:call (+ t
|
||||
(function-offset name s)
|
||||
statement-offset)
|
||||
(+ d (data-offset string s))))))
|
||||
(append symbols (list (string->symbols string)))));; FIXME: ->symbolSXX
|
||||
(i386:call s t d
|
||||
(+ t (function-offset name s)
|
||||
statement-offset)
|
||||
(+ d (data-offset string s))))))
|
||||
(append symbols (list (string->symbols string)))
|
||||
locals))
|
||||
|
||||
((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
|
||||
(let ((args (map (expr->arg symbols) expr-list)))
|
||||
(make-text+symbols
|
||||
;;(stderr "S1 expr-list=~a\n" expr-list)
|
||||
(let* ((symbols (append symbols (filter-map expr->symbols expr-list)))
|
||||
(args (map (expr->arg symbols locals) expr-list)))
|
||||
(make-text+symbols+locals
|
||||
(append text
|
||||
(list (lambda (s t d) (apply i386:call (cons (+ t (function-offset name s) statement-offset) args)))))
|
||||
(append symbols (filter-map expr->symbols expr-list)))))
|
||||
(list (lambda (s t d) (apply i386:call (cons* s t d (+ t (function-offset name s) statement-offset) args)))))
|
||||
symbols
|
||||
locals)))
|
||||
|
||||
((return (p-expr (fixed ,value)))
|
||||
((while ,test ,body)
|
||||
(let* ((t+s+l (make-text+symbols+locals '() symbols locals))
|
||||
|
||||
(body-t+s+l ((statement->text+symbols+locals t+s+l) body))
|
||||
(body-text (.text body-t+s+l))
|
||||
;;(body-symbols (.symbols body-t+s+l))
|
||||
(symbols (.symbols body-t+s+l))
|
||||
(body-locals (.locals body-t+s+l))
|
||||
(body-length (length (text->list body-text)))
|
||||
|
||||
(test-t+s+l ((statement->text+symbols+locals t+s+l) test))
|
||||
(test-text (.text test-t+s+l))
|
||||
(test-symbols (.symbols test-t+s+l))
|
||||
(test-locals (.locals test-t+s+l))
|
||||
(test-length (length (text->list test-text))))
|
||||
|
||||
(make-text+symbols+locals
|
||||
(append text
|
||||
(list (lambda (s t d) (i386:jump body-length)))
|
||||
body-text
|
||||
test-text
|
||||
(list (lambda (s t d) (i386:test-jump (- (+ body-length test-length))))))
|
||||
symbols
|
||||
locals)))
|
||||
|
||||
((array-ref (p-expr (ident ,name)) (p-expr (ident ,index)))
|
||||
(make-text+symbols+locals
|
||||
(append
|
||||
text
|
||||
(list
|
||||
(lambda (s t d)
|
||||
(append
|
||||
((ident->base locals) name)
|
||||
((ident->accu locals) index)
|
||||
(i386:mem-byte->accu)))))
|
||||
symbols
|
||||
locals))
|
||||
|
||||
((expr-stmt (post-inc (p-expr (ident ,name))))
|
||||
(make-text+symbols+locals
|
||||
(append text
|
||||
(list (lambda (s t d) (i386:local-add (assoc-ref locals name) 1))))
|
||||
symbols
|
||||
locals))
|
||||
|
||||
((return ,expr)
|
||||
(make-text+symbols+locals
|
||||
(append text (list (i386:ret ((expr->accu symbols locals) expr))))
|
||||
symbols
|
||||
locals))
|
||||
|
||||
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
|
||||
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
|
||||
(make-text+symbols+locals text symbols locals)))
|
||||
|
||||
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
|
||||
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))
|
||||
(value (string->number value)))
|
||||
(make-text+symbols+locals
|
||||
(append
|
||||
text
|
||||
(list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value))))
|
||||
symbols
|
||||
locals)))
|
||||
|
||||
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
|
||||
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
|
||||
(let* ((t+s+l (make-text+symbols+locals text symbols locals))
|
||||
(t+s+l ((statement->text+symbols+locals t+s+l)
|
||||
`(expr-stmt (fctn-call ,@call))))
|
||||
(text (.text t+s+l))
|
||||
(symbols (.symbols t+s+l))
|
||||
(locals (.locals t+s+l)))
|
||||
(make-text+symbols+locals
|
||||
(append
|
||||
text
|
||||
(list (lambda (s t d) (i386:ret-local (assoc-ref locals name)))))
|
||||
symbols
|
||||
locals))))
|
||||
|
||||
((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value))))
|
||||
|
||||
(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
|
||||
|
||||
(let ((value (string->number value)))
|
||||
(make-text+symbols (append text (list (lambda _ (i386:ret value)))) symbols)))
|
||||
(make-text+symbols+locals
|
||||
(append text (list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value))))
|
||||
symbols
|
||||
locals)))
|
||||
|
||||
((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call)))
|
||||
(let* ((t+s+l ((statement->text+symbols+locals text+symbols+locals)
|
||||
`(expr-stmt (fctn-call ,@call))))
|
||||
(text (.text t+s+l))
|
||||
(symbols (.symbols t+s+l))
|
||||
(locals (.locals t+s+l)))
|
||||
(make-text+symbols+locals
|
||||
(append text (list (lambda (s t d) (i386:ret-local (assoc-ref locals name)))))
|
||||
symbols
|
||||
locals)))
|
||||
|
||||
(_
|
||||
(format (current-error-port) "SKIPPING S=~a\n" o)
|
||||
text+symbols)))))
|
||||
(format (current-error-port) "SKIP statement=~a\n" o)
|
||||
text+symbols+locals)))))
|
||||
|
||||
(define (symbols->exe symbols)
|
||||
(display "dumping elf\n" (current-error-port))
|
||||
|
@ -133,58 +289,139 @@
|
|||
|
||||
(define (formal->text n)
|
||||
(lambda (o i)
|
||||
(case i
|
||||
((0) (list #x8b #x5d (* n 4))) ; mov $00(%ebp),%ebx
|
||||
((1) (list #x8b #x4d (* (- n 1) 4))) ; mov $00(%ebp),%ecx
|
||||
((2) (list #x8b #x55 (* (- n 2) 4))) ; mov $00(%ebp),%edx
|
||||
((3) (list #x8b #x45 (* (- n 3) 4)))))) ; mov $00(%ebp),%eax FIXME
|
||||
;;(i386:formal i n)
|
||||
'()
|
||||
))
|
||||
|
||||
(define (formals->text o)
|
||||
(pmatch o
|
||||
((param-list . ,formals)
|
||||
(let ((n (length formals)))
|
||||
(list (lambda (s t d)
|
||||
(append
|
||||
'(#x55 ; push %ebp
|
||||
#x89 #xe5) ; mov %esp,%ebp
|
||||
(append-map (formal->text n) formals (iota n))
|
||||
'(#x83 #xec #x10) ; sub $0x10,%esp -- 4 local vars
|
||||
)))))
|
||||
(_ (format (current-error-port) "formals->text+data: no match: ~a\n" o)
|
||||
(append
|
||||
(i386:function-preamble)
|
||||
(append-map (formal->text n) formals (iota n))
|
||||
(i386:function-locals))))))
|
||||
(_ (format (current-error-port) "formals->text: no match: ~a\n" o)
|
||||
barf)))
|
||||
|
||||
(define (formals->locals o)
|
||||
(pmatch o
|
||||
((param-list . ,formals)
|
||||
(let ((n (length formals)))
|
||||
(map cons (map .name formals) (iota n (1- (- n))))))
|
||||
(_ (format (current-error-port) "formals->symbols: no match: ~a\n" o)
|
||||
barf)))
|
||||
|
||||
(define (string->symbols string)
|
||||
(make-data string (string->list string)))
|
||||
(make-data string (append (string->list string) (list #\nul))))
|
||||
|
||||
(define (function->symbols symbols)
|
||||
(lambda (o)
|
||||
(format (current-error-port) "compiling ~a\n" (.name o))
|
||||
;;(stderr "formals=~a\n" (.formals o))
|
||||
(let* ((text (formals->text (.formals o)))
|
||||
(locals (formals->locals (.formals o)))
|
||||
(text-offset (length (symbols->text symbols 0 0))))
|
||||
(let loop ((statements (.statements o))
|
||||
(text+symbols (make-text+symbols text symbols)))
|
||||
(if (null? statements) (append (.symbols text+symbols) (list (make-function (.name o) (.text text+symbols))))
|
||||
(text+symbols+locals (make-text+symbols+locals text symbols locals)))
|
||||
(if (null? statements) (append (.symbols text+symbols+locals) (list (make-function (.name o) (.text text+symbols+locals))))
|
||||
(let* ((statement (car statements)))
|
||||
(loop (cdr statements)
|
||||
((statement->text+symbols text+symbols) (car statements)))))))))
|
||||
((statement->text+symbols+locals text+symbols+locals) (car statements)))))))))
|
||||
|
||||
(define _start
|
||||
(let* ((ast (with-input-from-string
|
||||
"int _start () {main(0,0);exit (0);}"
|
||||
"int _start () {int i;i=main (0,0);exit (i);}"
|
||||
parse-c99))
|
||||
(functions (filter ast:function? (cdr ast))))
|
||||
;;(pretty-print ast (current-error-port))
|
||||
(list (find (lambda (x) (equal? (.name x) "_start")) functions))))
|
||||
|
||||
(define libc
|
||||
(define strlen
|
||||
(let* ((ast (with-input-from-string
|
||||
"
|
||||
int
|
||||
strlen (char const* s)
|
||||
{
|
||||
int i = 0;
|
||||
while (s[i]) i++;
|
||||
return i;
|
||||
}
|
||||
"
|
||||
parse-c99))
|
||||
(functions (filter ast:function? (cdr ast))))
|
||||
;;(pretty-print ast (current-error-port))
|
||||
(list (find (lambda (x) (equal? (.name x) "strlen")) functions))))
|
||||
|
||||
(define eputs
|
||||
(let* ((ast (with-input-from-string
|
||||
"
|
||||
int
|
||||
eputs (char const* s)
|
||||
{
|
||||
//write (STDERR, s, strlen (s));
|
||||
//write (2, s, strlen (s));
|
||||
int i = strlen (s);
|
||||
write (2, s, i);
|
||||
return 0;
|
||||
}
|
||||
"
|
||||
parse-c99))
|
||||
(functions (filter ast:function? (cdr ast))))
|
||||
;;(pretty-print ast (current-error-port))
|
||||
(list (find (lambda (x) (equal? (.name x) "eputs")) functions))))
|
||||
|
||||
(define fputs
|
||||
(let* ((ast (with-input-from-string
|
||||
"
|
||||
int
|
||||
fputs (char const* s, int fd)
|
||||
{
|
||||
int i = strlen (s);
|
||||
write (fd, s, i);
|
||||
return 0;
|
||||
}
|
||||
"
|
||||
parse-c99))
|
||||
(functions (filter ast:function? (cdr ast))))
|
||||
;;(pretty-print ast (current-error-port))
|
||||
(list (find (lambda (x) (equal? (.name x) "fputs")) functions))))
|
||||
|
||||
(define puts
|
||||
(let* ((ast (with-input-from-string
|
||||
"
|
||||
int
|
||||
puts (char const* s)
|
||||
{
|
||||
//write (STDERR, s, strlen (s));
|
||||
//int i = write (STDERR, s, strlen (s));
|
||||
int i = strlen (s);
|
||||
write (1, s, i);
|
||||
return 0;
|
||||
}
|
||||
"
|
||||
parse-c99))
|
||||
(functions (filter ast:function? (cdr ast))))
|
||||
;;(pretty-print ast (current-error-port))
|
||||
(list (find (lambda (x) (equal? (.name x) "puts")) functions))))
|
||||
|
||||
(define i386:libc
|
||||
(list
|
||||
(make-function "eputs" (list i386:eputs))
|
||||
(make-function "exit" (list i386:exit))
|
||||
(make-function "puts" (list i386:puts))))
|
||||
(make-function "write" (list i386:write))))
|
||||
|
||||
(define libc
|
||||
(append
|
||||
strlen
|
||||
eputs
|
||||
fputs
|
||||
puts))
|
||||
|
||||
(define (compile)
|
||||
(let* ((ast (mescc))
|
||||
(functions (filter ast:function? (cdr ast)))
|
||||
(functions (append functions _start)))
|
||||
(let loop ((functions functions) (symbols libc))
|
||||
(functions (append libc functions _start)))
|
||||
(let loop ((functions functions) (symbols i386:libc))
|
||||
(if (null? functions) (symbols->exe symbols)
|
||||
(loop (cdr functions) ((function->symbols symbols) (car functions)))))))
|
||||
|
|
|
@ -24,45 +24,71 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(define (push-arg o)
|
||||
`(#x68 ,@(int->bv32 o))) ; push o
|
||||
(define (i386:function-preamble)
|
||||
'(#x55 ; push %ebp
|
||||
#x89 #xe5)) ; mov %esp,%ebp
|
||||
|
||||
(define (i386:function-locals)
|
||||
'(#x83 #xec #x10)) ; sub $0x10,%esp -- 4 local vars
|
||||
|
||||
;; (define (i386:formal i n)
|
||||
;; (case i
|
||||
;; ((0) (list #x8b #x5d (* (- n 2) 4))) ; mov $00(%ebp),%ebx
|
||||
;; ((1) (list #x8b #x4d (* (- n 3) 4))) ; mov $00(%ebp),%ecx
|
||||
;; ((2) (list #x8b #x55 (* (- n 4) 4))) ; mov $00(%ebp),%edx
|
||||
;; ((3) (list #x8b #x45 (* (- n 5) 4))))) ; mov $00(%ebp),%eax FIXME
|
||||
|
||||
(define (i386:ref-global o)
|
||||
`(#x68 ,@(int->bv32 o))) ; push $0x<o>
|
||||
|
||||
(define (i386:ref-local n)
|
||||
`(#xff #x75 ,(- 0 (* 4 n)))) ; pushl 0x<n>(%ebp)
|
||||
|
||||
(define (i386:push-arg s t d)
|
||||
(lambda (o)
|
||||
(cond ((number? o)
|
||||
`(#x68 ,@(int->bv32 o))) ; push $<o>
|
||||
((pair? o) o)
|
||||
((procedure? o) (o s t d)))))
|
||||
|
||||
(define (i386:ret . rest)
|
||||
(lambda (s t d)
|
||||
`(
|
||||
,@(cond ((null? rest) '())
|
||||
((number? (car rest))
|
||||
`(#xb8 ; mov $<>,%eax
|
||||
,@(int->bv32 (car rest))))
|
||||
((pair? (car rest)) (car rest))
|
||||
((procedure? (car rest))
|
||||
((car rest) s t d)))
|
||||
#xc9 ; leave
|
||||
#xc3 ; ret
|
||||
)))
|
||||
|
||||
(define (i386:local->accu n)
|
||||
`(#x8b #x45 ,(- 0 (* 4 n)))) ; mov -<0xn>(%ebp),%eax
|
||||
|
||||
(define (i386:local->base n)
|
||||
`(#x8b #x55 ,(- 0 (* 4 n)))) ; mov -<0xn>(%ebp),%edx
|
||||
|
||||
(define (i386:mem-byte->accu)
|
||||
'(#x01 #xd0 ; add %edx,%eax
|
||||
#x0f #xb6 #x00)) ; movzbl (%eax),%eax
|
||||
|
||||
(define (i386:local-add n v)
|
||||
`(#x83 #x45 ,(- 0 (* 4 n)) ,v)) ; addl $<v>,0x<n>(%ebp)
|
||||
|
||||
(define (i386:local-assign n v)
|
||||
`(#xc7 #x45 ,(- 0 (* 4 n)) ; movl $<v>,0x<n>(%ebp)
|
||||
,@(int->bv32 v)))
|
||||
|
||||
(define (i386:ret-local n)
|
||||
`(
|
||||
,@(if (null? rest) '()
|
||||
`(#xb8 ; mov $00,%eax
|
||||
,@(int->bv32 (car rest))))
|
||||
#xc9 ; leave
|
||||
#xc3 ; ret
|
||||
#x89 #x45 ,(- 0 (* 4 n)) ; mov %eax,-0x<n>(%ebp)
|
||||
))
|
||||
|
||||
;; #x83 #xec #x10 ; sub $0x10,%esp
|
||||
|
||||
;; #x8b #x45 #x04 ; mov 0x4(%ebp),%eax
|
||||
|
||||
;; #x8b #x5d #x04 ; mov 0x4(%ebp),%ebx
|
||||
;; #x8b #x45 #x08 ; mov 0x8(%ebp),%eax
|
||||
|
||||
;; #x8b #x4d #x04 ; mov 0xc(%ebp),%ecx
|
||||
;; #x8b #x5d #x08 ; mov 0x4(%ebp),%ebx
|
||||
;; #x8b #x45 #x0c ; mov 0x8(%ebp),%eax
|
||||
|
||||
;; #x8b #x55 #xfc ; mov 0x4(%ebp),%edx
|
||||
|
||||
|
||||
|
||||
;; #x8b #x5d #x08 ; mov $0x8(%ebp),%ebx
|
||||
|
||||
;; #x8b #x4d #x08 ; mov $0x8(%ebp),%ecx
|
||||
;; #x8b #x5d #x0c ; mov $0xc(%ebp),%ebx
|
||||
|
||||
;; #x8b #x55 #x08 ; mov $0x8(%ebp),%edx
|
||||
;; #x8b #x4d #x0c ; mov $0xc(%ebp),%ecx
|
||||
;; #x8b #x5d #x10 ; mov $0x10(%ebp),%ebx
|
||||
|
||||
|
||||
(define (i386:call address . arguments)
|
||||
(let* ((pushes (append-map push-arg arguments))
|
||||
(define (i386:call s t d address . arguments)
|
||||
(let* ((pushes (append-map (i386:push-arg s t d) arguments))
|
||||
(s (length pushes))
|
||||
(n (length arguments)))
|
||||
`(
|
||||
|
@ -71,52 +97,33 @@
|
|||
#x83 #xc4 ,(* n 4) ; add $00,%esp
|
||||
)))
|
||||
|
||||
(define (i386:eputs s t d)
|
||||
`(
|
||||
#x55 ; push %ebp
|
||||
#x89 #xe5 ; mov %esp,%ebp
|
||||
|
||||
;;;#x59 ; pop %ecx
|
||||
|
||||
#x8b #x4d #x08 ; mov $0x8(%ebp),%ecx
|
||||
;;#x8b #x5d #x0c ; mov $0xc(%ebp),%ebx
|
||||
|
||||
#xba #x01 #x00 #x00 #x00 ; mov $0x1,%edx
|
||||
|
||||
|
||||
#xbb #x02 #x00 #x00 #x00 ; mov $0x1,%ebx
|
||||
#xb8 #x04 #x00 #x00 #x00 ; mov $0x4,%eax
|
||||
#xcd #x80 ; int $0x80
|
||||
|
||||
#xc9 ; leave
|
||||
#xc3 ; ret
|
||||
))
|
||||
|
||||
(define (i386:exit s t d)
|
||||
`(
|
||||
#x5b ; pop %ebx
|
||||
#x5b ; pop %ebx
|
||||
;; FIXME: hack to get return value 41
|
||||
;; without local variable support in _start
|
||||
#x89 #xc3 ; mov %eax,%ebx
|
||||
#xb8 #x01 #x00 #x00 #x00 ; mov $0x1,%eax
|
||||
#xcd #x80 ; int $0x80
|
||||
))
|
||||
|
||||
(define (i386:puts s t d)
|
||||
(define (i386:write s t d)
|
||||
`(
|
||||
#x55 ; push %ebp
|
||||
#x89 #xe5 ; mov %esp,%ebp
|
||||
|
||||
#x8b #x4d #x08 ; mov $0x8(%ebp),%ecx
|
||||
;; #x8b #x5d #x0c ; mov $0xc(%ebp),%ebx
|
||||
#x8b #x5d #x10 ; mov $0x8(%ebp),%ebx
|
||||
#x8b #x4d #x0c ; mov $0xc(%ebp),%ecx
|
||||
#x8b #x55 #x08 ; mov $0x4(%ebp),%edx
|
||||
|
||||
#xba #x0a #x00 #x00 #x00 ; mov $0xa,%edx
|
||||
;; #x59 ; pop %ecx
|
||||
|
||||
#xbb #x01 #x00 #x00 #x00 ; mov $0x1,%ebx
|
||||
#xb8 #x04 #x00 #x00 #x00 ; mov $0x4,%eax
|
||||
#xcd #x80 ; int $0x80
|
||||
|
||||
#xc9 ; leave
|
||||
#xc3 ; ret
|
||||
))
|
||||
|
||||
(define (i386:jump n)
|
||||
`(#xeb ,(if (>= n 0) n (- n 2)))) ; jmp <n>
|
||||
|
||||
(define (i386:test-jump n)
|
||||
`(#x84 #xc0 ; test %al,%al
|
||||
#x75 ,(if (>= n 0) n (- n 4)))) ; jne <n>
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of Mes.
|
||||
;;;
|
||||
|
@ -29,10 +29,23 @@
|
|||
#:use-module (mes elf)
|
||||
#:export (i386:call
|
||||
i386:exit
|
||||
i386:for
|
||||
i386:formal
|
||||
i386:function-preamble
|
||||
i386:function-locals
|
||||
i386:eputs
|
||||
i386:jump
|
||||
i386:local-add
|
||||
i386:local-assign
|
||||
i386:local->accu
|
||||
i386:local->base
|
||||
i386:mem-byte->accu
|
||||
i386:puts
|
||||
i386:ref-global
|
||||
i386:ref-local
|
||||
i386:ret
|
||||
i386:ret-local
|
||||
i386:test-jump
|
||||
i386:write
|
||||
))
|
||||
|
||||
(cond-expand
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
* Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of Mes.
|
||||
*
|
||||
|
@ -148,6 +148,27 @@ eputs (char const* s)
|
|||
return 0;
|
||||
}
|
||||
|
||||
int g_a;
|
||||
int g_b;
|
||||
|
||||
#if 0
|
||||
void
|
||||
eputs2 (char const* s, int a)
|
||||
{
|
||||
g_a = a;
|
||||
write (STDERR, s, strlen (s));
|
||||
//return 0;
|
||||
}
|
||||
|
||||
void
|
||||
eputs3 (char const* s, int a, int b)
|
||||
{
|
||||
g_a = a;
|
||||
g_b = b;
|
||||
write (STDERR, s, strlen (s));
|
||||
//return 0;
|
||||
}
|
||||
|
||||
char const*
|
||||
itoa (int x)
|
||||
{
|
||||
|
@ -170,6 +191,7 @@ itoa (int x)
|
|||
|
||||
return p+1;
|
||||
}
|
||||
#endif
|
||||
|
||||
void
|
||||
assert_fail (char* s)
|
||||
|
@ -191,28 +213,41 @@ int
|
|||
main (int argc, char *argv[])
|
||||
{
|
||||
puts ("Hello main!\n");
|
||||
//eputs (itoa (123));
|
||||
eputs ("\n");
|
||||
puts ("Bye micro!!\n");
|
||||
//assert(!"boo");
|
||||
return 41;
|
||||
eputs ("Strlen...\n");
|
||||
puts ("Bye micro\n");
|
||||
int i = strlen ("02013");
|
||||
return i;
|
||||
}
|
||||
|
||||
#if __GNUC__
|
||||
// int
|
||||
// test1()
|
||||
// {
|
||||
// return 9;
|
||||
// }
|
||||
|
||||
// void
|
||||
// test()
|
||||
// {
|
||||
// int r;
|
||||
// r=7;
|
||||
// r=test1();
|
||||
// }
|
||||
|
||||
void
|
||||
_start ()
|
||||
{
|
||||
puts ("Hello micro-mes!\n");
|
||||
int r;
|
||||
asm (
|
||||
"push $0\n\t"
|
||||
"push $0\n\t"
|
||||
"call main\n\t"
|
||||
"movl %%eax,%0\n\t"
|
||||
: "=r" (r)
|
||||
: //no inputs "" (&main)
|
||||
);
|
||||
|
||||
exit (r);
|
||||
int i;
|
||||
i = main (0,0);
|
||||
// asm (
|
||||
// "push $0\n\t"
|
||||
// "push $0\n\t"
|
||||
// "call main\n\t"
|
||||
// "movl %%eax,%0\n\t"
|
||||
// : "=r" (r)
|
||||
// : //no inputs "" (&main)
|
||||
// );
|
||||
exit (i);
|
||||
}
|
||||
#endif
|
||||
|
|
Loading…
Reference in a new issue