From: <cli...@li...> - 2009-10-28 19:45:08
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/doc impbody.xml,1.577,1.578 (Sam Steingold) 2. clisp/src ChangeLog, 1.7175, 1.7176 clos-class5.lisp, 1.53, 1.54 clos-genfun3.lisp, 1.63, 1.64 clos-package.lisp, 1.48, 1.49 clos-slots2.lisp, 1.6, 1.7 compiler.lisp, 1.347, 1.348 defs2.lisp, 1.46, 1.47 deprecated.lisp, 1.9, 1.10 disassem.lisp, 1.25, 1.26 foreign1.lisp, 1.135, 1.136 init.lisp, 1.292, 1.293 loadform.lisp, 1.19, 1.20 macros1.lisp, 1.25, 1.26 package.d, 1.133, 1.134 places.lisp, 1.75, 1.76 trace.lisp, 1.42, 1.43 (Sam Steingold) 3. clisp/src ChangeLog, 1.7176, 1.7177 NEWS, 1.514, 1.515 TODO, 1.150, 1.151 compiler.lisp, 1.348, 1.349 condition.lisp, 1.99, 1.100 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Wed, 28 Oct 2009 15:38:02 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/doc impbody.xml,1.577,1.578 To: cli...@li... Message-ID: <E1N...@dd...> Update of /cvsroot/clisp/clisp/doc In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10170/doc Modified Files: impbody.xml Log Message: remove the "COMPILER" nickname from #<PACKAGE SYSTEM> * package.d (init_packages): do not add "COMPILER" nickname to SYS * clos-class5.lisp, clos-genfun3.lisp, clos-package.lisp: * clos-slots2.lisp, compiler.lisp, defs2.lisp, deprecated.lisp: * disassem.lisp, foreign1.lisp, init.lisp, loadform.lisp: * macros1.lisp, places.lisp, trace.lisp: use SYS instead of COMPILER Index: impbody.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v retrieving revision 1.577 retrieving revision 1.578 diff -u -d -r1.577 -r1.578 --- impbody.xml 2 Oct 2009 10:55:12 -0000 1.577 +++ impbody.xml 28 Oct 2009 15:38:00 -0000 1.578 @@ -1540,9 +1540,8 @@ <link linkend="clos-diff">additional symbols</link>. </simpara></listitem></varlistentry> <varlistentry id="sys-pac"><term>&sys-pac;</term><listitem> - <simpara>has the nicknames <quote role="package">SYS</quote> - and <quote role="package">COMPILER</quote>, and has no - &export;ed symbols. It defines many system internals. + <simpara>has the nickname <quote role="package">SYS</quote>, + and has no &export;ed symbols. It defines many system internals. </simpara></listitem></varlistentry> <varlistentry id="ext-pac"><term>&ext-pac;</term><listitem><simpara> is the umbrella package for all extensions: it imports and &re-export;s ------------------------------ Message: 2 Date: Wed, 28 Oct 2009 15:38:03 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog, 1.7175, 1.7176 clos-class5.lisp, 1.53, 1.54 clos-genfun3.lisp, 1.63, 1.64 clos-package.lisp, 1.48, 1.49 clos-slots2.lisp, 1.6, 1.7 compiler.lisp, 1.347, 1.348 defs2.lisp, 1.46, 1.47 deprecated.lisp, 1.9, 1.10 disassem.lisp, 1.25, 1.26 foreign1.lisp, 1.135, 1.136 init.lisp, 1.292, 1.293 loadform.lisp, 1.19, 1.20 macros1.lisp, 1.25, 1.26 package.d, 1.133, 1.134 places.lisp, 1.75, 1.76 trace.lisp, 1.42, 1.43 To: cli...@li... Message-ID: <E1N...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10170/src Modified Files: ChangeLog clos-class5.lisp clos-genfun3.lisp clos-package.lisp clos-slots2.lisp compiler.lisp defs2.lisp deprecated.lisp disassem.lisp foreign1.lisp init.lisp loadform.lisp macros1.lisp package.d places.lisp trace.lisp Log Message: remove the "COMPILER" nickname from #<PACKAGE SYSTEM> * package.d (init_packages): do not add "COMPILER" nickname to SYS * clos-class5.lisp, clos-genfun3.lisp, clos-package.lisp: * clos-slots2.lisp, compiler.lisp, defs2.lisp, deprecated.lisp: * disassem.lisp, foreign1.lisp, init.lisp, loadform.lisp: * macros1.lisp, places.lisp, trace.lisp: use SYS instead of COMPILER Index: deprecated.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/deprecated.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- deprecated.lisp 31 Dec 2007 21:19:08 -0000 1.9 +++ deprecated.lisp 28 Oct 2009 15:38:01 -0000 1.10 @@ -1,6 +1,6 @@ ;; deprecated CLISP functionality ;; present for now, will be removed later -;; Sam Steingold 2001, 2007 +;; Sam Steingold 2001, 2007, 2009 ;; the standard way to deprecate a function is to define a ;; compiler-macro for it which will issue a warning @@ -11,7 +11,7 @@ (export symbol (symbol-package symbol)) (sys::%putd symbol def) (push (list symbol "Use ~S instead." superseded) - compiler::*deprecated-functions-alist*) + system::*deprecated-functions-alist*) symbol) ;; --------------------------------------------------------- @@ -46,7 +46,7 @@ #+ffi (progn (deprecate 'ffi::foreign-address-null 'null) - (setf (cdr (assoc 'ffi::foreign-address-null compiler::*deprecated-functions-alist*)) + (setf (cdr (assoc 'ffi::foreign-address-null system::*deprecated-functions-alist*)) (list "The FFI now returns C NULL pointers as Lisp NIL. Use the function ~S instead." 'null))) ;; ------------------------------------------------------ Index: clos-class5.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class5.lisp,v retrieving revision 1.53 retrieving revision 1.54 diff -u -d -r1.53 -r1.54 --- clos-class5.lisp 22 Apr 2006 14:18:39 -0000 1.53 +++ clos-class5.lisp 28 Oct 2009 15:38:01 -0000 1.54 @@ -1,6 +1,6 @@ ;;;; Common Lisp Object System for CLISP: Classes ;;;; Bruno Haible 21.8.1993 - 2004 -;;;; Sam Steingold 1998 - 2004 +;;;; Sam Steingold 1998 - 2004, 2009 ;;;; German comments translated into English: Stefan Kain 2002-04-08 (in-package "CLOS") @@ -367,7 +367,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(instance slot-names &rest initargs) - 'signature #s(compiler::signature :req-num 2 :rest-p t))) + 'signature #s(system::signature :req-num 2 :rest-p t))) (do-defmethod 'shared-initialize (make-instance-<standard-method> <standard-method> :specializers (list (find-class 'structure-object) (find-class 't)) @@ -375,7 +375,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(instance slot-names &rest initargs) - 'signature #s(compiler::signature :req-num 2 :rest-p t))) + 'signature #s(system::signature :req-num 2 :rest-p t))) ;; CLtL2 28.1.12., ANSI CL 7.3. (defgeneric reinitialize-instance @@ -419,7 +419,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(instance &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) (do-defmethod 'reinitialize-instance (make-instance-<standard-method> <standard-method> :specializers (list (find-class 'structure-object)) @@ -427,7 +427,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(instance &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) ;; At the first call of REINITIALIZE-INSTANCE of each class ;; we memorize the needed information in *reinitialize-instance-table*. (defun initial-reinitialize-instance (instance &rest initargs) @@ -483,7 +483,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(instance &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) (do-defmethod 'initialize-instance (make-instance-<standard-method> <standard-method> :specializers (list (find-class 'structure-object)) @@ -491,7 +491,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(instance &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) ;; At the first call of MAKE-INSTANCE or INITIALIZE-INSTANCE of each class ;; we memorize the needed information in *make-instance-table*. (defun initial-initialize-instance (instance &rest initargs) @@ -542,7 +542,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(class &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) (do-defmethod 'allocate-instance (make-instance-<standard-method> <standard-method> :specializers (list (find-class 'structure-class)) @@ -550,7 +550,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(class &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) ; No extended method check because this GF is specified in ANSI CL. ;(initialize-extended-method-check #'allocate-instance) @@ -606,7 +606,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(class &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) (do-defmethod 'make-instance (make-instance-<standard-method> <standard-method> :specializers (list (find-class 'structure-class)) @@ -614,7 +614,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(class &rest initargs) - 'signature #s(compiler::signature :req-num 1 :rest-p t))) + 'signature #s(system::signature :req-num 1 :rest-p t))) ; No extended method check because this GF is specified in ANSI CL. ;(initialize-extended-method-check #'make-instance) ;; At the first call of MAKE-INSTANCE or INITIALIZE-INSTANCE of each class Index: loadform.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/loadform.lisp,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- loadform.lisp 24 Nov 2004 11:41:13 -0000 1.19 +++ loadform.lisp 28 Oct 2009 15:38:01 -0000 1.20 @@ -1,5 +1,5 @@ ;;; MAKE-LOAD-FORM for CLISP -;;; Sam Steingold 2001-2004 +;;; Sam Steingold 2001-2004, 2009 ;;; Bruno Haible 2004 ;; this could have been placed in in clos.lisp, @@ -71,7 +71,7 @@ ">-")))) `(FUNCTION ,funname (LAMBDA () - ,@(if (and compiler::*compiling* compiler::*compiling-from-file*) + ,@(if (and sys::*compiling* sys::*compiling-from-file*) '((DECLARE (COMPILE))) '()) ,(if initialization-form @@ -84,12 +84,12 @@ creation-form)))))) (defun make-init-form (object) - (when compiler::*load-forms* + (when sys::*load-forms* (multiple-value-bind (form found-p) - (gethash object compiler::*load-forms*) + (gethash object sys::*load-forms*) (if found-p form - (setf (gethash object compiler::*load-forms*) + (setf (gethash object sys::*load-forms*) (block compute-init-form (handler-bind ((missing-load-form Index: package.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/package.d,v retrieving revision 1.133 retrieving revision 1.134 diff -u -d -r1.133 -r1.134 --- package.d 8 Oct 2009 14:57:29 -0000 1.133 +++ package.d 28 Oct 2009 15:38:01 -0000 1.134 @@ -3094,9 +3094,8 @@ O(keyword_package) = make_package(popSTACK(),NIL,false,false); /* "KEYWORD" */ { /* #<PACKAGE SYSTEM>: */ pushSTACK(coerce_imm_ss(ascii_to_string("SYSTEM"))); - pushSTACK(coerce_imm_ss(ascii_to_string("COMPILER"))); pushSTACK(coerce_imm_ss(ascii_to_string("SYS"))); - var object nicks = listof(2); /* ("COMPILER" "SYS") */ + var object nicks = listof(1); /* ("SYS") */ make_package(popSTACK(),nicks,false,false); /* "SYSTEM" */ } { /* #<PACKAGE COMMON-LISP-USER>: */ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7175 retrieving revision 1.7176 diff -u -d -r1.7175 -r1.7176 --- ChangeLog 26 Oct 2009 20:32:11 -0000 1.7175 +++ ChangeLog 28 Oct 2009 15:38:00 -0000 1.7176 @@ -1,3 +1,12 @@ +2009-10-28 Sam Steingold <sd...@gn...> + + remove the "COMPILER" nickname from #<PACKAGE SYSTEM> + * package.d (init_packages): do not add "COMPILER" nickname to SYS + * clos-class5.lisp, clos-genfun3.lisp, clos-package.lisp: + * clos-slots2.lisp, compiler.lisp, defs2.lisp, deprecated.lisp: + * disassem.lisp, foreign1.lisp, init.lisp, loadform.lisp: + * macros1.lisp, places.lisp, trace.lisp: use SYS instead of COMPILER + 2009-10-26 Sam Steingold <sd...@gn...> fix (describe 'linux:wait) Index: clos-package.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-package.lisp,v retrieving revision 1.48 retrieving revision 1.49 diff -u -d -r1.48 -r1.49 --- clos-package.lisp 23 Nov 2007 20:08:02 -0000 1.48 +++ clos-package.lisp 28 Oct 2009 15:38:01 -0000 1.49 @@ -1,6 +1,6 @@ ;;;; Common Lisp Object System for CLISP ;;;; Bruno Haible 21.8.1993 - 2004 -;;;; Sam Steingold 1998 - 2007 +;;;; Sam Steingold 1998 - 2007, 2009 ;; to use it: (USE-PACKAGE "CLOS"). @@ -21,8 +21,8 @@ (import 'check-function-name) ;; Defined later, in compiler.lisp. -(import 'compiler::%generic-function-lambda) -(import 'compiler::%optimize-function-lambda) +(import '%generic-function-lambda) +(import '%optimize-function-lambda) (defpackage "CLOS" (:nicknames "MOP") @@ -53,8 +53,8 @@ ;; clos:slot-boundp clos:slot-makunbound ; defined in record.d ;; clos:slot-exists-p ; defined in record.d ;; clos::class-gethash clos::class-tuple-gethash ; defined in hashtabl.d - compiler::%generic-function-lambda ; defined in compiler.lisp - compiler::%optimize-function-lambda ; defined in compiler.lisp + sys::%generic-function-lambda ; defined in compiler.lisp + sys::%optimize-function-lambda ; defined in compiler.lisp ;; clos:generic-flet clos:generic-labels ; treated in compiler.lisp ;; Export: ;; clos::closclass ; property in predtype.d, type.lisp, compiler.lisp Index: macros1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/macros1.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- macros1.lisp 1 May 2008 14:09:55 -0000 1.25 +++ macros1.lisp 28 Oct 2009 15:38:01 -0000 1.26 @@ -69,8 +69,8 @@ 'defconstant symbol)) (let ((initial-var (gensym))) `(LET () - (COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-PROCLAIM-CONSTANT ',symbol ',initial-value)) + (SYS::EVAL-WHEN-COMPILE + (SYS::C-PROCLAIM-CONSTANT ',symbol ',initial-value)) (LET ((,initial-var ,initial-value)) (IF (CONSTANTP ',symbol) (UNLESS (CONSTANT-EQL ,initial-value ,initial-var Index: clos-genfun3.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun3.lisp,v retrieving revision 1.63 retrieving revision 1.64 diff -u -d -r1.63 -r1.64 --- clos-genfun3.lisp 6 May 2008 20:12:51 -0000 1.63 +++ clos-genfun3.lisp 28 Oct 2009 15:38:01 -0000 1.64 @@ -1,6 +1,6 @@ ;;;; Common Lisp Object System for CLISP: Generic Functions ;;;; Bruno Haible 21.8.1993 - 2004 -;;;; Sam Steingold 1998 - 2004, 2007 +;;;; Sam Steingold 1998 - 2004, 2007, 2009 ;;;; German comments translated into English: Stefan Kain 2002-04-08 (in-package "CLOS") @@ -216,8 +216,8 @@ (multiple-value-bind (fast-function-factory-lambda method-initargs-forms signature) (analyze-method-description 'defmethod whole-form funname method-description) `(LET () - (COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-DEFUN ',funname ,signature nil 'DEFMETHOD)) + (SYS::EVAL-WHEN-COMPILE + (SYS::C-DEFUN ',funname ,signature nil 'DEFMETHOD)) (WHEN (GET ',(SYS::GET-FUNNAME-SYMBOL funname) 'SYS::TRACED-DEFINITION) (SYS::UNTRACE1 ',funname)) (DO-DEFMETHOD ',funname (FUNCTION ,fast-function-factory-lambda) @@ -272,8 +272,8 @@ (multiple-value-bind (fast-function-factory-lambda method-initargs-forms signature) (analyze-method-description 'defmethod whole-form funname method-description) (declare (ignore fast-function-factory-lambda method-initargs-forms)) - `(COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-DEFUN ',funname ,signature nil 'DEFMETHOD)))) + `(SYS::EVAL-WHEN-COMPILE + (SYS::C-DEFUN ',funname ,signature nil 'DEFMETHOD)))) ;; ====================== DEFGENERIC and similar Macros ====================== @@ -533,8 +533,8 @@ (method-combination-form `(,method-combination-lambda ,generic-function-class-var))) `(LET () (DECLARE (SYS::IN-DEFUN ,funname)) - (COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-DEFUN ',funname ',signature nil 'DEFGENERIC)) + (SYS::EVAL-WHEN-COMPILE + (SYS::C-DEFUN ',funname ',signature nil 'DEFGENERIC)) (WHEN (GET ',funname-symbol 'SYS::TRACED-DEFINITION) (SYS::UNTRACE1 ',funname)) ;; NB: no (SYSTEM::REMOVE-OLD-DEFINITIONS ',funname) Index: defs2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defs2.lisp,v retrieving revision 1.46 retrieving revision 1.47 diff -u -d -r1.46 -r1.47 --- defs2.lisp 17 May 2009 05:09:43 -0000 1.46 +++ defs2.lisp 28 Oct 2009 15:38:01 -0000 1.47 @@ -123,7 +123,7 @@ (SYSTEM::*PRIN-STREAM* NIL) ; CLISP specific (SYSTEM::*PRIN-LINELENGTH* 79) ; CLISP specific (SYSTEM::*PRIN-LINE-PREFIX* NIL) ; CLISP specific - (COMPILER::*LOAD-FORMS* NIL) ; CLISP specific + (SYSTEM::*LOAD-FORMS* NIL) ; CLISP specific ;; reader variables: (*READ-BASE* 10) (*READ-DEFAULT-FLOAT-FORMAT* 'SINGLE-FLOAT) Index: foreign1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/foreign1.lisp,v retrieving revision 1.135 retrieving revision 1.136 diff -u -d -r1.135 -r1.136 --- foreign1.lisp 26 Oct 2009 20:32:11 -0000 1.135 +++ foreign1.lisp 28 Oct 2009 15:38:01 -0000 1.136 @@ -32,10 +32,10 @@ foreign-variable foreign-function)) (eval-when (load compile eval) - (import (intern "*COUTPUT-FILE*" "COMPILER")) - (import (intern "*COUTPUT-STREAM*" "COMPILER")) - (import (intern "*FFI-MODULE*" "COMPILER")) - (import (intern "FINALIZE-COUTPUT-FILE" "COMPILER")) + (import (intern "*COUTPUT-FILE*" "SYSTEM")) + (import (intern "*COUTPUT-STREAM*" "SYSTEM")) + (import (intern "*FFI-MODULE*" "SYSTEM")) + (import (intern "FINALIZE-COUTPUT-FILE" "SYSTEM")) (import (intern "TEXT" "SYSTEM")) ; messages (import (intern "SYMBOL-TO-KEYWORD" "SYSTEM")) (import (intern "CHECK-SYMBOL" "SYSTEM")) ; error checking @@ -503,7 +503,7 @@ ((null args) (nreverse argspecs)) (let ((argtype (first args)) (argflags (second args))) - (push `(,(intern (format nil "arg~D" i) compiler::*keyword-package*) + (push `(,(intern (format nil "arg~D" i) system::*keyword-package*) ,(deparse argtype) ,(cond ((flag-set-p argflags ff-flag-out) ':OUT) ((flag-set-p argflags ff-flag-in-out) ':IN-OUT) @@ -838,7 +838,7 @@ ; Pass an object from the compilation environment to the module. (defun pass-object (object) (new-object t - (let ((*package* compiler::*keyword-package*)) + (let ((*package* system::*keyword-package*)) (write-to-string object :readably t :pretty nil)))) ; Convert an object's index to a C lvalue. @@ -850,7 +850,7 @@ `(EVAL-WHEN (COMPILE) (DO-C-LINES ,format-string ,@args))) (defun do-c-lines (format-string &rest args) ; ABI - (when (compiler::prepare-coutput-file) + (when (system::prepare-coutput-file) (prepare-module) (etypecase format-string ((or string function) @@ -912,7 +912,7 @@ ,@doc))))) (defun note-c-const (c-name c-type cftype guard) - (when (compiler::prepare-coutput-file) + (when (system::prepare-coutput-file) (prepare-module) (let ((f-name (intern (format nil "module__~A__constant_map_~A" *name* @@ -988,7 +988,7 @@ ',name))) (defun note-c-var (c-name type flags) ; ABI - (when (compiler::prepare-coutput-file) + (when (system::prepare-coutput-file) (prepare-module) (push (list c-name (parse-c-type type) flags) *variable-list*))) @@ -1082,7 +1082,7 @@ :built-in :library :version :documentation) whole-form)) (def (gensym "DEF-CALL-OUT-")) - (properties (and (>= 1 (compiler::declared-optimize + (properties (and (>= 1 (system::declared-optimize 'space (and (boundp 'system::*denv*) system::*denv*))) (assoc ':documentation alist))) @@ -1098,15 +1098,15 @@ (EXT:COMPILER-LET ((,def ,ctype)) (EVAL-WHEN (COMPILE) (UNLESS ,LIBRARY (NOTE-C-FUN ',c-name ,def ',built-in))) - (COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-DEFUN ',name (C-TYPE-TO-SIGNATURE ,ctype)))) + (SYSTEM::EVAL-WHEN-COMPILE + (SYSTEM::C-DEFUN ',name (C-TYPE-TO-SIGNATURE ,ctype)))) (WHEN ,def ; found library function (SYSTEM::REMOVE-OLD-DEFINITIONS ',name) (SYSTEM::%PUTD ',name ,def)) ',name))) (defun note-c-fun (c-name ctype built-in) ; not ABI, compile-time only - (when (compiler::prepare-coutput-file) + (when (system::prepare-coutput-file) (prepare-module) (push (list c-name ctype built-in) *function-list*))) @@ -1195,7 +1195,7 @@ "mallocing" "nomalloc"))))) (defun note-c-call-in (name c-name alist whole) ; ABI - (when (compiler::prepare-coutput-file) + (when (system::prepare-coutput-file) (prepare-module) (let* ((fvd (parse-c-function alist whole)) (rettype (svref fvd 1)) Index: compiler.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v retrieving revision 1.347 retrieving revision 1.348 diff -u -d -r1.347 -r1.348 --- compiler.lisp 27 Sep 2009 16:24:41 -0000 1.347 +++ compiler.lisp 28 Oct 2009 15:38:01 -0000 1.348 @@ -52,30 +52,7 @@ (export '(compile compile-file disassemble)) (pushnew ':compiler *features*) -(in-package "COMPILER") -;; Convention: Write SYSTEM::PNAME for a Symbol, that is "accidentally" in -;; #<PACKAGE SYSTEM>, but which we don't use any further. -;; Write SYS::PNAME, if we assume any properties for the Symbol. -;; Write COMPILER::PNAME, if the Compiler declares the Symbol -;; and it is used by other program parts. -(import '(sys::function-name-p sys::parse-body sys::add-implicit-block - sys::make-load-time-eval sys::make-macro-expander - sys::make-funmacro-expander - sys::analyze-lambdalist sys::specialized-lambda-list-to-ordinary - sys::closure-name sys::closure-codevec - sys::closure-consts sys::closure-const - sys::fixnump sys::short-float-p sys::single-float-p - sys::double-float-p sys::long-float-p - sys::search-file sys::date-string sys::line-number - sys::%funtabref sys::inlinable sys::constant-inlinable - sys::module-name - sys::*compiling* sys::*compiling-from-file* sys::*inline-functions* - sys::*venv* sys::*fenv* sys::*benv* sys::*genv* sys::*denv* - sys::*toplevel-environment* sys::*toplevel-denv* - sys::*current-source-file* sys::*internal-compiled-file-type* - COMPILER::C-PROCLAIM COMPILER::C-PROCLAIM-CONSTANT - COMPILER::EVAL-WHEN-COMPILE - COMPILER::C-DEFUN COMPILER::C-PROVIDE COMPILER::C-REQUIRE)) +(in-package "SYS") ;; some auxilliary functions (proclaim '(inline env mac-exp)) @@ -1917,10 +1894,10 @@ (format nil (if (and *compile-file-pathname* (equalp file *compile-file-truename*)) #1="" - (format nil (TEXT " in file ~S") file))) + (format nil (TEXT "in file ~S ") file))) (format nil (if (= lineno1 lineno2) - (TEXT " in line ~D") - (TEXT " in lines ~D..~D")) + (TEXT "in line ~D ") + (TEXT "in lines ~D..~D ")) lineno1 lineno2)) #1#)) Index: clos-slots2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-slots2.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- clos-slots2.lisp 24 Nov 2004 11:41:12 -0000 1.6 +++ clos-slots2.lisp 28 Oct 2009 15:38:01 -0000 1.7 @@ -106,7 +106,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(class instance slot) - 'signature #s(compiler::signature :req-num 3))) + 'signature #s(system::signature :req-num 3))) ;; MOP p. 93 (defgeneric (setf slot-value-using-class) (new-value class object slot)) @@ -135,7 +135,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(new-value class instance slot) - 'signature #s(compiler::signature :req-num 4))) + 'signature #s(system::signature :req-num 4))) ;; MOP p. 94 (defgeneric slot-boundp-using-class (class object slot)) @@ -163,7 +163,7 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(class instance slot) - 'signature #s(compiler::signature :req-num 3))) + 'signature #s(system::signature :req-num 3))) ;; MOP p. 96 (defgeneric slot-makunbound-using-class (class object slot)) @@ -191,4 +191,4 @@ 'wants-next-method-p nil :qualifiers '() :lambda-list '(class instance slot) - 'signature #s(compiler::signature :req-num 3))) + 'signature #s(system::signature :req-num 3))) Index: disassem.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/disassem.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- disassem.lisp 14 Sep 2008 02:22:28 -0000 1.25 +++ disassem.lisp 28 Oct 2009 15:38:01 -0000 1.26 @@ -1,7 +1,7 @@ ;; CLISP disassembler ;; Sam Steingold: converted to CLOS 2001-06-16 -(in-package "COMPILER") +(in-package "SYS") (defun orig-fundef (object) (unless (fboundp object) Index: init.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/init.lisp,v retrieving revision 1.292 retrieving revision 1.293 diff -u -d -r1.292 -r1.293 --- init.lisp 5 Aug 2009 00:24:21 -0000 1.292 +++ init.lisp 28 Oct 2009 15:38:01 -0000 1.293 @@ -211,9 +211,9 @@ (common-lisp:eval-when (common-lisp:compile common-lisp:load common-lisp:eval) (common-lisp:setq common-lisp:*package* (sys::%find-package "SYSTEM"))) -(proclaim '(special compiler::*compiling* compiler::*compiling-from-file* - compiler::*c-error-output*)) ; for load/compiling -(setq compiler::*compiling* nil) +(proclaim '(special sys::*compiling* sys::*compiling-from-file* + sys::*c-error-output*)) ; for load/compiling +(setq sys::*compiling* nil) #-COMPILER ; only for bootstrapping (progn @@ -836,7 +836,7 @@ ((= i l) (venv-assoc s (svref venv i) from-inside-macrolet)) (if (eq s (svref venv i)) (if (and from-inside-macrolet - (not (eq (svref venv (1+ i)) compiler::specdecl)) + (not (eq (svref venv (1+ i)) sys::specdecl)) (not (symbol-macro-p (svref venv (1+ i))))) (error-of-type 'source-program-error :form s @@ -1734,10 +1734,10 @@ #+ffi (ffi::*foreign-library* ffi::*foreign-library*) (*package* *package*) ; bind *PACKAGE* (*readtable* *readtable*) ; bind *READTABLE* - (compiler::*c-error-output* *error-output*) ; for compiling + (*c-error-output* *error-output*) ; for compiling (eof-indicator input-stream)) (loading-message (TEXT "Loading file ~A ...") filename) - (when *load-compiling* (compiler::c-reset-globals)) + (when *load-compiling* (sys::c-reset-globals)) ;; see `with-compilation-unit' -- `:compiling' sets a compilation unit ;; the user might set `*load-compiling*' to T either directly ;; or using the -C option, so we have to check that @@ -1768,7 +1768,7 @@ (or (eq stream filename) (sys::built-in-stream-close stream)) (when (and *load-compiling* *load-verbose* *compile-verbose*) - (compiler::c-report-problems)))) + (c-report-problems)))) (loading-message (TEXT "Loaded file ~A") filename) t))) (let ((sys::*current-source-file* "init")) @@ -1926,7 +1926,7 @@ (sys::%putd 'sys::maybe-arglist ; arglist if permitted by compiler optimizations (function sys::maybe-arglist (lambda (arglist) - (if (and compiler::*compiling* (< 2 (compiler::declared-optimize 'space))) + (if (and sys::*compiling* (< 2 (sys::declared-optimize 'space))) 0 arglist)))) (sys::%putd 'defmacro @@ -1958,7 +1958,7 @@ (sys::check-redefinition 'defmacro 'defmacro nil)) #-compiler -(predefmacro COMPILER::EVAL-WHEN-COMPILE (&body body) ; preliminary +(predefmacro SYS::EVAL-WHEN-COMPILE (&body body) ; preliminary `(eval-when (compile) ,@body)) ;; return 2 values: ordinary lambda list and reversed list of type declarations @@ -2027,27 +2027,27 @@ (SYSTEM::REMOVE-OLD-DEFINITIONS ,symbolform ,@(if preliminaryp '('T))) ,@(if ; Is name declared inline? - (if (and compiler::*compiling* - compiler::*compiling-from-file*) - (member name compiler::*inline-functions* :test #'equal) + (if (and sys::*compiling* + sys::*compiling-from-file*) + (member name sys::*inline-functions* :test #'equal) (eq (get (get-funname-symbol name) 'inlinable) 'inline)) ;; Is the lexical environment the top-level environment? ;; If yes, save the lambdabody for inline compilation. - (if compiler::*compiling* - (if (and (null compiler::*venv*) - (null compiler::*fenv*) - (null compiler::*benv*) - (null compiler::*genv*) - (eql compiler::*denv* *toplevel-denv*)) - `((COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-DEFUN + (if sys::*compiling* + (if (and (null sys::*venv*) + (null sys::*fenv*) + (null sys::*benv*) + (null sys::*genv*) + (eql sys::*denv* *toplevel-denv*)) + `((SYS::EVAL-WHEN-COMPILE + (SYS::C-DEFUN ',name (lambda-list-to-signature ',lambdalist) ',lambdabody)) (EVAL-WHEN (LOAD) (SYSTEM::%PUT ,symbolform 'SYSTEM::INLINE-EXPANSION ',lambdabody))) - `((COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-DEFUN + `((SYS::EVAL-WHEN-COMPILE + (SYS::C-DEFUN ',name (lambda-list-to-signature ',lambdalist))))) (if (and (null (svref env 0)) ; venv (null (svref env 1))) ; fenv @@ -2062,8 +2062,8 @@ 'SYSTEM::INLINE-EXPANSION ',lambdabody))))) '())) - `((COMPILER::EVAL-WHEN-COMPILE - (COMPILER::C-DEFUN + `((SYS::EVAL-WHEN-COMPILE + (SYS::C-DEFUN ',name (lambda-list-to-signature ',lambdalist))))) (SYSTEM::%PUTD ,symbolform ,(if preliminaryp Index: places.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/places.lisp,v retrieving revision 1.75 retrieving revision 1.76 diff -u -d -r1.75 -r1.76 --- places.lisp 7 Feb 2008 17:44:45 -0000 1.75 +++ places.lisp 28 Oct 2009 15:38:01 -0000 1.76 @@ -237,11 +237,11 @@ (and (not (special-operator-p funname)) (null (macro-function funname env))) t) - (not (compiler::fenv-search funname (and env (svref env 1)))) + (not (sys::fenv-search funname (and env (svref env 1)))) (every #'(lambda (argform) (commuting-forms-p var argform env)) argforms)))))) ;;; For bootstrapping. -(predefun compiler::fenv-search (funname fenv) +(predefun sys::fenv-search (funname fenv) (declare (ignore funname fenv)) nil) Index: trace.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/trace.lisp,v retrieving revision 1.42 retrieving revision 1.43 diff -u -d -r1.42 -r1.43 --- trace.lisp 9 May 2008 17:41:38 -0000 1.42 +++ trace.lisp 28 Oct 2009 15:38:01 -0000 1.43 @@ -1,7 +1,7 @@ ;; Tracer ;; Bruno Haible 13.2.1990, 15.3.1991, 4.4.1991 ;; German comments translated into English: Stefan Kain 2001-12-26 -;; Sam Steingold 2001-2008 +;; Sam Steingold 2001-2009 (in-package "COMMON-LISP") (export '(trace untrace)) @@ -33,8 +33,8 @@ (labels ((subclosure-pos (closure name) (do ((length (sys::%record-length closure)) - ;; compiler::symbol-suffix is defined in compiler.lisp - (nm (compiler::symbol-suffix (closure-name closure) name)) + ;; sys::symbol-suffix is defined in compiler.lisp + (nm (sys::symbol-suffix (closure-name closure) name)) (pos 0 (1+ pos)) obj) ((= pos length) (error (TEXT "~S: no local name ~S in ~S") ------------------------------ Message: 3 Date: Wed, 28 Oct 2009 19:45:01 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog, 1.7176, 1.7177 NEWS, 1.514, 1.515 TODO, 1.150, 1.151 compiler.lisp, 1.348, 1.349 condition.lisp, 1.99, 1.100 To: cli...@li... Message-ID: <E1N...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv16625/src Modified Files: ChangeLog NEWS TODO compiler.lisp condition.lisp Log Message: Implement the ANSI issue COMPILER-DIAGNOSTICS:USE-HANDLER: use the CL Condition system for compiler diagnostics. * compiler.lisp (c-current-location): add (c-warning): add predefun, uses c-comment (c-warn): use it (c-style-warn): use it instead of c-warn * condition.lisp (simple-style-warning): add (c-warning): define Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.514 retrieving revision 1.515 diff -u -d -r1.514 -r1.515 --- NEWS 29 Sep 2009 21:59:08 -0000 1.514 +++ NEWS 28 Oct 2009 19:44:59 -0000 1.515 @@ -18,6 +18,10 @@ exceptional situation in unsafe code. [ 2868166 ] + Fix an nternal error in DECLAIM on bad OPTIMIZE quality. [ 2868147 ] +* ANSI compliance: + + Implement the ANSI issue COMPILER-DIAGNOSTICS:USE-HANDLER: use the + CL Condition system for compiler diagnostics. + 2.48 (2009-07-28) ================= Index: TODO =================================================================== RCS file: /cvsroot/clisp/clisp/src/TODO,v retrieving revision 1.150 retrieving revision 1.151 diff -u -d -r1.150 -r1.151 --- TODO 20 Jul 2008 14:56:13 -0000 1.150 +++ TODO 28 Oct 2009 19:44:59 -0000 1.151 @@ -318,7 +318,6 @@ ; ; Number Title Status Files affected ; -; <24> compiler diagnostics no compiler.lisp ; <85> FORMAT & pretty print yes format.lisp ; no: ~E, ~F, ~G, ~$ also bind *PRINT-BASE* to 10 and *PRINT-RADIX* to NIL ; <110> LOAD & objects no loadform.lisp Index: condition.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/condition.lisp,v retrieving revision 1.99 retrieving revision 1.100 diff -u -d -r1.99 -r1.100 --- condition.lisp 22 Jul 2008 14:40:29 -0000 1.99 +++ condition.lisp 28 Oct 2009 19:44:59 -0000 1.100 @@ -1,7 +1,7 @@ ;;; Condition System for CLISP ;;; David Gadbois <ga...@cs...> 30.11.1993 ;;; Bruno Haible 24.11.1993, 2.12.1993 -- 2005 -;;; Sam Steingold 1998-2005, 2007 +;;; Sam Steingold 1998-2005, 2007, 2009 (in-package "COMMON-LISP") ;;; exports: @@ -306,6 +306,8 @@ ; |-- simple-warning ; | ; |-- style-warning +; | | +; | |-- simple-style-warning ; | ; |-- clos-warning ; | @@ -485,6 +487,8 @@ ;; conditions usually created by WARN (define-condition simple-warning (simple-condition warning) ()) +(define-condition simple-style-warning (simple-condition style-warning) ()) + ;; CLOS warnings (define-condition clos::simple-clos-warning (simple-condition clos:clos-warning) ()) (define-condition clos::simple-gf-already-called-warning (simple-condition clos:gf-already-called-warning) ()) @@ -1662,6 +1666,14 @@ (funcall *break-driver* nil condition nil))))))) nil) +;; for X3J13 Issue COMPILER-DIAGNOSTICS:USE-HANDLER +(defun c-warning (type format-string &rest args) + (let ((*error-output* + (if *compile-verbose* *c-error-output* *c-listing-output*))) + (apply #'warn-of-type type + (string-concat (c-current-location) ": " format-string) + args))) + ;; WARN, CLtL2 p. 912 ;; (WARN format-string {arg}*) (defun warn (format-string &rest args) Index: compiler.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v retrieving revision 1.348 retrieving revision 1.349 diff -u -d -r1.348 -r1.349 --- compiler.lisp 28 Oct 2009 15:38:01 -0000 1.348 +++ compiler.lisp 28 Oct 2009 19:44:59 -0000 1.349 @@ -1915,22 +1915,29 @@ (defun in-defun-p (fun) (and (equal fun (current-function)) (defining-p fun))) +(defun c-current-location () + (format nil (TEXT "~@[in ~S ~]~A") (current-function) (c-source-location))) + +(predefun c-warning (type cstring &rest args) + (declare (ignore type)) + (apply #'c-comment + (string-concat (TEXT "WARNING ~A:") "~%" cstring) + (c-current-location) args)) + (defvar *warning-count*) ;;; (C-WARN format-control-string . args) ;;; issue a compilation warning using FORMAT. (defun c-warn (cstring &rest args) (incf *warning-count*) - (apply #'c-comment - (string-concat (TEXT "WARNING~@[ in ~S~]~A :") "~%" cstring) - (current-function) (c-source-location) - args)) + (apply 'c-warning 'sys::simple-warning cstring args)) (defvar *style-warning-count*) ; (C-STYLE-WARN controlstring . args) ; issue a style-warning (via FORMAT). (defun c-style-warn (cstring &rest args) (incf *style-warning-count*) - (apply #'c-warn cstring args)) + (incf *warning-count*) + (apply #'c-warning 'sys::simple-style-warning cstring args)) (defvar *error-count*) ;; (C-ERROR controlstring . args) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7176 retrieving revision 1.7177 diff -u -d -r1.7176 -r1.7177 --- ChangeLog 28 Oct 2009 15:38:00 -0000 1.7176 +++ ChangeLog 28 Oct 2009 19:44:58 -0000 1.7177 @@ -1,5 +1,16 @@ 2009-10-28 Sam Steingold <sd...@gn...> + Implement the ANSI issue COMPILER-DIAGNOSTICS:USE-HANDLER: + use the CL Condition system for compiler diagnostics. + * compiler.lisp (c-current-location): add + (c-warning): add predefun, uses c-comment + (c-warn): use it + (c-style-warn): use it instead of c-warn + * condition.lisp (simple-style-warning): add + (c-warning): define + +2009-10-28 Sam Steingold <sd...@gn...> + remove the "COMPILER" nickname from #<PACKAGE SYSTEM> * package.d (init_packages): do not add "COMPILER" nickname to SYS * clos-class5.lisp, clos-genfun3.lisp, clos-package.lisp: ------------------------------ ------------------------------------------------------------------------------ Come build with us! The BlackBerry(R) Developer Conference in SF, CA is the only developer event you need to attend this year. Jumpstart your developing skills, take BlackBerry mobile applications to market and stay ahead of the curve. Join us from November 9 - 12, 2009. Register now! http://p.sf.net/sfu/devconference ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 42, Issue 22 ***************************************** |