From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 9 Mar 1987 15:00:25 +0000 (+0000)
Subject: Change to use named slots for microcode-identification table.
X-Git-Tag: 20090517-FFI~13689
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1661e22d973fb469aa3e363ac080d547b75665c9;p=mit-scheme.git

Change to use named slots for microcode-identification table.
---

diff --git a/v7/src/runtime/utabs.scm b/v7/src/runtime/utabs.scm
index 436d9e20e..7fa53fec1 100644
--- a/v7/src/runtime/utabs.scm
+++ b/v7/src/runtime/utabs.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/utabs.scm,v 13.41 1987/01/23 00:22:10 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/utabs.scm,v 13.42 1987/03/09 15:00:25 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -68,6 +68,8 @@
 (define primitive-procedure-name)
 (define implemented-primitive-procedure?)
 
+(define microcode-identification-item)
+
 (define future?)
 
 (define microcode-system
@@ -207,6 +209,14 @@
 (set! microcode-termination-name
 (named-lambda (microcode-termination-name type)
   (code->name termination-vector-slot type)))
+
+(define identification-vector-slot)
+
+(set! microcode-identification-item
+  (lambda (name)
+    (vector-ref :identification
+		(or (microcode-table-search identification-vector-slot name)
+		    (error "Unknown identification item" name)))))
 
 ;;;; Microcode Primitives
 
@@ -281,9 +291,6 @@
 
 (define (snarf-version)
   (set! :identification (microcode-identify))
-  (set! :release (vector-ref :identification 0))
-  (set! :version (vector-ref :identification 1))
-  (set! :modification (vector-ref :identification 2))
 
   (set! microcode-tables-identification
 	(scode-eval (binary-fasload (microcode-tables-filename))
@@ -315,6 +322,12 @@
   (set! number-of-microcode-terminations
 	(vector-length (vector-ref fixed-objects termination-vector-slot)))
 
+  (set! identification-vector-slot
+	(fixed-objects-vector-slot 'MICROCODE-IDENTIFICATION-VECTOR))
+  (set! :release (microcode-identification-item 'SYSTEM-RELEASE-STRING))
+  (set! :version (microcode-identification-item 'MICROCODE-VERSION))
+  (set! :modification (microcode-identification-item 'MICROCODE-MODIFICATION))
+
   ;; Predicate to test if object is a future without touching it.
   (set! future? 
 	(let ((primitive (make-primitive-procedure 'FUTURE? true)))