Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Beginning of bignum support

Browse source
This commit is contained in:
Justin Ethier 2017-03-29 07:11:15 +00:00
parent 4e600a243a
commit 6e9fcc6434
1 changed files with 70 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

105
srfi/60.scm
View file

@ -1,38 +1,73 @@
#| ;;;; Cyclone Scheme
| Copyright (c) 1991, 1993, 2001, 2003, 2005 Aubrey Jaffer ;;;; https://github.com/justinethier/cyclone
| Copyright (c) 2017, Koz Ross ;;;;
| ;;;; Copyright (c) 1991, 1993, 2001, 2003, 2005 Aubrey Jaffer
| All rights reserved. ;;;; Copyright (c) 2017, Koz Ross, Justin Ethier
| ;;;;
| Redistribution and use in source and binary forms, with or without ;;;; All rights reserved.
| modification, are permitted provided that the following conditions are met: ;;;;
| * Redistributions of source code must retain the above copyright ;;;; Redistribution and use in source and binary forms, with or without
| notice, this list of conditions and the following disclaimer. ;;;; modification, are permitted provided that the following conditions are met:
| * Redistributions in binary form must reproduce the above copyright ;;;; * Redistributions of source code must retain the above copyright
| notice, this list of conditions and the following disclaimer in the ;;;; notice, this list of conditions and the following disclaimer.
| documentation and/or other materials provided with the distribution. ;;;; * Redistributions in binary form must reproduce the above copyright
| * Neither the name of Cyclone nor the ;;;; notice, this list of conditions and the following disclaimer in the
| names of its contributors may be used to endorse or promote products ;;;; documentation and/or other materials provided with the distribution.
| derived from this software without specific prior written permission. ;;;; * Neither the name of Cyclone nor the
| ;;;; names of its contributors may be used to endorse or promote products
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ;;;; derived from this software without specific prior written permission.
| ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;;;
| WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
| DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY ;;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
| DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES ;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
| (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; ;;;; DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
| LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
| ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
| (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
| SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|# ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;;
(define-c raw-logand (define-c raw-logand
"(void* data, int argc, closure _, object k, object x, object y)" "(void* data, int argc, closure _, object k, object x, object y)"
"Cyc_check_int(data, x); "Cyc_check_int(data, x);
Cyc_check_int(data, y); Cyc_check_int(data, y);
int result = ((int)unbox_number(x)) & ((int)unbox_number(y));
return_closcall1(data, k, obj_int2obj(result));") if (obj_is_int(x) && obj_is_int(y)) {
int result = ((int)unbox_number(x)) & ((int)unbox_number(y));
return_closcall1(data, k, obj_int2obj(result));
} else {
int result;
alloc_bignum(data, bn);
mp_int *xx, *yy;
mp_int tmpx, tmpy;
if (obj_is_int(x)) {
mp_init(&tmpx);
Cyc_int2bignum(obj_obj2int(x), &tmpx);
xx = &tmpx;
} else {
xx = &bignum_value(x);
}
if (obj_is_int(y)) {
mp_init(&tmpy);
Cyc_int2bignum(obj_obj2int(y), &tmpy);
yy = &tmpy;
} else {
yy = &bignum_value(y);
}
result = mp_and(xx, yy, &(bignum_value(bn)));
if (MP_OKAY != result) {
char buffer[128];
snprintf(buffer, 127, \"Bignum error: %s\", mp_error_to_string(result));
Cyc_rt_raise_msg(data, buffer);
}
return_closcall1(data, k, Cyc_bignum_normalize(data, bn));
}
")
(define (logand x . rest) (define (logand x . rest)
(if (null? rest) (if (null? rest)
@ -43,10 +78,10 @@
(define-c raw-logior (define-c raw-logior
"(void* data, int argc, closure _, object k, object x, object y)" "(void* data, int argc, closure _, object k, object x, object y)"
"Cyc_check_int(data, x); "Cyc_check_fixnum(data, x); // TODO: bignum support
Cyc_check_int(data, y); Cyc_check_fixnum(data, y);
int result = ((int)unbox_number(x)) | ((int)unbox_number(y)); int result = ((int)unbox_number(x)) | ((int)unbox_number(y));
return_closcall1(data, k, obj_int2obj(result));") return_closcall1(data, k, obj_int2obj(result));")
(define (logior x . rest) (define (logior x . rest)
(if (null? rest) (if (null? rest)