Changeset 12151 in project
- Timestamp:
- 10/14/08 10:11:13 (12 years ago)
- Location:
- chicken/branches/cmi
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/branches/cmi/Makefile
r12021 r12151 79 79 bootstrap: 80 80 $(MAKE) -f $(SRCDIR)/Makefile.$(PLATFORM) bootstrap 81 bench: 82 $(MAKE) -f $(SRCDIR)/Makefile.$(PLATFORM) bench 81 83 endif -
chicken/branches/cmi/TODO
r12148 r12151 41 41 *** "-inline-global" slurps *.inline files include-path 42 42 ** 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) 44 45 45 46 * benchmarks -
chicken/branches/cmi/batch-driver.scm
r12148 r12151 65 65 default-declarations units-used-by-default words-per-flonum default-debugging-declarations 66 66 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 68 68 foreign-string-result-reserve parameter-limit eq-inline-operator optimizable-rest-argument-operators 69 69 membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument 70 70 chop-separator chop-extension display-real-name-table display-line-number-database explicit-use-flag 71 71 generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration 72 do-lambda-lifting compiler-warning e xport-file-name72 do-lambda-lifting compiler-warning emit-global-inline-file load-inline-file 73 73 foreign-argument-conversion foreign-result-conversion) 74 74 … … 239 239 (set! local-definitions #t)) 240 240 (when (memq 'inline-global options) 241 (set! inline-global #t))241 (set! inline-globally #t)) 242 242 (set! disabled-warnings (map string->symbol (collect-options 'disable-warning))) 243 243 (when (memq 'no-warnings options) … … 497 497 (end-time "user pass") ) ) 498 498 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 499 513 (let* ([node0 (make-node 500 514 'lambda '(()) … … 502 516 (canonicalize-begin-body exps) ) ) ) ] 503 517 [proc (user-pass-2)] ) 504 (when (debugging 'M "; requirements:")505 (pretty-print (concatenate (vector->list file-requirements))))506 518 (when proc 507 519 (when verbose (printf "Secondary user pass...~%")) … … 558 570 559 571 (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) 561 574 (end-time "optimization") 562 575 (print-node "optimized-iteration" '|5| node2) … … 580 593 (print-node "optimized" '|7| node2) 581 594 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 582 601 (begin-time) 583 602 (let ([node3 (perform-closure-conversion node2 db)]) -
chicken/branches/cmi/chicken.scm
r12148 r12151 124 124 [(3) 125 125 (set! options 126 (cons* 'optimize-leaf-routines 'local options) ) ]126 (cons* 'optimize-leaf-routines 'local 'inline options) ) ] 127 127 [(4) 128 128 (set! options 129 (cons* 'optimize-leaf-routines 'local ' unsafe options) ) ]129 (cons* 'optimize-leaf-routines 'local 'inline 'unsafe options) ) ] 130 130 [else (compiler-warning 'usage "invalid optimization level ~S - ignored" (car rest))] ) 131 131 (loop (cdr rest)) ) ] -
chicken/branches/cmi/compiler.scm
r12148 r12151 42 42 ; ([not] usual-integrations {<name>}) 43 43 ; (local {<name> ...}) 44 ; ([not] inline-global {<name>}) 44 45 ; ([number-type] <type>) 45 46 ; (always-bound {<name>}) … … 86 87 ; ##compiler#intrinsic -> #f | 'standard | 'extended 87 88 ; ##compiler#inline -> 'no | 'yes 89 ; ##compiler#inline-global -> 'yes | 'no | <node> 88 90 ; ##compiler#profile -> BOOL 89 91 … … 232 234 ; o-r/access-count -> <n> Contains number of references as arguments of optimizable rest operators 233 235 ; constant -> <boolean> If true: variable has fixed value 236 ; hidden-refs -> <boolean> If true: procedure that refers to hidden global variables 234 237 ; 235 238 ; <lambda-id>: … … 306 309 membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument 307 310 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 309 312 local-definitions export-variable variable-mark intrinsic? 310 313 undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info … … 377 380 (define standalone-executable #t) 378 381 (define local-definitions #f) 379 (define inline-global #f)382 (define inline-globally #f) 380 383 381 384 … … 603 606 (apply ##sys#require ids) 604 607 (##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) 606 610 (lambda () ids) ) 607 611 '(##core#undefined) ) ) … … 1259 1263 (apply register-feature! us) 1260 1264 (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)) 1262 1269 (let ((units (map (lambda (u) (string->c-identifier (stringify u))) us))) 1263 1270 (set! used-units (append used-units units)) ) ) ) ) … … 1266 1273 (let* ([u (strip (cadr spec))] 1267 1274 [un (string->c-identifier (stringify u))] ) 1268 (##sys#hash-table-set! file-requirements 'unit u)1269 1275 (when (and unit-name (not (string=? unit-name un))) 1270 1276 (compiler-warning 'usage "unit was already given a name (new name is ignored)") ) … … 1366 1372 (set! standard-bindings (lset-difference eq? default-standard-bindings syms)) 1367 1373 (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))))) 1368 1380 [else 1369 1381 (check-decl spec 1 1) … … 1434 1446 (stripa (cdr spec)))))) 1435 1447 ((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))))) 1437 1453 (else (compiler-warning 'syntax "illegal declaration specifier `~s'" spec)) ) 1438 1454 '(##core#undefined) ) ) ) … … 1931 1947 (when (and (eq? '##core#lambda (node-class value)) 1932 1948 (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)) ) ) ) 1934 1952 (if (and (= 1 nreferences) (= 1 ncall-sites)) 1935 1953 (quick-put! plist 'contractable #t) … … 1938 1956 ;; Make 'inlinable, if it is declared local and has a value 1939 1957 (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)))))) 1944 1977 1945 1978 ;; Make 'collapsable, if it has a known constant value which is either collapsable or is only -
chicken/branches/cmi/eval.scm
r12130 r12151 1185 1185 (let ((vector->list vector->list)) 1186 1186 (lambda (id comp? imp?) 1187 (define (add-req id )1187 (define (add-req id syntax?) 1188 1188 (when comp? 1189 (##sys#hash-table-update! 1189 (##sys#hash-table-update! ; assumes compiler has extras available - will break in the interpreter 1190 1190 ##compiler#file-requirements 1191 'syntax-requirements1191 (if syntax? 'dynamic/syntax 'dynamic) 1192 1192 (cut lset-adjoin eq? <> id) 1193 1193 (lambda () (list id))))) … … 1229 1229 (let ((s (assq 'syntax info)) 1230 1230 (rr (assq 'require-at-runtime info)) ) 1231 (when s (add-req id ))1231 (when s (add-req id #t)) 1232 1232 (values 1233 1233 (impform … … 1243 1243 #t) ) ) 1244 1244 (else 1245 (add-req id )1245 (add-req id #f) 1246 1246 (values 1247 1247 (impform -
chicken/branches/cmi/manual/Declarations
r12148 r12151 142 142 143 143 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 151 Declare that then given toplevel procedures (or all) are subject to 152 cross-module inlining. Potentially inlinable procedures in the current 153 compilation unit will be written to an external 154 {{<source-filename>.inline}} file in the current directory. Globally 155 inlinable 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 158 in the current compilation unit. 159 160 144 161 === inline-limit 145 162 -
chicken/branches/cmi/manual/Using the compiler
r12148 r12151 120 120 ; -inline : Enable procedure inlining for known procedures of a size below the threshold (which can be set through the {{-inline-limit}} option). 121 121 122 ; -inline-global : Enable cross-module inlining. 123 122 124 ; -inline-limit THRESHOLD : Sets the maximum size of a potentially inlinable procedure. The default threshold is {{10}}. 123 125 … … 146 148 -optimize-level 1 is equivalent to -optimize-leaf-routines 147 149 -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 - unsafe150 -optimize-level 3 is equivalent to -optimize-leaf-routines -local -inline 151 -optimize-level 4 is equivalent to -optimize-leaf-routines -local -inline -unsafe 150 152 151 153 ; -output-file FILENAME : Specifies the pathname of the generated C file. Default is {{FILENAME.c}}. -
chicken/branches/cmi/optimizer.scm
r12148 r12151 319 319 (lambda (vars argc rest) 320 320 (let ([fid (first lparams)]) 321 #;(pp `(INLINE: ,var ,fid ,(test fid 'simple)322 ,(test var 'inlinable)323 ,(variable-mark var '##compiler#inline)))324 321 (cond [(and (test fid 'simple) 325 322 (test var 'inlinable) -
chicken/branches/cmi/rules.make
r12117 r12151 1386 1386 srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c posixunix.c posixwin.c regex.c \ 1387 1387 scheduler.c profiler.c stub.c expand.c $(COMPILER_OBJECTS_1:=.c) 1388 1389 1390 # benchmarking 1391 1392 .PHONY: bench 1393 1394 bench: 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 54 54 debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list 55 55 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 57 57 collapsable-literal? immediate? canonicalize-begin-body string->expr get get-all 58 58 put! collect! count! get-line get-line-2 find-lambda-container display-analysis-database varnode qnode … … 69 69 foreign-argument-conversion foreign-result-conversion final-foreign-type debugging block-globals 70 70 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 72 72 make-random-name foreign-type-convert-result foreign-type-convert-argument process-custom-declaration) 73 73 … … 667 667 ,(node-parameters n) 668 668 ,@(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))))))) 669 710 670 711 … … 1055 1096 1056 1097 (define (scan-free-variables node) 1057 (let ((vars '())) 1098 (let ((vars '()) 1099 (hvars '())) 1058 1100 1059 1101 (define (walk n e) … … 1064 1106 ((##core#variable) 1065 1107 (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)))))) 1067 1112 ((set!) 1068 1113 (let ((var (first params))) … … 1083 1128 1084 1129 (walk node '()) 1085 vars) )1130 (values vars hvars) ) ) 1086 1131 1087 1132 -
chicken/branches/cmi/tweaks.scm
r12148 r12151 43 43 44 44 45 (define-inline (node? x) (##sys#structure? x 'node)) 45 46 (define-inline (make-node c p s) (##sys#make-structure 'node c p s)) 46 47 (define-inline (node-class n) (##sys#slot n 1))
Note: See TracChangeset
for help on using the changeset viewer.