Changeset 12134 in project


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

uses proplists instead of some global lists; added 'local' declaration and option (not used yet)

Location:
chicken/branches/cmi
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/cmi/TODO

    r12130 r12134  
    4343*** would inline in other compilation units, but not in current (sort of confusing)
    4444** remove "custom-declare" + stuff?
    45 ** "assume-no-redefinitions" mode?
    46    like Gambit's block-mode (?): single toplevel assignment makes assigned
    47    variable known (and allows inlining/contraction)
    4845** when inlining, consing arg-list with "list" may make get-keyword possible foldable
    49 ** using plists instead of symbol lists (block-globals, etc.) might speed up things
     46** using plists instead of symbol lists might speed up things
     47   standard-bindings
     48   extended-bindings
     49   inline-list
     50   not-inline-list
    5051
    5152* tests
  • chicken/branches/cmi/batch-driver.scm

    r12088 r12134  
    3737  non-foldable-standard-bindings foldable-standard-bindings non-foldable-extended-bindings foldable-extended-bindings
    3838  standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
    39   compiler-cleanup-hook disabled-warnings
     39  compiler-cleanup-hook disabled-warnings local-definitions
    4040  file-io-only undefine-shadowed-macros profiled-procedures
    4141  unit-name insert-timer-checks used-units inline-max-size
     
    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   export-list do-lambda-lifting compiler-warning export-file-name
     72  do-lambda-lifting compiler-warning export-file-name
    7373  foreign-argument-conversion foreign-result-conversion)
    7474
     
    237237    (when (memq 'no-lambda-info options)
    238238      (set! emit-closure-info #f) )
    239     (when (memq 'check-imports options) ;***
    240       (compiler-warning 'usage "deprecated compiler option: -check-imports")) ;***
    241     (when (memq 'import options)        ;***
    242       (compiler-warning 'usage "deprecated compiler option: -import")) ;***
     239    (when (memq 'local options)
     240      (set! local-definitions #t))
    243241    (set! disabled-warnings (map string->symbol (collect-options 'disable-warning)))
    244242    (when (memq 'no-warnings options)
  • chicken/branches/cmi/c-platform.scm

    r12086 r12134  
    118118    check-syntax to-stdout no-usual-integrations case-insensitive no-lambda-info
    119119    profile inline keep-shadowed-macros
    120     fixnum-arithmetic disable-interrupts optimize-leaf-routines check-imports
     120    fixnum-arithmetic disable-interrupts optimize-leaf-routines
    121121    lambda-lift compile-syntax tag-pointers accumulate-profile
    122122    disable-stack-overflow-checks disable-c-syntax-checks unsafe-libraries raw
    123     emit-external-prototypes-first release
     123    emit-external-prototypes-first release local
    124124    analyze-only dynamic extension) )
    125125
    126126(define valid-compiler-options-with-argument
    127127  '(debug output-file include-path heap-size stack-size unit uses keyword-style require-extension
    128           inline-limit profile-name disable-warning emit-exports import
     128          inline-limit profile-name disable-warning
    129129    prelude postlude prologue epilogue nursery extend feature
    130130    emit-import-library
  • chicken/branches/cmi/compiler.scm

    r12114 r12134  
    7373; (unused <symbol> ...)
    7474; (uses {<unitname>})
     75; ([not] local {<name> ...})
    7576;
    7677;   <type> = fixnum | generic
     
    263264  profile-info-vector-name finish-foreign-result pending-canonicalizations
    264265  foreign-declarations emit-trace-info block-compilation line-number-database-size
    265   always-bound-to-procedure block-globals make-block-variable-literal block-variable-literal? block-variable-literal-name
     266  make-block-variable-literal block-variable-literal? block-variable-literal-name
    266267  target-heap-size target-stack-size valid-c-identifier? profiled-procedures standalone-executable
    267268  target-initial-heap-size internal-bindings source-filename dump-nodes source-info->string
     
    273274  direct-call-ids foreign-type-table first-analysis callback-names disabled-warnings
    274275  initialize-compiler canonicalize-expression expand-foreign-lambda update-line-number-database! scan-toplevel-assignments
    275   compiler-warning
     276  compiler-warning variable-visible? hide-variable mark-variable
    276277  perform-cps-conversion analyze-expression simplifications perform-high-level-optimizations perform-pre-optimization!
    277278  reorganize-recursive-bindings substitution-table simplify-named-call inline-max-size
     
    287288  simple-lambda-node? compute-database-statistics print-program-statistics output gen gen-list
    288289  pprint-expressions-to-file foreign-type-check estimate-foreign-result-size scan-used-variables scan-free-variables
    289   topological-sort print-version print-usage initialize-analysis-database export-list csc-control-file
     290  topological-sort print-version print-usage initialize-analysis-database csc-control-file
    290291  estimate-foreign-result-location-size unused-variables
    291292  expand-foreign-callback-lambda default-optimization-passes default-optimization-passes-when-trying-harder
     
    295296  make-random-name final-foreign-type real-name-table real-name set-real-name! safe-globals-flag
    296297  location-pointer-map literal-rewrite-hook
     298  local-definitions export-variable variable-mark
    297299  undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info
    298300  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
     
    336338(define used-units '())
    337339(define unsafe #f)
    338 (define always-bound '())
    339 (define always-bound-to-procedure '())
    340340(define foreign-declarations '())
    341341(define emit-trace-info #f)
     
    350350(define no-argc-checks #f)
    351351(define no-procedure-checks #f)
    352 (define block-globals '())
    353352(define source-filename #f)
    354 (define export-list #f)
    355353(define safe-globals-flag #f)
    356354(define explicit-use-flag #f)
     
    367365(define import-libraries '())
    368366(define standalone-executable #t)
     367(define local-definitions #f)
    369368
    370369
     
    576575                                  (let ([var (gensym 'c)])
    577576                                    (set! immutable-constants (alist-cons c var immutable-constants))
    578                                     (set! always-bound (cons var always-bound))
    579                                     (set! block-globals (cons var block-globals))
     577                                    (mark-variable var '##compiler#always-bound)
     578                                    (hide-variable var)
    580579                                    var) ] ) ) )
    581580
     
    871870                             (set! var (##sys#alias-global-hook var #t))
    872871                             (when safe-globals-flag
    873                                (set! always-bound-to-procedure
    874                                  (lset-adjoin eq? always-bound-to-procedure var))
    875                                (set! always-bound (lset-adjoin eq? always-bound var)) )
     872                               (mark-variable var '##compiler#always-bound-to-procedure)
     873                               (mark-variable var '##compiler#always-bound))
    876874                             (when (macro? var)
    877875                               (compiler-warning
     
    983981                                        [ret (gensym)] )
    984982                                    (##sys#hash-table-set! foreign-type-table name (vector type arg ret))
    985                                     (set! always-bound (cons* arg ret always-bound))
    986                                     (set! block-globals (cons* arg ret block-globals))
     983                                    (mark-variable arg '##compiler#always-bound)
     984                                    (mark-variable ret '##compiler#always-bound)
     985                                    (hide-variable arg)
     986                                    (hide-variable ret)
    987987                                    (walk
    988988                                     `(,(macro-alias 'begin se)
     
    10641064                                    (##sys#hash-table-set! constant-table name (list var))
    10651065                                    (set! mutable-constants (alist-cons var val mutable-constants))
    1066                                     (set! block-globals (cons var block-globals))
    1067                                     (set! always-bound (cons var always-bound))
     1066                                    (hide-variable var)
     1067                                    (mark-variable var '##compiler#always-bound)
    10681068                                    (walk `(define ,var ',val) se #f) ) ] ) ) )
    10691069
     
    12911291          (append (strip (cdr spec)) disabled-warnings)))
    12921292       ((always-bound)
    1293         (set! always-bound (append (stripa (cdr spec)) always-bound)))
     1293        (for-each (cut mark-variable <> '##compiler#always-bound) (stripa (cdr spec))))
    12941294       ((safe-globals) (set! safe-globals-flag #t))
    12951295       ((no-procedure-checks-for-usual-bindings)
    1296         (set! always-bound-to-procedure
    1297           (append default-standard-bindings default-extended-bindings always-bound-to-procedure))
    1298         (set! always-bound
    1299           (append default-standard-bindings default-extended-bindings always-bound)) )
     1296        (for-each
     1297         (cut mark-variable <> '##compiler#always-bound-to-procedure)
     1298         (append default-standard-bindings default-extended-bindings))
     1299        (for-each
     1300         (cut mark-variable <> '##compiler#always-bound)
     1301         (append default-standard-bindings default-extended-bindings)))
    13001302       ((bound-to-procedure)
    13011303        (let ((vars (stripa (cdr spec))))
    1302           (set! always-bound-to-procedure (append vars always-bound-to-procedure))
    1303           (set! always-bound (append vars always-bound)) ) )
     1304          (for-each (cut mark-variable <> '##compiler#always-bound-to-procedure) vars)
     1305          (for-each (cut mark-variable <> '##compiler#always-bound) vars)))
    13041306       ((foreign-declare)
    13051307        (let ([fds (cdr spec)])
     
    13521354                    (set! standard-bindings (lset-difference eq? default-standard-bindings syms))
    13531355                    (set! extended-bindings (lset-difference eq? default-extended-bindings syms)) ) ] ) ]
     1356          ((local)
     1357           (if (null? (cddr spec))
     1358               (set! local-definitions #f)
     1359               (for-each (cut remprop! <> '##compiler#local) (stripa (cddr spec)))))
    13541360          [else
    13551361           (check-decl spec 1 1)
     
    13641370       ((block-global hide)
    13651371        (let ([syms (stripa (cdr spec))])
    1366           (when export-list
    1367             (set! export-list (lset-difference eq? export-list syms)) )
    1368           (set! block-globals (lset-union eq? syms block-globals)) ) )
     1372          (for-each hide-variable syms)))
    13691373       ((export)
    13701374        (let ((syms (stripa (cdr spec))))
    1371           (set! block-globals (lset-difference eq? block-globals syms))
    1372           (set! export-list (lset-union eq? syms (or export-list '())))))
     1375          (for-each export-variable syms)))
    13731376       ((emit-external-prototypes-first)
    13741377        (set! external-protos-first #t) )
     
    14111414          (append (stripa (cdr spec))
    14121415                  (or profiled-procedures '()))))
     1416       ((local)
     1417        (cond ((null? (cdr spec))
     1418               (set! local-definitions #t) )
     1419              (else
     1420               (for-each
     1421                (cut ##sys#put! <> '##compiler#local #t)
     1422                (stripa (cdr spec))))))
    14131423       (else (compiler-warning 'syntax "illegal declaration specifier `~s'" spec)) )
    14141424     '(##core#undefined) ) ) )
     
    17671777                        (not (memq var env)) )
    17681778               (grow 1)
    1769                (when first-analysis
    1770                  (when (or block-compilation (and export-list (not (memq var export-list))))
    1771                    (set! block-globals (lset-adjoin eq? block-globals var)) ) )
    17721779               (put! db var 'global #t) )
    17731780             (assign var val (append localenv env) here)
     
    17961803                 (get db var 'constant)
    17971804                 ;;(memq var inline-list)       - would be nice, but might be customized...
    1798                  (memq var block-globals) )
     1805                 (not (variable-visible? var)))
    17991806             (let ((props (get-all db var 'unknown 'value))
    18001807                   (home (get db var 'home)) )
     
    18861893           (when assigned-locally
    18871894             (compiler-warning 'var "local assignment to unused variable `~S' may be unintended" sym) )
    1888            (when (and (or block-compilation
    1889                           (and export-list (not (memq sym export-list))) )
     1895           (when (and (not (variable-visible? sym))
    18901896                      (not (assq sym mutable-constants)) )
    18911897             (compiler-warning 'var "global variable `~S' is never used" sym) ) )
     
    23212327                       no-bound-checks
    23222328                       unsafe
    2323                        (memq var always-bound)
     2329                       (variable-mark var '##compiler#always-bound)
    23242330                       (get db var 'standard-binding)
    23252331                       (get db var 'extended-binding) ) ]
    2326              [blockvar (memq var block-globals)] )
     2332             [blockvar (and (get db var 'assigned)
     2333                            (not (variable-visible? var)))])
    23272334        (when blockvar (set! fastrefs (add1 fastrefs)))
    23282335        (make-node
     
    24662473                           [safe (not (or no-bound-checks
    24672474                                          unsafe
    2468                                           (memq var always-bound)
     2475                                          (variable-mark var '##compiler#always-bound)
    24692476                                          (get db var 'standard-binding)
    24702477                                          (get db var 'extended-binding) ) ) ]
    2471                            [blockvar (memq var block-globals)]
     2478                           [blockvar (not (variable-visible? var))]
    24722479                           [immf (or (and (eq? cval 'quote) (immediate? (first (node-parameters val))))
    24732480                                     (eq? '##core#undefined cval) ) ] )
  • chicken/branches/cmi/csc.scm

    r12086 r12134  
    175175    -block -disable-interrupts -fixnum-arithmetic -to-stdout -profile -raw -accumulate-profile
    176176    -check-syntax -case-insensitive -benchmark-mode -shared -compile-syntax -no-lambda-info
    177     -lambda-lift -dynamic -disable-stack-overflow-checks -emit-debug-info
     177    -lambda-lift -dynamic -disable-stack-overflow-checks -emit-debug-info -local
    178178    -emit-external-prototypes-first -inline -extension -release -static-extensions
    179179    -analyze-only -keep-shadowed-macros))
     
    376376    -N  -no-usual-integrations  standard procedures may be redefined
    377377    -u  -unsafe                 disable safety checks
     378    -local                      assume globals are only modified in current file
    378379    -b  -block                  enable block-compilation
    379380    -disable-interrupts         disable interrupts in compiled code
  • chicken/branches/cmi/optimizer.scm

    r12101 r12134  
    3434  standard-bindings-that-never-return-false side-effect-free-standard-bindings-that-never-return-false
    3535  installation-home decompose-lambda-list external-to-pointer
    36   copy-node! export-list inline-list not-inline-list
    37   unit-name insert-timer-checks used-units external-variables
     36  copy-node! inline-list not-inline-list variable-visible? mark-variable
     37  unit-name insert-timer-checks used-units external-variables hide-variable
    3838  debug-info-index debug-info-vector-name profile-info-vector-name
    3939  foreign-declarations emit-trace-info block-compilation line-number-database-size
    40   always-bound-to-procedure block-globals make-block-variable-literal block-variable-literal? block-variable-literal-name
    41   target-heap-size target-stack-size constant-declarations
     40  make-block-variable-literal block-variable-literal? block-variable-literal-name
     41  target-heap-size target-stack-size constant-declarations variable-mark
    4242  default-default-target-heap-size default-default-target-stack-size verbose-mode original-program-size
    4343  current-program-size line-number-database-2 foreign-lambda-stubs immutable-constants foreign-variables
     
    120120       (scan node '()) ) )
    121121    (debugging 'o "safe globals" safe)
    122     (set! always-bound (append safe always-bound)) ) )
     122    (for-each (cut mark-variable <> '##compiler#always-bound) safe)))
    123123
    124124
     
    390390                    (make-node '##core#undefined '() '()) ]
    391391                   [(and (or (not (test var 'global))
    392                              block-compilation
    393                              (and export-list (not (memq var export-list)))
    394                              (memq var block-globals))
     392                             (not (variable-visible? var)))
    395393                         (not (test var 'references))
    396394                         (not (expression-has-side-effects? (first subs) db)) )
     
    17201718           (let* ([name (car gn)]
    17211719                  [lval (get db name 'value)] )
    1722              (set! block-globals (cons name block-globals))
     1720             (hide-variable name)
    17231721             (decompose-lambda-list
    17241722              (first (node-parameters lval))
  • chicken/branches/cmi/support.scm

    r12109 r12134  
    3838  unit-name insert-timer-checks used-units source-filename pending-canonicalizations
    3939  foreign-declarations block-compilation line-number-database-size
    40   target-heap-size target-stack-size
     40  target-heap-size target-stack-size variable-visible? hide-variable export-variable
    4141  default-default-target-heap-size default-default-target-stack-size verbose-mode original-program-size
    4242  current-program-size line-number-database-2 foreign-lambda-stubs immutable-constants foreign-variables
    4343  rest-parameters-promoted-to-vector inline-table inline-table-used constant-table constants-used mutable-constants
    4444  dependency-list broken-constant-nodes inline-substitutions-enabled emit-syntax-trace-info
    45   always-bound-to-procedure block-variable-literal? copy-node! valid-c-identifier? tree-copy copy-node-tree-and-rename
     45  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
     47  make-block-variable-literal block-variable-literal-name variable-mark
    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
     
    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
     56  constant? basic-literal? source-info->string mark-variable
    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
     
    6767  default-optimization-iterations chop-separator chop-extension follow-without-loop
    6868  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    69   foreign-argument-conversion foreign-result-conversion final-foreign-type debugging export-list block-globals
     69  foreign-argument-conversion foreign-result-conversion final-foreign-type debugging block-globals
    7070  constant-declarations process-lambda-documentation big-fixnum?
    7171  export-dump-hook
     
    532532                  (make-node
    533533                   '##core#call
    534                    (list (cond [(memq name always-bound-to-procedure)
     534                   (list (cond [(variable-mark name '##compiler#always-bound-to-procedure)
    535535                                (set! count (add1 count))
    536536                                #t]
     
    735735       (newline) ) )
    736736   db) )
    737 
    738 (define (check-global-exports db)
    739   (when export-list
    740     (let ([exps export-list])
    741       (##sys#hash-table-for-each
    742        (lambda (sym plist)
    743          (when (and (memq sym exps) (not (assq 'assigned plist)))
    744            (compiler-warning 'var "exported global variable `~S' is used but not defined" sym) )
    745          (set! exps (delete sym exps eq?)) )
    746        db)
    747       (for-each (cut compiler-warning 'var "exported global variable `~S' is not defined" <>) exps) ) ) )
    748737
    749738
     
    12131202    -no-usual-integrations      standard procedures may be redefined
    12141203    -unsafe                     disable safety checks
     1204    -local                      assume globals are only modified in current file
    12151205    -block                      enable block-compilation
    12161206    -disable-interrupts         disable interrupts in compiled code
     
    14231413       (or (fx> x 1073741823)
    14241414           (fx< x -1073741824) ) ) )
     1415
     1416
     1417;;; symbol visibility
     1418
     1419(define (hide-variable sym)
     1420  (mark-variable sym '##compiler#visibility 'hidden))
     1421
     1422(define (export-variable sym)
     1423  (mark-variable sym '##compiler#visibility 'exported))
     1424
     1425(define (variable-visible? sym)
     1426  (let ((p (##sys#get sym '##compiler#visibility)))
     1427    (case p
     1428      ((hidden) #f)
     1429      ((exported) #t)
     1430      (else (not block-compilation)))))
     1431
     1432(define (mark-variable var mark #!optional (val #t))
     1433  (##sys#put! var mark val) )
     1434
     1435(define (variable-mark var mark)
     1436  (##sys#get var mark) )
Note: See TracChangeset for help on using the changeset viewer.