mescc: Refactor function-offset.
[mes.git] / module / mes / elf-util.mes
index 4676eaece4057bc32750592094ad2bf51a5ce348..7a8eeb0ee6af6b07fd378ebf0e6faad8b26f67c0 100644 (file)
@@ -38,6 +38,9 @@
 (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))))
         (loop (cdr lambdas/labels)
               (append text ((lambda/label->list functions globals ta (- (length text)) d) (car lambdas/labels)))))))
 
-;; (define (functions->text functions globals ta t d)
-;;   (let loop ((functions functions) (text '()))
-;;     (if (null? functions) text
-;;         (loop (cdr functions)
-;;               (append '() ;;text
-;;                       (function->text functions globals ta t d text (car functions)))))))
-
-;; (define (function->text functions globals ta t d text function)
-;;   (format (current-error-port) "elf func=~a\n" (car function))
-;;   (let loop ((lambdas/labels (cdr function)) (text text))
-;;     (if (null? lambdas/labels) text
-;;         (loop (cdr lambdas/labels)
-;;               (append '() ;;text
-;;                       ((lambda/label->list functions globals ta (- (length text)) d) (car lambdas/labels)))))))
-
 (define (function-prefix name functions)
-  (member name (reverse functions) (lambda (a b) (equal? (car b) name))))
+  ;; FIXME
+  ;;(member name (reverse functions) (lambda (a b) (equal? (car b) name)))
+  (let* ((x functions)
+         (x (if (and (pair? x) (equal? (caar x) "exit")) (reverse x) x)))
+    (member name x (lambda (a b) (equal? (car b) name)))))
 
 (define function-offset
   (let ((cache '()))
     (lambda (name functions)
       (or (assoc-ref cache name)
-          (let* ((prefix (function-prefix name functions))
-                 (offset (if prefix (length (functions->text (cdr prefix) '() 0 0 0))
-                             0)))
-            (if (or (equal? name "exit") (> offset 0)) (set! cache (assoc-set! cache name offset)))
-            offset)))))
-
-(define (label-offset function label functions)
-  (let ((prefix (function-prefix function functions)))
-    (if (not prefix) 0
-        (let ((function-entry (car prefix)))
-          (let loop ((text (cdr function-entry)))
-            (if (or (equal? (car text) label) (null? text)) 0
-                (let* ((l/l (car text))
-                       (t ((lambda/label->list '() '() 0 0 0) l/l))
-                       (n (length t)))
-                  (+ (loop (cdr text)) n))))))))
+          (let* ((functions (if (and (pair? functions) (equal? (caar functions) "exit")) functions (reverse functions)))
+                 (prefix (and=> (function-prefix name functions) cdr))
+                 (offset (and prefix
+                              (if (null? prefix) 0
+                                  (+ (length (functions->text (list (car prefix)) '() 0 0 0))
+                                     (if (null? (cdr prefix)) 0
+                                         (function-offset (caar prefix) functions)))))))
+            (if (and offset (or (equal? name "exit") (> offset 0))) (set! cache (assoc-set! cache name offset)))
+            (or offset 0))))))
+
+(define label-offset
+  (let ((cache '()))
+    (lambda (function label functions)
+      (or (assoc-ref cache (cons function label))
+          (let ((prefix (function-prefix function functions)))
+            (if (not prefix) 0
+                (let* ((function-entry (car prefix))
+                       (offset (let loop ((text (cdr function-entry)))
+                                 (if (or (equal? (car text) label) (null? text)) 0
+                                     (let* ((l/l (car text))
+                                            (t ((lambda/label->list '() '() 0 0 0) l/l))
+                                            (n (length t)))
+                                       (+ (loop (cdr text)) n))))))
+                  (when (> offset 0)
+                    (set! cache (assoc-set! cache (cons function label) offset)))
+                  offset)))))))
 
 (define (globals->data globals)
   (append-map (compose global:value cdr) globals))
 
-(define (data-offset name globals)
-  (let* ((prefix (member name (reverse globals)
-                         (lambda (a b)
-                           (equal? (car b) name)))))
-    (if prefix (length (globals->data (cdr prefix)))
-        0)))
+(define data-offset
+  (let ((cache '()))
+    (lambda (name globals)
+      (or (assoc-ref cache name)
+          (let* ((prefix (member name (reverse globals)
+                                 (lambda (a b)
+                                   (equal? (car b) name)))))
+            (if (not prefix) 0
+                (let ((offset (length (globals->data (cdr prefix)))))
+                 (set! cache (assoc-set! cache name offset))
+                 offset)))))))