From 09848caa98f1b0633432500aa17cbc43587c5d2f Mon Sep 17 00:00:00 2001 From: ch <ch> Date: Mon, 26 Feb 1990 22:55:51 +0000 Subject: [PATCH] Changed string-char to base-character in preparation for X3J13. Added SAP as a primitive type. --- compiler/mips/vm.lisp | 59 +++++++++++++++++++++++-------------------- 1 file changed, 31 insertions(+), 28 deletions(-) diff --git a/compiler/mips/vm.lisp b/compiler/mips/vm.lisp index 504656d1c..6f2b9ffeb 100644 --- a/compiler/mips/vm.lisp +++ b/compiler/mips/vm.lisp @@ -7,7 +7,7 @@ ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.11 1990/02/25 18:35:05 ch Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.12 1990/02/26 22:55:51 ch Exp $ ;;; ;;; This file contains the VM definition for the MIPS R2000 and the new ;;; object format. @@ -54,8 +54,8 @@ (interior-reg registers :locations (1)) - ;; Unboxed string-chars - (string-char-reg registers + ;; Unboxed base-characters + (base-character-reg registers :locations (2 3 4 5 6 7)) ;; Unboxed SAP's (arbitrary pointers into address space) @@ -68,8 +68,8 @@ ;; Stack for non-descriptor objects (not scanned by GC) (number-stack number-stack) - ;; Unboxed string-char stack - (string-char-stack number-stack) + ;; Unboxed base-character stack + (base-character-stack number-stack) ;; Unboxed SAP stack (sap-stack number-stack) @@ -101,8 +101,8 @@ ;; Immediate null/nil. (null immediate-constant) - ;; Immediate unboxed string-chars. - (immediate-string-char immediate-constant) + ;; Immediate unboxed base-characters. + (immediate-base-character immediate-constant) ;; Immediate unboxed SAP's. (immediate-sap immediate-constant) @@ -124,35 +124,35 @@ ;;;; Move costs. -;;; ### this needs work +;;; ### This needs work. ;;; ;;; Move costs for operand loading and storing (define-move-costs ((any-reg descriptor-reg non-descriptor-reg) (1 any-reg descriptor-reg non-descriptor-reg) - (2 string-char-reg sap-reg) + (2 base-character-reg sap-reg) (5 control-stack number-stack)) ((control-stack number-stack constant) (5 any-reg descriptor-reg non-descriptor-reg) - (6 string-char-reg sap-reg)) + (6 base-character-reg sap-reg)) ((immediate zero null random-immediate) (1 any-reg descriptor-reg non-descriptor-reg)) - ((immediate-string-char) - (1 string-char-reg) + ((immediate-base-character) + (1 base-character-reg) (2 any-reg descriptor-reg non-descriptor-reg)) ((immediate-sap) (1 sap-reg) (2 any-reg descriptor-reg non-descriptor-reg)) - ((string-char-reg) - (1 string-char-reg) + ((base-character-reg) + (1 base-character-reg) (2 any-reg descriptor-reg non-descriptor-reg) - (5 string-char-stack) + (5 base-character-stack) (6 control-stack number-stack)) ((sap-reg) @@ -161,8 +161,8 @@ (5 sap-stack) (6 control-stack number-stack)) - ((string-char-stack) - (5 string-char-reg)) + ((base-character-stack) + (5 base-character-reg)) ((sap-stack) (5 sap-reg))) @@ -171,7 +171,7 @@ ;;; SCs which must saved on a function call. (define-save-scs (control-stack any-reg descriptor-reg) - (string-char-stack string-char-reg) + (base-character-stack base-character-reg) (sap-stack sap-reg)) @@ -182,14 +182,13 @@ ;;; (def-primitive-type fixnum (any-reg control-stack)) -;;; ### what about character? -(def-primitive-type string-char (string-char-reg any-reg - string-char-stack - control-stack)) + +(def-primitive-type base-character (base-character-reg any-reg + base-character-stack + control-stack)) ;;; (def-primitive-type function (descriptor-reg control-stack)) -;;; ### what about structure? (def-primitive-type list (descriptor-reg control-stack)) ;;; @@ -211,6 +210,8 @@ (def-primitive-type simple-array-single-float (descriptor-reg control-stack)) (def-primitive-type simple-array-double-float (descriptor-reg control-stack)) +(def-primitive-type sap (sap-reg sap-stack)) + (def-primitive-type random (non-descriptor-reg)) (def-primitive-type interior (interior-reg)) @@ -238,7 +239,7 @@ ;;; (defvar *simple-array-primitive-types* - '((string-char . simple-string) + '((base-character . simple-string) (bit . simple-bit-vector) ((unsigned-byte 2) . simple-array-unsigned-byte-2) ((unsigned-byte 4) . simple-array-unsigned-byte-4) @@ -308,12 +309,14 @@ nil)) (named-type (case (named-type-name type) - ((t bignum ratio complex string-char function) + ((t bignum ratio complex function) (values (primitive-type-or-lose (named-type-name type)) t)) + (string-char + (values (primitive-type-or-lose 'base-character) t)) + (standard-char + (values (primitive-type-or-lose 'base-character) nil)) (cons (values (primitive-type-or-lose 'list) nil)) - (standard-char - (values (primitive-type-or-lose 'string-char) nil)) (t (values *any-primitive-type* nil)))) (ctype @@ -443,7 +446,7 @@ ;; ;; ### hack around bug in (typep x 'string-char) (if (and (characterp value) (string-char-p value)) - (sc-number-or-lose 'immediate-string-char) + (sc-number-or-lose 'immediate-base-character) nil)))) -- GitLab