From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Jun 1987 18:02:50 +0000 (+0000)
Subject: New microcode handles purification of compiled code blocks without
X-Git-Tag: 20090517-FFI~13409
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5942a0399730c7b7dabc8d14cc1b76ee7986e106;p=mit-scheme.git

New microcode handles purification of compiled code blocks without
special treatment by the runtime system.
---

diff --git a/v7/src/runtime/system.scm b/v7/src/runtime/system.scm
index b5c8edc87..5180af4f4 100644
--- a/v7/src/runtime/system.scm
+++ b/v7/src/runtime/system.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/system.scm,v 13.48 1987/06/05 16:28:08 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/system.scm,v 13.49 1987/06/05 18:02:50 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -203,17 +203,10 @@
 	  '()
 	  (split-list files 20
 	    (lambda (head tail)
-	      (fasload-files head
-		(lambda (expressions pure constant)
-		  (if (not (null? pure))
-		      (begin (newline)
-			     (write-string "Purify")
-			     (purify (list->vector pure) true)))
-		  (if (not (null? constant))
-		      (begin (newline)
-			     (write-string "Constantify")
-			     (purify (list->vector constant) false)))
-		  (append! expressions (loop tail))))))))
+	      (newline)
+	      (write-string "Purify")
+	      (purify (list->vector head) true)
+	      (append! head (loop tail))))))
     (let ((files (format-files-list (access :files-lists system) compiled?)))
       (set! (access :files system)
 	    (map (lambda (file) (pathname->string (car file))) files))
@@ -227,30 +220,13 @@
       (write-string "Done"))
     (add-system! system)
     *the-non-printing-object*))
-
+
 (define (split-list list n receiver)
   (if (or (not (pair? list)) (zero? n))
       (receiver '() list)
       (split-list (cdr list) (-1+ n)
 	(lambda (head tail)
 	  (receiver (cons (car list) head) tail)))))
-
-(define (fasload-files filenames receiver)
-  (if (null? filenames)
-      (receiver '() '() '())
-      (fasload-files (cdr filenames)
-	(lambda (expressions pure constant)
-	  (let ((scode (fasload (car filenames))))
-	    (if (primitive-type? type-code/compiled-expression scode)
-		(receiver (cons scode expressions)
-			  pure
-			  (cons scode constant))
-		(receiver (cons scode expressions)
-			  (cons scode pure)
-			  constant)))))))
-
-(define type-code/compiled-expression
-  (microcode-type 'COMPILED-EXPRESSION))
 
 (define (format-files-list files-lists compiled?)
   (mapcan (lambda (files-list)