mescc: Remove jump calculation, use labels: prepare.
* module/language/c99/compiler.mes (test-jump-label->info): New function. * module/mes/as-i386.mes (i386:jump-label-z,i386:jump-label-byte-z, i386:jump-label-g, i386:jump-label-ge,i386:jump-label-nz): New functions. * module/mes/as-i386.scm: Export them.
This commit is contained in:
Jan Nieuwenhuizen
parent
7cce8c6090
commit
5bf3c92938
|
|
@ -1153,6 +1153,60 @@
|
|||
|
||||
(_ ((jump i386:Xjump-z (wrap-as (i386:accu-zero?))) o)))))
|
||||
|
||||
(define (test-jump-label->info info label)
|
||||
(define (jump type . test)
|
||||
(lambda (o)
|
||||
(let* ((info ((ast->info info) o))
|
||||
(info (append-text info (wrap-as `(#:comment "jmp test LABEL"))))
|
||||
(jump-text (wrap-as (type `(#:local ,label)))))
|
||||
(append-text info (append (if (null? test) '() (car test))
|
||||
jump-text)))))
|
||||
(lambda (o)
|
||||
(pmatch o
|
||||
;; unsigned
|
||||
;; ((le ,a ,b) ((jump i386:jump-label-ncz) o)) ; ja
|
||||
;; ((lt ,a ,b) ((jump i386:jump-label-nc) o)) ; jae
|
||||
;; ((ge ,a ,b) ((jump i386:jump-label-ncz) o))
|
||||
;; ((gt ,a ,b) ((jump i386:jump-label-nc) o))
|
||||
|
||||
((le ,a ,b) ((jump i386:jump-label-g) o))
|
||||
((lt ,a ,b) ((jump i386:jump-label-ge) o))
|
||||
((ge ,a ,b) ((jump i386:jump-label-g) o))
|
||||
((gt ,a ,b) ((jump i386:jump-label-ge) o))
|
||||
|
||||
((ne ,a ,b) ((jump i386:jump-label-nz) o))
|
||||
((eq ,a ,b) ((jump i386:jump-label-nz) o))
|
||||
((not _) ((jump i386:jump-label-z) o))
|
||||
|
||||
((and ,a ,b)
|
||||
(let* ((info ((test-jump-label->info info label) a))
|
||||
(info ((test-jump-label->info info label) b)))
|
||||
info))
|
||||
|
||||
((or ,a ,b)
|
||||
(let* ((here (number->string (length (.text info))))
|
||||
(skip-b-label (string-append label "_skip_b_" here))
|
||||
(b-label (string-append label "_b_" here))
|
||||
(info ((test-jump-label->info info b-label) a))
|
||||
(info (append-text info (wrap-as (i386:jump-label `(#:local ,skip-b-label)))))
|
||||
(info (append-text info (wrap-as `(#:label ,b-label))))
|
||||
(info ((test-jump-label->info info label) b))
|
||||
(info (append-text info (wrap-as `(#:label ,skip-b-label)))))
|
||||
info))
|
||||
|
||||
((array-ref . _) ((jump i386:jump-label-byte-z
|
||||
(wrap-as (i386:accu-zero?))) o))
|
||||
|
||||
((de-ref _) ((jump i386:jump-label-byte-z
|
||||
(wrap-as (i386:accu-zero?))) o))
|
||||
|
||||
((assn-expr (p-expr (ident ,name)) ,op ,expr)
|
||||
((jump i386:jump-label-z
|
||||
(append ((ident->accu info) name)
|
||||
(wrap-as (i386:accu-zero?)))) o))
|
||||
|
||||
(_ ((jump i386:jump-label-z (wrap-as (i386:accu-zero?))) o)))))
|
||||
|
||||
(define (cstring->number s)
|
||||
(cond ((string-prefix? "0x" s) (string->number (string-drop s 2) 16))
|
||||
((string-prefix? "0b" s) (string->number (string-drop s 2) 2))
|
||||
|
|
|
|||
|
|
@ -349,6 +349,27 @@
|
|||
(define (i386:jump-label label)
|
||||
`(#xe9 ,label #f #f #f)) ; jmp . + <n>
|
||||
|
||||
(define (i386:jump-label-z label)
|
||||
`(#x0f #x84 ,label #f #f #f)) ; jz . + <n>
|
||||
|
||||
(define (i386:jump-label-byte-z label)
|
||||
`(#x84 #xc0 ; test %al,%al
|
||||
#x74 ,label)) ; jne <n>
|
||||
|
||||
;; signed
|
||||
(define (i386:jump-label-g label)
|
||||
`(#x0f #x8f ,label #f #f #f)) ; jg/jnle <n>
|
||||
|
||||
;; signed
|
||||
(define (i386:jump-label-ge label)
|
||||
`(#x0f #x8d ,label #f #f #f)) ; jge/jnl <n>
|
||||
|
||||
(define (i386:jump-label-nz label)
|
||||
`(#x0f #x85 ,label #f #f #f)) ; jnz . + <n>
|
||||
|
||||
(define (i386:jump-label-z label)
|
||||
`(#x0f #x84 ,label #f #f #f)) ; jz . + <n>
|
||||
|
||||
(define (i386:Xjump-nz n)
|
||||
(or n (error "invalid value: i386:Xjump-nz: n: " n))
|
||||
`(#x0f #x85 ,@(int->bv32 n))) ; jnz . + <n>
|
||||
|
|
|
|||
|
|
@ -79,8 +79,15 @@
|
|||
i386:label->base
|
||||
i386:label-mem->accu
|
||||
i386:label-mem->base
|
||||
|
||||
i386:jump
|
||||
i386:jump-label
|
||||
i386:jump-label-byte-z
|
||||
i386:jump-label-g
|
||||
i386:jump-label-ge
|
||||
i386:jump-label-nz
|
||||
i386:jump-label-z
|
||||
|
||||
i386:jump-byte-nz
|
||||
i386:jump-byte-z
|
||||
i386:jump-c
|
||||
|
|
|
|||
|
|
@ -84,33 +84,35 @@
|
|||
(if (null? text) '()
|
||||
(let ((label (car text)))
|
||||
(if (number? label) (cons label (loop (cdr text) (1+ off)))
|
||||
(if (and (pair? label) (member (car label) '(#:comment #:label)))
|
||||
(loop (cdr text) off)
|
||||
(let* ((prefix (if (and (pair? (cdr text))
|
||||
(pair? (cddr text))
|
||||
(boolean? (caddr text))) 4
|
||||
2))
|
||||
;;(foo (format (current-error-port) "LABEL=~s\n" label))
|
||||
(address? (and (pair? label) (eq? (car label) #:address)))
|
||||
(local? (and (pair? label) (eq? (car label) #:local)))
|
||||
(relative? (and (pair? label) (eq? (car label) #:relative)))
|
||||
(label (if (or address? local? relative?) (cadr label) label))
|
||||
(function-address (function-offset label functions))
|
||||
(data-address (data-offset label globals))
|
||||
(label-address (label-offset (car o) `((#:label ,label)) functions))
|
||||
;; (foo (format (current-error-port) " address?=~s\n" address?))
|
||||
;; (foo (format (current-error-port) " d=~s\n" data-address))
|
||||
;; (foo (format (current-error-port) " f=~s\n" function-address))
|
||||
;; (foo (format (current-error-port) " l=~s\n" label-address))
|
||||
(address (or (and local?
|
||||
(and=> label-address (lambda (a) (- a (- off offset) prefix))))
|
||||
(and=> data-address (lambda (a) (+ a d)))
|
||||
(if address?
|
||||
(and=> function-address (lambda (a) (+ a ta)))
|
||||
(and=> function-address (lambda (a) (- a off prefix))))
|
||||
(error "unresolved label: " label))))
|
||||
(append ((if (= prefix 2) int->bv16 int->bv32) address)
|
||||
(loop (list-tail text prefix) (+ off prefix))))))))))))
|
||||
(if (and (pair? label) (member (car label) '(#:comment #:label))) (loop (cdr text) off)
|
||||
(let* ((prefix (cond ((and (pair? (cdr text))
|
||||
(pair? (cddr text))
|
||||
(boolean? (caddr text))) 4)
|
||||
((and (pair? (cdr text))
|
||||
(boolean? (cadr text))) 2)
|
||||
(else 1)))
|
||||
;; (foo (format (current-error-port) "LABEL=~s\n" label))
|
||||
;; (foo (format (current-error-port) " prefix=~s\n" prefix))
|
||||
(address? (and (pair? label) (eq? (car label) #:address)))
|
||||
(local? (and (pair? label) (eq? (car label) #:local)))
|
||||
(relative? (and (pair? label) (eq? (car label) #:relative)))
|
||||
(label (if (or address? local? relative?) (cadr label) label))
|
||||
(function-address (function-offset label functions))
|
||||
(data-address (data-offset label globals))
|
||||
(label-address (label-offset (car o) `((#:label ,label)) functions))
|
||||
;; (foo (format (current-error-port) " address?=~s\n" address?))
|
||||
;; (foo (format (current-error-port) " d=~s\n" data-address))
|
||||
;; (foo (format (current-error-port) " f=~s\n" function-address))
|
||||
;; (foo (format (current-error-port) " l=~s\n" label-address))
|
||||
(address (or (and local?
|
||||
(and=> label-address (lambda (a) (- a (- off offset) prefix))))
|
||||
(and=> data-address (lambda (a) (+ a d)))
|
||||
(if address?
|
||||
(and=> function-address (lambda (a) (+ a ta)))
|
||||
(and=> function-address (lambda (a) (- a off prefix))))
|
||||
(error "unresolved label: " label))))
|
||||
(append ((case prefix ((1) list) ((2) int->bv16) ((4) int->bv32)) address)
|
||||
(loop (list-tail text prefix) (+ off prefix))))))))))))
|
||||
|
||||
(define (function-prefix name functions)
|
||||
;; FIXME
|
||||
|
|
|
|||
|
|
@ -123,62 +123,80 @@
|
|||
16)))
|
||||
((char? o) (dec->hex (char->integer o)))
|
||||
((and (pair? o) (eq? (car o) #:string))
|
||||
(format #f "&~a" (string->label (cadr o))))
|
||||
(format #f "&~a" (string->label o)))
|
||||
((string? o) (format #f "~a" o))
|
||||
(else (format #f "~a" o))))
|
||||
(define (write-line o)
|
||||
(newline)
|
||||
(cond ((not (pair? o))
|
||||
(display (dec->hex o)))
|
||||
((number? (car o))
|
||||
;;(display (string-join (map dec->hex (filter identity o)) " "))
|
||||
(let ((text (let loop ((text o))
|
||||
(if (null? text) '()
|
||||
(let ((label (car text)))
|
||||
(if (number? label) (cons label (loop (cdr text)))
|
||||
(if (and (pair? label) (member (car label) '(#:comment #:label))) (loop (cdr text))
|
||||
(let* ((prefix (if (and (pair? (cdr text))
|
||||
(pair? (cddr text))
|
||||
(boolean? (caddr text))) 4
|
||||
2))
|
||||
(address? (and (pair? label) (eq? (car label) #:address)))
|
||||
(local? (and (pair? label) (eq? (car label) #:local)))
|
||||
(relative? (and (pair? label) (eq? (car label) #:relative)))
|
||||
(label (if (or address? local? relative?) (cadr label) label))
|
||||
(function? (member label function-names))
|
||||
(string-label (string->label label))
|
||||
(string? (not (equal? string-label "string_#f")))
|
||||
(global? (member label global-names)))
|
||||
(cons (cond
|
||||
((eq? prefix 1) (format #f "!~a" label))
|
||||
((eq? prefix 2) (format #f "@~a" label))
|
||||
(local? (format #f "%local_~a" label))
|
||||
(function? (format #f "%~a" label))
|
||||
(string? (format #f "&~a" string-label))
|
||||
(global? (format #f "&~a" label))
|
||||
(else (format #f "%~a" label)))
|
||||
(loop (list-tail text prefix)))))))))))
|
||||
(display (string-join (map dec->hex text) " "))))
|
||||
((member (car o) '(#:comment))
|
||||
(format #t "# ~a" (cadr o)))
|
||||
((eq? (car o) #:label)
|
||||
(format #t ":~a\n" (cadr o)))
|
||||
((and (pair? (car o)) (eq? (caar o) #:label))
|
||||
(format #t ":~a\n" (cadar o)))
|
||||
((and (pair? (car o)) (member (caar o) '(#:comment)))
|
||||
(format #t "# ~a" (cadar o)))
|
||||
((and (pair? (car o)) (member (caar o) '(#:comment #:label)))
|
||||
(write (car o)))
|
||||
(else (error "write-line LINE:" o))))
|
||||
(define (write-line function)
|
||||
(lambda (o)
|
||||
(newline)
|
||||
(cond ((not (pair? o))
|
||||
(display (dec->hex o)))
|
||||
((number? (car o))
|
||||
;;(display (string-join (map dec->hex (filter identity o)) " "))
|
||||
;; FIXME: c&p from elf-util: function->text
|
||||
(let ((text (let loop ((text o))
|
||||
(if (null? text) '()
|
||||
(let ((label (car text)))
|
||||
(if (number? label) (cons label (loop (cdr text)))
|
||||
(if (and (pair? label) (member (car label) '(#:comment #:label))) (loop (cdr text))
|
||||
(let* ((prefix (cond ((and (pair? (cdr text))
|
||||
(pair? (cddr text))
|
||||
(boolean? (caddr text))) 4)
|
||||
((and (pair? (cdr text))
|
||||
(boolean? (cadr text))) 2)
|
||||
(else 1)))
|
||||
(address? (and (pair? label) (eq? (car label) #:address)))
|
||||
(local? (and (pair? label) (eq? (car label) #:local)))
|
||||
(relative? (and (pair? label) (eq? (car label) #:relative)))
|
||||
(label (if (or address? local? relative?) (cadr label) label))
|
||||
(function? (member label function-names))
|
||||
(string-label (string->label label))
|
||||
(string? (not (equal? string-label "string_#f")))
|
||||
(global? (member label global-names))
|
||||
(label (if local? (string-append "local_" function "_" label) label)))
|
||||
(cons (cond
|
||||
((eq? prefix 1) (format #f "!~a" label))
|
||||
((eq? prefix 2) (format #f "@~a" label))
|
||||
(local? (format #f "%~a" label))
|
||||
(function? (if address? (format #f "&~a" label)
|
||||
(format #f "%~a" label)))
|
||||
(string? (format #f "&~a" string-label))
|
||||
(global? (format #f "&~a" label))
|
||||
(else (format #f "%~a" label)))
|
||||
(loop (list-tail text prefix)))))))))))
|
||||
(display (string-join (map dec->hex text) " "))))
|
||||
((member (car o) '(#:comment))
|
||||
(format #t "# ~s" (cadr o)))
|
||||
((eq? (car o) #:label)
|
||||
(format #t ":local_~a_~a\n" function (cadr o)))
|
||||
((and (pair? (car o)) (eq? (caar o) #:label))
|
||||
(format #t ":local_~a\n" (cadar o)))
|
||||
((and (pair? (car o)) (member (caar o) '(#:comment)))
|
||||
(format #t "# ~s" (cadar o)))
|
||||
((and (pair? (car o)) (member (caar o) '(#:comment #:label)))
|
||||
(write (car o)))
|
||||
(else (error "write-line LINE:" o)))))
|
||||
(define (write-function o)
|
||||
(format #t "\n\n:~a" (car o))
|
||||
(if (pair? (cadr o)) (for-each write-line (cdr o))
|
||||
(write-line (cdr o))))
|
||||
(if (pair? (cadr o)) (for-each (write-line (car o)) (cdr o))
|
||||
((write-line (car o)) (cdr o))))
|
||||
(define (write-global o)
|
||||
(let ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
|
||||
(string->label (car o)))))
|
||||
(define (labelize o)
|
||||
(if (not (string? o)) o
|
||||
(let* ((label o)
|
||||
(function? (member label function-names))
|
||||
(string-label (string->label label))
|
||||
(string? (not (equal? string-label "string_#f")))
|
||||
(global? (member label global-names)))
|
||||
(if (or global? string?) (format #f "&~a" label)
|
||||
(begin (if (not function?) (stderr "warning: unresolved label: ~s\n" label))
|
||||
(format #f "&~a" label))))))
|
||||
(let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
|
||||
(string->label (car o))))
|
||||
(data (cdr o))
|
||||
(data (filter-map labelize data)))
|
||||
(format #t "\n:~a\n" label)
|
||||
(display (string-join (map dec->hex (cdr o)) " "))
|
||||
(display (string-join (map dec->hex data) " "))
|
||||
(newline)))
|
||||
(display "### stage0's hex2 format for x86\n")
|
||||
(display "### !<label> 1 byte relative\n")
|
||||
|
|
|
|||
|
|
@ -76,7 +76,6 @@ SCM cell_fun;
|
|||
|
||||
char *env[] = {"foo", "bar", "baz", 0};
|
||||
|
||||
#if 1
|
||||
int
|
||||
add (int a, int b)
|
||||
{
|
||||
|
|
@ -95,6 +94,7 @@ identity (int i)
|
|||
return i;
|
||||
}
|
||||
|
||||
#if 1
|
||||
int
|
||||
label (int c)
|
||||
{
|
||||
|
|
@ -584,7 +584,9 @@ void
|
|||
void_func ()
|
||||
{
|
||||
}
|
||||
#endif
|
||||
|
||||
#if 1
|
||||
int
|
||||
test (char *p)
|
||||
{
|
||||
|
|
@ -809,7 +811,7 @@ test (char *p)
|
|||
puts ("t: while (1) ... break;\n");
|
||||
while (1) {f=0;break;}
|
||||
|
||||
puts ("t: while (1) ... break;\n");
|
||||
puts ("t: while (1) {while (1) break;break;}\n");
|
||||
while (1) {while (1) break;break;}
|
||||
|
||||
puts ("t: while (1) { goto label; };\n");
|
||||
|
|
|
|||
|
|
@ -61,8 +61,8 @@
|
|||
#65 01 00 00 # p_filesz
|
||||
#65 01 00 00 # p_memsz
|
||||
|
||||
00 20 00 00 # p_filesz
|
||||
00 20 00 00 # p_memsz
|
||||
ff ff 00 00 # p_filesz
|
||||
ff ff 00 00 # p_memsz
|
||||
|
||||
|
||||
07 00 00 00 # p_flags
|
||||
|
|
|
|||
Loading…
Reference in a new issue