[ThinLisp-commits] CVS: thinlisp-1.0/src/tlt/lisp tlt-prim.lisp,1.20,1.21

[Jim A. <ja...@us...>]

Update of /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp
In directory usw-pr-cvs1:/tmp/cvs-serv22999

Modified Files:
	tlt-prim.lisp 
Log Message:
Changed the Lisp macro expand time evaluations of the accessors for compiled-function
objects to consistently use the derror form.  This is necessary to eliminate dead
code warnings in CMU Lisp.  Here's why.

In CMU Lisp if a function or macro expansion can be determined to return a type or
a constant then the compiler will use that value to further constant fold any uses
of the result of that function.  When these constant folded values are part of the
predicate argument to an IF or COND form, it will eliminate the dead code that is
part of the consequent clause that won't be called.  This is all well and good, but
then the CMU compiler proceeds to whine that it is eliminating dead code.

The reason this comes up is that some of the operations defined by def-c-translation
do not have a Lisp development time equivalent.  The compled-function-sets-values-count
accessor of ThinLisp compiled functions is a case in point.  Since there is no Lisp
time evaluation that would make sense, if this code is executed during Lisp 
development, the expansion will call error.  CMU Lisp was seeing this call to 
error and eliminating all the code following that point in the function flow graphs
where it was being called.  This was then causing these spurious dead code warnings.
So, this edit calls derror instead of error.  Derror is written in a way to 
confuse CMU's code analyzer so it will stop making assumptions and bothering me with
compiler warnings.

This edit uses derror more to eliminate dead code warnings that I was getting in
the compilation of tl/lisp/apply.lisp.


Index: tlt-prim.lisp
===================================================================
RCS file: /cvsroot/thinlisp/thinlisp-1.0/src/tlt/lisp/tlt-prim.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -r1.20 -r1.21
*** tlt-prim.lisp	2001/08/19 16:07:05	1.20
--- tlt-prim.lisp	2001/10/13 02:57:02	1.21
***************
*** 2038,2044 ****
  (def-c-translation compiled-function-optional-arguments (compiled-function)
    ((lisp-specs :ftype ((compiled-function) fixnum))
!    `(progn
!       (derror "No Lisp env implementation of (compiled-function-optional-arguments ~s)"
! 	     ,compiled-function)))
    ((trans-specs :c-type ((obj) sint32))
     (make-c-cast-expr
--- 2038,2043 ----
  (def-c-translation compiled-function-optional-arguments (compiled-function)
    ((lisp-specs :ftype ((compiled-function) fixnum))
!    `(derror "No Lisp env implementation of (compiled-function-optional-arguments ~s)"
! 	    ,compiled-function))
    ((trans-specs :c-type ((obj) sint32))
     (make-c-cast-expr
***************
*** 2049,2056 ****
  (def-c-translation compiled-function-sets-values-count (compiled-function)
    ((lisp-specs :ftype ((compiled-function) fixnum))
!    `(progn
!       (derror "No Lisp env implementation of (compiled-function-optional-arguments ~s)"
! 	     ,compiled-function)
!       0))
    ((trans-specs :c-type ((obj) sint32))
     (make-c-cast-expr
--- 2048,2053 ----
  (def-c-translation compiled-function-sets-values-count (compiled-function)
    ((lisp-specs :ftype ((compiled-function) fixnum))
!    `(derror "No Lisp env implementation of (compiled-function-optional-arguments ~s)"
! 	    ,compiled-function))
    ((trans-specs :c-type ((obj) sint32))
     (make-c-cast-expr
***************
*** 2063,2069 ****
  (def-c-translation compiled-function-default-arguments (compiled-function)
    ((lisp-specs :ftype ((compiled-function) t))
!    `(progn
!       (derror "No Lisp env implementation of (compiled-function-default-arguments ~s)"
! 	     ,compiled-function)))
    ((trans-specs :c-type ((obj) obj))
     (make-c-indirect-selection-expr
--- 2060,2065 ----
  (def-c-translation compiled-function-default-arguments (compiled-function)
    ((lisp-specs :ftype ((compiled-function) t))
!    `(derror "No Lisp env implementation of (compiled-function-default-arguments ~s)"
! 	    ,compiled-function))
    ((trans-specs :c-type ((obj) obj))
     (make-c-indirect-selection-expr
***************
*** 2073,2079 ****
  (def-c-translation compiled-function-closure-environment (compiled-function)
    ((lisp-specs :ftype ((compiled-function) t))
!    `(progn
!       (derror "No Lisp env implementation of (compiled-function-closure-environment ~s)"
! 	     ,compiled-function)))
    ((trans-specs :c-type ((obj) obj))
     (make-c-indirect-selection-expr
--- 2069,2074 ----
  (def-c-translation compiled-function-closure-environment (compiled-function)
    ((lisp-specs :ftype ((compiled-function) t))
!    `(derror "No Lisp env implementation of (compiled-function-closure-environment ~s)"
! 	    ,compiled-function))
    ((trans-specs :c-type ((obj) obj))
     (make-c-indirect-selection-expr
***************
*** 2084,2090 ****
  							      closure-env)
    ((lisp-specs :ftype ((compiled-function t) t))
!    `(progn
!       (derror "No Lisp env implementation of (set-compiled-function-closure-environment ~s ~s)"
! 	     ,compiled-function ,closure-env)))
    ((trans-specs :c-type ((obj obj) obj))
     (make-c-infix-expr
--- 2079,2084 ----
  							      closure-env)
    ((lisp-specs :ftype ((compiled-function t) t))
!    `(derror "No Lisp env implementation of (set-compiled-function-closure-environment ~s ~s)"
! 	    ,compiled-function ,closure-env))
    ((trans-specs :c-type ((obj obj) obj))
     (make-c-infix-expr
***************
*** 2111,2118 ****
     `(kernel:%function-name ,compiled-function)
     #-(or lucid cmu)
!    `(progn
!       (derror "No Lisp env implementation of (compiled-function-name ~s)"
! 	     ,compiled-function)
!       :dummy-name))
    ((trans-specs :c-type ((obj) obj))
     (make-c-indirect-selection-expr
--- 2105,2110 ----
     `(kernel:%function-name ,compiled-function)
     #-(or lucid cmu)
!    `(derror "No Lisp env implementation of (compiled-function-name ~s)"
! 	    ,compiled-function))
    ((trans-specs :c-type ((obj) obj))
     (make-c-indirect-selection-expr