Changeset 12338 in project
- Timestamp:
- 11/03/08 01:40:55 (12 years ago)
- Location:
- chicken/branches
- Files:
-
- 1 added
- 11 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
chicken/branches/README
r12214 r12338 28 28 regular expression package (currently worked on by felix and Alex). 29 29 30 * cmi30 * lfa 31 31 32 Experimental branch for impoving inlining and the implementation of33 cross-module inlining (maintainedby felix).32 An attempt to implement "localized" flow- and type analysis (worked on 33 by felix). -
chicken/branches/lfa/README
r12320 r12338 3 3 (c)2000-2008 Felix L. Winkelmann 4 4 5 version 4.0.0x1 5 version 4.0.0x1-lfa 6 6 7 7 -
chicken/branches/lfa/batch-driver.scm
r12308 r12338 85 85 (define user-pass-2 (make-parameter #f)) 86 86 (define user-post-analysis-pass (make-parameter #f)) 87 (define user-optimization-pass (make-parameter #f)) 87 88 88 89 … … 577 578 578 579 (cond [progress 580 581 (let ((proc (user-optimization-pass))) 582 (when proc 583 (when verbose (printf "User optimization pass...~%~!")) 584 (set! node2 (proc node2 db)) )) 585 579 586 (debugging 'p "optimization pass" i) 580 587 -
chicken/branches/lfa/buildversion
r12320 r12338 1 4.0.0x1 1 4.0.0x1-lfa -
chicken/branches/lfa/c-platform.scm
r12301 r12338 35 35 standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false 36 36 installation-home debugging intrinsic? 37 dump-nodes unlikely-variables 37 dump-nodes unlikely-variables varnode? 38 38 unit-name insert-timer-checks used-units inlining 39 39 foreign-declarations block-compilation line-number-database-size … … 370 370 (let ([arg1 (first callargs)] 371 371 [arg2 (second callargs)] ) 372 (or (and (eq? '##core#variable (node-class arg1)) 373 (eq? '##core#variable (node-class arg2)) 372 (or (and (varnode? arg1) (varnode? arg2) 374 373 (equal? (node-parameters arg1) (node-parameters arg2)) 375 374 (make-node '##core#call '(#t) (list cont (qnode #t))) ) … … 393 392 (let ([arg1 (first callargs)] 394 393 [arg2 (second callargs)] ) 395 (or (and (eq? '##core#variable (node-class arg1)) 396 (eq? '##core#variable (node-class arg2)) 394 (or (and (varnode? arg1) (varnode? arg2) 397 395 (equal? (node-parameters arg1) (node-parameters arg2)) 398 396 (make-node '##core#call '(#t) (list cont (qnode #t))) ) … … 425 423 cont 426 424 (append (cdr (butlast callargs)) (map qnode (first (node-parameters lastarg)))) ) ) 427 (or (and ( eq? '##core#variable (node-class proc))425 (or (and (varnode? proc) 428 426 (= 2 (length callargs)) 429 427 (let ([name (car (node-parameters proc))]) … … 458 456 (list 459 457 cont 460 (cond [(and ( eq? '##core#variable (node-class arg))458 (cond [(and (varnode? arg) 461 459 (eq? 'vector (get db (first (node-parameters arg)) 'rest-parameter)) ) 462 460 (make-node … … 496 494 (let ((arg1 (car callargs)) 497 495 (arg2 (cadr callargs)) ) 498 (and ( eq? '##core#variable (node-class arg1)) ; probably not needed499 ( eq? '##core#variable (node-class arg2))496 (and (varnode? arg1) ; probably not needed 497 (varnode? arg2) 500 498 (and-let* ((sym (car (node-parameters arg2))) 501 499 (val (get db sym 'value)) ) … … 991 989 (and (= 1 (length callargs)) 992 990 (let ([val (first callargs)]) 993 (and ( eq? '##core#variable (node-class val))991 (and (varnode? val) 994 992 (and-let* ([proc (get db (first (node-parameters val)) 'value)] 995 993 [(eq? '##core#lambda (node-class proc))] ) … … 1042 1040 (and (= 1 (length callargs)) 1043 1041 (let ((arg (car callargs))) 1044 (and ( eq? '##core#variable (node-class arg))1042 (and (varnode? arg) 1045 1043 (let ((sym (car (node-parameters arg)))) 1046 1044 (and (intrinsic? sym) … … 1061 1059 '##core#call '(#t) 1062 1060 (list cont 1063 (if (and ( eq? '##core#variable (node-class arg))1061 (if (and (varnode? arg) 1064 1062 (not (get db (car (node-parameters arg)) 'global)) ) 1065 1063 (qnode #t) -
chicken/branches/lfa/compiler.scm
r12301 r12338 1729 1729 (grow 1) 1730 1730 (let ([fun (car subs)]) 1731 (if ( eq? '##core#variable (node-class fun))1731 (if (varnode? fun) 1732 1732 (let ([name (first (node-parameters fun))]) 1733 1733 (collect! db name 'call-sites (cons here n)) … … 1737 1737 (for-each 1738 1738 (lambda (arg) 1739 (and-let* ([( eq? '##core#variable (node-class arg))]1739 (and-let* ([(varnode? arg)] 1740 1740 [var (first (node-parameters arg))] ) 1741 1741 (when (get db var 'rest-parameter) (count! db var 'o-r/access-count)) ) ) … … 1832 1832 (cond ((eq? '##core#undefined (node-class val)) 1833 1833 (put! db var 'undefined #t) ) 1834 ((and ( eq? '##core#variable (node-class val))1834 ((and (varnode val) 1835 1835 (eq? var (first (node-parameters val))) ) ) 1836 1836 ((or block-compilation … … 2030 2030 (null? references) 2031 2031 (or (and value 2032 (or (not ( eq? '##core#variable (node-class value)))2032 (or (not (varnode? value)) 2033 2033 (not (get db (first (node-parameters value)) 'global)) ) 2034 2034 (not (expression-has-side-effects? value db)) ) … … 2044 2044 ;; it was contracted). 2045 2045 (when (and value (not global)) 2046 (when ( eq? '##core#variable (node-class value))2046 (when (varnode? value) 2047 2047 (let* ([name (first (node-parameters value))] 2048 2048 [nrefs (get db name 'references)] ) … … 2071 2071 (let ([v1 (first subs)] 2072 2072 [v2 (second subs)] ) 2073 (when (and (eq? '##core#variable (node-class v1)) 2074 (eq? '##core#variable (node-class v2)) 2073 (when (and (varnode? v1) (varnode? v2) 2075 2074 (eq? (first llist) (first (node-parameters v2))) ) 2076 2075 (let ([kvar (first (node-parameters v1))]) … … 2136 2135 [mode (first params)] 2137 2136 [name (and (pair? (cdr params)) (second params))] 2138 [varfn ( eq? '##core#variable (node-class fn))] )2137 [varfn (varnode? fn)] ) 2139 2138 (node-parameters-set! 2140 2139 n … … 2455 2454 [subs (mapwalk subs e here boxes)] ) 2456 2455 (make-node 2457 (cond [(and ( eq? '##core#variable (node-class b))2456 (cond [(and (varnode? b) 2458 2457 (memq (first (node-parameters b)) boxes) ) 2459 2458 (set! fastinits (add1 fastinits)) -
chicken/branches/lfa/manual/The User's Manual
r12320 r12338 3 3 == The User's Manual 4 4 5 This is the user's manual for the Chicken Scheme compiler, version 4.0.0x1 5 This is the user's manual for the Chicken Scheme compiler, version 4.0.0x1-lfa 6 6 7 7 ; [[Overview]] : What is Chicken? -
chicken/branches/lfa/optimizer.scm
r12301 r12338 191 191 192 192 ((##core#call) 193 (if ( eq? '##core#variable (node-class (car subs)))193 (if (varnode? (car subs)) 194 194 (let ((var (first (node-parameters (car subs))))) 195 195 (if (and (intrinsic? var) … … 298 298 [(memq var constant-declarations) 299 299 (or (and-let* ((k (car args)) 300 (( eq? '##core#variable (node-class k)))300 ((varnode? k)) 301 301 (kvar (first (node-parameters k))) 302 302 (lval (and (not (test kvar 'unknown)) (test kvar 'value))) … … 477 477 (let ((iftest (first (node-subexpressions body)))) 478 478 ;; Parameter is used only once and is the test-argument? 479 (if (and ( eq? '##core#variable (node-class iftest))479 (if (and (varnode? iftest) 480 480 (eq? var (first (node-parameters iftest))) ) 481 481 ;; Modify call-site to call continuation directly and swap branches … … 518 518 ;; Parameter is used only once and is the test-argument? 519 519 (if (and refs (= 1 (length refs)) 520 ( eq? '##core#variable (node-class iftest))520 (varnode? iftest) 521 521 (eq? var (first (node-parameters iftest))) ) 522 522 (let ((bodysubs (node-subexpressions body))) … … 865 865 (let ((arg1 (first callargs)) 866 866 (arg2 (second callargs)) ) 867 (and (eq? '##core#variable (node-class arg1)) 868 (eq? '##core#variable (node-class arg2)) 867 (and (varnode? arg1) (varnode? arg2) 869 868 (equal? (node-parameters arg1) (node-parameters arg2)) 870 869 (make-node '##core#call '(#t) (list cont (qnode #t))) ) ) ) … … 888 887 cont 889 888 (cond [(and iopv 890 ( eq? '##core#variable (node-class arg1))889 (varnode? arg1) 891 890 (eq? 'vector (get db (first (node-parameters arg1)) 'rest-parameter)) ) 892 891 (make-node '##core#inline (list iopv) callargs) ] … … 1334 1333 [(##core#call) 1335 1334 (let ([fn (first subs)]) 1336 (and ( eq? '##core#variable (node-class fn))1335 (and (varnode? fn) 1337 1336 (let ([v (first (node-parameters fn))]) 1338 1337 (cond [(eq? v fnvar) 1339 1338 (and (zero? allocated) 1340 1339 (let ([k (second subs)]) 1341 (when ( eq? '##core#variable (node-class k))1340 (when (varnode? k) 1342 1341 (set! inner-ks (cons (first (node-parameters k)) inner-ks)) ) 1343 1342 (set! recursive #t) … … 1392 1391 [fnp (node-parameters fn)] 1393 1392 [arg0p (node-parameters arg0)] ) 1394 (when ( eq? '##core#variable (node-class fn))1393 (when (varnode? fn) 1395 1394 (cond [(eq? fnvar (first fnp)) 1396 1395 (set! ksites (alist-cons #f n ksites)) … … 1655 1654 (call-with-current-continuation 1656 1655 (lambda (return) 1657 (when ( eq? '##core#variable (node-class fn))1656 (when (varnode? fn) 1658 1657 (let ([done '()]) 1659 1658 (let loop ([name (first (node-parameters fn))]) … … 1780 1779 [(##core#call) 1781 1780 (let ([fn (first subs)]) 1782 (when ( eq? '##core#variable (node-class fn))1781 (when (varnode? fn) 1783 1782 (let ([a (assq (first (node-parameters fn)) extra)]) 1784 1783 (when a -
chicken/branches/lfa/support.scm
r12301 r12338 45 45 block-variable-literal? copy-node! valid-c-identifier? tree-copy copy-node-tree-and-rename 46 46 direct-call-ids foreign-type-table first-analysis scan-sharp-greater-string 47 make-block-variable-literal block-variable-literal-name variable-mark 47 make-block-variable-literal block-variable-literal-name variable-mark varnode? 48 48 expand-profile-lambda profile-lambda-list profile-lambda-index profile-info-vector-name 49 49 initialize-compiler canonicalize-expression expand-foreign-lambda update-line-number-database scan-toplevel-assignments … … 482 482 (define (varnode var) (make-node '##core#variable (list var) '())) 483 483 (define (qnode const) (make-node 'quote (list const) '())) 484 485 (define (varnode? node) 486 (memq (node-class node) '(##core#variable ##core#global-ref))) 484 487 485 488 (define (build-node-graph exp) … … 782 785 (let* ([subs (node-subexpressions n)] 783 786 [f (first subs)] ) 784 (and ( eq? '##core#variable (node-class f))787 (and (varnode? f) 785 788 (eq? k (first (node-parameters f))) 786 789 (every rec (cdr subs)) ) ) ] -
chicken/branches/lfa/version.scm
r12320 r12338 1 (define-constant +build-version+ "4.0.0x1 ")1 (define-constant +build-version+ "4.0.0x1-lfa")
Note: See TracChangeset
for help on using the changeset viewer.