Changeset 7276 in project for chicken/branches/release/support.scm


Ignore:
Timestamp:
01/05/08 20:17:50 (13 years ago)
Author:
felix winkelmann
Message:

merged trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/release/support.scm

    r6057 r7276  
    3737
    3838
    39 #{compiler
     39(private compiler
    4040  compiler-arguments process-command-line dump-nodes dump-undefined-globals
    4141  default-standard-bindings default-extended-bindings side-effecting-standard-bindings
     
    5151  rest-parameters-promoted-to-vector inline-table inline-table-used constant-table constants-used mutable-constants
    5252  dependency-list broken-constant-nodes inline-substitutions-enabled emit-syntax-trace-info
    53   always-bound-to-procedure block-variable-literal copy-node! valid-c-identifier? tree-copy copy-node-tree-and-rename
     53  always-bound-to-procedure block-variable-literal? copy-node! valid-c-identifier? tree-copy copy-node-tree-and-rename
    5454  direct-call-ids foreign-type-table first-analysis scan-sharp-greater-string
     55  make-block-variable-literal block-variable-literal-name
    5556  expand-profile-lambda profile-lambda-list profile-lambda-index profile-info-vector-name
    5657  initialize-compiler canonicalize-expression expand-foreign-lambda update-line-number-database scan-toplevel-assignments
     
    5859  reorganize-recursive-bindings substitution-table simplify-named-call
    5960  perform-closure-conversion prepare-for-code-generation compiler-source-file create-foreign-stub expand-foreign-lambda*
    60   transform-direct-lambdas! finish-foreign-result compressable-literal csc-control-file
     61  transform-direct-lambdas! finish-foreign-result csc-control-file
    6162  debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list
    6263  string->c-identifier c-ify-string words words->bytes check-and-open-input-file close-checked-input-file fold-inner
     
    7576  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    7677  foreign-argument-conversion foreign-result-conversion final-foreign-type debugging export-list block-globals
    77   lookup-exports-file constant-declarations process-lambda-documentation
     78  lookup-exports-file constant-declarations process-lambda-documentation big-fixnum?
    7879  compiler-macro-table register-compiler-macro export-dump-hook export-import-hook
    79   make-random-name foreign-type-convert-result foreign-type-convert-argument process-custom-declaration}
     80  make-random-name foreign-type-convert-result foreign-type-convert-argument process-custom-declaration)
    8081
    8182
     
    185186          (let* ((c (car chars))
    186187                 (code (char->integer c)) )
    187             (if (or (< code 32) (> code 128) (memq c '(#\" #\' #\\ #\?)))
     188            (if (or (< code 32) (>= code 127) (memq c '(#\" #\' #\\ #\?)))
    188189                (append '(#\\)
    189190                        (cond ((< code 8) '(#\0 #\0))
     
    257258
    258259(define (immediate? x)
    259   (or (fixnum? x)
     260  (or (and (fixnum? x) (not (big-fixnum? x)))
    260261      (eq? (##core#undefined) x)
    261262      (null? x)
     
    263264      (char? x)
    264265      (boolean? x) ) )
    265 
    266 (define (compressable-literal lit t)
    267   (let* ([count 0]
    268          [f (let rec ([x lit])
    269               (set! count (add1 count))
    270               (cond [(or (number? x) (char? x) (string? x) (boolean? x) (null? x) (symbol? x))] ; 1
    271                     [(pair? x)          ; car + cdr
    272                      (set! count (sub1 count))
    273                      (and (rec (car x)) (rec (cdr x))) ]
    274                     [(vector? x) (every rec (vector->list x))] ; 1 + elements
    275                     [else #f] ) ) ] )
    276     (and f (> count t) count) ) )
    277266
    278267(define (basic-literal? x)
     
    12211210(define (chop-separator str)
    12221211  (let ([len (sub1 (string-length str))])
    1223     (if (and (> len 0) (char=? (string-ref str len) ##sys#pathname-directory-separator))
     1212    (if (and (> len 0)
     1213             (memq (string-ref str len) '(#\\ #\/)))
    12241214        (substring str 0 len)
    12251215        str) ) )
     
    13291319
    13301320    -debug MODES                display debugging output for the given modes
    1331     -compress-literals NUMBER   compile literals above threshold as strings
    13321321    -unsafe-libraries           marks the generated file as being linked
    13331322                                with the unsafe runtime system
     
    15201509        (eval `(lambda (,wvar) (apply (lambda ,llist ,@body) (cdr ,wvar))) ) )
    15211510       #t) ) ) )
     1511
     1512
     1513;;; 64-bit fixnum?
     1514
     1515(define (big-fixnum? x)
     1516  (and (fixnum? x)
     1517       (##sys#fudge 3)                  ; 64 bit?
     1518       (or (fx> x 1073741823)
     1519           (fx< x -1073741824) ) ) )
Note: See TracChangeset for help on using the changeset viewer.