Remove copy-program. It now lives in prgcop.scm .

diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm
index a9314378f858d34376c5cc5b5f947258c2d77051..31dc45dd7e2cb64633a8e424bb7c6276516e0c51 100644 (file)
--- a/v7/src/runtime/global.scm
+++ b/v7/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.15 1990/06/07 19:53:40 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.16 1990/07/20 01:12:03 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -197,42 +197,6 @@ MIT in each case. |#
    (->environment from)
    name))
 \f
-(define (copy-program exp)
-  (if (not (object-type? (ucode-type compiled-entry) exp))
-      (error "COPY-PROGRAM: Can only copy compiled programs" exp))
-  (let* ((original (compiled-code-address->block exp))
-        (block
-         (object-new-type
-          (ucode-type compiled-code-block)
-          (vector-copy (object-new-type (ucode-type vector) original))))
-        (end (system-vector-length block)))
-
-    (define (map-entry entry)
-      (with-absolutely-no-interrupts
-       (lambda ()
-        ((ucode-primitive primitive-object-set-type)
-         (object-type entry)
-         (+ (compiled-code-address->offset entry)
-            (object-datum block))))))
-
-    (let loop ((n (1+ (object-datum (system-vector-ref block 0)))))
-      (if (< n end)
-         (begin
-           (if (lambda? (system-vector-ref block n))
-               (lambda-components (system-vector-ref block n)
-                 (lambda (name required optional rest auxiliary declarations
-                               body)
-                   (if (and (object-type? (ucode-type compiled-entry) body)
-                            (eq? original
-                                 (compiled-code-address->block body)))
-                       (system-vector-set!
-                        block
-                        n
-                        (make-lambda name required optional rest auxiliary
-                                     declarations (map-entry body)))))))
-           (loop (1+ n)))))
-    (map-entry exp)))
-
 (define-integrable (object-non-pointer? object)
   (zero? (object-gc-type object)))
 

diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm
index f9ff6e1b1ed8d9b4ea27a79ed3b1715fb973a146..37c7941723bf6e3021b62d49662ed1e17741c6d6 100644 (file)
--- a/v8/src/runtime/global.scm
+++ b/v8/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.15 1990/06/07 19:53:40 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.16 1990/07/20 01:12:03 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -197,42 +197,6 @@ MIT in each case. |#
    (->environment from)
    name))
 \f
-(define (copy-program exp)
-  (if (not (object-type? (ucode-type compiled-entry) exp))
-      (error "COPY-PROGRAM: Can only copy compiled programs" exp))
-  (let* ((original (compiled-code-address->block exp))
-        (block
-         (object-new-type
-          (ucode-type compiled-code-block)
-          (vector-copy (object-new-type (ucode-type vector) original))))
-        (end (system-vector-length block)))
-
-    (define (map-entry entry)
-      (with-absolutely-no-interrupts
-       (lambda ()
-        ((ucode-primitive primitive-object-set-type)
-         (object-type entry)
-         (+ (compiled-code-address->offset entry)
-            (object-datum block))))))
-
-    (let loop ((n (1+ (object-datum (system-vector-ref block 0)))))
-      (if (< n end)
-         (begin
-           (if (lambda? (system-vector-ref block n))
-               (lambda-components (system-vector-ref block n)
-                 (lambda (name required optional rest auxiliary declarations
-                               body)
-                   (if (and (object-type? (ucode-type compiled-entry) body)
-                            (eq? original
-                                 (compiled-code-address->block body)))
-                       (system-vector-set!
-                        block
-                        n
-                        (make-lambda name required optional rest auxiliary
-                                     declarations (map-entry body)))))))
-           (loop (1+ n)))))
-    (map-entry exp)))
-
 (define-integrable (object-non-pointer? object)
   (zero? (object-gc-type object)))