From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 29 Feb 2016 05:12:57 +0000 (-0800)
Subject: Explicitly specify settability of all parameters.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~89
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a8f09e3f9eb44272e6de00e37bef3c464c19bf23;p=mit-scheme.git

Explicitly specify settability of all parameters.
---

diff --git a/src/runtime/advice.scm b/src/runtime/advice.scm
index 766c4ff10..6ddbd7942 100644
--- a/src/runtime/advice.scm
+++ b/src/runtime/advice.scm
@@ -35,10 +35,11 @@ USA.
 (define (initialize-package!)
   (set! entry-advice-population (make-population))
   (set! exit-advice-population (make-population))
-  (set! advice-continuation (make-parameter #f))
-  (set! the-arguments (make-parameter #f))
-  (set! the-procedure (make-parameter #f))
-  (set! the-result (make-parameter #f)))
+  (set! advice-continuation (make-unsettable-parameter #f))
+  (set! the-arguments (make-unsettable-parameter #f))
+  (set! the-procedure (make-unsettable-parameter #f))
+  (set! the-result (make-unsettable-parameter #f))
+  unspecific)
 
 (define the-arguments)
 (define the-procedure)
diff --git a/src/runtime/debug.scm b/src/runtime/debug.scm
index c5c908235..be2961702 100644
--- a/src/runtime/debug.scm
+++ b/src/runtime/debug.scm
@@ -162,8 +162,8 @@ USA.
   (stack-frame/reductions (dstate/subproblem dstate)))
 
 (define (initialize-package!)
-  (set! *dstate* (make-parameter 'UNBOUND))
-  (set! *port* (make-parameter 'UNBOUND))
+  (set! *dstate* (make-unsettable-parameter 'UNBOUND))
+  (set! *port* (make-unsettable-parameter 'UNBOUND))
   (set!
    command-set
    (make-command-set
diff --git a/src/runtime/dosdir.scm b/src/runtime/dosdir.scm
index 94b3d6593..e5def82be 100644
--- a/src/runtime/dosdir.scm
+++ b/src/runtime/dosdir.scm
@@ -33,7 +33,8 @@ USA.
 (define *expand-directory-prefixes?*)
 
 (define (initialize-package!)
-  (set! *expand-directory-prefixes?* (make-parameter true)))
+  (set! *expand-directory-prefixes?* (make-unsettable-parameter #t))
+  unspecific)
 
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) true sort?)
diff --git a/src/runtime/dragon4.scm b/src/runtime/dragon4.scm
index f98dbec8b..c99c7cc40 100644
--- a/src/runtime/dragon4.scm
+++ b/src/runtime/dragon4.scm
@@ -51,10 +51,10 @@ not much different to numbers within a few orders of magnitude of 1.
 
 (define (initialize-dragon4!)
   (set! param:flonum-unparser-cutoff
-	(make-parameter 'NORMAL
-			(lambda (cutoff)
-			  (guarantee-cutoff-spec cutoff)
-			  cutoff)))
+	(make-settable-parameter 'NORMAL
+				 (lambda (cutoff)
+				   (guarantee-cutoff-spec cutoff)
+				   cutoff)))
   (set! expt-radix
 	(let ((v (make-initialized-vector 310 (lambda (i) (expt 10 i)))))
 	  (lambda (base exponent)
diff --git a/src/runtime/error.scm b/src/runtime/error.scm
index b132d71da..f230122f4 100644
--- a/src/runtime/error.scm
+++ b/src/runtime/error.scm
@@ -778,10 +778,10 @@ USA.
   (memq condition-type:error (%condition-type/generalizations type)))
 
 (define (initialize-package!)
-  (set! param:bound-restarts (make-parameter '()))
-  (set! static-handler-frames (make-parameter '()))
-  (set! dynamic-handler-frames (make-parameter '()))
-  (set! break-on-signals-types (make-parameter '()))
+  (set! param:bound-restarts (make-unsettable-parameter '()))
+  (set! static-handler-frames (make-settable-parameter '()))
+  (set! dynamic-handler-frames (make-unsettable-parameter '()))
+  (set! break-on-signals-types (make-settable-parameter '()))
   (set! param:standard-error-hook (make-settable-parameter #f))
   (set! param:standard-warning-hook (make-settable-parameter #f))
   (set! hook/invoke-condition-handler default/invoke-condition-handler)
diff --git a/src/runtime/infutl.scm b/src/runtime/infutl.scm
index 48ad7a655..465a467cf 100644
--- a/src/runtime/infutl.scm
+++ b/src/runtime/infutl.scm
@@ -37,7 +37,7 @@ USA.
 	  (,lambda-tag:internal-lexpr . LAMBDA)
 	  (,lambda-tag:let . LET)
 	  (,lambda-tag:fluid-let . FLUID-LET)))
-  (set! directory-rewriting-rules (make-parameter '()))
+  (set! directory-rewriting-rules (make-settable-parameter '()))
   (set! wrappers-with-memoized-debugging-info (make-serial-population))
   (add-secondary-gc-daemon! discard-debugging-info!))
 
diff --git a/src/runtime/ntdir.scm b/src/runtime/ntdir.scm
index 4fc60ff49..02ca643e5 100644
--- a/src/runtime/ntdir.scm
+++ b/src/runtime/ntdir.scm
@@ -32,7 +32,8 @@ USA.
 (define *expand-directory-prefixes?*)
 
 (define (initialize-package!)
-  (set! *expand-directory-prefixes?* (make-parameter #t)))
+  (set! *expand-directory-prefixes?* (make-unsettable-parameter #t))
+  unspecific)
 
 (define (directory-read pattern #!optional sort? full?)
   (let ((sort? (if (default-object? sort?) #t sort?))
diff --git a/src/runtime/option.scm b/src/runtime/option.scm
index 9b2732440..5f08f7547 100644
--- a/src/runtime/option.scm
+++ b/src/runtime/option.scm
@@ -94,8 +94,8 @@ USA.
 (define *initial-options-file* #f)
 
 (define (initialize-package!)
-  (set! *options* (make-parameter '()))
-  (set! *parent* (make-parameter initial-load-options)))
+  (set! *options* (make-settable-parameter '()))
+  (set! *parent* (make-settable-parameter initial-load-options)))
 
 (define (dummy-option-loader)
   unspecific)
diff --git a/src/runtime/os2dir.scm b/src/runtime/os2dir.scm
index 10b04bc86..0a25c8056 100644
--- a/src/runtime/os2dir.scm
+++ b/src/runtime/os2dir.scm
@@ -32,7 +32,8 @@ USA.
 (define *expand-directory-prefixes?*)
 
 (define (initialize-package!)
-  (set! *expand-directory-prefixes?* (make-parameter #t)))
+  (set! *expand-directory-prefixes?* (make-unsettable-parameter #t))
+  unspecific)
 
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) #t sort?)
diff --git a/src/runtime/pathnm.scm b/src/runtime/pathnm.scm
index f03504685..cc9a3131f 100644
--- a/src/runtime/pathnm.scm
+++ b/src/runtime/pathnm.scm
@@ -736,7 +736,7 @@ these rules:
   (set! param:default-pathname-defaults (make-param:default-pathname-defaults))
   (param:default-pathname-defaults (make-pathname local-host #f #f #f #f #f))
   (set! library-directory-path
-	(make-parameter
+	(make-unsettable-parameter
 	 (map pathname-as-directory
 	      (vector->list ((ucode-primitive microcode-library-path 0))))))
   unspecific)
diff --git a/src/runtime/pp.scm b/src/runtime/pp.scm
index 117601946..25fcb0c90 100644
--- a/src/runtime/pp.scm
+++ b/src/runtime/pp.scm
@@ -60,8 +60,8 @@ USA.
   (set! param:pp-save-vertical-space? (make-settable-parameter #f))
   (set! param:pp-uninterned-symbols-by-name? (make-settable-parameter #t))
 
-  (set! x-size (make-parameter #f))
-  (set! output-port (make-parameter #f))
+  (set! x-size (make-unsettable-parameter #f))
+  (set! output-port (make-unsettable-parameter #f))
   (set! pp-description (make-generic-procedure 1 'PP-DESCRIPTION))
   (set-generic-procedure-default-generator! pp-description
     (lambda (generic tags)
@@ -73,7 +73,7 @@ USA.
   (set! print-let-expression (special-printer kernel/print-let-expression))
   (set! print-case-expression (special-printer kernel/print-case-expression))
   (set! code-dispatch-list
-	(make-parameter
+	(make-unsettable-parameter
 	 `((COND . ,forced-indentation)
 	   (CASE . ,print-case-expression)
 	   (IF . ,forced-indentation)
@@ -87,8 +87,8 @@ USA.
 	   (DEFINE-INTEGRABLE . ,print-procedure)
 	   (LAMBDA . ,print-procedure)
 	   (NAMED-LAMBDA . ,print-procedure))))
-  (set! dispatch-list (make-parameter (code-dispatch-list)))
-  (set! dispatch-default (make-parameter print-combination))
+  (set! dispatch-list (make-unsettable-parameter (code-dispatch-list)))
+  (set! dispatch-default (make-unsettable-parameter print-combination))
   (set! cocked-object (generate-uninterned-symbol))
   unspecific)
 
@@ -352,7 +352,7 @@ USA.
       (print-node node column depth))))
 
 (define (print-code-node node column depth)
-  (parameterize* (list (cons dispatch-list code-dispatch-list)
+  (parameterize* (list (cons dispatch-list (code-dispatch-list))
 		       (cons dispatch-default print-combination))
     (lambda ()
       (print-node node column depth))))
diff --git a/src/runtime/prgcop.scm b/src/runtime/prgcop.scm
index d80984128..6ec6c70fd 100644
--- a/src/runtime/prgcop.scm
+++ b/src/runtime/prgcop.scm
@@ -33,8 +33,8 @@ USA.
   (object-new-type primitive-object-new-type 2))
 
 (define (initialize-package!)
-  (set! *copy-constants?* (make-parameter 'UNBOUND))
-  (set! *object-copies* (make-parameter 'UNBOUND))
+  (set! *copy-constants?* (make-unsettable-parameter 'UNBOUND))
+  (set! *object-copies* (make-unsettable-parameter 'UNBOUND))
   (set! copier/scode-walker
 	(make-scode-walker
 	 copy-constant
diff --git a/src/runtime/savres.scm b/src/runtime/savres.scm
index 0f9c13faa..bafc97e31 100644
--- a/src/runtime/savres.scm
+++ b/src/runtime/savres.scm
@@ -45,7 +45,7 @@ USA.
 (define *within-restore-window?*)
 
 (define (initialize-package!)
-  (set! *within-restore-window?* (make-parameter #f)))
+  (set! *within-restore-window?* (make-unsettable-parameter #f)))
 
 (define (disk-save filename #!optional id)
   (let ((filename (->namestring (merge-pathnames filename)))
diff --git a/src/runtime/stack-sample.scm b/src/runtime/stack-sample.scm
index daa4f28c9..68cf21987 100644
--- a/src/runtime/stack-sample.scm
+++ b/src/runtime/stack-sample.scm
@@ -84,7 +84,7 @@
 (define event-return-address 'UNINITIALIZED)
 
 (define (initialize-package!)
-  (set! stack-sampling-return-address (make-parameter #f))
+  (set! stack-sampling-return-address (make-unsettable-parameter #f))
   (let ((blocked? (block-thread-events)))
     (signal-thread-event (current-thread)
       (lambda ()
diff --git a/src/runtime/structure-parser.scm b/src/runtime/structure-parser.scm
index ba54f28fc..e2b0d1895 100644
--- a/src/runtime/structure-parser.scm
+++ b/src/runtime/structure-parser.scm
@@ -786,7 +786,8 @@ USA.
 (define name-counters)
 
 (define (initialize-package!)
-  (set! name-counters (make-parameter unspecific)))
+  (set! name-counters (make-unsettable-parameter unspecific))
+  unspecific)
 
 ;;;; Optimizer
 
diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index 10ee4025e..24f7051be 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -316,10 +316,10 @@ USA.
 
 (define repl-port-type)
 (define (initialize-package!)
-  (set! *top-level-restart* (make-parameter unspecific))
-  (set! *sldb-state* (make-parameter #f))
-  (set! *index* (make-parameter unspecific))
-  (set! *buffer-pstring* (make-parameter unspecific))
+  (set! *top-level-restart* (make-unsettable-parameter unspecific))
+  (set! *sldb-state* (make-unsettable-parameter #f))
+  (set! *index* (make-unsettable-parameter unspecific))
+  (set! *buffer-pstring* (make-unsettable-parameter unspecific))
   (set! repl-port-type
 	(make-port-type
 	 `((WRITE-CHAR
diff --git a/src/runtime/syntax-output.scm b/src/runtime/syntax-output.scm
index 7b9f879bf..e4a752909 100644
--- a/src/runtime/syntax-output.scm
+++ b/src/runtime/syntax-output.scm
@@ -404,7 +404,7 @@ USA.
 (define *rename-database*)
 
 (define (initialize-package!)
-  (set! *rename-database* (make-parameter 'UNBOUND)))
+  (set! *rename-database* (make-unsettable-parameter 'UNBOUND)))
 
 (define-structure (rename-database (constructor initial-rename-database ())
 				   (conc-name rename-database/))
diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index f86953c08..bd4eb666d 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -126,7 +126,7 @@ USA.
 
 (define (initialize-high!)
   ;; Called later in the cold load, when more of the runtime is initialized.
-  (set! root-continuation-default (make-parameter #f))
+  (set! root-continuation-default (make-unsettable-parameter #f))
   (initialize-error-conditions!)
   (reset-threads-high!)
   (record-start-times! first-running-thread)
diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm
index 7c7e3aa3b..bffb670f2 100644
--- a/src/runtime/unsyn.scm
+++ b/src/runtime/unsyn.scm
@@ -30,7 +30,7 @@ USA.
 (declare (usual-integrations))
 
 (define (initialize-package!)
-  (set! substitutions (make-parameter '()))
+  (set! substitutions (make-unsettable-parameter '()))
   (set! unsyntaxer/scode-walker
 	(make-scode-walker unsyntax-constant
 			   `((ACCESS ,unsyntax-ACCESS-object)
diff --git a/src/runtime/unxdir.scm b/src/runtime/unxdir.scm
index 198b580d1..f7b59c0a6 100644
--- a/src/runtime/unxdir.scm
+++ b/src/runtime/unxdir.scm
@@ -32,7 +32,8 @@ USA.
 (define *expand-directory-prefixes?*)
 
 (define (initialize-package!)
-  (set! *expand-directory-prefixes?* (make-parameter true)))
+  (set! *expand-directory-prefixes?* (make-unsettable-parameter #t))
+  unspecific)
 
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) true sort?)
diff --git a/src/runtime/usrint.scm b/src/runtime/usrint.scm
index 0dbae5f70..f37b505e2 100644
--- a/src/runtime/usrint.scm
+++ b/src/runtime/usrint.scm
@@ -499,7 +499,7 @@ USA.
 (define wrapped-notification-port-type)
 
 (define (initialize-package!)
-  (set! *notification-depth* (make-parameter 0))
+  (set! *notification-depth* (make-unsettable-parameter 0))
   (set! indentation-atom "  ")
   (set! wrapped-notification-port-type (make-wrapped-notification-port-type))
   unspecific)
\ No newline at end of file