diff options
-rw-r--r-- | libguile/frames.c | 12 | ||||
-rw-r--r-- | libguile/frames.h | 17 | ||||
-rw-r--r-- | libguile/objcodes.h | 3 | ||||
-rw-r--r-- | libguile/programs.c | 52 | ||||
-rw-r--r-- | libguile/programs.h | 9 | ||||
-rw-r--r-- | libguile/vm-engine.c | 12 | ||||
-rw-r--r-- | libguile/vm-engine.h | 36 | ||||
-rw-r--r-- | libguile/vm-i-loader.c | 2 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 84 | ||||
-rw-r--r-- | libguile/vm.c | 6 | ||||
-rw-r--r-- | module/language/objcode/spec.scm | 4 | ||||
-rw-r--r-- | module/system/vm/program.scm | 7 |
12 files changed, 60 insertions, 184 deletions
diff --git a/libguile/frames.c b/libguile/frames.c index 76552f54f..e89184d79 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -222,16 +222,6 @@ SCM_DEFINE (scm_vm_frame_dynamic_link, "vm-frame-dynamic-link", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_vm_frame_external_link, "vm-frame-external-link", 1, 0, 0, - (SCM frame), - "") -#define FUNC_NAME s_scm_vm_frame_external_link -{ - SCM_VALIDATE_VM_FRAME (1, frame); - return SCM_FRAME_EXTERNAL_LINK (SCM_VM_FRAME_FP (frame)); -} -#undef FUNC_NAME - SCM_DEFINE (scm_vm_frame_stack, "vm-frame-stack", 1, 0, 0, (SCM frame), "") diff --git a/libguile/frames.h b/libguile/frames.h index 99623fb16..1d8a30f8e 100644 --- a/libguile/frames.h +++ b/libguile/frames.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2001 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009 Free Software Foundation, Inc. * * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -30,12 +30,11 @@ /* VM Frame Layout --------------- - | | <- fp + bp->nargs + bp->nlocs + 4 + | | <- fp + bp->nargs + bp->nlocs + 3 +------------------+ = SCM_FRAME_UPPER_ADDRESS (fp) | Return address | | MV return address| - | Dynamic link | - | External link | <- fp + bp->nargs + bp->nlocs + | Dynamic link | <- fp + bp->nargs + bp->blocs | Local variable 1 | = SCM_FRAME_DATA_ADDRESS (fp) | Local variable 0 | <- fp + bp->nargs | Argument 1 | @@ -51,21 +50,20 @@ #define SCM_FRAME_DATA_ADDRESS(fp) \ (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \ + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs) -#define SCM_FRAME_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 4) +#define SCM_FRAME_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 3) #define SCM_FRAME_LOWER_ADDRESS(fp) (fp - 1) #define SCM_FRAME_BYTE_CAST(x) ((scm_byte_t *) SCM_UNPACK (x)) #define SCM_FRAME_STACK_CAST(x) ((SCM *) SCM_UNPACK (x)) #define SCM_FRAME_RETURN_ADDRESS(fp) \ - (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3])) -#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \ (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2])) +#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \ + (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1])) #define SCM_FRAME_DYNAMIC_LINK(fp) \ - (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1])) + (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0])) #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \ ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(dl); -#define SCM_FRAME_EXTERNAL_LINK(fp) (SCM_FRAME_DATA_ADDRESS (fp)[0]) #define SCM_FRAME_VARIABLE(fp,i) fp[i] #define SCM_FRAME_PROGRAM(fp) fp[-1] @@ -106,7 +104,6 @@ SCM_API SCM scm_vm_frame_local_set_x (SCM frame, SCM index, SCM val); SCM_API SCM scm_vm_frame_return_address (SCM frame); SCM_API SCM scm_vm_frame_mv_return_address (SCM frame); SCM_API SCM scm_vm_frame_dynamic_link (SCM frame); -SCM_API SCM scm_vm_frame_external_link (SCM frame); SCM_API SCM scm_vm_frame_stack (SCM frame); SCM_API SCM scm_c_vm_frame_prev (SCM frame); diff --git a/libguile/objcodes.h b/libguile/objcodes.h index e9b1cdbff..6727e23e8 100644 --- a/libguile/objcodes.h +++ b/libguile/objcodes.h @@ -26,7 +26,7 @@ struct scm_objcode { scm_t_uint8 nargs; scm_t_uint8 nrest; scm_t_uint8 nlocs; - scm_t_uint8 nexts; + scm_t_uint8 unused; scm_t_uint32 len; /* the maximum index of base[] */ scm_t_uint32 metalen; /* well, i lie. this many bytes at the end of base[] for metadata */ @@ -49,7 +49,6 @@ SCM_API scm_t_bits scm_tc16_objcode; #define SCM_OBJCODE_NARGS(x) (SCM_OBJCODE_DATA (x)->nargs) #define SCM_OBJCODE_NREST(x) (SCM_OBJCODE_DATA (x)->nrest) #define SCM_OBJCODE_NLOCS(x) (SCM_OBJCODE_DATA (x)->nlocs) -#define SCM_OBJCODE_NEXTS(x) (SCM_OBJCODE_DATA (x)->nexts) #define SCM_OBJCODE_BASE(x) (SCM_OBJCODE_DATA (x)->base) #define SCM_OBJCODE_IS_MMAP(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP) diff --git a/libguile/programs.c b/libguile/programs.c index 892b6770f..9e74f98e3 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -36,7 +36,7 @@ scm_t_bits scm_tc16_program; static SCM write_program = SCM_BOOL_F; SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0, - (SCM objcode, SCM objtable, SCM external), + (SCM objcode, SCM objtable, SCM free_vars), "") #define FUNC_NAME s_scm_make_program { @@ -45,18 +45,12 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0, objtable = SCM_BOOL_F; else if (scm_is_true (objtable)) SCM_VALIDATE_VECTOR (2, objtable); - if (SCM_UNLIKELY (SCM_UNBNDP (external))) - external = SCM_EOL; - else - /* FIXME: currently this test is quite expensive (can be 2-3% of total - execution time in programs that make many closures). We could remove it, - yes, but we'd get much better gains if we used some other method, like - just capturing the variables that we need instead of all heap-allocated - variables. Dunno. Keeping the check for now, as it's a user-callable - function, and inlining the op in the vm's make-closure operation. */ - SCM_VALIDATE_LIST (3, external); - - SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, external); + if (SCM_UNLIKELY (SCM_UNBNDP (free_vars))) + free_vars = SCM_BOOL_F; + else if (free_vars != SCM_BOOL_F) + SCM_VALIDATE_VECTOR (3, free_vars); + + SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_vars); } #undef FUNC_NAME @@ -65,8 +59,8 @@ program_mark (SCM obj) { if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj))) scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj)); - if (!scm_is_null (SCM_PROGRAM_EXTERNALS (obj))) - scm_gc_mark (SCM_PROGRAM_EXTERNALS (obj)); + if (scm_is_true (SCM_PROGRAM_FREE_VARS (obj))) + scm_gc_mark (SCM_PROGRAM_FREE_VARS (obj)); return SCM_PROGRAM_OBJCODE (obj); } @@ -151,10 +145,9 @@ SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0, SCM_VALIDATE_PROGRAM (1, program); p = SCM_PROGRAM_DATA (program); - return scm_list_4 (SCM_I_MAKINUM (p->nargs), + return scm_list_3 (SCM_I_MAKINUM (p->nargs), SCM_I_MAKINUM (p->nrest), - SCM_I_MAKINUM (p->nlocs), - SCM_I_MAKINUM (p->nexts)); + SCM_I_MAKINUM (p->nlocs)); } #undef FUNC_NAME @@ -191,7 +184,7 @@ SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0, metaobj = scm_objcode_meta (SCM_PROGRAM_OBJCODE (program)); if (scm_is_true (metaobj)) - return scm_make_program (metaobj, SCM_BOOL_F, SCM_EOL); + return scm_make_program (metaobj, SCM_BOOL_F, SCM_BOOL_F); else return SCM_BOOL_F; } @@ -300,26 +293,13 @@ scm_c_program_source (SCM program, size_t ip) return source; /* (addr . (filename . (line . column))) */ } -SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0, +SCM_DEFINE (scm_program_free_vars, "program-free-vars", 1, 0, 0, (SCM program), "") -#define FUNC_NAME s_scm_program_external -{ - SCM_VALIDATE_PROGRAM (1, program); - return SCM_PROGRAM_EXTERNALS (program); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_program_external_set_x, "program-external-set!", 2, 0, 0, - (SCM program, SCM external), - "Modify the list of closure variables of @var{program} (for " - "debugging purposes).") -#define FUNC_NAME s_scm_program_external_set_x +#define FUNC_NAME s_scm_program_free_vars { SCM_VALIDATE_PROGRAM (1, program); - SCM_VALIDATE_LIST (2, external); - SCM_PROGRAM_EXTERNALS (program) = external; - return SCM_UNSPECIFIED; + return SCM_PROGRAM_FREE_VARS (program); } #undef FUNC_NAME diff --git a/libguile/programs.h b/libguile/programs.h index 16a15500f..0564139f7 100644 --- a/libguile/programs.h +++ b/libguile/programs.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2001 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -35,12 +35,12 @@ SCM_API scm_t_bits scm_tc16_program; #define SCM_PROGRAM_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x)) #define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x)) #define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (x)) -#define SCM_PROGRAM_EXTERNALS(x) (SCM_SMOB_OBJECT_3 (x)) +#define SCM_PROGRAM_FREE_VARS(x) (SCM_SMOB_OBJECT_3 (x)) #define SCM_PROGRAM_DATA(x) (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x))) #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P) #define SCM_PROGRAM_IS_BOOT(x) (SCM_SMOB_FLAGS (x) & SCM_F_PROGRAM_IS_BOOT) -SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM externals); +SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_vars); SCM_API SCM scm_program_p (SCM obj); SCM_API SCM scm_program_base (SCM program); @@ -53,8 +53,7 @@ SCM_API SCM scm_program_properties (SCM program); SCM_API SCM scm_program_name (SCM program); SCM_API SCM scm_program_objects (SCM program); SCM_API SCM scm_program_module (SCM program); -SCM_API SCM scm_program_external (SCM program); -SCM_API SCM scm_program_external_set_x (SCM program, SCM external); +SCM_API SCM scm_program_free_vars (SCM program); SCM_API SCM scm_program_objcode (SCM program); SCM_API SCM scm_c_program_source (SCM program, size_t ip); diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 7a98a8a62..8a0c92d24 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -21,14 +21,12 @@ #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE) #define VM_USE_HOOKS 0 /* Various hooks */ #define VM_USE_CLOCK 0 /* Bogoclock */ -#define VM_CHECK_EXTERNAL 1 /* Check external link */ #define VM_CHECK_OBJECT 1 /* Check object table */ #define VM_CHECK_CLOSURE 1 /* Check closure vars */ #define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */ #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE) #define VM_USE_HOOKS 1 #define VM_USE_CLOCK 1 -#define VM_CHECK_EXTERNAL 1 #define VM_CHECK_OBJECT 1 #define VM_CHECK_CLOSURE 1 #define VM_PUSH_DEBUG_FRAMES 1 @@ -49,7 +47,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs) /* Cache variables */ struct scm_objcode *bp = NULL; /* program base pointer */ - SCM external = SCM_EOL; /* external environment REMOVEME */ SCM *closure = NULL; /* closure variables */ size_t closure_count = 0; /* length of CLOSURE */ SCM *objects = NULL; /* constant objects */ @@ -230,13 +227,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs) goto vm_error; #endif -#if VM_CHECK_EXTERNAL - vm_error_external: - err_msg = scm_from_locale_string ("VM: Invalid external access"); - finish_args = SCM_EOL; - goto vm_error; -#endif - #if VM_CHECK_OBJECT vm_error_object: err_msg = scm_from_locale_string ("VM: Invalid object table access"); @@ -263,8 +253,8 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs) #undef VM_USE_HOOKS #undef VM_USE_CLOCK -#undef VM_CHECK_EXTERNAL #undef VM_CHECK_OBJECT +#undef VM_CHECK_CLOSURE #undef VM_PUSH_DEBUG_FRAMES /* diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h index a2c1effd3..b860bf151 100644 --- a/libguile/vm-engine.h +++ b/libguile/vm-engine.h @@ -138,11 +138,7 @@ #define ASSERT_BOUND(x) #endif -/* Get a local copy of the program's "object table" (i.e. the vector of - external bindings that are referenced by the program), initialized by - `load-program'. */ -/* XXX: We could instead use the "simple vector macros", thus not having to - call `scm_vector_writable_elements ()' and the likes. */ +/* Cache the object table and free variables. */ #define CACHE_PROGRAM() \ { \ if (bp != SCM_PROGRAM_DATA (program)) { \ @@ -156,7 +152,7 @@ } \ } \ { \ - SCM c = SCM_PROGRAM_EXTERNALS (program); \ + SCM c = SCM_PROGRAM_FREE_VARS (program); \ if (SCM_I_IS_VECTOR (c)) \ { \ closure = SCM_I_VECTOR_WELTS (c); \ @@ -185,14 +181,6 @@ * Error check */ -#undef CHECK_EXTERNAL -#if VM_CHECK_EXTERNAL -#define CHECK_EXTERNAL(e) \ - do { if (SCM_UNLIKELY (!SCM_CONSP (e))) goto vm_error_external; } while (0) -#else -#define CHECK_EXTERNAL(e) -#endif - /* Accesses to a program's object table. */ #if VM_CHECK_OBJECT #define CHECK_OBJECT(_num) \ @@ -406,7 +394,7 @@ do { \ /* New registers */ \ fp = sp - bp->nargs + 1; \ data = SCM_FRAME_DATA_ADDRESS (fp); \ - sp = data + 3; \ + sp = data + 2; \ CHECK_OVERFLOW (); \ stack_base = sp; \ ip = bp->base; \ @@ -416,23 +404,11 @@ do { \ data[-i] = SCM_UNDEFINED; \ \ /* Set frame data */ \ - data[3] = (SCM)ra; \ - data[2] = 0x0; \ - data[1] = (SCM)dl; \ - \ - /* Postpone initializing external vars, \ - because if the CONS causes a GC, we \ - want the stack marker to see the data \ - array formatted as expected. */ \ - data[0] = SCM_UNDEFINED; \ - external = SCM_PROGRAM_EXTERNALS (fp[-1]); \ - for (i = 0; i < bp->nexts; i++) \ - CONS (external, SCM_UNDEFINED, external); \ - data[0] = external; \ + data[2] = (SCM)ra; \ + data[1] = 0x0; \ + data[0] = (SCM)dl; \ } -#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs] - /* Local Variables: c-file-style: "gnu" diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c index 4edadb37f..9ae49ed65 100644 --- a/libguile/vm-i-loader.c +++ b/libguile/vm-i-loader.c @@ -114,7 +114,7 @@ VM_DEFINE_LOADER (86, load_program, "load-program") objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip); len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode); - PUSH (scm_make_program (objcode, objs, SCM_EOL)); + PUSH (scm_make_program (objcode, objs, SCM_BOOL_F)); ip += len; diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 5e850a1a6..a7e05c83b 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -278,21 +278,6 @@ VM_DEFINE_INSTRUCTION (25, local_ref, "local-ref", 1, 0, 1) NEXT; } -VM_DEFINE_INSTRUCTION (26, external_ref, "external-ref", 1, 0, 1) -{ - unsigned int i; - SCM e = external; - for (i = FETCH (); i; i--) - { - CHECK_EXTERNAL(e); - e = SCM_CDR (e); - } - CHECK_EXTERNAL(e); - PUSH (SCM_CAR (e)); - ASSERT_BOUND (*sp); - NEXT; -} - VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 0, 1) { SCM x = *sp; @@ -369,21 +354,6 @@ VM_DEFINE_INSTRUCTION (30, local_set, "local-set", 1, 1, 0) NEXT; } -VM_DEFINE_INSTRUCTION (31, external_set, "external-set", 1, 1, 0) -{ - unsigned int i; - SCM e = external; - for (i = FETCH (); i; i--) - { - CHECK_EXTERNAL(e); - e = SCM_CDR (e); - } - CHECK_EXTERNAL(e); - SCM_SETCAR (e, *sp); - DROP (); - NEXT; -} - VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 1, 0) { VARIABLE_SET (sp[0], sp[-1]); @@ -500,14 +470,6 @@ VM_DEFINE_INSTRUCTION (41, br_if_not_null, "br-if-not-null", 2, 0, 0) * Subprogram call */ -VM_DEFINE_INSTRUCTION (42, make_closure, "make-closure", 0, 1, 1) -{ - SYNC_BEFORE_GC (); - SCM_NEWSMOB3 (*sp, scm_tc16_program, SCM_PROGRAM_OBJCODE (*sp), - SCM_PROGRAM_OBJTABLE (*sp), external); - NEXT; -} - VM_DEFINE_INSTRUCTION (43, call, "call", 1, -1, 1) { SCM x; @@ -656,12 +618,6 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1) sp -= 2; NULLSTACK (bp->nargs + 1); - /* Freshen the externals */ - external = SCM_PROGRAM_EXTERNALS (x); - for (i = 0; i < bp->nexts; i++) - CONS (external, SCM_UNDEFINED, external); - SCM_FRAME_DATA_ADDRESS (fp)[0] = external; - /* Init locals to valid SCM values */ for (i = 0; i < bp->nlocs; i++) LOCAL_SET (i + bp->nargs, SCM_UNDEFINED); @@ -710,7 +666,7 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1) sure we have space for the locals now */ data = SCM_FRAME_DATA_ADDRESS (fp); ip = bp->base; - stack_base = data + 3; + stack_base = data + 2; sp = stack_base; CHECK_OVERFLOW (); @@ -725,17 +681,9 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1) data[-i] = SCM_UNDEFINED; /* Set frame data */ - data[3] = (SCM)ra; - data[2] = (SCM)mvra; - data[1] = (SCM)dl; - - /* Postpone initializing external vars, because if the CONS causes a GC, - we want the stack marker to see the data array formatted as expected. */ - data[0] = SCM_UNDEFINED; - external = SCM_PROGRAM_EXTERNALS (fp[-1]); - for (i = 0; i < bp->nexts; i++) - CONS (external, SCM_UNDEFINED, external); - data[0] = external; + data[2] = (SCM)ra; + data[1] = (SCM)mvra; + data[0] = (SCM)dl; ENTER_HOOK (); APPLY_HOOK (); @@ -860,7 +808,7 @@ VM_DEFINE_INSTRUCTION (47, mv_call, "mv-call", 3, -1, 1) CACHE_PROGRAM (); INIT_ARGS (); NEW_FRAME (); - SCM_FRAME_DATA_ADDRESS (fp)[2] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset); + SCM_FRAME_DATA_ADDRESS (fp)[1] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset); ENTER_HOOK (); APPLY_HOOK (); NEXT; @@ -1019,12 +967,12 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1) POP (ret); ASSERT (sp == stack_base); - ASSERT (stack_base == data + 3); + ASSERT (stack_base == data + 2); /* Restore registers */ sp = SCM_FRAME_LOWER_ADDRESS (fp); - ip = SCM_FRAME_BYTE_CAST (data[3]); - fp = SCM_FRAME_STACK_CAST (data[1]); + ip = SCM_FRAME_BYTE_CAST (data[2]); + fp = SCM_FRAME_STACK_CAST (data[0]); { #ifdef VM_ENABLE_STACK_NULLING int nullcount = stack_base - sp; @@ -1040,7 +988,6 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1) /* Restore the last program */ program = SCM_FRAME_PROGRAM (fp); CACHE_PROGRAM (); - CACHE_EXTERNAL (); CHECK_IP (); NEXT; } @@ -1057,16 +1004,16 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1) RETURN_HOOK (); data = SCM_FRAME_DATA_ADDRESS (fp); - ASSERT (stack_base == data + 3); + ASSERT (stack_base == data + 2); - /* data[2] is the mv return address */ - if (nvalues != 1 && data[2]) + /* data[1] is the mv return address */ + if (nvalues != 1 && data[1]) { int i; /* Restore registers */ sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; - ip = SCM_FRAME_BYTE_CAST (data[2]); /* multiple value ra */ - fp = SCM_FRAME_STACK_CAST (data[1]); + ip = SCM_FRAME_BYTE_CAST (data[1]); /* multiple value ra */ + fp = SCM_FRAME_STACK_CAST (data[0]); /* Push return values, and the number of values */ for (i = 0; i < nvalues; i++) @@ -1085,8 +1032,8 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1) continuation.) */ /* Restore registers */ sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; - ip = SCM_FRAME_BYTE_CAST (data[3]); /* single value ra */ - fp = SCM_FRAME_STACK_CAST (data[1]); + ip = SCM_FRAME_BYTE_CAST (data[2]); /* single value ra */ + fp = SCM_FRAME_STACK_CAST (data[0]); /* Push first value */ *++sp = stack_base[1]; @@ -1101,7 +1048,6 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1) /* Restore the last program */ program = SCM_FRAME_PROGRAM (fp); CACHE_PROGRAM (); - CACHE_EXTERNAL (); CHECK_IP (); NEXT; } diff --git a/libguile/vm.c b/libguile/vm.c index f753ea251..957baf6fe 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -259,7 +259,7 @@ really_make_boot_program (long nargs) u8vec = make_u8vector (bytes.bytes, sizeof (bytes.bytes)); ret = scm_make_program (scm_bytecode_to_objcode (u8vec), - SCM_BOOL_F, SCM_EOL); + SCM_BOOL_F, SCM_BOOL_F); SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT); return ret; @@ -663,7 +663,7 @@ SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0, SCM scm_load_compiled_with_vm (SCM file) { SCM program = scm_make_program (scm_load_objcode (file), - SCM_BOOL_F, SCM_EOL); + SCM_BOOL_F, SCM_BOOL_F); return scm_c_vm_run (scm_the_vm (), program, NULL, 0); } diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm index 76c1cbcb9..a783a4e5e 100644 --- a/module/language/objcode/spec.scm +++ b/module/language/objcode/spec.scm @@ -1,6 +1,6 @@ ;;; Guile Lowlevel Intermediate Language -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -31,7 +31,7 @@ (if env (car env) (current-module))) (define (objcode-env-externals env) - (if env (cdr env) '())) + (and env (vector? (cdr env)) (cdr env))) (define (objcode->value x e opts) (let ((thunk (make-program x #f (objcode-env-externals e)))) diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm index 9db4a754b..99021ed05 100644 --- a/module/system/vm/program.scm +++ b/module/system/vm/program.scm @@ -1,6 +1,6 @@ ;;; Guile VM program functions -;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -31,16 +31,15 @@ program-properties program-property program-documentation program-name program-arguments - program-arity program-external-set! program-meta + program-arity program-meta program-objcode program? program-objects - program-module program-base program-external)) + program-module program-base program-free-vars)) (load-extension "libguile" "scm_init_programs") (define arity:nargs car) (define arity:nrest cadr) (define arity:nlocs caddr) -(define arity:nexts cadddr) (define (make-binding name extp index start end) (list name extp index start end)) |