Skip to content
Snippets Groups Projects
Commit d11f2853 authored by wlott's avatar wlott
Browse files

Added VALUE-CELL structure.

Added automatic generation of slot-ref and slot-set for :rest t slots.
parent 24e359eb
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.8 1990/02/20 16:04:50 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.9 1990/02/20 18:21:28 wlott Exp $
;;; ;;;
;;; This file contains the VM definition of various primitive memory access ;;; This file contains the VM definition of various primitive memory access
;;; VOPs for the MIPS. ;;; VOPs for the MIPS.
...@@ -50,6 +50,8 @@ ...@@ -50,6 +50,8 @@
closure-structure closure-function-slot closure-info-offset closure-structure closure-function-slot closure-info-offset
value-cell-structure value-cell-size value-cell-value-slot
symbol-structure symbol-size symbol-value-slot symbol-structure symbol-size symbol-value-slot
symbol-function-slot symbol-plist-slot symbol-name-slot symbol-function-slot symbol-plist-slot symbol-name-slot
symbol-package-slot)) symbol-package-slot))
...@@ -62,16 +64,20 @@ ...@@ -62,16 +64,20 @@
(eval-when (compile eval load) (eval-when (compile eval load)
(defun parse-slot (slot) (defun parse-slot (slot)
(if (atom slot) (multiple-value-bind
(values slot nil t nil nil nil nil nil) (name props)
(values (car slot) (if (atom slot)
(getf (cdr slot) :rest) (values slot nil)
(getf (cdr slot) :boxed t) (values (car slot) (cdr slot)))
(getf (cdr slot) :ref-vop) (values name
(getf (cdr slot) :ref-trans) (getf props :rest)
(getf (cdr slot) :set-vop) (getf props :boxed t)
(getf (cdr slot) :set-trans) (getf props :ref-vop)
(getf (cdr slot) :docs))))) (getf props :ref-trans)
(getf props :set-vop)
(getf props :setf-vop)
(getf props :set-trans)
(getf props :docs)))))
(defmacro defslots ((name &key (header t) (lowtag 0)) &rest slots) (defmacro defslots ((name &key (header t) (lowtag 0)) &rest slots)
(let ((compile-time nil) (let ((compile-time nil)
...@@ -84,7 +90,8 @@ ...@@ -84,7 +90,8 @@
(error "Rest slot ~S in defslots of ~S is not the last one." (error "Rest slot ~S in defslots of ~S is not the last one."
did-rest name)) did-rest name))
(multiple-value-bind (multiple-value-bind
(slot-name rest boxed ref-vop ref-trans set-vop set-trans docs) (slot-name rest boxed ref-vop ref-trans
set-vop setf-vop set-trans docs)
(parse-slot slot) (parse-slot slot)
(let ((const (intern (concatenate 'simple-string (let ((const (intern (concatenate 'simple-string
(string name) (string name)
...@@ -95,9 +102,19 @@ ...@@ -95,9 +102,19 @@
,index ,index
,@(if docs (list docs))) ,@(if docs (list docs)))
compile-time) compile-time)
(when (or set-vop set-trans ref-vop ref-trans) (when (or set-vop setf-vop)
(push `(define-cell-accessors ,const ,lowtag (push `(define-vop ,(cond (rest `(,set-vop slot-set))
,ref-vop ,ref-trans ,set-vop ,set-trans) (set-vop `(,set-vop cell-set))
(t `(,setf-vop cell-setf)))
(:variant ,const ,lowtag)
,@(when set-trans
`((:translate ,set-trans))))
load-time))
(when ref-vop
(push `(define-vop (,ref-vop ,(if rest 'slot-ref 'cell-ref))
(:variant ,const ,lowtag)
,@(when ref-trans
`((:translate ,ref-trans))))
load-time))) load-time)))
(push (if (or (not boxed) rest) (push (if (or (not boxed) rest)
`(,slot-name `(,slot-name
...@@ -128,9 +145,9 @@ ...@@ -128,9 +145,9 @@
(defslots (cons :lowtag list-pointer-type :header nil) (defslots (cons :lowtag list-pointer-type :header nil)
(car :ref-vop car :ref-trans car (car :ref-vop car :ref-trans car
:set-vop set-car :set-trans %rplaca) :setf-vop set-car :set-trans %rplaca)
(cdr :ref-vop cdr :ref-trans cdr (cdr :ref-vop cdr :ref-trans cdr
:set-vop set-cdr :set-trans %rplacd)) :setf-vop set-cdr :set-trans %rplacd))
(defslots (bignum :lowtag other-pointer-type) (defslots (bignum :lowtag other-pointer-type)
...@@ -182,16 +199,19 @@ ...@@ -182,16 +199,19 @@
(defslots (closure :lowtag function-pointer-type) (defslots (closure :lowtag function-pointer-type)
function function
(info :rest t)) (info :rest t :set-vop closure-init :ref-vop closure-ref))
(defslots (value-cell :lowtag other-pointer-type)
(value :set-vop value-cell-set :ref-vop value-cell-ref))
(defslots (symbol :lowtag other-pointer-type) (defslots (symbol :lowtag other-pointer-type)
(value :set-vop set :set-trans set) (value :setf-vop set :set-trans set)
(function :set-vop set-symbol-function :set-trans %sp-set-definition) (function :setf-vop set-symbol-function :set-trans %sp-set-definition)
(plist :ref-vop symbol-plist :ref-trans symbol-plist (plist :ref-vop symbol-plist :ref-trans symbol-plist
:set-vop set-symbol-plist :set-trans %sp-set-plist) :setf-vop set-symbol-plist :set-trans %sp-set-plist)
(name :ref-vop symbol-name :ref-trans symbol-name) (name :ref-vop symbol-name :ref-trans symbol-name)
(package :ref-vop symbol-package :ref-trans symbol-package (package :ref-vop symbol-package :ref-trans symbol-package
:set-vop set-package)) :setf-vop set-package))
...@@ -291,32 +311,11 @@ ...@@ -291,32 +311,11 @@
(define-miscop unbind (num) :results ()) (define-miscop unbind (num) :results ())
;;;; 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: ;;;; Structure hackery:
;;; ### This is only necessary until we get real structures up and running.
(define-vop (structure-ref slot-ref) (define-vop (structure-ref slot-ref)
(:variant vm:vector-data-offset vm:other-pointer-type)) (:variant vm:vector-data-offset vm:other-pointer-type))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment