From b10af70a0b4b725866510fb60db92c272c8801ed Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 31 Aug 2008 07:28:05 +0000 Subject: [PATCH] Implement new mechanism to simplify initialization during cold load. --- v7/src/runtime/boot.scm | 27 +++++++++++++++++++++++++-- v7/src/runtime/make.scm | 13 +++++++++---- v7/src/runtime/mit-syntax.scm | 34 +++++++++++++++++++++------------- v7/src/runtime/sysmac.scm | 16 ++++++++++++++-- 4 files changed, 69 insertions(+), 21 deletions(-) diff --git a/v7/src/runtime/boot.scm b/v7/src/runtime/boot.scm index a179e2062..d9b82d456 100644 --- a/v7/src/runtime/boot.scm +++ b/v7/src/runtime/boot.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: boot.scm,v 14.30 2008/02/10 06:14:03 cph Exp $ +$Id: boot.scm,v 14.31 2008/08/31 07:27:00 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -142,4 +142,27 @@ USA. (eq? object (default-object))) (define-integrable (default-object) - ((ucode-primitive object-set-type) (ucode-type constant) 7)) \ No newline at end of file + ((ucode-primitive object-set-type) (ucode-type constant) 7)) + +(define (init-boot-inits!) + (set! boot-inits '()) + unspecific) + +(define (add-boot-init! thunk) + (set! boot-inits (cons thunk boot-inits)) + unspecific) + +(define (save-boot-inits! environment) + (let ((inits (reverse! boot-inits))) + (set! boot-inits) + ((ucode-primitive local-assignment) environment saved-boot-inits inits))) + +(define (run-boot-inits! environment) + (let ((inits + ((ucode-primitive lexical-reference) environment saved-boot-inits))) + ((ucode-primitive unbind-variable) environment saved-boot-inits) + (for-each (lambda (init) (init)) + inits))) + +(define boot-inits) +(define saved-boot-inits '|#[saved-boot-inits]|) \ No newline at end of file diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm index 95f054d7a..6005b006e 100644 --- a/v7/src/runtime/make.scm +++ b/v7/src/runtime/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: make.scm,v 14.117 2008/08/24 07:20:09 cph Exp $ +$Id: make.scm,v 14.118 2008/08/31 07:28:05 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -401,14 +401,19 @@ USA. (let loop ((files files)) (and (pair? files) (or (string=? (car (car files)) filename) - (loop (cdr files)))))))) + (loop (cdr files))))))) + (boot-defs + (package/environment (name->package '(RUNTIME BOOT-DEFINITIONS))))) (lambda (filename environment) (if (not (or (string=? filename "make") (string=? filename "packag") (file-member? filename files1) (file-member? filename files2))) - (eval (file->object filename #t #t) - environment)) + (begin + ((access init-boot-inits! boot-defs)) + (eval (file->object filename #t #t) + environment) + ((access save-boot-inits! boot-defs) environment))) unspecific)))) ;;; Funny stuff is done. Rest of sequence is standardized. diff --git a/v7/src/runtime/mit-syntax.scm b/v7/src/runtime/mit-syntax.scm index 00a7f72b2..9326ddc8b 100644 --- a/v7/src/runtime/mit-syntax.scm +++ b/v7/src/runtime/mit-syntax.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: mit-syntax.scm,v 14.32 2008/01/30 20:02:32 cph Exp $ +$Id: mit-syntax.scm,v 14.33 2008/08/31 07:27:34 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -225,18 +225,26 @@ USA. variable-binding-theory))))) (lambda (form rename compare) compare ;ignore - (cond ((syntax-match? '((IDENTIFIER . MIT-BVL) + FORM) (cdr form)) - `(,(car form) ,(caadr form) - (,(rename 'NAMED-LAMBDA) ,@(cdr form)))) - ((syntax-match? '((DATUM . MIT-BVL) + FORM) (cdr form)) - `(,(car form) ,(caadr form) - (,(rename 'LAMBDA) ,(cdadr form) ,@(cddr form)))) - ((syntax-match? '(IDENTIFIER) (cdr form)) - `(,keyword ,(cadr form) ,(unassigned-expression))) - ((syntax-match? '(IDENTIFIER EXPRESSION) (cdr form)) - `(,keyword ,(cadr form) ,(caddr form))) - (else - (ill-formed-syntax form)))))) + (receive (name value) (parse-define-form form rename) + `(,keyword ,name ,value))))) + +(define (parse-define-form form rename) + (cond ((syntax-match? '((IDENTIFIER . MIT-BVL) + FORM) (cdr form)) + (parse-define-form + `(,(car form) ,(caadr form) + (,(rename 'NAMED-LAMBDA) ,@(cdr form))) + rename)) + ((syntax-match? '((DATUM . MIT-BVL) + FORM) (cdr form)) + (parse-define-form + `(,(car form) ,(caadr form) + (,(rename 'LAMBDA) ,(cdadr form) ,@(cddr form))) + rename)) + ((syntax-match? '(IDENTIFIER) (cdr form)) + (values (cadr form) (unassigned-expression))) + ((syntax-match? '(IDENTIFIER EXPRESSION) (cdr form)) + (values (cadr form) (caddr form))) + (else + (ill-formed-syntax form)))) (define-classifier 'DEFINE-SYNTAX system-global-environment (lambda (form environment definition-environment history) diff --git a/v7/src/runtime/sysmac.scm b/v7/src/runtime/sysmac.scm index 0d825b154..9e4baf073 100644 --- a/v7/src/runtime/sysmac.scm +++ b/v7/src/runtime/sysmac.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: sysmac.scm,v 14.19 2008/02/14 02:35:05 cph Exp $ +$Id: sysmac.scm,v 14.20 2008/08/31 07:27:37 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -94,4 +94,16 @@ USA. (IF (DEFAULT-OBJECT? CALLER) #F CALLER)))))) - (ill-formed-syntax form))))) \ No newline at end of file + (ill-formed-syntax form))))) + +(define-syntax define-deferred + (er-macro-transformer + (lambda (form rename compare) + compare + (receive (name value) (parse-define-form form rename) + `(,(rename 'BEGIN) + (,(rename 'DEFINE) ,name) + (,(rename 'ADD-BOOT-INIT!) + (,(rename 'LAMBDA) () + (,(rename 'SET!) ,name ,value) + ,(rename 'UNSPECIFIC)))))))) \ No newline at end of file -- 2.25.1