From d46994f2fe063d010679644413216de7ed7c53f1 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 11 Jun 2017 18:05:56 +0200 Subject: [PATCH] mescc: Unify labels. * 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 | 64 ++++++++++++++++---------------- module/mes/elf-util.mes | 20 +++++----- module/mes/elf-util.scm | 2 - module/mes/hex2.mes | 22 +++++------ module/mes/hex2.scm | 1 - 5 files changed, 52 insertions(+), 57 deletions(-) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index e37c17d8..a16f7824 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -217,7 +217,7 @@ (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) @@ -255,10 +255,10 @@ (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)))) @@ -286,7 +286,7 @@ (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) @@ -295,7 +295,7 @@ (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) @@ -316,7 +316,7 @@ (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))))))) @@ -328,7 +328,7 @@ ((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))) @@ -376,12 +376,12 @@ (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) @@ -393,8 +393,8 @@ (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) @@ -407,8 +407,8 @@ (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))) @@ -418,13 +418,13 @@ (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) @@ -443,13 +443,13 @@ (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) @@ -459,7 +459,7 @@ (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)))))))) @@ -482,12 +482,12 @@ (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) @@ -505,10 +505,10 @@ ((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)))) @@ -644,7 +644,7 @@ (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) @@ -1535,7 +1535,7 @@ ((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))) @@ -1597,7 +1597,7 @@ (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))) @@ -1776,7 +1776,7 @@ (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))) @@ -2141,7 +2141,7 @@ ((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) diff --git a/module/mes/elf-util.mes b/module/mes/elf-util.mes index aa24720a..be67aa6e 100644 --- a/module/mes/elf-util.mes +++ b/module/mes/elf-util.mes @@ -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)) @@ -87,29 +84,30 @@ (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)))))))))))) diff --git a/module/mes/elf-util.scm b/module/mes/elf-util.scm index 533ea1e5..8ab1ad62 100644 --- a/module/mes/elf-util.scm +++ b/module/mes/elf-util.scm @@ -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 diff --git a/module/mes/hex2.mes b/module/mes/hex2.mes index 5c0e9de5..2c5096a9 100644 --- a/module/mes/hex2.mes +++ b/module/mes/hex2.mes @@ -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)))) @@ -114,7 +113,7 @@ (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) @@ -123,8 +122,8 @@ (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) @@ -142,17 +141,18 @@ (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)) @@ -175,7 +175,7 @@ (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)) " ")) @@ -186,7 +186,7 @@ (display "### @