Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ecl
ecl
Commits
a8ba6f5c
Commit
a8ba6f5c
authored
Oct 13, 2006
by
jgarcia
Browse files
Initital support for long double and immediate short floats.
parent
433c8fe3
Changes
35
Expand all
Hide whitespace changes
Inline
Side-by-side
src/CHANGELOG
View file @
a8ba6f5c
...
...
@@ -27,6 +27,10 @@ ECL 1.0:
- MAPCAR, MAPLIST, MAPC, MAPL, MAPCAN, MAPCON have now compiler macro functions
which create equivalent inlined forms.
- Support for C "long double" as lisp long-double datatype (originated from
a patch by Lars Brinkhoff). Still missing compiler support for unboxed
long double types.
* Bugs fixed:
- STREAMP signals an error for Gray streams.
...
...
src/aclocal.m4
View file @
a8ba6f5c
...
...
@@ -570,4 +570,4 @@ case "${host_cpu}" in
;;
esac
AC_SUBST(ECL_FPE_CODE)
])
\ No newline at end of file
])
src/c/alloc.d
View file @
a8ba6f5c
...
...
@@ -220,6 +220,10 @@ cl_alloc_object(cl_type t)
return
MAKE_FIXNUM
(
0
);
/* Immediate fixnum */
case
t_character
:
return
CODE_CHAR
(
'\0'
);
/* Immediate character */
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
return
make_shortfloat
(
0.0
);
/* Immediate float */
#
endif
default
:;
}
...
...
@@ -261,6 +265,9 @@ ONCE_MORE:
break
;
case
t_singlefloat
:
case
t_doublefloat
:
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
#
endif
break
;
case
t_complex
:
obj
->
complex
.
imag
=
OBJNULL
;
...
...
@@ -722,6 +729,9 @@ init_alloc(void)
init_tm
(
t_process
,
"tPROCESS"
,
sizeof
(
struct
ecl_process
),
2
);
init_tm
(
t_lock
,
"tLOCK"
,
sizeof
(
struct
ecl_lock
),
2
);
#
endif
/* THREADS */
#
ifdef
ECL_LONG_FLOAT
init_tm
(
t_longfloat
,
"tLONGFLOAT"
,
sizeof
(
struct
ecl_long_float
),
2
);
#
endif
ncb
=
0
;
ncbpage
=
0
;
...
...
src/c/alloc_2.d
View file @
a8ba6f5c
...
...
@@ -59,6 +59,12 @@ cl_alloc_object(cl_type t)
obj
->
cblock
.
data_size
=
0
;
obj
->
cblock
.
handle
=
NULL
;
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
#
endif
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
#
endif
case
t_singlefloat
:
case
t_doublefloat
:
obj
=
(
cl_object
)
GC_MALLOC_ATOMIC
(
type_size
[
t
]);
...
...
@@ -204,6 +210,9 @@ init_alloc(void)
init_tm
(
t_process
,
"PROCESS"
,
sizeof
(
struct
ecl_process
));
init_tm
(
t_lock
,
"LOCK"
,
sizeof
(
struct
ecl_lock
));
#
endif
#
ifdef
ECL_LONG_FLOAT
init_tm
(
t_longfloat
,
"LONG-FLOAT"
,
sizeof
(
struct
ecl_long_float
));
#
endif
old_GC_push_other_roots
=
GC_push_other_roots
;
GC_push_other_roots
=
stacks_scanner
;
...
...
src/c/array.d
View file @
a8ba6f5c
...
...
@@ -559,7 +559,7 @@ array_address(cl_object x, cl_index inc)
case
aet_index
:
return
x
->
array
.
self
.
fix
+
inc
;
case
aet_sf
:
return
x
->
array
.
self
.
t
+
inc
;
return
x
->
array
.
self
.
sf
+
inc
;
case
aet_bc
:
return
x
->
base_string
.
self
+
inc
;
case
aet_df
:
...
...
src/c/cmpaux.d
View file @
a8ba6f5c
...
...
@@ -77,10 +77,18 @@ object_to_fixnum(cl_object x)
/* case t_character: return (cl_fixnum)CHAR_CODE(x); */
case
t_ratio
:
return
(
cl_fixnum
)
number_to_double
(
x
);
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
return
(
cl_fixnum
)
ecl_short_float
(
x
);
#
endif
case
t_singlefloat
:
return
(
cl_fixnum
)
sf
(
x
);
case
t_doublefloat
:
return
(
cl_fixnum
)
df
(
x
);
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
return
(
cl_fixnum
)
ecl_long_float
(
x
);
#
endif
default
:
FEerror
(
"~S cannot be coerced to a C int."
,
1
,
x
);
}
...
...
@@ -95,10 +103,18 @@ object_to_unsigned_integer(cl_object x)
return
fixnnint
(
x
);
case
t_ratio
:
return
(
cl_index
)
number_to_double
(
x
);
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
return
(
cl_index
)
ecl_short_float
(
x
);
#
endif
case
t_singlefloat
:
return
(
cl_index
)
sf
(
x
);
case
t_doublefloat
:
return
(
cl_index
)
df
(
x
);
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
return
(
cl_index
)
ecl_long_float
(
x
);
#
endif
default
:
FEerror
(
"~S cannot be coerced to a C unsigned int."
,
1
,
x
);
}
...
...
@@ -115,10 +131,18 @@ object_to_float(cl_object x)
case
t_bignum
:
case
t_ratio
:
return
number_to_double
(
x
);
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
return
ecl_short_float
(
x
);
#
endif
case
t_singlefloat
:
return
sf
(
x
);
case
t_doublefloat
:
return
df
(
x
);
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
return
ecl_long_float
(
x
);
#
endif
default
:
FEtype_error_real
(
x
);
}
...
...
@@ -136,10 +160,18 @@ object_to_double(cl_object x)
case
t_bignum
:
case
t_ratio
:
return
number_to_double
(
x
);
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
return
ecl_short_float
(
x
);
#
endif
case
t_singlefloat
:
return
sf
(
x
);
case
t_doublefloat
:
return
df
(
x
);
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
return
ecl_long_float
(
x
);
#
endif
default
:
FEtype_error_real
(
x
);
}
...
...
src/c/format.d
View file @
a8ba6f5c
...
...
@@ -1041,14 +1041,35 @@ fmt_exponential_float(format_stack fmt, bool colon, bool atsign)
writestr_stream
(
b
,
fmt
->
stream
);
y
=
symbol_value
(
@
'
*
read
-
default
-
float
-
format
*
'
);
if
(
exponentchar
<
0
)
{
if
(
y
==
@
'
long
-
float
'
||
y
==
@
'
double
-
float
'
)
if
(
y
==
@
'
long
-
float
'
)
{
#
ifdef
ECL_LONG_FLOAT
t
=
t_longfloat
;
#
else
t
=
t_doublefloat
;
else
#
endif
}
else
if
(
y
==
@
'
double
-
float
'
)
{
t
=
t_doublefloat
;
}
else
if
(
y
==
@
'
single
-
float
'
)
{
t
=
t_singlefloat
;
}
else
{
#
ifdef
ECL_SHORT_FLOAT
t
=
t_shortfloat
;
#
else
t
=
t_singlefloat
;
#
endif
}
if
(
type_of
(
x
)
==
t
)
exponentchar
=
'E'
;
else
if
(
type_of
(
x
)
==
t_singlefloat
)
exponentchar
=
'F'
;
#
ifdef
ECL_SHORT_FLOAT
else
if
(
type_of
(
x
)
==
t_shortfloat
)
exponentchar
=
'S'
;
#
endif
#
ifdef
ECL_LONG_FLOAT
else
if
(
type_of
(
x
)
==
t_longfloat
)
exponentchar
=
'L'
;
#
endif
else
exponentchar
=
'D'
;
}
...
...
src/c/gbc.d
View file @
a8ba6f5c
...
...
@@ -146,8 +146,14 @@ BEGIN:
mark_next
(
x
->
ratio
.
den
);
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
#
endif
case
t_singlefloat
:
case
t_doublefloat
:
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
#
endif
break
;
case
t_complex
:
...
...
src/c/hash.d
View file @
a8ba6f5c
...
...
@@ -129,10 +129,22 @@ _hash_eql(cl_hashkey h, cl_object x)
case
t_ratio
:
h
=
_hash_eql
(
h
,
x
->
ratio
.
num
);
return
_hash_eql
(
h
,
x
->
ratio
.
den
);
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
{
float
f
=
ecl_short_float
(
x
);
return
hash_string
(
h
,
(
unsigned
char
*)&
f
,
sizeof
(
f
));
}
#
endif
case
t_singlefloat
:
return
hash_string
(
h
,
(
unsigned
char
*)&
sf
(
x
),
sizeof
(
sf
(
x
)));
case
t_doublefloat
:
return
hash_string
(
h
,
(
unsigned
char
*)&
df
(
x
),
sizeof
(
df
(
x
)));
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
long
double
d
=
ecl_long_float
(
x
);
return
hash_string
(
h
,
(
unsigned
char
*)&
d
,
sizeof
(
d
));
}
#
endif
case
t_complex
:
h
=
_hash_eql
(
h
,
x
->
complex
.
real
);
return
_hash_eql
(
h
,
x
->
complex
.
imag
);
...
...
@@ -207,6 +219,16 @@ SCAN: if (depth++ >= 3) {
return
h
;
case
t_fixnum
:
return
hash_word
(
h
,
fix
(
x
));
#
ifdef
HAVE_SHORT_FLOAT
case
t_shortfloat
:
{
/* FIXME! We should be more precise here! */
return
hash_word
(
h
,
(
cl_index
)
sf
(
x
));
union
{
float
f
;
cl_index
w
;
}
x
;
x
.
w
=
0
;
x
.
f
=
ecl_short_float
(
x
);
return
hash_word
(
h
,
x
.
w
);
}
#
endif
case
t_singlefloat
:
/* FIXME! We should be more precise here! */
return
hash_word
(
h
,
(
cl_index
)
sf
(
x
));
...
...
@@ -373,19 +395,24 @@ ecl_extend_hashtable(cl_object hashtable)
{
cl_object
old
,
key
;
cl_index
old_size
,
new_size
,
i
;
cl_object
new_size_obj
;
assert_type_hash_table
(
hashtable
);
old_size
=
hashtable
->
hash
.
size
;
if
(
FIXNUMP
(
hashtable
->
hash
.
rehash_size
))
new_size
=
old_size
+
fix
(
hashtable
->
hash
.
rehash_size
);
else
if
(
type_of
(
hashtable
->
hash
.
rehash_size
)
==
t_singlefloat
)
new_size
=
(
cl_index
)(
old_size
*
sf
(
hashtable
->
hash
.
rehash_size
));
else
if
(
type_of
(
hashtable
->
hash
.
rehash_size
)
==
t_doublefloat
)
new_size
=
(
cl_index
)(
old_size
*
df
(
hashtable
->
hash
.
rehash_size
));
else
corrupted_hash
(
hashtable
);
if
(
new_size
<=
old_size
)
new_size
=
old_size
+
1
;
/* We do the computation with lisp datatypes, just in case the sizes contain
* weird numbers */
if
(
FIXNUMP
(
hashtable
->
hash
.
rehash_size
))
{
new_size_obj
=
number_plus
(
hashtable
->
hash
.
rehash_size
,
MAKE_FIXNUM
(
old_size
));
}
else
{
new_size_obj
=
number_times
(
hashtable
->
hash
.
rehash_size
,
MAKE_FIXNUM
(
old_size
));
new_size_obj
=
ceiling1
(
new_size_obj
);
}
if
(!
FIXNUMP
(
new_size_obj
))
{
/* New size is too large */
new_size
=
old_size
*
2
;
}
else
{
new_size
=
fix
(
new_size_obj
);
}
old
=
cl_alloc_object
(
t_hashtable
);
old
->
hash
=
hashtable
->
hash
;
hashtable
->
hash
.
data
=
NULL
;
/* for GC sake */
...
...
@@ -446,26 +473,28 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
hsize
=
16
;
t
=
type_of
(
rehash_size
);
if
((
t
!=
t_fixnum
&&
t
!=
t_singlefloat
&&
t
!=
t_doublefloat
)
||
(
number_compare
(
rehash_size
,
MAKE_FIXNUM
(
1
))
<
0
))
{
if
(
t
!=
t_fixnum
)
{
rehash_size
=
make_doublefloat
(
number_to_double
(
rehash_size
));
t
=
t_doublefloat
;
}
if
((
number_compare
(
rehash_size
,
MAKE_FIXNUM
(
1
))
<
0
))
{
FEerror
(
"~S is an illegal hash-table rehash-size."
,
1
,
rehash_size
);
}
factor
=
-
1.0
;
t
=
type_of
(
rehash_threshold
);
if
(
t
==
t_fixnum
||
t
==
t_ratio
||
t
==
t_singlefloat
||
t
==
t_doublefloat
)
{
factor
=
number_to_double
(
rehash_threshold
);
}
if
(
factor
<
0.0
||
factor
>
1.0
)
{
if
(!
numberp
(
rehash_threshold
)
||
number_minusp
(
rehash_threshold
)
||
number_compare
(
rehash_threshold
,
MAKE_FIXNUM
(
1
))
>
0
)
{
FEerror
(
"~S is an illegal hash-table rehash-threshold."
,
1
,
rehash_threshold
);
}
rehash_threshold
=
cl_max
(
2
,
rehash_threshold
,
make_singlefloat
(
0.1
));
h
=
cl_alloc_object
(
t_hashtable
);
h
->
hash
.
test
=
htt
;
h
->
hash
.
size
=
hsize
;
h
->
hash
.
rehash_size
=
rehash_size
;
h
->
hash
.
threshold
=
rehash_threshold
;
h
->
hash
.
factor
=
factor
;
h
->
hash
.
factor
=
number_to_double
(
rehash_threshold
)
;
h
->
hash
.
entries
=
0
;
h
->
hash
.
data
=
NULL
;
/* for GC sake */
h
->
hash
.
data
=
(
struct
ecl_hashtable_entry
*)
...
...
src/c/instance.d
View file @
a8ba6f5c
...
...
@@ -208,8 +208,14 @@ cl_class_of(cl_object x)
t
=
@
'
integer
'
;
break
;
case
t_ratio
:
t
=
@
'
ratio
'
;
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
#
endif
case
t_singlefloat
:
case
t_doublefloat
:
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
#
endif
t
=
@
'
float
'
;
break
;
/* XXX t = @'long-float'; break; */
case
t_complex
:
...
...
src/c/main.d
View file @
a8ba6f5c
...
...
@@ -462,6 +462,12 @@ cl_boot(int argc, char **argv)
#
endif
#
ifdef
ECL_UNICODE
ADD_FEATURE
(
"UNICODE"
);
#
endif
#
ifdef
ECL_LONG_FLOAT
ADD_FEATURE
(
"LONG-FLOAT"
);
#
endif
#
ifdef
ECL_SHORT_FLOAT
ADD_FEATURE
(
"SHORT-FLOAT"
);
#
endif
/* This is assumed in all systems */
ADD_FEATURE
(
"IEEE-FLOATING-POINT"
);
...
...
src/c/num_arith.d
View file @
a8ba6f5c
This diff is collapsed.
Click to expand it.
src/c/num_co.d
View file @
a8ba6f5c
...
...
@@ -89,36 +89,48 @@ number_remainder(cl_object x, cl_object y, cl_object q)
otherwise coerce to same float type as second arg */
@
(
defun
float
(
x
&
optional
(
y
OBJNULL
))
cl_type
t
=
t_singlefloat
;
cl_type
t
,
tx
;
double
d
;
/* TODO: LONG_FLOAT SHORT_FLOAT */
@
if
(
y
!=
OBJNULL
)
{
t
=
type_of
(
y
);
if
(
t
!=
t_singlefloat
&&
t
!=
t_doublefloat
)
FEtype_error_float
(
y
);
}
switch
(
type_of
(
x
))
{
case
t_fixnum
:
if
(
t
==
t_singlefloat
)
x
=
make_singlefloat
(
fix
(
x
));
else
x
=
make_doublefloat
(
fix
(
x
));
break
;
case
t_bignum
:
case
t_ratio
:
{
double
d
=
number_to_double
(
x
);
if
(
t
==
t_singlefloat
)
x
=
make_singlefloat
(
d
);
else
x
=
make_doublefloat
(
d
);
break
;
}
else
{
t
=
t_singlefloat
;
}
switch
(
tx
=
type_of
(
x
))
{
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
#
endif
case
t_singlefloat
:
if
(
y
&&
t
==
t_doublefloat
)
x
=
make_doublefloat
(
sf
(
x
));
break
;
case
t_doublefloat
:
if
(
y
&&
t
==
t_singlefloat
)
x
=
make_singlefloat
(
df
(
x
));
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
#
endif
if
(
y
==
OBJNULL
||
t
==
tx
)
break
;
case
t_fixnum
:
case
t_bignum
:
case
t_ratio
:
switch
(
t
)
{
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
x
=
make_shortfloat
(
number_to_double
(
x
));
break
;
#
endif
case
t_singlefloat
:
x
=
make_singlefloat
(
number_to_double
(
x
));
break
;
case
t_doublefloat
:
x
=
make_doublefloat
(
number_to_double
(
x
));
break
;
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
/* FIXME! We lose precision! */
volatile
double
y
=
number_to_double
(
x
);
x
=
make_longfloat
(
y
);
break
;
}
#
endif
default
:
FEtype_error_float
(
y
);
}
break
;
default
:
FEtype_error_real
(
x
);
...
...
@@ -177,6 +189,15 @@ floor1(cl_object x)
VALUES
(
0
)
=
floor2
(
x
->
ratio
.
num
,
x
->
ratio
.
den
);
VALUES
(
1
)
=
make_ratio
(
VALUES
(
1
),
x
->
ratio
.
den
);
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
{
float
d
=
ecl_short_float
(
x
);
float
y
=
floorf
(
d
);
VALUES
(
0
)
=
float_to_integer
(
y
);
VALUES
(
1
)
=
make_shortfloat
(
d
-
y
);
break
;
}
#
endif
case
t_singlefloat
:
{
float
d
=
sf
(
x
);
float
y
=
floorf
(
d
);
...
...
@@ -191,6 +212,15 @@ floor1(cl_object x)
VALUES
(
1
)
=
make_doublefloat
(
d
-
y
);
break
;
}
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
long
double
d
=
ecl_long_float
(
x
);
long
double
y
=
floorl
(
d
);
VALUES
(
0
)
=
double_to_integer
(
y
);
VALUES
(
1
)
=
make_longfloat
(
d
-
y
);
break
;
}
#
endif
default
:
FEtype_error_real
(
x
);
}
...
...
@@ -240,6 +270,16 @@ floor2(cl_object x, cl_object y)
floor2
(
number_times
(
x
,
y
->
ratio
.
den
),
y
->
ratio
.
num
);
VALUES
(
1
)
=
make_ratio
(
VALUES
(
1
),
y
->
ratio
.
den
);
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
{
/* FIX / SF */
float
n
=
ecl_short_float
(
y
);
float
p
=
fix
(
x
)
/
n
;
float
q
=
floorf
(
p
);
VALUES
(
0
)
=
float_to_integer
(
q
);
VALUES
(
1
)
=
make_shortfloat
((
p
-
q
)*
n
);
break
;
}
#
endif
case
t_singlefloat
:
{
/* FIX / SF */
float
n
=
sf
(
y
);
float
p
=
fix
(
x
)
/
n
;
...
...
@@ -256,6 +296,16 @@ floor2(cl_object x, cl_object y)
VALUES
(
1
)
=
make_doublefloat
((
p
-
q
)*
n
);
break
;
}
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
/* FIX / SF */
long
double
n
=
ecl_long_float
(
y
);
long
double
p
=
fix
(
x
)
/
n
;
long
double
q
=
floorl
(
p
);
VALUES
(
0
)
=
float_to_integer
(
q
);
VALUES
(
1
)
=
make_longfloat
((
p
-
q
)*
n
);
break
;
}
#
endif
default
:
FEtype_error_real
(
y
);
}
...
...
@@ -294,6 +344,16 @@ floor2(cl_object x, cl_object y)
floor2
(
number_times
(
x
,
y
->
ratio
.
den
),
y
->
ratio
.
num
);
VALUES
(
1
)
=
make_ratio
(
VALUES
(
1
),
y
->
ratio
.
den
);
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
{
/* BIG / SF */
float
n
=
ecl_short_float
(
y
);
float
p
=
big_to_double
(
x
)
/
n
;
float
q
=
floorf
(
p
);
VALUES
(
0
)
=
float_to_integer
(
q
);
VALUES
(
1
)
=
make_shortfloat
((
p
-
q
)*
n
);
break
;
}
#
endif
case
t_singlefloat
:
{
/* BIG / SF */
float
n
=
sf
(
y
);
float
p
=
big_to_double
(
x
)
/
n
;
...
...
@@ -310,6 +370,16 @@ floor2(cl_object x, cl_object y)
VALUES
(
1
)
=
make_doublefloat
((
p
-
q
)*
n
);
break
;
}
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
/* BIG / DF */
long
double
n
=
ecl_long_float
(
y
);
long
double
p
=
big_to_double
(
x
)
/
n
;
long
double
q
=
floorl
(
p
);
VALUES
(
0
)
=
double_to_integer
(
q
);
VALUES
(
1
)
=
make_longfloat
((
p
-
q
)*
n
);
break
;
}
#
endif
default
:
FEtype_error_real
(
y
);
}
...
...
@@ -326,6 +396,16 @@ floor2(cl_object x, cl_object y)
VALUES
(
1
)
=
number_divide
(
VALUES
(
1
),
x
->
ratio
.
den
);
}
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
{
/* SF / ANY */
float
n
=
number_to_double
(
y
);
float
p
=
sf
(
x
)/
n
;
float
q
=
floorf
(
p
);
VALUES
(
0
)
=
float_to_integer
(
q
);
VALUES
(
1
)
=
make_shortfloat
((
p
-
q
)*
n
);
break
;
}
#
endif
case
t_singlefloat
:
{
/* SF / ANY */
float
n
=
number_to_double
(
y
);
float
p
=
sf
(
x
)/
n
;
...
...
@@ -342,13 +422,23 @@ floor2(cl_object x, cl_object y)
VALUES
(
1
)
=
make_doublefloat
((
p
-
q
)*
n
);
break
;
}
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
/* LF / ANY */
float
n
=
number_to_double
(
y
);
float
p
=
sf
(
x
)/
n
;
float
q
=
floorl
(
p
);
VALUES
(
0
)
=
float_to_integer
(
q
);
VALUES
(
1
)
=
make_longfloat
((
p
-
q
)*
n
);
break
;
}
#
endif
default
:
FEtype_error_real
(
x
);
}
NVALUES
=
2
;
return
VALUES
(
0
);
}
@
(
defun
floor
(
x
&
optional
(
y
OBJNULL
))
@
if
(
narg
==
1
)
...
...
@@ -371,6 +461,15 @@ ceiling1(cl_object x)
VALUES
(
0
)
=
ceiling2
(
x
->
ratio
.
num
,
x
->
ratio
.
den
);
VALUES
(
1
)
=
make_ratio
(
VALUES
(
1
),
x
->
ratio
.
den
);
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
{
float
d
=
ecl_short_float
(
x
);
float
y
=
ceilf
(
d
);
VALUES
(
0
)
=
float_to_integer
(
y
);
VALUES
(
1
)
=
make_shortfloat
(
d
-
y
);
break
;
}
#
endif
case
t_singlefloat
:
{
float
d
=
sf
(
x
);
float
y
=
ceilf
(
d
);
...
...
@@ -385,6 +484,15 @@ ceiling1(cl_object x)
VALUES
(
1
)
=
make_doublefloat
(
d
-
y
);
break
;
}
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
long
double
d
=
ecl_long_float
(
x
);
long
double
y
=
ceill
(
d
);
VALUES
(
0
)
=
double_to_integer
(
y
);
VALUES
(
1
)
=
make_longfloat
(
d
-
y
);
break
;
}
#
endif
default
:
FEtype_error_real
(
x
);
}
...
...
@@ -434,6 +542,16 @@ ceiling2(cl_object x, cl_object y)
ceiling2
(
number_times
(
x
,
y
->
ratio
.
den
),
y
->
ratio
.
num
);
VALUES
(
1
)
=
make_ratio
(
VALUES
(
1
),
y
->
ratio
.
den
);
break
;
#
ifdef
ECL_SHORT_FLOAT
case
t_shortfloat
:
{
/* FIX / SF */
float
n
=
ecl_short_float
(
y
);
float
p
=
fix
(
x
)/
n
;
float
q
=
ceilf
(
p
);
VALUES
(
0
)
=
float_to_integer
(
q
);
VALUES
(
1
)
=
make_singlefloat
((
p
-
q
)*
n
);
break
;
}
#
endif
case
t_singlefloat
:
{
/* FIX / SF */
float
n
=
sf
(
y
);
float
p
=
fix
(
x
)/
n
;
...
...
@@ -450,6 +568,16 @@ ceiling2(cl_object x, cl_object y)
VALUES
(
1
)
=
make_doublefloat
((
p
-
q
)*
n
);
break
;
}
#
ifdef
ECL_LONG_FLOAT
case
t_longfloat
:
{
/* FIX / DF */
long
double
n
=
ecl_long_float
(
y
);
long
double
p
=
fix
(
x
)/
n
;
long
double
q
=
ceill
(
p
);
VALUES
(
0
)
=
double_to_integer
(
q
);
VALUES
(
1
)
=
make_longfloat
((
p
-
q
)*
n
);
break
;