FSET only can work specially when it is a toplevel form

src/CHANGELOG

@@ -1,98 +1,10 @@
-ECL 13.5.1
+ECL 13.7.1
 ==========
 
-* Visible changes:
+* Errors fixed:
 
-- ECL now reports #+UNIX for all compatible systems, including *BSD ones.
-
-* Compiler fixes:
-
-- Minor readability improvements in the C code.
-
-- MULTIPLE-VALUE-BIND compiles using MULTIPLE-VALUE-SETQ and now both are
-  better optimized, generating simpler C code.
-
-- The type checking routine for LOGAND was producing spurious warnings.
-
-- (LDB (BYTE ...) ...) no longer conses a BYTE object.
-
-- Added optimizations for MASK-FIELD, DPB, DEPOSIT-FIELD, LDB-TEST and LDB.
-
-- CONSTANT-VALUE-P and friends now use the (compiler) environment.
-
-- No optional type check generated for constant values.
-
-- Declare the temporary variables in DEFMACRO/DESTRUCTURING-BIND as IGNORABLE
-
-- ECL now accepts WHILE/IF before FOR/AS, a construct that is not ANSI
-  An example: (LOOP FOR I IN LIST WHILE (SOME-TEST I) FOR X = (F I) ... )
-
-* Common Lisp fixes:
-
-- CONSTANTP now performs a bit more work, macroexpanding forms.
-
-- ENSURE-DIRECTORIES-EXIST ignores the host and device from the original
-  pathname when creating the directories.
-
-- In FORMAT, printing of floating point numbers could lead to an infinite loop.
-
-- ROUND, FLOOR, CEILING and TRUNCATE have been reorganized and work faster with
-  rational numbers.
-
-- (CONCATENATE 'SIMPLE-BASE-STRING ...) returned an ordinary string.
-
-- MAKE-ARRAY did not terminate strings with #\Null (needed internally by the C
-  code).
-
-- (SETF DOCUMENTATION) did not operate on functions because the function object
-  documentation had precedence over the annotation.
-
-- Added the whole Unicode character database to the C library. This means ECL
-  can now interpret all Unicode character names properly, and print them as
-  well. ECL now also recognizes all ASCII control-character abbreviations
-
-- Print integers using upcase letters for radix > 10
-
-- New functions RATIOP, {SINGLE,SHORT,DOUBLE,LONG}-FLOAT-P help avoid consing
-  in TYPEP
-
-- HASH-TABLE-COUNT did not work with weak hashes: it did not update the count
-  of live cells (Note, however, that this function is by definition not
-  reliable, just a hint, since a garbage collection may happen while the count
-  is being computed)
-
-- ECL no longer uses :READ-ONLY declarations in the SETF expansions because
-  there is code out there that modifies the values variables.
-
-- PROGV can now 'unbind' variables when the list of variables is longer than
-  the list of values.
-
-* CLOS:
-
-- Added built in classes FIXNUM and BIGNUM.
-
-- Eliminated code for accessing slots that was no longer used. Removed also
-  redundant code.
-
-- Updating a class (due to a change in metaclass) now forces updating its
-  children
-
-- UPDATE-INSTANCE-FOR-REDEFINED-CLASS received an alist instead of a
-  propertly-list as last argument
-
-- PRINT-OBJECT did not have a working default for built in classes.
-
-* Extensions:
-
-- SYSTEM must use the POSIX shell, which usually lives in /bin/sh.
-
-- CLX now uses recursive locks.
-
-- ASDF upgraded to version 2.32, including the ASDF-BUNDLE facility, which
-  supersedes ECL's own implementation of precompiled libraries.
-
-- MAKE-INSTANCE, SHARED-INITIALIZE, REINITIALIZE-INSTANCE now work on
-  structures as well.
+- DEFUN functions not defined as toplevel forms were also directly referenced
+  other code in the same file.
 
 ;;; Local Variables: ***
 ;;; mode:text ***

src/cmp/cmpglobals.lsp

@@ -270,6 +270,7 @@ lines are inserted, but the order is preserved")
 
 (defvar *global-vars* nil)		; variables declared special
 (defvar *global-funs* nil)		; holds	{ fun }*
+(defvar *use-c-global* nil)		; honor si::c-global declaration
 (defvar *global-cfuns-array* nil)	; holds	{ fun }*
 (defvar *linking-calls* nil)		; holds { ( global-fun-name fun symbol c-fun-name var-name ) }*
 (defvar *local-funs* nil)		; holds { fun }*

src/cmp/cmplam.lsp

@@ -109,7 +109,9 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
 	 (*cmp-env* (setf (fun-cmp-env fun) (cmp-env-mark CB/LB)))
 	 (setjmps *setjmps*)
 	 (decl (si::process-declarations (rest lambda-list-and-body)))
-	 (global (and (assoc 'SI::C-GLOBAL decl) (setf (fun-global fun) T)))
+	 (global (and *use-c-global*
+		      (assoc 'SI::C-GLOBAL decl)
+		      (setf (fun-global fun) T)))
 	 (no-entry (assoc 'SI::C-LOCAL decl))
 	 (lambda-expr (c1lambda-expr lambda-list-and-body
 				     (si::function-block-name name)))

src/cmp/cmptables.lsp

@@ -140,7 +140,6 @@
     (psetq . c1psetq) ; c1special
 
     (load-time-value . c1load-time-value) ; c1
-    (si:fset . c1fset) ; c1
 
     (apply . c1apply) ; c1
     ))
@@ -155,6 +154,7 @@
     (macrolet . c1macrolet)
     (locally . c1locally)
     (symbol-macrolet . c1symbol-macrolet)
+    (si:fset . t1fset)
     ))
 
 (defconstant +set-loc-dispatch-alist+
@@ -241,7 +241,7 @@
     (progv . c2progv) ; c2
     (psetq . c2psetq) ; c2
 
-    (si:fset . c2fset) ; c2
+    (si:fset . c2fset)
 
     (ext:compiler-typecase . c2compiler-typecase)
     (checked-value . c2checked-value)
@@ -254,6 +254,7 @@
     (load-time-value . t2load-time-value)
     (make-form . t2make-form)
     (init-form . t2init-form)
+    (si:fset . t2fset)
     ))
 
 (defconstant +p1-dispatch-alist+

src/cmp/cmptop.lsp

@@ -802,10 +802,19 @@
 ;;; (SYS:FSET (FLET ((FOO ...)) #'FOO) ...) which is to what LAMBDA gets
 ;;; translated in c1function.
 ;;;
-(defun c1fset (args)
+(defun t1fset (args)
+  (let ((form `(si::fset ,@args)))
+    (when *compile-time-too*
+      (cmp-eval form))
+    (let ((*compile-toplevel* nil)
+	  (*compile-time-too* nil))
+      (add-load-time-values (c1fset form)))))
+
+(defun c1fset (form)
   (destructuring-bind (fname def &optional (macro nil) (pprint nil))
-      args
-    (let* ((fun-form (c1expr def)))
+      (rest form)
+    (let* ((*use-c-global* t)
+	   (fun-form (c1expr def)))
       (when (eq (c1form-name fun-form) 'LOCALS)
 	(let* ((function-list (c1form-arg 0 fun-form))
 	       (fun-object (pop function-list))
@@ -846,11 +855,14 @@
 				    fun-form
 				    (c1expr macro)
 				    (c1expr pprint)))))))))
-    (c1call-global 'SI:FSET (list fname def macro pprint))))
+    (t1ordinary form)))
 
 (defun p1fset (c1form assumptions fun fname macro pprint c1forms)
   (p1propagate (fun-lambda fun) assumptions))
 
+(defun t2fset (c1form &rest args)
+  (t2ordinary nil c1form))
+
 (defun c2fset (c1form fun fname macro pprint c1forms)
   (when (fun-no-entry fun)
     (wt-nl "(void)0; /* No entry created for "