suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add unsafe-fx->fl; avoid some gcc warnings

Browse Source 
svn: r16221
This commit is contained in:
Matthew Flatt 2009-10-02 19:45:41 +00:00
parent 83f9c99cf1
commit 01d15eb9b6
13 changed files with 41 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/scribblings/reference/unsafe.scrbl
View File

@ -79,6 +79,11 @@ For @tech{fixnums}: Like @scheme[=], @scheme[<], @scheme[>],
@tech{fixnums}.}
@defproc[(unsafe-fx->fl [a fixnum?]) inexact-real?]{
Like @scheme[exact->inexact], but constrained to consume @tech{fixnums}.
}
@deftogether[(
@defproc[(unsafe-fl+ [a inexact-real?][b inexact-real?]) inexact-real?]
@defproc[(unsafe-fl- [a inexact-real?][b inexact-real?]) inexact-real?]

2
collects/scribblings/scribble/manual.scrbl
View File

@ -164,7 +164,7 @@ hyperlinked to the module path's definition as created by
@scheme[defmodule].}
@defform[(schememodlink datum pre-content-expr ...)]{
Like @scheme[schememodlink], but separating the module path to link
Like @scheme[schememod], but separating the module path to link
from the content to be linked. The @scheme[datum] module path is always
linked, even if it is not an identifier.}

3
collects/tests/mzscheme/unsafe.ss
View File

@ -119,6 +119,9 @@
(test-bin 8 'unsafe-fxrshift 32 2)
(test-bin 8 'unsafe-fxrshift 8 0)
(test-un 8.0 'unsafe-fx->fl 8)
(test-un -8.0 'unsafe-fx->fl -8)
(test-un 5 'unsafe-car (cons 5 9))
(test-un 9 'unsafe-cdr (cons 5 9))
(test-un 15 'unsafe-mcar (mcons 15 19))

17
src/mzscheme/gc2/newgc.c
View File

@ -2106,23 +2106,26 @@ void GC_mark(const void *const_p)
/* this is what actually does mark propagation */
static inline void propagate_marks_worker(PageMap pagemap, Mark_Proc *mark_table, void *pp)
{
void **start;
void **start, **end;
int alloc_type;
objhead *info;
mpage *page;
int is_big_page = IS_BIG_PAGE_PTR(pp);
void *p = REMOVE_BIG_PAGE_PTR_TAG(pp);
void *p;
/* we can assume a lot here -- like it's a valid pointer with a page --
because we vet bad cases out in GC_mark, above */
if (is_big_page) {
if (IS_BIG_PAGE_PTR(pp)) {
mpage *page;
p = REMOVE_BIG_PAGE_PTR_TAG(pp);
page = pagemap_find_page(pagemap, p);
start = PPTR(BIG_PAGE_TO_OBJECT(page));
alloc_type = page->page_type;
end = PAGE_END_VSS(page);
} else {
objhead *info;
p = pp;
info = OBJPTR_TO_OBJHEAD(p);
start = p;
alloc_type = info->type;
end = PPTR(info) + info->size;
}
set_backtrace_source(start, alloc_type);
@ -2144,12 +2147,10 @@ static inline void propagate_marks_worker(PageMap pagemap, Mark_Proc *mark_table
break;
case PAGE_ARRAY:
{
void **end = is_big_page ? PAGE_END_VSS(page) : PPTR(info) + info->size;
while(start < end) gcMARK(*start++); break;
}
case PAGE_TARRAY:
{
void **end = is_big_page ? PAGE_END_VSS(page) : PPTR(info) + info->size;
const unsigned short tag = *(unsigned short *)start;
ASSERT_TAG(tag);
end -= INSET_WORDS;

3
src/mzscheme/src/bool.c
View File

@ -29,9 +29,6 @@
#ifdef USE_STACKAVAIL
# include <malloc.c>
#endif
#ifdef USE_IEEE_FP_PREDS
# include <math.h>
#endif
/* global_constants */
Scheme_Object scheme_true[1];

8
src/mzscheme/src/jit.c
View File

@ -3660,7 +3660,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
if (for_branch) mz_rs_sync();
}
if (unsafe_fl || (!SCHEME_INTP(rand) && can_fast_double(arith, cmp, 1))) {
if (unsafe_fl || (!unsafe_fx && !SCHEME_INTP(rand) && can_fast_double(arith, cmp, 1))) {
/* Maybe they're both doubles... */
if (unsafe_fl) mz_rs_sync();
generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl);
@ -3709,7 +3709,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
CHECK_LIMIT();
}
if (unsafe_fl || can_fast_double(arith, cmp, 1)) {
if (unsafe_fl || (!unsafe_fx && can_fast_double(arith, cmp, 1))) {
/* Maybe they're both doubles... */
if (unsafe_fl) mz_rs_sync();
generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl);
@ -3753,6 +3753,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
if (unsafe_fl
|| ((orig_args != 2) /* <- heuristic: we could generate code when an exact argument is
given, but the extra FP code is probably not worthwhile. */
&& !unsafe_fx
&& can_fast_double(arith, cmp, 0)
/* watch out: divide by 0 is special: */
&& ((arith != -2) || v || reversed))) {
@ -4766,6 +4767,9 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
} else if (IS_NAMED_PRIM(rator, "exact->inexact")) {
generate_arith(jitter, rator, app->rand, NULL, 1, 12, 0, 0, NULL, 1, 0, 0);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-fx->fl")) {
generate_arith(jitter, rator, app->rand, NULL, 1, 12, 0, 0, NULL, 1, 1, 0);
return 1;
} else if (IS_NAMED_PRIM(rator, "bitwise-not")) {
generate_arith(jitter, rator, app->rand, NULL, 1, 7, 0, 9, NULL, 1, 0, 0);
return 1;

21
src/mzscheme/src/mzmark.c
View File

@ -196,27 +196,6 @@ static int offset_cpointer_obj_FIXUP(void *p) {
#define offset_cpointer_obj_IS_CONST_SIZE 1
static int second_of_cons_SIZE(void *p) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object));
}
static int second_of_cons_MARK(void *p) {
gcMARK(SCHEME_PTR2_VAL((Scheme_Object *)p));
return
gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object));
}
static int second_of_cons_FIXUP(void *p) {
gcFIXUP(SCHEME_PTR2_VAL((Scheme_Object *)p));
return
gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object));
}
#define second_of_cons_IS_ATOMIC 0
#define second_of_cons_IS_CONST_SIZE 1
static int twoptr_obj_SIZE(void *p) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object));

7
src/mzscheme/src/mzmarksrc.c
View File

@ -70,13 +70,6 @@ offset_cpointer_obj {
gcBYTES_TO_WORDS(sizeof(Scheme_Offset_Cptr));
}
second_of_cons {
mark:
gcMARK(SCHEME_PTR2_VAL((Scheme_Object *)p));
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object));
}
twoptr_obj {
mark:
gcMARK(SCHEME_PTR1_VAL((Scheme_Object *)p));

13
src/mzscheme/src/number.c
View File

@ -104,6 +104,7 @@ static Scheme_Object *fx_xor (int argc, Scheme_Object *argv[]);
static Scheme_Object *fx_not (int argc, Scheme_Object *argv[]);
static Scheme_Object *fx_lshift (int argc, Scheme_Object *argv[]);
static Scheme_Object *fx_rshift (int argc, Scheme_Object *argv[]);
static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[]);
static double not_a_number_val;
@ -519,6 +520,11 @@ void scheme_init_unsafe_number(Scheme_Env *env)
p = scheme_make_folding_prim(fx_rshift, "unsafe-fxrshift", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("unsafe-fxrshift", p, env);
p = scheme_make_folding_prim(fx_to_fl, "unsafe-fx->fl", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("unsafe-fx->fl", p, env);
}
@ -2801,3 +2807,10 @@ static Scheme_Object *fx_not (int argc, Scheme_Object *argv[])
return scheme_make_integer(v);
}
static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[])
{
long v;
if (scheme_current_thread->constant_folding) return scheme_exact_to_inexact(argc, argv);
v = SCHEME_INT_VAL(argv[0]);
return scheme_make_double(v);
}

1
src/mzscheme/src/read.c
View File

@ -46,7 +46,6 @@
#ifdef USE_STACKAVAIL
# include <malloc.h>
#endif
#include "math.h"
#define MAX_QUICK_SYMBOL_SIZE 64

2
src/mzscheme/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 959
#define EXPECTED_UNSAFE_COUNT 38
#define EXPECTED_UNSAFE_COUNT 39
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

1
src/mzscheme/src/schpriv.h
View File

@ -1651,6 +1651,7 @@ extern int scheme_is_nan(double);
# define MZ_IS_NAN(d) _isnan(d)
# else
/* USE_IEEE_FP_PREDS */
# include <math.h>
# define MZ_IS_INFINITY(d) (isinf(d))
# define MZ_IS_POS_INFINITY(d) (isinf(d) && (d > 0))
# define MZ_IS_NEG_INFINITY(d) (isinf(d) && (d < 0))

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "4.2.2.2"
#define MZSCHEME_VERSION "4.2.2.3"
#define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 2
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)