← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/mit-scheme/intrepid-updates

« back to all changes in this revision

Viewing changes to src/runtime/fixart.scm

  • Committer: Bazaar Package Importer
  • Author(s): Chris Hanson
  • Date: 2002-03-14 17:04:07 UTC
  • Revision ID: james.westby@ubuntu.com-20020314170407-m5lg1d6bdsl9lv0s
Tags: upstream-7.7.0
Import upstream version 7.7.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/runtime/fixart.scm
 
1
#| -*-Scheme-*-
 
2
 
 
3
$Id: fixart.scm,v 1.8 2001/12/18 18:39:31 cph Exp $
 
4
 
 
5
Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
6
 
 
7
This program is free software; you can redistribute it and/or modify
 
8
it under the terms of the GNU General Public License as published by
 
9
the Free Software Foundation; either version 2 of the License, or (at
 
10
your option) any later version.
 
11
 
 
12
This program is distributed in the hope that it will be useful, but
 
13
WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
15
General Public License for more details.
 
16
 
 
17
You should have received a copy of the GNU General Public License
 
18
along with this program; if not, write to the Free Software
 
19
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
20
02111-1307, USA.
 
21
|#
 
22
 
 
23
;;;; Fixnum Arithmetic
 
24
;;; package: (runtime fixnum-arithmetic)
 
25
 
 
26
(declare (usual-integrations))
 
27
 
 
28
(define-primitives
 
29
  (fix:fixnum? fixnum? 1)
 
30
  (fixnum? fixnum? 1)
 
31
  (index-fixnum? index-fixnum? 1)
 
32
  (fix:zero? zero-fixnum? 1)
 
33
  (fix:negative? negative-fixnum? 1)
 
34
  (fix:positive? positive-fixnum? 1)
 
35
  (fix:= equal-fixnum? 2)
 
36
  (fix:< less-than-fixnum? 2)
 
37
  (fix:> greater-than-fixnum? 2)
 
38
  (fix:1+ one-plus-fixnum 1)
 
39
  (fix:-1+ minus-one-plus-fixnum 1)
 
40
  (fix:+ plus-fixnum 2)
 
41
  (fix:- minus-fixnum 2)
 
42
  (fix:* multiply-fixnum 2)
 
43
  (fix:divide divide-fixnum 2)
 
44
  (fix:quotient fixnum-quotient 2)
 
45
  (fix:remainder fixnum-remainder 2)
 
46
  (fix:gcd gcd-fixnum 2)
 
47
  (fix:andc fixnum-andc 2)
 
48
  (fix:and fixnum-and 2)
 
49
  (fix:or fixnum-or 2)
 
50
  (fix:xor fixnum-xor 2)
 
51
  (fix:not fixnum-not 1)
 
52
  (fix:lsh fixnum-lsh 2)
 
53
 
 
54
  (int:integer? integer? 1)
 
55
  (int:zero? integer-zero? 1)
 
56
  (int:positive? integer-positive? 1)
 
57
  (int:negative? integer-negative? 1)
 
58
  (int:= integer-equal? 2)
 
59
  (int:< integer-less? 2)
 
60
  (int:> integer-greater? 2)
 
61
  (int:negate integer-negate 1)
 
62
  (int:1+ integer-add-1 1)
 
63
  (int:-1+ integer-subtract-1 1)
 
64
  (int:+ integer-add 2)
 
65
  (int:- integer-subtract 2)
 
66
  (int:* integer-multiply 2)
 
67
  (int:divide integer-divide 2)
 
68
  (int:quotient integer-quotient 2)
 
69
  (int:remainder integer-remainder 2)
 
70
 
 
71
  (flo:flonum? flonum? 1)
 
72
  (flo:zero? flonum-zero? 1)
 
73
  (flo:positive? flonum-positive? 1)
 
74
  (flo:negative? flonum-negative? 1)
 
75
  (flo:= flonum-equal? 2)
 
76
  (flo:< flonum-less? 2)
 
77
  (flo:> flonum-greater? 2)
 
78
  (flo:+ flonum-add 2)
 
79
  (flo:- flonum-subtract 2)
 
80
  (flo:* flonum-multiply 2)
 
81
  (flo:/ flonum-divide 2)
 
82
  (flo:negate flonum-negate 1)
 
83
  (flo:abs flonum-abs 1)
 
84
  (flo:exp flonum-exp 1)
 
85
  (flo:log flonum-log 1)
 
86
  (flo:sin flonum-sin 1)
 
87
  (flo:cos flonum-cos 1)
 
88
  (flo:tan flonum-tan 1)
 
89
  (flo:asin flonum-asin 1)
 
90
  (flo:acos flonum-acos 1)
 
91
  (flo:atan flonum-atan 1)
 
92
  (flo:atan2 flonum-atan2 2)
 
93
  (flo:sqrt flonum-sqrt 1)
 
94
  (flo:expt flonum-expt 2)
 
95
  (flo:floor flonum-floor 1)
 
96
  (flo:ceiling flonum-ceiling 1)
 
97
  (flo:truncate flonum-truncate 1)
 
98
  (flo:round flonum-round 1)
 
99
  (flo:floor->exact flonum-floor->exact 1)
 
100
  (flo:ceiling->exact flonum-ceiling->exact 1)
 
101
  (flo:truncate->exact flonum-truncate->exact 1)
 
102
  (flo:round->exact flonum-round->exact 1)
 
103
  (flo:vector-cons floating-vector-cons 1)
 
104
  (flo:vector-length floating-vector-length 1)
 
105
  (flo:vector-ref floating-vector-ref 2)
 
106
  (flo:vector-set! floating-vector-set! 3))
 
107
 
 
108
(define-integrable (fix:<= x y)
 
109
  (not (fix:> x y)))
 
110
 
 
111
(define-integrable (fix:>= x y)
 
112
  (not (fix:< x y)))
 
113
 
 
114
(define (fix:min n m)
 
115
  (if (fix:< n m) n m))
 
116
 
 
117
(define (fix:max n m)
 
118
  (if (fix:> n m) n m))
 
119
 
 
120
(define-integrable (int:<= x y)
 
121
  (not (int:> x y)))
 
122
 
 
123
(define-integrable (int:>= x y)
 
124
  (not (int:< x y)))
 
125
 
 
126
(define-integrable (int:->flonum n)
 
127
  ((ucode-primitive integer->flonum 2) n #b10))
 
128
 
 
129
(define-integrable (flo:<= x y)
 
130
  (not (flo:> x y)))
 
131
 
 
132
(define-integrable (flo:>= x y)
 
133
  (not (flo:< x y)))
 
134
 
 
135
(define (flo:min n m)
 
136
  (if (flo:< n m) n m))
 
137
 
 
138
(define (flo:max n m)
 
139
  (if (flo:> n m) n m))
 
140
 
 
141
(define (->flonum x)
 
142
  (if (not (real? x))
 
143
      (error:wrong-type-argument x "real number" '->FLONUM))
 
144
  (exact->inexact (real-part x)))
 
145
 
 
146
(define (flo:finite? x)
 
147
  (not (cond ((flo:> x 0.)
 
148
              (and (flo:> x 1.)
 
149
                   (flo:= x (flo:/ x 2.))))
 
150
             ((flo:< x 0.)
 
151
              (and (flo:< x -1.)
 
152
                   (flo:= x (flo:/ x 2.))))
 
153
             (else
 
154
              (flo:= x 0.)))))
 
 
b'\\ No newline at end of file'