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

fix problem with code inspectors and unmarshaling syntax (PR 10429)

Browse Source 
svn: r15957
This commit is contained in:
Matthew Flatt 2009-09-10 15:27:41 +00:00
parent 07b104e939
commit f49af7c4fa
5 changed files with 46 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -134,7 +134,7 @@ static Scheme_Object *write_local(Scheme_Object *obj);
static Scheme_Object *read_local(Scheme_Object *obj);
static Scheme_Object *read_local_unbox(Scheme_Object *obj);
static Scheme_Object *write_resolve_prefix(Scheme_Object *obj);
static Scheme_Object *read_resolve_prefix(Scheme_Object *obj);
static Scheme_Object *read_resolve_prefix(Scheme_Object *obj, Scheme_Object *insp);
static void skip_certain_things(Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data);
int scheme_is_module_begin_env(Scheme_Comp_Env *env);
@ -624,7 +624,7 @@ static void make_kernel_env(void)
scheme_install_type_writer(scheme_local_unbox_type, write_local);
scheme_install_type_reader(scheme_local_unbox_type, read_local_unbox);
scheme_install_type_writer(scheme_resolve_prefix_type, write_resolve_prefix);
scheme_install_type_reader(scheme_resolve_prefix_type, read_resolve_prefix);
scheme_install_type_reader2(scheme_resolve_prefix_type, read_resolve_prefix);
REGISTER_SO(kernel_symbol);
kernel_symbol = scheme_intern_symbol("#%kernel");
@ -5513,7 +5513,7 @@ static Scheme_Object *write_resolve_prefix(Scheme_Object *obj)
return tv;
}
static Scheme_Object *read_resolve_prefix(Scheme_Object *obj)
static Scheme_Object *read_resolve_prefix(Scheme_Object *obj, Scheme_Object *insp)
{
Resolve_Prefix *rp;
Scheme_Object *tv, *sv, **a, *stx;
@ -5546,7 +5546,7 @@ static Scheme_Object *read_resolve_prefix(Scheme_Object *obj)
rp->num_stxes = SCHEME_VEC_SIZE(sv);
rp->num_lifts = i;
if (uses_unsafe)
rp->uses_unsafe = scheme_true; /* reset in read_marshalled */
rp->uses_unsafe = insp;
i = rp->num_toplevels;
a = MALLOC_N(Scheme_Object *, i);

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

@ -5062,7 +5062,7 @@ static Scheme_Object *read_compact_quote(CPort *port, int embedded)
static Scheme_Object *read_marshalled(int type, CPort *port)
{
Scheme_Object *l;
Scheme_Type_Reader reader;
Scheme_Type_Reader2 reader;
l = read_compact(port, 1);
@ -5076,17 +5076,11 @@ static Scheme_Object *read_marshalled(int type, CPort *port)
scheme_ill_formed_code(port);
}
l = reader(l);
l = reader(l, port->insp);
if (!l)
scheme_ill_formed_code(port);
if (type == scheme_resolve_prefix_type) {
/* If unsafe_insp is set, need to use the one in port: */
if (((Resolve_Prefix *)l)->uses_unsafe)
((Resolve_Prefix *)l)->uses_unsafe = port->insp;
}
return l;
}
@ -5541,6 +5535,11 @@ void scheme_unmarshal_wrap_set(Scheme_Unmarshal_Tables *ut,
ut->decoded[l] = 1;
}
Scheme_Object *scheme_get_cport_inspector(struct CPort *rp)
{
return rp->insp;
}
/*========================================================================*/
/* readtable support */
/*========================================================================*/

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

@ -236,9 +236,10 @@ void scheme_free_dynamic_extensions(void);
/* Type readers & writers for compiled code data */
typedef Scheme_Object *(*Scheme_Type_Reader)(Scheme_Object *list);
typedef Scheme_Object *(*Scheme_Type_Reader2)(Scheme_Object *list, Scheme_Object *insp);
typedef Scheme_Object *(*Scheme_Type_Writer)(Scheme_Object *obj);
extern Scheme_Type_Reader *scheme_type_readers;
extern Scheme_Type_Reader2 *scheme_type_readers;
extern Scheme_Type_Writer *scheme_type_writers;
extern Scheme_Equal_Proc *scheme_type_equals;
@ -1801,6 +1802,7 @@ extern Scheme_Object *scheme_default_global_print_handler;
/* Type readers & writers for compiled code data */
void scheme_install_type_reader(Scheme_Type type, Scheme_Type_Reader f);
void scheme_install_type_reader2(Scheme_Type type, Scheme_Type_Reader2 f);
void scheme_install_type_writer(Scheme_Type type, Scheme_Type_Writer f);
Scheme_Object *scheme_make_default_readtable(void);
@ -2545,6 +2547,8 @@ typedef struct Scheme_Unmarshal_Tables {
char *decoded;
} Scheme_Unmarshal_Tables;
Scheme_Object *scheme_get_cport_inspector(struct CPort *rp);
Scheme_Object *scheme_unmarshal_wrap_get(Scheme_Unmarshal_Tables *ut,
Scheme_Object *wraps_key,
int *_decoded);

25
src/mzscheme/src/stxobj.c
View File

@ -73,7 +73,7 @@ static Scheme_Object *syntax_recertify(int argc, Scheme_Object **argv);
static Scheme_Object *lift_inactive_certs(Scheme_Object *o, int as_active);
static Scheme_Object *write_free_id_info_prefix(Scheme_Object *obj);
static Scheme_Object *read_free_id_info_prefix(Scheme_Object *obj);
static Scheme_Object *read_free_id_info_prefix(Scheme_Object *obj, Scheme_Object *insp);
static Scheme_Object *source_symbol; /* uninterned! */
static Scheme_Object *share_symbol; /* uninterned! */
@ -629,7 +629,7 @@ void scheme_init_stx(Scheme_Env *env)
scheme_install_type_writer(scheme_free_id_info_type, write_free_id_info_prefix);
scheme_install_type_reader(scheme_free_id_info_type, read_free_id_info_prefix);
scheme_install_type_reader2(scheme_free_id_info_type, read_free_id_info_prefix);
}
void scheme_init_stx_places() {
@ -7119,7 +7119,8 @@ static int ok_phase_index(Scheme_Object *o) {
return ok_phase(o);
}
static Scheme_Object *datum_to_module_renames(Scheme_Object *a, Scheme_Hash_Table *ht, int lex_ok)
static Scheme_Object *datum_to_module_renames(Scheme_Object *a, Scheme_Hash_Table *ht, int lex_ok,
Scheme_Unmarshal_Tables *ut)
{
int count, i;
Scheme_Object *key, *p0, *p;
@ -7138,6 +7139,9 @@ static Scheme_Object *datum_to_module_renames(Scheme_Object *a, Scheme_Hash_Tabl
if (SCHEME_PAIRP(p) && SCHEME_INTP(SCHEME_CAR(p))) {
/* reconstruct inspector info */
Scheme_Object *insp;
if (ut)
insp = scheme_get_cport_inspector(ut->rp);
else
insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
if (!SAME_OBJ(scheme_make_integer(1), SCHEME_CAR(p))) {
insp = CONS(scheme_make_inspector(insp), insp);
@ -7485,7 +7489,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
mns = SCHEME_CDR(mns);
}
if (!datum_to_module_renames(a, mrn->ht, 0))
if (!datum_to_module_renames(a, mrn->ht, 0, ut))
return_NULL;
/* Extract free-id=? renames, if any */
@ -7493,7 +7497,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
Scheme_Hash_Table *ht;
ht = scheme_make_hash_table(SCHEME_hash_ptr);
mrn->free_id_renames = ht;
if (!datum_to_module_renames(SCHEME_CAR(mns), mrn->free_id_renames, 1))
if (!datum_to_module_renames(SCHEME_CAR(mns), mrn->free_id_renames, 1, ut))
return_NULL;
mns = SCHEME_CDR(mns);
}
@ -7650,6 +7654,9 @@ Scheme_Object *cert_marks_to_certs(Scheme_Object *cert_marks,
cert_marks = a;
}
if (ut)
insp = scheme_get_cport_inspector(ut->rp);
else
insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
while (SCHEME_PAIRP(cert_marks)) {
@ -9168,9 +9175,9 @@ static Scheme_Object *write_free_id_info_prefix(Scheme_Object *obj)
return vec;
}
static Scheme_Object *read_free_id_info_prefix(Scheme_Object *obj)
static Scheme_Object *read_free_id_info_prefix(Scheme_Object *obj, Scheme_Object *insp)
{
Scheme_Object *vec, *insp;
Scheme_Object *vec;
int i;
if (!SCHEME_VECTORP(obj)
@ -9182,10 +9189,8 @@ static Scheme_Object *read_free_id_info_prefix(Scheme_Object *obj)
SCHEME_VEC_ELS(vec)[i] = SCHEME_VEC_ELS(obj)[i];
}
if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[7])) {
insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[7]))
SCHEME_VEC_ELS(vec)[7] = insp;
}
vec->type = scheme_free_id_info_type;

18
src/mzscheme/src/type.c
View File

@ -26,7 +26,7 @@
#include "schpriv.h"
#include <string.h>
Scheme_Type_Reader *scheme_type_readers;
Scheme_Type_Reader2 *scheme_type_readers;
Scheme_Type_Writer *scheme_type_writers;
Scheme_Equal_Proc *scheme_type_equals;
Scheme_Primary_Hash_Proc *scheme_type_hash1s;
@ -54,7 +54,7 @@ static void init_type_arrays()
allocmax = maxtype + 100;
type_names = MALLOC_N(char *, allocmax);
scheme_type_readers = MALLOC_N_ATOMIC(Scheme_Type_Reader, allocmax);
scheme_type_readers = MALLOC_N_ATOMIC(Scheme_Type_Reader2, allocmax);
n = allocmax * sizeof(Scheme_Type_Reader);
memset((char *)scheme_type_readers, 0, n);
@ -295,10 +295,10 @@ Scheme_Type scheme_make_type(const char *name)
memcpy(naya, type_names, maxtype * sizeof(char *));
type_names = (char **)naya;
naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Type_Reader));
naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Type_Reader2));
memset((char *)naya, 0, n);
memcpy(naya, scheme_type_readers, maxtype * sizeof(Scheme_Type_Reader));
scheme_type_readers = (Scheme_Type_Reader *)naya;
memcpy(naya, scheme_type_readers, maxtype * sizeof(Scheme_Type_Reader2));
scheme_type_readers = (Scheme_Type_Reader2 *)naya;
naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Type_Writer));
memset((char *)naya, 0, n);
@ -344,6 +344,14 @@ char *scheme_get_type_name(Scheme_Type t)
}
void scheme_install_type_reader(Scheme_Type t, Scheme_Type_Reader f)
{
if (t < 0 || t >= maxtype)
return;
scheme_type_readers[t] = (Scheme_Type_Reader2)f;
}
void scheme_install_type_reader2(Scheme_Type t, Scheme_Type_Reader2 f)
{
if (t < 0 || t >= maxtype)
return;