Changeset 15245 in project

Timestamp:

07/20/09 23:46:01 (10 years ago)

Author:

felix winkelmann

Message:

merged trunk rev. 15243 into prerelease branch

Location:

chicken/branches/prerelease

Files:

• c-platform.scm (modified) (3 diffs)
• manual/faq (modified) (1 diff)
• optimizer.scm (modified) (3 diffs)

chicken/branches/prerelease/c-platform.scm

@@ -159 +159 @@
 
 (define default-extended-bindings
-  '(bitwise-and bitwise-ior bitwise-xor bitwise-not add1 sub1 fx+ fx- fx* fx/ fxmod
+  '(bitwise-and bitwise-ior bitwise-xor bitwise-not add1 sub1 fx+ fx- fx* fx/ fxmod o
     fx= fx> fx< fx>= fx<= fixnum? fxneg fxmax fxmin identity fp+ fp- fp* fp/ fpmin fpmax fpneg
     fp> fp< fp= fp>= fp<= fxand fxnot fxior fxxor fxshr fxshl bit-set?
@@ -203 +203 @@
   '(vector
     cons list string make-vector make-string string->symbol values current-input-port current-output-port
-    read-char write-char
+    read-char write-char printf fprintf
     apply call-with-current-continuation set-car! set-cdr! write-char newline write display
     peek-char char-ready?
@@ -212 +212 @@
     u8vector->blob/shared s8vector->blob/shared u16vector->blob/shared s16vector->blob/shared u32vector->blob/shared
     f32vector->blob/shared f64vector->blob/shared
-    s32vector->blob/shared read-string read-string!
+    s32vector->blob/shared read-string read-string! o
     ##sys#make-structure print* ##sys#make-vector ##sys#apply ##sys#setislot ##sys#block-ref
     ##sys#byte ##sys#setbyte 

chicken/branches/prerelease/manual/faq

@@ -471 +471 @@
 {{cpu-time}} {{error}} {{call/cc}} {{any?}}
 {{substring=?}} {{substring-ci=?}} {{substring-index}} {{substring-index-ci}}
-{{printf}} {{sprintf}} {{fprintf}} {{format}}
+{{printf}} {{sprintf}} {{fprintf}} {{format}} {{o}}
 
 ==== What's the difference betweem "block" and "local" mode?

chicken/branches/prerelease/optimizer.scm

@@ -1822 +1822 @@
      (if (symbol? names) (list names) names) ) ) )
 
-(r-c-s
- '(o #%o)
- (lambda (x r c)
-   (if (fx> (length x) 1)
-       (let ((%tmp (r 'tmp)))
-         `(,(r 'lambda) (,%tmp) ,(fold-right list %tmp (cdr x))))
-       x)))
-
 (r-c-s 
  '(for-each ##sys#for-each #%for-each)
@@ -1849 +1841 @@
  `((pair? . ,(##sys#primitive-alias 'pair?))))
 
+(r-c-s
+ '(o #%o)
+ (lambda (x r c)
+   (if (and (fx> (length x) 1)
+            (memq 'o extended-bindings) )
+       (let ((%tmp (r 'tmp)))
+         `(,(r 'lambda) (,%tmp) ,(fold-right list %tmp (cdr x))))
+       x)))
+
 (let ((env `((display . ,(##sys#primitive-alias 'display)) ;XXX clean this up
              (write . ,(##sys#primitive-alias 'write))
@@ -1861 +1862 @@
      (let* ((out (gensym 'out))
             (code (compile-format-string 
-                   'sprintf out 
+                   (if (memq (car x) '(sprintf #%sprintf))
+                       'sprintf
+                       'format)
+                   out 
                    x
                    (cdr x)