[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] Re: smallnthcdr
From: |
Camm Maguire |
Subject: |
[Gcl-devel] Re: smallnthcdr |
Date: |
13 Feb 2006 21:49:42 -0500 |
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Gcl-devel] Re: smallnthcdr,
Camm Maguire <=