mescc: Change --align to --align=functions, --align=globals.
This makes function alignment optional and disables function alignment when using MesCC-Tools 0.5.2 (numbered architecture). * module/mescc.scm (parse-opts): Make --align take a value. * module/mescc/mescc.scm (mescc:compile, infos->hex2): Parse it and pass it as renamed #:align keyword argument to ... * module/mescc/M1.scm (infos->M1): ...here. Rename parameter align? to align, pass it to... (info->M1): ...here. Likewise. Use it to make function alignment optional.
This commit is contained in:
parent
3115261f2f
commit
5bb568e455
|
@ -876,8 +876,9 @@ The @var{option}s can be among the following:
|
||||||
|
|
||||||
@table @code
|
@table @code
|
||||||
|
|
||||||
@item --align
|
@item --align=@var{symbol}
|
||||||
align globals
|
align @var{symbol}, the default is @code{functions}; other valid values
|
||||||
|
are: @code{globals}.
|
||||||
|
|
||||||
@item --base-address=ADRRESS
|
@item --base-address=ADRRESS
|
||||||
use BaseAddress ADDRESS [0x1000000]
|
use BaseAddress ADDRESS [0x1000000]
|
||||||
|
|
|
@ -58,7 +58,7 @@
|
||||||
|
|
||||||
(define (parse-opts args)
|
(define (parse-opts args)
|
||||||
(let* ((option-spec
|
(let* ((option-spec
|
||||||
'((align)
|
'((align (value #t))
|
||||||
(arch (value #t))
|
(arch (value #t))
|
||||||
(assemble (single-char #\c))
|
(assemble (single-char #\c))
|
||||||
(base-address (value #t))
|
(base-address (value #t))
|
||||||
|
@ -103,7 +103,7 @@ Usage: mescc [OPTION]... FILE...
|
||||||
C99 compiler in Scheme for bootstrapping the GNU system.
|
C99 compiler in Scheme for bootstrapping the GNU system.
|
||||||
|
|
||||||
Options:
|
Options:
|
||||||
--align align globals
|
--align=SYMBOL align SYMBOL {functions,globals,none} [functions]
|
||||||
--arch=ARCH compile for ARCH [~a]
|
--arch=ARCH compile for ARCH [~a]
|
||||||
--kernel=ARCH compile for KERNEL [~a]
|
--kernel=ARCH compile for KERNEL [~a]
|
||||||
-dumpmachine display the compiler's target machine
|
-dumpmachine display the compiler's target machine
|
||||||
|
|
|
@ -35,9 +35,9 @@
|
||||||
infos->M1
|
infos->M1
|
||||||
M1:merge-infos))
|
M1:merge-infos))
|
||||||
|
|
||||||
(define* (infos->M1 file-name infos #:key align? verbose?)
|
(define* (infos->M1 file-name infos #:key align verbose?)
|
||||||
(let ((info (fold M1:merge-infos (make <info>) infos)))
|
(let ((info (fold M1:merge-infos (make <info>) infos)))
|
||||||
(info->M1 file-name info #:align? align? #:verbose? verbose?)))
|
(info->M1 file-name info #:align align #:verbose? verbose?)))
|
||||||
|
|
||||||
(define (M1:merge-infos o info)
|
(define (M1:merge-infos o info)
|
||||||
(clone info
|
(clone info
|
||||||
|
@ -113,14 +113,16 @@
|
||||||
(define (global-extern? o)
|
(define (global-extern? o)
|
||||||
(and=> (global:storage o) (cut eq? <> 'extern)))
|
(and=> (global:storage o) (cut eq? <> 'extern)))
|
||||||
|
|
||||||
(define* (info->M1 file-name o #:key align? verbose?)
|
(define* (info->M1 file-name o #:key align verbose?)
|
||||||
(let* ((functions (.functions o))
|
(let* ((functions (.functions o))
|
||||||
(function-names (map car functions))
|
(function-names (map car functions))
|
||||||
(globals (.globals o))
|
(globals (.globals o))
|
||||||
(globals (filter (negate (compose global-extern? cdr)) globals))
|
(globals (filter (negate (compose global-extern? cdr)) globals))
|
||||||
(strings (filter global-string? globals))
|
(strings (filter global-string? globals))
|
||||||
(strings (map car strings))
|
(strings (map car strings))
|
||||||
(reg-size (type:size (assoc-ref (.types o) "*"))))
|
(reg-size (type:size (assoc-ref (.types o) "*")))
|
||||||
|
(align-functions? (memq 'functions align))
|
||||||
|
(align-globals? (memq 'globals align)))
|
||||||
(define (string->label o)
|
(define (string->label o)
|
||||||
(let ((index (list-index (lambda (s) (equal? s o)) strings)))
|
(let ((index (list-index (lambda (s) (equal? s o)) strings)))
|
||||||
(if index
|
(if index
|
||||||
|
@ -207,8 +209,11 @@
|
||||||
(newline))
|
(newline))
|
||||||
(when verbose?
|
(when verbose?
|
||||||
(display (string-append " :" name "\n") (current-error-port)))
|
(display (string-append " :" name "\n") (current-error-port)))
|
||||||
;; "<" aligns to multiple of 4 Bytes.
|
(display "\n\n")
|
||||||
(display (string-append "\n\n<\n:" name "\n"))
|
(when align-functions?
|
||||||
|
;; "<" aligns to multiple of 4 Bytes.
|
||||||
|
(display "<\n"))
|
||||||
|
(display (string-append ":" name "\n"))
|
||||||
(for-each line->M1 (apply append text))))
|
(for-each line->M1 (apply append text))))
|
||||||
(define (write-global o)
|
(define (write-global o)
|
||||||
(define (labelize o)
|
(define (labelize o)
|
||||||
|
@ -223,7 +228,7 @@
|
||||||
(else (string-append "&" label))))))
|
(else (string-append "&" label))))))
|
||||||
(define (display-align size)
|
(define (display-align size)
|
||||||
(let ((alignment (- reg-size (modulo size reg-size))))
|
(let ((alignment (- reg-size (modulo size reg-size))))
|
||||||
(when (and align? (> reg-size alignment 0))
|
(when (and align-globals? (> reg-size alignment 0))
|
||||||
(display " ")
|
(display " ")
|
||||||
(display-join (map text->M1 (map (const 0) (iota alignment))) " "))
|
(display-join (map text->M1 (map (const 0) (iota alignment))) " "))
|
||||||
#t))
|
#t))
|
||||||
|
|
|
@ -79,11 +79,16 @@
|
||||||
(else (replace-suffix input-base ".s"))))
|
(else (replace-suffix input-base ".s"))))
|
||||||
(infos (map (cut file->info options <>) files))
|
(infos (map (cut file->info options <>) files))
|
||||||
(verbose? (count-opt options 'verbose))
|
(verbose? (count-opt options 'verbose))
|
||||||
(align? (option-ref options 'align #f)))
|
(numbered-arch? (option-ref options 'numbered-arch? #f))
|
||||||
|
(align (filter-map (multi-opt 'align) options))
|
||||||
|
(align (if (null? align) '(functions) (map string->symbol align)))
|
||||||
|
(align (if (not numbered-arch?) align
|
||||||
|
;; function alignment not supported by MesCC-Tools 0.5.2
|
||||||
|
(filter (negate (cut eq? <> 'functions)) align))))
|
||||||
(when verbose?
|
(when verbose?
|
||||||
(stderr "dumping: ~a\n" M1-file-name))
|
(stderr "dumping: ~a\n" M1-file-name))
|
||||||
(with-output-to-file M1-file-name
|
(with-output-to-file M1-file-name
|
||||||
(cut infos->M1 M1-file-name infos #:align? align? #:verbose? verbose?))
|
(cut infos->M1 M1-file-name infos #:align align #:verbose? verbose?))
|
||||||
M1-file-name))
|
M1-file-name))
|
||||||
|
|
||||||
(define (file->info options file-name)
|
(define (file->info options file-name)
|
||||||
|
@ -168,11 +173,16 @@
|
||||||
(options (acons 'compile #t options)) ; ugh
|
(options (acons 'compile #t options)) ; ugh
|
||||||
(options (acons 'output hex2-file-name options))
|
(options (acons 'output hex2-file-name options))
|
||||||
(verbose? (count-opt options 'verbose))
|
(verbose? (count-opt options 'verbose))
|
||||||
(align? (option-ref options 'align #f)))
|
(numbered-arch? (option-ref options 'numbered-arch? #f))
|
||||||
|
(align (filter-map (multi-opt 'align) options))
|
||||||
|
(align (if (null? align) '(functions) (map string->symbol align)))
|
||||||
|
(align (if (not numbered-arch?) align
|
||||||
|
;; function alignment not supported by MesCC-Tools 0.5.2
|
||||||
|
(filter (negate (cut eq? <> 'functions)) align))))
|
||||||
(when verbose?
|
(when verbose?
|
||||||
(stderr "dumping: ~a\n" M1-file-name))
|
(stderr "dumping: ~a\n" M1-file-name))
|
||||||
(with-output-to-file M1-file-name
|
(with-output-to-file M1-file-name
|
||||||
(cut infos->M1 M1-file-name infos #:align? align?))
|
(cut infos->M1 M1-file-name infos #:align align))
|
||||||
(or (M1->hex2 options (list M1-file-name))
|
(or (M1->hex2 options (list M1-file-name))
|
||||||
(exit 1))))
|
(exit 1))))
|
||||||
|
|
||||||
|
@ -362,7 +372,7 @@
|
||||||
|
|
||||||
(define (arch-get-architecture options)
|
(define (arch-get-architecture options)
|
||||||
(let* ((arch (arch-get options))
|
(let* ((arch (arch-get options))
|
||||||
(numbered-arch? (option-ref options 'numbered-arch? #f))
|
(numbered-arch? (option-ref options 'numbered-arch? #f))
|
||||||
(flag (if numbered-arch? "--Architecture" "--architecture")))
|
(flag (if numbered-arch? "--Architecture" "--architecture")))
|
||||||
(list flag
|
(list flag
|
||||||
(cond ((equal? arch "arm") (if numbered-arch? "40" "armv7l"))
|
(cond ((equal? arch "arm") (if numbered-arch? "40" "armv7l"))
|
||||||
|
|
Loading…
Reference in a new issue