[Gcl-devel] Re: [Axiom-developer] 2.7.0 reports

[Stephen Wilson]

Hello Camm,

A new problem now, unfortunately, unseen before latest commit.

Not pressing as I belive I have a workaround.

==----- test.lisp ----

(defun test (obj1 &optional (obj2 nil))
  (let ((obj2 (or obj2 t)))
    (cond
      ((and (null obj2)
            (stringp obj1)
            (pathname-type obj1))
       (values obj1))
      (t nil))))

==--------------------

Issue seems to be with optimization.  GCL knows OBJ2 above is
non-null.  The AND is transformed such that even if STRINGP returns
NIL, PATHNAME-TYPE is still executed, leading to a type error.

steve:tmp> gcl
GCL (GNU Common Lisp)  2.7.0 ANSI    Jun 30 2007 00:17:31
Source License: LGPL(gcl,gmp,pargcl), GPL(unexec,bfd,xgcl)
Binary License:  GPL due to GPL'ed components: (XGCL READLINE BFD UNEXEC)
Modifications of this banner must retain notice of a compatible license
Dedicated to the memory of W. Schelter

Use (help) to get some basic information on how to use GCL.

Temporary directory for compiler files set to /tmp/

>(si::use-fast-links nil)

NIL

>(compile-file "test.lisp")

;; Compiling test.lisp.
;; End of Pass 1.  
;; End of Pass 2.  
;; OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3, 
(Debug quality ignored)
;; Finished compiling test.o.
#P"/home/steve/tmp/test.o"
NIL
NIL

>(load "test.o")

;; Loading test.o
 ;; start address -T 0xa33e50 ;; Finished loading test.o
84

>(test (list))

Error: 
Signalled by TEST.
Condition in TEST [or a callee]: INTERNAL-SIMPLE-TYPE-ERROR: NIL is not of type 
PATHNAME: 

Broken at TEST.  Type :H for Help.
 1 (Continue) Return to top level.
>>:bt

#0   TEST {obj1=nil,obj2=nil,loc2=nil,loc3=nil,loc4=nil,loc5=nil,loc6=nil} 
[ihs=3]
#1   EVAL {loc0=nil,loc1=nil,loc2=nil,loc3=#<compiled-function test>} [ihs=2]
>>:q

Top level.
>(disassemble 'test)

;; Compiling /tmp/gazonk_12078_0.lsp.
;; End of Pass 1.  
;; End of Pass 2.  
;; OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3, 
(Debug quality ignored)
;; Finished compiling /tmp/gazonk_12078_0.o.

#include "gazonk_12078_0.h"
void init_code(){do_init((void *)VV);}
/*      local entry for function TEST   */

static object LI1(object V1,object first,...)
{
        va_list ap;
        int narg = VFUN_NARGS; VMB1 VMS1 VMV1
        {object V2;
        object V3;
        va_start(ap,first);
        V2= V1;
        narg -= 1;
        if (narg <= 0) goto T1;
        else {
        V3= first;}
        --narg; goto T2;
        goto T1;
T1:;
        V3= Cnil;
        goto T2;
T2:;
        goto TTL;
TTL:;
        {object V4;
        if(((V3))==Cnil){
        goto T6;}
        V4= (V3);
        goto T4;
        goto T6;
T6:;
        V4= Ct;
        goto T4;
T4:;
        (void)(type_of((V2))==t_string);
        base[0]= (V2);
        vs_top=(vs_base=base+0)+1;
        Lpathname_type();
        vs_top=sup;
        V5= ({register object _z=vs_base[0];_z;});
        if(!((V5)==(Cnil))){
        goto T12;}
        goto T10;
        goto T12;
T12:;
        goto T10;
T10:;
        {object V6 = Cnil;VMR1
        (V6);}}
        va_end(ap);
        base[0]=base[0];
        return Cnil;}
        }
#(#((%INIT
     . #((LET ((*DISABLE-RECOMPILE* T))
           (MFVFUN 'TEST 0 131073 0)
           (ADD-HASH 'TEST '((T *) NULL)
               '((PATHNAME-TYPE (T) T) (STRINGP (T) BOOLEAN))
COMMON-LISP-USER
LISPLAMBDA      !
                 OBJ1   ,&OPTIONA!
                                  OBJ,DECLA,OPTIMIZ,SAFETY      ,BLOCK
                                                                      TEST      
,LE.    ,OR.,T
,IF
,PATHNAME-TYPE,VALUES-
               '/tmp/gazonk_12078_0.lsp)
           (DEBUGGER 'TEST '(OBJ1 OBJ2)))
         (DO-RECOMPILE)))))
static object LI1(object,object,...);
#define VMB1 register object *base=vs_top; object  V5;
#define VMS1 register object *sup=vs_top+1;vs_top=sup;
#define VMV1 vs_check;
#define VMR1(VMT1) vs_top=base ; return(VMT1);
#define VM1 1
static void * VVi[1]={
#define Cdata VV[0]
(void *)(LI1)
};
#define VV (VVi)

/tmp/gazonk_12078_0.o:     file format elf32-i386

Disassembly of section .text:

00000000 <init_code>:
   0:   68 00 00 00 00          push   $0x0
   5:   e8 fc ff ff ff          call   6 <init_code+0x6>
   a:   58                      pop    %eax
   b:   c3                      ret    

0000000c <LI1>:
   c:   53                      push   %ebx
   d:   8b 1d 00 00 00 00       mov    0x0,%ebx
  13:   8d 43 04                lea    0x4(%ebx),%eax
  16:   3b 05 00 00 00 00       cmp    0x0,%eax
  1c:   a3 00 00 00 00          mov    %eax,0x0
  21:   72 05                   jb     28 <LI1+0x1c>
  23:   e8 fc ff ff ff          call   24 <LI1+0x18>
  28:   8b 44 24 08             mov    0x8(%esp),%eax
  2c:   89 03                   mov    %eax,(%ebx)
  2e:   8d 43 04                lea    0x4(%ebx),%eax
  31:   89 1d 00 00 00 00       mov    %ebx,0x0
  37:   a3 00 00 00 00          mov    %eax,0x0
  3c:   e8 fc ff ff ff          call   3d <LI1+0x31>
  41:   89 1d 00 00 00 00       mov    %ebx,0x0
  47:   b8 00 00 00 00          mov    $0x0,%eax
  4c:   5b                      pop    %ebx
  4d:   c3                      ret    
NIL


Thanks again,
Steve