From 81ed6564cf64e85d9ad7a03ce825c544ec0732d5 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Thu, 3 May 2018 09:01:00 +0200
Subject: [PATCH] mescc: Use file-name as global prefix.

* module/mes/M1.mes (object->M1): Add file-name parameter.
---
 module/mes/M1.mes | 15 +++++++--------
 scripts/mescc     | 13 +++++++------
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/module/mes/M1.mes b/module/mes/M1.mes
index 1968121b..1b983f09 100644
--- a/module/mes/M1.mes
+++ b/module/mes/M1.mes
@@ -43,14 +43,14 @@
 (define (stderr string . rest)
   (apply logf (cons* (current-error-port) string rest)))
 
-(define (objects->M1 objects)
-  ((compose object->M1 merge-objects) objects))
+(define (objects->M1 file-name objects)
+  ((compose (cut object->M1 file-name <>) merge-objects) objects))
 
-(define (object->elf o)
-  ((compose M1->elf object->M1) o))
+(define (object->elf file-name o)
+  ((compose M1->elf (cut object->M1 file-name <>)) o))
 
-(define (objects->elf objects)
-  ((compose M1->elf object->M1 merge-objects) objects))
+(define (objects->elf file-name objects)
+  ((compose M1->elf (cut object->M1 file-name <>) merge-objects) objects))
 
 (define (merge-objects objects)
   (let loop ((objects (cdr objects)) (object (car objects)))
@@ -92,11 +92,10 @@
           (display sep))
       (loop (cdr o)))))
 
-(define (object->M1 o)
+(define (object->M1 file-name o)
   (stderr "dumping M1: object\n")
   (let* ((functions (assoc-ref o 'functions))
          (function-names (map car functions))
-         (file-name (car (or (assoc-ref o 'file-names) function-names)))
          (globals (assoc-ref o 'globals))
          (global-names (map car globals))
          (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names)))
diff --git a/scripts/mescc b/scripts/mescc
index bc324ad8..b37de93f 100755
--- a/scripts/mescc
+++ b/scripts/mescc
@@ -167,6 +167,7 @@ Environment variables:
   (let* ((options (parse-opts args))
          (files (option-ref options '() '()))
          (file (car files))
+         (file-name (car (string-split (basename file) #\.)))
          (preprocess? (option-ref options 'E #f))
          (compile? (option-ref options 'c #f))
          (debug-info? (option-ref options 'g #f))
@@ -192,17 +193,17 @@ Environment variables:
         (if (and (not compile?)
                  (not preprocess?)) (set-port-encoding! (current-output-port) "ISO-8859-1"))
         (cond ((pair? objects) (let ((objects (map read-object objects)))
-                                 (if compile? (objects->M1 objects)
-                                     (objects->elf objects))))
+                                 (if compile? (objects->M1 file-name objects)
+                                     (objects->elf file objects))))
               ((pair? asts) (let* ((infos (map main:ast->info asts))
                                    (objects (map info->object infos)))
-                              (if compile? (objects->M1 objects)
-                                  (objects->elf objects))))
+                              (if compile? (objects->M1 file-name objects)
+                                  (objects->elf file objects))))
               ((pair? sources) (if preprocess? (map (source->ast pretty-print/write defines includes) sources)
                                    (let* ((infos (map (source->info defines includes) sources))
                                           (objects (map info->object infos)))
-                                     (if compile? (objects->M1 objects)
-                                         (objects->elf objects))))))))))
+                                     (if compile? (objects->M1 file-name objects)
+                                         (objects->elf file objects))))))))))
 
 (main (command-line))
 'done