[ThinLisp-commits] CVS: thinlisp-1.0/src/tlt/lisp boot.lisp,1.27,1.28 c-expr.lisp,1.6,1.7 c-state.li

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6449

Modified Files:
	boot.lisp c-expr.lisp c-state.lisp defstruct.lisp defun.lisp 
	defvar.lisp destruct.lisp macros.lisp system.lisp 
	tli-util.lisp tests.lisp trandata.lisp tlt-prim.lisp 
	trans.lisp types.lisp 
Log Message:
Step toward a SBCL port.  Mostly obvious stuff.  One messy issue: making declarations about common lisp symbols. Unlikely the current code is right.

Index: boot.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/boot.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -r1.27 -r1.28
*** boot.lisp	12 Oct 2001 22:52:03 -0000	1.27
--- boot.lisp	23 Aug 2005 00:21:01 -0000	1.28
***************
*** 175,190 ****
  	(symbol-function 'compile-tlt)))))

! (defconstant lisp-file-type 
     #-aclpc "lisp"
     #+aclpc "lsp")

! (defconstant binary-file-type 
      #+lucid                    "sbin"
      #+aclpc                    "acl"
      #+allegro                  "fasl"
      #+cmu                      "x86f"
      #+mcl                      "pfsl"
      #+clisp                    "fas"
!     #-(or lucid aclpc allegro cmu mcl clisp) "bin")

--- 175,199 ----
  	(symbol-function 'compile-tlt)))))

! (defmacro defconstant-string (symbol value)
!   `(defconstant ,symbol (let ((s ',symbol)
! 			      (v ,value))
! 			  (if (and (boundp s)
! 				   (string= v (symbol-value s)))
! 			      (symbol-value s)
! 			      v))))
! 
! (defconstant-string lisp-file-type 
     #-aclpc "lisp"
     #+aclpc "lsp")

! (defconstant-string binary-file-type 
      #+lucid                    "sbin"
      #+aclpc                    "acl"
      #+allegro                  "fasl"
      #+cmu                      "x86f"
+     #+sbcl                     "fasl"
      #+mcl                      "pfsl"
      #+clisp                    "fas"
!     #-(or lucid aclpc allegro  cmu sbcl mcl clisp) "bin")

***************
*** 236,240 ****
  ;  (merge-pathnames pathname)
  ;  #-allegro
!   pathname)

--- 245,251 ----
  ;  (merge-pathnames pathname)
  ;  #-allegro
! ;  (format t "~&finalize: p: ~S d: ~S m: ~S" pathname *default-pathname-defaults* (merge-pathnames pathname))
!   #+sbcl
!   (merge-pathnames pathname))

***************
*** 291,303 ****
  		   (<= bin-date? exports-file-write-date)))
        ;; The following weird construction forces line output buffering.
!       (write-string (format nil "Compiling   ~40a    [~3d/~3d] ~%" lisp-file count total))
        (force-output)
        (compile-file lisp-file #-clisp-old :output-file #-clisp-old relative-bin-file
  		    :verbose nil :print nil)
        (setq bin-date? (file-write-date bin-file)))
      (when (or (null load-date?)
  	      (/= load-date? bin-date?))
        ;; The following weird construction forces line output buffering.
!       (write-string (format nil "Loading     ~40a    [~3d/~3d] ~%" bin-file count total))
        (force-output)
        (load bin-file :verbose nil)
--- 302,315 ----
  		   (<= bin-date? exports-file-write-date)))
        ;; The following weird construction forces line output buffering.
!       (write-string (format nil "Compiling   ~40a    [~3d/~3d] ~%" (enough-namestring lisp-file) count total))
        (force-output)
        (compile-file lisp-file #-clisp-old :output-file #-clisp-old relative-bin-file
  		    :verbose nil :print nil)
+       (force-output)
        (setq bin-date? (file-write-date bin-file)))
      (when (or (null load-date?)
  	      (/= load-date? bin-date?))
        ;; The following weird construction forces line output buffering.
!       (write-string (format nil "Loading     ~40a    [~3d/~3d] ~%" (enough-namestring bin-file) count total))
        (force-output)
        (load bin-file :verbose nil)
***************
*** 335,338 ****
--- 347,368 ----

+ ;;; Porting status for various implementations.
+ 
+ ;;; Add clauses here to get started, be sure to leave
+ ;;; note the date when you got it working for that implementation.
+ ;;; If you port is incomplete emit a warning here.
+ 
+ #+lucid nil ; worked-circa-2000
+ #+aclpc nil ;  worked-circa-2000
+ #+allegro nil ; worked-circa-2000
+ #+cmu nil ; worked-circa-2000
+ #+sbcl (warning "Port to SBCL is incomplete 8/22/2005.")
+ #+mcl nil ; worked-circa-2000 
+ #+clisp nil ; worked-circa-2000 
+ #-(or lucid aclpc allegro cmu sbcl mcl clisp)
+ (warning "No known Lisp implementation was found in *features*.")
+ 
+ 
+ 

  ;;; Set the default float format to doubles.
***************
*** 601,608 ****
      (make-package name :use use-list)))

! (make-package-if-necessary "TLI"     '("LISP"))
  (make-package-if-necessary "TLT"     nil)
  (make-package-if-necessary "TL"      nil)
! (make-package-if-necessary "AB-LISP" '("LISP"))
  (make-package-if-necessary "TL-USER" '("TL"))

--- 631,638 ----
      (make-package name :use use-list)))

! (make-package-if-necessary "TLI"     '("COMMON-LISP"))
  (make-package-if-necessary "TLT"     nil)
  (make-package-if-necessary "TL"      nil)
! (make-package-if-necessary "AB-LISP" '("COMMON-LISP"))
  (make-package-if-necessary "TL-USER" '("TL"))

Index: c-expr.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/c-expr.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** c-expr.lisp	2 Jul 2001 02:04:13 -0000	1.6
--- c-expr.lisp	23 Aug 2005 00:21:01 -0000	1.7
***************
*** 994,998 ****
  ;;; arg, an infix operator string, and a right arg.

! (defconstant c-expr-infix-operator-types
    ;; Op strings          C-expr type        Requires op string arg?
    '((("*" "/" "%")       c-mult-expr        t)
--- 994,998 ----
  ;;; arg, an infix operator string, and a right arg.

! (define-equal-constant c-expr-infix-operator-types
    ;; Op strings          C-expr type        Requires op string arg?
    '((("*" "/" "%")       c-mult-expr        t)

Index: c-state.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/c-state.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** c-state.lisp	9 May 2001 03:47:10 -0000	1.5
--- c-state.lisp	23 Aug 2005 00:21:01 -0000	1.6
***************
*** 334,338 ****
  (defun emit-statement-to-compound-statement (statement compound-statement)
    (unless (c-statement-p statement)
!     (error "~A is not a C-statement."))
    (if (c-compound-statement-p statement)
        (let ((substatements (c-compound-statement-statements statement)))
--- 334,338 ----
  (defun emit-statement-to-compound-statement (statement compound-statement)
    (unless (c-statement-p statement)
!     (error "~A is not a C-statement." statement))
    (if (c-compound-statement-p statement)
        (let ((substatements (c-compound-statement-statements statement)))

Index: defstruct.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/defstruct.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** defstruct.lisp	9 May 2001 03:47:10 -0000	1.8
--- defstruct.lisp	23 Aug 2005 00:21:01 -0000	1.9
***************
*** 595,599 ****
  	  (t slot-name-or-binding))))

! (defconstant boa-lambda-list-keywords 
    '(tl:&optional tl:&rest tl:&aux tl:&key tl:&allow-other-keys))

--- 595,599 ----
  	  (t slot-name-or-binding))))

! (define-equal-constant boa-lambda-list-keywords 
    '(tl:&optional tl:&rest tl:&aux tl:&key tl:&allow-other-keys))

Index: defun.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/defun.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** defun.lisp	24 May 2001 01:59:28 -0000	1.8
--- defun.lisp	23 Aug 2005 00:21:01 -0000	1.9
***************
*** 399,403 ****
  ;;;   (def-c-translation +-two-arg (number1 number2)
  ;;;     ((lisp-specs :ftype ((number number) number))
! ;;;      `(lisp:+ ,number1 ,number2))
  ;;;     
  ;;;     ((trans-specs :lisp-type ((fixnum fixnum) fixnum)
--- 399,403 ----
  ;;;   (def-c-translation +-two-arg (number1 number2)
  ;;;     ((lisp-specs :ftype ((number number) number))
! ;;;      `(common-lisp:+ ,number1 ,number2))
  ;;;     
  ;;;     ((trans-specs :lisp-type ((fixnum fixnum) fixnum)
***************
*** 442,446 ****
  		     ;; In the following line, lie about the home location of this 
  		     (function-home (,home-system . ,home-module) ,name))
! 	 (lisp:defmacro ,name ,function-arglist ,@macro)
  	 (defun ,translator-name
  	     (function-call-l-expr c-expr-args c-func
--- 442,446 ----
  		     ;; In the following line, lie about the home location of this 
  		     (function-home (,home-system . ,home-module) ,name))
! 	 (common-lisp:defmacro ,name ,function-arglist ,@macro)
  	 (defun ,translator-name
  	     (function-call-l-expr c-expr-args c-func

Index: defvar.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/defvar.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** defvar.lisp	9 May 2001 03:47:11 -0000	1.5
--- defvar.lisp	23 Aug 2005 00:21:01 -0000	1.6
***************
*** 68,73 ****
      (name &optional (initial-value no-initial-value))
    `(tl:progn
!      (tl:declaim (special ,name))
!      (def-named-variable ,name :underlying-lisp-variable ,initial-value)))

  (defmacro def-translatable-lisp-constant
--- 68,74 ----
      (name &optional (initial-value no-initial-value))
    `(tl:progn
!     (with-common-lisp-unlocked ()
!      (tl:declaim (special ,name)))
!     (def-named-variable ,name :underlying-lisp-variable ,initial-value)))

  (defmacro def-translatable-lisp-constant

Index: destruct.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/destruct.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -r1.9 -r1.10
*** destruct.lisp	24 May 2001 01:59:28 -0000	1.9
--- destruct.lisp	23 Aug 2005 00:21:01 -0000	1.10
***************
*** 66,70 ****
  (defvar destruct-binding-list nil)

! (defconstant tl:lambda-list-keywords
    '(&optional &rest &key &aux &body &whole &allow-other-keys &environment))

--- 66,70 ----
  (defvar destruct-binding-list nil)

! (define-equal-constant tl:lambda-list-keywords
    '(&optional &rest &key &aux &body &whole &allow-other-keys &environment))

Index: macros.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/macros.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
*** macros.lisp	9 May 2001 03:47:13 -0000	1.7
--- macros.lisp	23 Aug 2005 00:21:01 -0000	1.8
***************
*** 52,56 ****
  ;;; Note that this macroexpander supports macrolet, symbol-macrolet, and
  ;;; compiler-macros, ala CLtL 2.  The macros defined are also passed through to
! ;;; lisp:macro-function.  The tl:macro-function version is defined since it
  ;;; needs to use the TL environment structures, not the ones native to the
  ;;; underlying Lisp.
--- 52,56 ----
  ;;; Note that this macroexpander supports macrolet, symbol-macrolet, and
  ;;; compiler-macros, ala CLtL 2.  The macros defined are also passed through to
! ;;; common-lisp:macro-function.  The tl:macro-function version is defined since it
  ;;; needs to use the TL environment structures, not the ones native to the
  ;;; underlying Lisp.

Index: system.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/system.lisp,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -r1.19 -r1.20
*** system.lisp	2 Jan 2002 04:41:47 -0000	1.19
--- system.lisp	23 Aug 2005 00:21:01 -0000	1.20
***************
*** 266,300 ****
      (name nicknames library main-function used-systems lisp-dir c-dir
  	  extra-c-files extra-h-files modules alias properties)
!   (make-system
!     :name name
!     :nicknames nicknames
!     :is-library-p library
!     :main-function main-function
!     :used-systems used-systems
!     :lisp-dir (if lisp-dir
! 		  (pathname lisp-dir)
! 		  (make-pathname
! 		    :directory
! 		    (list :relative
! 			  (string-downcase (symbol-name name))
! 			  "lisp")))
!     :c-dir (if c-dir
! 	       (pathname c-dir)
! 	       (make-pathname
  		 :directory
  		 (list :relative
  		       (string-downcase (symbol-name name))
! 		       "c")))
!     :extra-c-files extra-c-files
!     :extra-h-files extra-h-files
!     :modules (loop for mod in modules
! 		   collect (if (consp mod)
! 			       (cons-car mod)
! 			       mod))
!     :module-properties-alist (loop for mod in modules
! 				   when (consp mod)
! 				     collect mod)
!     :alias alias
!     :properties properties))

--- 266,309 ----
      (name nicknames library main-function used-systems lisp-dir c-dir
  	  extra-c-files extra-h-files modules alias properties)
!   (flet ((finalize-pathname (pathname)
! ;	   #+allegro
! ;	   (merge-pathnames pathname)
! ;	   #-allegro
! ;	   (format t "~&finalize: p: ~S d: ~S m: ~S" pathname *default-pathname-defaults* (merge-pathnames pathname))
! 	   #+sbcl
! 	   (merge-pathnames pathname)))
!     (make-system
!      :name name
!      :nicknames nicknames
!      :is-library-p library
!      :main-function main-function
!      :used-systems used-systems
!      :lisp-dir (finalize-pathname
! 		(if lisp-dir
! 		    (pathname lisp-dir)
! 		    (make-pathname
! 		     :directory
! 		     (list :relative
! 			   (string-downcase (symbol-name name))
! 			   "lisp"))))
!      :c-dir (finalize-pathname
! 	     (if c-dir
! 		(pathname c-dir)
! 		(make-pathname
  		 :directory
  		 (list :relative
  		       (string-downcase (symbol-name name))
! 		       "c"))))
!      :extra-c-files extra-c-files
!      :extra-h-files extra-h-files
!      :modules (loop for mod in modules
! 		    collect (if (consp mod)
! 				(cons-car mod)
! 				mod))
!      :module-properties-alist (loop for mod in modules
! 				    when (consp mod)
! 				    collect mod)
!      :alias alias
!      :properties properties)))

***************
*** 749,759 ****
  		 (or (null binary-write-date?)
  		     (<= binary-write-date? lisp-write-date)
! 		     (and user::exports-file-write-date
  			  (<= binary-write-date? 
! 			      user::exports-file-write-date))))
  	(when verbose
  	  (write-string
  	    (format nil "~%Compiling   ~40a    [~3d/~3d] ~a"
! 		    lisp-file module-count total-modules
  		    (if development? " (development)" "")))
  	  (force-output))
--- 758,768 ----
  		 (or (null binary-write-date?)
  		     (<= binary-write-date? lisp-write-date)
! 		     (and common-lisp-user::exports-file-write-date
  			  (<= binary-write-date? 
! 			      common-lisp-user::exports-file-write-date))))
  	(when verbose
  	  (write-string
  	    (format nil "~%Compiling   ~40a    [~3d/~3d] ~a"
! 		    (enough-namestring lisp-file) module-count total-modules
  		    (if development? " (development)" "")))
  	  (force-output))
***************
*** 767,771 ****
  	  (write-string
  	    (format nil "~%Loading     ~40a    [~3d/~3d] ~a"
! 		    binary-file module-count total-modules
  		    (if development? " (development)" "")))
  	  (force-output))
--- 776,780 ----
  	  (write-string
  	    (format nil "~%Loading     ~40a    [~3d/~3d] ~a"
! 		    (enough-namestring binary-file) module-count total-modules
  		    (if development? " (development)" "")))
  	  (force-output))
***************
*** 793,797 ****
  ;;; purely for convenience.

! (defmacro user::def-system-convenience-forms (&rest system-names)
    (cons
      'progn
--- 802,806 ----
  ;;; purely for convenience.

! (defmacro common-lisp-user::def-system-convenience-forms (&rest system-names)
    (cons
      'progn
***************
*** 874,878 ****

  (defmacro def-system-convenience-forms (&rest systems)
!   `(user::def-system-convenience-forms ,@systems))

  (def-system-convenience-forms tl)
--- 883,887 ----

  (defmacro def-system-convenience-forms (&rest systems)
!   `(common-lisp-user::def-system-convenience-forms ,@systems))

  (def-system-convenience-forms tl)

Index: tli-util.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/tli-util.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -r1.18 -r1.19
*** tli-util.lisp	24 May 2001 05:53:30 -0000	1.18
--- tli-util.lisp	23 Aug 2005 00:21:01 -0000	1.19
***************
*** 103,130 ****
  ;;; types of compiles.

! (defconstant lisp-file-type "lisp")

! (defconstant lisp-binary-file-type
!     #+lucid                      "sbin"
!     #+allegro                    "fasl"
!     #+cmu                        "x86f"
!     #+mcl                        "pfsl"
!     #-(or lucid allegro cmu mcl) "bin")

! (defconstant c-file-type "c")		; duh

! (defconstant h-file-type "h")

! (defconstant trans-data-file-type "tlt")

! (defconstant temporary-c-file-type "tmc")

! (defconstant temporary-h-file-type "tmh")

! (defconstant temporary-trans-data-file-type "tmg")

! (defconstant lisp-dev-binary-directory-name "dev")

! (defconstant lisp-macro-binary-directory-name "macro")

--- 103,141 ----
  ;;; types of compiles.

! (defmacro define-equal-constant (symbol value)
!   `(defconstant ,symbol (let ((s ',symbol)
! 			      (v ,value))
! 			  (if (and (boundp s)
! 				   (equal v (symbol-value s)))
! 			      (symbol-value s)
! 			      v))))

! (define-equal-constant lisp-file-type "lisp")

! (define-equal-constant lisp-binary-file-type
!     #+lucid                    "sbin"
!     #+aclpc                    "acl"
!     #+allegro                  "fasl"
!     #+cmu                      "x86f"
!     #+sbcl                     "fasl"
!     #+mcl                      "pfsl"
!     #+clisp                    "fas"
!     #-(or lucid aclpc allegro cmu sbcl mcl clisp) "bin")

! (define-equal-constant c-file-type "c")		; duh

! (define-equal-constant h-file-type "h")

! (define-equal-constant trans-data-file-type "tlt")

! (define-equal-constant temporary-c-file-type "tmc")

! (define-equal-constant temporary-h-file-type "tmh")

! (define-equal-constant temporary-trans-data-file-type "tmg")

! (define-equal-constant lisp-dev-binary-directory-name "dev")
! 
! (define-equal-constant lisp-macro-binary-directory-name "macro")

***************
*** 402,406 ****
    (cons-car (cons-cdr (cons-cdddr conses))))

! (defconstant default-cons-error-message
    "An argument to cons-car or cons-cdr, ~s, was not a cons.")

--- 413,417 ----
    (cons-car (cons-cdr (cons-cdddr conses))))

! (define-equal-constant default-cons-error-message
    "An argument to cons-car or cons-cdr, ~s, was not a cons.")

***************
*** 590,594 ****
  (defmacro tl:expand-development-memory (bytes)
    (unless (eval-feature :translator)
!     `(user::expand-memory-to-limit ,bytes)))

--- 601,606 ----
  (defmacro tl:expand-development-memory (bytes)
    (unless (eval-feature :translator)
!     ; `(user::expand-memory-to-limit ,bytes)
!     `(common-lisp-user::expand-memory-to-limit ,bytes)))

***************
*** 619,625 ****
         (multiple-value-prog1
  	   ,@forms
! 	 (format stream " ~X>"
  		 #+lucid (sys:%pointer ,object-var)
! 		 #-lucid (progn ,object-var 0))))))

--- 631,638 ----
         (multiple-value-prog1
  	   ,@forms
! 	 (format ,stream-var " ~X>"
  		 #+lucid (sys:%pointer ,object-var)
! 		 #+sbcl (sb-kernel:get-lisp-obj-address ,object-var)
! 		 #-(or sbcl lucid) (progn ,object-var 0))))))

***************
*** 642,650 ****
        `(lcl:with-buffered-terminal-output (*standard-output*)
  	 ,@forms)
!       #+(or allegro cmu)
        `(multiple-value-prog1
  	   (progn ,@forms)
  	 (force-output))
!       #-(or lucid allegro cmu)
        `(progn ,@forms)))

--- 655,663 ----
        `(lcl:with-buffered-terminal-output (*standard-output*)
  	 ,@forms)
!       #+(or allegro cmu sbcl)
        `(multiple-value-prog1
  	   (progn ,@forms)
  	 (force-output))
!       #-(or lucid allegro cmu sbcl)
        `(progn ,@forms)))

***************
*** 904,908 ****
--- 917,930 ----

+ ;;; In SBCL we can't declare facts about COMMON-LISP symbols unless we
+ ;;; relax a lock.
+ 
+ #+sbcl(eval-when (:compile-toplevel) (warn "In port to SBCL with-common-lisp-unlocked is not well thought thru."))

+ (defmacro with-common-lisp-unlocked (() &body body)
+   `(#+sbcl sb-ext:with-unlocked-packages #+sbcl ("COMMON-LISP")
+     #-sbcl progn
+     ,@body))
+   
  ;;; The Lucid we are currently using does not support declaim, so we have a
  ;;; macro that abstracts this with TLT.  Note that TL supports declaim, and so
***************
*** 910,919 ****

  (defmacro lisp-declaim (&rest decls)
!   #+lucid
!   `(eval-when (compile load eval)
!      ,@(loop for decl in decls
! 	     collect `(proclaim ',decl)))
!   #-lucid
!   `(declaim ,@decls))

--- 932,942 ----

  (defmacro lisp-declaim (&rest decls)
!   (with-common-lisp-unlocked ()
!     #+lucid
!     `(eval-when (compile load eval)
!       ,@(loop for decl in decls
! 	      collect `(proclaim ',decl)))
!     #-lucid
!     `(declaim ,@decls)))

***************
*** 971,974 ****
--- 994,998 ----
    #+cmu
    (ext:gc)
+   #+sbcl nil ; (sb-ext:gc :gen t) <-- but not implemented
    nil)

***************
*** 983,985 ****
--- 1007,1011 ----
    #+cmu
    (ext:gc)
+   #+sbcl
+   (sb-ext:gc :full t)
    nil)

Index: tests.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/tests.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** tests.lisp	29 Aug 1999 22:34:17 -0000	1.2
--- tests.lisp	23 Aug 2005 00:21:01 -0000	1.3
***************
*** 148,159 ****
  (progn
    (defconstant byte-array
!     #.(lisp:make-array 10 :element-type '(unsigned-byte 8) :initial-element 9))
    (defconstant double-byte-array
!     #.(lisp:make-array 15 :element-type '(unsigned-byte 16) :initial-element 132)))

  (progn
    (defconstant list-1 '(1 2 3 4 "Uffda" (5 nil . 8) 23))
!   (defconstant list-2 (quote #.(let ((a (lisp:list 1 2 3))) (lisp:setf (lisp:cdr (lisp:last a)) a) a)))
!   (defconstant list-3 (quote #.(let ((a (lisp:list nil 2 3))) (lisp:setf (lisp:car a) a) a))))

  (defun and-test1 (a b)
--- 148,159 ----
  (progn
    (defconstant byte-array
!     #.(common-lisp:make-array 10 :element-type '(unsigned-byte 8) :initial-element 9))
    (defconstant double-byte-array
!     #.(common-lisp:make-array 15 :element-type '(unsigned-byte 16) :initial-element 132)))

  (progn
    (defconstant list-1 '(1 2 3 4 "Uffda" (5 nil . 8) 23))
!   (defconstant list-2 (quote #.(let ((a (common-lisp:list 1 2 3))) (common-lisp:setf (common-lisp:cdr (common-lisp:last a)) a) a)))
!   (defconstant list-3 (quote #.(let ((a (common-lisp:list nil 2 3))) (common-lisp:setf (lisp:car a) a) a))))

  (defun and-test1 (a b)

Index: trandata.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/trandata.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** trandata.lisp	30 May 2001 03:13:50 -0000	1.11
--- trandata.lisp	23 Aug 2005 00:21:01 -0000	1.12
***************
*** 382,386 ****
  	(retranslate-warning
  	  verbose module
! 	  "A C function name has changed:~%    ~a changed to ~a."
  	  function-name c-name current-c-name)
  	(return-from trans-data-indicates-retranslate-p t))
--- 382,386 ----
  	(retranslate-warning
  	  verbose module
! 	  "A C function name has changed:~%    ~a (aka ~a) changed to ~a."
  	  function-name c-name current-c-name)
  	(return-from trans-data-indicates-retranslate-p t))
***************
*** 406,410 ****
  	(retranslate-warning
  	  verbose module
! 	  "A C variable name has changed:~%    ~a changed to ~a."
  	  variable-name c-name current-c-name)
  	(return-from trans-data-indicates-retranslate-p t))
--- 406,410 ----
  	(retranslate-warning
  	  verbose module
! 	  "A C variable name has changed:~%    ~a (aka ~a) changed to ~a."
  	  variable-name c-name current-c-name)
  	(return-from trans-data-indicates-retranslate-p t))
***************
*** 430,434 ****
  	(retranslate-warning
  	  verbose module
! 	  "A C typedef name for a Lisp structure or class has changed:~%    ~a changed to ~a"
  	  class-name c-name current-c-name)
  	(return-from trans-data-indicates-retranslate-p t))
--- 430,434 ----
  	(retranslate-warning
  	  verbose module
! 	  "A C typedef name for a Lisp structure or class has changed:~%    ~a (aka ~a) changed to ~a"
  	  class-name c-name current-c-name)
  	(return-from trans-data-indicates-retranslate-p t))
***************
*** 436,440 ****
  	(retranslate-warning
  	 verbose module
! 	 "A C struct type for a Lisp structure or class has changed:~%    ~a changed to ~a"
  	 class-name c-struct-type current-c-struct-type)
  	(return-from trans-data-indicates-retranslate-p t)))
--- 436,440 ----
  	(retranslate-warning
  	 verbose module
! 	 "A C struct type for a Lisp structure or class has changed:~%    ~a (aka ~a) changed to ~a"
  	 class-name c-struct-type current-c-struct-type)
  	(return-from trans-data-indicates-retranslate-p t)))

Index: tlt-prim.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/tlt-prim.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -r1.21 -r1.22
*** tlt-prim.lisp	13 Oct 2001 02:57:02 -0000	1.21
--- tlt-prim.lisp	23 Aug 2005 00:21:01 -0000	1.22
***************
*** 2132,2136 ****
    (if (eval-feature :translator)
        `(tl::make-package-1 ,name ,use)
!       `(lisp:make-package ,name :use ,use)))

  (def-tl-macro tl:find-package (string-or-symbol-or-package)
--- 2132,2136 ----
    (if (eval-feature :translator)
        `(tl::make-package-1 ,name ,use)
!       `(common-lisp:make-package ,name :use ,use)))

  (def-tl-macro tl:find-package (string-or-symbol-or-package)
***************
*** 2146,2150 ****
    (if (typep arg 'package)
        arg
!     (lisp:find-package arg)))

--- 2146,2150 ----
    (if (typep arg 'package)
        arg
!     (common-lisp:find-package arg)))

Index: trans.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/trans.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -r1.21 -r1.22
*** trans.lisp	8 Jun 2001 04:16:01 -0000	1.21
--- trans.lisp	23 Aug 2005 00:21:01 -0000	1.22
***************
*** 170,175 ****
      (or (null write-date?)
  	(<= write-date? source-write-date)
! 	(and user::exports-file-write-date
! 	     (<= write-date? user::exports-file-write-date)))))

--- 170,175 ----
      (or (null write-date?)
  	(<= write-date? source-write-date)
! 	(and common-lisp-user::exports-file-write-date
! 	     (<= write-date? common-lisp-user::exports-file-write-date)))))

Index: types.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/types.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** types.lisp	2 Jul 2001 02:04:13 -0000	1.13
--- types.lisp	23 Aug 2005 00:21:01 -0000	1.14
***************
*** 46,50 ****
  	  (split-declarations-and-body body)
  	`(progn
! 	   (deftype ,name ,arglist ,@body)
  	   (eval-when (:compile-toplevel :load-toplevel :execute)
  	     (defun ,type-expander ,arglist
--- 46,52 ----
  	  (split-declarations-and-body body)
  	`(progn
! 	  (handler-case 
! 	      (deftype ,name ,arglist ,@body)
! 	    #+sbcl(sb-kernel:declaration-type-conflict-error (e) nil))
  	   (eval-when (:compile-toplevel :load-toplevel :execute)
  	     (defun ,type-expander ,arglist