From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Mon, 6 May 1991 18:46:39 +0000 (+0000)
Subject: Add primitives quotient and remainder.
X-Git-Tag: 20090517-FFI~10665
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=820bbd6f95db8c0e47f6f35352bece8163242387;p=mit-scheme.git

Add primitives quotient and remainder.
---

diff --git a/v7/src/sf/gconst.scm b/v7/src/sf/gconst.scm
index dab0582db..47bcbcd7a 100644
--- 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))
 
@@ -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 aba8fb361..79ba668a8 100644
--- 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 7ebeaf0ab..a22b45dfb 100644
--- 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"))
 
-;;;; 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)))
+
+;;;; 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 b04abd35b..3be1ebee7 100644
--- 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