Changeset 12151 in project


Ignore:
Timestamp:
10/14/08 10:11:13 (12 years ago)
Author:
felix winkelmann
Message:

inlining (local and global) work

Location:
chicken/branches/cmi
Files:
12 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/cmi/Makefile

    r12021 r12151  
    7979bootstrap:
    8080        $(MAKE) -f $(SRCDIR)/Makefile.$(PLATFORM) bootstrap
     81bench:
     82        $(MAKE) -f $(SRCDIR)/Makefile.$(PLATFORM) bench
    8183endif
  • chicken/branches/cmi/TODO

    r12148 r12151  
    4141*** "-inline-global" slurps *.inline files include-path
    4242** remove "custom-declare" + stuff?
    43 ** when inlining, consing arg-list with "list" may make get-keyword possible foldable
     43** when inlining, consing arg-list with "list" may make get-keyword possibly foldable
     44** refactor inline tests (simple fid, inlinable/contractable, inline prop, size)
    4445
    4546* benchmarks
  • chicken/branches/cmi/batch-driver.scm

    r12148 r12151  
    6565  default-declarations units-used-by-default words-per-flonum default-debugging-declarations
    6666  default-profiling-declarations default-optimization-passes
    67   inline-max-size file-requirements import-libraries inline-global
     67  inline-max-size file-requirements import-libraries inline-globally
    6868  foreign-string-result-reserve parameter-limit eq-inline-operator optimizable-rest-argument-operators
    6969  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    7070  chop-separator chop-extension display-real-name-table display-line-number-database explicit-use-flag
    7171  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    72   do-lambda-lifting compiler-warning export-file-name
     72  do-lambda-lifting compiler-warning emit-global-inline-file load-inline-file
    7373  foreign-argument-conversion foreign-result-conversion)
    7474
     
    239239      (set! local-definitions #t))
    240240    (when (memq 'inline-global options)
    241       (set! inline-global #t))
     241      (set! inline-globally #t))
    242242    (set! disabled-warnings (map string->symbol (collect-options 'disable-warning)))
    243243    (when (memq 'no-warnings options)
     
    497497                 (end-time "user pass") ) )
    498498
     499             (let ((req (concatenate (vector->list file-requirements))))
     500               (when (debugging 'M "; requirements:")
     501                 (pp req))
     502               (when inline-globally
     503                 (for-each
     504                  (lambda (id)
     505                    (and-let* ((ifile (##sys#resolve-include-filename
     506                                       (make-pathname #f (symbol->string id) "inline")
     507                                       #f #t)))
     508                      (when verbose
     509                        (print "Loading inline file " ifile " ...")
     510                        (load-inline-file ifile))))
     511                  (map cdr req))))
     512
    499513             (let* ([node0 (make-node
    500514                            'lambda '(())
     
    502516                                   (canonicalize-begin-body exps) ) ) ) ]
    503517                    [proc (user-pass-2)] )
    504                (when (debugging 'M "; requirements:")
    505                  (pretty-print (concatenate (vector->list file-requirements))))
    506518               (when proc
    507519                 (when verbose (printf "Secondary user pass...~%"))
     
    558570
    559571                            (begin-time)
    560                             (receive (node2 progress-flag) (perform-high-level-optimizations node2 db)
     572                            (receive (node2 progress-flag)
     573                                (perform-high-level-optimizations node2 db)
    561574                              (end-time "optimization")
    562575                              (print-node "optimized-iteration" '|5| node2)
     
    580593                            (print-node "optimized" '|7| node2)
    581594
     595                            (when inline-globally
     596                              (let ((f (pathname-replace-extension source-filename "inline")))
     597                                (when verbose
     598                                  (printf "Generating global inline file ~a ...~%" f))
     599                                (emit-global-inline-file f db) ) )
     600
    582601                            (begin-time)
    583602                            (let ([node3 (perform-closure-conversion node2 db)])
  • chicken/branches/cmi/chicken.scm

    r12148 r12151  
    124124                   [(3)
    125125                    (set! options
    126                       (cons* 'optimize-leaf-routines 'local options) ) ]
     126                      (cons* 'optimize-leaf-routines 'local 'inline options) ) ]
    127127                   [(4)
    128128                    (set! options
    129                       (cons* 'optimize-leaf-routines 'local 'unsafe options) ) ]
     129                      (cons* 'optimize-leaf-routines 'local 'inline 'unsafe options) ) ]
    130130                   [else (compiler-warning 'usage "invalid optimization level ~S - ignored" (car rest))] )
    131131                 (loop (cdr rest)) ) ]
  • chicken/branches/cmi/compiler.scm

    r12148 r12151  
    4242; ([not] usual-integrations {<name>})
    4343; (local {<name> ...})
     44; ([not] inline-global {<name>})
    4445; ([number-type] <type>)
    4546; (always-bound {<name>})
     
    8687;   ##compiler#intrinsic -> #f | 'standard | 'extended
    8788;   ##compiler#inline -> 'no | 'yes
     89;   ##compiler#inline-global -> 'yes | 'no | <node>
    8890;   ##compiler#profile -> BOOL
    8991
     
    232234;   o-r/access-count -> <n>                  Contains number of references as arguments of optimizable rest operators
    233235;   constant -> <boolean>                    If true: variable has fixed value
     236;   hidden-refs -> <boolean>                 If true: procedure that refers to hidden global variables
    234237;
    235238; <lambda-id>:
     
    306309  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    307310  make-random-name final-foreign-type real-name-table real-name set-real-name! safe-globals-flag
    308   location-pointer-map literal-rewrite-hook inline-global
     311  location-pointer-map literal-rewrite-hook inline-globally
    309312  local-definitions export-variable variable-mark intrinsic?
    310313  undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info
     
    377380(define standalone-executable #t)
    378381(define local-definitions #f)
    379 (define inline-global #f)
     382(define inline-globally #f)
    380383
    381384
     
    603606                           (apply ##sys#require ids)
    604607                           (##sys#hash-table-update!
    605                             file-requirements 'syntax-requirements (cut lset-union eq? <> ids)
     608                            file-requirements 'dynamic/syntax
     609                            (cut lset-union eq? <> ids)
    606610                            (lambda () ids) )
    607611                           '(##core#undefined) ) )
     
    12591263          (apply register-feature! us)
    12601264          (when (pair? us)
    1261             (##sys#hash-table-update! file-requirements 'uses (cut lset-union eq? us <>) (lambda () us))
     1265            (##sys#hash-table-update!
     1266             file-requirements 'static
     1267             (cut lset-union eq? us <>)
     1268             (lambda () us))
    12621269            (let ((units (map (lambda (u) (string->c-identifier (stringify u))) us)))
    12631270              (set! used-units (append used-units units)) ) ) ) )
     
    12661273        (let* ([u (strip (cadr spec))]
    12671274               [un (string->c-identifier (stringify u))] )
    1268           (##sys#hash-table-set! file-requirements 'unit u)
    12691275          (when (and unit-name (not (string=? unit-name un)))
    12701276            (compiler-warning 'usage "unit was already given a name (new name is ignored)") )
     
    13661372                    (set! standard-bindings (lset-difference eq? default-standard-bindings syms))
    13671373                    (set! extended-bindings (lset-difference eq? default-extended-bindings syms)) ) ] ) ]
     1374          ((inline-global)
     1375           (if (null? (cddr spec))
     1376               (set! inline-globally #f)
     1377               (for-each
     1378                (cut mark-variable <> '##compiler#inline-global 'no)
     1379                (stripa (cddr spec)))))
    13681380          [else
    13691381           (check-decl spec 1 1)
     
    14341446                (stripa (cdr spec))))))
    14351447       ((inline-global)
    1436         (set! inline-global #t))
     1448        (if (null? (cdr spec))
     1449            (set! inline-globally #t)
     1450            (for-each
     1451             (cut mark-variable <> '##compiler#inline-global 'yes)
     1452             (stripa (cdr spec)))))
    14371453       (else (compiler-warning 'syntax "illegal declaration specifier `~s'" spec)) )
    14381454     '(##core#undefined) ) ) )
     
    19311947                  (when (and (eq? '##core#lambda (node-class value))
    19321948                             (or (not (second valparams))
    1933                                  (every (lambda (v) (get db v 'global)) (scan-free-variables value)) ) )
     1949                                 (every
     1950                                  (lambda (v) (get db v 'global))
     1951                                  (nth-value 0 (scan-free-variables value)) ) ) )
    19341952                    (if (and (= 1 nreferences) (= 1 ncall-sites))
    19351953                        (quick-put! plist 'contractable #t)
     
    19381956                ;; Make 'inlinable, if it is declared local and has a value
    19391957                (let ((valparams (node-parameters local-value)))
    1940                   (when (and (eq? '##core#lambda (node-class local-value))
    1941                              (or (not (second valparams))
    1942                                  (every (lambda (v) (get db v 'global)) (scan-free-variables local-value)) ) )
    1943                     (quick-put! plist 'inlinable #t) ) ) ) )
     1958                  (when (eq? '##core#lambda (node-class local-value))
     1959                    (let-values (((vars hvars) (scan-free-variables local-value)))
     1960                      (when (and (get db sym 'global)
     1961                                 (pair? hvars))
     1962                        (quick-put! plist 'hidden-refs #t))
     1963                      (when (or (not (second valparams))
     1964                                (every
     1965                                 (lambda (v) (get db v 'global))
     1966                                 vars))
     1967                        (quick-put! plist 'inlinable #t) ) ) ) ) )
     1968               ((variable-mark sym '##compiler#inline) =>
     1969                (lambda (n)
     1970                  (when (and (node? n)
     1971                             inline-globally
     1972                             (not (eq? 'no (variable-mark sym '##compiler#inline-global))))
     1973                    (let ((lparams (node-parameters n)))
     1974                      (put! db (first lparams) 'simple)
     1975                      (quick-put! plist 'inlinable #t)
     1976                      (quick-put! plist 'local-value n))))))
    19441977
    19451978         ;; Make 'collapsable, if it has a known constant value which is either collapsable or is only
  • chicken/branches/cmi/eval.scm

    r12130 r12151  
    11851185  (let ((vector->list vector->list))
    11861186    (lambda (id comp? imp?)
    1187       (define (add-req id)
     1187      (define (add-req id syntax?)
    11881188        (when comp?
    1189           (##sys#hash-table-update!             ; assumes compiler has extras available - will break in the interpreter
     1189          (##sys#hash-table-update! ; assumes compiler has extras available - will break in the interpreter
    11901190           ##compiler#file-requirements
    1191            'syntax-requirements
     1191           (if syntax? 'dynamic/syntax 'dynamic)
    11921192           (cut lset-adjoin eq? <> id)
    11931193           (lambda () (list id)))))
     
    12291229                        (let ((s (assq 'syntax info))
    12301230                              (rr (assq 'require-at-runtime info)) )
    1231                           (when s (add-req id))
     1231                          (when s (add-req id #t))
    12321232                          (values
    12331233                           (impform
     
    12431243                           #t) ) )
    12441244                       (else
    1245                         (add-req id)
     1245                        (add-req id #f)
    12461246                        (values
    12471247                         (impform
  • chicken/branches/cmi/manual/Declarations

    r12148 r12151  
    142142
    143143
     144=== inline-global
     145
     146  [declaration specifier] (inline-global)
     147  [declaration specifier] (not inline-global)
     148  [declaration specifier] (inline-global IDENTIFIER ...)
     149  [declaration specifier] (not inline-global IDENTIFIER ...)
     150
     151Declare that then given toplevel procedures (or all) are subject to
     152cross-module inlining. Potentially inlinable procedures in the current
     153compilation unit will be written to an external
     154{{<source-filename>.inline}} file in the current directory. Globally
     155inlinable procedures from other compilation units referred to via
     156{{(declare (uses ...))}} or {{require-extension}} are loaded from
     157{{.inline}} files (if available in the current include path) and inlined
     158in the current compilation unit.
     159
     160
    144161=== inline-limit
    145162
  • chicken/branches/cmi/manual/Using the compiler

    r12148 r12151  
    120120; -inline : Enable procedure inlining for known procedures of a size below the threshold (which can be set through the {{-inline-limit}} option).
    121121
     122; -inline-global : Enable cross-module inlining.
     123
    122124; -inline-limit THRESHOLD : Sets the maximum size of a potentially inlinable procedure. The default threshold is {{10}}.
    123125
     
    146148     -optimize-level 1          is equivalent to -optimize-leaf-routines
    147149     -optimize-level 2          is currently the same as -optimize-level 1
    148      -optimize-level 3          is equivalent to -optimize-leaf-routines -local
    149      -optimize-level 4          is equivalent to -optimize-leaf-routines -local -unsafe
     150     -optimize-level 3          is equivalent to -optimize-leaf-routines -local -inline
     151     -optimize-level 4          is equivalent to -optimize-leaf-routines -local -inline -unsafe
    150152
    151153; -output-file FILENAME : Specifies the pathname of the generated C file. Default is {{FILENAME.c}}.
  • chicken/branches/cmi/optimizer.scm

    r12148 r12151  
    319319                            (lambda (vars argc rest)
    320320                              (let ([fid (first lparams)])
    321                                 #;(pp `(INLINE: ,var ,fid ,(test fid 'simple)
    322                                               ,(test var 'inlinable)
    323                                               ,(variable-mark var '##compiler#inline)))
    324321                                (cond [(and (test fid 'simple)
    325322                                            (test var 'inlinable)
  • chicken/branches/cmi/rules.make

    r12117 r12151  
    13861386          srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c posixunix.c posixwin.c regex.c \
    13871387          scheduler.c profiler.c stub.c expand.c $(COMPILER_OBJECTS_1:=.c)
     1388
     1389
     1390# benchmarking
     1391
     1392.PHONY: bench
     1393
     1394bench:
     1395        here=`pwd`; cd $(SRCDIR)benchmark; \
     1396        LD_LIBRARY_PATH=$$here DYLD_LIBRARY_PATH=$$here \
     1397        $$here/csi -s $(SRCDIR)cscbench.scm $(BENCHMARK_OPTIONS)
  • chicken/branches/cmi/support.scm

    r12148 r12151  
    5454  debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list
    5555  string->c-identifier c-ify-string words words->bytes check-and-open-input-file close-checked-input-file fold-inner
    56   constant? basic-literal? source-info->string mark-variable
     56  constant? basic-literal? source-info->string mark-variable load-inline-file
    5757  collapsable-literal? immediate? canonicalize-begin-body string->expr get get-all
    5858  put! collect! count! get-line get-line-2 find-lambda-container display-analysis-database varnode qnode
     
    6969  foreign-argument-conversion foreign-result-conversion final-foreign-type debugging block-globals
    7070  constant-declarations process-lambda-documentation big-fixnum?
    71   export-dump-hook intrinsic?
     71  export-dump-hook intrinsic? node->sexpr emit-global-inline-file inline-max-size
    7272  make-random-name foreign-type-convert-result foreign-type-convert-argument process-custom-declaration)
    7373
     
    667667      ,(node-parameters n)
    668668      ,@(map walk (node-subexpressions n)))))
     669
     670(define (emit-global-inline-file filename db)
     671  (let ((lst '()))
     672    (with-output-to-file filename
     673      (lambda ()
     674        (print "; GENERATED BY CHICKEN " (chicken-version) "\n")
     675        (##sys#hash-table-for-each
     676         (lambda (sym plist)
     677           (and-let* ((val (assq 'local-value plist))
     678                      ((let ((val (assq 'value plist)))
     679                         (or (not val)
     680                             (not (eq? 'unknown (cdr val))))))
     681                      ((assq 'inlinable plist))
     682                      (lparams (node-parameters (cdr val)))
     683                      ((get db (first lparams) 'simple))
     684                      ((not (get db sym 'hidden-refs)))
     685                      ((not (eq? (variable-mark sym '##compiler#inline-global) 'no)))
     686                      ((case (variable-mark sym '##compiler#inline)
     687                         ((yes) #t)
     688                         ((no) #f)
     689                         (else
     690                          (< (fourth lparams) inline-max-size) ) ) ) )
     691             (set! lst (cons sym lst))
     692             (pp (list sym (node->sexpr (cdr val))))
     693             (newline)))
     694         db)
     695        (print "; END OF FILE")))
     696    (when (and (pair? lst)
     697               (debugging 'i "the following procedures can be globally inlined:"))
     698      (for-each (cut print "  " <>) lst))))
     699
     700(define (load-inline-file fname)
     701  (with-input-from-file fname
     702    (lambda ()
     703      (let loop ()
     704        (let ((x (read)))
     705          (unless (eof-object? x)
     706            (mark-variable
     707             (car x) '##compiler#inline-global
     708             (apply make-node (cadr x)))
     709            (loop)))))))
    669710
    670711
     
    10551096
    10561097(define (scan-free-variables node)
    1057   (let ((vars '()))
     1098  (let ((vars '())
     1099        (hvars '()))
    10581100
    10591101    (define (walk n e)
     
    10641106          ((##core#variable)
    10651107           (let ((var (first params)))
    1066              (unless (memq var e) (set! vars (lset-adjoin eq? vars var))) ) )
     1108             (unless (memq var e)
     1109               (set! vars (lset-adjoin eq? vars var))
     1110               (unless (variable-visible? var)
     1111                 (set! hvars (lset-adjoin eq? hvars var))))))
    10671112          ((set!)
    10681113           (let ((var (first params)))
     
    10831128
    10841129    (walk node '())
    1085     vars) )
     1130    (values vars hvars) ) )
    10861131
    10871132
  • chicken/branches/cmi/tweaks.scm

    r12148 r12151  
    4343
    4444
     45(define-inline (node? x) (##sys#structure? x 'node))
    4546(define-inline (make-node c p s) (##sys#make-structure 'node c p s))
    4647(define-inline (node-class n) (##sys#slot n 1))
Note: See TracChangeset for help on using the changeset viewer.