Changeset 13734 in project


Ignore:
Timestamp:
03/13/09 05:37:58 (11 years ago)
Author:
Kon Lovett
Message:

Update.

Location:
release/4/stack
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/stack/tags/2.0.0/chicken-primitive-object-inlines.scm

    r13719 r13734  
    22;;;; Kon Lovett, Jan '09
    33;;;; (Was chicken-sys-macros.scm)
     4
     5; ***** SHOULD RENAME SAFE ROUTINES AS '*foo', KEEPING '%foo' FOR UNSAFE *****
    46
    57; Usage
     
    288290(define-inline (%fxeven? fx) (%fx= 0 (%fxand fx 1)))
    289291
    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))
    292294
    293295(define-inline (%fx+ x y) (##core#inline "C_fixnum_plus" x y))
     
    371373
    372374(define-inline (%string->bytevector s)
    373   (let* ((n (%byteblock-length s) #;(%string-length s))
     375  (let* ((n (%byteblock-length s) #;(%string-size s))
    374376               (bv (%make-bytevector sz)) )
    375377    (##core#inline "C_copy_memory" bv s n)
     
    423425    s ) )
    424426
     427(define-inline (%string-size s) (%byteblock-length s))
    425428(define-inline (%string-length s) (%byteblock-length s))
    426429
     
    428431
    429432(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)))
    430465
    431466;; Flonum (byteblock)
     
    480515
    481516(define-inline (%string->lambda-info s)
    482   (let* ((n (%string-length s))
    483                (li (%make-string sz)) )
     517  (let* ((n (%string-size s))
     518               (li (%make-string n)) )
    484519    (##core#inline "C_copy_memory" li s n)
    485520    (##core#inline "C_string_to_lambdainfo" li)
     
    824859;; Symbol (wordblock)
    825860
     861;Unsafe
     862
    826863(define-inline (%symbol-binding s) (%wordblock-ref s 0))
    827864(define-inline (%symbol-string s) (%wordblock-ref s 1))
    828865(define-inline (%symbol-bucket s) (%wordblock-ref s 2))
    829866
     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
    830876(define-inline (%string->symbol-interned s) ((##core#primitive "C_string_to_symbol") s))
    831877
    832 ;(define-inline (%symbol-intern! s) (%string->symbol (%symbol-string s)))
    833 
    834878(define-inline (%symbol-interned? x) (##core#inline "C_lookup_symbol" x))
    835879
     
    838882;; Keyword (wordblock)
    839883
    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))))
    841885
    842886;; Pointer (wordblock)
  • release/4/stack/trunk/chicken-primitive-object-inlines.scm

    r13719 r13734  
    22;;;; Kon Lovett, Jan '09
    33;;;; (Was chicken-sys-macros.scm)
     4
     5; ***** SHOULD RENAME SAFE ROUTINES AS '*foo', KEEPING '%foo' FOR UNSAFE *****
    46
    57; Usage
     
    288290(define-inline (%fxeven? fx) (%fx= 0 (%fxand fx 1)))
    289291
    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))
    292294
    293295(define-inline (%fx+ x y) (##core#inline "C_fixnum_plus" x y))
     
    371373
    372374(define-inline (%string->bytevector s)
    373   (let* ((n (%byteblock-length s) #;(%string-length s))
     375  (let* ((n (%byteblock-length s) #;(%string-size s))
    374376               (bv (%make-bytevector sz)) )
    375377    (##core#inline "C_copy_memory" bv s n)
     
    423425    s ) )
    424426
     427(define-inline (%string-size s) (%byteblock-length s))
    425428(define-inline (%string-length s) (%byteblock-length s))
    426429
     
    428431
    429432(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)))
    430465
    431466;; Flonum (byteblock)
     
    480515
    481516(define-inline (%string->lambda-info s)
    482   (let* ((n (%string-length s))
    483                (li (%make-string sz)) )
     517  (let* ((n (%string-size s))
     518               (li (%make-string n)) )
    484519    (##core#inline "C_copy_memory" li s n)
    485520    (##core#inline "C_string_to_lambdainfo" li)
     
    824859;; Symbol (wordblock)
    825860
     861;Unsafe
     862
    826863(define-inline (%symbol-binding s) (%wordblock-ref s 0))
    827864(define-inline (%symbol-string s) (%wordblock-ref s 1))
    828865(define-inline (%symbol-bucket s) (%wordblock-ref s 2))
    829866
     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
    830876(define-inline (%string->symbol-interned s) ((##core#primitive "C_string_to_symbol") s))
    831877
    832 ;(define-inline (%symbol-intern! s) (%string->symbol (%symbol-string s)))
    833 
    834878(define-inline (%symbol-interned? x) (##core#inline "C_lookup_symbol" x))
    835879
     
    838882;; Keyword (wordblock)
    839883
    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))))
    841885
    842886;; Pointer (wordblock)
Note: See TracChangeset for help on using the changeset viewer.