Previous: C Interface, Up: C Interface [Contents][Index]
Package:SYSTEM
Syntax:
(compile (DEFDLFUN {RETURN NAME &optional LIBNAME) ARGS*))
GCL specific: Produces an entry function to function NAME in external shared library LIBNAME with the specified args/return signature. This function must be compiled to run. When inlined, the function call collapses to a single reference to a pointer which is automatically updated to the location of the external function at image startup. The connection to the external library is persistent across image saves and re-executions. The RETURN and ARGS specifiers are keywords from the following list corresponding to the accompanying C programming types:
:char :short :int :long :float :double
Unsigned versions available are:
:uchar :ushort :uint
Complex float and complex double types can be access via:
:fcomplex :dcomplex
Pointers to types available are
:void* :char* :long* :float* :double*
Example usage:
GCL (GNU Common Lisp) 2.7.0 Thu Oct 26 12:00:01 PM EDT 2023 CLtL1 git: Version_2_7_0pre38
Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)
Binary License: GPL due to GPL'ed components: (XGCL READLINE 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/
>(do-symbols (s :lib) (print s))
LIB:|libm|
LIB:|libc|
NIL
>(compile (si::defdlfun (:double "cblas_ddot" "libblas.so") :uint :double* :uint :double* :uint))
;; Compiling /tmp/gazonk_653784_0.lsp.
;; End of Pass 1.
;; End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
;; Finished compiling /tmp/gazonk_653784_0.o.
;; Loading #P"/tmp/gazonk_653784_0.o"
;; start address for /tmp/gazonk_653784_0.o 0x2700860
;; Finished loading #P"/tmp/gazonk_653784_0.o"
#<function 0000000001a4a860>
NIL
NIL
>(do-symbols (s :lib) (print s))
LIB:|libblas|
LIB:|libm|
LIB:|libc|
NIL
>(do-symbols (s 'lib::|libblas|) (unless (find-symbol (symbol-name s) :user) (print s)))
|libblas|:|cblas_ddot|
NIL
NIL
>(setq a (make-array 3 :element-type 'long-float) b (make-array 3 :element-type 'long-float))
#(0.0 0.0 0.0)
>(setf (aref a 1) 1.2 (aref b 1) 2.3)
2.3
>(|libblas|:|cblas_ddot| 3 a 1 b 1)
2.76
>(compile (defun foo (a b) (declare ((vector long-float) a b)) (|libblas|:|cblas_ddot| (length a) a 1 b 1)))
;; Compiling /tmp/gazonk_653784_0.lsp.
;; End of Pass 1.
;; End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
;; Finished compiling /tmp/gazonk_653784_0.o.
;; Loading #P"/tmp/gazonk_653784_0.o"
;; start address for /tmp/gazonk_653784_0.o 0x2715050
;; Finished loading #P"/tmp/gazonk_653784_0.o"
#<function 0000000001a62140>
NIL
NIL
>(compile (defun bar (a b) (declare (inline |libblas|:|cblas_ddot|) ((vector long-float) a b)) (|libblas|:|cblas_ddot| (length a) a 1 b 1)))
;; Compiling /tmp/gazonk_653784_0.lsp.
;; End of Pass 1.
;; End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
;; Finished compiling /tmp/gazonk_653784_0.o.
;; Loading #P"/tmp/gazonk_653784_0.o"
;; start address for /tmp/gazonk_653784_0.o 0x2729570
;; Finished loading #P"/tmp/gazonk_653784_0.o"
#<function 0000000001a62740>
NIL
NIL
>(foo a b)
2.76
>(bar a b)
2.76
>(setq compiler::*disassemble-objdump* nil)
NIL
>(disassemble '|libblas|:|cblas_ddot|)
;; Compiling /tmp/gazonk_653784_0.lsp.
;; End of Pass 1.
;; End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
;; Finished compiling /tmp/gazonk_653784_0.o.
#include "gazonk_653784_0.h"
void init_code(){do_init((void *)VV);}
/* local entry for function libblas::cblas_ddot */
static object LI1__cblas_ddot___gazonk_653784_0(fixnum V6,object V7,fixnum V8,object V9,fixnum V10)
{ VMB1 VMS1 VMV1
if(!(((char)tp0(make_fixnum(V6)))==(1))){
goto T8;
}
if(!((0)<=(V6))){
goto T13;
}
if(!((V6)<=((fixnum)4294967295))){
goto T11;
}
goto T12;
goto T13;
T13:;
goto T11;
goto T12;
T12:;
goto T7;
goto T11;
T11:;
goto T6;
goto T8;
T8:;
goto T6;
goto T7;
T7:;
goto T5;
goto T6;
T6:;
goto T3;
goto T5;
T5:;
goto T2;
goto T3;
T3:;
V11= CMPmake_fixnum(V6);
V6= fixint((fcall.argd=4,/* SYSTEM::CHECK-TYPE-SYMBOL */(object )(*LnkLI2)(((object)VV[1]),(V11),((object)VV[2]),Cnil)));
goto T2;
T2:;
switch(tp6(V7)){
case 428:
goto T27;
T27:;
case 492:
goto T28;
T28:;
goto T25;
default:
goto T29;
T29:;
goto T24;
goto T24;
}
goto T24;
goto T25;
T25:;
goto T23;
goto T24;
T24:;
goto T22;
goto T23;
T23:;
goto T21;
goto T22;
T22:;
goto T19;
goto T21;
T21:;
goto T18;
goto T19;
T19:;
V7= (fcall.argd=4,/* SYSTEM::CHECK-TYPE-SYMBOL */(object )(*LnkLI2)(((object)VV[3]),(V7),((object)VV[4]),Cnil));
goto T18;
T18:;
if(!(((char)tp0(make_fixnum(V8)))==(1))){
goto T39;
}
if(!((0)<=(V8))){
goto T44;
}
if(!((V8)<=((fixnum)4294967295))){
goto T42;
}
goto T43;
goto T44;
T44:;
goto T42;
goto T43;
T43:;
goto T38;
goto T42;
T42:;
goto T37;
goto T39;
T39:;
goto T37;
goto T38;
T38:;
goto T36;
goto T37;
T37:;
goto T34;
goto T36;
T36:;
goto T33;
goto T34;
T34:;
V12= CMPmake_fixnum(V8);
V8= fixint((fcall.argd=4,/* SYSTEM::CHECK-TYPE-SYMBOL */(object )(*LnkLI2)(((object)VV[5]),(V12),((object)VV[2]),Cnil)));
goto T33;
T33:;
switch(tp6(V9)){
case 428:
goto T58;
T58:;
case 492:
goto T59;
T59:;
goto T56;
default:
goto T60;
T60:;
goto T55;
goto T55;
}
goto T55;
goto T56;
T56:;
goto T54;
goto T55;
T55:;
goto T53;
goto T54;
T54:;
goto T52;
goto T53;
T53:;
goto T50;
goto T52;
T52:;
goto T49;
goto T50;
T50:;
V9= (fcall.argd=4,/* SYSTEM::CHECK-TYPE-SYMBOL */(object )(*LnkLI2)(((object)VV[6]),(V9),((object)VV[4]),Cnil));
goto T49;
T49:;
if(!(((char)tp0(make_fixnum(V10)))==(1))){
goto T70;
}
if(!((0)<=(V10))){
goto T75;
}
if(!((V10)<=((fixnum)4294967295))){
goto T73;
}
goto T74;
goto T75;
T75:;
goto T73;
goto T74;
T74:;
goto T69;
goto T73;
T73:;
goto T68;
goto T70;
T70:;
goto T68;
goto T69;
T69:;
goto T67;
goto T68;
T68:;
goto T65;
goto T67;
T67:;
goto T64;
goto T65;
T65:;
V13= CMPmake_fixnum(V10);
V10= fixint((fcall.argd=4,/* SYSTEM::CHECK-TYPE-SYMBOL */(object )(*LnkLI2)(((object)VV[7]),(V13),((object)VV[2]),Cnil)));
goto T64;
T64:;
{object V14 = make_longfloat(((double(*)(uint,double*,uint,double*,uint))(dlcblas_ddot))((uint)V6,(double*)V7->v.v_self,(uint)V8,(double*)V9->v.v_self,(uint)V10));
VMR1(V14);}
}
static object LnkTLI2(object first,...){object V1;va_list ap;va_start(ap,first);V1=(object )call_proc_new(((object)VV[0]),0,262147,(void **)(void *)&LnkLI2,0,first,ap);va_end(ap);return V1;} /* SYSTEM::CHECK-TYPE-SYMBOL */
(9 (MAPC 'EVAL *COMPILER-COMPILE-DATA*))
static object LI1__cblas_ddot___gazonk_653784_0(fixnum V6,object V7,fixnum V8,object V9,fixnum V10)
;
static void *dlcblas_ddot;
#define VMB1 object V13 ,V12 ,V11;
#define VMS1
#define VMV1
#define VMRV1(a_,b_) return((object )a_);
#define VMR1(a_) VMRV1(a_,0);
#define VM1 0
static void * VVi[9]={
#define Cdata VV[8]
(void *)(&dlcblas_ddot),
(void *)(LI1__cblas_ddot___gazonk_653784_0)
};
#define VV (VVi)
static object LnkTLI2(object,...);
static object (*LnkLI2)() = (object (*)()) LnkTLI2;
NIL
>(disassemble 'foo)
;; Compiling /tmp/gazonk_653784_0.lsp.
;; End of Pass 1.
;; End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
;; Finished compiling /tmp/gazonk_653784_0.o.
#include "gazonk_653784_0.h"
void init_code(){do_init((void *)VV);}
/* local entry for function COMMON-LISP-USER::FOO */
static object LI1__FOO___gazonk_653784_0(object V3,object V4)
{ VMB1 VMS1 VMV1
if(!(((char)((fixnum)((uchar*)((fixnum)V3))[(fixnum)2]&(fixnum)1))==(0))){
goto T5;
}
goto T2;
goto T5;
T5:;
V5= ((fixnum)((uint*)((fixnum)V3))[(fixnum)4]&268435455);
goto T1;
goto T2;
T2:;
V5= (((fixnum)((uint*)((fixnum)V3))[(fixnum)1]>>(fixnum)3)&268435455);
goto T1;
T1:;
{object V6 = (/* libblas::cblas_ddot */(object )(*LnkLI2)(V5,(V3),(fixnum)1,(V4),(fixnum)1));
VMR1(V6);}
}
static object LnkTLI2(object first,...){object V1;va_list ap;va_start(ap,first);V1=(object )call_proc_new(((object)VV[0]),0,5,(void **)(void *)&LnkLI2,1092,first,ap);va_end(ap);return V1;} /* libblas::cblas_ddot */
(2 (MAPC 'EVAL *COMPILER-COMPILE-DATA*))
static object LI1__FOO___gazonk_653784_0(object V3,object V4)
;
#define VMB1 fixnum V5;
#define VMS1
#define VMV1
#define VMRV1(a_,b_) return((object )a_);
#define VMR1(a_) VMRV1(a_,0);
#define VM1 0
static void * VVi[2]={
#define Cdata VV[1]
(void *)(LI1__FOO___gazonk_653784_0)
};
#define VV (VVi)
static object LnkTLI2(object,...);
static object (*LnkLI2)() = (object (*)()) LnkTLI2;
NIL
>(disassemble 'bar)
;; Compiling /tmp/gazonk_653784_0.lsp.
;; End of Pass 1.
;; End of Pass 2.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
;; Finished compiling /tmp/gazonk_653784_0.o.
#include "gazonk_653784_0.h"
void init_code(){do_init((void *)VV);}
/* local entry for function COMMON-LISP-USER::BAR */
static object LI1__BAR___gazonk_653784_0(object V3,object V4)
{ VMB1 VMS1 VMV1
{fixnum V5;
if(!(((char)((fixnum)((uchar*)((fixnum)V3))[(fixnum)2]&(fixnum)1))==(0))){
goto T5;
}
goto T2;
goto T5;
T5:;
V5= ((fixnum)((uint*)((fixnum)V3))[(fixnum)4]&268435455);
goto T1;
goto T2;
T2:;
V5= (((fixnum)((uint*)((fixnum)V3))[(fixnum)1]>>(fixnum)3)&268435455);
goto T1;
T1:;
{object V6 = make_longfloat(((double(*)(uint,double*,uint,double*,uint))(dlcblas_ddot))((uint)V5,(double*)V3->v.v_self,(uint)1,(double*)V4->v.v_self,(uint)1));
VMR1(V6);}}
}
(2 (MAPC 'EVAL *COMPILER-COMPILE-DATA*))
static object LI1__BAR___gazonk_653784_0(object V3,object V4)
;
static void *dlcblas_ddot;
#define VMB1
#define VMS1
#define VMV1
#define VMRV1(a_,b_) return((object )a_);
#define VMR1(a_) VMRV1(a_,0);
#define VM1 0
static void * VVi[2]={
#define Cdata VV[1]
(void *)(&dlcblas_ddot),
(void *)(LI1__BAR___gazonk_653784_0)
};
#define VV (VVi)
NIL
>(si::save-system "ff")
$ ./ff
GCL (GNU Common Lisp) 2.7.0 Thu Oct 26 12:00:01 PM EDT 2023 CLtL1 git: Version_2_7_0pre38
Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)
Binary License: GPL due to GPL'ed components: (XGCL READLINE 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/
>(foo a b)
2.76
>(bar a b)
2.76
>
Previous: C Interface, Up: C Interface [Contents][Index]