artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Use file-name as global prefix.

Browse source 
* module/mes/M1.mes (object->M1): Add file-name parameter.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-03 09:01:00 +02:00
parent 99718a8b7a
commit 81ed6564cf
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 14 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
module/mes/M1.mes
View file

@ -43,14 +43,14 @@
(define (stderr string . rest) (define (stderr string . rest)
(apply logf (cons* (current-error-port) string rest))) (apply logf (cons* (current-error-port) string rest)))
(define (objects->M1 objects) (define (objects->M1 file-name objects)
((compose object->M1 merge-objects) objects)) ((compose (cut object->M1 file-name <>) merge-objects) objects))
(define (object->elf o) (define (object->elf file-name o)
((compose M1->elf object->M1) o)) ((compose M1->elf (cut object->M1 file-name <>)) o))
(define (objects->elf objects) (define (objects->elf file-name objects)
((compose M1->elf object->M1 merge-objects) objects)) ((compose M1->elf (cut object->M1 file-name <>) merge-objects) objects))
(define (merge-objects objects) (define (merge-objects objects)
(let loop ((objects (cdr objects)) (object (car objects))) (let loop ((objects (cdr objects)) (object (car objects)))
@ -92,11 +92,10 @@
(display sep)) (display sep))
(loop (cdr o))))) (loop (cdr o)))))
(define (object->M1 o) (define (object->M1 file-name o)
(stderr "dumping M1: object\n") (stderr "dumping M1: object\n")
(let* ((functions (assoc-ref o 'functions)) (let* ((functions (assoc-ref o 'functions))
(function-names (map car functions)) (function-names (map car functions))
(file-name (car (or (assoc-ref o 'file-names) function-names)))
(globals (assoc-ref o 'globals)) (globals (assoc-ref o 'globals))
(global-names (map car globals)) (global-names (map car globals))
(strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names))) (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names)))

13
scripts/mescc
View file

@ -167,6 +167,7 @@ Environment variables:
(let* ((options (parse-opts args)) (let* ((options (parse-opts args))
(files (option-ref options '() '())) (files (option-ref options '() '()))
(file (car files)) (file (car files))
(file-name (car (string-split (basename file) #\.)))
(preprocess? (option-ref options 'E #f)) (preprocess? (option-ref options 'E #f))
(compile? (option-ref options 'c #f)) (compile? (option-ref options 'c #f))
(debug-info? (option-ref options 'g #f)) (debug-info? (option-ref options 'g #f))
@ -192,17 +193,17 @@ Environment variables:
(if (and (not compile?) (if (and (not compile?)
(not preprocess?)) (set-port-encoding! (current-output-port) "ISO-8859-1")) (not preprocess?)) (set-port-encoding! (current-output-port) "ISO-8859-1"))
(cond ((pair? objects) (let ((objects (map read-object objects))) (cond ((pair? objects) (let ((objects (map read-object objects)))
(if compile? (objects->M1 objects) (if compile? (objects->M1 file-name objects)
(objects->elf objects)))) (objects->elf file objects))))
((pair? asts) (let* ((infos (map main:ast->info asts)) ((pair? asts) (let* ((infos (map main:ast->info asts))
(objects (map info->object infos))) (objects (map info->object infos)))
(if compile? (objects->M1 objects) (if compile? (objects->M1 file-name objects)
(objects->elf objects)))) (objects->elf file objects))))
((pair? sources) (if preprocess? (map (source->ast pretty-print/write defines includes) sources) ((pair? sources) (if preprocess? (map (source->ast pretty-print/write defines includes) sources)
(let* ((infos (map (source->info defines includes) sources)) (let* ((infos (map (source->info defines includes) sources))
(objects (map info->object infos))) (objects (map info->object infos)))
(if compile? (objects->M1 objects) (if compile? (objects->M1 file-name objects)
(objects->elf objects)))))))))) (objects->elf file objects))))))))))
(main (command-line)) (main (command-line))
'done 'done