From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 9 May 1987 20:04:56 +0000 (+0000)
Subject: Add fixnum arithmetic for use by compiled code.
X-Git-Tag: 20090517-FFI~13529
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5fcf19dbe62797b3ab942852550dbbf5ea7b54a4;p=mit-scheme.git

Add fixnum arithmetic for use by compiled code.
---

diff --git a/v7/src/sf/gconst.scm b/v7/src/sf/gconst.scm
index 6dc1b15d1..e6c06b028 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 3.1 1987/04/25 20:06:59 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/gconst.scm,v 3.2 1987/05/09 20:02:49 cph Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -65,6 +65,10 @@ MIT in each case. |#
     TRUNCATE ROUND FLOOR CEILING
     SQRT EXP LOG SIN COS 
 
+    ;; Fixnum Arithmetic
+    FIX:ZERO? FIX:NEGATIVE? FIX:POSITIVE? FIX:= FIX:< FIX:>
+    FIX:1+ FIX:-1+ FIX:+ FIX:- FIX:* FIX:DIVIDE FIX:GCD
+
     ;; Basic Compound Datatypes
     CONS PAIR? CAR CDR SET-CAR! SET-CDR! GENERAL-CAR-CDR
     NULL? LENGTH MEMQ ASSQ FIRST HEAD EMPTY-STREAM?
diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index a522e750d..43c4a4a4e 100644
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 3.1 1987/05/04 23:50:20 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 3.2 1987/05/09 20:04:56 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -151,17 +151,23 @@ MIT in each case. |#
 
 ;;;; Miscellaneous Arithmetic
 
-(define (divide-component-expansion selector)
+(define (divide-component-expansion divide selector)
   (lambda (operands if-expanded if-not-expanded)
     (if-expanded
      (make-combination selector
-		       (list (make-combination integer-divide operands))))))
+		       (list (make-combination divide operands))))))
 
 (define quotient-expansion
-  (divide-component-expansion car))
+  (divide-component-expansion integer-divide car))
 
 (define remainder-expansion
-  (divide-component-expansion cdr))
+  (divide-component-expansion integer-divide cdr))
+
+(define fix:quotient-expansion
+  (divide-component-expansion fixnum-divide car))
+
+(define fix:remainder-expansion
+  (divide-component-expansion fixnum-divide cdr))
 
 ;;;; N-ary List Operations
 
@@ -279,7 +285,7 @@ MIT in each case. |#
 ;;;; Tables
 
 (define usual-integrations/expansion-names
-  '(= < > <= >= + - * / quotient remainder
+  '(= < > <= >= + - * / quotient remainder fix:quotient fix:remainder
       apply cons* list vector
       caar cadr cdar cddr
       caaar caadr cadar caddr cdaar cdadr cddar cdddr
@@ -293,6 +299,7 @@ MIT in each case. |#
   (list =-expansion <-expansion >-expansion <=-expansion >=-expansion
 	+-expansion --expansion *-expansion /-expansion
 	quotient-expansion remainder-expansion
+	fix:quotient-expansion fix:remainder-expansion
 	apply*-expansion cons*-expansion list-expansion vector-expansion
 	caar-expansion cadr-expansion cdar-expansion cddr-expansion
 	caaar-expansion caadr-expansion cadar-expansion caddr-expansion