1"======================================================================
2|
3|   Java run-time support.  java.lang.Math native methods.
4|
5|
6 ======================================================================"
7
8
9"======================================================================
10|
11| Copyright 2003 Free Software Foundation, Inc.
12| Written by Paolo Bonzini.
13|
14| This file is part of GNU Smalltalk.
15|
16| The GNU Smalltalk class library is free software; you can redistribute it
17| and/or modify it under the terms of the GNU General Public License
18| as published by the Free Software Foundation; either version 2, or (at
19| your option) any later version.
20|
21| The GNU Smalltalk class library is distributed in the hope that it will be
22| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
24| Public License for more details.
25|
26| You should have received a copy of the GNU Lesser General Public License
27| along with the GNU Smalltalk class library; see the file COPYING.  If not,
28| write to the Free Software Foundation, 51 Franklin Street, Fifth Floor,
29| Boston, MA 02110-1301, USA.
30|
31 ======================================================================"
32
33
34!JavaVM methodsFor: 'java.lang.Math'!
35
36java_lang_Math_sin_double: arg1
37    <javaNativeMethod: #'sin(D)D'
38        for: #{Java.java.lang.Math} static: true>
39    ^arg1 sin
40!
41
42java_lang_Math_cos_double: arg1
43    <javaNativeMethod: #'cos(D)D'
44        for: #{Java.java.lang.Math} static: true>
45    ^arg1 cos
46!
47
48java_lang_Math_tan_double: arg1
49    <javaNativeMethod: #'tan(D)D'
50        for: #{Java.java.lang.Math} static: true>
51    ^arg1 tan
52!
53
54java_lang_Math_asin_double: arg1
55    <javaNativeMethod: #'asin(D)D'
56        for: #{Java.java.lang.Math} static: true>
57    ^arg1 arcSin
58!
59
60java_lang_Math_acos_double: arg1
61    <javaNativeMethod: #'acos(D)D'
62        for: #{Java.java.lang.Math} static: true>
63    ^arg1 arcCos
64!
65
66java_lang_Math_atan_double: arg1
67    <javaNativeMethod: #'atan(D)D'
68        for: #{Java.java.lang.Math} static: true>
69    ^arg1 arcTan
70!
71
72java_lang_Math_atan2_double: arg1 double: arg2
73    <javaNativeMethod: #'atan2(DD)D'
74        for: #{Java.java.lang.Math} static: true>
75    ^arg1 arcTan: arg2
76!
77
78java_lang_Math_exp_double: arg1
79    <javaNativeMethod: #'exp(D)D'
80        for: #{Java.java.lang.Math} static: true>
81    ^arg1 exp
82!
83
84java_lang_Math_log_double: arg1
85    <javaNativeMethod: #'log(D)D'
86        for: #{Java.java.lang.Math} static: true>
87    ^arg1 ln
88!
89
90java_lang_Math_sqrt_double: arg1
91    <javaNativeMethod: #'sqrt(D)D'
92        for: #{Java.java.lang.Math} static: true>
93    ^arg1 sqrt
94!
95
96java_lang_Math_pow_double: arg1 double: arg2
97    <javaNativeMethod: #'pow(DD)D'
98        for: #{Java.java.lang.Math} static: true>
99    ^arg1 raisedTo: arg2
100!
101
102java_lang_Math_IEEEremainder_double: arg1 double: arg2
103    <javaNativeMethod: #'IEEEremainder(DD)D'
104        for: #{Java.java.lang.Math} static: true>
105    arg2 = 0.0 ifTrue: [ ^FloatD nan ].
106    arg1 = arg1 ifFalse: [ ^arg2 ].
107    arg2 = arg2 ifFalse: [ ^arg2 ].
108    ^arg1 rem: arg2
109!
110
111java_lang_Math_ceil_double: arg1
112    <javaNativeMethod: #'ceil(D)D'
113        for: #{Java.java.lang.Math} static: true>
114    ^arg1 ceiling
115!
116
117java_lang_Math_floor_double: arg1
118    <javaNativeMethod: #'floor(D)D'
119        for: #{Java.java.lang.Math} static: true>
120    ^arg1 floor
121!
122
123java_lang_Math_rint_double: arg1
124    <javaNativeMethod: #'rint(D)D'
125        for: #{Java.java.lang.Math} static: true>
126    ^arg1 rounded
127! !
128
129