mescc: Unify labels.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 11 Jun 2017 16:05:56 +0000 (18:05 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 11 Jun 2017 16:05:56 +0000 (18:05 +0200)
* module/language/c99/compiler.mes: Use (#:address label) (#local
  label) (#:relative label) thoughout.
* module/mes/elf-util.mes (add-s:-prefix, drop-s:-prefix): Remove.
  (function->text): Update.
* module/mes/hex2.mes (write-hex2): Update.

module/language/c99/compiler.mes
module/mes/elf-util.mes
module/mes/elf-util.scm
module/mes/hex2.mes
module/mes/hex2.scm

index e37c17d8bf254c98eeab59f16396815ae0414a52..a16f782461dbf9e1e14cdb452c61c141e3abc000 100644 (file)
 
 (define (push-global globals)
   (lambda (o)
-    (list (i386:push-label-mem o))))
+    (list (i386:push-label-mem `(#:address ,o)))))
 
 (define (push-local locals)
   (lambda (o)
           (error "TODO int-de-de-ref")))))
 
 (define (string->global string)
-  (make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul))))
+  (make-global `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
 
 (define (int->global value)
-  (make-global (add-s:-prefix (number->string value)) "int" 0 (int->bv32 value)))
+  (make-global `(#:string ,(number->string value)) "int" 0 (int->bv32 value)))
 
 (define (ident->global name type pointer value)
   (make-global name type pointer (if (pair? value) value (int->bv32 value))))
                   (if constant
                       (wrap-as (append (i386:value->accu constant)
                                        (i386:push-accu)))
-                      ((push-global-address #f) `(address ,o))))))))))
+                      ((push-global-address #f) `(#:address ,o))))))))))
 
 (define (push-ident-address info)
   (lambda (o)
           (let ((global (assoc-ref (.globals info) o)))
           (if global
               ((push-global-address (.globals info)) o)
-              ((push-global-address #f) `(address ,o))))))))
+              ((push-global-address #f) `(#:address ,o))))))))
 
 (define (push-ident-de-ref info)
   (lambda (o)
 
 (define (globals:add-string globals)
   (lambda (o)
-    (let ((string (add-s:-prefix o)))
+    (let ((string `(#:string ,o)))
       (if (assoc-ref globals string) globals
           (append globals (list (string->global o)))))))
 
         ((p-expr (string ,string))
          (let* ((globals ((globals:add-string (.globals info)) string))
                 (info (clone info #:globals globals)))
-           (append-text info ((push-global-address info) (add-s:-prefix string)))))
+           (append-text info ((push-global-address info) `(#:string ,string)))))
 
         ((p-expr (ident ,name))
          (append-text info ((push-ident info) name)))
                      (size (if (= ptr 1) (type->size info type)
                                4)))
                 (case ptr
-                  ((-1) (list (i386:label->accu o)))
-                  ((1) (list (i386:label-mem->accu o)))
-                  ((2) (list (i386:label->accu o)))
-                  (else (list (i386:label-mem->accu o)))))
+                  ((-1) (list (i386:label->accu `(#:address ,o))))
+                  ((1) (list (i386:label-mem->accu `(#:address ,o))))
+                  ((2) (list (i386:label->accu `(#:address ,o))))
+                  (else (list (i386:label-mem->accu `(#:address ,o))))))
               (if constant (wrap-as (i386:value->accu constant))
-                  (list (i386:label->accu `(address ,o)))))))))
+                  (list (i386:label->accu `(#:address ,o)))))))))
 
 (define (ident-address->accu info)
   (lambda (o)
                        (size (if (= ptr 1) (type->size info type)
                                  4)))
             (wrap-as (i386:local-ptr->accu (local:id local))))
-          (if global (list (i386:label->accu o))
-              (list (i386:label->accu `(address ,o))))))))
+          (if global (list (i386:label->accu `(#:address ,o)))
+              (list (i386:label->accu `(#:address ,o))))))))
 
 (define (ident-address->base info)
   (lambda (o)
                  (size (if (= ptr 1) (type->size info type)
                            4)))
             (wrap-as (i386:local-ptr->base (local:id local))))
-          (if global (list (i386:label->base o))
-              (list (i386:label->accu `(address ,o))))))))
+          (if global (list (i386:label->base `(#:address ,o)))
+              (list (i386:label->accu `(#:address ,o))))))))
 
 (define (value->accu v)
   (wrap-as (i386:value->accu v)))
     (let ((local (assoc-ref (.locals info) o)))
       (if local (wrap-as (i386:accu->local (local:id local)))
           (let ((ptr (ident->pointer info o)))
-            (list (i386:accu->label o)))))))
+            (list (i386:accu->label `(#:address ,o))))))))
 
 (define (base->ident info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
       (if local (wrap-as (i386:base->local (local:id local)))
-          (list (i386:base->label o))))))
+          (list (i386:base->label `(#:address ,o)))))))
 
 (define (base->ident-address info)
   (lambda (o)
   (lambda (o value)
     (let ((local (assoc-ref (.locals info) o)))
       (if local (wrap-as (i386:value->local (local:id local) value))
-          (list (i386:value->label o value))))))
+          (list (i386:value->label `(#:address ,o) value))))))
 
 (define (ident-add info)
   (lambda (o n)
     (let ((local (assoc-ref (.locals info) o)))
       (if local (wrap-as (i386:local-add (local:id local) n))
-          (list (i386:label-mem-add o n))))))
+          (list (i386:label-mem-add `(#:address ,o) n))))))
 
 (define (ident-address-add info)
   (lambda (o n)
                                  (i386:accu-mem-add n)
                                  (i386:pop-accu)))
           (list (wrap-as (append (i386:push-accu)
-                                 (i386:label->accu o)
+                                 (i386:label->accu `(#:address ,o))
                                  (i386:accu-mem-add n)
                                  (i386:pop-accu))))))))
 
             (if global
                 (let ((ptr (ident->pointer info o)))
                   (case ptr
-                    ((-1) (list (i386:label->base o)))
-                    ((2) (list (i386:label->base o)))
-                    (else (list (i386:label-mem->base o)))))
+                    ((-1) (list (i386:label->base `(#:address ,o))))
+                    ((2) (list (i386:label->base `(#:address ,o))))
+                    (else (list (i386:label-mem->base `(#:address ,o))))))
                 (let ((constant (assoc-ref (.constants info) o)))
                   (if constant (wrap-as (i386:value->base constant))
-                      (list (i386:label->base `(address ,o)))))))))))
+                      (list (i386:label->base `(#:address ,o)))))))))))
 
 (define (expr->accu info)
   (lambda (o)
         ((p-expr (string ,string))
          (let* ((globals (append globals (list (string->global string))))
                 (info (clone info #:globals globals)))
-           (append-text info (list (i386:label->accu (add-s:-prefix string))))))
+           (append-text info (list (i386:label->accu `(#:string ,string))))))
 
         ((p-expr (string . ,strings))
-         (append-text info (list (i386:label->accu (add-s:-prefix (apply string-append strings))))))
+         (append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
         ((p-expr (fixed ,value))
          (append-text info (value->accu (cstring->number value))))
 
                      (if (and (not (assoc name (.functions info)))
                               (not (assoc name globals)))
                          (stderr "warning: undeclared function: ~a\n" name))
-                     (append-text args-info (list (i386:call-label name n))))
+                     (append-text args-info (list (i386:call-label `(#:relative ,name) n))))
                    (let* ((empty (clone info #:text '()))
                           (accu ((expr->accu empty) `(p-expr (ident ,name)))))
                      (append-text args-info (append (.text accu)
         ((goto (ident ,label))
          (let* ((jump (lambda (n) (i386:XXjump n)))
                 (offset (+ (length (jump 0)) (length (object->list text)))))
-           (append-text info (list (i386:jump-label `(label ,label))))))
+           (append-text info (list (i386:jump-label `(#:local ,label))))))
 
         ((return ,expr)
          (let ((info ((expr->accu info) expr)))
                     (globals (append globals (list (string->global string))))
                     (info (clone info #:locals locals #:globals globals)))
                (append-text info (append
-                                  (list (i386:label->accu (add-s:-prefix string)))
+                                  (list (i386:label->accu `(#:string ,string)))
                                   ((accu->ident info) name))))
              (let* ((global (string->global string))
                     (globals (append globals (list global)))
                   (append text
                           (.text accu)
                           ((accu->ident info) name)
-                          (wrap-as (append (i386:label->base '(address "_start"))
+                          (wrap-as (append (i386:label->base `(#:address "_start"))
                                            (i386:accu+base))))
                   #:locals locals)))
 
     ((initzer (p-expr (fixed ,value))) (int->bv32 (cstring->number value)))
     ((initzer (neg (p-expr (fixed ,value)))) (int->bv32 (- (cstring->number value))))
     ((initzer (ref-to (p-expr (ident ,name)))) `(,name #f #f #f))
-    ((initzer (p-expr (string ,string))) `(,(add-s:-prefix string) #f #f #f))
+    ((initzer (p-expr (string ,string))) `((#:string ,string) #f #f #f))
     (_ (error "initzer->data: unsupported: " o))))
 
 (define (.formals o)
index aa24720a2009f91c2087ff728b984f81ef00aed0..be67aa6ebb3859ffa024b224149e4d81ab1d077f 100644 (file)
@@ -50,9 +50,6 @@
 (define global:pointer cadr)
 (define global:value caddr)
 
-(define (drop-s:-prefix o) (substring o 2))
-(define (add-s:-prefix o) (string-append "s:" o))
-
 (define (dec->hex o)
   (cond ((number? o) (number->string o 16))
         ((char? o) (number->string (char->integer o) 16))
         (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))) ;;(cons #x90 (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))
-                          ;; FiXME: address vs relative address
-                          (address? (and (pair? label) (member (car label) '(address))))
-                          (label (if address? (cadr label) 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) (and (pair? label)
-                                                                    `((#:label ,(cadr label)))) functions))
+                          (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=> data-address (lambda (a) (+ a d)))
+                          (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))))
-                                       (and=> label-address (lambda (a) (- a (- off offset) prefix)))
                                        (error "unresolved label: " label))))
                      (append ((if (= prefix 2) int->bv16 int->bv32) address)
                              (loop (list-tail text prefix) (+ off prefix))))))))))))
index 533ea1e5e406e35b823f172e05fd366ac6715eb9..8ab1ad624c7b4729f9e1428e44b9588262a3460e 100644 (file)
@@ -27,8 +27,6 @@
   #:use-module (mes bytevectors)
   #:export (data-offset
             dec->hex
-            add-s:-prefix
-            drop-s:-prefix
             function-offset
             int->bv16
             int->bv32
index 5c0e9de511834be7fdb2ac848870abaaeb18a02b..2c5096a97727ca9e380a9feea3d1532dd0dece32 100644 (file)
@@ -28,7 +28,6 @@
  (guile)
  (mes
   (mes-use-module (srfi srfi-1))
-  (mes-use-module (srfi srfi-26))
   (mes-use-module (mes elf-util))
   (mes-use-module (mes elf))
   (mes-use-module (mes optargs))))
          (function-names (map car functions))
          (globals (assoc-ref o 'globals))
          (global-names (map car globals))
-         (strings (filter (cut string-prefix? "s:" <>) global-names)))
+         (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names)))
     (define (string->label o)
       (format #f "string_~a" (list-index (lambda (s) (equal? s o)) strings)))
     (define (dec->hex o)
                                          (if (>= o 0) o (+ o #x100))
                                          16)))
             ((char? o) (dec->hex (char->integer o)))
-            ((and (string? o) (string-prefix? "s:" o))
-             (format #f "&~a" (string->label o)))
+            ((and (pair? o) (eq? (car o) #:string))
+             (format #f "&~a" (string->label (cadr o))))
             ((string? o) (format #f "~a" o))
             (else (format #f "~a" o))))
     (define (write-line o)
                                                                  (pair? (cddr text))
                                                                  (boolean? (caddr text))) 4
                                                                  2))
-                                                (address? (and (pair? label) (member (car label) '(address))))
-                                                (label (if address? (cadr label) 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? (member label function-names))
                                                 (string-label (string->label label))
                                                 (string? (not (equal? string-label "string_#f")))
-                                                (global? (member label global-names))
-                                                (label? (and (pair? label) (eq? (car label) #:label))))
+                                                (global? (member label global-names)))
                                            (cons (cond
                                                   ((eq? prefix 1) (format #f "!~a" label))
                                                   ((eq? prefix 2) (format #f "@~a" label))
-                                                  (label? (format #f "%label_~a" label))
+                                                  (local? (format #f "%local_~a" label))
                                                   (function? (format #f "%~a" label))
                                                   (string? (format #f "&~a" string-label))
                                                   (global? (format #f "&~a" label))
       (if (pair? (cadr o)) (for-each write-line (cdr o))
           (write-line (cdr o))))
     (define (write-global o)
-      (let ((label (if (not (string-prefix? "s:" (car o))) (car o)
+      (let ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
                        (string->label (car o)))))
         (format #t "\n:~a\n" label)
         (display (string-join (map dec->hex (cdr o)) " "))
     (display "###    @<label>          2 byte relative\n")
     (display "###    &<label>          4 byte address\n")
     (display "###    %<label>          4 byte relative\n")
-    (display "###    label_<label>     function-local\n")
+    (display "###    local_<label>     function-local\n")
     (display "###    string_<index>    string #<index>\n")
     (display "\n##.text")
     (for-each write-function (filter cdr functions))
index 5f660e67b83f30a42c3839825ac832310eae6b5e..f16ee436739ae427a15ac4dd5041d2d9bed7f4fb 100644 (file)
@@ -24,7 +24,6 @@
 
 (define-module (mes hex2)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
   #:use-module (mes elf-util)
   #:use-module (mes elf)
   #:export (objects->hex2