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
646ebee6
Commit
646ebee6
authored
33 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Added NEW-BACKEND for use with cross-compiling. Some tweeks to package
state dumping.
parent
85028b44
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
tools/setup.lisp
+79
-9
79 additions, 9 deletions
tools/setup.lisp
with
79 additions
and
9 deletions
tools/setup.lisp
+
79
−
9
View file @
646ebee6
...
@@ -17,8 +17,9 @@
...
@@ -17,8 +17,9 @@
(
let
((
nicks
(
package-nicknames
pkg
))
(
let
((
nicks
(
package-nicknames
pkg
))
(
name
(
package-name
pkg
))
(
name
(
package-name
pkg
))
(
shad
(
package-shadowing-symbols
pkg
)))
(
shad
(
package-shadowing-symbols
pkg
)))
(
forms
`
(
unless
(
find-package
,
name
)
(
forms
`
(
if
(
find-package
,
name
)
(
make-package
,
name
:nicknames
',nicks
:use
nil
)))
(
rename-package
,
name
,
name
',nicks
)
(
make-package
,
name
:nicknames
',nicks
:use
nil
)))
(
when
shad
(
when
shad
(
forms
`
(
shadow
',
(
mapcar
#'
string
shad
)
,
name
)))))
(
forms
`
(
shadow
',
(
mapcar
#'
string
shad
)
,
name
)))))
...
@@ -45,13 +46,25 @@
...
@@ -45,13 +46,25 @@
(
pushnew
name
(
gethash
pkg
imports
)
:test
#'
string=
))
(
pushnew
name
(
gethash
pkg
imports
)
:test
#'
string=
))
(
when
(
eq
how
:external
)
(
when
(
eq
how
:external
)
(
exports
name
)))))))
(
exports
name
)))))))
(
forms
`
(
defpackage
,
(
package-name
old
)
(
collect
((
import-froms
))
,@
(
loop
for
pkg
being
each
hash-key
in
imports
(
maphash
#'
(
lambda
(
pkg
raw-names
)
for
names
being
each
hash-value
in
imports
(
let
((
names
(
sort
(
delete-duplicates
raw-names
collect
`
(
:import-from
,
(
package-name
pkg
)
:test
,@
names
))
#'
string=
)
,@
(
when
(
exports
)
#'
string<
))
`
((
:export
,@
(
exports
)))))))))
(
pkg-name
(
package-name
pkg
)))
(
when
names
(
import-froms
`
(
:import-from
,
pkg-name
,@
names
))
(
dolist
(
name
names
)
(
forms
`
(
intern
,
name
,
pkg-name
))))))
imports
)
(
forms
`
(
defpackage
,
(
package-name
old
)
,@
(
import-froms
)
,@
(
when
(
exports
)
`
((
:export
,@
(
sort
(
delete-duplicates
(
exports
)
:test
#'
string=
)
#'
string<
))))))))))
(
with-open-file
(
s
file
:direction
:output
:if-exists
:new-version
)
(
with-open-file
(
s
file
:direction
:output
:if-exists
:new-version
)
(
dolist
(
form
(
forms
))
(
dolist
(
form
(
forms
))
...
@@ -114,6 +127,63 @@
...
@@ -114,6 +127,63 @@
(
export
nsym
new
)))))))))))))
(
export
nsym
new
)))))))))))))
(
values
))
(
values
))
;;;; NEW-BACKEND
(
defparameter
machine-specific-features
'
(
:small
:mach
:sunos
:unix
:pmax
:decstation-3100
:ibm-pc-rt
:ibmrt
:rt
:SPARCstation
:sparc
:sun4
))
(
defun
new-backend
(
name
&rest
features
)
;; If VM names a different package, rename that package so that VM doesn't
;; name it.
(
let*
((
pkg
(
find-package
"VM"
))
(
pkg-name
(
package-name
pkg
)))
(
unless
(
string=
pkg-name
name
)
(
rename-package
pkg
pkg-name
(
remove
"VM"
(
package-nicknames
pkg
)
:test
#'
string=
))
(
unuse-package
pkg
"C"
)))
;; Make sure VM names our package, creating it if necessary.
(
let*
((
pkg
(
or
(
find-package
name
)
(
make-package
name
:nicknames
'
(
"VM"
))))
(
nicknames
(
package-nicknames
pkg
)))
(
unless
(
member
"VM"
nicknames
:test
#'
string=
)
(
rename-package
pkg
name
(
cons
"VM"
nicknames
)))
;; And make sure we are using the necessary packages.
(
use-package
"C"
pkg
)
(
use-package
"ASSEM"
pkg
)
(
use-package
"EXT"
pkg
)
(
use-package
"KERNEL"
pkg
)
(
use-package
"SYSTEM"
pkg
)
(
use-package
"ALIEN"
pkg
)
(
use-package
"C-CALL"
pkg
))
;; Make sure the native info env and features list are stored in
;; *native-backend*
(
unless
(
c:backend-info-environment
c:*native-backend*
)
(
setf
(
c:backend-info-environment
c:*native-backend*
)
*info-environment*
))
(
unless
(
c:backend-features
c:*native-backend*
)
(
setf
(
c:backend-features
c:*native-backend*
)
*features*
))
;; Cons up a backend structure, filling in the info-env and features slots.
(
let
((
backend
(
c::make-backend
:name
name
:info-environment
(
cons
(
c::make-info-environment
:name
(
concatenate
'string
name
" backend"
))
(
remove-if
#'
(
lambda
(
name
)
(
let
((
len
(
length
name
)))
(
and
(
>
len
8
)
(
string=
name
" backend"
:start1
(
-
len
8
)))))
*info-environment*
:key
#'
c::info-env-name
))
:features
(
append
features
(
set-difference
*features*
machine-specific-features
)))))
(
setf
c:*target-backend*
backend
)))
;;;; Compile utility:
;;;; Compile utility:
...
...
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