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
d4b84a20
Commit
d4b84a20
authored
32 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Changed function-header-code-offset to function-code-offset.
Added stuff for new var-alloc and fixed-alloc vops.
parent
7bcb4239
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
compiler/hppa/cell.lisp
+45
-55
45 additions, 55 deletions
compiler/hppa/cell.lisp
with
45 additions
and
55 deletions
compiler/hppa/cell.lisp
+
45
−
55
View file @
d4b84a20
...
@@ -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/hppa/cell.lisp,v 1.
2
199
2/10/28
0
0
:3
2:4
3 wlott Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/cell.lisp,v 1.
3
199
3/01/15
0
1
:3
3:5
3 wlott Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -20,63 +20,34 @@
...
@@ -20,63 +20,34 @@
(
in-package
"HPPA"
)
(
in-package
"HPPA"
)
;;;; Data object definition macros.
;;;; Data object ref/set stuff.
(
define-for-each-primitive-object
(
obj
)
(
define-vop
(
slot
)
(
collect
((
forms
))
(
:args
(
object
:scs
(
descriptor-reg
)))
(
let
((
lowtag
(
primitive-object-lowtag
obj
)))
(
:info
name
offset
lowtag
)
(
dolist
(
slot
(
primitive-object-slots
obj
))
(
:ignore
name
)
(
let*
((
name
(
slot-name
slot
))
(
:results
(
result
:scs
(
descriptor-reg
any-reg
)))
(
offset
(
slot-offset
slot
))
(
:generator
1
(
rest-p
(
slot-rest-p
slot
))
(
loadw
result
object
offset
lowtag
)))
(
slot-opts
(
slot-options
slot
))
(
ref-trans
(
getf
slot-opts
:ref-trans
))
(
define-vop
(
set-slot
)
(
ref-vop
(
getf
slot-opts
:ref-vop
ref-trans
))
(
:args
(
object
:scs
(
descriptor-reg
))
(
set-trans
(
getf
slot-opts
:set-trans
))
(
value
:scs
(
descriptor-reg
any-reg
)))
(
setf-function-p
(
and
(
listp
set-trans
)
(
:info
name
offset
lowtag
)
(
=
(
length
set-trans
)
2
)
(
:ignore
name
)
(
eq
(
car
set-trans
)
'setf
)))
(
:results
)
(
setf-vop
(
getf
slot-opts
:setf-vop
(
:generator
1
(
when
setf-function-p
(
storew
value
object
offset
lowtag
)))
(
intern
(
concatenate
'simple-string
"SET-"
(
string
(
cadr
set-trans
)))))))
(
set-vop
(
getf
slot-opts
:set-vop
(
if
setf-vop
nil
set-trans
))))
(
when
ref-vop
(
forms
`
(
define-vop
(
,
ref-vop
,
(
if
rest-p
'slot-ref
'cell-ref
))
(
:variant
,
offset
,
lowtag
)
,@
(
when
ref-trans
`
((
:translate
,
ref-trans
))))))
(
when
(
or
set-vop
setf-vop
)
(
forms
`
(
define-vop
,
(
cond
((
and
rest-p
setf-vop
)
(
error
"Can't automatically generate ~
a setf VOP for :rest-p ~
slots: ~S in ~S"
name
(
primitive-object-name
obj
)))
(
rest-p
`
(
,
set-vop
slot-set
))
((
and
set-vop
setf-function-p
)
(
error
"Setf functions (list ~S) must ~
use :setf-vops."
set-trans
))
(
set-vop
`
(
,
set-vop
cell-set
))
(
setf-function-p
`
(
,
setf-vop
cell-setf-function
))
(
t
`
(
,
setf-vop
cell-setf
)))
(
:variant
,
offset
,
lowtag
)
,@
(
when
set-trans
`
((
:translate
,
set-trans
)))))))))
(
when
(
forms
)
`
(
progn
,@
(
forms
)))))
;;;; Symbol hacking VOPs:
;;;; Symbol hacking VOPs:
;;; The compiler likes to be able to directly SET symbols.
;;;
(
define-vop
(
set
cell-set
)
(
:variant
symbol-value-slot
other-pointer-type
))
;;; Do a cell ref with an error check for being unbound.
;;; Do a cell ref with an error check for being unbound.
;;;
;;;
(
define-vop
(
checked-cell-ref
)
(
define-vop
(
checked-cell-ref
)
...
@@ -125,6 +96,9 @@
...
@@ -125,6 +96,9 @@
;;;; Fdefinition (fdefn) objects.
;;;; Fdefinition (fdefn) objects.
(
define-vop
(
fdefn-function
cell-ref
)
(
:variant
fdefn-function-slot
other-pointer-type
))
(
define-vop
(
safe-fdefn-function
)
(
define-vop
(
safe-fdefn-function
)
(
:args
(
object
:scs
(
descriptor-reg
)
:target
obj-temp
))
(
:args
(
object
:scs
(
descriptor-reg
)
:target
obj-temp
))
(
:results
(
value
:scs
(
descriptor-reg
any-reg
)))
(
:results
(
value
:scs
(
descriptor-reg
any-reg
)))
...
@@ -149,8 +123,7 @@
...
@@ -149,8 +123,7 @@
(
load-type
type
function
(
-
function-pointer-type
))
(
load-type
type
function
(
-
function-pointer-type
))
(
inst
addi
(
-
function-header-type
)
type
type
)
(
inst
addi
(
-
function-header-type
)
type
type
)
(
inst
comb
:=
type
zero-tn
normal-fn
)
(
inst
comb
:=
type
zero-tn
normal-fn
)
(
inst
addi
(
-
(
ash
function-header-code-offset
word-shift
)
(
inst
addi
(
-
(
ash
function-code-offset
word-shift
)
function-pointer-type
)
function-pointer-type
)
function
lip
)
function
lip
)
(
inst
li
(
make-fixup
"closure_tramp"
:foreign
)
lip
)
(
inst
li
(
make-fixup
"closure_tramp"
:foreign
)
lip
)
NORMAL-FN
NORMAL-FN
...
@@ -231,6 +204,23 @@
...
@@ -231,6 +204,23 @@
(
descriptor-reg
any-reg
)
*
%set-funcallable-instance-info
)
(
descriptor-reg
any-reg
)
*
%set-funcallable-instance-info
)
(
define-vop
(
closure-ref
slot-ref
)
(
:variant
closure-info-offset
function-pointer-type
))
(
define-vop
(
closure-init
slot-set
)
(
:variant
closure-info-offset
function-pointer-type
))
;;;; Value Cell hackery.
(
define-vop
(
value-cell-ref
cell-ref
)
(
:variant
value-cell-value-slot
other-pointer-type
))
(
define-vop
(
value-cell-set
cell-set
)
(
:variant
value-cell-value-slot
other-pointer-type
))
;;;; Structure hackery:
;;;; Structure hackery:
...
...
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