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
28fa103f
Commit
28fa103f
authored
34 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Emit trace table entries for function prologues/epilogues and call sites.
parent
f5f5e02e
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/mips/call.lisp
+35
-13
35 additions, 13 deletions
compiler/mips/call.lisp
with
35 additions
and
13 deletions
compiler/mips/call.lisp
+
35
−
13
View file @
28fa103f
...
...
@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.3
7
1991/0
2
/20
15:14:17 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.3
8
1991/0
3
/20
03:07:01 wlott
Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.3
7
1991/0
2
/20
15:14:17 ram
Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.3
8
1991/0
3
/20
03:07:01 wlott
Exp $
;;;
;;; This file contains the VM definition of function call for the MIPS.
;;;
...
...
@@ -176,6 +176,7 @@
;; Make sure the function is aligned, and drop a label pointing to this
;; function header.
(
align
vm:lowtag-bits
)
(
trace-table-entry
trace-table-function-prologue
)
(
emit-label
start-lab
)
;; Allocate function header.
(
inst
function-header-word
)
...
...
@@ -193,20 +194,23 @@
(
when
nfp
(
inst
addu
nsp-tn
nsp-tn
(
-
(
bytes-needed-for-non-descriptor-stack-frame
)))
(
move
nfp
nsp-tn
)))))
(
move
nfp
nsp-tn
)))
(
trace-table-entry
trace-table-normal
)))
(
define-vop
(
allocate-frame
)
(
:results
(
res
:scs
(
any-reg
))
(
nfp
:scs
(
any-reg
)))
(
:info
callee
)
(
:generator
2
(
trace-table-entry
trace-table-function-prologue
)
(
move
res
csp-tn
)
(
inst
addu
csp-tn
csp-tn
(
*
vm:word-bytes
(
sb-allocated-size
'control-stack
)))
(
when
(
ir2-environment-number-stack-p
callee
)
(
inst
addu
nsp-tn
nsp-tn
(
-
(
bytes-needed-for-non-descriptor-stack-frame
)))
(
move
nfp
nsp-tn
))))
(
move
nfp
nsp-tn
))
(
trace-table-entry
trace-table-normal
)))
;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
;;; is the number of arguments passed. If no stack arguments are passed, then
...
...
@@ -343,13 +347,15 @@ default-value-8
(
let
((
defaults
(
defaults
)))
(
when
defaults
(
assemble
(
*elsewhere*
)
(
trace-table-entry
trace-table-call-site
)
(
do
((
remaining
defaults
(
cdr
remaining
)))
((
null
remaining
))
(
let
((
def
(
car
remaining
)))
(
emit-label
(
car
def
))
(
when
(
null
(
cdr
remaining
))
(
inst
b
defaulting-done
))
(
store-stack-tn
(
cdr
def
)
null-tn
))))))))))
(
store-stack-tn
(
cdr
def
)
null-tn
)))
(
trace-table-entry
trace-table-normal
))))))))
(
undefined-value
))
...
...
@@ -391,6 +397,7 @@ default-value-8
(
emit-label
done
)
(
assemble
(
*elsewhere*
)
(
trace-table-entry
trace-table-call-site
)
(
emit-label
variable-values
)
(
inst
compute-code-from-lra
code-tn
code-tn
lra-label
temp
)
(
do
((
arg
register-arg-tns
(
rest
arg
))
...
...
@@ -400,7 +407,8 @@ default-value-8
(
move
start
args
)
(
move
count
nargs
)
(
inst
b
done
)
(
inst
nop
)))
(
inst
nop
)
(
trace-table-entry
trace-table-normal
)))
(
undefined-value
))
...
...
@@ -456,6 +464,7 @@ default-value-8
(
:temporary
(
:sc
any-reg
:offset
old-fp-offset
:from
:eval
)
ocfp
)
(
:ignore
arg-locs
args
ocfp
)
(
:generator
5
(
trace-table-entry
trace-table-call-site
)
(
let
((
label
(
gen-label
))
(
cur-nfp
(
current-nfp-tn
vop
)))
(
when
cur-nfp
...
...
@@ -472,7 +481,8 @@ default-value-8
(
note-this-location
vop
:unknown-return
)
(
default-unknown-values
values
nvals
move-temp
temp
label
)
(
when
cur-nfp
(
load-stack-tn
cur-nfp
nfp-save
)))))
(
load-stack-tn
cur-nfp
nfp-save
)))
(
trace-table-entry
trace-table-normal
)))
;;; Non-TR local call for a variable number of return values passed according
...
...
@@ -494,6 +504,7 @@ default-value-8
(
:vop-var
vop
)
(
:temporary
(
:sc
control-stack
:offset
nfp-save-offset
)
nfp-save
)
(
:generator
20
(
trace-table-entry
trace-table-call-site
)
(
let
((
label
(
gen-label
))
(
cur-nfp
(
current-nfp-tn
vop
)))
(
when
cur-nfp
...
...
@@ -510,7 +521,8 @@ default-value-8
(
note-this-location
vop
:unknown-return
)
(
receive-unknown-values
values-start
nvals
start
count
label
temp
)
(
when
cur-nfp
(
load-stack-tn
cur-nfp
nfp-save
)))))
(
load-stack-tn
cur-nfp
nfp-save
)))
(
trace-table-entry
trace-table-normal
)))
;;;; Local call with known values return:
...
...
@@ -535,6 +547,7 @@ default-value-8
(
:temporary
(
:sc
control-stack
:offset
nfp-save-offset
)
nfp-save
)
(
:temporary
(
:scs
(
non-descriptor-reg
))
temp
)
(
:generator
5
(
trace-table-entry
trace-table-call-site
)
(
let
((
label
(
gen-label
))
(
cur-nfp
(
current-nfp-tn
vop
)))
(
when
cur-nfp
...
...
@@ -550,7 +563,8 @@ default-value-8
(
emit-return-pc
label
)
(
note-this-location
vop
:known-return
)
(
when
cur-nfp
(
load-stack-tn
cur-nfp
nfp-save
)))))
(
load-stack-tn
cur-nfp
nfp-save
)))
(
trace-table-entry
trace-table-normal
)))
;;; Return from known values call. We receive the return locations as
;;; arguments to terminate their lifetimes in the returning function. We
...
...
@@ -572,6 +586,7 @@ default-value-8
(
:ignore
val-locs
vals
)
(
:vop-var
vop
)
(
:generator
6
(
trace-table-entry
trace-table-function-epilogue
)
(
maybe-load-stack-tn
old-fp-temp
old-fp
)
(
maybe-load-stack-tn
return-pc-temp
return-pc
)
(
move
csp-tn
fp-tn
)
...
...
@@ -581,7 +596,8 @@ default-value-8
(
bytes-needed-for-non-descriptor-stack-frame
))))
(
inst
addu
lip
return-pc-temp
(
-
vm:word-bytes
vm:other-pointer-type
))
(
inst
j
lip
)
(
move
fp-tn
old-fp-temp
)))
(
move
fp-tn
old-fp-temp
)
(
trace-table-entry
trace-table-normal
)))
;;;; Full call:
...
...
@@ -712,6 +728,7 @@ default-value-8
(
if
(
eq
return
:tail
)
0
10
)
15
(
if
(
eq
return
:unknown
)
25
0
))
(
trace-table-entry
trace-table-call-site
)
(
let*
((
cur-nfp
(
current-nfp-tn
vop
))
,@
(
unless
(
eq
return
:tail
)
'
((
lra-label
(
gen-label
))))
...
...
@@ -841,7 +858,8 @@ default-value-8
lra-label
temp
)
(
when
cur-nfp
(
load-stack-tn
cur-nfp
nfp-save
))))
(
:tail
))))))
(
:tail
)))
(
trace-table-entry
trace-table-normal
))))
(
define-full-call
call
nil
:fixed
nil
)
...
...
@@ -926,6 +944,7 @@ default-value-8
(
:vop-var
vop
)
(
:generator
6
;; Clear the number stack.
(
trace-table-entry
trace-table-function-epilogue
)
(
let
((
cur-nfp
(
current-nfp-tn
vop
)))
(
when
cur-nfp
(
inst
addu
nsp-tn
cur-nfp
...
...
@@ -949,7 +968,8 @@ default-value-8
(
dolist
(
reg
(
subseq
(
list
a0
a1
a2
a3
a4
a5
)
nvals
))
(
move
reg
null-tn
)))
;; And away we go.
(
lisp-return
return-pc
lip
)))))
(
lisp-return
return-pc
lip
)))
(
trace-table-entry
trace-table-normal
)))
;;; Do unknown-values return of an arbitrary number of values (passed on the
;;; stack.) We check for the common case of a single return value, and do that
...
...
@@ -973,6 +993,7 @@ default-value-8
(
:vop-var
vop
)
(
:generator
13
(
trace-table-entry
trace-table-function-epilogue
)
(
let
((
not-single
(
gen-label
)))
;; Clear the number stack.
(
let
((
cur-nfp
(
current-nfp-tn
vop
)))
...
...
@@ -997,7 +1018,8 @@ default-value-8
(
move
vals
vals-arg
)
(
move
nvals
nvals-arg
)
(
inst
j
(
make-fixup
'return-multiple
:assembly-routine
))
(
inst
nop
))))
(
inst
nop
))
(
trace-table-entry
trace-table-normal
)))
...
...
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