From 06e32fca4d20e6372869220bb3dc66dd74e9dc61 Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Mon, 6 May 1991 18:08:59 +0000
Subject: [PATCH] - Add trampolines for quotient, remainder, and modulo. -
 Redefine user-visible quotient, remainder, and modulo so that the compiler
 will do a better job.

---
 v7/src/runtime/arith.scm   | 34 ++++++++++++++++++++++++++++++++--
 v7/src/runtime/version.scm |  4 ++--
 2 files changed, 34 insertions(+), 4 deletions(-)

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index d8660e384..3e13496d1 100644
--- 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.19 1991/04/26 02:39:56 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/arith.scm,v 1.20 1991/05/06 18:08:24 jinx Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -130,7 +130,10 @@ MIT in each case. |#
       (set-trampoline! 'GENERIC-TRAMPOLINE-ADD complex:+)
       (set-trampoline! 'GENERIC-TRAMPOLINE-SUBTRACT complex:-)
       (set-trampoline! 'GENERIC-TRAMPOLINE-MULTIPLY complex:*)
-      (set-trampoline! 'GENERIC-TRAMPOLINE-DIVIDE complex:/)))
+      (set-trampoline! 'GENERIC-TRAMPOLINE-DIVIDE complex:/)
+      (set-trampoline! 'GENERIC-TRAMPOLINE-QUOTIENT complex:quotient)
+      (set-trampoline! 'GENERIC-TRAMPOLINE-REMAINDER complex:remainder)
+      (set-trampoline! 'GENERIC-TRAMPOLINE-MODULO complex:modulo)))
   unspecific)
 
 (define flo:significand-digits-base-2)
@@ -1635,9 +1638,36 @@ MIT in each case. |#
 					  (reduce complex:* 1 (cddr zs))))))))
 
 (define abs complex:abs)
+#|
+;; Kludge!
+
 (define quotient complex:quotient)
 (define remainder complex:remainder)
 (define modulo complex:modulo)
+|#
+
+(define (quotient n d)
+  ((ucode-primitive quotient 2) n d))
+
+(define (remainder n d)
+  ((ucode-primitive remainder 2) n d))
+
+#|
+
+(define (modulo n d)
+  ((ucode-primitive modulo 2) n d))
+
+|#
+
+(define (modulo n d)
+  (let ((r ((ucode-primitive remainder 2) n d)))
+    (if (or (zero? r)
+	    (if (negative? n)
+		(negative? d)
+		(not (negative? d))))
+	r
+	(+ r d))))
+
 (define integer-floor complex:integer-floor)
 (define integer-ceiling complex:integer-ceiling)
 (define integer-truncate complex:quotient)
diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index f608b95f8..9ea93e47c 100644
--- 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.117 1991/05/06 03:19:59 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.118 1991/05/06 18:08:59 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
 		     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 117))
+  (add-identification! "Runtime" 14 118))
 
 (define microcode-system)
 
-- 
2.25.1