Skip to content
Snippets Groups Projects
Commit 94e28a96 authored by ram's avatar ram
Browse files

Rip out NS-BOOT conditionals.

parent 3d4ebb5b
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.38 1993/02/26 08:25:05 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.39 1993/03/01 20:07:52 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -33,11 +33,6 @@ ...@@ -33,11 +33,6 @@
;;;; Structure frobbing primitives. ;;;; Structure frobbing primitives.
#+ns-boot
(defun %instancep (x)
(structurep x))
#-ns-boot
(defun %make-instance (length) (defun %make-instance (length)
"Allocate a new instance with LENGTH data slots." "Allocate a new instance with LENGTH data slots."
(declare (type index length)) (declare (type index length))
...@@ -46,19 +41,12 @@ ...@@ -46,19 +41,12 @@
(defun %instance-length (instance) (defun %instance-length (instance)
"Given an instance, return its length." "Given an instance, return its length."
(declare (type instance instance)) (declare (type instance instance))
#+ns-boot
(structure-length instance)
#-ns-boot
(%instance-length instance)) (%instance-length instance))
(defun %instance-ref (instance index) (defun %instance-ref (instance index)
"Return the value from the INDEXth slot of INSTANCE. This is SETFable." "Return the value from the INDEXth slot of INSTANCE. This is SETFable."
#+ns-boot
(structure-ref instance index)
#-ns-boot
(%instance-ref instance index)) (%instance-ref instance index))
#-ns-boot (progn
(defun %instance-set (instance index new-value) (defun %instance-set (instance index new-value)
"Set the INDEXth slot of INSTANCE to NEW-VALUE." "Set the INDEXth slot of INSTANCE to NEW-VALUE."
(setf (%instance-ref instance index) new-value)) (setf (%instance-ref instance index) new-value))
...@@ -79,15 +67,9 @@ ...@@ -79,15 +67,9 @@
(declare (type index index)) (declare (type index index))
(%raw-set-double vec index val)) (%raw-set-double vec index val))
); #-ns-boot progn
(defun %instance-layout (instance) (defun %instance-layout (instance)
#+ns-boot
(layout-of instance)
#-ns-boot
(%instance-layout instance)) (%instance-layout instance))
#-ns-boot
(defun %set-instance-layout (instance new-value) (defun %set-instance-layout (instance new-value)
(%set-instance-layout instance new-value)) (%set-instance-layout instance new-value))
...@@ -459,8 +441,7 @@ ...@@ -459,8 +441,7 @@
(let* ((aname (concat-pnames (dd-conc-name defstruct) name)) (let* ((aname (concat-pnames (dd-conc-name defstruct) name))
(existing (info function accessor-for aname))) (existing (info function accessor-for aname)))
(if #-ns-boot (if (and (structure-class-p existing)
(and (structure-class-p existing)
(not (eq (class-name existing) (dd-name defstruct))) (not (eq (class-name existing) (dd-name defstruct)))
(string= (dsd-%name (find aname (string= (dsd-%name (find aname
(dd-slots (dd-slots
...@@ -468,7 +449,6 @@ ...@@ -468,7 +449,6 @@
(class-layout existing))) (class-layout existing)))
:key #'dsd-accessor)) :key #'dsd-accessor))
name)) name))
#+ns-boot nil
(setf (dsd-accessor islot) nil) (setf (dsd-accessor islot) nil)
(setf (dsd-accessor islot) aname))) (setf (dsd-accessor islot) aname)))
...@@ -963,11 +943,6 @@ ...@@ -963,11 +943,6 @@
;;; general-case code. Since the compiler will normally open-code accesors, ;;; general-case code. Since the compiler will normally open-code accesors,
;;; the (minor) efficiency penalty is not a concern. ;;; the (minor) efficiency penalty is not a concern.
#+ns-boot
(defun %defstruct (&rest ignore)
(declare (ignore ignore)))
#-ns-boot(progn
;;; Typep-To-Layout -- Internal ;;; Typep-To-Layout -- Internal
;;; ;;;
;;; Return true if Obj is an object of the structure type corresponding to ;;; Return true if Obj is an object of the structure type corresponding to
...@@ -1078,7 +1053,6 @@ ...@@ -1078,7 +1053,6 @@
(undefined-value)) (undefined-value))
); #-ns-boot progn
;;;; Redefinition stuff: ;;;; Redefinition stuff:
...@@ -1107,9 +1081,6 @@ ...@@ -1107,9 +1081,6 @@
:inheritance-depth (length inherits) :inheritance-depth (length inherits)
:length (dd-length info) :length (dd-length info)
:info info))) :info info)))
#+ns-boot
(when (and old-layout (not (layout-info old-layout)))
(setf (layout-info old-layout) info))
(cond (cond
((not old-layout) ((not old-layout)
(values class new-layout nil)) (values class new-layout nil))
...@@ -1356,7 +1327,6 @@ ...@@ -1356,7 +1327,6 @@
;;; ;;;
;;; Copy any old kind of structure. ;;; Copy any old kind of structure.
;;; ;;;
#-ns-boot
(defun copy-structure (structure) (defun copy-structure (structure)
"Return a copy of Structure with the same (EQL) slot values." "Return a copy of Structure with the same (EQL) slot values."
(declare (type structure-object structure) (optimize (speed 3) (safety 0))) (declare (type structure-object structure) (optimize (speed 3) (safety 0)))
...@@ -1387,7 +1357,6 @@ ...@@ -1387,7 +1357,6 @@
;;; Default print and make-load-form methods. ;;; Default print and make-load-form methods.
#-ns-boot
(defun default-structure-print (structure stream depth) (defun default-structure-print (structure stream depth)
(declare (ignore depth)) (declare (ignore depth))
(let* ((type (%instance-layout structure)) (let* ((type (%instance-layout structure))
...@@ -1433,7 +1402,6 @@ ...@@ -1433,7 +1402,6 @@
(write-char #\space stream) (write-char #\space stream)
(output-object (%instance-ref structure index) stream)))))) (output-object (%instance-ref structure index) stream))))))
#-ns-boot
(defun make-structure-load-form (structure) (defun make-structure-load-form (structure)
(declare (type structure-object structure)) (declare (type structure-object structure))
(let* ((class (layout-class (%instance-layout structure))) (let* ((class (layout-class (%instance-layout structure)))
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.36 1993/02/26 08:25:51 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.37 1993/03/01 20:11:18 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -168,11 +168,6 @@ ...@@ -168,11 +168,6 @@
(:primitive (:primitive
(when *type-system-initialized* (when *type-system-initialized*
(error "Illegal to redefine standard type: ~S." name))) (error "Illegal to redefine standard type: ~S." name)))
#+ns-boot
(:structure
(warn "Redefining structure type ~S with DEFTYPE." name)
(c::undefine-structure (info type structure-info name))
(setf (info type kind name) :defined))
(:instance (:instance
(warn "Redefining class ~S to be a DEFTYPE." name) (warn "Redefining class ~S to be a DEFTYPE." name)
(undefine-structure (layout-info (class-layout (info type class name)))) (undefine-structure (layout-info (class-layout (info type class name))))
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type-boot.lisp,v 1.7 1993/02/26 08:26:22 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type-boot.lisp,v 1.8 1993/03/01 20:11:52 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -35,7 +35,6 @@ ...@@ -35,7 +35,6 @@
(%instance-ref tc i))) (%instance-ref tc i)))
new)) new))
#-ns-boot
;;; Define the STRUCTURE-OBJECT class as a subclass of INSTANCE. This must be ;;; Define the STRUCTURE-OBJECT class as a subclass of INSTANCE. This must be
;;; the first DEFSTRUCT executed. ;;; the first DEFSTRUCT executed.
;;; ;;;
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.6 1993/02/25 02:24:32 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.7 1993/03/01 20:09:44 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -780,9 +780,6 @@ ...@@ -780,9 +780,6 @@
(info type builtin spec))) (info type builtin spec)))
((eq (info type kind spec) :instance) ((eq (info type kind spec) :instance)
(find-class spec)) (find-class spec))
#+ns-boot
((eq (info type kind spec) :structure)
(find-class spec))
((typep spec 'class) ((typep spec 'class)
(if (typep spec 'built-in-class) (if (typep spec 'built-in-class)
(or (built-in-class-translation spec) spec) (or (built-in-class-translation spec) spec)
...@@ -2105,10 +2102,9 @@ ...@@ -2105,10 +2102,9 @@
((or numeric-type named-type member-type array-type built-in-class) ((or numeric-type named-type member-type array-type built-in-class)
(values (%typep obj type) t)) (values (%typep obj type) t))
(class (class
(if #-ns-boot(if (csubtypep type (specifier-type 'generic-function)) (if (if (csubtypep type (specifier-type 'generic-function))
(funcallable-instance-p obj) (funcallable-instance-p obj)
(%instancep obj)) (%instancep obj))
#+ns-boot(structurep obj)
(if (eq (class-layout type) (if (eq (class-layout type)
(info type compiler-layout (class-name type))) (info type compiler-layout (class-name type)))
(values (typep obj type) t) (values (typep obj type) t)
...@@ -2198,12 +2194,8 @@ ...@@ -2198,12 +2194,8 @@
(setf (numeric-type-low res) num) (setf (numeric-type-low res) num)
(setf (numeric-type-high res) num))) (setf (numeric-type-high res) num)))
res)) res))
#-ns-boot
(instance (instance
(layout-class (%instance-layout x))) (layout-class (%instance-layout x)))
#+ns-boot
(structure
(find-class (structure-ref x 0)))
(array (array
(let ((etype (specifier-type (array-element-type x)))) (let ((etype (specifier-type (array-element-type x))))
(make-array-type :dimensions (array-dimensions x) (make-array-type :dimensions (array-dimensions x)
......
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