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
1f61eea3
Commit
1f61eea3
authored
32 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Implemented EMIT-POSTIT, which is needed by NOTE-NEXT-INSTRUCTION.
parent
2e1000e0
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/new-assem.lisp
+45
-6
45 additions, 6 deletions
compiler/new-assem.lisp
with
45 additions
and
6 deletions
compiler/new-assem.lisp
+
45
−
6
View file @
1f61eea3
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/new-assem.lisp,v 1.
1
1992/05/
1
8
17:56:10
wlott Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/new-assem.lisp,v 1.
2
1992/05/
2
8
23:40:49
wlott Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -17,7 +17,7 @@
;;;
(
in-package
:new-assem
)
(
export
'
(
emit-byte
emit-skip
emit-back-patch
emit-chooser
(
export
'
(
emit-byte
emit-skip
emit-back-patch
emit-chooser
emit-postit
define-emitter
define-instruction
define-instruction-macro
def-assembler-params
...
...
@@ -154,6 +154,9 @@
;;
;; *** State used by the scheduler during instruction queueing.
;;
;; List of postit's. These are accumulated between instructions.
(
postits
nil
:type
list
)
;;
;; A-lists mapping locations to the instruction that reads them and
;; instructions that write them. If maintaining these as a-lists is
;; too expensive (consing, time, or whatever) we could represent this
...
...
@@ -859,14 +862,18 @@
(
setf
(
segment-block-end
segment
)
(
system:int-sap
0
))
(
ext:undefined-value
))
;;; EMIT-LABEL -- internal.
;;;
%
EMIT-LABEL -- internal.
;;;
;;; EMIT-LABEL (the interface) basically just expands into this, supplying
;;; the segment.
;;; the segment
and vop
.
;;;
(
defun
%emit-label
(
segment
vop
label
)
(
when
(
segment-run-scheduler
segment
)
(
schedule-pending-instructions
segment
))
(
let
((
postits
(
segment-postits
segment
)))
(
setf
(
segment-postits
segment
)
nil
)
(
dolist
(
postit
postits
)
(
emit-back-patch
segment
0
postit
)))
(
let
((
hook
(
segment-inst-hook
segment
)))
(
when
hook
(
funcall
hook
segment
vop
:label
label
)))
...
...
@@ -925,6 +932,16 @@
(
when
(
logbitp
i
offset
)
(
return
i
))))
;;; EMIT-POSTIT -- Internal.
;;;
;;; Emit a postit. The function will be called as a back-patch with the
;;; position the following instruction is finally emitted. Postits do not
;;; interfere at all with scheduling.
;;;
(
defun
%emit-postit
(
segment
function
)
(
push
function
(
segment-postits
segment
))
(
ext:undefined-value
))
;;;; Output compression/position assignment stuff
...
...
@@ -1173,6 +1190,11 @@
"Emit LABEL at this location in the current segment."
`
(
%emit-label
*current-segment*
*current-vop*
,
label
))
;;; EMIT-POSTIT -- interface.
;;;
(
defmacro
emit-postit
(
function
)
`
(
%emit-postit
*current-segment*
,
function
))
;;; ALIGN -- interface.
;;;
(
defmacro
align
(
bits
)
...
...
@@ -1194,6 +1216,12 @@
(
defun
append-segment
(
segment
other-segment
)
"Append OTHER-SEGMENT to the end of SEGMENT. Don't use OTHER-SEGMENT
for anything after this."
(
when
(
segment-run-scheduler
segment
)
(
schedule-pending-instructions
segment
))
(
let
((
postits
(
segment-postits
segment
)))
(
setf
(
segment-postits
segment
)
(
segment-postits
other-segment
))
(
dolist
(
postit
postits
)
(
emit-back-patch
segment
0
postit
)))
(
emit-alignment
segment
nil
max-alignment
)
(
let
((
offset-in-last-block
(
rem
(
segment-current-index
segment
)
output-block-size
)))
...
...
@@ -1235,6 +1263,10 @@
covered by this segment."
(
when
(
segment-run-scheduler
segment
)
(
schedule-pending-instructions
segment
))
(
let
((
postits
(
segment-postits
segment
)))
(
setf
(
segment-postits
segment
)
nil
)
(
dolist
(
postit
postits
)
(
emit-back-patch
segment
0
postit
)))
(
setf
(
segment-final-index
segment
)
(
segment-current-index
segment
))
(
setf
(
segment-final-posn
segment
)
(
segment-current-posn
segment
))
(
setf
(
segment-inst-hook
segment
)
nil
)
...
...
@@ -1453,6 +1485,7 @@
(
defmacro
define-instruction
(
name
lambda-list
&rest
options
)
(
let*
((
sym-name
(
symbol-name
name
))
(
defun-name
(
ext:symbolicate
sym-name
"-INST-EMITTER"
))
(
postits
(
gensym
"POSTITS-"
))
(
emitter
nil
)
(
decls
nil
)
(
attributes
nil
)
...
...
@@ -1501,6 +1534,9 @@
(
funcall
hook
,
segment-name
,
vop-name
,
sym-name
,
arg-reconstructor
)))
emitter
)
(
push
`
(
dolist
(
postit
,
postits
)
(
emit-back-patch
,
segment-name
0
postit
))
emitter
)
(
when
(
assem-params-scheduler-p
(
c:backend-assembler-params
c:*target-backend*
))
(
if
pinned
...
...
@@ -1526,8 +1562,11 @@
(
defun
,
defun-name
,
new-lambda-list
,@
(
when
decls
`
((
declare
,@
decls
)))
(
symbol-macrolet
((
*current-segment*
,
segment-name
))
,@
emitter
)
(
let
((
,
postits
(
segment-postits
,
segment-name
)))
(
setf
(
segment-postits
,
segment-name
)
nil
)
(
symbol-macrolet
((
*current-segment*
,
segment-name
)
(
*current-vop*
,
vop-name
))
,@
emitter
))
(
ext:undefined-value
))
(
eval-when
(
compile
load
eval
)
(
%define-instruction
,
sym-name
',defun-name
))))))
...
...
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