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