diff --git a/collects/tests/mzscheme/basic.ss b/collects/tests/mzscheme/basic.ss index cecaecc190..f26e3e6fcd 100644 --- a/collects/tests/mzscheme/basic.ss +++ b/collects/tests/mzscheme/basic.ss @@ -105,6 +105,10 @@ (test #f equal? (make-vector 5 'b) (make-vector 5 'a)) (test #f equal? (box "a") (box "b")) +(test #t equal? #\a #\a) +(test #t equal? (integer->char 1024) (integer->char 1024)) +(test #f equal? (integer->char 1024) (integer->char 1025)) + (arity-test eq? 2 2) (arity-test eqv? 2 2) (arity-test equal? 2 2) @@ -1935,7 +1939,8 @@ (hash-table-put! h1 (save 123456789123456789123456789) 'bignum) (hash-table-put! h1 (save 3.45) 'flonum) (hash-table-put! h1 (save 3/45) 'rational) - (hash-table-put! h1 (save 3+45i) 'complex))] + (hash-table-put! h1 (save 3+45i) 'complex) + (hash-table-put! h1 (save (integer->char 955)) 'char))] [puts2 (lambda () (hash-table-put! h1 (save (list 5 7)) 'another-list) (hash-table-put! h1 (save 3+0.0i) 'izi-complex) @@ -1950,7 +1955,7 @@ (puts1)) (begin (puts1) - (test 6 hash-table-count h1) + (test 7 hash-table-count h1) (puts2)))) (when reorder? @@ -1962,7 +1967,7 @@ (loop (add1 i)) (hash-table-remove! h1 i)))) - (test 12 hash-table-count h1) + (test 13 hash-table-count h1) (test 'list hash-table-get h1 l) (test 'list hash-table-get h1 (list 1 2 3)) (test 'another-list hash-table-get h1 (list 5 7)) @@ -1980,6 +1985,7 @@ (test #f hash-table-get h1 (make-ax 1 2) (lambda () #f)) (test 'box hash-table-get h1 b) (test 'box hash-table-get h1 #&(1 2 3)) + (test 'char hash-table-get h1 (integer->char 955)) (test #t andmap (lambda (i) @@ -1997,13 +2003,14 @@ (#(5 6 7) . vector) (,(make-a 1 (make-a 2 3)) . struct) (,an-ax . structx) + (#\u3BB . char) (#&(1 2 3) . box))) (hash-table-remove! h1 (list 1 2 3)) - (test 11 hash-table-count h1) + (test 12 hash-table-count h1) (test 'not-there hash-table-get h1 l (lambda () 'not-there)) (let ([c 0]) (hash-table-for-each h1 (lambda (k v) (set! c (add1 c)))) - (test 11 'count c)) + (test 12 'count c)) ;; return the hash table: h1))]) diff --git a/src/mred/mrmain.cxx b/src/mred/mrmain.cxx index 82b198eea3..13c67e94dd 100644 --- a/src/mred/mrmain.cxx +++ b/src/mred/mrmain.cxx @@ -176,7 +176,7 @@ static void do_graph_repl(Scheme_Env *env) p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { - if (xfa->alternate_rep) + if (xfa->a->alternate_rep) scheme_eval_string("(read-eval-print-loop)", env); else scheme_eval_string("(graphical-read-eval-print-loop)", env); @@ -200,7 +200,7 @@ static int do_main_loop(FinishArgs *fa) xfa = fa; #ifdef wx_mac - if (!fa->no_front) { + if (!fa->a->no_front) { ProcessSerialNumber psn; GetCurrentProcess(&psn); SetFrontProcess(&psn); /* kCurrentProcess doesn't work */ diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index 7422e4d7db..f9ec6b7e94 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -285,12 +285,14 @@ static char *make_embedded_load(const char *start, const char *end) #define mzcmd_LOAD 1 #define mzcmd_MAIN 2 +/* To avoid having to create a specific mark procedure for + prcise GC, split argument information into purely atomic + and purely non-atomic records. */ + typedef struct { int start_with_req; #ifndef DONT_PARSE_COMMAND_LINE - char **evals_and_loads; - int *eval_kind, num_enl; - Scheme_Object *main_args; + int num_enl; #endif #ifndef DONT_LOAD_INIT_FILE int no_init_file; @@ -306,6 +308,15 @@ typedef struct { int alternate_rep; int no_front; #endif +} FinishArgsAtoms; + +typedef struct { + FinishArgsAtoms *a; +#ifndef DONT_PARSE_COMMAND_LINE + char **evals_and_loads; + int *eval_kind; + Scheme_Object *main_args; +#endif Scheme_Env *global_env; } FinishArgs; @@ -315,12 +326,12 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) { volatile int exit_val = 0; - if (fa->start_with_req) { + if (fa->a->start_with_req) { scheme_eval_string("(require mzscheme)", fa->global_env); } #ifndef DONT_LOAD_INIT_FILE - if (!fa->no_init_file) { + if (!fa->a->no_init_file) { char *filename; filename = GET_INIT_FILENAME(fa->global_env); if (filename) { @@ -336,7 +347,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) volatile int i; mz_jmp_buf * volatile save, newbuf; - for (i = 0; i < fa->num_enl; i++) { + for (i = 0; i < fa->a->num_enl; i++) { if (fa->eval_kind[i] == mzcmd_LOAD) { if (!scheme_load(fa->evals_and_loads[i])) { exit_val = 1; @@ -404,7 +415,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) #endif #ifndef DONT_RUN_REP - if (!fa->no_rep && !fa->script_mode) { + if (!fa->a->no_rep && !fa->a->script_mode) { /* enter read-eval-print loop */ mz_jmp_buf * volatile save, newbuf; Scheme_Thread * volatile p; @@ -417,7 +428,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) } else { exit_val = 1; #ifdef VERSION_YIELD_FLAG - fa->add_yield = 0; + fa->a->add_yield = 0; #endif } p->error_buf = save; @@ -425,7 +436,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) #endif /* DONT_RUN_REP */ #ifdef VERSION_YIELD_FLAG - if (fa->add_yield) { + if (fa->a->add_yield) { mz_jmp_buf * volatile save, newbuf; Scheme_Thread * volatile p; p = scheme_get_current_thread(); @@ -532,6 +543,7 @@ static int run_from_cmd_line(int argc, char *_argv[], #endif int no_lib_path = 0; FinishArgs *fa; + FinishArgsAtoms *fa_a; #ifdef GC_THINKS_ITS_A_DLL_BUT_ISNT DllMain(NULL, DLL_PROCESS_ATTACH, NULL); @@ -1198,27 +1210,29 @@ static int run_from_cmd_line(int argc, char *_argv[], init_mred(global_env); #endif + fa_a = (FinishArgsAtoms *)scheme_malloc_atomic(sizeof(FinishArgsAtoms)); fa = (FinishArgs *)scheme_malloc(sizeof(FinishArgs)); - fa->start_with_req = start_with_req; + fa->a = fa_a; + fa->a->start_with_req = start_with_req; #ifndef DONT_PARSE_COMMAND_LINE fa->evals_and_loads = evals_and_loads; fa->eval_kind = eval_kind; - fa->num_enl = num_enl; + fa->a->num_enl = num_enl; fa->main_args = sch_argv; #endif #ifndef DONT_LOAD_INIT_FILE - fa->no_init_file = no_init_file; + fa->a->no_init_file = no_init_file; #endif #ifndef DONT_RUN_REP - fa->no_rep = no_rep; - fa->script_mode = script_mode; + fa->a->no_rep = no_rep; + fa->a->script_mode = script_mode; #endif #ifdef VERSION_YIELD_FLAG - fa->add_yield = add_yield; + fa->a->add_yield = add_yield; #endif #ifdef CMDLINE_STDIO_FLAG - fa->alternate_rep = alternate_rep; - fa->no_front = no_front; + fa->a->alternate_rep = alternate_rep; + fa->a->no_front = no_front; #endif fa->global_env = global_env; diff --git a/src/mzscheme/src/hash.c b/src/mzscheme/src/hash.c index 79069d4204..ff9f92d403 100644 --- a/src/mzscheme/src/hash.c +++ b/src/mzscheme/src/hash.c @@ -953,6 +953,8 @@ static long equal_hash_key(Scheme_Object *o, long k) o = SCHEME_VEC_ELS(o)[len]; break; } + case scheme_char_type: + return k + SCHEME_CHAR_VAL(o); case scheme_byte_string_type: case scheme_unix_path_type: case scheme_windows_path_type: @@ -1183,6 +1185,8 @@ long scheme_equal_hash_key2(Scheme_Object *o) return k; } + case scheme_char_type: + return t; case scheme_byte_string_type: case scheme_unix_path_type: case scheme_windows_path_type: