Add primitives quotient and remainder.

diff --git a/v7/src/sf/gconst.scm b/v7/src/sf/gconst.scm
index dab0582db9a3946855afd19e814478a78d14e802..47bcbcd7ad62fdcb5d37bbb1b1234c3f9cca1b6e 100644 (file)
--- a/v7/src/sf/gconst.scm
+++ b/v7/src/sf/gconst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/gconst.scm,v 4.10 1991/04/20 06:09:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/gconst.scm,v 4.11 1991/05/06 18:46:04 jinx Exp $
 
 Copyright (c) 1987-91 Massachusetts Institute of Technology
 
@@ -33,6 +33,7 @@ promotional, or sales literature without prior written consent from
 MIT in each case. |#
 
 ;;;; SCode Optimizer: Global Constants List
+;;; package: (scode-optimizer)
 
 (declare (usual-integrations))
 \f
@@ -190,6 +191,7 @@ MIT in each case. |#
     MAKE-CELL
     MAKE-CHAR
     MAKE-NON-POINTER-OBJECT
+    ;; MODULO ; expanded to primitive.  Global defn. is not.
     NOT
     NULL?
     OBJECT-CONSTANT?
@@ -202,8 +204,10 @@ MIT in each case. |#
     PAIR?
     PRIMITIVE-PROCEDURE-ARITY
     PROCESS-TIME-CLOCK
+    ;; QUOTIENT ; expanded to primitive.  Global defn. is not.
     READ-BITS!
     REAL-TIME-CLOCK
+    ;; REMAINDER ; expanded to primitive.  Global defn. is not.
     SET-CAR!
     SET-CDR!
     SET-CELL-CONTENTS!

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index aba8fb361ea1a4652546d0e9b6131fc4778f46f1..79ba668a8e8d1aa1cb9ee634aca8eb258d046c7c 100644 (file)
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.16 1991/04/20 06:21:12 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.17 1991/05/06 18:46:39 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
                    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 16 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 17 '()))
\ No newline at end of file

diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index 7ebeaf0ab59550d407533514c0105260a6df5fd9..a22b45dfbd68c6cab627955a0415f6c3ad8590e0 100644 (file)
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 4.8 1990/10/24 15:09:57 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 4.9 1991/05/06 18:46:23 jinx Exp $
 
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -33,6 +33,7 @@ promotional, or sales literature without prior written consent from
 MIT in each case. |#
 
 ;;;; SCode Optimizer: Usual Integrations: Combination Expansions
+;;; package: (scode-optimizer expansion)
 
 (declare (usual-integrations)
         (automagic-integrations)
@@ -40,7 +41,7 @@ MIT in each case. |#
         (eta-substitution)
         (integrate-external "object"))
 \f
-;;;; N-ary Arithmetic Predicates
+;;;; Fixed-arity arithmetic primitives
 
 (define (make-combination primitive operands)
   (combination/make (constant/make primitive) operands))
@@ -57,6 +58,15 @@ MIT in each case. |#
        (if-expanded (make-combination primitive operands))
        (if-not-expanded))))
 
+(define (binary-arithmetic primitive)
+  (lambda (operands if-expanded if-not-expanded block)
+    block
+    (if (and (pair? operands)
+            (pair? (cdr operands))
+            (null? (cddr operands)))
+       (if-expanded (make-combination primitive operands))
+       (if-not-expanded))))
+
 (define zero?-expansion
   (unary-arithmetic (ucode-primitive zero?)))
 
@@ -72,6 +82,17 @@ MIT in each case. |#
 (define -1+-expansion
   (unary-arithmetic (ucode-primitive -1+)))
 
+(define quotient-expansion
+  (binary-arithmetic (ucode-primitive quotient 2)))
+
+(define remainder-expansion
+  (binary-arithmetic (ucode-primitive remainder 2)))
+
+(define modulo-expansion
+  (binary-arithmetic (ucode-primitive modulo 2)))
+\f
+;;;; N-ary Arithmetic Predicates
+
 (define (pairwise-test binary-predicate if-left-zero if-right-zero)
   (lambda (operands if-expanded if-not-expanded block)
     block
@@ -482,9 +503,12 @@ MIT in each case. |#
     int:integer?
     list
     make-string
+    ;; modulo  ; Compiler does not currently open-code it.
     negative?
     number?
     positive?
+    quotient
+    remainder
     second
     seventh
     sixth
@@ -556,9 +580,12 @@ MIT in each case. |#
    exact-integer?-expansion
    list-expansion
    make-string-expansion
+   ;; modulo-expansion
    negative?-expansion
    complex?-expansion
    positive?-expansion
+   quotient-expansion
+   remainder-expansion
    second-expansion
    seventh-expansion
    sixth-expansion

diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index b04abd35bb79f7251dc68baea36255fa20ff50f3..3be1ebee7c79a1f01b9f3c2eb2c2bd61912f088d 100644 (file)
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.16 1991/04/20 06:21:12 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.17 1991/05/06 18:46:39 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
                    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 16 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 17 '()))
\ No newline at end of file