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
e3fe869c
Commit
e3fe869c
authored
Aug 25, 1993
by
ram
Browse files
Fix compiler warnings.
parent
af30308e
Changes
24
Hide whitespace changes
Inline
Side-by-side
compiler/array-tran.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.1
6
1993/0
5/12 11:10:18
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.1
7
1993/0
8/25 00:14:32
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -577,4 +577,4 @@
;;;
(
deftransform
bit-not
((
bit-array-1
result-bit-array
)
(
bit-vector
(
constant-argument
t
)))
'
(
bit-not
bit-array-1
bit-array-1
))
)
'
(
bit-not
bit-array-1
bit-array-1
))
compiler/bit-util.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/bit-util.lisp,v 1.
5
1993/08/
12 17:32:09
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/bit-util.lisp,v 1.
6
1993/08/
25 00:14:43
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -16,7 +16,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
(
declaim
(
inline
clear-bit-vector
set-bit-vector
bit-vector-replace
bit-vector-copy
))
...
...
compiler/checkgen.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.2
2
199
2
/0
9/07 15:34:20
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.2
3
199
3
/0
8/25 00:14:48
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -433,7 +433,7 @@
(
what
(
when
(
and
(
combination-p
dest
)
(
eq
(
combination-kind
dest
)
:local
))
(
let
((
lambda
(
combination-lambda
dest
))
(
pos
(
position
cont
(
combination-args
dest
))))
(
pos
(
e
position
cont
(
combination-args
dest
))))
(
format
nil
"~:[A possible~;The~] binding of ~S"
(
and
(
continuation-use
cont
)
(
eq
(
functional-kind
lambda
)
:let
))
...
...
compiler/constraint.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.1
3
199
2
/0
6/03 20:03:37
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.1
4
199
3
/0
8/25 00:14:53
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -16,7 +16,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
(
defstruct
(
constraint
(
:include
sset-element
)
...
...
compiler/control.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/control.lisp,v 1.1
2
1993/0
5/08 00:47:1
7 ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/control.lisp,v 1.1
3
1993/0
8/25 00:14:5
7 ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -22,7 +22,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;; Add-To-Emit-Order -- Interface
...
...
compiler/copyprop.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/copyprop.lisp,v 1.
6
199
1
/0
2
/2
0 14:56:55
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/copyprop.lisp,v 1.
7
199
3
/0
8
/2
5 00:14:58
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;; In copy propagation, we manipulate sets of TNs. We only consider TNs whose
;;; sole write is by a MOVE VOP. This allows us to use a degenerate version of
...
...
compiler/ctype.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.2
6
1993/0
1/14 18:04:00
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.2
7
1993/0
8/25 00:14:59
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;; These are the functions that are to be called when a problem is detected.
;;; They are passed format arguments. If null, we don't do anything. The
...
...
compiler/debug-dump.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.3
7
1993/08/
17 22:38:55
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.3
8
1993/08/
25 00:15:01
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -118,7 +118,7 @@
(
type
hash-table
var-locs
)
(
type
(
or
vop
null
)
vop
))
(
vector-push-extend
(
dpb
(
position
kind
compiled-code-location-kinds
)
(
dpb
(
e
position
kind
compiled-code-location-kinds
)
compiled-code-location-kind-byte
0
)
*byte-buffer*
)
...
...
@@ -667,7 +667,7 @@
(
let
((
options
0
))
(
setf
(
ldb
minimal-debug-function-name-style-byte
options
)
name-rep
)
(
setf
(
ldb
minimal-debug-function-kind-byte
options
)
(
position
(
compiled-debug-function-kind
dfun
)
(
e
position
(
compiled-debug-function-kind
dfun
)
minimal-debug-function-kinds
))
(
setf
(
ldb
minimal-debug-function-returns-byte
options
)
(
etypecase
(
compiled-debug-function-returns
dfun
)
...
...
compiler/entry.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/entry.lisp,v 1.
9
199
1
/0
5/16 00:24:38
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/entry.lisp,v 1.
10
199
3
/0
8/25 00:15:16
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;; Entry-Analyze -- Interface
...
...
compiler/envanal.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.2
4
1993/0
5/13 11:35:26
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.2
5
1993/0
8/25 00:15:19
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -18,7 +18,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;; Environment-Analyze -- Interface
...
...
compiler/eval.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.2
4
1993/08/2
4 23:43:05
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.2
5
1993/08/2
5 00:15:24
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -734,7 +734,7 @@
((
member
,
info
'
(
:multiple
:return
)
:test
#'
eq
)
(
eval-stack-push
(
list
,
value
)))
(
t
(
assert
(
eq
,
info
:single
))
(
eval-stack-push
,
value
))))
))
(
eval-stack-push
,
value
))))
(
defun
maybe-trace-nodes
(
node
)
...
...
compiler/float-tran.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.
19
1993/08/2
1
0
8
:1
6
:2
8
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.
20
1993/08/2
5
0
0
:1
5
:2
9
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -160,7 +160,7 @@
(
defknown
integer-decode-double-float
(
double-float
)
(
values
double-float-significand
double-float-int-exponent
(
integer
-1
1
))
(
movable
foldable
flushable
))
)
(
movable
foldable
flushable
))
(
defknown
scale-single-float
(
single-float
fixnum
)
single-float
(
movable
foldable
flushable
))
...
...
compiler/fndb.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.5
8
1993/08/2
0 18:46
:3
7
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.5
9
1993/08/2
5 00:15
:3
1
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -60,7 +60,7 @@
(
export
'
(
%caller-frame-and-pc
%with-array-data
))
(
in-package
'c
)
(
in-package
"C"
)
;;;; Information for known functions:
...
...
compiler/gtn.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/gtn.lisp,v 1.1
3
199
2
/0
4/01 15:30:08
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/gtn.lisp,v 1.1
4
199
3
/0
8/25 00:15:37
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;; GTN-Analyze -- Interface
...
...
compiler/ir1util.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.7
0
1993/08/2
4
0
2
:1
2:13 wlott
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.7
1
1993/08/2
5
0
0
:1
5:48 ram
Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -1472,7 +1472,7 @@
(
declare
(
type
lambda-var
var
))
(
let
((
fun
(
lambda-var-home
var
)))
(
elt
(
combination-args
(
let-combination
fun
))
(
position
var
(
lambda-vars
fun
)))))
(
e
position
var
(
lambda-vars
fun
)))))
;;; COMBINATION-LAMBDA -- Interface
...
...
@@ -1998,8 +1998,7 @@
(
cerror
"replace form with call to ERROR."
'compiler-error
:format-control
format-string
:format-arguments
format-args
)
(
funcall
*compiler-error-bailout*
)
(
error
"*Compiler-Error-Bailout* returned?"
))
(
funcall
*compiler-error-bailout*
))
;;;
(
defun
compiler-error-message
(
format-string
&rest
format-args
)
(
cerror
"ignore it."
...
...
@@ -2076,106 +2075,6 @@
(
return-from
careful-call
(
values
nil
nil
))))))
t
))
;;;; Generic list (?) functions:
(
proclaim
'
(
inline
find-in
position-in
map-in
))
;;; Find-In -- Interface
;;;
(
defun
find-in
(
next
element
list
&key
(
key
#'
identity
)
(
test
#'
eql
test-p
)
(
test-not
nil
not-p
))
"Find Element in a null-terminated List linked by the accessor function
Next. Key, Test and Test-Not are the same as for generic sequence
functions."
(
when
(
and
test-p
not-p
)
(
error
"Silly to supply both :Test and :Test-Not."
))
(
if
not-p
(
do
((
current
list
(
funcall
next
current
)))
((
null
current
)
nil
)
(
unless
(
funcall
test-not
(
funcall
key
current
)
element
)
(
return
current
)))
(
do
((
current
list
(
funcall
next
current
)))
((
null
current
)
nil
)
(
when
(
funcall
test
(
funcall
key
current
)
element
)
(
return
current
)))))
;;; Position-In -- Interface
;;;
(
defun
position-in
(
next
element
list
&key
(
key
#'
identity
)
(
test
#'
eql
test-p
)
(
test-not
nil
not-p
))
"Return the position of Element (or NIL if absent) in a null-terminated List
linked by the accessor function Next. Key, Test and Test-Not are the same as
for generic sequence functions."
(
when
(
and
test-p
not-p
)
(
error
"Silly to supply both :Test and :Test-Not."
))
(
if
not-p
(
do
((
current
list
(
funcall
next
current
))
(
i
0
(
1+
i
)))
((
null
current
)
nil
)
(
unless
(
funcall
test-not
(
funcall
key
current
)
element
)
(
return
i
)))
(
do
((
current
list
(
funcall
next
current
))
(
i
0
(
1+
i
)))
((
null
current
)
nil
)
(
when
(
funcall
test
(
funcall
key
current
)
element
)
(
return
i
)))))
;;; Map-In -- Interface
;;;
(
defun
map-in
(
next
function
list
)
"Map Function over the elements in a null-terminated List linked by the
accessor function Next, returning a list of the results."
(
collect
((
res
))
(
do
((
current
list
(
funcall
next
current
)))
((
null
current
))
(
res
(
funcall
function
current
)))
(
res
)))
;;; Deletef-In -- Interface
;;;
(
defmacro
deletef-in
(
next
place
item
&environment
env
)
"Deletef-In Next Place Item
Delete Item from a null-terminated list linked by the accessor function Next
that is stored in Place. Item must appear exactly once in the list."
(
multiple-value-bind
(
temps
vals
stores
store
access
)
(
get-setf-method
place
env
)
(
let
((
n-item
(
gensym
))
(
n-place
(
gensym
))
(
n-current
(
gensym
))
(
n-prev
(
gensym
)))
`
(
let*
(
,@
(
mapcar
#'
list
temps
vals
)
(
,
n-place
,
access
)
(
,
n-item
,
item
))
(
if
(
eq
,
n-place
,
n-item
)
(
let
((
,
(
first
stores
)
(
,
next
,
n-place
)))
,
store
)
(
do
((
,
n-prev
,
n-place
,
n-current
)
(
,
n-current
(
,
next
,
n-place
)
(
,
next
,
n-current
)))
((
eq
,
n-current
,
n-item
)
(
setf
(
,
next
,
n-prev
)
(
,
next
,
n-current
)))))
(
undefined-value
)))))
;;; Push-In -- Interface
;;;
(
defmacro
push-in
(
next
item
place
&environment
env
)
"Push Item onto a list linked by the accessor function Next that is stored in
Place."
(
multiple-value-bind
(
temps
vals
stores
store
access
)
(
get-setf-method
place
env
)
`
(
let
(
,@
(
mapcar
#'
list
temps
vals
)
(
,
(
first
stores
)
,
item
))
(
setf
(
,
next
,
(
first
stores
))
,
access
)
,
store
(
undefined-value
))))
;;;; Utilities used at run-time for parsing keyword args in IR1:
...
...
compiler/life.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/life.lisp,v 1.2
1
199
2
/08/
14 15:20:1
9 ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/life.lisp,v 1.2
2
199
3
/08/
25 00:15:5
9 ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -15,7 +15,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;;; Utilities:
...
...
compiler/macros.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.
39
1993/08/2
4
0
2
:1
2:18 wlott
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.
40
1993/08/2
5
0
0
:1
6:09 ram
Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -27,6 +27,10 @@
(
proclaim
'
(
special
*wild-type*
*universal-type*
*compiler-error-context*
))
(
declaim
(
ftype
function
(
setf
dylan::value-datum
)
dylan::find-module
dylan::lookup-varinfo-value
dylan::parse-and-convert
dylan::value-datum
))
;;;; Deftypes:
;;;
...
...
@@ -1106,3 +1110,110 @@
(
setf
(
event-info-count
v
)
0
))
*event-info*
)
(
values
))
;;;; Generic list (?) functions:
(
proclaim
'
(
inline
find-in
position-in
map-in
))
;;; Find-In -- Interface
;;;
(
defun
find-in
(
next
element
list
&key
(
key
#'
identity
)
(
test
#'
eql
test-p
)
(
test-not
nil
not-p
))
"Find Element in a null-terminated List linked by the accessor function
Next. Key, Test and Test-Not are the same as for generic sequence
functions."
(
when
(
and
test-p
not-p
)
(
error
"Silly to supply both :Test and :Test-Not."
))
(
if
not-p
(
do
((
current
list
(
funcall
next
current
)))
((
null
current
)
nil
)
(
unless
(
funcall
test-not
(
funcall
key
current
)
element
)
(
return
current
)))
(
do
((
current
list
(
funcall
next
current
)))
((
null
current
)
nil
)
(
when
(
funcall
test
(
funcall
key
current
)
element
)
(
return
current
)))))
;;; Position-In -- Interface
;;;
(
defun
position-in
(
next
element
list
&key
(
key
#'
identity
)
(
test
#'
eql
test-p
)
(
test-not
nil
not-p
))
"Return the position of Element (or NIL if absent) in a null-terminated List
linked by the accessor function Next. Key, Test and Test-Not are the same as
for generic sequence functions."
(
when
(
and
test-p
not-p
)
(
error
"Silly to supply both :Test and :Test-Not."
))
(
if
not-p
(
do
((
current
list
(
funcall
next
current
))
(
i
0
(
1+
i
)))
((
null
current
)
nil
)
(
unless
(
funcall
test-not
(
funcall
key
current
)
element
)
(
return
i
)))
(
do
((
current
list
(
funcall
next
current
))
(
i
0
(
1+
i
)))
((
null
current
)
nil
)
(
when
(
funcall
test
(
funcall
key
current
)
element
)
(
return
i
)))))
;;; Map-In -- Interface
;;;
(
defun
map-in
(
next
function
list
)
"Map Function over the elements in a null-terminated List linked by the
accessor function Next, returning a list of the results."
(
collect
((
res
))
(
do
((
current
list
(
funcall
next
current
)))
((
null
current
))
(
res
(
funcall
function
current
)))
(
res
)))
;;; Deletef-In -- Interface
;;;
(
defmacro
deletef-in
(
next
place
item
&environment
env
)
"Deletef-In Next Place Item
Delete Item from a null-terminated list linked by the accessor function Next
that is stored in Place. Item must appear exactly once in the list."
(
multiple-value-bind
(
temps
vals
stores
store
access
)
(
get-setf-method
place
env
)
(
let
((
n-item
(
gensym
))
(
n-place
(
gensym
))
(
n-current
(
gensym
))
(
n-prev
(
gensym
)))
`
(
let*
(
,@
(
mapcar
#'
list
temps
vals
)
(
,
n-place
,
access
)
(
,
n-item
,
item
))
(
if
(
eq
,
n-place
,
n-item
)
(
let
((
,
(
first
stores
)
(
,
next
,
n-place
)))
,
store
)
(
do
((
,
n-prev
,
n-place
,
n-current
)
(
,
n-current
(
,
next
,
n-place
)
(
,
next
,
n-current
)))
((
eq
,
n-current
,
n-item
)
(
setf
(
,
next
,
n-prev
)
(
,
next
,
n-current
)))))
(
undefined-value
)))))
;;; Push-In -- Interface
;;;
(
defmacro
push-in
(
next
item
place
&environment
env
)
"Push Item onto a list linked by the accessor function Next that is stored in
Place."
(
multiple-value-bind
(
temps
vals
stores
store
access
)
(
get-setf-method
place
env
)
`
(
let
(
,@
(
mapcar
#'
list
temps
vals
)
(
,
(
first
stores
)
,
item
))
(
setf
(
,
next
,
(
first
stores
))
,
access
)
,
store
(
undefined-value
))))
;;; EPOSITION -- Interface
;;;
(
defmacro
eposition
(
&rest
args
)
`
(
or
(
position
,@
args
)
(
error
"Shouldn't happen?"
)))
compiler/meta-vmdef.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/meta-vmdef.lisp,v 1.
5
1993/08/2
0
00:1
2:39
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/meta-vmdef.lisp,v 1.
6
1993/08/2
5
00:1
6:15
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -720,10 +720,10 @@
(
targets
(
+
(
*
index
max-vop-tn-refs
)
(
ecase
(
operand-parse-kind
target
)
(
:result
(
+
(
position
target
(
vop-parse-results
parse
))
(
+
(
e
position
target
(
vop-parse-results
parse
))
num-args
))
(
:temporary
(
+
(
*
(
position
target
(
vop-parse-temps
parse
))
2
)
(
+
(
*
(
e
position
target
(
vop-parse-temps
parse
))
2
)
num-args
num-results
)))))))
(
let
((
born
(
operand-parse-born
op
))
(
dies
(
operand-parse-dies
op
)))
...
...
compiler/pseudo-vops.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pseudo-vops.lisp,v 1.
7
199
2
/0
6/04 16:13:14
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pseudo-vops.lisp,v 1.
8
199
3
/0
8/25 00:16:28
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -16,7 +16,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;; Notes the place at which the environment is properly initialized, for
...
...
compiler/represent.lisp
View file @
e3fe869c
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/represent.lisp,v 1.3
2
199
2
/0
2
/2
4
0
5:50:28 wlott
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/represent.lisp,v 1.3
3
199
3
/0
8
/2
5
0
0:16:29 ram
Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -18,7 +18,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(
in-package
'c
)
(
in-package
"C"
)
;;;; Error routines:
...
...
Prev
1
2
Next
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