#lang scheme/base ;; POSTPROCESSING and OPTIMIZATION ;; This part is separate from target-compile.ss because the data ;; structure representation changed to a linked graph representing all ;; of the code, instead of the threaded immutable structure used in the compiler. ;; * inside the compiler, all data structures are functional. (labels ;; are just abstract entities and not attached to any code) ;; * in the postprocessor and assembler, labels contain: ;; - code: which contains expressions that indirectly reference labels ;; - next: the word immediately following, in case there's no terminating jump (require "../target.ss" "../tools.ss" "../scat.ss" "../coma.ss" "../control.ss" scheme/pretty scheme/match) (provide target-postprocess! target-postprocess macros->postprocess empty-ctrl->asm assert-empty-ctrl ) (define (empty-ctrl->asm state [name ""]) (match state ((struct 2stack (ctor asm ctrl)) (unless (null? ctrl) (error 'non-null-compilation-stack "~a ~s" name ctrl)) asm))) (define (assert-empty-ctrl . a) (void (apply empty-ctrl->asm a))) ;; Turn a (set-of (list-of (list word code))) into a linked up ;; imperative data structure and perform postprocessing optimizations. (define (target-postprocess! compiled-words) (define roots (link! compiled-words)) (define (all: . fns) (let ((words (apply append (map target-chain->list roots)))) (for-each (lambda (fn) (for-each fn words)) fns))) ;; Individual optimizations (all: target-post!) ;; No global optimizations yet roots) ;; Converts the (list-of (list-of (list word code))) to (list-of ;; word), with all graph structure linked in (code + chain) (define (link! chains) (define link-chain! (match-lambda ((list w) w) ((list-rest w+ w ws) (set-target-word-next! w w+) (link-chain! (cons w ws))))) (define (link-code! word code) (set-target-word-code! word code) word) (map link-chain! (map (lambda (chain) (map* link-code! chain)) chains))) ;; PER-WORD optimizations ;; Hook for target specific assembly postprocessing. I.e. for PIC18 ;; this translates the pseudo ops QW JW CW to real assembly code, and ;; performs SAVE elimination. ;; FIXME: the real question: why not postpone all optimisations till ;; later, and have the core language be simple? (define target-postprocess (make-parameter (lambda (reverse-asm) reverse-asm))) (define (target-post! word) (set-target-word-code! word ((target-postprocess) (target-word-code word)))) ;; Lift a macro to a function that postprocesses a list of reversed ;; assembly code, by executing the macro after pushing the next ;; instruction to the assembly state. (Note that these macros are only ;; allowed to use the 2stack state.) (define (macro->postprocessor macro) (lambda (reverse-asm) (let next ((a (reverse reverse-asm)) (s (make-state:2stack '() '()))) (let ((asm (empty-ctrl->asm s))) (if (null? a) asm (next (cdr a) (macro (make-state:2stack (cons (car a) asm) '() ;; empty ctrl )))))))) (define (do-macros->postprocess . macros) (lambda (asm) ((apply compose (map macro->postprocessor (reverse macros))) ;; use left -> right order asm))) (define-sr (macros->postprocess namespace macro ...) (do-macros->postprocess (ns namespace macro) ...)) ;; More optimizations: ;; * Serialize the code graph. Optimize jump sizes for words ending in ;; 'jw' (after dead code elimination), and eliminate jumps to the ;; next word. ;; * jump chaining.