Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
94e28a96
Commit
94e28a96
authored
32 years ago
by
ram
Browse files
Options
Downloads
Patches
Plain Diff
Rip out NS-BOOT conditionals.
parent
3d4ebb5b
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
code/defstruct.lisp
+2
-34
2 additions, 34 deletions
code/defstruct.lisp
code/macros.lisp
+1
-6
1 addition, 6 deletions
code/macros.lisp
code/type-boot.lisp
+1
-2
1 addition, 2 deletions
code/type-boot.lisp
code/type.lisp
+4
-12
4 additions, 12 deletions
code/type.lisp
with
8 additions
and
54 deletions
code/defstruct.lisp
+
2
−
34
View file @
94e28a96
...
@@ -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.3
8
1993/0
2/26 08:25:05
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.3
9
1993/0
3/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
)))
...
...
This diff is collapsed.
Click to expand it.
code/macros.lisp
+
1
−
6
View file @
94e28a96
...
@@ -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.3
6
1993/0
2/26 08:25:51
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.3
7
1993/0
3/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
))))
...
...
This diff is collapsed.
Click to expand it.
code/type-boot.lisp
+
1
−
2
View file @
94e28a96
...
@@ -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/0
2/26 08:26:2
2 ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type-boot.lisp,v 1.
8
1993/0
3/01 20:11:5
2 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.
;;;
;;;
...
...
This diff is collapsed.
Click to expand it.
code/type.lisp
+
4
−
12
View file @
94e28a96
...
@@ -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/0
2/25 02:24:32
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.
7
1993/0
3/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
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment