Skip to content
Snippets Groups Projects
Commit 3a40c453 authored by ram's avatar ram
Browse files

New structure hax.

parent bcf09777
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/load.lisp,v 1.47.1.1 1993/01/15 16:13:46 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.47.1.2 1993/01/23 14:18:08 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -660,12 +660,12 @@ ...@@ -660,12 +660,12 @@
(clone-fop (fop-struct 48) (clone-fop (fop-struct 48)
(fop-small-struct 49) (fop-small-struct 49)
(let* ((size (clone-arg)) (let* ((size (clone-arg))
(res (make-structure size))) (res (%make-instance size)))
(declare (type index size)) (declare (type index size))
(do ((n (1- size) (1- n))) (do ((n (1- size) (1- n)))
((minusp n)) ((minusp n))
(declare (type (integer -1 #.most-positive-fixnum) n)) (declare (type (integer -1 #.most-positive-fixnum) n))
(setf (structure-ref res n) (pop-stack))) (setf (%instance-ref res n) (pop-stack)))
res)) res))
(define-fop (fop-layout 45) (define-fop (fop-layout 45)
...@@ -945,13 +945,13 @@ ...@@ -945,13 +945,13 @@
(obj (svref *current-fop-table* obi)) (obj (svref *current-fop-table* obi))
(idx (read-arg 4)) (idx (read-arg 4))
(val (pop-stack))) (val (pop-stack)))
(if (structurep obj) (if (%instancep obj)
(setf (c::structure-ref obj idx) val) (setf (%instance-ref obj idx) val)
(setf (svref obj idx) val)))) (setf (svref obj idx) val))))
(define-fop (fop-structset 204 nil) (define-fop (fop-structset 204 nil)
(setf (c::structure-ref (svref *current-fop-table* (read-arg 4)) (setf (%instance-ref (svref *current-fop-table* (read-arg 4))
(read-arg 4)) (read-arg 4))
(pop-stack))) (pop-stack)))
(define-fop (fop-nthcdr 203 t) (define-fop (fop-nthcdr 203 t)
......
...@@ -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/pred.lisp,v 1.28.1.1 1993/01/15 15:29:10 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.28.1.2 1993/01/23 14:16:16 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -282,13 +282,12 @@ ...@@ -282,13 +282,12 @@
(when (%%typep object type) (when (%%typep object type)
(return t)))) (return t))))
(unknown-type (unknown-type
;; Type may be unknown to the compiler (and SPECIFIER-TYPE), yet be ;; Parse it again to make sure it's really undefined.
;; a defined structure in the core. (let ((reparse (specifier-type (unknown-type-specifier type))))
(let ((orig-spec (unknown-type-specifier type))) (if (typep reparse 'unknown-type)
(if (and (symbolp orig-spec) (error "Unknown type specifier: ~S"
(info type defined-structure-info orig-spec)) (unknown-type-specifier reparse))
(structure-typep object orig-spec) (%%typep object reparse))))
(error "Unknown type specifier: ~S" orig-spec))))
(hairy-type (hairy-type
;; Now the tricky stuff. ;; Now the tricky stuff.
(let* ((hairy-spec (hairy-type-specifier type)) (let* ((hairy-spec (hairy-type-specifier 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