Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
58a3e223
Commit
58a3e223
authored
Aug 03, 1992
by
wlott
Browse files
Removed traces of the old assembler.
parent
aa8b71ad
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/codegen.lisp
View file @
58a3e223
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.1
7
1992/0
5/21 2
2:
4
6:
56
wlott Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.1
8
1992/0
8/03 1
2:
3
6:
01
wlott Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -18,8 +18,12 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'
c
)
(
in-package
:
c
)
(
in-package
:new-assem
)
(
import
'
(
label
gen-label
emit-label
label-position
)
:c
)
(
in-package
:c
)
(
export
'
(
component-header-length
sb-allocated-size
current-nfp-tn
callee-nfp-tn
callee-return-pc-tn
*code-segment*
*elsewhere*
trace-table-entry
pack-trace-table
note-fixup
...
...
@@ -122,13 +126,10 @@
(
defvar
*elsewhere*
nil
)
(
defvar
*elsewhere-label*
nil
)
(
defvar
*assembly-optimize*
t
(
defvar
*assembly-optimize*
nil
"Set to NIL to inhibit assembly-level optimization. For compiler debugging,
rather than policy control."
)
(
defvar
*assembly-check*
nil
"Set to T to enable lifetime consistency checking of the assembly code."
)
;;;; Noise to emit an instruction trace.
...
...
@@ -159,41 +160,18 @@
;;;;
Hooks used to dispatch between the two different assembler
s.
;;;;
Generate-code and support routine
s.
(
defun
make-segment
(
&optional
name
)
(
if
(
backend-featurep
:new-assembler
)
(
new-assem:make-segment
:name
name
:run-scheduler
(
and
*assembly-optimize*
(
policy
(
lambda-bind
(
block-home-lambda
(
block-next
(
component-head
*compile-component*
))))
(
or
(
>=
speed
cspeed
)
(
>=
space
cspeed
))))
:inst-hook
(
if
*compiler-trace-output*
#'
trace-instruction
))
(
assem:make-segment
)))
(
deftype
label
()
'
(
or
new-assem:label
assem:label
))
(
defun
gen-label
()
(
if
(
backend-featurep
:new-assembler
)
(
new-assem:gen-label
)
(
assem:gen-label
)))
(
defun
emit-label
(
label
)
(
if
(
backend-featurep
:new-assembler
)
(
new-assem:emit-label
label
)
(
assem:emit-label
label
)))
(
defun
label-position
(
label
)
(
if
(
backend-featurep
:new-assembler
)
(
new-assem:label-position
label
)
(
assem:label-position
label
)))
;;;; Generate-code and support routines.
(
new-assem:make-segment
:name
name
:run-scheduler
(
and
*assembly-optimize*
(
policy
(
lambda-bind
(
block-home-lambda
(
block-next
(
component-head
*compile-component*
))))
(
or
(
>=
speed
cspeed
)
(
>=
space
cspeed
))))
:inst-hook
(
if
*compiler-trace-output*
#'
trace-instruction
)))
;;; Init-Assembler -- Interface
;;;
...
...
@@ -205,7 +183,7 @@
;;; Generate-Code -- Interface
;;;
(
defun
generate-code
(
component
)
(
when
(
and
*compiler-trace-output*
(
backend-featurep
:new-assembler
))
(
when
*compiler-trace-output*
(
format
*compiler-trace-output*
"~|~%Assembly code for ~S~2%"
component
))
...
...
@@ -214,20 +192,16 @@
(
*prev-segment*
nil
)
(
*prev-vop*
nil
)
(
*fixups*
nil
))
(
when
(
backend-featurep
:new-assembler
)
(
let
((
label
(
new-assem:gen-label
)))
(
setf
*elsewhere-label*
label
)
(
new-assem:assemble
(
*elsewhere*
)
(
new-assem:emit-label
label
))))
(
let
((
label
(
new-assem:gen-label
)))
(
setf
*elsewhere-label*
label
)
(
new-assem:assemble
(
*elsewhere*
)
(
new-assem:emit-label
label
)))
(
do-ir2-blocks
(
block
component
)
(
let
((
1block
(
ir2-block-block
block
)))
(
when
(
and
(
eq
(
block-info
1block
)
block
)
(
block-start
1block
))
(
if
(
backend-featurep
:new-assembler
)
(
new-assem:assemble
(
*code-segment*
)
(
new-assem:emit-label
(
block-label
1block
)))
(
assem:assemble
(
*code-segment*
nil
)
(
assem:emit-label
(
block-label
1block
))))
(
new-assem:assemble
(
*code-segment*
)
(
new-assem:emit-label
(
block-label
1block
)))
(
let
((
env
(
block-environment
1block
)))
(
unless
(
eq
env
prev-env
)
(
let
((
lab
(
gen-label
)))
...
...
@@ -244,38 +218,18 @@
(
format
t
"Missing generator for ~S.~%"
(
template-name
(
vop-info
vop
)))))))
(
cond
((
backend-featurep
:new-assembler
)
(
new-assem:append-segment
*code-segment*
*elsewhere*
)
(
setf
*elsewhere*
nil
)
(
values
(
new-assem:finalize-segment
*code-segment*
)
(
nreverse
*trace-table-info*
)
*fixups*
))
(
t
(
assem:assemble
(
*code-segment*
nil
)
(
assem:insert-segment
*elsewhere*
))
(
assem:expand-pseudo-instructions
*code-segment*
)
(
when
*assembly-check*
(
assem:segment-check-registers
*code-segment*
*elsewhere*
))
(
when
(
and
(
policy
(
lambda-bind
(
block-home-lambda
(
block-next
(
component-head
component
))))
(
or
(
>=
speed
cspeed
)
(
>=
space
cspeed
)))
*assembly-optimize*
)
(
assem:optimize-segment
*code-segment*
))
(
let
((
length
(
assem:finalize-segment
*code-segment*
)))
(
values
length
(
nreverse
*trace-table-info*
)))))))
(
new-assem:append-segment
*code-segment*
*elsewhere*
)
(
setf
*elsewhere*
nil
)
(
values
(
new-assem:finalize-segment
*code-segment*
)
(
nreverse
*trace-table-info*
)
*fixups*
)))
(
defun
emit-label-elsewhere
(
label
)
(
if
(
backend-featurep
:new-assembler
)
(
new-assem:assemble
(
*elsewhere*
)
(
new-assem:emit-label
label
))
(
assem:assemble
(
*elsewhere*
nil
)
(
assem:emit-label
label
))))
(
new-assem:assemble
(
*elsewhere*
)
(
new-assem:emit-label
label
)))
(
defun
label-elsewhere-p
(
label-or-posn
)
(
<=
(
label-position
(
if
(
backend-featurep
:new-assembler
)
*elsewhere-label*
*elsewhere*
))
(
<=
(
label-position
*elsewhere-label*
)
(
etypecase
label-or-posn
(
label
(
label-position
label-or-posn
))
...
...
compiler/dump.lisp
View file @
58a3e223
...
...
@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.4
3
1992/08/0
2
1
9:41:09 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.4
4
1992/08/0
3
1
2:37:12 wlott
Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.4
3
1992/08/0
2
1
9:41:09 ram
Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.4
4
1992/08/0
3
1
2:37:12 wlott
Exp $
;;;
;;; This file contains stuff that knows about dumping FASL files.
;;;
...
...
@@ -502,10 +502,7 @@
(
dump-unsigned-32
total-length
file
))))
(
flush-fasl-file-buffer
file
)
(
if
(
backend-featurep
:new-assembler
)
(
dump-segment
code-segment
code-length
file
)
(
setf
fixups
(
assem:emit-code-vector
(
fasl-file-stream
file
)
code-segment
)))
(
dump-segment
code-segment
code-length
file
)
(
dump-i-vector
trace-table
file
t
)
(
let
((
handle
(
dump-pop
file
)))
(
dump-fixups
handle
fixups
file
)
...
...
@@ -519,14 +516,11 @@
(
dump-fop
'lisp::fop-assembler-code
file
)
(
dump-unsigned-32
length
file
)
(
flush-fasl-file-buffer
file
)
(
if
(
backend-featurep
:new-assembler
)
(
let
((
stream
(
fasl-file-stream
file
)))
(
new-assem:segment-map-output
code-segment
#'
(
lambda
(
sap
amount
)
(
system:output-raw-bytes
stream
sap
0
amount
))))
(
setf
fixups
(
assem:emit-code-vector
(
fasl-file-stream
file
)
code-segment
)))
(
let
((
stream
(
fasl-file-stream
file
)))
(
new-assem:segment-map-output
code-segment
#'
(
lambda
(
sap
amount
)
(
system:output-raw-bytes
stream
sap
0
amount
))))
(
dolist
(
routine
routines
)
(
dump-fop
'lisp::fop-normal-load
file
)
(
let
((
*cold-load-dump*
t
))
...
...
compiler/main.lisp
View file @
58a3e223
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.
69
1992/08/0
2
1
9:40:14 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.
70
1992/08/0
3
1
2:36:11 wlott
Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -286,15 +286,7 @@
(
length
trace-table
fixups
)
(
generate-code
component
)
(
when
(
and
*compiler-trace-output*
(
not
(
backend-featurep
:new-assembler
)))
(
format
*compiler-trace-output*
"~|~%Assembly code for ~S~2%"
component
)
(
assem:dump-segment
*code-segment*
:stream
*compiler-trace-output*
))
(
when
(
and
*compiler-trace-output*
(
backend-featurep
:new-assembler
))
(
when
*compiler-trace-output*
(
format
*compiler-trace-output*
"~|~%Disassembly of code for ~S~2%"
component
)
(
disassem:disassemble-blocks
*code-segment*
...
...
@@ -320,13 +312,10 @@
*compile-object*
))
(
null
))))
(
cond
((
backend-featurep
:new-assembler
)
(
when
*code-segment*
(
new-assem:release-segment
*code-segment*
))
(
when
*elsewhere*
(
new-assem:release-segment
*elsewhere*
)))
(
t
(
assem:nuke-segment
*code-segment*
)))))
(
when
*code-segment*
(
new-assem:release-segment
*code-segment*
))
(
when
*elsewhere*
(
new-assem:release-segment
*elsewhere*
))))
;; We are done, so don't bother keeping anything around.
(
clear-ir2-info
component
)
...
...
compiler/vmdef.lisp
View file @
58a3e223
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/vmdef.lisp,v 1.4
3
1992/0
7/14 03:40:11
wlott Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/vmdef.lisp,v 1.4
4
1992/0
8/03 12:36:24
wlott Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -290,13 +290,9 @@
(
setf
(
svref
(
sc-move-functions
to-sc
)
num
)
',name
)
(
setf
(
svref
(
sc-load-costs
to-sc
)
num
)
',cost
)))))
,
(
if
(
target-featurep
:new-assembler
)
`
(
defun
,
name
,
lambda-list
(
new-assem:assemble
(
*code-segment*
,
(
first
lambda-list
))
,@
body
))
`
(
defun
,
name
,
lambda-list
(
assem:assemble
(
*code-segment*
,
(
first
lambda-list
))
,@
body
)))))
(
defun
,
name
,
lambda-list
(
new-assem:assemble
(
*code-segment*
,
(
first
lambda-list
))
,@
body
))))
(
defconstant
sc-vop-slots
'
((
:move
.
sc-move-vops
)
...
...
@@ -1205,11 +1201,8 @@
,@
(
binds
))
(
declare
(
ignore
,@
(
vop-parse-ignores
parse
)))
,@
(
loads
)
,
(
if
(
target-featurep
:new-assembler
)
`
(
new-assem:assemble
(
*code-segment*
,
n-vop
)
,@
(
vop-parse-body
parse
))
`
(
assem:assemble
(
*code-segment*
,
n-vop
)
,@
(
vop-parse-body
parse
)))
(
new-assem:assemble
(
*code-segment*
,
n-vop
)
,@
(
vop-parse-body
parse
))
,@
(
saves
))))))
...
...
@@ -2463,7 +2456,6 @@
Similar to NOTE-THIS-LOCATION, except the use the location of the next
instruction for the code location, wherever the scheduler decided to put
it."
(
assert
(
backend-featurep
:new-assembler
))
(
new-assem:emit-postit
#'
(
lambda
(
segment
posn
)
(
declare
(
ignore
segment
))
(
note-debug-location
vop
posn
kind
))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment