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
a90bef30
Commit
a90bef30
authored
20 years ago
by
rtoy
Browse files
Options
Downloads
Patches
Plain Diff
Define allocation macro to handle allocation. Use it. (Incomplete,
but everything should still work.)
parent
1b3a21ca
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
assembly/ppc/array.lisp
+2
-3
2 additions, 3 deletions
assembly/ppc/array.lisp
compiler/ppc/alloc.lisp
+7
-7
7 additions, 7 deletions
compiler/ppc/alloc.lisp
compiler/ppc/array.lisp
+3
-3
3 additions, 3 deletions
compiler/ppc/array.lisp
compiler/ppc/macros.lisp
+34
-1
34 additions, 1 deletion
compiler/ppc/macros.lisp
with
46 additions
and
14 deletions
assembly/ppc/array.lisp
+
2
−
3
View file @
a90bef30
...
@@ -7,7 +7,7 @@
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.
2
200
3
/08/0
3
11:
27:51 gerd
Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.
3
200
4
/08/0
8
11:
15:11 rtoy
Exp $
;;;
;;;
;;; This file contains the support routines for arrays and vectors.
;;; This file contains the support routines for arrays and vectors.
;;;
;;;
...
@@ -31,10 +31,9 @@
...
@@ -31,10 +31,9 @@
(
:temp
pa-flag
non-descriptor-reg
nl3-offset
)
(
:temp
pa-flag
non-descriptor-reg
nl3-offset
)
(
:temp
vector
descriptor-reg
a3-offset
))
(
:temp
vector
descriptor-reg
a3-offset
))
(
pseudo-atomic
(
pa-flag
)
(
pseudo-atomic
(
pa-flag
)
(
inst
ori
vector
alloc-tn
vm:other-pointer-type
)
(
inst
addi
ndescr
words
(
*
(
1+
vm:vector-data-offset
)
vm:word-bytes
))
(
inst
addi
ndescr
words
(
*
(
1+
vm:vector-data-offset
)
vm:word-bytes
))
(
inst
clrrwi
ndescr
ndescr
lowtag-bits
)
(
inst
clrrwi
ndescr
ndescr
lowtag-bits
)
(
inst
add
alloc-tn
alloc-tn
ndescr
)
(
allocation
vector
ndescr
other-pointer-type
)
(
inst
srwi
ndescr
type
vm:word-shift
)
(
inst
srwi
ndescr
type
vm:word-shift
)
(
storew
ndescr
vector
0
vm:other-pointer-type
)
(
storew
ndescr
vector
0
vm:other-pointer-type
)
(
storew
length
vector
vm:vector-length-slot
vm:other-pointer-type
))
(
storew
length
vector
vm:vector-length-slot
vm:other-pointer-type
))
...
...
This diff is collapsed.
Click to expand it.
compiler/ppc/alloc.lisp
+
7
−
7
View file @
a90bef30
...
@@ -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/compiler/ppc/alloc.lisp,v 1.
5
2004/0
7/25
1
8
:15:
52 pmai
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.
6
2004/0
8/08
1
1
:15:
11 rtoy
Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -43,6 +43,7 @@
...
@@ -43,6 +43,7 @@
(
:temporary
(
:scs
(
descriptor-reg
)
:type
list
:to
(
:result
0
)
:target
result
)
(
:temporary
(
:scs
(
descriptor-reg
)
:type
list
:to
(
:result
0
)
:target
result
)
res
)
res
)
(
:temporary
(
:sc
non-descriptor-reg
:offset
nl3-offset
)
pa-flag
)
(
:temporary
(
:sc
non-descriptor-reg
:offset
nl3-offset
)
pa-flag
)
(
:temporary
(
:scs
(
non-descriptor-reg
))
alloc-temp
)
(
:info
num
dynamic-extent
)
(
:info
num
dynamic-extent
)
(
:results
(
result
:scs
(
descriptor-reg
)))
(
:results
(
result
:scs
(
descriptor-reg
)))
(
:variant-vars
star
)
(
:variant-vars
star
)
...
@@ -64,9 +65,8 @@
...
@@ -64,9 +65,8 @@
temp
)))))
temp
)))))
(
let*
((
cons-cells
(
if
star
(
1-
num
)
num
))
(
let*
((
cons-cells
(
if
star
(
1-
num
)
num
))
(
alloc
(
*
(
pad-data-block
cons-size
)
cons-cells
)))
(
alloc
(
*
(
pad-data-block
cons-size
)
cons-cells
)))
(
pseudo-atomic
(
pa-flag
:extra
alloc
)
(
pseudo-atomic
(
pa-flag
)
(
inst
clrrwi
res
alloc-tn
lowtag-bits
)
(
allocation
res
alloc
list-pointer-type
:temp-tn
alloc-temp
)
(
inst
ori
res
res
list-pointer-type
)
(
move
ptr
res
)
(
move
ptr
res
)
(
dotimes
(
i
(
1-
cons-cells
))
(
dotimes
(
i
(
1-
cons-cells
))
(
storew
(
maybe-load
(
tn-ref-tn
things
))
ptr
(
storew
(
maybe-load
(
tn-ref-tn
things
))
ptr
...
@@ -98,6 +98,7 @@
...
@@ -98,6 +98,7 @@
(
unboxed-arg
:scs
(
any-reg
)))
(
unboxed-arg
:scs
(
any-reg
)))
(
:results
(
result
:scs
(
descriptor-reg
)))
(
:results
(
result
:scs
(
descriptor-reg
)))
(
:temporary
(
:scs
(
non-descriptor-reg
))
ndescr
)
(
:temporary
(
:scs
(
non-descriptor-reg
))
ndescr
)
(
:temporary
(
:scs
(
non-descriptor-reg
))
size
)
(
:temporary
(
:scs
(
any-reg
)
:from
(
:argument
0
))
boxed
)
(
:temporary
(
:scs
(
any-reg
)
:from
(
:argument
0
))
boxed
)
(
:temporary
(
:scs
(
non-descriptor-reg
)
:from
(
:argument
1
))
unboxed
)
(
:temporary
(
:scs
(
non-descriptor-reg
)
:from
(
:argument
1
))
unboxed
)
(
:temporary
(
:sc
non-descriptor-reg
:offset
nl3-offset
)
pa-flag
)
(
:temporary
(
:sc
non-descriptor-reg
:offset
nl3-offset
)
pa-flag
)
...
@@ -111,9 +112,8 @@
...
@@ -111,9 +112,8 @@
;; Note: we don't have to subtract off the 4 that was added by
;; Note: we don't have to subtract off the 4 that was added by
;; pseudo-atomic, because oring in other-pointer-type just adds
;; pseudo-atomic, because oring in other-pointer-type just adds
;; it right back.
;; it right back.
(
inst
ori
result
alloc-tn
other-pointer-type
)
(
inst
add
size
boxed
unboxed
)
(
inst
add
alloc-tn
alloc-tn
boxed
)
(
allocation
result
size
other-pointer-type
:temp-tn
ndescr
)
(
inst
add
alloc-tn
alloc-tn
unboxed
)
(
inst
slwi
ndescr
boxed
(
-
type-bits
word-shift
))
(
inst
slwi
ndescr
boxed
(
-
type-bits
word-shift
))
(
inst
ori
ndescr
ndescr
code-header-type
)
(
inst
ori
ndescr
ndescr
code-header-type
)
(
storew
ndescr
result
0
other-pointer-type
)
(
storew
ndescr
result
0
other-pointer-type
)
...
...
This diff is collapsed.
Click to expand it.
compiler/ppc/array.lisp
+
3
−
3
View file @
a90bef30
...
@@ -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/compiler/ppc/array.lisp,v 1.
4
2004/0
7/25
1
8
:15:
5
2
pmai
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.
5
2004/0
8/08
1
1
:15:
1
2
rtoy
Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -29,13 +29,13 @@
...
@@ -29,13 +29,13 @@
(
:temporary
(
:scs
(
descriptor-reg
)
:to
(
:result
0
)
:target
result
)
header
)
(
:temporary
(
:scs
(
descriptor-reg
)
:to
(
:result
0
)
:target
result
)
header
)
(
:temporary
(
:sc
non-descriptor-reg
:offset
nl3-offset
)
pa-flag
)
(
:temporary
(
:sc
non-descriptor-reg
:offset
nl3-offset
)
pa-flag
)
(
:temporary
(
:scs
(
non-descriptor-reg
))
ndescr
)
(
:temporary
(
:scs
(
non-descriptor-reg
))
ndescr
)
(
:temporary
(
:scs
(
non-descriptor-reg
))
gc-temp
)
; gencgc
(
:results
(
result
:scs
(
descriptor-reg
)))
(
:results
(
result
:scs
(
descriptor-reg
)))
(
:generator
0
(
:generator
0
(
pseudo-atomic
(
pa-flag
)
(
pseudo-atomic
(
pa-flag
)
(
inst
ori
header
alloc-tn
other-pointer-type
)
(
inst
addi
ndescr
rank
(
*
(
1+
array-dimensions-offset
)
vm:word-bytes
))
(
inst
addi
ndescr
rank
(
*
(
1+
array-dimensions-offset
)
vm:word-bytes
))
(
inst
clrrwi
ndescr
ndescr
lowtag-bits
)
(
inst
clrrwi
ndescr
ndescr
lowtag-bits
)
(
inst
add
alloc-tn
alloc-tn
ndescr
)
(
allocation
header
ndescr
other-pointer-type
:temp-tn
gc-temp
)
(
inst
addi
ndescr
rank
(
fixnumize
(
1-
vm:array-dimensions-offset
)))
(
inst
addi
ndescr
rank
(
fixnumize
(
1-
vm:array-dimensions-offset
)))
(
inst
slwi
ndescr
ndescr
vm:type-bits
)
(
inst
slwi
ndescr
ndescr
vm:type-bits
)
(
inst
or
ndescr
ndescr
type
)
(
inst
or
ndescr
ndescr
type
)
...
...
This diff is collapsed.
Click to expand it.
compiler/ppc/macros.lisp
+
34
−
1
View file @
a90bef30
...
@@ -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/ppc/macros.lisp,v 1.
2
2004/0
7/25
1
8
:15:
5
2
pmai
Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/macros.lisp,v 1.
3
2004/0
8/08
1
1
:15:
1
2
rtoy
Exp $
;;;
;;;
;;; This file contains various useful macros for generating PC code.
;;; This file contains various useful macros for generating PC code.
;;;
;;;
...
@@ -165,6 +165,21 @@
...
@@ -165,6 +165,21 @@
;;;; Storage allocation:
;;;; Storage allocation:
(
defmacro
allocation
(
result-tn
size
lowtag
&key
stack-p
temp-tn
)
(
declare
(
ignore
stack-p
temp-tn
))
(
let
((
alloc-size
(
gensym
)))
`
(
let
((
,
alloc-size
,
size
))
(
if
(
logbitp
(
1-
lowtag-bits
)
,
lowtag
)
(
progn
(
inst
ori
,
result-tn
alloc-tn
,
lowtag
))
(
progn
(
inst
clrrwi
,
result-tn
alloc-tn
lowtag-bits
)
(
inst
ori
,
result-tn
,
result-tn
,
lowtag
)))
(
if
(
numberp
,
alloc-size
)
(
inst
addi
alloc-tn
alloc-tn
,
alloc-size
)
(
inst
add
alloc-tn
alloc-tn
,
alloc-size
)))))
#+
nil
(
defmacro
with-fixed-allocation
((
result-tn
flag-tn
temp-tn
type-code
size
)
(
defmacro
with-fixed-allocation
((
result-tn
flag-tn
temp-tn
type-code
size
)
&body
body
)
&body
body
)
"Do stuff to allocate an other-pointer object of fixed Size with a single
"Do stuff to allocate an other-pointer object of fixed Size with a single
...
@@ -180,6 +195,24 @@
...
@@ -180,6 +195,24 @@
(
storew
,
temp-tn
,
result-tn
0
other-pointer-type
)
(
storew
,
temp-tn
,
result-tn
0
other-pointer-type
)
,@
body
)))
,@
body
)))
(
defmacro
with-fixed-allocation
((
result-tn
flag-tn
temp-tn
type-code
size
&key
(
lowtag
other-pointer-type
))
&body
body
)
"Do stuff to allocate an other-pointer object of fixed Size with a single
word header having the specified Type-Code. The result is placed in
Result-TN, and Temp-TN is a non-descriptor temp (which may be randomly used
by the body.) The body is placed inside the PSEUDO-ATOMIC, and presumably
initializes the object."
(
once-only
((
result-tn
result-tn
)
(
temp-tn
temp-tn
)
(
flag-tn
flag-tn
)
(
type-code
type-code
)
(
size
size
))
`
(
pseudo-atomic
(
,
flag-tn
)
(
allocation
,
result-tn
(
pad-data-block
,
size
)
,
lowtag
:temp-tn
temp-tn
)
(
when
,
type-code
(
inst
lr
,
temp-tn
(
logior
(
ash
(
1-
,
size
)
type-bits
)
,
type-code
))
(
storew
,
temp-tn
,
result-tn
0
other-pointer-type
))
,@
body
)))
;;;; Type testing noise.
;;;; Type testing noise.
...
...
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