summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-01 10:50:45 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-01 10:50:45 +0100
commitac47d5f6399c54bcb39a01bb0ade83a614d625b4 (patch)
tree218be79c6771477492f78ffdaebec67a6f43afec
parent1f1ec13b5c459717b22030565e591f1f713ee39d (diff)
downloadguile-ac47d5f6399c54bcb39a01bb0ade83a614d625b4.tar.gz
avoid 8 words of allocation per lambda, whoooo
* libguile/objcodes.c (scm_bytecode_to_objcode): Check that the length of the vector matches the length embedded in the bytecode. * libguile/programs.c (scm_program_meta): Call through to scm_objcode_meta, instead of looking in the object table. Avoids consing up a program+objcode slice for the meta until the meta is actually called. * libguile/vm-i-loader.c (load-program): Step past the metadata too. * module/language/glil/compile-assembly.scm (make-meta): Just return the load-program form, or #f. (assoc-ref-or-acons, object-index-and-alist, make-object-table): Don't write the meta into the object table. (glil->assembly): Instead write the meta into the load-program form.
-rw-r--r--libguile/objcodes.c9
-rw-r--r--libguile/programs.c11
-rw-r--r--libguile/vm-i-loader.c2
-rw-r--r--module/language/glil/compile-assembly.scm36
4 files changed, 29 insertions, 29 deletions
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index eb40213e9..7dba0e00b 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -190,14 +190,17 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0,
data = (struct scm_objcode*)c_bytecode;
SCM_NEWSMOB2 (objcode, scm_tc16_objcode, data, bytecode);
scm_array_handle_release (&handle);
+
+ SCM_ASSERT_RANGE (0, bytecode, size >= sizeof(struct scm_objcode));
+ if (data->len + data->metalen != (size - sizeof (*data)))
+ scm_misc_error (FUNC_NAME, "bad u8vector size (~a != ~a)",
+ SCM_LIST2 (scm_from_size_t (size),
+ scm_from_uint32 (sizeof (*data) + data->len + data->metalen)));
assert (increment == 1);
- SCM_ASSERT_RANGE (0, bytecode, size < 1<<31);
- SCM_ASSERT_RANGE (0, bytecode, size >= sizeof(*data));
SCM_SET_SMOB_FLAGS (objcode, SCM_F_OBJCODE_IS_U8VECTOR);
/* foolishly, we assume that as long as bytecode is around, that c_bytecode
will be of the same length; perhaps a bad assumption? */
- /* FIXME: check length of bytecode */
return objcode;
}
diff --git a/libguile/programs.c b/libguile/programs.c
index e9c093a2e..b6dd7c2a6 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -178,10 +178,15 @@ SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
"")
#define FUNC_NAME s_scm_program_meta
{
- SCM objs;
+ SCM metaobj;
+
SCM_VALIDATE_PROGRAM (1, program);
- objs = SCM_PROGRAM_OBJTABLE (program);
- return scm_is_true (objs) ? scm_c_vector_ref (objs, 1) : SCM_BOOL_F;
+
+ metaobj = scm_objcode_meta (SCM_PROGRAM_OBJCODE (program));
+ if (scm_is_true (metaobj))
+ return scm_make_program (metaobj, SCM_BOOL_F, SCM_EOL);
+ else
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 2919638bc..5b086808b 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -92,7 +92,7 @@ VM_DEFINE_LOADER (65, load_program, "load-program")
scm_c_vector_set_x (objs, 0, scm_current_module ());
objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip);
- len = sizeof (struct scm_objcode) + SCM_OBJCODE_LEN (objcode);
+ len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
PUSH (scm_make_program (objcode, objs, SCM_EOL));
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 88bb1897b..d33210159 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -44,21 +44,14 @@
(define-record <subprogram> code)
-;; A metadata thunk has no object table, so it is very quick to load.
(define (make-meta bindings sources tail)
(if (and (null? bindings) (null? sources) (null? tail))
#f
- (make-subprogram
- ;; we need to prepend #f for the object table. This would have
- ;; even less overhead if we just appended the metadata-generating
- ;; instructions after the body of the program's code. A FIXME for
- ;; the future, eh.
- `((make-false)
- ,(compile-assembly
- (make-glil-program 0 0 0 0 '()
- (list
- (make-glil-const `(,bindings ,sources ,@tail))
- (make-glil-call 'return 0))))))))
+ (compile-assembly
+ (make-glil-program 0 0 0 0 '()
+ (list
+ (make-glil-const `(,bindings ,sources ,@tail))
+ (make-glil-call 'return 0))))))
;; A functional stack of names of live variables.
(define (make-open-binding name ext? index)
@@ -98,7 +91,7 @@
(close-all-bindings (close-binding bindings end) end)))
;; A functional object table.
-(define *module-and-meta* 2)
+(define *module* 1)
(define (assoc-ref-or-acons alist x make-y)
(cond ((assoc-ref alist x)
=> (lambda (y) (values y alist)))
@@ -108,15 +101,15 @@
(define (object-index-and-alist x alist)
(assoc-ref-or-acons alist x
(lambda (x alist)
- (+ (length alist) *module-and-meta*))))
+ (+ (length alist) *module*))))
(define (compile-assembly glil)
(receive (code . _)
(glil->assembly glil 0 '() '(()) '() '() #f 0)
(car code)))
-(define (make-object-table objects meta)
- (and (or meta (not (null? objects)))
- (list->vector (cons* #f meta objects))))
+(define (make-object-table objects)
+ (and (not (null? objects))
+ (list->vector (cons #f objects))))
(define (glil->assembly glil nargs nexts-stack bindings
source-alist label-alist object-alist addr)
@@ -151,7 +144,9 @@
(receive (code bindings sources labels objects len)
(process-body)
(let ((prog `(load-program ,nargs ,nrest ,nlocs ,nexts ,labels
- ,len #f . ,code)))
+ ,len
+ ,(make-meta bindings sources meta)
+ . ,code)))
(cond
(toplevel?
;; toplevel bytecode isn't loaded by the vm, no way to do
@@ -159,10 +154,7 @@
;; anyway)
(emit-code `(,prog)))
(else
- (let ((table (dump-object (make-object-table
- objects
- (make-meta bindings sources meta))
- addr))
+ (let ((table (dump-object (make-object-table objects) addr))
(closure (if (> closure-level 0) '((make-closure)) '())))
(cond
(object-alist