### 16.2 External Shared Libraries ¶

Macro: DEFDLFUN ¶

  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

      >