Add several missing `int:' prefixes to `ratnum->flonum'. Fix argument

order to `real:atan2' in `complex:angle'.  Fix exact integer argument
test in `real:atan2'.  Add code to perform exact `expt' when the first
argument is a recnum and the second is an exact integer.

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index f285d0efccee5df90fc1b18f8f7c2eb1e036dcdb..22562f5b558200931674a25e22df31930c075251 100644 (file)
--- a/v7/src/runtime/arith.scm
+++ b/v7/src/runtime/arith.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/arith.scm,v 1.8 1989/11/09 22:07:04 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/arith.scm,v 1.9 1989/11/15 02:46:41 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -608,13 +608,14 @@ MIT in each case. |#
                     (let scale-up ((n n) (e 0))
                       (let ((n*2 (int:* n 2)))
                         (if (int:< n*2 d)
-                            (let loop ((n n*2) (n*r (int:* n 4)) (r 4) (m 1))
+                            (let loop
+                                ((n n*2) (n*r (int:* n*2 2)) (r 4) (m 1))
                               (if (int:< n*r d)
                                   (loop n*r
                                         (int:* n*r r)
                                         (int:* r r)
-                                        (int:+ m m))
-                                  (scale-up n (- e m))))
+                                        (int:* 2 m))
+                                  (scale-up n (int:- e m))))
                             (finish n d e))))
                     (let scale-down ((d d) (e 0))
                       (let ((d (int:* d 2)))
@@ -624,22 +625,22 @@ MIT in each case. |#
                                         (loop d*r
                                               (int:* d*r r)
                                               (int:* r r)
-                                              (int:+ m m)))
+                                              (int:* 2 m)))
                                        ((int:< n d*r)
                                         (scale-down d (int:+ e m)))
                                        (else
                                         (finish
                                          n
                                          (int:* d*r 2)
-                                         (int:1+ (int:+ e (int:+ m m))))))))
+                                         (int:1+ (int:+ e (int:* 2 m))))))))
                               ((int:< n d)
                                (finish n d (int:1+ e)))
                               (else
                                (finish n (int:* d 2) (int:+ e 2)))))))))))))
     (let ((n (ratnum-numerator q))
          (d (ratnum-denominator q)))
-      (cond ((positive? n) (q>0 n d))
-           ((negative? n) (flo:negate (q>0 (int:negate n) d)))
+      (cond ((int:positive? n) (q>0 n d))
+           ((int:negative? n) (flo:negate (q>0 (int:negate n) d)))
            (else flo:0)))))
 \f
 (define (flo:significand-digits radix)
@@ -913,8 +914,8 @@ MIT in each case. |#
   (define-transcendental-unary real:atan real:exact0= 0 flo:atan))
 
 (define (real:atan2 y x)
-  (if (and (real:exact1= y)
-          (real:exact0= x))
+  (if (and (real:exact0= y)
+          (real:exact? x))
       0
       (flo:atan2 (real:->flonum y) (real:->flonum x))))
 
@@ -1025,10 +1026,13 @@ MIT in each case. |#
 
 (define (complex:exact? z)
   (if (recnum? z)
-      (and (real:exact? (rec:real-part z))
-          (real:exact? (rec:imag-part z)))
+      ((copy rec:exact?) z)
       ((copy real:exact?) z)))
 
+(define (rec:exact? z)
+  (and (real:exact? (rec:real-part z))
+       (real:exact? (rec:imag-part z))))
+
 (define (complex:real-arg name x)
   (if (recnum? x) (rec:real-arg name x) x))
 
@@ -1403,7 +1407,7 @@ MIT in each case. |#
               (complex:- (complex:log (complex:1+ iz))
                          (complex:log (complex:- 1 iz))))
             +2i))
-
+\f
 (define (complex:sqrt z)
   (cond ((recnum? z)
         (complex:make-polar (real:sqrt (complex:magnitude z))
@@ -1414,18 +1418,45 @@ MIT in each case. |#
         ((copy real:sqrt) z))))
 
 (define (complex:expt z1 z2)
-  (if (or (recnum? z1)
-         (recnum? z2)
-         (and (real:negative? z1)
-              (not (real:integer? z2))))
-      (complex:exp (complex:* (complex:log z1) z2))
-      (real:expt z1 z2)))
-
+  (let ((general-case
+        (lambda ()
+          (complex:exp (complex:* (complex:log z1) z2)))))
+    (cond ((and (recnum? z1)
+               (rec:exact? z1))
+          (if (int:integer? z2)
+              (let ((exact-method
+                     (lambda (z2)
+                       (if (int:= 1 z2)
+                           z1
+                           (let loop ((z1 z1) (z2 z2) (answer 1))
+                             (let ((qr (int:divide z2 2)))
+                               (let ((z1 (complex:* z1 z1))
+                                     (z2 (integer-divide-quotient qr))
+                                     (answer
+                                      (if (int:zero?
+                                           (integer-divide-remainder qr))
+                                          answer
+                                          (complex:* answer z1))))
+                                 (if (int:= 1 z2)
+                                     (complex:* answer z1)
+                                     (loop z1 z2 answer)))))))))
+                (cond ((int:positive? z2) (exact-method z2))
+                      ((int:negative? z2)
+                       (complex:/ 1 (exact-method (int:negate z2))))
+                      (else 1)))
+              (general-case)))
+         ((or (recnum? z2)
+              (and (real:negative? z1)
+                   (not (real:integer? z2))))
+          (general-case))
+         (else
+          (real:expt z1 z2)))))
+\f
 (define (complex:make-rectangular real imag)
   (if (real:exact0= imag)
       real
       (make-recnum real imag)))
-\f
+
 (define (complex:make-polar magnitude angle)
   (complex:make-rectangular (real:* magnitude (real:cos angle))
                            (real:* magnitude (real:sin angle))))
@@ -1456,7 +1487,8 @@ MIT in each case. |#
       (if (and (real:zero? (rec:real-part z))
               (real:zero? (rec:imag-part z)))
          (real:0 (complex:exact? z))
-         (real:atan2 (rec:real-part z) (rec:imag-part z)))      (real:0 (real:exact? z))))
+         (real:atan2 (rec:imag-part z) (rec:real-part z)))
+      (real:0 (real:exact? z))))
 
 (define (complex:exact->inexact z)
   (if (recnum? z)

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 0009b82395205792fa40721d697c633337a08ed1..81ebc244157294c0409d5bce126caccbea8fa643 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.66 1989/11/09 22:07:48 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.67 1989/11/15 02:47:09 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -45,7 +45,8 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 66))
+  (add-identification! "Runtime" 14 67))
+
 (define microcode-system)
 
 (define (snarf-microcode-version!)