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
41144bbe
Commit
41144bbe
authored
33 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Only allow dumping of structures that have been explicitly allowed.
parent
66ef3ec2
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/dump.lisp
+33
-7
33 additions, 7 deletions
compiler/dump.lisp
with
33 additions
and
7 deletions
compiler/dump.lisp
+
33
−
7
View file @
41144bbe
...
@@ -7,11 +7,11 @@
...
@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
;;;
(
ext:file-comment
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.3
4
1991/1
1/24 23:00:39
wlott Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.3
5
1991/1
2/14 18:12:00
wlott Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.3
4
1991/1
1/24 23:00:39
wlott Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.3
5
1991/1
2/14 18:12:00
wlott Exp $
;;;
;;;
;;; This file contains stuff that knows about dumping FASL files.
;;; This file contains stuff that knows about dumping FASL files.
;;;
;;;
...
@@ -88,8 +88,11 @@
...
@@ -88,8 +88,11 @@
;;
;;
;; Except with list objects, the key and the value are always the same. In a
;; Except with list objects, the key and the value are always the same. In a
;; list, the key will be some tail of the value.
;; list, the key will be some tail of the value.
(
circularity-table
(
make-hash-table
:test
#'
eq
)
:type
hash-table
))
(
circularity-table
(
make-hash-table
:test
#'
eq
)
:type
hash-table
)
;;
;; Hash table of structures that are allowed to be dumped. If we try to
;; dump a structure that isn't in this hash table, we lose.
(
valid-structures
(
make-hash-table
:test
#'
eq
)
:type
hash-table
))
;;; This structure holds information about a circularity.
;;; This structure holds information about a circularity.
;;;
;;;
...
@@ -125,6 +128,11 @@
...
@@ -125,6 +128,11 @@
;;;
;;;
(
defvar
*cold-load-dump*
nil
)
(
defvar
*cold-load-dump*
nil
)
;;; Used to turn off the structure validation during dumping of source info.
;;;
(
defvar
*dump-only-valid-structures*
t
)
;;;; Utilities:
;;;; Utilities:
...
@@ -458,7 +466,8 @@
...
@@ -458,7 +466,8 @@
(
dump-fop
'lisp::fop-misc-trap
file
)))))
(
dump-fop
'lisp::fop-misc-trap
file
)))))
;; Dump the debug info.
;; Dump the debug info.
(
let
((
info
(
debug-info-for-component
component
)))
(
let
((
info
(
debug-info-for-component
component
))
(
*dump-only-valid-structures*
nil
))
(
dump-object
info
file
)
(
dump-object
info
file
)
(
let
((
info-handle
(
dump-pop
file
)))
(
let
((
info-handle
(
dump-pop
file
)))
(
dump-push
info-handle
file
)
(
dump-push
info-handle
file
)
...
@@ -634,7 +643,8 @@
...
@@ -634,7 +643,8 @@
;;;
;;;
(
defun
fasl-dump-source-info
(
info
file
)
(
defun
fasl-dump-source-info
(
info
file
)
(
declare
(
type
source-info
info
)
(
type
fasl-file
file
))
(
declare
(
type
source-info
info
)
(
type
fasl-file
file
))
(
let
((
res
(
debug-source-for-info
info
)))
(
let
((
res
(
debug-source-for-info
info
))
(
*dump-only-valid-structures*
nil
))
(
dump-object
res
file
)
(
dump-object
res
file
)
(
let
((
res-handle
(
dump-pop
file
)))
(
let
((
res-handle
(
dump-pop
file
)))
(
dolist
(
info-handle
(
fasl-file-debug-info
file
))
(
dolist
(
info-handle
(
fasl-file-debug-info
file
))
...
@@ -790,7 +800,10 @@
...
@@ -790,7 +800,10 @@
;;; if it's in the EQ table.
;;; if it's in the EQ table.
;;;
;;;
(
defun
fasl-constant-already-dumped
(
constant
file
)
(
defun
fasl-constant-already-dumped
(
constant
file
)
(
if
(
gethash
constant
(
fasl-file-eq-table
file
))
t
nil
))
(
if
(
or
(
gethash
constant
(
fasl-file-eq-table
file
))
(
gethash
constant
(
fasl-file-valid-structures
file
)))
t
nil
))
;;; FASL-NOTE-HANDLE-FOR-CONSTANT -- interface.
;;; FASL-NOTE-HANDLE-FOR-CONSTANT -- interface.
;;;
;;;
...
@@ -804,6 +817,15 @@
...
@@ -804,6 +817,15 @@
(
setf
(
gethash
constant
table
)
handle
))
(
setf
(
gethash
constant
table
)
handle
))
(
undefined-value
))
(
undefined-value
))
;;; FASL-VALIDATE-STRUCTURE -- interface.
;;;
;;; Note that the specified structure can just be dumped by enumerating the
;;; slots.
;;;
(
defun
fasl-validate-structure
(
structure
file
)
(
setf
(
gethash
structure
(
fasl-file-valid-structures
file
))
t
)
(
undefined-value
))
;;;; Number Dumping:
;;;; Number Dumping:
...
@@ -1235,6 +1257,10 @@
...
@@ -1235,6 +1257,10 @@
;;; Dump a structure.
;;; Dump a structure.
(
defun
dump-structure
(
struct
file
)
(
defun
dump-structure
(
struct
file
)
(
when
*dump-only-valid-structures*
(
unless
(
gethash
struct
(
fasl-file-valid-structures
file
))
(
error
"Attempt to dump invalid structure:~% ~S~%How did this happen?"
struct
)))
(
note-potential-circularity
struct
file
)
(
note-potential-circularity
struct
file
)
(
do
((
index
0
(
1+
index
))
(
do
((
index
0
(
1+
index
))
(
length
(
structure-length
struct
))
(
length
(
structure-length
struct
))
...
...
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