Changeset 12338 in project


Ignore:
Timestamp:
11/03/08 01:40:55 (12 years ago)
Author:
felix winkelmann
Message:

added lfa branch; variable-node check didn't take ##core#global-ref into account

Location:
chicken/branches
Files:
1 added
11 edited
1 copied

Legend:

Unmodified
Added
Removed

  • chicken/branches/README

    r12214 r12338  
    2828  regular expression package (currently worked on by felix and Alex).
    2929
    30 * cmi
     30* lfa
    3131
    32   Experimental branch for impoving inlining and the implementation of
    33   cross-module inlining (maintained by felix).
     32  An attempt to implement "localized" flow- and type analysis (worked on
     33  by felix).

  • chicken/branches/lfa/README

    r12320 r12338  
    33  (c)2000-2008 Felix L. Winkelmann
    44
    5   version 4.0.0x1
     5  version 4.0.0x1-lfa
    66
    77

  • chicken/branches/lfa/batch-driver.scm

    r12308 r12338  
    8585(define user-pass-2 (make-parameter #f))
    8686(define user-post-analysis-pass (make-parameter #f))
     87(define user-optimization-pass (make-parameter #f))
    8788
    8889
    … …  
    577578
    578579                     (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
    579586                            (debugging 'p "optimization pass" i)
    580587

  • chicken/branches/lfa/buildversion

    r12320 r12338  
    1 4.0.0x1
     14.0.0x1-lfa

  • chicken/branches/lfa/c-platform.scm

    r12301 r12338  
    3535  standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
    3636  installation-home debugging intrinsic?
    37   dump-nodes unlikely-variables
     37  dump-nodes unlikely-variables varnode?
    3838  unit-name insert-timer-checks used-units inlining
    3939  foreign-declarations block-compilation line-number-database-size
    … …  
    370370         (let ([arg1 (first callargs)]
    371371               [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)
    374373                    (equal? (node-parameters arg1) (node-parameters arg2))
    375374                    (make-node '##core#call '(#t) (list cont (qnode #t))) )
    … …  
    393392        (let ([arg1 (first callargs)]
    394393              [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)
    397395                   (equal? (node-parameters arg1) (node-parameters arg2))
    398396                   (make-node '##core#call '(#t) (list cont (qnode #t))) )
    … …  
    425423                       cont
    426424                       (append (cdr (butlast callargs)) (map qnode (first (node-parameters lastarg)))) ) )
    427                (or (and (eq? '##core#variable (node-class proc))
     425               (or (and (varnode? proc)
    428426                        (= 2 (length callargs))
    429427                        (let ([name (car (node-parameters proc))])
    … …  
    458456                  (list
    459457                   cont
    460                    (cond [(and (eq? '##core#variable (node-class arg))
     458                   (cond [(and (varnode? arg)
    461459                               (eq? 'vector (get db (first (node-parameters arg)) 'rest-parameter)) )
    462460                          (make-node
    … …  
    496494        (let ((arg1 (car callargs))
    497495              (arg2 (cadr callargs)) )
    498           (and (eq? '##core#variable (node-class arg1)) ; probably not needed
    499                (eq? '##core#variable (node-class arg2))
     496          (and (varnode? arg1)  ; probably not needed
     497               (varnode? arg2)
    500498               (and-let* ((sym (car (node-parameters arg2)))
    501499                          (val (get db sym 'value)) )
    … …  
    991989    (and (= 1 (length callargs))
    992990         (let ([val (first callargs)])
    993            (and (eq? '##core#variable (node-class val))
     991           (and (varnode? val)
    994992                (and-let* ([proc (get db (first (node-parameters val)) 'value)]
    995993                           [(eq? '##core#lambda (node-class proc))] )
    … …  
    10421040   (and (= 1 (length callargs))
    10431041        (let ((arg (car callargs)))
    1044           (and (eq? '##core#variable (node-class arg))
     1042          (and (varnode? arg)
    10451043               (let ((sym (car (node-parameters arg))))
    10461044                 (and (intrinsic? sym)
    … …  
    10611059           '##core#call '(#t)
    10621060           (list cont
    1063                  (if (and (eq? '##core#variable (node-class arg))
     1061                 (if (and (varnode? arg)
    10641062                          (not (get db (car (node-parameters arg)) 'global)) )
    10651063                     (qnode #t)

  • chicken/branches/lfa/compiler.scm

    r12301 r12338  
    17291729           (grow 1)
    17301730           (let ([fun (car subs)])
    1731              (if (eq? '##core#variable (node-class fun))
     1731             (if (varnode? fun)
    17321732                 (let ([name (first (node-parameters fun))])
    17331733                   (collect! db name 'call-sites (cons here n))
    … …  
    17371737                       (for-each
    17381738                        (lambda (arg)
    1739                           (and-let* ([(eq? '##core#variable (node-class arg))]
     1739                          (and-let* ([(varnode? arg)]
    17401740                                     [var (first (node-parameters arg))] )
    17411741                            (when (get db var 'rest-parameter) (count! db var 'o-r/access-count)) ) )
    … …  
    18321832      (cond ((eq? '##core#undefined (node-class val))
    18331833             (put! db var 'undefined #t) )
    1834             ((and (eq? '##core#variable (node-class val))
     1834            ((and (varnode val)
    18351835                  (eq? var (first (node-parameters val))) ) )
    18361836            ((or block-compilation
    … …  
    20302030                    (null? references)
    20312031                    (or (and value
    2032                              (or (not (eq? '##core#variable (node-class value)))
     2032                             (or (not (varnode? value))
    20332033                                 (not (get db (first (node-parameters value)) 'global)) )
    20342034                             (not (expression-has-side-effects? value db)) )
    … …  
    20442044         ;;    it was contracted).
    20452045         (when (and value (not global))
    2046            (when (eq? '##core#variable (node-class value))
     2046           (when (varnode? value)
    20472047             (let* ([name (first (node-parameters value))]
    20482048                    [nrefs (get db name 'references)] )
    … …  
    20712071                       (let ([v1 (first subs)]
    20722072                             [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)
    20752074                                    (eq? (first llist) (first (node-parameters v2))) )
    20762075                           (let ([kvar (first (node-parameters v1))])
    … …  
    21362135                  [mode (first params)]
    21372136                  [name (and (pair? (cdr params)) (second params))]
    2138                   [varfn (eq? '##core#variable (node-class fn))] )
     2137                  [varfn (varnode? fn)] )
    21392138             (node-parameters-set!
    21402139              n
    … …  
    24552454                  [subs (mapwalk subs e here boxes)] )
    24562455             (make-node
    2457               (cond [(and (eq? '##core#variable (node-class b))
     2456              (cond [(and (varnode? b)
    24582457                          (memq (first (node-parameters b)) boxes) )
    24592458                     (set! fastinits (add1 fastinits))

  • chicken/branches/lfa/manual/The User's Manual

    r12320 r12338  
    33== The User's Manual
    44
    5 This is the user's manual for the Chicken Scheme compiler, version 4.0.0x1
     5This is the user's manual for the Chicken Scheme compiler, version 4.0.0x1-lfa
    66
    77; [[Overview]] : What is Chicken?

  • chicken/branches/lfa/optimizer.scm

    r12301 r12338  
    191191
    192192               ((##core#call)
    193                 (if (eq? '##core#variable (node-class (car subs)))
     193                (if (varnode? (car subs))
    194194                    (let ((var (first (node-parameters (car subs)))))
    195195                      (if (and (intrinsic? var)
    … …  
    298298                        [(memq var constant-declarations)
    299299                         (or (and-let* ((k (car args))
    300                                         ((eq? '##core#variable (node-class k)))
     300                                        ((varnode? k))
    301301                                        (kvar (first (node-parameters k)))
    302302                                        (lval (and (not (test kvar 'unknown)) (test kvar 'value)))
    … …  
    477477                             (let ((iftest (first (node-subexpressions body))))
    478478                               ;; Parameter is used only once and is the test-argument?
    479                                (if (and (eq? '##core#variable (node-class iftest))
     479                               (if (and (varnode? iftest)
    480480                                        (eq? var (first (node-parameters iftest))) )
    481481                                   ;; Modify call-site to call continuation directly and swap branches
    … …  
    518518                            ;; Parameter is used only once and is the test-argument?
    519519                            (if (and refs (= 1 (length refs))
    520                                      (eq? '##core#variable (node-class iftest))
     520                                     (varnode? iftest)
    521521                                     (eq? var (first (node-parameters iftest))) )
    522522                                (let ((bodysubs (node-subexpressions body)))
    … …  
    865865                   (let ((arg1 (first callargs))
    866866                         (arg2 (second callargs)) )
    867                      (and (eq? '##core#variable (node-class arg1))
    868                           (eq? '##core#variable (node-class arg2))
     867                     (and (varnode? arg1) (varnode? arg2)
    869868                          (equal? (node-parameters arg1) (node-parameters arg2))
    870869                          (make-node '##core#call '(#t) (list cont (qnode #t))) ) ) )
    … …  
    888887              cont
    889888              (cond [(and iopv
    890                           (eq? '##core#variable (node-class arg1))
     889                          (varnode? arg1)
    891890                          (eq? 'vector (get db (first (node-parameters arg1)) 'rest-parameter)) )
    892891                     (make-node '##core#inline (list iopv) callargs) ]
    … …  
    13341333              [(##core#call)
    13351334               (let ([fn (first subs)])
    1336                  (and (eq? '##core#variable (node-class fn))
     1335                 (and (varnode? fn)
    13371336                      (let ([v (first (node-parameters fn))])
    13381337                        (cond [(eq? v fnvar)
    13391338                               (and (zero? allocated)
    13401339                                    (let ([k (second subs)])
    1341                                       (when (eq? '##core#variable (node-class k))
     1340                                      (when (varnode? k)
    13421341                                        (set! inner-ks (cons (first (node-parameters k)) inner-ks)) )
    13431342                                      (set! recursive #t)
    … …  
    13921391                         [fnp (node-parameters fn)]
    13931392                         [arg0p (node-parameters arg0)] )
    1394                     (when (eq? '##core#variable (node-class fn))
     1393                    (when (varnode? fn)
    13951394                      (cond [(eq? fnvar (first fnp))
    13961395                             (set! ksites (alist-cons #f n ksites))
    … …  
    16551654               (call-with-current-continuation
    16561655                (lambda (return)
    1657                   (when (eq? '##core#variable (node-class fn))
     1656                  (when (varnode? fn)
    16581657                    (let ([done '()])
    16591658                      (let loop ([name (first (node-parameters fn))])
    … …  
    17801779            [(##core#call)
    17811780             (let ([fn (first subs)])
    1782                (when (eq? '##core#variable (node-class fn))
     1781               (when (varnode? fn)
    17831782                 (let ([a (assq (first (node-parameters fn)) extra)])
    17841783                   (when a

  • chicken/branches/lfa/support.scm

    r12301 r12338  
    4545  block-variable-literal? copy-node! valid-c-identifier? tree-copy copy-node-tree-and-rename
    4646  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?
    4848  expand-profile-lambda profile-lambda-list profile-lambda-index profile-info-vector-name
    4949  initialize-compiler canonicalize-expression expand-foreign-lambda update-line-number-database scan-toplevel-assignments
    … …  
    482482(define (varnode var) (make-node '##core#variable (list var) '()))
    483483(define (qnode const) (make-node 'quote (list const) '()))
     484
     485(define (varnode? node)
     486  (memq (node-class node) '(##core#variable ##core#global-ref)))
    484487
    485488(define (build-node-graph exp)
    … …  
    782785              (let* ([subs (node-subexpressions n)]
    783786                     [f (first subs)] )
    784                 (and (eq? '##core#variable (node-class f))
     787                (and (varnode? f)
    785788                     (eq? k (first (node-parameters f)))
    786789                     (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.