mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +02:00
Code Activity

lazily load meta info, for less consage

Browse source 
* module/system/vm/assemble.scm (make-meta, codegen): Hide the "meta"
  information -- the names of the bindings, source info, procedure
  properties, etc -- behind a lambda. This way, loading up a program
  conses less, because the metadata stays as mmap'd code until it is
  needed.

* libguile/vm-i-loader.c (load-program): Adjust load-program to expect
  the metadata to be a program.

* module/system/vm/program.scm (program-bindings, program-sources)
  (program-properties): Adjust to new meta format.
This commit is contained in:
Andy Wingo 2008-09-08 01:03:34 +02:00
parent 7063452276
commit 13906f976e
3 changed files with 33 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/vm-i-loader.c
View file

@ -118,7 +118,7 @@ VM_DEFINE_LOADER (load_program, "load-program")
POP (x);
/* init meta data */
if (SCM_CONSP (x))
if (SCM_PROGRAM_P (x))
{
p->meta = x;
POP (x);

34
module/system/vm/assemble.scm
View file

@ -71,6 +71,25 @@
;;; Stage 2: Bytecode generation
;;;
(define-macro (push x loc)
`(set! ,loc (cons ,x ,loc)))
;; this is to avoid glil-const's desire to put constants in the object
;; array -- instead we explicitly want them in the code, because meta
;; info is infrequently used. to load it up always would make garbage,
;; needlessly. so hide it behind a lambda.
(define (make-meta bindings sources tail)
(if (and (null? bindings) (null? sources) (null? tail))
#f
(let ((stack '()))
(define (push-code! code)
(push (code->bytes code) stack))
(dump-object! push-code! `(,bindings ,sources ,@tail))
(push-code! '(return))
(make-bytespec :vars (make-glil-vars 0 0 0 0)
:bytes (stack->bytes (reverse! stack) '())
:meta #f :objs #f :closure? #f))))
(define (codegen glil toplevel)
(record-case glil
((<vm-asm> venv glil body) (record-case glil ((<glil-asm> vars meta) ; body?
@ -81,10 +100,11 @@
(object-alist '()))
(define (push-code! code)
; (format #t "push-code! ~a~%" code)
(set! stack (cons (code->bytes code) stack)))
(push (code->bytes code) stack))
(define (push-object! x)
(cond ((object->code x) => push-code!)
(toplevel (dump-object! push-code! x))
(toplevel
(dump-object! push-code! x))
(else
(let ((i (cond ((object-assoc x object-alist) => cdr)
(else
@ -175,7 +195,7 @@
(set! label-alist (assq-set! label-alist label (current-address))))
((<glil-branch> inst label)
(set! stack (cons (list inst label) stack)))
(push (list inst label) stack))
((<glil-call> inst nargs)
(if (instruction? inst)
@ -195,13 +215,9 @@
(if toplevel
(bytecode->objcode bytes (glil-vars-nlocs vars) (glil-vars-nexts vars))
(make-bytespec :vars vars :bytes bytes
:meta (if (and (null? binding-alist)
(null? source-alist)
(null? meta))
#f
(cons* (reverse! binding-alist)
:meta (make-meta (reverse! binding-alist)
(reverse! source-alist)
meta))
meta)
:objs (let ((objs (map car (reverse! object-alist))))
(if (null? objs) #f (list->vector objs)))
:closure? (venv-closure? venv))))))))))

9
module/system/vm/program.scm
View file

@ -44,8 +44,11 @@
(define binding:extp cadr)
(define binding:index caddr)
(define (curry1 proc)
(lambda (x) (proc (x))))
(define (program-bindings prog)
(cond ((program-meta prog) => car)
(cond ((program-meta prog) => (curry1 car))
(else '())))
(define (source:addr source)
@ -58,11 +61,11 @@
(vector-ref (cdr source) 2))
(define (program-sources prog)
(cond ((program-meta prog) => cadr)
(cond ((program-meta prog) => (curry1 cadr))
(else '())))
(define (program-properties prog)
(or (and=> (program-meta prog) cddr)
(or (and=> (program-meta prog) (curry1 cddr))
'()))
(define (program-property prog prop)