From 1661e22d973fb469aa3e363ac080d547b75665c9 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 9 Mar 1987 15:00:25 +0000 Subject: [PATCH] Change to use named slots for microcode-identification table. --- v7/src/runtime/utabs.scm | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) 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))) -- 2.25.1