Changeset 13734 in project
- Timestamp:
- 03/13/09 05:37:58 (11 years ago)
- Location:
- release/4/stack
- Files:
-
- 2 edited
-
tags/2.0.0/chicken-primitive-object-inlines.scm (modified) (8 diffs)
-
trunk/chicken-primitive-object-inlines.scm (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
release/4/stack/tags/2.0.0/chicken-primitive-object-inlines.scm
r13719 r13734 2 2 ;;;; Kon Lovett, Jan '09 3 3 ;;;; (Was chicken-sys-macros.scm) 4 5 ; ***** SHOULD RENAME SAFE ROUTINES AS '*foo', KEEPING '%foo' FOR UNSAFE ***** 4 6 5 7 ; Usage … … 288 290 (define-inline (%fxeven? fx) (%fx= 0 (%fxand fx 1))) 289 291 290 (define-inline (%fxmin x y) ( ##core#inline "C_i_fixnum_min"x y))291 (define-inline (%fxmax x y) ( ##core#inline "C_i_fixnum_max" x y))292 (define-inline (%fxmin x y) (if (%fx< x y) x y)) 293 (define-inline (%fxmax x y) (if (%fx< x y) y x)) 292 294 293 295 (define-inline (%fx+ x y) (##core#inline "C_fixnum_plus" x y)) … … 371 373 372 374 (define-inline (%string->bytevector s) 373 (let* ((n (%byteblock-length s) #;(%string- lengths))375 (let* ((n (%byteblock-length s) #;(%string-size s)) 374 376 (bv (%make-bytevector sz)) ) 375 377 (##core#inline "C_copy_memory" bv s n) … … 423 425 s ) ) 424 426 427 (define-inline (%string-size s) (%byteblock-length s)) 425 428 (define-inline (%string-length s) (%byteblock-length s)) 426 429 … … 428 431 429 432 (define-inline (%string-set! s i c) (##core#inline "C_setsubchar" s i c)) 433 434 (define-inline (%string-compare/length s1 s2 l) (##core#inline "C_string_compare" s1 s2 l)) 435 436 (define-inline (%string-compare s1 s2) 437 (let* ((l1 (%string-length s1)) 438 (l2 (%string-length s2)) 439 (d (%fx- l1 l2)) 440 (r (%string-compare/length s1 s2 (if (%fxpositive? d) l2 l1))) ) 441 (if (%fxzero? r) d 442 r ) ) ) 443 444 (define-inline (%string=? s1 s2) (%fxzero? (%string-compare s1 s2))) 445 (define-inline (%string<? s1 s2) (%fxnegative? (%string-compare s1 s2))) 446 (define-inline (%string>? s1 s2) (%fxpositive? (%string-compare s1 s2))) 447 (define-inline (%string<=? s1 s2) (%fx<= 0 (%string-compare s1 s2))) 448 (define-inline (%string>=? s1 s2) (%fx>= 0 (%string-compare s1 s2))) 449 450 (define-inline (%string-ci-compare/length s1 s2 l) (##core#inline "C_string_compare_case_insensitive" s1 s2 l)) 451 452 (define-inline (%string-ci-compare s1 s2) 453 (let* ((l1 (%string-length s1)) 454 (l2 (%string-length s2)) 455 (d (%fx- l1 l2)) 456 (r (%string-ci-compare/length s1 s2 (if (%fxpositive? d) l2 l1))) ) 457 (if (%fxzero? r) d 458 r ) ) ) 459 460 (define-inline (%string-ci=? s1 s2) (%fxzero? (%string-ci-compare s1 s2))) 461 (define-inline (%string-ci<? s1 s2) (%fxnegative? (%string-ci-compare s1 s2))) 462 (define-inline (%string-ci>? s1 s2) (%fxpositive? (%string-ci-compare s1 s2))) 463 (define-inline (%string-ci<=? s1 s2) (%fx<= 0 (%string-ci-compare s1 s2))) 464 (define-inline (%string-ci>=? s1 s2) (%fx>= 0 (%string-ci-compare s1 s2))) 430 465 431 466 ;; Flonum (byteblock) … … 480 515 481 516 (define-inline (%string->lambda-info s) 482 (let* ((n (%string- lengths))483 (li (%make-string sz)) )517 (let* ((n (%string-size s)) 518 (li (%make-string n)) ) 484 519 (##core#inline "C_copy_memory" li s n) 485 520 (##core#inline "C_string_to_lambdainfo" li) … … 824 859 ;; Symbol (wordblock) 825 860 861 ;Unsafe 862 826 863 (define-inline (%symbol-binding s) (%wordblock-ref s 0)) 827 864 (define-inline (%symbol-string s) (%wordblock-ref s 1)) 828 865 (define-inline (%symbol-bucket s) (%wordblock-ref s 2)) 829 866 867 (define-constant NAMESPACE-MAX-ID-LEN 31) 868 869 (define-inline (%qualified-symbol? s) 870 (let ((str (%symbol-string s))) 871 (and (%fxpositive? (%string-size str)) 872 (fx<= (%byteblock-ref str 0) NAMESPACE-MAX-ID-LEN) ) ) ) 873 874 ;Safe 875 830 876 (define-inline (%string->symbol-interned s) ((##core#primitive "C_string_to_symbol") s)) 831 877 832 ;(define-inline (%symbol-intern! s) (%string->symbol (%symbol-string s)))833 834 878 (define-inline (%symbol-interned? x) (##core#inline "C_lookup_symbol" x)) 835 879 … … 838 882 ;; Keyword (wordblock) 839 883 840 (define-inline (%keyword? x) (and (%symbol? x) (%fx = 0(%byteblock-ref (%symbol-string x) 0))))884 (define-inline (%keyword? x) (and (%symbol? x) (%fxzero? (%byteblock-ref (%symbol-string x) 0)))) 841 885 842 886 ;; Pointer (wordblock) -
release/4/stack/trunk/chicken-primitive-object-inlines.scm
r13719 r13734 2 2 ;;;; Kon Lovett, Jan '09 3 3 ;;;; (Was chicken-sys-macros.scm) 4 5 ; ***** SHOULD RENAME SAFE ROUTINES AS '*foo', KEEPING '%foo' FOR UNSAFE ***** 4 6 5 7 ; Usage … … 288 290 (define-inline (%fxeven? fx) (%fx= 0 (%fxand fx 1))) 289 291 290 (define-inline (%fxmin x y) ( ##core#inline "C_i_fixnum_min"x y))291 (define-inline (%fxmax x y) ( ##core#inline "C_i_fixnum_max" x y))292 (define-inline (%fxmin x y) (if (%fx< x y) x y)) 293 (define-inline (%fxmax x y) (if (%fx< x y) y x)) 292 294 293 295 (define-inline (%fx+ x y) (##core#inline "C_fixnum_plus" x y)) … … 371 373 372 374 (define-inline (%string->bytevector s) 373 (let* ((n (%byteblock-length s) #;(%string- lengths))375 (let* ((n (%byteblock-length s) #;(%string-size s)) 374 376 (bv (%make-bytevector sz)) ) 375 377 (##core#inline "C_copy_memory" bv s n) … … 423 425 s ) ) 424 426 427 (define-inline (%string-size s) (%byteblock-length s)) 425 428 (define-inline (%string-length s) (%byteblock-length s)) 426 429 … … 428 431 429 432 (define-inline (%string-set! s i c) (##core#inline "C_setsubchar" s i c)) 433 434 (define-inline (%string-compare/length s1 s2 l) (##core#inline "C_string_compare" s1 s2 l)) 435 436 (define-inline (%string-compare s1 s2) 437 (let* ((l1 (%string-length s1)) 438 (l2 (%string-length s2)) 439 (d (%fx- l1 l2)) 440 (r (%string-compare/length s1 s2 (if (%fxpositive? d) l2 l1))) ) 441 (if (%fxzero? r) d 442 r ) ) ) 443 444 (define-inline (%string=? s1 s2) (%fxzero? (%string-compare s1 s2))) 445 (define-inline (%string<? s1 s2) (%fxnegative? (%string-compare s1 s2))) 446 (define-inline (%string>? s1 s2) (%fxpositive? (%string-compare s1 s2))) 447 (define-inline (%string<=? s1 s2) (%fx<= 0 (%string-compare s1 s2))) 448 (define-inline (%string>=? s1 s2) (%fx>= 0 (%string-compare s1 s2))) 449 450 (define-inline (%string-ci-compare/length s1 s2 l) (##core#inline "C_string_compare_case_insensitive" s1 s2 l)) 451 452 (define-inline (%string-ci-compare s1 s2) 453 (let* ((l1 (%string-length s1)) 454 (l2 (%string-length s2)) 455 (d (%fx- l1 l2)) 456 (r (%string-ci-compare/length s1 s2 (if (%fxpositive? d) l2 l1))) ) 457 (if (%fxzero? r) d 458 r ) ) ) 459 460 (define-inline (%string-ci=? s1 s2) (%fxzero? (%string-ci-compare s1 s2))) 461 (define-inline (%string-ci<? s1 s2) (%fxnegative? (%string-ci-compare s1 s2))) 462 (define-inline (%string-ci>? s1 s2) (%fxpositive? (%string-ci-compare s1 s2))) 463 (define-inline (%string-ci<=? s1 s2) (%fx<= 0 (%string-ci-compare s1 s2))) 464 (define-inline (%string-ci>=? s1 s2) (%fx>= 0 (%string-ci-compare s1 s2))) 430 465 431 466 ;; Flonum (byteblock) … … 480 515 481 516 (define-inline (%string->lambda-info s) 482 (let* ((n (%string- lengths))483 (li (%make-string sz)) )517 (let* ((n (%string-size s)) 518 (li (%make-string n)) ) 484 519 (##core#inline "C_copy_memory" li s n) 485 520 (##core#inline "C_string_to_lambdainfo" li) … … 824 859 ;; Symbol (wordblock) 825 860 861 ;Unsafe 862 826 863 (define-inline (%symbol-binding s) (%wordblock-ref s 0)) 827 864 (define-inline (%symbol-string s) (%wordblock-ref s 1)) 828 865 (define-inline (%symbol-bucket s) (%wordblock-ref s 2)) 829 866 867 (define-constant NAMESPACE-MAX-ID-LEN 31) 868 869 (define-inline (%qualified-symbol? s) 870 (let ((str (%symbol-string s))) 871 (and (%fxpositive? (%string-size str)) 872 (fx<= (%byteblock-ref str 0) NAMESPACE-MAX-ID-LEN) ) ) ) 873 874 ;Safe 875 830 876 (define-inline (%string->symbol-interned s) ((##core#primitive "C_string_to_symbol") s)) 831 877 832 ;(define-inline (%symbol-intern! s) (%string->symbol (%symbol-string s)))833 834 878 (define-inline (%symbol-interned? x) (##core#inline "C_lookup_symbol" x)) 835 879 … … 838 882 ;; Keyword (wordblock) 839 883 840 (define-inline (%keyword? x) (and (%symbol? x) (%fx = 0(%byteblock-ref (%symbol-string x) 0))))884 (define-inline (%keyword? x) (and (%symbol? x) (%fxzero? (%byteblock-ref (%symbol-string x) 0)))) 841 885 842 886 ;; Pointer (wordblock)
Note: See TracChangeset
for help on using the changeset viewer.
