From 94436c38c3bdc688fc354cf3b9ed8bdfd303c751 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 3 Feb 1990 15:14:14 +0000
Subject: [PATCH] Wrote DEFSLOTS macro.  Added DEFSLOTS forms for most of the
 basic data types.

---
 compiler/mips/cell.lisp | 145 +++++++++++++++++++++++++++++++++-------
 1 file changed, 119 insertions(+), 26 deletions(-)

diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp
index 994e8af17..9bc243352 100644
--- a/compiler/mips/cell.lisp
+++ b/compiler/mips/cell.lisp
@@ -7,6 +7,8 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.2 1990/02/03 15:14:14 wlott Exp $
+;;;
 ;;;    This file contains the VM definition of various primitive memory access
 ;;; VOPs for the MIPS.
 ;;;
@@ -14,7 +16,101 @@
 ;;;
 ;;; Converted by William Lott.
 ;;; 
-(in-package 'c)
+(in-package "C")
+
+
+;;;; Data object definition macros.
+
+(eval-when (compile eval load)
+  (defun parse-slot (slot)
+    (if (atom slot)
+	(values slot nil nil nil nil nil)
+	(values (car slot)
+		(getf (cdr slot) :ref-vop)
+		(getf (cdr slot) :ref-trans)
+		(getf (cdr slot) :set-vop)
+		(getf (cdr slot) :set-trans)
+		(getf (cdr slot) :docs)))))
+
+(defmacro defslots ((name &key (header t) (lowtag 0)) &rest slots)
+  (let ((compile-time nil)
+	(load-time nil)
+	(index (if header 1 0))
+	(rest nil))
+    (dolist (slot slots)
+      (if (eq slot '&rest)
+	  (setf rest t)
+	  (multiple-value-bind
+	      (slot-name ref-vop ref-trans set-vop set-trans docs)
+	      (parse-slot slot)
+	    (let ((const (intern (concatenate 'simple-string
+					      (string name)
+					      "-"
+					      (string slot-name)
+					      (if rest "-OFFSET" "-SLOT")))))
+	      (push `(defconstant ,const
+		       ,index
+		       ,@(if docs (list docs)))
+		    compile-time)
+	      (when (or set-vop set-trans ref-vop ref-trans)
+		(push `(define-cell-accessors ,const ,lowtag
+			 ,ref-vop ,ref-trans ,set-vop ,set-trans)
+		      load-time))
+	      (if rest
+		  (setf rest nil)
+		  (incf index))))))
+    `(progn
+       (eval-when (compile load eval)
+	 ,@(nreverse compile-time))
+       ,@(nreverse load-time))))
+
+
+(defslots (%cons :lowtag list-pointer-type :header nil)
+  (car :ref-vop car :ref-trans car
+       :set-vop set-car :set-trans %rplaca)
+  (cdr :ref-vop cdr :ref-trans cdr
+       :set-vop set-cdr :set-trans %rplacd))
+
+
+(defslots (%symbol :lowtag other-pointer-type)
+  (value :set-vop set :set-trans set)
+  (function :set-vop set-symbol-function :set-trans %sp-set-definition)
+  (plist :ref-vop symbol-plist :ref-trans symbol-plist
+	 :set-vop set-symbol-plist :set-trans %sp-set-plist)
+  (name :ref-vop symbol-name :ref-trans symbol-name)
+  (package :ref-vop symbol-package :ref-trans symbol-package
+	   :set-vop set-package))
+
+
+(defslots (%array)
+  fill-pointer
+  elements
+  data
+  displacement
+  displaced-p
+  &rest
+  dimensions)
+
+(defslots (%code)
+  code-size
+  entry-points
+  debug-info
+  &rest
+  constants)
+  
+(defslots (%function-header)
+  self
+  next
+  name
+  arglist
+  type
+  &rest
+  code)
+
+(defslots (%closure)
+  code)
+
+
 
 
 ;;;; Symbol hacking VOPs:
@@ -34,11 +130,10 @@
 ;;;
 (define-vop (symbol-value checked-cell-ref)
   (:translate symbol-value)
-  #+nil
   (:generator 9
-    (unless (location= obj-temp object)
-      (inst or obj-temp object zero-tn))
-    (lw value obj-temp (/ clc::symbol-value 4))
+    (move obj-temp object)
+    (loadw value obj-temp %symbol-value-slot)
+    #+nil
     (let ((err-lab (generate-error-code node clc::error-symbol-unbound
 					obj-temp)))
       (test-special-value value temp '%trap-object err-lab nil))))
@@ -48,11 +143,10 @@
 ;;;
 (define-vop (symbol-function checked-cell-ref)
   (:translate symbol-function)
-  #+nil
   (:generator 10
-    (unless (location= obj-temp object)
-      (inst lr obj-temp object))
-    (loadw value obj-temp (/ clc::symbol-definition 4))
+    (move obj-temp object)
+    (loadw value obj-temp %symbol-function-slot)
+    #+nil
     (let ((err-lab (generate-error-code node clc::error-symbol-undefined
 					obj-temp)))
       (test-simple-type value temp err-lab t system:%function-type))))
@@ -90,65 +184,64 @@
     (loadw value object (/ clc::symbol-definition 4))
     (test-simple-type value temp target not-p system:%function-type)))
 
+#+nil
 (def-source-transform makunbound (x)
   `(set ,x (%primitive make-immediate-type 0 system:%trap-type)))
 
 
 (define-vop (fast-symbol-value cell-ref)
-  (:variant (/ clc::symbol-value 4))
+  (:variant %symbol-value-slot other-pointer-type)
   (:policy :fast)
   (:translate symbol-value))
 
 (define-vop (fast-symbol-function cell-ref)
-  (:variant (/ clc::symbol-definition 4))
+  (:variant %symbol-function-slot other-pointer-type)
   (:policy :fast)
   (:translate symbol-function))
 
-(define-cell-accessors (/ clc::symbol-value 4) nil nil set set)
-(define-cell-accessors (/ clc::symbol-definition 4)
-  nil nil set-symbol-function %sp-set-definition)
-(define-cell-accessors (/ clc::symbol-property-list 4)
-  symbol-plist symbol-plist set-symbol-plist %sp-set-plist)
-(define-cell-accessors (/ clc::symbol-print-name 4)
-  symbol-name symbol-name nil nil)
-(define-cell-accessors (/ clc::symbol-package 4)
-  symbol-package symbol-package set-package nil)
-
 
+#+nil
 (define-miscop bind (val symbol) :results ())
+
+#+nil
 (define-miscop unbind (num) :results ())
 
 
 ;;;; List hackery:
 
-(define-cell-accessors (/ clc::list-car 4)
-  car car set-car %rplaca)
-(define-cell-accessors (/ clc::list-cdr 4)
-  cdr cdr set-cdr %rplacd)
-
+#+nil
 (define-miscop cons (x y) :translate cons)
 
 
 ;;;; Value cell and closure hackery:
 
+#+nil
 (define-miscop make-value-cell (val))
+#+nil
 (define-miscop make-closure (nvars entry))
 
+#+nil
 (define-vop (value-cell-ref cell-ref)
   (:variant (+ clc::g-vector-header-size-in-words
 	       system:%function-value-cell-value-slot)))
 
+#+nil
 (define-vop (value-cell-set cell-set)
   (:variant (+ clc::g-vector-header-size-in-words
 	       system:%function-value-cell-value-slot)))
 
+#+nil
 (define-vop (closure-init slot-set))
+#+nil
 (define-vop (closure-ref slot-ref))
 
 
 ;;;; Structure hackery:
 
+#+nil
 (define-vop (structure-ref slot-ref)
   (:variant vector-header-length other-pointer-type))
+
+#+nil
 (define-vop (structure-set slot-set)
   (:variant vector-header-length other-pointer-type))
-- 
GitLab