mescc: Refactor function-offset.
[mes.git] / module / mes / elf-util.mes
index 53db0f8c36a2d51d51b7b2eb658e133fc0bb2c79..7a8eeb0ee6af6b07fd378ebf0e6faad8b26f67c0 100644 (file)
         (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)
   ;; FIXME
   ;;(member name (reverse functions) (lambda (a b) (equal? (car b) name)))
   (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 (and prefix (or (equal? name "exit") (> offset 0))) (set! cache (assoc-set! cache name offset)))
-            offset)))))
+          (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 '()))
                                             (n (length t)))
                                        (+ (loop (cdr text)) n))))))
                   (when (> offset 0)
-                      (set! cache (assoc-set! cache (cons function label) offset)))
+                    (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)))))))