mescc: Remove jump calculation, use labels: prepare.
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 12 Jun 2017 19:00:50 +0000 (21:00 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 12 Jun 2017 19:00:50 +0000 (21:00 +0200)
* 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.

module/language/c99/compiler.mes
module/mes/as-i386.mes
module/mes/as-i386.scm
module/mes/elf-util.mes
module/mes/hex2.mes
scaffold/t.c
stage0/elf32.hex2

index 91e91877774492a6d33e97a181f86471d87e9cd8..ffda180c8a370c131283bb9defcc42a10c17f800 100644 (file)
 
       (_ ((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))
index b2f8065f1bbdc1b194ad554aa8ef9214e4b9c2eb..ae667d85fabc5a2f638187b870043347de60f525 100644 (file)
 (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>
index b52a24ff512f8432ff2b6cf1c1f00ec9a7a9fbc5..f324b8ca08ae79aeb020602a698012123da21f47 100644 (file)
             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
index be67aa6ebb3859ffa024b224149e4d81ab1d077f..5dd55a47686595761c3002019f8d0ced9bbceda9 100644 (file)
         (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
index 2c5096a97727ca9e380a9feea3d1532dd0dece32..e311ff2f7d1b1bd36a34a636ec9d374f0d68b73b 100644 (file)
                                          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")
index db891844383afb7f1cb26dd730352b70d047f771..c54b2f277e72c52c37e1b4592dae8c4e6e4b3ec9 100644 (file)
@@ -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");
index f09f0ec820760b780fcdd593754bb717ffb5b87d..11c8dd2cae7dc538040f63e330482fb496b39053 100644 (file)
@@ -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