mescc: Refactor function-offset.
[mes.git] / module / mes / elf-util.mes
index 3231e7b041818af9834b192bd96d82f5971f2ac9..7a8eeb0ee6af6b07fd378ebf0e6faad8b26f67c0 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
  (mes
   (mes-use-module (srfi srfi-1))))
 
-(define (make-function key value)
-  (cons key (cons 'function value)))
-
-(define (make-data key value)
-  (cons key (cons 'data value)))
-
-(define (function-symbol? x)
-  (eq? (car x) 'function))
-
-(define (function-entry? x)
-  (function-symbol? (cdr x)))
-
-(define (data-symbol? x)
-  (eq? (car x) 'data))
-
-(define (data-entry? x)
-  (data-symbol? (cdr x)))
-
-(define (symbols->functions symbols)
-  (append-map cdr (filter function-symbol? (map cdr symbols))))
-
-(define (symbols->text symbols t d)
-  (append-map (lambda (f) (f symbols t d)) (symbols->functions symbols)))
-
-(define (function-offset name symbols)
-  (let* ((functions (filter function-entry? symbols))
-         (prefix (member name (reverse functions)
-                         (lambda (a b)
-                           (equal? (car b) name)))))
-    (if prefix (length (symbols->text (cdr prefix) 0 0))
-        0)))
-
-(define (data-offset name symbols)
-  (let* ((globals (filter data-entry? symbols))
-         (prefix (member name (reverse globals)
-                         (lambda (a b)
-                           (equal? (car b) name)))))
-    (if prefix (length (symbols->data (cdr prefix)))
-        0)))
-
-(define (symbols->data symbols)
-  (append-map cdr (filter data-symbol? (map cdr symbols))))
+(define (make-global name type pointer value)
+  (cons name (list type pointer value)))
+
+(define global:type car)
+(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))))
+
+(define (functions->lambdas functions)
+  (append-map cdr functions))
+
+(define (lambda/label->list f g ta t d)
+  (lambda (l/l)
+    (if (not (procedure? l/l)) '() (l/l f g ta t d))))
+
+(define (text->list o)
+  (append-map (lambda/label->list '() '() 0 0 0) o))
+
+(define (functions->text functions globals ta t d)
+  (let loop ((lambdas/labels (functions->lambdas functions)) (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* ((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* ((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
+  (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)))))))