[Gcl-devel] Re: smallnthcdr

[Camm Maguire]

Greetings!

I'm using a new cond eval macro which facilitates terse coding 
(gcl_evalmacros.lsp):

(defmacro cond (&rest clauses &aux (form nil))
  (let ((x (reverse clauses)))
    (dolist (l x form)
      (cond ((endp (cdr l))
             (if (or (constantp (car l)) (eq l (car x)))
                 (setq form (car l))
               (let ((sym (gensym)))
                 (setq form `(let ((,sym ,(car l))) (if ,sym ,sym ,form))))))
            ((and (constantp (car l)) (car l))
             (setq form (if (endp (cddr l)) (cadr l) `(progn ,@(cdr l)))))
            ((setq form (if (endp (cddr l))
                            `(if ,(car l) ,(cadr l) ,form)
                          `(if ,(car l) (progn ,@(cdr l))
  ,form))))))))

This will go in if it passes muster.  In any case, with this the
concise version appears optimal (i.e. tail recursion goes through):

Take care,
=============================================================================
(proclaim '(ftype (function (seqind t) t) smallnthcdr))

(defmacro tp-error (x y)
  `(specific-error :wrong-type-argument "~S is not of type ~S." ,x ',y))

(defun smallnthcdr (n x)
  (declare (seqind n))
  (cond 
        ((atom x) (when x (tp-error x si::proper-list)))
        ((= n 0) x)
        ((smallnthcdr (1- n) (cdr x)))))

TP-ERROR

>
SMALLNTHCDR

>(disassemble 'smallnthcdr )

;; Compiling /tmp/gazonk_10677_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_10677_0.o.

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

static object LI1(V3,V4)

fixnum V3;register object V4;
{        VMB1 VMS1 VMV1
        goto TTL;
TTL:;
        if(!(atom((V4)))){
        goto T2;}
        if(((V4))==Cnil){
        goto T5;}
        {object V5 = (VFUN_NARGS=4,(*(LnkLI3))(VV[0],VV[1],(V4),VV[2]));
        VMR1(V5)}
        goto T5;
T5:;
        {object V6 = Cnil;
        VMR1(V6)}
        goto T2;
T2:;
        if(!((V3)==((fixnum)0))){
        goto T8;}
        {object V7 = (V4);
        VMR1(V7)}
        goto T8;
T8:;
        V3= (fixnum)(V3)-((fixnum)1);
        V4= CMPcdr((V4));
        goto TTL;
        return Cnil;
}
static object  LnkTLI3(object first,...){object V1;va_list 
ap;va_start(ap,first);V1=(object )call_vproc_new(VV[3],0,(void **)(void 
*)&LnkLI3,first,ap);va_end(ap);return V1;} /* SPECIFIC-ERROR */
       
#(
#(:wrong-type-argument "~S is not of type ~S." system::proper-list 
lisp::specific-error (system::%init . #((system::mfsfun (lisp::quote 
common-lisp-user::smallnthcdr) 0 4098))))
)

static object LI1();
#define VMB1
#define VMS1
#define VMV1
#define VMR1(VMT1) return(VMT1);
#define VM1 0
static char * VVi[5]={
#define Cdata VV[4]
(char *)(LI1)
};
#define VV ((object *)VVi)
static object  LnkTLI3(object,...);
static object  (*LnkLI3)() = (object (*)()) LnkTLI3;

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

Disassembly of section .text:

00000000 <init_code>:
init_code():
   0:   83 ec 18                sub    $0x18,%esp
   3:   68 00 00 00 00          push   $0x0
   8:   e8 fc ff ff ff          call   9 <init_code+0x9>
   d:   83 c4 1c                add    $0x1c,%esp
  10:   c3                      ret    
  11:   eb 0d                   jmp    20 <LI1>
  13:   90                      nop    
  14:   90                      nop    
  15:   90                      nop    
  16:   90                      nop    
  17:   90                      nop    
  18:   90                      nop    
  19:   90                      nop    
  1a:   90                      nop    
  1b:   90                      nop    
  1c:   90                      nop    
  1d:   90                      nop    
  1e:   90                      nop    
  1f:   90                      nop    

00000020 <LI1>:
LI1():
  20:   83 ec 0c                sub    $0xc,%esp
  23:   8b 4c 24 10             mov    0x10(%esp),%ecx
  27:   8b 44 24 14             mov    0x14(%esp),%eax
  2b:   3d 00 00 00 00          cmp    $0x0,%eax
  30:   74 57                   je     89 <LI1+0x69>
  32:   3d ff ff ff bf          cmp    $0xbfffffff,%eax
  37:   77 29                   ja     62 <LI1+0x42>
  39:   31 d2                   xor    %edx,%edx
  3b:   90                      nop    
  3c:   8d 74 26 00             lea    0x0(%esi),%esi
  40:   f6 00 01                testb  $0x1,(%eax)
  43:   74 08                   je     4d <LI1+0x2d>
  45:   81 38 ff ff ff bf       cmpl   $0xbfffffff,(%eax)
  4b:   76 40                   jbe    8d <LI1+0x6d>
  4d:   39 d1                   cmp    %edx,%ecx
  4f:   74 38                   je     89 <LI1+0x69>
  51:   8b 00                   mov    (%eax),%eax
  53:   3d 00 00 00 00          cmp    $0x0,%eax
  58:   74 2f                   je     89 <LI1+0x69>
  5a:   42                      inc    %edx
  5b:   3d ff ff ff bf          cmp    $0xbfffffff,%eax
  60:   76 de                   jbe    40 <LI1+0x20>
  62:   66 c7 05 04 00 00 00    movw   $0x4,0x4
  69:   04 00 
  6b:   8b 0d 08 00 00 00       mov    0x8,%ecx
  71:   51                      push   %ecx
  72:   50                      push   %eax
  73:   8b 15 04 00 00 00       mov    0x4,%edx
  79:   52                      push   %edx
  7a:   a1 00 00 00 00          mov    0x0,%eax
  7f:   50                      push   %eax
  80:   ff 15 14 00 00 00       call   *0x14
  86:   83 c4 10                add    $0x10,%esp
  89:   83 c4 0c                add    $0xc,%esp
  8c:   c3                      ret    
  8d:   3d 00 00 00 00          cmp    $0x0,%eax
  92:   75 ce                   jne    62 <LI1+0x42>
  94:   eb f3                   jmp    89 <LI1+0x69>
  96:   8d 76 00                lea    0x0(%esi),%esi
  99:   8d bc 27 00 00 00 00    lea    0x0(%edi),%edi

000000a0 <LnkTLI3>:
LnkTLI3():
  a0:   83 ec 1c                sub    $0x1c,%esp
  a3:   8d 44 24 24             lea    0x24(%esp),%eax
  a7:   89 44 24 18             mov    %eax,0x18(%esp)
  ab:   83 ec 0c                sub    $0xc,%esp
  ae:   50                      push   %eax
  af:   8b 44 24 30             mov    0x30(%esp),%eax
  b3:   50                      push   %eax
  b4:   68 14 00 00 00          push   $0x14
  b9:   6a 00                   push   $0x0
  bb:   a1 0c 00 00 00          mov    0xc,%eax
  c0:   50                      push   %eax
  c1:   e8 fc ff ff ff          call   c2 <LnkTLI3+0x22>
  c6:   83 c4 3c                add    $0x3c,%esp
  c9:   c3                      ret    
NIL
=============================================================================



Robert Boyer <address@hidden> writes:

> At a much more pedestrian level, wouldn't this be faster for the current
> compiler.
> 
> (defun smallnthcdr (n x)
>   (declare (seqind n))
>   (prog ()
>     loop
>     (cond ((atom x)
>            (cond ((null x) (return nil))
>                  (t (tp-error x si::proper-list))))
>           ((= n 0) (return x))
>           (t (setq n (the seqind (- n 1)))
>              (setq x (cdr x))                        
>              (go loop)))))
> 
> Isn't the compiled code for that as fast as the C in list.d for NTH?  By the
> way, in list.d, nthcdr seems to assume that argument n is a fixnum, which
> is/was also wrong.
> 
> Bob
> 
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah