From: Guillermo J. Rozas Date: Mon, 15 Apr 1991 20:48:03 +0000 (+0000) Subject: Add hook/extended-scode-eval so that expressions can be integrated or X-Git-Tag: 20090517-FFI~10747 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c0414be02ed61d0c74c970c8831ad94c1872e201;p=mit-scheme.git Add hook/extended-scode-eval so that expressions can be integrated or compiled before they are evaluated. Change compiled-code-block/dbg-info to correctly handle compiled code blocks whose debugging slot holds a dbg-info structure. --- diff --git a/v7/src/runtime/infutl.scm b/v7/src/runtime/infutl.scm index a0305baae..3544618aa 100644 --- a/v7/src/runtime/infutl.scm +++ b/v7/src/runtime/infutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.20 1991/02/15 18:05:49 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.21 1991/04/15 20:47:29 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -51,12 +51,16 @@ MIT in each case. |# (define (compiled-code-block/dbg-info block demand-load?) (let ((old-info (compiled-code-block/debugging-info block))) - (if (and (pair? old-info) (dbg-info? (car old-info))) - (car old-info) - (and demand-load? - (let ((dbg-info (read-debugging-info old-info))) - (if dbg-info (memoize-debugging-info! block dbg-info)) - dbg-info))))) + (cond ((dbg-info? old-info) + old-info) + ((and (pair? old-info) (dbg-info? (car old-info))) + (car old-info)) + (demand-load? + (let ((dbg-info (read-debugging-info old-info))) + (if dbg-info (memoize-debugging-info! block dbg-info)) + dbg-info)) + (else + false)))) (define (discard-debugging-info!) (without-interrupts diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index 5d3d058f0..301dacde2 100644 --- a/v7/src/runtime/load.scm +++ b/v7/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.20 1991/02/15 18:06:13 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.21 1991/04/15 20:47:37 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -221,7 +221,7 @@ MIT in each case. |# (= 250 (char->ascii fasl-marker))) (begin (close-input-port port) - (scode-eval + (extended-scode-eval (let ((scode (fasload/internal true-pathname load/suppress-loading-message?))) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index c5f1a9e2c..9d3409f8d 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.100 1991/04/11 03:24:25 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.101 1991/04/15 20:47:45 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -638,7 +638,8 @@ MIT in each case. |# (files "xeval") (parent ()) (export () - extended-scode-eval) + extended-scode-eval + hook/extended-scode-eval) (initialization (initialize-package!))) (define-package (runtime file-input) diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm index 829347231..f773a859f 100644 --- a/v7/src/runtime/syntax.scm +++ b/v7/src/runtime/syntax.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 14.14 1991/02/15 18:07:07 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 14.15 1991/04/15 20:47:52 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -442,7 +442,7 @@ MIT in each case. |# keyword)) (define-integrable (syntax-eval scode) - (scode-eval scode syntaxer/default-environment)) + (extended-scode-eval scode syntaxer/default-environment)) ;;;; FLUID-LET diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index e90e17c43..65bf14a45 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.115 1991/04/11 03:24:32 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.116 1991/04/15 20:47:59 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 115)) + (add-identification! "Runtime" 14 116)) (define microcode-system) diff --git a/v7/src/runtime/xeval.scm b/v7/src/runtime/xeval.scm index 445fe3ec3..736485be0 100644 --- a/v7/src/runtime/xeval.scm +++ b/v7/src/runtime/xeval.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/xeval.scm,v 1.3 1991/02/15 18:08:01 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/xeval.scm,v 1.4 1991/04/15 20:48:03 jinx Exp $ Copyright (c) 1989-91 Massachusetts Institute of Technology @@ -37,15 +37,20 @@ MIT in each case. |# (declare (usual-integrations)) +(define hook/extended-scode-eval) + +(define (default/extended-scode-eval expression environment) + (scode-eval expression environment)) + (define (extended-scode-eval expression environment) (cond ((interpreter-environment? environment) - (scode-eval expression environment)) + (hook/extended-scode-eval expression environment)) ((scode-constant? expression) expression) (else (with-values (lambda () (split-environment environment)) (lambda (bound-names interpreter-environment) - (scode-eval + (hook/extended-scode-eval (cond ((null? bound-names) expression) ((or (definition? expression) @@ -116,6 +121,7 @@ MIT in each case. |# (THE-ENVIRONMENT ,rewrite/the-environment) (UNASSIGNED? ,rewrite/unassigned?) (VARIABLE ,rewrite/variable)))) + (set! hook/extended-scode-eval default/extended-scode-eval) unspecific) (define (rewrite/variable expression environment bound-names) diff --git a/v8/src/runtime/infutl.scm b/v8/src/runtime/infutl.scm index 2530078c1..6311f8193 100644 --- a/v8/src/runtime/infutl.scm +++ b/v8/src/runtime/infutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.20 1991/02/15 18:05:49 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.21 1991/04/15 20:47:29 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -51,12 +51,16 @@ MIT in each case. |# (define (compiled-code-block/dbg-info block demand-load?) (let ((old-info (compiled-code-block/debugging-info block))) - (if (and (pair? old-info) (dbg-info? (car old-info))) - (car old-info) - (and demand-load? - (let ((dbg-info (read-debugging-info old-info))) - (if dbg-info (memoize-debugging-info! block dbg-info)) - dbg-info))))) + (cond ((dbg-info? old-info) + old-info) + ((and (pair? old-info) (dbg-info? (car old-info))) + (car old-info)) + (demand-load? + (let ((dbg-info (read-debugging-info old-info))) + (if dbg-info (memoize-debugging-info! block dbg-info)) + dbg-info)) + (else + false)))) (define (discard-debugging-info!) (without-interrupts diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm index 3312b495d..09c8beab4 100644 --- a/v8/src/runtime/load.scm +++ b/v8/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.20 1991/02/15 18:06:13 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.21 1991/04/15 20:47:37 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -221,7 +221,7 @@ MIT in each case. |# (= 250 (char->ascii fasl-marker))) (begin (close-input-port port) - (scode-eval + (extended-scode-eval (let ((scode (fasload/internal true-pathname load/suppress-loading-message?))) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 5d181200b..8633e0b02 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.100 1991/04/11 03:24:25 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.101 1991/04/15 20:47:45 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -638,7 +638,8 @@ MIT in each case. |# (files "xeval") (parent ()) (export () - extended-scode-eval) + extended-scode-eval + hook/extended-scode-eval) (initialization (initialize-package!))) (define-package (runtime file-input)