Changeset 14874 in project


Ignore:
Timestamp:
06/03/09 13:25:11 (10 years ago)
Author:
felix winkelmann
Message:

global inlining fixes; other small things

Location:
chicken/trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/batch-driver.scm

    r14870 r14874  
    3535  compiler-arguments process-command-line dump-nodes dump-undefined-globals
    3636  default-standard-bindings default-extended-bindings
    37   foldable-bindings dump-defined-globals
     37  foldable-bindings dump-defined-globals apply-pre-cps-rewrite-rules!
    3838  compiler-cleanup-hook disabled-warnings local-definitions inline-output-file
    3939  file-io-only undefine-shadowed-macros profiled-procedures
     
    556556                 (end-time "pre-analysis (rewrite)")
    557557                 (begin-time)
    558                  (apply-rewrite-rules! node0 db)
    559                  (end-time "applying rewrite rules")
    560                  (print-node "applied rewrite rules" '|R| node0)
     558                 (apply-pre-cps-rewrite-rules! node0 db)
     559                 (end-time "applying pre-CPS rewrite rules")
     560                 (print-node "applied pre-CPS rewrite rules" '|R| node0)
    561561                 (set! first-analysis #t) )
    562562
     
    574574                        (load-inline-file ifile)))
    575575                    (concatenate (map cdr req))) )
    576                  (for-each
    577                   (lambda (ilf)
    578                     (dribble "Loading inline file ~a ..." ilf)
    579                     (load-inline-file ilf) )
    580                   (collect-options 'consult-inline-file)))
     576                 (let ((ifs (collect-options 'consult-inline-file)))
     577                   (unless (null? ifs)
     578                     (set! inline-globally #t)
     579                     (set! inline-locally #t)
     580                     (for-each
     581                      (lambda (ilf)
     582                        (dribble "Loading inline file ~a ..." ilf)
     583                        (load-inline-file ilf) )
     584                      ifs))))
    581585
    582586               (set! ##sys#line-number-database #f)
  • chicken/trunk/compiler.scm

    r14870 r14874  
    9191;   ##compiler#unused -> BOOL
    9292;   ##compiler#foldable -> BOOL
     93;   ##compiler#rewrite -> PROCEDURE (see `apply-rewrite-rules!')
    9394
    9495; - Source language:
  • chicken/trunk/manual/Using the compiler

    r14870 r14874  
    3535; -check-syntax : Aborts compilation process after macro-expansion and syntax checks.
    3636
    37 ; -consult-inline-file FILENAME : load file with definitions for cross-module inlining generated by a previous compiloer invocation via {{-emit-inline-file}}.
     37; -consult-inline-file FILENAME : load file with definitions for cross-module inlining generated by a previous compiloer invocation via {{-emit-inline-file}}. Implies {{-inline}}.
    3838
    3939; -debug MODES : Enables one or more compiler debugging modes. {{MODES}} is a string of characters that select debugging information about the compiler that will be printed to standard output.
  • chicken/trunk/optimizer.scm

    r14828 r14874  
    6262  parameter-limit eq-inline-operator optimizable-rest-argument-operators
    6363  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    64   make-random-name final-foreign-type inline-max-size simplified-ops
     64  make-random-name final-foreign-type inline-max-size simplified-ops apply-pre-cps-rewrite-rules!
    6565  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    6666  foreign-argument-conversion foreign-result-conversion foreign-type-convert-argument foreign-type-convert-result)
     
    349349                                                   [(test (car vars) 'unused)
    350350                                                    (touch)
    351                                                     (debugging 'o "removed unused parameter to known procedure" (car vars) var)
     351                                                    (debugging
     352                                                     'o "removed unused parameter to known procedure"
     353                                                     (car vars) var)
    352354                                                    (if (expression-has-side-effects? (car args) db)
    353355                                                        (make-node
     
    17901792            (when (debugging 'l "accessibles:") (pretty-print al))
    17911793            (debugging 'p "eliminating liftables by access-lists and non-liftable callees...")
    1792             (let ([ls (eliminate3 (eliminate4 g2))]) ;(eliminate2 g2 al)))])
     1794            (let ([ls (eliminate3 (eliminate4 g2))]) ;(eliminate2 g2 al)))]) - why isn't this used?
    17931795              (debugging 'o "liftable local procedures" (delay (unzip1 ls)))
    17941796              (debugging 'p "gathering extra parameters...")
     
    18011803                (debugging 'p "moving liftables to toplevel...")
    18021804                (reconstruct! ls extra) ) ) ) ) ) ) ) )
     1805
     1806
     1807;;; Apply rewrite-rules to procedure calls
     1808
     1809(define (apply-pre-cps-rewrite-rules! node db)
     1810  (define (walk n)
     1811    (let ((class (node-class n))
     1812          (params (node-parameters n))
     1813          (subs (node-subexpressions n)))
     1814      (case class
     1815        ((##core#call)
     1816         (let* ((opnode (walk (first subs)))
     1817                (proc (and (eq? '##core#variable (node-class opnode))
     1818                           (first (node-parameters opnode))) )
     1819                (handler (and proc
     1820                              (intrinsic? proc)
     1821                              (##sys#get proc '##compiler#rewrite) ) ) )
     1822           (for-each walk (cdr subs))
     1823           (cond (handler
     1824                  (let ((info (and (pair? (cdr params))
     1825                                   (source-info->line (second params)))))
     1826                    (debugging 'o "applying rule" proc info)
     1827                    (copy-node! (handler proc (cdr subs) db walk) n)))
     1828                 (else n))))
     1829        (else
     1830         (for-each walk subs)))))
     1831  (walk node))
  • chicken/trunk/scrutinizer.scm

    r14870 r14874  
    656656         (##sys#put! name '##core#type new)))
    657657     (read-file dbfile))))
    658 
    659 (define (source-info->line info)
    660   (if (list? info)
    661       (cadr info)
    662       (and info (->string info))) )
  • chicken/trunk/support.scm

    r14870 r14874  
    6666  default-optimization-iterations chop-separator chop-extension follow-without-loop
    6767  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    68   foreign-argument-conversion foreign-result-conversion final-foreign-type debugging
     68  foreign-argument-conversion foreign-result-conversion final-foreign-type debugging source-info->line
    6969  constant-declarations process-lambda-documentation big-fixnum? sort-symbols llist-length
    7070  export-dump-hook intrinsic? node->sexpr emit-global-inline-file inline-max-size
     
    673673  (node-parameters-set! to (node-parameters from))
    674674  (node-subexpressions-set! to (node-subexpressions from))
    675   (let ([len-from (##sys#size from)]
    676         [len-to (##sys#size to)] )
    677     (do ([i 4 (fx+ i 1)])
    678         ((or (fx>= i len-from) (fx>= i len-to)))
    679       (##sys#setslot to i (##sys#slot from i)) ) ) )
     675  to)
    680676
    681677(define (node->sexpr n)
     
    14291425      (and info (->string info))) )
    14301426
     1427(define (source-info->line info)
     1428  (if (list? info)
     1429      (cadr info)
     1430      (and info (->string info))) )
     1431
    14311432
    14321433;;; We need this for constant folding:
Note: See TracChangeset for help on using the changeset viewer.