* base-rtd is now placed in the pcb.

* renamed:
    src/library-manager.ss => src/ikarus.library-manager.ss
This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 22:42:26 -04:00
parent 57a20bdfb4
commit 48e062dfc4
7 changed files with 50 additions and 42 deletions

Binary file not shown.

View File

@ -348,6 +348,7 @@ ik_collect(int mem_req, ikpcb* pcb){
pcb->symbol_table = add_object(&gc, pcb->symbol_table, "symbol_table"); pcb->symbol_table = add_object(&gc, pcb->symbol_table, "symbol_table");
pcb->gensym_table = add_object(&gc, pcb->gensym_table, "gensym_table"); pcb->gensym_table = add_object(&gc, pcb->gensym_table, "gensym_table");
pcb->arg_list = add_object(&gc, pcb->arg_list, "args_list_foo"); pcb->arg_list = add_object(&gc, pcb->arg_list, "args_list_foo");
pcb->base_rtd = add_object(&gc, pcb->base_rtd, "base_rtd");
/* now we trace all live objects */ /* now we trace all live objects */
collect_loop(&gc); collect_loop(&gc);

View File

@ -337,6 +337,7 @@ ikpcb* ik_make_pcb(){
ref(r, off_rtd_symbol) = 0; ref(r, off_rtd_symbol) = 0;
ref(s, off_symbol_system_value) = r; ref(s, off_symbol_system_value) = r;
ref(s, off_symbol_value) = r; ref(s, off_symbol_value) = r;
pcb->base_rtd = r;
} }
return pcb; return pcb;
} }

View File

@ -116,6 +116,7 @@ typedef struct ikpcb{
ikp arg_list; /* offset = 32 */ ikp arg_list; /* offset = 32 */
int engine_counter; /* offset = 36 */ int engine_counter; /* offset = 36 */
int interrupted; /* offset = 40 */ int interrupted; /* offset = 40 */
ikp base_rtd; /* offset = 44 */
/* the rest are not used by any scheme code */ /* the rest are not used by any scheme code */
/* they only support the runtime system (gc, etc.) */ /* they only support the runtime system (gc, etc.) */
unsigned int* segment_vector; unsigned int* segment_vector;

Binary file not shown.

View File

@ -14,8 +14,17 @@
(library (ikarus library-manager) (library (ikarus library-manager)
(export) (export imported-label->binding library-subst/env
(import (scheme)) current-library-collection
installed-libraries
find-library-by-name imported-loc->library install-library
library-spec invoke-library)
(import (except (ikarus) imported-label->binding library-subst/env
current-library-collection
installed-libraries
find-library-by-name imported-loc->library install-library
library-spec invoke-library))
(define (make-collection) (define (make-collection)
@ -28,7 +37,7 @@
[() set] [() set]
[(x) (set! set (set-cons x set))]))) [(x) (set! set (set-cons x set))])))
(define lm:current-library-collection (define current-library-collection
(make-parameter (make-collection) (make-parameter (make-collection)
(lambda (x) (lambda (x)
(unless (procedure? x) (unless (procedure? x)
@ -45,18 +54,18 @@
[else (error 'find-dependencies "cannot handle deps yet")])) [else (error 'find-dependencies "cannot handle deps yet")]))
(define (find-library-by pred) (define (find-library-by pred)
(let f ([ls ((lm:current-library-collection))]) (let f ([ls ((current-library-collection))])
(cond (cond
[(null? ls) #f] [(null? ls) #f]
[(pred (car ls)) (car ls)] [(pred (car ls)) (car ls)]
[else (f (cdr ls))]))) [else (f (cdr ls))])))
(define (lm:find-library-by-name name) (define (find-library-by-name name)
(find-library-by (find-library-by
(lambda (x) (equal? (library-name x) name)))) (lambda (x) (equal? (library-name x) name))))
(define (find-library-by-name/die name) (define (find-library-by-name/die name)
(or (lm:find-library-by-name name) (or (find-library-by-name name)
(error #f "cannot find library ~s" name))) (error #f "cannot find library ~s" name)))
(define (find-library-by-spec/die spec) (define (find-library-by-spec/die spec)
@ -65,18 +74,18 @@
(lambda (x) (eq? id (library-id x)))) (lambda (x) (eq? id (library-id x))))
(error #f "cannot find library with spec ~s" spec)))) (error #f "cannot find library with spec ~s" spec))))
(define (lm:install-library id name ver (define (install-library id name ver
imp* vis* inv* exp-subst exp-env visit-code invoke-code) imp* vis* inv* exp-subst exp-env visit-code invoke-code)
(let ([imp-lib* (map find-library-by-spec/die imp*)] (let ([imp-lib* (map find-library-by-spec/die imp*)]
[vis-lib* (map find-library-by-spec/die vis*)] [vis-lib* (map find-library-by-spec/die vis*)]
[inv-lib* (map find-library-by-spec/die inv*)]) [inv-lib* (map find-library-by-spec/die inv*)])
(unless (and (symbol? id) (list? name) (list? ver)) (unless (and (symbol? id) (list? name) (list? ver))
(error 'install-library "invalid spec ~s ~s ~s" id name ver)) (error 'install-library "invalid spec ~s ~s ~s" id name ver))
(when (lm:find-library-by-name name) (when (find-library-by-name name)
(error 'install-library "~s is already installed" name)) (error 'install-library "~s is already installed" name))
(let ([lib (make-library id name ver imp-lib* vis-lib* inv-lib* (let ([lib (make-library id name ver imp-lib* vis-lib* inv-lib*
exp-subst exp-env visit-code invoke-code)]) exp-subst exp-env visit-code invoke-code)])
((lm:current-library-collection) lib)))) ((current-library-collection) lib))))
(define scheme-env ; the-env (define scheme-env ; the-env
'([define define-label (define)] '([define define-label (define)]
@ -523,14 +532,14 @@
[current-library-collection current-library-collection-label (core-prim . current-library-collection)] [current-library-collection current-library-collection-label (core-prim . current-library-collection)]
[invoke-library invoke-library-label (core-prim . invoke-library)] [invoke-library invoke-library-label (core-prim . invoke-library)]
)) ))
(define (lm:imported-label->binding lab) (define (imported-label->binding lab)
(let f ([ls ((lm:current-library-collection))]) (let f ([ls ((current-library-collection))])
(cond (cond
[(null? ls) #f] [(null? ls) #f]
[(assq lab (library-env (car ls))) => cdr] [(assq lab (library-env (car ls))) => cdr]
[else (f (cdr ls))]))) [else (f (cdr ls))])))
(define (lm:imported-loc->library loc) (define (imported-loc->library loc)
(define (loc-in-env? ls) (define (loc-in-env? ls)
(and (pair? ls) (and (pair? ls)
(let ([a (car ls)]) (let ([a (car ls)])
@ -538,56 +547,52 @@
(or (and (eq? (car binding) 'global) (or (and (eq? (car binding) 'global)
(eq? (cdr binding) loc)) (eq? (cdr binding) loc))
(loc-in-env? (cdr ls))))))) (loc-in-env? (cdr ls)))))))
(let f ([ls ((lm:current-library-collection))]) (let f ([ls ((current-library-collection))])
(cond (cond
[(null? ls) #f] [(null? ls) #f]
[(loc-in-env? (library-env (car ls))) (car ls)] [(loc-in-env? (library-env (car ls))) (car ls)]
[else (f (cdr ls))]))) [else (f (cdr ls))])))
(define (lm:invoke-library lib) (define (invoke-library lib)
(let ([invoke (library-invoke-state lib)]) (let ([invoke (library-invoke-state lib)])
(when (procedure? invoke) (when (procedure? invoke)
(set-library-invoke-state! lib (set-library-invoke-state! lib
(lambda () (error 'invoke "circularity detected for ~s" lib))) (lambda () (error 'invoke "circularity detected for ~s" lib)))
(for-each lm:invoke-library (library-inv* lib)) (for-each invoke-library (library-inv* lib))
(set-library-invoke-state! lib (set-library-invoke-state! lib
(lambda () (error 'invoke "first invoke did not return for ~s" lib))) (lambda () (error 'invoke "first invoke did not return for ~s" lib)))
(invoke) (invoke)
(set-library-invoke-state! lib #t)))) (set-library-invoke-state! lib #t))))
(define (lm:invoke-library-by-spec spec) (define (invoke-library-by-spec spec)
(lm:invoke-library (find-library-by-spec/die spec))) (invoke-library (find-library-by-spec/die spec)))
(define installed-libraries
(lambda () ((current-library-collection))))
(define library-subst/env
(lambda (x)
(unless (library? x)
(error 'library-subst/env "~s is not a library" x))
(values (library-subst x) (library-env x))))
(define library-spec
(lambda (x)
(unless (library? x)
(error 'library-spec "~s is not a library" x))
(list (library-id x) (library-name x) (library-ver x))))
;;; init ;;; init
(let ([subst (let ([subst
(map (lambda (x) (cons (car x) (cadr x))) scheme-env)] (map (lambda (x) (cons (car x) (cadr x))) scheme-env)]
[env [env
(map (lambda (x) (cons (cadr x) (caddr x))) scheme-env)]) (map (lambda (x) (cons (cadr x) (caddr x))) scheme-env)])
(lm:install-library 'scheme-id ;;; id (install-library 'scheme-id ;;; id
'(scheme) ;;; name '(scheme) ;;; name
'() ;;; version '() ;;; version
'() '() '() ;;; req '() '() '() ;;; req
subst env subst env
void void)) void void))
(primitive-set! 'installed-libraries
(lambda () ((lm:current-library-collection))))
(primitive-set! 'library-subst/env
(lambda (x)
(unless (library? x)
(error 'library-subst/env "~s is not a library" x))
(values (library-subst x) (library-env x))))
(primitive-set! 'library-spec
(lambda (x)
(unless (library? x)
(error 'library-spec "~s is not a library" x))
(list (library-id x) (library-name x) (library-ver x))))
(primitive-set! 'find-library-by-name lm:find-library-by-name)
(primitive-set! 'imported-label->binding lm:imported-label->binding)
(primitive-set! 'imported-loc->library lm:imported-loc->library)
(primitive-set! 'invoke-library lm:invoke-library)
(primitive-set! 'current-library-collection lm:current-library-collection)
(primitive-set! 'install-library lm:install-library)
((record-field-mutator (record-type-descriptor (type-descriptor library)) 'printer) ((record-field-mutator (record-type-descriptor (type-descriptor library)) 'printer)
(type-descriptor library) (type-descriptor library)
(lambda (x p) (lambda (x p)

View File

@ -59,7 +59,7 @@
"ikarus.cafe.ss" "ikarus.cafe.ss"
"ikarus.posix.ss" "ikarus.posix.ss"
"ikarus.timer.ss" "ikarus.timer.ss"
"library-manager.ss" "ikarus.library-manager.ss"
"libtoplevel.ss")) "libtoplevel.ss"))
(define ikarus-system-macros (define ikarus-system-macros