├── .gitignore ├── Makefile ├── README.org ├── emacs-module-helpers.c ├── emacs-module-helpers.h ├── emacs-module.h ├── examples.org ├── gsl-constants.c ├── gsl-ffi ├── ffi.el └── gsl-ffi.org ├── gsl-integration.c ├── gsl-linalg.c ├── gsl-roots.c ├── mod-list-vec.c ├── mod-types.c ├── mongodb ├── bson.el ├── bson.org ├── connect ├── ex.c ├── ffi.el └── mongo-ffi.org ├── template ├── .gitignore └── template.org ├── tests.el └── zeromq ├── ffi.el ├── hwclient ├── hwclient.c ├── hwserver ├── hwserver.c ├── makefile ├── mod-zmq.c ├── test.el └── zeromq.org /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.so 3 | .DS_Store 4 | mongo-c-driver-1.6.3 -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: libemacs-module-helpers.so gsl-constants.so gsl-linalg.so 2 | 3 | clean: 4 | rm *.o *.so 5 | 6 | ################## 7 | # Module helpers # 8 | ################## 9 | 10 | emacs-module-helpers.o: emacs-module-helpers.c emacs-module-helpers.h 11 | gcc -Wall -I/usr/local/include -fPIC -c emacs-module-helpers.c 12 | 13 | libemacs-module-helpers.so: emacs-module-helpers.o 14 | gcc -shared -o libemacs-module-helpers.so emacs-module-helpers.o 15 | 16 | ################## 17 | # GSL constants # 18 | ################## 19 | 20 | gsl-constants.so: gsl-constants.o libemacs-module-helpers.so 21 | gcc -shared -L/usr/local/include -lgsl -L. -lemacs-module-helpers -o gsl-constants.so gsl-constants.o 22 | 23 | gsl-constants.o: gsl-constants.c 24 | gcc -Wall -I/usr/local/include -fPIC -c gsl-constants.c 25 | 26 | test-constants: gsl-constants.so tests.el 27 | emacs -batch -q -l tests.el -f test-constants 28 | 29 | ############## 30 | # GSL linalg # 31 | ############## 32 | 33 | gsl-linalg.so: gsl-linalg.o libemacs-module-helpers.so 34 | gcc -shared -L/usr/local/include -lgsl -L. -lemacs-module-helpers -o gsl-linalg.so gsl-linalg.o 35 | 36 | gsl-linalg.o: gsl-linalg.c 37 | gcc -Wall -I/usr/local/include -fPIC -c gsl-linalg.c 38 | 39 | test-linalg: gsl-linalg.so tests.el 40 | emacs -batch -q -l tests.el -f test-linalg 41 | 42 | 43 | ############## 44 | # MOD-MKL module 45 | ############## 46 | mod-mkl.so: mod-mkl.o libemacs-module-helpers.so 47 | sh /opt/intel/mkl/bin/mklvars.sh intel64 48 | gcc -shared -L${MKLROOT}/lib -Wl,-rpath,${MKLROOT}/lib -lmkl_rt -lpthread -lm -ldl -L. -lemacs-module-helpers -o mod-mkl.so mod-mkl.o 49 | 50 | mod-mkl.o: mod-mkl.c 51 | sh /opt/intel/mkl/bin/mklvars.sh intel64 52 | gcc -Wall -m64 -I${MKLROOT}/include -fPIC -c mod-mkl.c 53 | 54 | test-mod-mkl: mod-mkl.so tests.el 55 | sh /opt/intel/mkl/bin/mklvars.sh intel64 56 | emacs -batch -q -l tests.el -f test-mkl 57 | 58 | 59 | ######################### 60 | # Miscellaneous modules # 61 | ######################### 62 | 63 | mod-types.so: mod-types.o libemacs-module-helpers.so 64 | gcc -shared -L. -lemacs-module-helpers -o mod-types.so mod-types.o 65 | 66 | mod-types.o: mod-types.c 67 | gcc -Wall -fPIC -c mod-types.c 68 | 69 | test-types: mod-types.so tests.el 70 | emacs -batch -q -l tests.el -f test-types 71 | 72 | ################################################################## 73 | 74 | mod-list-vec.so: mod-list-vec.o libemacs-module-helpers.so 75 | gcc -shared -L. -lemacs-module-helpers -o mod-list-vec.so mod-list-vec.o 76 | 77 | mod-list-vec.o: mod-list-vec.c 78 | gcc -Wall -fPIC -c mod-list-vec.c 79 | 80 | test-list-vec: mod-list-vec.so tests.el 81 | emacs -batch -q -l tests.el -f test-list-vec 82 | 83 | test: test-constants test-linalg test-types test-list-vec 84 | 85 | 86 | 87 | ########################################################################## 88 | # Special cases with nested functions # 89 | # These require a special gcc since nested functions are not a standard c 90 | # feature. In particular, on Mac OSX, the default gcc seems to use clang which 91 | # does not support this. The path below is to a gcc that does support it. 92 | ########################################################################## 93 | 94 | gsl-integration.so: gsl-integration.o libemacs-module-helpers.so 95 | /usr/local/Cellar/gcc/6.1.0/bin/gcc-6 -shared -L/usr/local/include -lgsl -L. -lemacs-module-helpers -o gsl-integration.so gsl-integration.o 96 | 97 | gsl-integration.o: gsl-integration.c 98 | /usr/local/Cellar/gcc/6.1.0/bin/gcc-6 -Wall -I/usr/local/include -fPIC -c gsl-integration.c 99 | 100 | test-integration: gsl-integration.so tests.el 101 | emacs -batch -q -l tests.el -f test-integration 102 | 103 | ################################################################## 104 | 105 | gsl-roots.so: gsl-roots.o libemacs-module-helpers.so 106 | /usr/local/Cellar/gcc/6.1.0/bin/gcc-6 -shared -L/usr/local/include -lgsl -L. -lemacs-module-helpers -o gsl-roots.so gsl-roots.o 107 | 108 | gsl-roots.o: gsl-roots.c 109 | /usr/local/Cellar/gcc/6.1.0/bin/gcc-6 -Wall -I/usr/local/include -fPIC -c gsl-roots.c 110 | 111 | test-roots: gsl-roots.so tests.el 112 | emacs -batch -q -l tests.el -f test-roots 113 | 114 | 115 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Dynamic modules in Emacs 2 | 3 | This repo contains examples of creating dynamic modules for Emacs. 4 | 5 | * Contents 6 | 7 | This repo mostly contains proofs of concept so many of these may contain only a single or small number of functions. 8 | 9 | 10 | - [[./examples.org]] has examples of using these libraries. Usually these have been blogged at some point. 11 | 12 | 13 | ** The GNU Scientific library 14 | 15 | - [[./gsl-constants.c]] shows how to expose constants to Emacs 16 | - [[./gsl-linalg.c]] shows how to deal with arrays and return a vector. 17 | - [[./gsl-integration.c]] shows how to integrate a function. It is a little improved over the [[http://kitchingroup.cheme.cmu.edu/blog/2017/07/09/Adding-a-GSL-integration-function-to-Emacs-with-a-dynamic-module/][blogpost]]. 18 | - [[./gsl-roots.c]] is similar to the integration library but implements a root finder 19 | 20 | ** Zeromq 21 | 22 | [[./zeromq/]] There are two sets of bindings to Zeromq, one is a dynamic module, and one uses emacs-ffi. The ffi was much easier to write, but I anticipate trouble with special types down the road. 23 | 24 | ** MongoDB 25 | 26 | [[./mongodb/]] Here I explored an emacs-ffi approach. I ran into trouble dealing with the custom struct types. 27 | 28 | I think that a full dynamic module might be required to support this. 29 | 30 | ** postgres 31 | 32 | https://github.com/anse1/emacs-libpq An Emacs 25 module for accessing PostgreSQL via the libpq client library. 33 | 34 | 35 | ** Miscellaneous 36 | 37 | - [[./mod-types.c]] shows how to test the type of an arg, and how to get a function to work for integers and floats. Also this has a little variadic function definition. 38 | - [[./mod-list-vec.c]] contains some test functions for making vectors and indexing them. 39 | - [[./emacs-module-helpers.c]] provides convenience functions like provide and DEFUN. 40 | 41 | * Notes to me 42 | ** Simplifying writing modules 43 | 44 | There are so many things that require boilerplate code. I started [[./emacs-module-helpers.c]] to help with this. 45 | 46 | - extract_double/int from an Emacs arg 47 | - defconst/i Define a float/integer constant from a #define in a header 48 | - DEFUN macro to simplify declaring functions to emacs 49 | - provide function 50 | 51 | TODO: There should a MACRO for the emacs_value standard functions to send stuff back to Emacs if that is feasible. Maybe something like 52 | 53 | CDEFUN fname {} 54 | 55 | Not sure that is feasible though. 56 | 57 | ** General design principles 58 | 59 | I have used two designs so far. 60 | 61 | *** the standard c to emacs design 62 | The one I use the most returns an emacs value to the emacs environment. These functions have this signature 63 | 64 | #+BEGIN_SRC c 65 | static emacs_value Fname (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 66 | #+END_SRC 67 | 68 | In this, nargs is an integer of how many arguments were passed from Emacs. The args argument is an array of emacs_value types sent from Emacs. The best I can tell you can use nargs to allow optional arguments. I don't know what *data is for yet. 69 | 70 | This function would be declared to Emacs with: 71 | 72 | #+BEGIN_SRC c 73 | DEFUN("emacs-func-name", Fname, minnargs, maxnargs, 74 | docstring, 75 | data_pointer); 76 | #+END_SRC 77 | 78 | If maxnargs is -2, the function is declared to be variadic. 79 | 80 | 81 | The second design I have used modifies the Emacs env by making funcalls to emacs commands. 82 | 83 | *** Modifying the Emacs env 84 | 85 | These functions are not registered, but are called in the emacs_init_module code to provide features, like this one: 86 | 87 | #+BEGIN_SRC c 88 | void provide (emacs_env *env, const char *feature) 89 | { 90 | emacs_value Qfeat = env->intern (env, feature); 91 | emacs_value Qprovide = env->intern (env, "provide"); 92 | emacs_value args[] = { Qfeat }; 93 | 94 | env->funcall (env, Qprovide, 1, args); 95 | } 96 | #+END_SRC 97 | 98 | Or to define constants. These functions also are used for binding functions to the environment also. 99 | 100 | ** testing modules 101 | 102 | It is moderately tedious to test modules because once you load them you cannot rebuild and reload them. You have to kill emacs and try again. Here is a pretty fast way to test modules. You develop in one emacs, and run the appropriate make command to build it. 103 | 104 | Add test functions to [[./tests.el]]. Then run them from the command line like this. Right now most of these functions just test that no segfaults occur and that there is some output. It would be better to integrate ert-testing... 105 | 106 | #+BEGIN_SRC sh 107 | emacs -batch -q -l tests.el -f test-linalg 108 | #+END_SRC 109 | 110 | Or add lines like that one to the [[./Makefile]] 111 | 112 | * Resources on dynamic modules 113 | For my own notes here are all the resources on dynamic modules I know of: 114 | 115 | Here are the official Emacs header and example: 116 | emacs-module.h: http://git.savannah.gnu.org/cgit/emacs.git/tree/src/emacs-module.h?id=e18ee60b02d08b2f075903005798d3d6064dc013 117 | mod_test.c: http://git.savannah.gnu.org/cgit/emacs.git/tree/modules/mod-test/mod-test.c?id=e18ee60b02d08b2f075903005798d3d6064dc013 118 | 119 | This simple example in C http://diobla.info/blog-archive/modules-tut.html 120 | 121 | - joymacs :: http://nullprogram.com/blog/2016/11/05/ 122 | - mruby :: https://github.com/syohex/emacs-mruby-test 123 | - https://github.com/tromey/emacs-ffi :: an actual ffi for emacs 124 | - elfuse :: https://github.com/vkazanov/elfuse a file system in Emacs 125 | - asynchronous events :: http://nullprogram.com/blog/2017/02/14/ related to elfuse 126 | 127 | - [[https://github.com/syohex/emacs-sqlite3][emacs-sqlite3]] :: sqlite3 binding of Emacs Lisp 128 | - [[https://github.com/syohex/emacs-parson][emacs-parson]] :: JSON parser with dynamic module feature with [[http://kgabis.github.com/parson/][parson]] 129 | - [[https://github.com/syohex/emacs-libyaml][libyaml]] :: libyaml 130 | - [[https://github.com/syohex/emacs-perl][emacs-perl]] :: Embed Perl into Emacs 131 | - [[https://github.com/syohex/emacs-eject]] :: eject a cd 132 | - [[https://github.com/collarchoke/emacs-capstone][emacs-capstone]] :: elisp bindings for the [[http://www.capstone-engine.org/][capstone]] disassembler 133 | - [[https://github.com/hlolli/csoundAPI_emacsLisp][emacs-csound]] :: EmacsLisp link to Csound's API via Emacs Modules 134 | - [[https://github.com/rzl24ozi/cmigemo-module][emacs-cmigemo]] :: Emacs dynamic module for cmigemo 135 | - [[https://github.com/syohex/emacs-cipher][emacs-cipher]] :: OpenSSL cipher binding of Emacs Lisp 136 | - [[https://github.com/syohex/emacs-lua][emacs-lua]] :: Lua engine from Emacs Lisp 137 | - [[https://github.com/syohex/emacs-zstd][emacs-ztd]] :: libzstd binding of Emacs Lisp 138 | - [[https://github.com/syohex/emacs-memcached][mem-cached]] :: libmemcached 139 | - https://coldnew.github.io/2d16cc25/ :: in Chinese, but with code 140 | 141 | A collection of module resources: https://github.com/emacs-pe/emacs-modules 142 | - Nim https://github.com/yuutayamada/nim-emacs-module 143 | - OCaml https://github.com/janestreet/ecaml 144 | - Rust 145 | https://github.com/lunaryorn/emacs-module.rs 146 | https://github.com/jjpe/emacs_module_bindings 147 | - golang :: https://github.com/sigma/go-emacs writing modules in go 148 | 149 | This may not be a dynamic module but claims an ffi 150 | haskell https://github.com/knupfer/haskell-emacs 151 | 152 | 153 | 154 | * Top goals for this 155 | 156 | It seems like the path forward on this is probably to implement the C functions as close to the documentation as possible and then to create elisp wrappers that do resource management, e.g. freeing memory, destroying pointers, etc. 157 | 158 | This would enable me to use the DEFINE's most easily I think. 159 | 160 | The big downside of dynamic modules so far is how to get decent docstrings and signatures. 161 | 162 | ** Zeromq 163 | 164 | [[./zeromq/]] [[./zeromq/zeromq.org]] - contains a dynamic module and an ffi implementation. 165 | 166 | ** BSON/mongoc 167 | 168 | [[./mongodb/]] ffi: [[./mongodb/mongo-ffi.org]] and [[./mongodb/bson.org]] 169 | 170 | My intuition is that a dynamic module is better than the ffi, at least until it is obvious how to handle custom data types and structs in the ffi. 171 | 172 | ** sqlite3 and/or postgresql 173 | 174 | There is already one interface for this. I don't know how it maps to SQL queries, but it might enable cleaner integration to full-text search. If one was dreaming, there might also be an interface to something like ElasticSearch. 175 | 176 | ** GNU Scientific Library 177 | :PROPERTIES: 178 | :ID: E88713AA-1100-49CB-8E9E-4ED8C268BA3D 179 | :END: 180 | 181 | Similar to the BSON/mongoc situation it seems likely that a full dynamic module is necessary here too because of ffi limitations on custom structs. 182 | 183 | I think getting a decent linear algebra capability with minimal broadcasting would be helpful. We can use vectors and have a generalized dot product. 184 | 185 | It might be best to see if I can wrap Numpy for this. 186 | 187 | #+BEGIN_SRC emacs-lisp 188 | (dot [1 2] [3 4]) ; a scalar 189 | 190 | (dot [[1 1] 191 | [2 2]] 192 | [1 1]) ; here b is implied as a column 193 | #+END_SRC 194 | 195 | 196 | It would be helpful to have a vector-1d-p function, and a vector size function. The vector size function should probably work recursively so you can pass an arbitrary shaped array in. 197 | 198 | #+BEGIN_SRC emacs-lisp 199 | (defun vector-shape (vec) 200 | "Return a vector of the shape of a vector." 201 | (let ((shape (vector (length vec)))) 202 | (if (vectorp (aref vec 0)) 203 | (vconcat shape (vector-shape (aref vec 0))) 204 | shape))) 205 | 206 | (defun vector-ndims (vec) 207 | "Returns the number of dimensions in a vector." 208 | (length (vector-shape vec))) 209 | 210 | (defun vector-numel (vec) 211 | "Returns the number of elements in a vector." 212 | (if (> (length vec) 0) 213 | (seq-reduce '* (vector-shape vec) 1) 214 | 0)) 215 | 216 | (vector-shape [[[1 2][4 5]]]) 217 | (vector-ndims []) 218 | (vector-numel [[1 2][3 4]]) 219 | 220 | #+END_SRC 221 | 222 | #+RESULTS: 223 | : 4 224 | 225 | Broadcasting rules. 226 | 227 | See [[id:BEAB5896-BE68-4C32-B049-CE7DD5506922][Adding linear algebra to Emacs with the GSL and dynamic modules]] 228 | 229 | ** (dot 1d 1d) 230 | 231 | The lengths of the vectors must be the same. Then, we have to make 2d arrays 232 | 233 | (rows, cols) 234 | (1, m1) and (m2, 1) for the standard matrix multiplication codes. 235 | 236 | ** (dot 2d 1d) 237 | 238 | Assuming the 2d matrix has the shape (m1, n1), then the 1d must have n1 elements, and be converted to a (n1, 1) shape array. 239 | 240 | ** (dot 1d 2d) 241 | 242 | Assuming the 2d matrix has the shape (m1, n1) then the 1d must have m1 elements and we have to make a (1, m1) array out of it for the multiplication. 243 | -------------------------------------------------------------------------------- /emacs-module-helpers.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "emacs-module.h" 3 | #include "emacs-module-helpers.h" 4 | 5 | // Extract a number as a double from arg. ints are cast as floats. 6 | double extract_double (emacs_env *env, emacs_value arg) 7 | { 8 | emacs_value type = env->type_of(env, arg); 9 | double result = 0.0; 10 | if (env->eq(env, type, env->intern(env, "integer"))) 11 | { 12 | result = (float) env->extract_integer(env, arg); 13 | } else if (env->eq(env, type, env->intern(env, "float"))) 14 | { 15 | result = env->extract_float(env, arg); 16 | } 17 | return result; 18 | } 19 | 20 | // Extract a number as an integer from arg. floats are cast as ints. 21 | int extract_integer (emacs_env *env, emacs_value arg) 22 | { 23 | emacs_value type = env->type_of(env, arg); 24 | int result = 0; 25 | if (env->eq(env, type, env->intern(env, "integer"))) 26 | { 27 | result = env->extract_integer(env, arg); 28 | } else if (env->eq(env, type, env->intern(env, "float"))) 29 | { 30 | result = (int) env->extract_float(env, arg); 31 | } 32 | return result; 33 | } 34 | 35 | // define a constant that is an integer in emacs 36 | void defconsti (emacs_env *env, const char *name, int value, const char *doc) 37 | { 38 | // These are functions we will call 39 | emacs_value eval = env->intern(env, "eval"); 40 | emacs_value list = env->intern(env, "list"); 41 | 42 | // These will make up the list we will eventually eval 43 | emacs_value fdefconst = env->intern(env, "defconst"); 44 | emacs_value sym = env->intern(env, name); 45 | emacs_value val = env->make_integer(env, value); 46 | emacs_value sdoc = env->make_string(env, doc, strlen(doc)); 47 | 48 | // make a list of (defconst sym val doc) 49 | emacs_value largs[] = {fdefconst, sym, val, sdoc}; 50 | emacs_value qlist = env->funcall(env, list, 4, largs); 51 | 52 | // now eval the list of symbols 53 | emacs_value args[] = { qlist }; 54 | env->funcall(env, eval, 1, args); 55 | } 56 | 57 | 58 | // define a constant that is a string in Emacs 59 | void defconsts (emacs_env *env, const char *name, const char *value, const char *doc) 60 | { 61 | // These are functions we will call 62 | emacs_value eval = env->intern(env, "eval"); 63 | emacs_value list = env->intern(env, "list"); 64 | 65 | // These will make up the list we will eventually eval 66 | emacs_value fdefconst = env->intern(env, "defconst"); 67 | emacs_value sym = env->intern(env, name); 68 | emacs_value val = env->make_string(env, value, strlen(value)); 69 | emacs_value sdoc = env->make_string(env, doc, strlen(doc)); 70 | 71 | // make a list of (defconst sym val doc) 72 | emacs_value largs[] = {fdefconst, sym, val, sdoc}; 73 | emacs_value qlist = env->funcall(env, list, 4, largs); 74 | 75 | // now eval the list of symbols 76 | emacs_value args[] = { qlist }; 77 | env->funcall(env, eval, 1, args); 78 | } 79 | 80 | // define a constant that is a float in Emacs 81 | void defconst (emacs_env *env, const char *name, double value, const char *doc) 82 | { 83 | // These are functions we will call 84 | emacs_value eval = env->intern(env, "eval"); 85 | emacs_value list = env->intern(env, "list"); 86 | 87 | // These will make up the list we will eventually eval 88 | emacs_value fdefconst = env->intern(env, "defconst"); 89 | emacs_value sym = env->intern(env, name); 90 | emacs_value val = env->make_float(env, value); 91 | emacs_value sdoc = env->make_string(env, doc, strlen(doc)); 92 | 93 | // make a list of (defconst sym val doc) 94 | emacs_value largs[] = {fdefconst, sym, val, sdoc}; 95 | emacs_value qlist = env->funcall(env, list, 4, largs); 96 | 97 | // now eval the list of symbols 98 | emacs_value args[] = { qlist }; 99 | env->funcall(env, eval, 1, args); 100 | } 101 | 102 | // bind a function with emacs name to the symbol Sfun 103 | // (fset symbol definition) 104 | // This is usually used with the DEFUN macro 105 | void bind_function (emacs_env *env, const char *name, emacs_value Sfun) 106 | { 107 | /* Set the function cell of the symbol named NAME to SFUN using 108 | the 'fset' function. */ 109 | 110 | /* Convert the strings to symbols by interning them */ 111 | emacs_value Qfset = env->intern (env, "fset"); 112 | emacs_value Qsym = env->intern (env, name); 113 | 114 | /* Prepare the arguments array */ 115 | emacs_value args[] = { Qsym, Sfun }; 116 | 117 | /* Make the call (2 == nb of arguments) */ 118 | env->funcall (env, Qfset, 2, args); 119 | } 120 | 121 | 122 | void provide (emacs_env *env, const char *feature) 123 | { 124 | emacs_value Qfeat = env->intern (env, feature); 125 | emacs_value Qprovide = env->intern (env, "provide"); 126 | emacs_value args[] = { Qfeat }; 127 | 128 | env->funcall (env, Qprovide, 1, args); 129 | } 130 | 131 | 132 | // This is a smidge shorter than env->intern (env, feature) 133 | // intern(env, feature) 134 | emacs_value intern(emacs_env *env, const char *feature) 135 | { 136 | return env->intern (env, feature); 137 | } 138 | 139 | // require("feature") 140 | // This is for use in a module 141 | void require (emacs_env *env, const char *feature) 142 | { 143 | emacs_value args[] = { intern(env, feature) }; 144 | env->funcall(env, intern(env, "require"), 1, args); 145 | } 146 | 147 | 148 | -------------------------------------------------------------------------------- /emacs-module-helpers.h: -------------------------------------------------------------------------------- 1 | #include "emacs-module.h" 2 | 3 | #ifndef EMACS_MODULE_HELPERS_H_ 4 | #define EMACS_MODULE_HELPERS_H_ 5 | 6 | // from dbg.h in Learn C the Hard Way 7 | #include 8 | #include 9 | #include 10 | 11 | #ifdef NDEBEG 12 | #define debug(M, ...) 13 | #else 14 | #define debug(M, ...) fprintf(stderr, "DEBUG %s:%d ", M "\n", \ 15 | __FILE__, __LINE__, ##__VA_ARGS__) 16 | #endif 17 | 18 | #define clean_errno() (errno == 0 ? "None" : strerror(errno)) 19 | 20 | #define log_err(M, ...) fprintf(stderr, \ 21 | "[ERROR] (%s:%d errno: %s) " M "\n", __FILE__, __LINE__, \ 22 | clean_errno(), ##__VA_ARGS__) 23 | 24 | #define log_warn(M, ...) fprintf(stderr, \ 25 | "[WARN] (%s:%d errno: %s) " M "\n", __FILE__, __LINE__, \ 26 | clean_errno(), ##__VA_ARGS__) 27 | 28 | #define log_info(M, ...) fprintf(stderr, \ 29 | "[INFO] (%s:%d errno: %s) " M "\n", __FILE__, __LINE__, \ 30 | clean_errno(), ##__VA_ARGS__) 31 | 32 | #define check(A, M, ...) if (!(A)) {\ 33 | log_err(M, ##VA_ARGS__); errno=0; goto error; } 34 | 35 | #define sentinel(M, ...) {log_err(M, ##VA_ARGS__); \ 36 | errno=0; goto error;} 37 | 38 | #define check_mem(A) check((A), "Out of memory") 39 | 40 | #define check_debug(A, M, ...) if(!(A)) {debug(M, ##__VA_ARGS__); \ 41 | errno=0; goto error;} 42 | 43 | void defconsti (emacs_env *env, const char *name, int value, const char *doc); 44 | void defconsts (emacs_env *env, const char *name, const char *value, const char *doc); 45 | void defconst (emacs_env *env, const char *name, double value, const char *doc); 46 | 47 | double extract_double (emacs_env *env, emacs_value arg); 48 | int extract_integer (emacs_env *env, emacs_value arg); 49 | 50 | emacs_value intern(emacs_env *env, const char *feature); 51 | 52 | // I could not figure out how to define this as a function, so we use this define instead. 53 | #define DEFUN(lsym, csym, amin, amax, doc, data) \ 54 | bind_function (env, lsym, \ 55 | env->make_function (env, amin, amax, csym, doc, data)) 56 | 57 | 58 | void provide (emacs_env *env, const char *feature); 59 | void require (emacs_env *env, const char *feature); 60 | 61 | #endif // EMACS_MODULE_HELPERS_H_ 62 | -------------------------------------------------------------------------------- /emacs-module.h: -------------------------------------------------------------------------------- 1 | /* emacs-module.h - GNU Emacs module API. 2 | 3 | Copyright (C) 2015-2016 Free Software Foundation, Inc. 4 | 5 | This file is part of GNU Emacs. 6 | 7 | GNU Emacs is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 3 of the License, or (at 10 | your option) any later version. 11 | 12 | GNU Emacs is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with GNU Emacs. If not, see . */ 19 | 20 | #ifndef EMACS_MODULE_H 21 | #define EMACS_MODULE_H 22 | 23 | #include 24 | #include 25 | #include 26 | 27 | #if defined __cplusplus && __cplusplus >= 201103L 28 | # define EMACS_NOEXCEPT noexcept 29 | #else 30 | # define EMACS_NOEXCEPT 31 | #endif 32 | 33 | #ifdef __cplusplus 34 | extern "C" { 35 | #endif 36 | 37 | /* Current environment. */ 38 | typedef struct emacs_env_25 emacs_env; 39 | 40 | /* Opaque pointer representing an Emacs Lisp value. 41 | BEWARE: Do not assume NULL is a valid value! */ 42 | typedef struct emacs_value_tag *emacs_value; 43 | 44 | enum emacs_arity { emacs_variadic_function = -2 }; 45 | 46 | /* Struct passed to a module init function (emacs_module_init). */ 47 | struct emacs_runtime 48 | { 49 | /* Structure size (for version checking). */ 50 | ptrdiff_t size; 51 | 52 | /* Private data; users should not touch this. */ 53 | struct emacs_runtime_private *private_members; 54 | 55 | /* Return an environment pointer. */ 56 | emacs_env *(*get_environment) (struct emacs_runtime *ert); 57 | }; 58 | 59 | 60 | /* Function prototype for the module init function. */ 61 | typedef int (*emacs_init_function) (struct emacs_runtime *ert); 62 | 63 | /* Function prototype for the module Lisp functions. */ 64 | typedef emacs_value (*emacs_subr) (emacs_env *env, ptrdiff_t nargs, 65 | emacs_value args[], void *data); 66 | 67 | /* Possible Emacs function call outcomes. */ 68 | enum emacs_funcall_exit 69 | { 70 | /* Function has returned normally. */ 71 | emacs_funcall_exit_return = 0, 72 | 73 | /* Function has signaled an error using `signal'. */ 74 | emacs_funcall_exit_signal = 1, 75 | 76 | /* Function has exit using `throw'. */ 77 | emacs_funcall_exit_throw = 2, 78 | }; 79 | 80 | struct emacs_env_25 81 | { 82 | /* Structure size (for version checking). */ 83 | ptrdiff_t size; 84 | 85 | /* Private data; users should not touch this. */ 86 | struct emacs_env_private *private_members; 87 | 88 | /* Memory management. */ 89 | 90 | emacs_value (*make_global_ref) (emacs_env *env, 91 | emacs_value any_reference); 92 | 93 | void (*free_global_ref) (emacs_env *env, 94 | emacs_value global_reference); 95 | 96 | /* Non-local exit handling. */ 97 | 98 | enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env); 99 | 100 | void (*non_local_exit_clear) (emacs_env *env); 101 | 102 | enum emacs_funcall_exit (*non_local_exit_get) 103 | (emacs_env *env, 104 | emacs_value *non_local_exit_symbol_out, 105 | emacs_value *non_local_exit_data_out); 106 | 107 | void (*non_local_exit_signal) (emacs_env *env, 108 | emacs_value non_local_exit_symbol, 109 | emacs_value non_local_exit_data); 110 | 111 | void (*non_local_exit_throw) (emacs_env *env, 112 | emacs_value tag, 113 | emacs_value value); 114 | 115 | /* Function registration. */ 116 | 117 | emacs_value (*make_function) (emacs_env *env, 118 | ptrdiff_t min_arity, 119 | ptrdiff_t max_arity, 120 | emacs_value (*function) (emacs_env *env, 121 | ptrdiff_t nargs, 122 | emacs_value args[], 123 | void *) 124 | EMACS_NOEXCEPT, 125 | const char *documentation, 126 | void *data); 127 | 128 | emacs_value (*funcall) (emacs_env *env, 129 | emacs_value function, 130 | ptrdiff_t nargs, 131 | emacs_value args[]); 132 | 133 | emacs_value (*intern) (emacs_env *env, 134 | const char *symbol_name); 135 | 136 | /* Type conversion. */ 137 | 138 | emacs_value (*type_of) (emacs_env *env, 139 | emacs_value value); 140 | 141 | bool (*is_not_nil) (emacs_env *env, emacs_value value); 142 | 143 | bool (*eq) (emacs_env *env, emacs_value a, emacs_value b); 144 | 145 | intmax_t (*extract_integer) (emacs_env *env, emacs_value value); 146 | 147 | emacs_value (*make_integer) (emacs_env *env, intmax_t value); 148 | 149 | double (*extract_float) (emacs_env *env, emacs_value value); 150 | 151 | emacs_value (*make_float) (emacs_env *env, double value); 152 | 153 | /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 154 | null-terminated string. 155 | 156 | SIZE must point to the total size of the buffer. If BUFFER is 157 | NULL or if SIZE is not big enough, write the required buffer size 158 | to SIZE and return false. 159 | 160 | Note that SIZE must include the last null byte (e.g. "abc" needs 161 | a buffer of size 4). 162 | 163 | Return true if the string was successfully copied. */ 164 | 165 | bool (*copy_string_contents) (emacs_env *env, 166 | emacs_value value, 167 | char *buffer, 168 | ptrdiff_t *size_inout); 169 | 170 | /* Create a Lisp string from a utf8 encoded string. */ 171 | emacs_value (*make_string) (emacs_env *env, 172 | const char *contents, ptrdiff_t length); 173 | 174 | /* Embedded pointer type. */ 175 | emacs_value (*make_user_ptr) (emacs_env *env, 176 | void (*fin) (void *) EMACS_NOEXCEPT, 177 | void *ptr); 178 | 179 | void *(*get_user_ptr) (emacs_env *env, emacs_value uptr); 180 | void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr); 181 | 182 | void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) 183 | (void *) EMACS_NOEXCEPT; 184 | void (*set_user_finalizer) (emacs_env *env, 185 | emacs_value uptr, 186 | void (*fin) (void *) EMACS_NOEXCEPT); 187 | 188 | /* Vector functions. */ 189 | emacs_value (*vec_get) (emacs_env *env, emacs_value vec, ptrdiff_t i); 190 | 191 | void (*vec_set) (emacs_env *env, emacs_value vec, ptrdiff_t i, 192 | emacs_value val); 193 | 194 | ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec); 195 | }; 196 | 197 | /* Every module should define a function as follows. */ 198 | extern int emacs_module_init (struct emacs_runtime *ert); 199 | 200 | #ifdef __cplusplus 201 | } 202 | #endif 203 | 204 | #endif /* EMACS_MODULE_H */ 205 | -------------------------------------------------------------------------------- /examples.org: -------------------------------------------------------------------------------- 1 | * DONE Adding linear algebra to Emacs with the GSL and dynamic modules 2 | CLOSED: [2017-07-11 Tue 10:27] 3 | :PROPERTIES: 4 | :categories: emacs,dynamic-module 5 | :date: 2017/07/11 10:27:13 6 | :updated: 2017/07/11 10:27:13 7 | :org-url: http://kitchingroup.cheme.cmu.edu/org/2017/07/11/Adding-linear-algebra-to-Emacs-with-the-GSL-and-dynamic-modules.org 8 | :permalink: http://kitchingroup.cheme.cmu.edu/blog/2017/07/11/Adding-linear-algebra-to-Emacs-with-the-GSL-and-dynamic-modules/index.html 9 | :ID: BEAB5896-BE68-4C32-B049-CE7DD5506922 10 | :END: 11 | 12 | The goal of this post is to be able to solve equations like this one: 13 | 14 | \[\left(\begin{array}{cccc} 15 | 0.18& 0.60& 0.57& 0.96 \\ 16 | 0.41& 0.24& 0.99& 0.58 \\ 17 | 0.14& 0.30& 0.97& 0.66 \\ 18 | 0.51& 0.13& 0.19& 0.85 \end{array} \right ) 19 | \left ( \begin{array}{c} x_0 \\ x_1 \\ x_2 \\ x_3 \end{array} \right ) 20 | = \left ( \begin{array}{c} 1.0 \\ 2.0 \\ 3.0 \\ 4.0 \end{array} \right ) \] 21 | 22 | The answer is [[https://www.gnu.org/software/gsl/doc/html/linalg.html#examples:][given]] as 23 | 24 | \[x = \left ( \begin{array}{c} -4.05205 \\ -12.6056 \\ 1.66091 \\ 8.69377 \end{array} \right ) \] 25 | 26 | The syntax we want to use is shown below, and we want it to return a vector containing the solution: 27 | 28 | #+BEGIN_SRC emacs-lisp 29 | (let ((A [[0.18 0.60 0.57 0.96] 30 | [0.41 0.24 0.99 0.58] 31 | [0.14 0.30 0.97 0.66] 32 | [0.51 0.13 0.19 0.85]]) 33 | (b [1.0 2.0 3.0 4.0])) 34 | (gsl-linalg-LU-solve A b)) 35 | #+END_SRC 36 | 37 | Rather than put all the code in here like I have for the past several posts, I started a git repo at https://github.com/jkitchin/emacs-modules that contains this code. 38 | 39 | 40 | The module for this post can be found here: https://github.com/jkitchin/emacs-modules/blob/master/gsl-linalg.c. There are a few notable features in it. First, I started writing/collecting [[https://github.com/jkitchin/emacs-modules/blob/master/emacs-module-helpers.c][some helper functions]] to make these modules simpler to write. For example, look how nice this looks to declare the functions and provide the feature. 41 | 42 | #+BEGIN_SRC c 43 | int emacs_module_init(struct emacs_runtime *ert) 44 | { 45 | emacs_env *env = ert->get_environment(ert); 46 | 47 | DEFUN("gsl-linalg-LU-solve", Fgsl_linalg_LU_solve, 2, 2, 48 | "(gsl-linalg-LU-solve A b).\n" \ 49 | "Solve A x = b for x.\n" \ 50 | "Returns a vector containing the solution x.", 51 | NULL); 52 | provide(env, "gsl-linalg"); 53 | 54 | return 0; 55 | } 56 | #+END_SRC 57 | 58 | The DEFUN and provide function are defined in https://github.com/jkitchin/emacs-modules/blob/master/emacs-module-helpers.c. 59 | 60 | Within the module itself, we have to loop over the inputs to create the arrays that GSL wants to solve this problem. Second, after the solution is obtained, we have to build up a vector to return. The solution is in a gsl_vector, and we need to create an array of emacs_value elements containing each element of the gsl_vector as a float, and then create a vector to return to emacs. I use vectors here because it was easy to get the size of the b vector, which is also related to the size of the A matrix. 61 | 62 | The repo has a Makefile in it, so we can build this module with: 63 | 64 | #+BEGIN_SRC sh 65 | make gsl-linalg.so 66 | #+END_SRC 67 | 68 | Once it is compiled, we load it like this. In this post we are in the emacs-modules directory where the gsl-linalg.so library is, and it is not on my load-path, so I add it here. 69 | 70 | #+BEGIN_SRC emacs-lisp 71 | (add-to-list 'load-path (expand-file-name ".")) 72 | (require 'gsl-linalg) 73 | #+END_SRC 74 | 75 | #+RESULTS: 76 | : gsl-linalg 77 | 78 | Here is one function in the module: 79 | 80 | #+BEGIN_SRC emacs-lisp 81 | (describe-function 'gsl-linalg-LU-solve) 82 | #+END_SRC 83 | 84 | #+RESULTS: 85 | : gsl-linalg-LU-solve is a Lisp function. 86 | : 87 | : (gsl-linalg-LU-solve &rest ARGS) 88 | : 89 | : For more information check the manuals. 90 | : 91 | : (gsl-linalg-LU-solve A b). 92 | : Solve A x = b for x. 93 | : Returns a vector containing the solution x. 94 | 95 | Now, we can solve linear equations like this: 96 | 97 | #+BEGIN_SRC emacs-lisp 98 | (gsl-linalg-LU-solve 99 | [[0.18 0.60 0.57 0.96] 100 | [0.41 0.24 0.99 0.58] 101 | [0.14 0.30 0.97 0.66] 102 | [0.51 0.13 0.19 0.85]] 103 | [1.0 2.0 3.0 4.0]) 104 | #+END_SRC 105 | 106 | #+RESULTS: 107 | : [-4.052050229573973 -12.605611395906903 1.6609116267088417 8.693766928795227] 108 | 109 | 110 | We have a limited ability to confirm this answer. I have written a function that uses blas for multiplication of 2d vectors. You can see from this: 111 | 112 | #+BEGIN_SRC emacs-lisp 113 | (gsl-blas-dgemm [[0.18 0.60 0.57 0.96] 114 | [0.41 0.24 0.99 0.58] 115 | [0.14 0.30 0.97 0.66] 116 | [0.51 0.13 0.19 0.85]] 117 | [[-4.052050229573973] 118 | [-12.605611395906903] 119 | [1.6609116267088417] 120 | [8.693766928795227]]) 121 | #+END_SRC 122 | 123 | #+RESULTS: 124 | : [[1.0] [1.9999999999999991] [2.9999999999999996] [4.0]] 125 | 126 | That within float that indeed $A x = b$. 127 | 128 | The main limitation of this module at the moment is that you have to use vectors; you cannot put in a list of numbers. It is possible to make it take lists and vectors, but for now I am leaving it at vectors. Also, it only produces solutions of float numbers (not integers). 129 | 130 | The module does not handle 1d vectors well,, e.g. in gsl-linalg-LU-solve example, the right hand side is implied to be a column vector, and we don't have the array broadcasting features of Python yet. Those are doable things for some future day perhaps. For now I am happy to have figured out how to handle arrays! 131 | 132 | 133 | 134 | * A GSL root finder in a dynamic module 135 | :PROPERTIES: 136 | :categories: emacs,dynamic-module 137 | :END: 138 | 139 | In a previous [[http://kitchingroup.cheme.cmu.edu/blog/2017/05/21/A-partial-symbolic-numeric-solver-in-emacs-lisp/][post]] I implemented a Newton solver in elisp to solve some problems numerically. Today, we continue the dynamic module studies and implement a bracketed root solver from the GNU Scientific Library (https://www.gnu.org/software/gsl/doc/html/roots.html#examples). I will implement the Brent solver here, which is a bracketed root finder: You specify a bracket that contains the root, and the software automatically finds it. It isn't my favorite solver, I prefer a single initial guess, but this one was easier to implement for now, and the root polishing algorithms in GSL seem to all require the function and derivatives, which I did not want to get into now. 140 | 141 | The elisp signature I want to solve an equation $f(x; params) = 0$ is to following. 142 | 143 | #+BEGIN_SRC emacs-lisp 144 | (gsl-root-fsolver-brent f xlo xhi &optional params epsabs epsrel) 145 | #+END_SRC 146 | 147 | So, here it is in action. 148 | 149 | #+BEGIN_SRC emacs-lisp 150 | (add-to-list 'load-path (expand-file-name ".")) 151 | (require 'gsl-roots) 152 | #+END_SRC 153 | 154 | #+RESULTS: 155 | : gsl-roots 156 | 157 | Here is a simple equation $f(x; params) = x^2 - 5 = 0$. The solution should be $\sqrt(5)$ 158 | 159 | #+BEGIN_SRC emacs-lisp 160 | (gsl-root-fsolver-brent (lambda (x params) (- (* x x) 5)) 0.0 5.0) 161 | #+END_SRC 162 | 163 | #+RESULTS: 164 | : 2.2360634081902244 165 | 166 | For comparison: 167 | 168 | #+BEGIN_SRC emacs-lisp 169 | (sqrt 5) 170 | #+END_SRC 171 | 172 | #+RESULTS: 173 | : 2.23606797749979 174 | 175 | These differ in about the 5th decimal place. If we lower the relative error (the default is only 1e-3), we get quantitative agreement with the analytical solution. 176 | 177 | #+BEGIN_SRC emacs-lisp 178 | (gsl-root-fsolver-brent (lambda (x params) (- (* x x) 5)) 0.0 5.0 nil nil 1e-6) 179 | #+END_SRC 180 | 181 | #+RESULTS: 182 | : 2.23606797749979 183 | 184 | * List/vector functions 185 | 186 | This module 187 | #+BEGIN_SRC c :tangle mod-vector.c 188 | #include "emacs-module.h" 189 | #include 190 | 191 | /* Declare mandatory GPL symbol. */ 192 | int plugin_is_GPL_compatible; 193 | 194 | /* Bind NAME to FUN. */ 195 | static void bind_function (emacs_env *env, const char *name, emacs_value Sfun) 196 | { 197 | /* Set the function cell of the symbol named NAME to SFUN using 198 | the 'fset' function. */ 199 | 200 | /* Convert the strings to symbols by interning them */ 201 | emacs_value Qfset = env->intern (env, "fset"); 202 | emacs_value Qsym = env->intern (env, name); 203 | 204 | /* Prepare the arguments array */ 205 | emacs_value args[] = { Qsym, Sfun }; 206 | 207 | /* Make the call (2 == nb of arguments) */ 208 | env->funcall (env, Qfset, 2, args); 209 | } 210 | 211 | /* Provide FEATURE to Emacs. */ 212 | static void 213 | provide (emacs_env *env, const char *feature) 214 | { 215 | /* call 'provide' with FEATURE converted to a symbol */ 216 | 217 | emacs_value Qfeat = env->intern (env, feature); 218 | emacs_value Qprovide = env->intern (env, "provide"); 219 | emacs_value args[] = { Qfeat }; 220 | 221 | env->funcall (env, Qprovide, 1, args); 222 | } 223 | 224 | /* */ 225 | 226 | // This just returns the argument, works for a list. 227 | static emacs_value Ff1 (emacs_env *env, int nargs, emacs_value args[], void *data) 228 | { 229 | return args[0]; 230 | } 231 | 232 | // get first element of a vector 233 | static emacs_value Ff2 (emacs_env *env, int nargs, emacs_value args[], void *data) 234 | { 235 | return env->vec_get(env, args[0], 0); 236 | } 237 | 238 | // This just returns a vector of integers!!! 239 | static emacs_value Ff3 (emacs_env *env, int nargs, emacs_value args[], void *data) 240 | { 241 | int len = 2; 242 | emacs_value *array = malloc(sizeof(emacs_value) * len); 243 | array[0] = env->make_integer(env, 2); 244 | array[1] = env->make_integer(env, 4); 245 | 246 | emacs_value Fvector = env->intern(env, "vector"); 247 | emacs_value vec = env->funcall(env, Fvector, len, array); 248 | free(array); 249 | return vec; 250 | } 251 | 252 | // return vector * n 253 | static emacs_value Ff4 (emacs_env *env, int nargs, emacs_value args[], void *data) 254 | { 255 | emacs_value input = args[0]; 256 | double N = env->extract_float(env, args[1]); 257 | 258 | int len = env->vec_size (env, input); 259 | 260 | emacs_value *array = malloc(sizeof(emacs_value) * len); 261 | 262 | // multiply each value by N 263 | for (ptrdiff_t i = 0; i < len; i++) 264 | { 265 | array[i] = env->make_float(env, 266 | N * env->extract_float(env, 267 | env->vec_get (env, input, i))); 268 | } 269 | 270 | // If you change this to list, you get a list instead! 271 | emacs_value Fvector = env->intern(env, "vector"); 272 | emacs_value vec = env->funcall(env, Fvector, len, array); 273 | free(array); 274 | return vec; 275 | } 276 | 277 | // return 2nd element of vector 278 | static emacs_value Ff5 (emacs_env *env, int nargs, emacs_value args[], void *data) 279 | { 280 | emacs_value vec = args[0]; 281 | 282 | return env->vec_get (env, vec, 1); 283 | } 284 | 285 | // get second value of second vector 286 | static emacs_value Ff6 (emacs_env *env, int nargs, emacs_value args[], void *data) 287 | { 288 | emacs_value vec = args[0]; 289 | emacs_value v2 = env->vec_get (env, vec, 1); 290 | return env->vec_get (env, v2, 1); 291 | } 292 | 293 | // index a list 294 | static emacs_value Ff7 (emacs_env *env, int nargs, emacs_value args[], void *data) 295 | { 296 | emacs_value nth = env->intern(env, "nth"); 297 | 298 | return env->funcall (env, nth, 2, args); 299 | } 300 | 301 | int emacs_module_init (struct emacs_runtime *ert) 302 | { 303 | emacs_env *env = ert->get_environment (ert); 304 | 305 | #define DEFUN(lsym, csym, amin, amax, doc, data) \ 306 | bind_function (env, lsym, \ 307 | env->make_function (env, amin, amax, csym, doc, data)) 308 | 309 | DEFUN("f1", Ff1, 1, 1, NULL, NULL); 310 | DEFUN("f2", Ff2, 1, 1, NULL, NULL); 311 | DEFUN("f3", Ff3, 0, 0, NULL, NULL); 312 | DEFUN("f4", Ff4, 2, 2, NULL, NULL); 313 | DEFUN("f5", Ff5, 1, 1, NULL, NULL); 314 | DEFUN("f6", Ff6, 1, 1, NULL, NULL); 315 | DEFUN("f7", Ff7, 2, 2, NULL, NULL); 316 | 317 | provide (env, "mod-vector"); 318 | 319 | /* loaded successfully */ 320 | return 0; 321 | } 322 | #+END_SRC 323 | 324 | #+NAME: build 325 | #+BEGIN_SRC sh :var data="" 326 | rm -f mod-vector.so mod-vector.o 327 | gcc -Wall -I/usr/local/include -fPIC -c mod-vector.c 328 | gcc -shared -L/usr/local/include -lgsl -o mod-vector.so mod-vector.o 329 | #+END_SRC 330 | 331 | #+RESULTS: build 332 | 333 | #+BEGIN_SRC emacs-lisp :post build(data=*this*) 334 | (org-babel-tangle) 335 | #+END_SRC 336 | 337 | #+RESULTS: 338 | : nil 339 | * DONE Linear algebra in Emacs using MKL and dynamic modules 340 | CLOSED: [2017-07-21 Fri 15:48] 341 | :PROPERTIES: 342 | :categories: emacs,dynamic-module 343 | :CUSTOM_ID: mkl 344 | :date: 2017/07/21 15:48:05 345 | :updated: 2017/07/21 15:48:05 346 | :org-url: http://kitchingroup.cheme.cmu.edu/org/2017/07/21/Linear-algebra-in-Emacs-using-MKL-and-dynamic-modules.org 347 | :permalink: http://kitchingroup.cheme.cmu.edu/blog/2017/07/21/Linear-algebra-in-Emacs-using-MKL-and-dynamic-modules/index.html 348 | :ID: 6AD22605-9C9A-41AA-B162-6E6A650D9201 349 | :END: 350 | 351 | In a [[http://kitchingroup.cheme.cmu.edu/blog/2017/07/11/Adding-linear-algebra-to-Emacs-with-the-GSL-and-dynamic-modules/][previous post]] I integrated some linear algebra into Emacs using the GNU Scientific library and a dynamic module. In this post, I use a similar approach that uses the Intel MKL library in conjunction with some helper elisp functions to mimic the array broadcasting features in Numpy. I thought this might be easier and lead to at least a complementary set of functionalities. 352 | 353 | Note: I had to follow the directions [[http://osxdaily.com/2015/10/05/disable-rootless-system-integrity-protection-mac-os-x][here]] to disable some security feature on my Mac so that it would use the MKL libraries. Thanks Apple. 354 | 355 | It is convenient to use vectors for the representation of arrays in Emacs because there are nice functions in the emacs-module.h for accessing vector properties. Also vectors sound closer to an array than a list. So what about array broadcasting, e.g. the way numpy lets you multiply a 2d array with a 1d array? If you multiply two arrays with size (m1, n1) * (m2, n2), it is required that the number of columns in the first array (n1) be equal to the number of rows in the second one (m2), and the resulting size of the array product will be (m1, n2). What should happen though when we have 1d array? This is neither a row or column vector itself, but we can treat as either one if we choose too. For example the vector [1 2 3] can be thought of as an array with the shape (1, 3), e.g. a single row with three columns, or (3, 1), i.e. three rows in a single column. We will build this capability into the module for convenience. 356 | 357 | I still find it moderately tedious to write c functions that take emacs arguments, transform them to c arguments, do some c computations, and convert the results back to emacs values. So, we only implement one c function for this that multiplies two 2d arrays together using the cblas_dgemm routine in the MKL library. Then, we will create a complementary elisp library that will provide some additional functionality to get the shapes of vector arrays, dimensions, and allow us to multiply 1d and 2d vectors together the same way Numpy does array broadcasting. 358 | 359 | The dynamic module code is listed in [[id:45D04B39-1927-44ED-9402-E89D166AE8C8][The module code]]. The elisp code is listed in [[id:F5AEAF4E-317F-48D4-9815-8EB0331AF0E5][Elisp helper functions]]. In the following sections we just demonstrate how to use the results. 360 | 361 | ** Convenience functions to get array properties 362 | 363 | I found it convenient to do array shape and dimension analysis in elisp before sending arrays to the dynamic module. The shape of an array is just the number of elements in each dimension. Here we look at a 2\times 3 array. 364 | 365 | #+BEGIN_SRC emacs-lisp 366 | (vector-shape [[1 2 3] 367 | [3 4 5]]) 368 | #+END_SRC 369 | 370 | #+RESULTS: 371 | : [2 3] 372 | 373 | You see it returns a vector showing two rows and three columns. There are two convenience commands to get the number of rows (vector-nrows) and columns (vector-ncols). Here is one of them. 374 | 375 | #+BEGIN_SRC emacs-lisp 376 | (vector-ncols [[1 2 3] 377 | [3 4 5]]) 378 | #+END_SRC 379 | 380 | #+RESULTS: 381 | : 3 382 | 383 | 384 | ** Matrix multiplication 385 | 386 | The main problem we want to calculate is the matrix multiplication $A\cdotB$ where $A$ and $B$ are either 1d vectors or 2d arrays. Here we examine several representative cases of matrix multiplication. 387 | 388 | *** 1d * 1d 389 | 390 | This is a simple dot-product that is actually calculated in elisp. 391 | 392 | $[1 1 1] \cdot [2 2 2] = 6$ 393 | 394 | #+BEGIN_SRC emacs-lisp 395 | (matrix-multiply [1 1 1] [2 2 2]) 396 | #+END_SRC 397 | 398 | #+RESULTS: 399 | : 6.0 400 | 401 | ✓ 402 | 403 | Note we get a float. That is because we initialize the sum with 0.0 to be consistent with all the other cases which are done with floats. dgemm is a double routine in MKL, which means it should return floats. Internally in the module, we cast all numbers as doubles for the multiplication. 404 | 405 | *** 2d * 1d 406 | 407 | This is a matrix multiplication that is typically like $A b$ where $b$ is a column vector. We return a 1d array as a result, rather than a 2d array of nrows and 1 column. 408 | 409 | \[ \left[\begin{array}{cc} 410 | 1 & 2 \\ 411 | 3 & 4 \end{array}\right] 412 | \left [ \begin{array}{c} 413 | 1 \\ 1 \end{array}\right] = \left[\begin{array}{c}3\\7\end{array}\right]\] 414 | 415 | #+BEGIN_SRC emacs-lisp 416 | (let ((A [[1 2] 417 | [3 4]]) 418 | (b [1 1])) 419 | (matrix-multiply A b)) 420 | #+END_SRC 421 | 422 | #+RESULTS: 423 | : [3.0 7.0] 424 | 425 | ✓ 426 | 427 | *** 1d * 2d 428 | 429 | This case is $b A$ where $b$ is a row vector. For example: 430 | 431 | \[\left[\begin{array}{cc}1 & 1\end{array}\right] 432 | \left[\begin{array}{cc} 1 & 2\\ 3 & 4\end{array}\right] = \left[\begin{array}{cc} 4 & 6 \end{array}\right ]\] 433 | 434 | #+BEGIN_SRC emacs-lisp 435 | (matrix-multiply [1 1] 436 | [[1 2] 437 | [3 4]]) 438 | #+END_SRC 439 | 440 | #+RESULTS: 441 | : [4.0 6.0] 442 | 443 | ✓ 444 | 445 | As with the previous case, we return a 1d vector result rather than a 2d array with 1 row and ncolumns. 446 | 447 | *** 2d * 2d 448 | 449 | Finally we have the case of $A B$. The number of columns in A must be the same as the number of rows in B, and the result has a size that is the number of rows in A and the number of columns in B. Here is one [[http://www.sosmath.com/matrix/matrix1/matrix1.html][example]]: 450 | 451 | \[\left[\begin{array}{cc} 0 & 1\\ 0 & 0\end{array}\right] 452 | \left[\begin{array}{cc} 0 & 0\\ 1 & 0\end{array}\right] 453 | = \left[\begin{array}{cc} 1 & 0\\ 0 & 0\end{array}\right] \] 454 | 455 | #+BEGIN_SRC emacs-lisp 456 | (matrix-multiply [[0 1] 457 | [0 0]] 458 | [[0 0] 459 | [1 0]]) 460 | #+END_SRC 461 | 462 | #+RESULTS: 463 | : [[1.0 0.0] [0.0 0.0]] 464 | 465 | ✓ 466 | 467 | This example is adapted from [[https://stackoverflow.com/questions/21547462/how-to-multiply-2-dimensional-arrays-matrix-multiplication][here]]. The correct answer is at the bottom of that page, and shown here. 468 | 469 | \[\left[\begin{array}{cccc} 1 & 2 & -2 & 0 \\ -3 & 4 & 7 & 2 \\ 6 & 0 & 3 & 1\end{array}\right] 470 | \left[\begin{array}{cc} -1 & 3 \\ 0 & 9 \\ 1 & -11 \\ 4 & -5 \end{array}\right] 471 | = \left[\begin{array}{cc} -3 & 43 \\ 18 & -60 \\ 4 & -5\end{array}\right] \] 472 | 473 | For readability we use temporary variables here, and pretty-print the result. 474 | 475 | #+BEGIN_SRC emacs-lisp 476 | (let ((A [[1 2 -2 0] 477 | [-3 4 7 2] 478 | [6 0 3 1]]) 479 | (B [[-1 3] 480 | [0 9] 481 | [1 -11] 482 | [4 -5]])) 483 | (pp (matrix-multiply A B))) 484 | #+END_SRC 485 | 486 | #+RESULTS: 487 | : [[-3.0 43.0] 488 | : [18.0 -60.0] 489 | : [1.0 -20.0]] 490 | 491 | ✓ 492 | 493 | So, all these example work as we expect. The elisp function for matrix-multiply does a lot of work for you to make these cases work, including error checking for dimensional consistency. 494 | 495 | ** Summary thoughts 496 | 497 | It was not any easier to write this dynamic module than the previous one I used with the Gnu Scientific Library. The approach and code are remarkably similar. In one way the GSL was easier to use; it worked out of the box, whereas I had to fiddle with a security option in my OS to get it to run MKL! My Anaconda Python distribution must get around that somehow since it ships with an MKL compiled Numpy and scipy. 498 | 499 | The idea of using elisp for analysis of the inputs and making sure they are correct is a good one and helps prevent segfaults. Of course it is a good idea to write defensive c-code to avoid that too. Overall, this is another good example of expanding the capabilities of Emacs with a dynamic module. 500 | 501 | ** The module code 502 | :PROPERTIES: 503 | :ID: 45D04B39-1927-44ED-9402-E89D166AE8C8 504 | :END: 505 | 506 | The c-code is loosely adapted from https://software.intel.com/en-us/node/529735. We do not implement the full dgemm behavior which is able to calculate $C = \alpha A * B + \beta*C$. We set \alpha=1, and \beta=0 in this example. We should do some dimension checking here, but it is easier to do it in emacs in a helper function. As long as you use the helper function there should not be an issue, but it is possible to segfault Emacs if you use the module function incorrectly. 507 | 508 | #+BEGIN_SRC c :tangle mkl.c 509 | #include "emacs-module.h" 510 | #include "emacs-module-helpers.h" 511 | #include 512 | 513 | int plugin_is_GPL_compatible; 514 | 515 | emacs_value Fmkl_dgemm (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 516 | { 517 | double *A, *B, *C; 518 | int m, n, k, i, j; 519 | double alpha = 1.0; 520 | double beta = 0.0; 521 | 522 | // These will be 2d vectors 523 | emacs_value M0 = args[0]; // array 1 - A (m x k) 524 | emacs_value M1 = args[1]; // array 2 - B (k x n) 525 | 526 | // I need to get the number of rows and columns of each one. 527 | m = env->vec_size(env, M0); 528 | k = 0; 529 | // We assume that we have a 2d array. 530 | emacs_value el1 = env->vec_get (env, M0, 0); 531 | k = env->vec_size(env, el1); 532 | 533 | // Now we know A has dimensions (m, k) 534 | 535 | emacs_value el2 = env->vec_get (env, M1, 0); 536 | n = env->vec_size(env, el2); 537 | 538 | // Now we know M1 had dimensions (k, n) 539 | 540 | // Now we have to build up arrays. 541 | // We are looking at a * b = c 542 | A = (double *)mkl_malloc( m*k*sizeof( double ), 64 ); 543 | B = (double *)mkl_malloc( k*n*sizeof( double ), 64 ); 544 | C = (double *)mkl_malloc( m*n*sizeof( double ), 64 ); 545 | if (A == NULL || B == NULL || C == NULL) { 546 | printf( "\n ERROR: Can't allocate memory for matrices. Aborting... \n\n"); 547 | mkl_free(A); 548 | mkl_free(B); 549 | mkl_free(C); 550 | return 1; 551 | } 552 | 553 | //populate A 554 | emacs_value row, ij; 555 | for (int i = 0; i < m; i++) 556 | { 557 | row = env->vec_get(env, M0, i); 558 | for (int j = 0; j < k; j++) 559 | { 560 | // get M0[i, j] 561 | ij = env->vec_get(env, row, j); 562 | A[k * i + j] = extract_double(env, ij); 563 | } 564 | } 565 | 566 | // populate B 567 | for (int i = 0; i < k; i++) 568 | { 569 | row = env->vec_get(env, M1, i); 570 | for (int j = 0; j < n; j++) 571 | { 572 | // get M0[i, j] 573 | ij = env->vec_get(env, row, j); 574 | B[n * i + j] = extract_double(env, ij); 575 | } 576 | } 577 | 578 | // initialize C. The solution will have dimensions of (rows1, cols2). 579 | for (int i = 0; i < m; i++) 580 | { 581 | for (int j = 0; j < n; j++) 582 | { 583 | C[n * i + j] = 0.0; 584 | } 585 | } 586 | 587 | // the multiplication is done here. 588 | cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, 589 | m, n, k, alpha, A, k, B, n, beta, C, n); 590 | 591 | // now we build up the vector to return 592 | emacs_value vector = env->intern(env, "vector"); 593 | emacs_value *array = malloc(sizeof(emacs_value) * m); 594 | emacs_value *row1; 595 | emacs_value vec; 596 | for (int i = 0; i < m; i++) 597 | { 598 | row1 = malloc(sizeof(emacs_value) * n); 599 | for (int j = 0; j < n; j++) 600 | { 601 | row1[j] = env->make_float(env, C[j + i * n]); 602 | } 603 | vec = env->funcall(env, vector, n, row1); 604 | array[i] = vec; 605 | free(row1); 606 | } 607 | 608 | emacs_value result = env->funcall(env, vector, m, array); 609 | free(array); 610 | return result; 611 | } 612 | 613 | 614 | int emacs_module_init(struct emacs_runtime *ert) 615 | { 616 | emacs_env *env = ert->get_environment(ert); 617 | 618 | DEFUN("mkl-dgemm", Fmkl_dgemm, 2, 2, 619 | "(mkl-dgemm A B)\n"\ 620 | "Multiply the matrices A and B. A and B must both be 2d vectors.\n" \ 621 | "Returns the product as a vector.", 622 | NULL); 623 | provide(env, "mkl"); 624 | 625 | return 0; 626 | } 627 | 628 | #+END_SRC 629 | 630 | To build this we have to run elisp:org-babel-tangle to generate the mkl.c file, and then run this shell block to compile it. 631 | 632 | #+BEGIN_SRC sh 633 | sh /opt/intel/mkl/bin/mklvars.sh intel64 634 | gcc -Wall -m64 -I${MKLROOT}/include -fPIC -c mkl.c 635 | gcc -shared -L${MKLROOT}/lib -Wl,-rpath,${MKLROOT}/lib -lmkl_rt -lpthread -lm -ldl -L. -lemacs-module-helpers -o mkl.so mkl.o 636 | #+END_SRC 637 | 638 | #+RESULTS: 639 | 640 | 641 | ** Elisp helper functions 642 | :PROPERTIES: 643 | :ID: F5AEAF4E-317F-48D4-9815-8EB0331AF0E5 644 | :END: 645 | 646 | We will often want to know the shape of our arrays. The shape is how many elements there are in each dimension. Here we define a recursive function that gets the shape of arbitrarily nested vectors and returns a vector of the shape. We define some helper functions to get the number of dimensions, elements, rows and columns. 647 | 648 | The main function is a helper elisp function that multiplies two arrays. The function analyzes the shapes and transforms 1d vectors into the right 2d shape to multiply them together, and then returns the shape that makes sense. The c-code is not very robust to mistakes in the array dimensions. It tends to make emacs segfault if you get it wrong. So we try to avoid that if possible. 649 | 650 | We have four cases to consider for multiplication: 651 | 652 | - 2d * 2d :: (assert (= m1 n2)) return (n1, m2) 653 | - 1d * 2d :: 1d is a row vector (1, n1) (assert (= n1 m2)) return vector with n2 elements 654 | - 2d * 1d :: 1d is a column vector (m2, 1) (assert (= n1 m2)) return vector with m2 elements 655 | - 1d * 1d :: (assert (= (length m1) (length m2)) return a scalar 656 | 657 | Here is the 658 | 659 | #+BEGIN_SRC emacs-lisp 660 | (add-to-list 'load-path (expand-file-name ".")) 661 | (require 'mkl) 662 | (require 'cl) 663 | (require 'seq) 664 | 665 | (defun vector-shape (vec) 666 | "Return a vector of the shape of VEC." 667 | (let ((shape (vector (length vec)))) 668 | (if (vectorp (aref vec 0)) 669 | (vconcat shape (vector-shape (aref vec 0))) 670 | shape))) 671 | 672 | (defun vector-ndims (vec) 673 | "Returns the number of dimensions in VEC." 674 | (length (vector-shape vec))) 675 | 676 | 677 | (defun vector-numel (vec) 678 | "Returns the number of elements in VEC." 679 | (if (> (length vec) 0) 680 | (seq-reduce '* (vector-shape vec) 1) 681 | 0)) 682 | 683 | 684 | (defun vector-nrows (vec) 685 | "Return the number of rows in VEC." 686 | (aref (vector-shape vec) 0)) 687 | 688 | 689 | (defun vector-ncols (vec) 690 | "Return the number of columns in VEC." 691 | (aref (vector-shape vec) 1)) 692 | 693 | 694 | (defun matrix-multiply (A B) 695 | "Return A * B in the matrix multiply sense." 696 | (cond 697 | ;; 1d * 1d i.e. a dot-product 698 | ((and (= 1 (vector-ndims A)) 699 | (= 1 (vector-ndims B)) 700 | (= (length A) (length B))) 701 | ;; this is easy to compute so we don't use dgemm. 702 | (seq-reduce '+ (mapcar* (lambda (a b) (* a b)) A B) 0.0)) 703 | 704 | ;; 2d * 1d (m1, n1) * (n2, 1) 705 | ((and (= 2 (vector-ndims A)) 706 | (= 1 (vector-ndims B)) 707 | ;; ncols-A = len-B 708 | (= (vector-ncols A) (length B))) 709 | ;; transform B into a 2d column vector 710 | (let* ((B2d (apply 'vector (mapcar 'vector B))) 711 | (result (mkl-dgemm A B2d))) 712 | ;; Now call (dgemm A B2d) -> (m2, 1) column vector 713 | ;; and convert it back to a 1d result 714 | (cl-map 'vector (lambda (v) (aref v 0)) result))) 715 | 716 | ;; 1d * 2d (1, n1) * (m2, n2) len-A = nrows-B 717 | ((and (= 1 (vector-ndims A)) 718 | (= 2 (vector-ndims B)) 719 | (= (length A) (vector-nrows B))) 720 | ;; transform B into a 2d row vector 721 | (let* ((A2d (vector A)) 722 | (result (mkl-dgemm A2d B))) 723 | ;; should be a 2d row vector 724 | (aref result 0))) 725 | 726 | ;; 2d * 2d (m1, n1) * (m2, n2) rows-A = ncols-B 727 | ((and (= 2 (vector-ndims A)) 728 | (= 2 (vector-ndims B)) 729 | (= (vector-ncols A) 730 | (vector-nrows B))) 731 | ;; call (dgemm A B) and return result 732 | (mkl-dgemm A B)) 733 | (t 734 | ;; Error checking, getting here means none of the cases above were caught. 735 | ;; something is probably wrong. 736 | (cond 737 | ((or (> (vector-ndims A) 2) 738 | (> (vector-ndims B) 2)) 739 | (error "One of your arrays has more than 2 dimensions. Only 1 or 2d arrays are supported")) 740 | ((and (= 1 (vector-ndims A)) 741 | (= 1 (vector-ndims B)) 742 | (not (= (length A) (length B)))) 743 | (error "A and B must be the same length. 744 | len(A) = %d 745 | len(B) = %d" (length A) (length B))) 746 | ((and 747 | (= (vector-ndims A) 2) 748 | (= (vector-ndims B) 2) 749 | (not (= (vector-nrows A) (vector-ncols B)))) 750 | (error "Your array shapes are not correct. 751 | The number of rows in array A must equal the number of columns in array B. 752 | There are %d rows in A and %d columns in B" (vector-nrows A) (vector-ncols B))) 753 | ((and 754 | (= (vector-ndims A) 2) 755 | (= (vector-ndims B) 1) 756 | (not (= (vector-nrows A) (length B)))) 757 | (error "Your array shapes are not correct. 758 | The number of rows in array A must equal the number of columns in array B. 759 | There are %d rows in A and %d columns in B" (vector-nrows A) (length B))) 760 | (t 761 | (error "Unknown error")))))) 762 | #+END_SRC 763 | 764 | #+RESULTS: 765 | : matrix-multiply 766 | 767 | -------------------------------------------------------------------------------- /gsl-constants.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "emacs-module.h" 3 | #include "emacs-module-helpers.h" 4 | 5 | int plugin_is_GPL_compatible; 6 | 7 | int emacs_module_init(struct emacs_runtime *ert) 8 | { 9 | emacs_env *env = ert->get_environment(ert); 10 | 11 | defconst(env, "GSL-CONST-MKSA-SPEED-OF-LIGHT", 12 | GSL_CONST_MKSA_SPEED_OF_LIGHT, 13 | "Speed of light in vacuum (m/s)."); 14 | 15 | defconst(env, "GSL-CONST-MKSA-PLANCKS-CONSTANT-H", 16 | GSL_CONST_MKSA_PLANCKS_CONSTANT_H, 17 | "Plank's constant, h"); 18 | 19 | provide(env, "gsl-constants"); 20 | 21 | return 0; 22 | } 23 | -------------------------------------------------------------------------------- /gsl-ffi/ffi.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding:t -*- 2 | 3 | (require 'cl-macs) 4 | 5 | (module-load "ffi-module.so") 6 | 7 | (gv-define-simple-setter ffi--mem-ref ffi--mem-set t) 8 | 9 | (defmacro define-ffi-library (symbol name) 10 | (let ((library (cl-gensym))) 11 | (set library nil) 12 | `(defun ,symbol () 13 | (or ,library 14 | (setq ,library (ffi--dlopen ,name)))))) 15 | 16 | (defmacro define-ffi-function (name c-name return-type arg-types library) 17 | (let* ( 18 | ;; Turn variable references into actual types; while keeping 19 | ;; keywords the same. 20 | (arg-types (mapcar #'symbol-value arg-types)) 21 | (arg-names (mapcar (lambda (_ignore) (cl-gensym)) arg-types)) 22 | (arg-types (vconcat arg-types)) 23 | (function (cl-gensym)) 24 | (cif (ffi--prep-cif (symbol-value return-type) arg-types))) 25 | (set function nil) 26 | `(defun ,name (,@arg-names) 27 | (unless ,function 28 | (setq ,function (ffi--dlsym ,c-name (,library)))) 29 | ;; FIXME do we even need a separate prep? 30 | (ffi--call ,cif ,function ,@arg-names)))) 31 | 32 | (defun ffi-lambda (function-pointer return-type arg-types) 33 | (let* ((cif (ffi--prep-cif return-type (vconcat arg-types)))) 34 | (lambda (&rest args) ; lame 35 | (apply #'ffi--call cif function-pointer args)))) 36 | 37 | (defsubst ffi--align (offset align) 38 | (+ offset (mod (- align (mod offset align)) align))) 39 | 40 | (defun ffi--lay-out-struct (types) 41 | (let ((offset 0)) 42 | (mapcar (lambda (this-type) 43 | (setf offset (ffi--align offset 44 | (ffi--type-alignment this-type))) 45 | (let ((here offset)) 46 | (cl-incf offset (ffi--type-size this-type)) 47 | here)) 48 | types))) 49 | 50 | (defun ffi--struct-union-helper (name slots definer-function layout-function) 51 | (cl-assert (symbolp name)) 52 | (let* ((docstring (if (stringp (car slots)) 53 | (pop slots))) 54 | (conc-name (concat (symbol-name name) "-")) 55 | (result-forms ()) 56 | (field-types (mapcar (lambda (slot) 57 | (cl-assert (eq (cadr slot) :type)) 58 | (symbol-value (cl-caddr slot))) 59 | slots)) 60 | (the-type (apply definer-function field-types)) 61 | (field-offsets (funcall layout-function field-types))) 62 | (push `(defvar ,name ,the-type ,docstring) 63 | result-forms) 64 | (cl-mapc 65 | (lambda (slot type offset) 66 | (let ((getter-name (intern (concat conc-name 67 | (symbol-name (car slot))))) 68 | (offsetter (if (> offset 0) 69 | `(ffi-pointer+ object ,offset) 70 | 'object))) 71 | ;; One benefit of using defsubst here is that we don't have 72 | ;; to provide a GV setter. 73 | (push `(cl-defsubst ,getter-name (object) 74 | (ffi--mem-ref ,offsetter ,type)) 75 | result-forms))) 76 | slots field-types field-offsets) 77 | (cons 'progn (nreverse result-forms)))) 78 | 79 | (defmacro define-ffi-struct (name &rest slots) 80 | "Like a limited form of `cl-defstruct', but works with foreign objects. 81 | 82 | NAME must be a symbol. 83 | Each SLOT must be of the form `(SLOT-NAME :type TYPE)', where 84 | SLOT-NAME is a symbol and TYPE is an FFI type descriptor." 85 | (ffi--struct-union-helper name slots #'ffi--define-struct 86 | #'ffi--lay-out-struct)) 87 | 88 | (defmacro define-ffi-union (name &rest slots) 89 | "Like a limited form of `cl-defstruct', but works with foreign objects. 90 | 91 | NAME must be a symbol. 92 | Each SLOT must be of the form `(SLOT-NAME :type TYPE)', where 93 | SLOT-NAME is a symbol and TYPE is an FFI type descriptor." 94 | (ffi--struct-union-helper name slots #'ffi--define-union 95 | (lambda (types) 96 | (make-list (length types) 0)))) 97 | 98 | (defmacro define-ffi-array (name type length &optional docstring) 99 | ;; This is a hack until libffi gives us direct support. 100 | (let ((type-description 101 | (apply #'ffi--define-struct 102 | (make-list (eval length) (symbol-value type))))) 103 | `(defvar ,name ,type-description ,docstring))) 104 | 105 | (defsubst ffi-aref (array type index) 106 | (ffi--mem-ref (ffi-pointer+ array (* index (ffi--type-size type))) type)) 107 | 108 | (defmacro with-ffi-temporary (binding &rest body) 109 | (declare (indent defun)) 110 | `(let ((,(car binding) (ffi-allocate ,@(cdr binding)))) 111 | (unwind-protect 112 | (progn ,@body) 113 | (ffi-free ,(car binding))))) 114 | 115 | (defmacro with-ffi-temporaries (bindings &rest body) 116 | (declare (indent defun)) 117 | (let ((first-binding (car bindings)) 118 | (rest-bindings (cdr bindings))) 119 | (if rest-bindings 120 | `(with-ffi-temporary ,first-binding 121 | (with-ffi-temporaries ,rest-bindings 122 | ,@body)) 123 | `(with-ffi-temporary ,first-binding ,@body)))) 124 | 125 | (defmacro with-ffi-string (binding &rest body) 126 | (declare (indent defun)) 127 | `(let ((,(car binding) (ffi-make-c-string ,@(cdr binding)))) 128 | (unwind-protect 129 | (progn ,@body) 130 | (ffi-free ,(car binding))))) 131 | 132 | (defmacro with-ffi-strings (bindings &rest body) 133 | (declare (indent defun)) 134 | (let ((first-binding (car bindings)) 135 | (rest-bindings (cdr bindings))) 136 | (if rest-bindings 137 | `(with-ffi-string ,first-binding 138 | (with-ffi-strings ,rest-bindings 139 | ,@body)) 140 | `(with-ffi-string ,first-binding ,@body)))) 141 | 142 | (provide 'ffi) 143 | -------------------------------------------------------------------------------- /gsl-ffi/gsl-ffi.org: -------------------------------------------------------------------------------- 1 | * Using emacs-ffi with the Gnu Scientific Library 2 | 3 | #+BEGIN_SRC emacs-lisp 4 | (add-to-list 'load-path (expand-file-name ".")) 5 | (require 'ffi) 6 | 7 | (define-ffi-library gsl "libgsl") 8 | #+END_SRC 9 | 10 | #+RESULTS: 11 | : gsl 12 | 13 | ** Simple functions 14 | 15 | #+BEGIN_SRC emacs-lisp 16 | 17 | (define-ffi-function gsl-sf-bessel-J0 "gsl_sf_bessel_J0" 18 | (:double "Function value") ;return value 19 | ((:double x "x")) ; args 20 | gsl 21 | "Regular cylindrical Bessel function of zeroth order, J_0(x)") 22 | (gsl-sf-bessel-J0 5.0) 23 | #+END_SRC 24 | 25 | #+RESULTS: 26 | : -0.17759677131433826 27 | 28 | #+BEGIN_SRC emacs-lisp 29 | (describe-function 'gsl-sf-bessel-J0) 30 | #+END_SRC 31 | 32 | #+RESULTS: 33 | #+begin_example 34 | gsl-sf-bessel-J0 is a Lisp function. 35 | 36 | (gsl-sf-bessel-J0 X) 37 | 38 | For more information check the manuals. 39 | 40 | Regular cylindrical Bessel function of zeroth order, J_0(x) 41 | 42 | X (:double) x 43 | 44 | Returns: Function value (:double) 45 | #+end_example 46 | 47 | ** Integration function 48 | 49 | #+BEGIN_SRC emacs-lisp 50 | (define-ffi-function gsl-integration-workspace-alloc "gsl_integration_workspace_alloc" 51 | (:pointer "gsl_integration_workspace") 52 | ((:size_t n)) 53 | gsl 54 | "This function allocates a workspace sufficient to hold n 55 | double precision intervals, their integration results and error 56 | estimates. One workspace may be used multiple times as all 57 | necessary reinitialization is performed automatically by the 58 | integration routines.") 59 | 60 | (define-ffi-function gsl-integration-workspace-free "gsl_integration_workspace_free" 61 | (:void) 62 | ((:pointer *w "gsl_integration_workspace")) 63 | gsl 64 | "This function frees the memory associated with the workspace w.") 65 | 66 | (define-ffi-function gsl-integration-qags "gsl_integration_qags" 67 | (:int "Integral result") 68 | ((:pointer *f "gsl_function") 69 | (:double a) (:double b) 70 | (:double epsabs) (:double epsrel) 71 | (:size_t limit) (:pointer *w "gsl-integration-workspace") 72 | (:pointer *result "double") (:pointer *abserr "double")) 73 | gsl 74 | "This function applies the Gauss-Kronrod 21-point integration 75 | rule adaptively until an estimate of the integral of f over (a,b) 76 | is achieved within the desired absolute and relative error 77 | limits, epsabs and epsrel. The results are extrapolated using the 78 | epsilon-algorithm, which accelerates the convergence of the 79 | integral in the presence of discontinuities and integrable 80 | singularities. The function returns the final approximation from 81 | the extrapolation, result, and an estimate of the absolute error, 82 | abserr. The subintervals and their results are stored in the 83 | memory provided by workspace. The maximum number of subintervals 84 | is given by limit, which may not exceed the allocated size of the 85 | workspace.") 86 | 87 | (define-ffi-struct gsl_function (function :type :pointer) (params :type :pointer)) 88 | 89 | #+END_SRC 90 | 91 | #+RESULTS: 92 | : gsl_function-params 93 | 94 | Here is a working example. 95 | 96 | #+BEGIN_SRC emacs-lisp :results value 97 | (defun ff (x params) (/ (log x) (sqrt x))) 98 | 99 | (let* ((*w (gsl-integration-workspace-alloc 1000)) 100 | (F (ffi--define-struct gsl_function)) 101 | (cif (ffi--prep-cif :double [:double :pointer])) 102 | (*f (ffi-make-closure cif #'ff)) 103 | (a 0.0) 104 | (b 1.0) 105 | (epsabs 0.0) 106 | (epsrel 1e-7) 107 | (limit 1000) 108 | (result (ffi-allocate :double)) 109 | (abserr (ffi-allocate :double))) 110 | (setf (gsl_function-function F) *f) 111 | (gsl-integration-qags F a b epsabs epsrel limit *w result abserr) 112 | (ffi--mem-ref result :double)) 113 | #+END_SRC 114 | 115 | #+RESULTS: 116 | : -4.000000000000085 117 | -------------------------------------------------------------------------------- /gsl-integration.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "emacs-module.h" 3 | #include "emacs-module-helpers.h" 4 | 5 | int plugin_is_GPL_compatible; 6 | 7 | static emacs_value F_gsl_integrate (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 8 | { 9 | // nested function - only supported as an extension in gcc 10 | double f (double x, void *params) 11 | { 12 | // we use funcall to evaluate the function so everything is an emacs_value 13 | // type 14 | emacs_value fn = args[0]; // function we will integrate 15 | emacs_value x2[] = { env->make_float(env, x), params }; 16 | emacs_value y = env->funcall(env, fn, 2, x2); 17 | 18 | return extract_double(env, y); 19 | } 20 | 21 | double a = extract_double (env, args[1]); 22 | double b = extract_double (env, args[2]); 23 | 24 | // default values for optional arguments 25 | double epsabs = 0.0; 26 | double epsrel = 1e-7; 27 | size_t limit = 1000; 28 | double result, error; 29 | 30 | // Here is how I handle the optional arguments 31 | // (gsl-integrate func a b params epsabs epsrel limit) 32 | gsl_function F; 33 | F.function = &f; 34 | if (nargs >= 4) {F.params = args[3];} 35 | if (nargs >= 5 && env->is_not_nil(env, args[4])) {epsabs = extract_double(env, args[4]);} 36 | if (nargs >= 6 && env->is_not_nil(env, args[5])) {epsrel = extract_double(env, args[5]);} 37 | if (nargs >= 7 && env->is_not_nil(env, args[6])) {limit = extract_integer(env, args[6]);} 38 | 39 | gsl_integration_workspace * w = gsl_integration_workspace_alloc (limit); 40 | 41 | gsl_integration_qags (&F, // gsl_function pointer 42 | a, // lower integration bound 43 | b, // upper integration bound 44 | epsabs, // absolute error tolerance 45 | epsrel, // relative error tolerance 46 | limit, // max number of subintervals for integration 47 | w, // the workspace 48 | // pointers to put results and error in 49 | &result, &error); 50 | 51 | gsl_integration_workspace_free (w); 52 | 53 | // make a list of (result error) to return 54 | emacs_value Qlist = env->intern(env, "list"); 55 | emacs_value Qresult = env->make_float (env, result); 56 | emacs_value Qerror = env->make_float (env, error); 57 | emacs_value list_args[] = { Qresult, Qerror }; 58 | return env->funcall(env, Qlist, 2, list_args); 59 | } 60 | 61 | int emacs_module_init(struct emacs_runtime *ert) 62 | { 63 | emacs_env *env = ert->get_environment(ert); 64 | 65 | DEFUN("gsl-integration-qags", F_gsl_integrate, 3, 7, 66 | "(gsl-integration-qags F A B &optional PARAMS EPSABS EPSREL LIMIT)\n" \ 67 | "Integrate F(x; params) from A to B.\n" \ 68 | "F is a function of a single variable and parameters.\n" \ 69 | "A is the lower bound of integration\n" \ 70 | "B is the upper bound of integration.\n" \ 71 | "Optional parameters:\n" \ 72 | "PARAMS is a list of params to pass to F.\n" \ 73 | "EPSABS is a float (default 0.0) and is the absolute error tolerance.\n" \ 74 | "EPSREL is a float (default 1e-7) and is the relative error tolerance.\n" \ 75 | "LIMIT is the maximum number of subintervals for the integration (default 1000).\n" \ 76 | "Returns (list result error-estimate).\n" \ 77 | "See https://www.gnu.org/software/gsl/manual/html_node/QAGS-adaptive-integration-with-singularities.html.", 78 | 0); 79 | 80 | provide(env, "gsl-integration"); 81 | return 0; 82 | } 83 | -------------------------------------------------------------------------------- /gsl-linalg.c: -------------------------------------------------------------------------------- 1 | #include "emacs-module.h" 2 | #include "emacs-module-helpers.h" 3 | #include 4 | #include 5 | 6 | int plugin_is_GPL_compatible; 7 | 8 | // (gsl_blas_dgemm M0 M1) 9 | // Caveat: This only works for 2d vectors right now. 10 | // Adapted from https://www.gnu.org/software/gsl/doc/html/blas.html#examples 11 | static emacs_value Fgsl_blas_dgemm (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 12 | { 13 | // These will be 2d vectors 14 | emacs_value M0 = args[0]; 15 | emacs_value M1 = args[1]; 16 | 17 | // I need to get the number of rows and columns of each one. 18 | size_t rows1 = env->vec_size(env, M0); 19 | size_t cols1 = 0; 20 | 21 | // columns are trickier. We check the first element of the array. If it is a 22 | // vector, we get its length, otherwise it is a 1d vector and we should raise 23 | // an error. I don't know how to do that yet. 24 | emacs_value el1 = env->vec_get (env, M0, 0); 25 | if (env->eq(env, 26 | env->type_of(env, el1), 27 | env->intern(env, "vector"))) 28 | { 29 | cols1 = env->vec_size(env, el1); 30 | } 31 | 32 | // Now we know M0 has dimensions (rows1, cols1) 33 | 34 | size_t rows2 = env->vec_size(env, M1); 35 | size_t cols2 = 0; 36 | emacs_value el2 = env->vec_get (env, M1, 0); 37 | if (env->eq(env, 38 | env->type_of(env, el2), 39 | env->intern(env, "vector"))) 40 | { 41 | cols2 = env->vec_size(env, el2); 42 | } 43 | 44 | // Now we know M1 had dimensions (rows2, cols2) 45 | 46 | // Now we have to build up arrays. 47 | // We are looking at a * b = c 48 | double a[rows1 * cols1], b[rows2 * cols2]; 49 | double c[rows1 * cols2]; 50 | 51 | //populate a 52 | emacs_value row, ij; 53 | for (int i = 0; i < rows1; i++) 54 | { 55 | row = env->vec_get(env, M0, i); 56 | for (int j = 0; j < cols1; j++) 57 | { 58 | // get M0[i, j] 59 | ij = env->vec_get(env, row, j); 60 | a[cols1 * i + j] = extract_double(env, ij); 61 | } 62 | } 63 | 64 | // populate b 65 | for (int i = 0; i < rows2; i++) 66 | { 67 | row = env->vec_get(env, M1, i); 68 | for (int j = 0; j < cols2; j++) 69 | { 70 | // get M0[i, j] 71 | ij = env->vec_get(env, row, j); 72 | b[cols2 * i + j] = extract_double(env, ij); 73 | } 74 | } 75 | 76 | // initialize c. The solution will have dimensions of (rows1, cols2). 77 | for (int i = 0; i < rows1; i++) 78 | { 79 | for (int j = 0; j < cols2; j++) 80 | { 81 | c[cols2 * i + j] = 0.0; 82 | } 83 | } 84 | 85 | gsl_matrix_view A = gsl_matrix_view_array(a, rows1, cols1); 86 | gsl_matrix_view B = gsl_matrix_view_array(b, rows2, cols2); 87 | gsl_matrix_view C = gsl_matrix_view_array(c, rows1, cols2); 88 | 89 | /* Compute C = A B */ 90 | gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 91 | 1.0, &A.matrix, &B.matrix, 92 | 0.0, &C.matrix); 93 | 94 | // printf ("[ %g, %g\n ]", b[0], b[1]); 95 | // printf ("[ %g, %g\n ]", b[2], b[3]); 96 | // printf ("[ %g, %g\n ]", b[4], b[5]); 97 | 98 | // Finally, C is a gsl_matrix_view_array. We need to build up a vector to 99 | // return. it has rows1 vectors of length cols2 100 | emacs_value *array = malloc(sizeof(emacs_value) * rows1); 101 | emacs_value *row1; 102 | emacs_value vector = env->intern(env, "vector"); 103 | emacs_value vec; 104 | for (int i=0; i < rows1; i++) 105 | { 106 | row1 = malloc(sizeof(emacs_value) * cols2); 107 | for (int j=0; j < cols2; j++) 108 | { 109 | row1[j] = env->make_float(env, gsl_matrix_get(&C.matrix, i, j)); 110 | } 111 | vec = env->funcall(env, vector, cols2, row1); 112 | array[i] = vec; 113 | free(row1); 114 | } 115 | emacs_value result = env->funcall(env, vector, rows1, array); 116 | free(array); 117 | return result; 118 | } 119 | 120 | static emacs_value Fgsl_linalg_LU_solve (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 121 | { 122 | // (solve A b) A and b are vectors 123 | emacs_value A = args[0]; 124 | emacs_value b = args[1]; 125 | 126 | size_t n = env->vec_size(env, args[1]); 127 | 128 | double a_data[n][n]; 129 | double b_data[n]; 130 | 131 | emacs_value val; 132 | 133 | // copy data over to the arrays 134 | for (ptrdiff_t i = 0; i < n; i++) 135 | { 136 | val = env->vec_get(env, b, i); 137 | b_data[i] = extract_double(env, val); 138 | } 139 | 140 | for (ptrdiff_t i = 0; i < n; i++) 141 | { 142 | emacs_value row = env->vec_get (env, A, i); 143 | for (ptrdiff_t j = 0; j < n; j++) 144 | { 145 | val = env->vec_get(env, row, j); 146 | a_data[i][j] = extract_double(env, val); 147 | } 148 | } 149 | 150 | gsl_matrix_view m = gsl_matrix_view_array (a_data, n, n); 151 | gsl_vector_view bb = gsl_vector_view_array (b_data, n); 152 | gsl_vector *x = gsl_vector_alloc (n); 153 | 154 | int s; 155 | 156 | gsl_permutation * p = gsl_permutation_alloc (n); 157 | gsl_linalg_LU_decomp (&m.matrix, p, &s); 158 | gsl_linalg_LU_solve (&m.matrix, p, &bb.vector, x); 159 | 160 | emacs_value *array = malloc(sizeof(emacs_value) * n); 161 | for (ptrdiff_t i = 0; i < n; i++) 162 | { 163 | array[i] = env->make_float(env, gsl_vector_get(x, i)); 164 | } 165 | 166 | emacs_value Fvector = env->intern(env, "vector"); 167 | emacs_value vec = env->funcall(env, Fvector, n, array); 168 | free(array); 169 | return vec; 170 | } 171 | 172 | int emacs_module_init(struct emacs_runtime *ert) 173 | { 174 | emacs_env *env = ert->get_environment(ert); 175 | 176 | DEFUN("gsl-linalg-LU-solve", Fgsl_linalg_LU_solve, 2, 2, 177 | "(gsl-linalg-LU-solve A b).\n" \ 178 | "Solve A x = b for x.\n" \ 179 | "Returns a vector containing the solution x.", 180 | NULL); 181 | 182 | 183 | DEFUN("gsl-blas-dgemm", Fgsl_blas_dgemm, 2, 2, 184 | "(gsl-blas-dgemm M0 M1)\n" \ 185 | "Matrix multiply M0 and M1.\n" \ 186 | "Both matrices must be 2D vectors.\n"\ 187 | "Returns a vector.", 188 | NULL); 189 | provide(env, "gsl-linalg"); 190 | 191 | return 0; 192 | } 193 | -------------------------------------------------------------------------------- /gsl-roots.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include "emacs-module.h" 4 | #include "emacs-module-helpers.h" 5 | 6 | int plugin_is_GPL_compatible; 7 | 8 | static emacs_value Fgsl_root_fsolver_brent (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 9 | { 10 | 11 | // nested function - only supported as an extension in gcc 12 | double f (double x, void *params) 13 | { 14 | emacs_value fn = args[0]; // function we will integrate 15 | emacs_value x2[] = { env->make_float(env, x), params }; 16 | emacs_value y = env->funcall(env, fn, 2, x2); 17 | 18 | return env->extract_float (env, y); 19 | } 20 | 21 | int status; 22 | int iter = 0, max_iter = 100; 23 | const gsl_root_fsolver_type *T; 24 | gsl_root_fsolver *s; 25 | double result = 0; 26 | 27 | double x_lo = extract_double (env, args[1]); 28 | double x_hi = extract_double (env, args[2]); 29 | 30 | gsl_function F; 31 | 32 | F.function = &f; 33 | if (nargs >= 4) {F.params = args[3];} 34 | 35 | // default values for optional arguments 36 | double epsabs = 0.0; 37 | double epsrel = 0.001; 38 | 39 | if (nargs >= 5 && env->is_not_nil(env, args[4])) {epsabs = extract_double(env, args[4]);} 40 | if (nargs >= 6 && env->is_not_nil(env, args[5])) {epsrel = extract_double(env, args[5]);} 41 | 42 | T = gsl_root_fsolver_brent; 43 | s = gsl_root_fsolver_alloc (T); 44 | gsl_root_fsolver_set (s, &F, x_lo, x_hi); 45 | 46 | do 47 | { 48 | iter++; 49 | status = gsl_root_fsolver_iterate (s); 50 | result = gsl_root_fsolver_root (s); 51 | x_lo = gsl_root_fsolver_x_lower (s); 52 | x_hi = gsl_root_fsolver_x_upper (s); 53 | status = gsl_root_test_interval (x_lo, x_hi, 54 | epsabs, epsrel); 55 | 56 | } 57 | while (status == GSL_CONTINUE && iter < max_iter); 58 | 59 | gsl_root_fsolver_free (s); 60 | 61 | return env->make_float (env, result); 62 | } 63 | 64 | int emacs_module_init(struct emacs_runtime *ert) 65 | { 66 | emacs_env *env = ert->get_environment(ert); 67 | 68 | DEFUN("gsl-root-fsolver-brent", Fgsl_root_fsolver_brent, 3, 7, 69 | "(gsl-root-fsolver-brent f xlo xhi params &optional epsabs epsrel)\n" \ 70 | "Solve f(x; params) = 0 using the Brent method.\n" \ 71 | "https://www.gnu.org/software/gsl/doc/html/roots.html#examples", 72 | 0); 73 | provide(env, "gsl-roots"); 74 | 75 | return 0; 76 | } 77 | -------------------------------------------------------------------------------- /mod-list-vec.c: -------------------------------------------------------------------------------- 1 | #include "emacs-module.h" 2 | #include "emacs-module-helpers.h" 3 | #include 4 | 5 | /* Declare mandatory GPL symbol. */ 6 | int plugin_is_GPL_compatible; 7 | 8 | // This just returns the argument, works for a list. 9 | static emacs_value Ff1 (emacs_env *env, int nargs, emacs_value args[], void *data) 10 | { 11 | // So args[0] must be some emacs_value representation of a list. 12 | return args[0]; 13 | } 14 | 15 | // get first element of a vector 16 | static emacs_value Ff2 (emacs_env *env, int nargs, emacs_value args[], void *data) 17 | { 18 | //vec_get is a function on the env struct 19 | //vec_get(env, vector, index) 20 | return env->vec_get(env, args[0], 0); 21 | } 22 | 23 | // This just returns a vector of integers!!! We create a vector with two 24 | // elements in it as an array of emacs_value items, and then we set each element 25 | // to be an emacs_value 26 | static emacs_value Ff3 (emacs_env *env, int nargs, emacs_value args[], void *data) 27 | { 28 | int len = 2; 29 | emacs_value *array = malloc(sizeof(emacs_value) * len); 30 | array[0] = env->make_integer(env, 2); // these return emacs_value types 31 | array[1] = env->make_integer(env, 4); 32 | 33 | // Now we have to call the vector function in Emacs with the "arguments" that 34 | // we built up into the array variable. 35 | emacs_value Fvector = env->intern(env, "vector"); 36 | emacs_value vec = env->funcall(env, Fvector, len, array); 37 | free(array); 38 | return vec; 39 | } 40 | 41 | 42 | // return an input vector * n 43 | static emacs_value Ff4 (emacs_env *env, int nargs, emacs_value args[], void *data) 44 | { 45 | emacs_value input = args[0]; 46 | 47 | // I assume we want a double. This means we get doubles out. 48 | double N = extract_double(env, args[1]); 49 | 50 | // Get the size of our input vector. WE use this to allocate an array to store 51 | // the results in. 52 | int len = env->vec_size (env, input); 53 | 54 | emacs_value *array = malloc(sizeof(emacs_value) * len); 55 | 56 | // multiply each value by N. We have to get the i^{th} element, extract a 57 | // float, multiply it by N, and make a new emacs_value of the float to put in 58 | // the array 59 | for (ptrdiff_t i = 0; i < len; i++) 60 | { 61 | array[i] = env->make_float(env, 62 | N * extract_double(env, 63 | env->vec_get (env, input, i))); 64 | } 65 | 66 | // If you change this to list, you get a list instead! 67 | emacs_value Fvector = env->intern(env, "vector"); 68 | emacs_value vec = env->funcall(env, Fvector, len, array); 69 | free(array); 70 | return vec; 71 | } 72 | 73 | // get a vector or list in and return list * n 74 | // This shows a little flexibility on input types 75 | static emacs_value Ff4a (emacs_env *env, int nargs, emacs_value args[], void *data) 76 | { 77 | emacs_value type = env->type_of(env, args[0]); 78 | double N = extract_double(env, args[1]); 79 | 80 | emacs_value length = env->intern(env, "length"); 81 | 82 | emacs_value lenargs[] = { args[0] }; 83 | 84 | // length works on all sequences it turns out 85 | emacs_value elen = env->funcall(env, length, 1, lenargs); 86 | 87 | int len = env->extract_integer(env, elen); 88 | 89 | emacs_value *array = malloc(sizeof(emacs_value) * len); 90 | 91 | // lists are a cons type 92 | if (env->eq(env, type, env->intern(env, "cons"))) 93 | { 94 | emacs_value nth = env->intern(env, "nth"); 95 | 96 | for (int i = 0; i < len; i++) 97 | { 98 | emacs_value nthargs[] = { env->make_integer(env, i), args[0] }; 99 | double j = extract_double(env, env->funcall(env, nth, 2, nthargs)); 100 | array[i] = env->make_float(env, N * j); 101 | } 102 | 103 | // vectors are a vector type 104 | } else if (env->eq(env, type, env->intern(env, "vector"))) 105 | { 106 | for (int i = 0; i < len; i++) 107 | { 108 | double j = extract_double(env, env->vec_get (env, args[0], i)); 109 | array[i] = env->make_float(env, N * j); 110 | } 111 | } 112 | 113 | // we convert our result to a list. 114 | emacs_value list = env->intern(env, "list"); 115 | emacs_value result = env->funcall(env, list, len, array); 116 | free(array); 117 | return result; 118 | } 119 | 120 | 121 | // return 2nd element of vector 122 | static emacs_value Ff5 (emacs_env *env, int nargs, emacs_value args[], void *data) 123 | { 124 | emacs_value vec = args[0]; 125 | 126 | return env->vec_get (env, vec, 1); 127 | } 128 | 129 | // get second value of second vector 130 | // we assume teh second thing is a vector here. 131 | static emacs_value Ff6 (emacs_env *env, int nargs, emacs_value args[], void *data) 132 | { 133 | emacs_value vec = args[0]; 134 | emacs_value v2 = env->vec_get (env, vec, 1); 135 | return env->vec_get (env, v2, 1); 136 | } 137 | 138 | // index a list 139 | static emacs_value Ff7 (emacs_env *env, int nargs, emacs_value args[], void *data) 140 | { 141 | emacs_value nth = env->intern(env, "nth"); 142 | 143 | return env->funcall (env, nth, 2, args); 144 | } 145 | 146 | int emacs_module_init (struct emacs_runtime *ert) 147 | { 148 | emacs_env *env = ert->get_environment (ert); 149 | 150 | DEFUN("f1", Ff1, 1, 1, "Return the argument", NULL); 151 | DEFUN("f2", Ff2, 1, 1, "return first element of a vector", NULL); 152 | DEFUN("f3", Ff3, 0, 0, "return a vector [2 4]", NULL); 153 | DEFUN("f4", Ff4, 2, 2, "return vector multiplied by arg", NULL); 154 | DEFUN("f4a", Ff4a, 2, 2, "return vector multiplied by arg", NULL); 155 | DEFUN("f5", Ff5, 1, 1, "return 2nd value of vector", NULL); 156 | DEFUN("f6", Ff6, 1, 1, "return 2nd value of 2d vector", NULL); 157 | DEFUN("f7", Ff7, 2, 2, "nth a list", NULL); 158 | 159 | provide (env, "mod-list-vec"); 160 | 161 | /* loaded successfully */ 162 | return 0; 163 | } 164 | -------------------------------------------------------------------------------- /mod-types.c: -------------------------------------------------------------------------------- 1 | #include "emacs-module.h" 2 | #include "emacs-module-helpers.h" 3 | #include 4 | int plugin_is_GPL_compatible; 5 | 6 | // adapted from https://github.com/syohex/emacs-mruby-test/blob/master/mruby-core.c 7 | static bool eq_type(emacs_env *env, emacs_value type, const char *type_str) 8 | { 9 | return env->eq(env, type, env->intern(env, type_str)); 10 | } 11 | 12 | // Function to return arg * 2 where arg can be an integer or float 13 | static emacs_value mt (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 14 | { 15 | emacs_value arg = args[0]; 16 | emacs_value type = env->type_of(env, arg); 17 | 18 | double a; 19 | if (eq_type(env, type, "integer")) 20 | { 21 | a = (float) env->extract_integer(env, arg); 22 | } else if (eq_type(env, type, "float")) 23 | { 24 | a = env->extract_float(env, arg); 25 | 26 | } 27 | return env->make_float(env, 2.0 * a); 28 | } 29 | 30 | // return the type of the arg in a formatted string 31 | static emacs_value mtype (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 32 | { 33 | emacs_value format = env->intern(env, "format"); 34 | char *f = "%S is a %s"; 35 | 36 | emacs_value fargs[] = { 37 | env->make_string(env, f, strlen(f)), 38 | args[0], 39 | env->type_of(env, args[0]) 40 | }; 41 | 42 | return env->funcall(env, format, 3, fargs); 43 | } 44 | 45 | // This is a variadic function that just prints the number of arguments it got. 46 | static emacs_value mvariadic (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 47 | { 48 | return env->make_integer(env, nargs); 49 | } 50 | 51 | int emacs_module_init(struct emacs_runtime *ert) 52 | { 53 | emacs_env *env = ert->get_environment(ert); 54 | 55 | DEFUN("mt", mt, 1, 1, 56 | "(mt arg) multiply arg by 2.", NULL); 57 | 58 | DEFUN("mtype", mtype, 1, 1, "Return the arg type.", NULL); 59 | provide(env, "mod-types"); 60 | 61 | // use -2 for maxargs to make it variadic 62 | DEFUN("mvariadic", mvariadic, 0, -2, "variadic function.", NULL); 63 | provide(env, "mod-types"); 64 | 65 | return 0; 66 | } 67 | -------------------------------------------------------------------------------- /mongodb/bson.el: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jkitchin/emacs-modules/9ffff332ed84a73bf32366b72fe6d7f44f79d888/mongodb/bson.el -------------------------------------------------------------------------------- /mongodb/bson.org: -------------------------------------------------------------------------------- 1 | #+BEGIN_SRC emacs-lisp 2 | (add-to-list 'load-path (expand-file-name ".")) 3 | (require 'ffi) 4 | 5 | (define-ffi-library mongoc "libmongoc") 6 | 7 | 8 | (define-ffi-struct bson_t 9 | (flags :type :uint32) 10 | (len :type :uint32) 11 | (padding :type :uint8)) 12 | 13 | ;; bson_t * 14 | ;; bson_new (void); 15 | (define-ffi-function bson-new "bson_new" :pointer () mongoc) 16 | 17 | ;; bson_t * 18 | ;; bson_sized_new (size_t size); 19 | 20 | (define-ffi-function bson-sized-new "bson_sized_new" :pointer (:size_t) 21 | mongoc) 22 | 23 | 24 | 25 | (define-ffi-function bson-init "bson_init" 26 | :void 27 | ((:pointer b)) 28 | mongoc 29 | "The bson_init() function shall initialize a bson_t that is 30 | placed on the stack. ") 31 | 32 | ;; bool 33 | ;; bson_append_utf8 (bson_t *bson, 34 | ;; const char *key, 35 | ;; int key_length, 36 | ;; const char *value, 37 | ;; int length); 38 | (define-ffi-function bson-append-utf8 "bson_append_utf8" 39 | :bool 40 | ((:pointer bson) 41 | (:pointer key) 42 | (:int key_length) 43 | (:pointer value) 44 | (:int length)) 45 | mongoc 46 | "The bson_append_utf8() function shall append a UTF-8 encoded string to bson. 47 | http://mongoc.org/libbson/current/bson_append_utf8.html") 48 | #+END_SRC 49 | 50 | #+RESULTS: 51 | : bson-append-utf8 52 | 53 | #+BEGIN_SRC emacs-lisp 54 | (ffi--type-size (bson-new)) 55 | #+END_SRC 56 | 57 | #+RESULTS: 58 | : 24 59 | 60 | 61 | #+BEGIN_SRC emacs-lisp 62 | (bson-init (ffi--define-struct bson_t :uint32 :uint32 :uint8)) 63 | #+END_SRC 64 | 65 | I can't figure out how to do some things here, e.g. what if a function returns a pointer to a struct? For bson-init, for example, the argument is a pointer to a struct, and it seems like you have to make the struct first. But it is not clear how to do that. It seems various ffi implementations in different languages have limited or no support for this kind of thing. Hopefully the emacs-ffi author will clarify soon if it can do this. 66 | 67 | 68 | -------------------------------------------------------------------------------- /mongodb/connect: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jkitchin/emacs-modules/9ffff332ed84a73bf32366b72fe6d7f44f79d888/mongodb/connect -------------------------------------------------------------------------------- /mongodb/ex.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | int 6 | main (int argc, 7 | char *argv[]) 8 | { 9 | mongoc_client_t *client; 10 | mongoc_database_t *database; 11 | mongoc_collection_t *collection; 12 | bson_t *command, 13 | reply, 14 | *insert; 15 | bson_error_t error; 16 | char *str; 17 | bool retval; 18 | 19 | /* 20 | * Required to initialize libmongoc's internals 21 | */ 22 | mongoc_init (); 23 | 24 | /* 25 | * Create a new client instance 26 | */ 27 | client = mongoc_client_new ("mongodb://localhost:27017"); 28 | 29 | /* 30 | * Register the application name so we can track it in the profile logs 31 | * on the server. This can also be done from the URI (see other examples). 32 | */ 33 | mongoc_client_set_appname (client, "connect-example"); 34 | 35 | /* 36 | * Get a handle on the database "db_name" and collection "coll_name" 37 | */ 38 | database = mongoc_client_get_database (client, "db_name"); 39 | collection = mongoc_client_get_collection (client, "db_name", "coll_name"); 40 | 41 | /* 42 | * Do work. This example pings the database, prints the result as JSON and 43 | * performs an insert 44 | */ 45 | command = BCON_NEW ("ping", BCON_INT32 (1)); 46 | 47 | retval = mongoc_client_command_simple (client, "admin", command, NULL, &reply, &error); 48 | 49 | if (!retval) { 50 | fprintf (stderr, "%s\n", error.message); 51 | return EXIT_FAILURE; 52 | } 53 | 54 | str = bson_as_json (&reply, NULL); 55 | printf ("%s\n", str); 56 | 57 | insert = BCON_NEW ("hello", BCON_UTF8 ("world")); 58 | 59 | if (!mongoc_collection_insert (collection, MONGOC_INSERT_NONE, insert, NULL, &error)) { 60 | fprintf (stderr, "%s\n", error.message); 61 | } 62 | 63 | bson_destroy (insert); 64 | bson_destroy (&reply); 65 | bson_destroy (command); 66 | bson_free (str); 67 | 68 | /* 69 | * Release our handles and clean up libmongoc 70 | */ 71 | mongoc_collection_destroy (collection); 72 | mongoc_database_destroy (database); 73 | mongoc_client_destroy (client); 74 | mongoc_cleanup (); 75 | 76 | return 0; 77 | } 78 | -------------------------------------------------------------------------------- /mongodb/ffi.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding:t -*- 2 | 3 | (require 'cl-macs) 4 | 5 | (module-load "ffi-module.so") 6 | 7 | (gv-define-simple-setter ffi--mem-ref ffi--mem-set t) 8 | 9 | ;; (defmacro define-ffi-library (symbol name) 10 | ;; (let ((library (cl-gensym))) 11 | ;; (set library nil) 12 | ;; `(defun ,symbol () 13 | ;; (or ,library 14 | ;; (setq ,library (ffi--dlopen ,name)))))) 15 | 16 | ;; (defmacro define-ffi-function (name c-name return-type arg-types library) 17 | ;; (let* ( 18 | ;; ;; Turn variable references into actual types; while keeping 19 | ;; ;; keywords the same. 20 | ;; (arg-types (mapcar #'symbol-value arg-types)) 21 | ;; (arg-names (mapcar (lambda (_ignore) (cl-gensym)) arg-types)) 22 | ;; (arg-types (vconcat arg-types)) 23 | ;; (function (cl-gensym)) 24 | ;; (cif (ffi--prep-cif (symbol-value return-type) arg-types))) 25 | ;; (set function nil) 26 | ;; `(defun ,name (,@arg-names) 27 | ;; (unless ,function 28 | ;; (setq ,function (ffi--dlsym ,c-name (,library)))) 29 | ;; ;; FIXME do we even need a separate prep? 30 | ;; (ffi--call ,cif ,function ,@arg-names)))) 31 | 32 | (defmacro define-ffi-library (symbol name) 33 | "Create a pointer named to the c library." 34 | (let ((library (cl-gensym)) 35 | (docstring (format "Returns a pointer to the %s library." name))) 36 | (set library nil) 37 | `(defun ,symbol () 38 | ,docstring 39 | (or ,library 40 | (setq ,library (ffi--dlopen ,name)))))) 41 | 42 | (defmacro define-ffi-function (name c-name return args library &optional docstring) 43 | "Create an Emacs function from a c-function. 44 | NAME is a symbol for the emacs function to create. 45 | C-NAME is a string of the c-function to use. 46 | RETURN is a type-keyword or (type-keyword docstring) 47 | ARGS is a list of type-keyword or (type-keyword name &optional arg-docstring) 48 | LIBRARY is a symbol usually defined by `define-ffi-library' 49 | DOCSTRING is a string for the function to be created. 50 | 51 | An overall docstring is created for the function from the arg and return docstrings. 52 | " 53 | ;; Turn variable references into actual types; while keeping 54 | ;; keywords the same. 55 | (let* ((return-type (if (keywordp return) 56 | return 57 | (car return))) 58 | (return-docstring (format "Returns: %s (%s)" 59 | (if (listp return) 60 | (second return) 61 | "") 62 | return-type)) 63 | (arg-types (vconcat (mapcar (lambda (arg) 64 | (if (keywordp arg) 65 | (symbol-value arg) 66 | ;; assume list (type-keyword name &optional doc) 67 | (symbol-value (car arg)))) 68 | args))) 69 | (arg-names (mapcar (lambda (arg) 70 | (if (keywordp arg) 71 | (cl-gensym) 72 | ;; assume list (type-keyword name &optional doc) 73 | (second arg))) 74 | args)) 75 | (arg-docstrings (mapcar (lambda (arg) 76 | (cond 77 | ((keywordp arg) 78 | "") 79 | ((and (listp arg) (= 3 (length arg))) 80 | (third arg)) 81 | (t ""))) 82 | args)) 83 | ;; Combine all the arg docstrings into one string 84 | (arg-docstring (mapconcat 'identity 85 | (mapcar* (lambda (name type arg-doc) 86 | (format "%s (%s) %s" 87 | (upcase (symbol-name name)) 88 | type 89 | arg-doc)) 90 | arg-names arg-types arg-docstrings) 91 | "\n")) 92 | (function (cl-gensym)) 93 | (cif (ffi--prep-cif (symbol-value return-type) arg-types))) 94 | (set function nil) 95 | `(defun ,name (,@arg-names) 96 | ,(concat docstring "\n\n" arg-docstring "\n\n" return-docstring) 97 | (unless ,function 98 | (setq ,function (ffi--dlsym ,c-name (,library)))) 99 | ;; FIXME do we even need a separate prep? 100 | (ffi--call ,cif ,function ,@arg-names)))) 101 | 102 | 103 | (defun ffi-lambda (function-pointer return-type arg-types) 104 | (let* ((cif (ffi--prep-cif return-type (vconcat arg-types)))) 105 | (lambda (&rest args) ; lame 106 | (apply #'ffi--call cif function-pointer args)))) 107 | 108 | (defsubst ffi--align (offset align) 109 | (+ offset (mod (- align (mod offset align)) align))) 110 | 111 | (defun ffi--lay-out-struct (types) 112 | (let ((offset 0)) 113 | (mapcar (lambda (this-type) 114 | (setf offset (ffi--align offset 115 | (ffi--type-alignment this-type))) 116 | (let ((here offset)) 117 | (cl-incf offset (ffi--type-size this-type)) 118 | here)) 119 | types))) 120 | 121 | (defun ffi--struct-union-helper (name slots definer-function layout-function) 122 | (cl-assert (symbolp name)) 123 | (let* ((docstring (if (stringp (car slots)) 124 | (pop slots))) 125 | (conc-name (concat (symbol-name name) "-")) 126 | (result-forms ()) 127 | (field-types (mapcar (lambda (slot) 128 | (cl-assert (eq (cadr slot) :type)) 129 | (symbol-value (cl-caddr slot))) 130 | slots)) 131 | (the-type (apply definer-function field-types)) 132 | (field-offsets (funcall layout-function field-types))) 133 | (push `(defvar ,name ,the-type ,docstring) 134 | result-forms) 135 | (cl-mapc 136 | (lambda (slot type offset) 137 | (let ((getter-name (intern (concat conc-name 138 | (symbol-name (car slot))))) 139 | (offsetter (if (> offset 0) 140 | `(ffi-pointer+ object ,offset) 141 | 'object))) 142 | ;; One benefit of using defsubst here is that we don't have 143 | ;; to provide a GV setter. 144 | (push `(cl-defsubst ,getter-name (object) 145 | (ffi--mem-ref ,offsetter ,type)) 146 | result-forms))) 147 | slots field-types field-offsets) 148 | (cons 'progn (nreverse result-forms)))) 149 | 150 | (defmacro define-ffi-struct (name &rest slots) 151 | "Like a limited form of `cl-defstruct', but works with foreign objects. 152 | 153 | NAME must be a symbol. 154 | Each SLOT must be of the form `(SLOT-NAME :type TYPE)', where 155 | SLOT-NAME is a symbol and TYPE is an FFI type descriptor." 156 | (ffi--struct-union-helper name slots #'ffi--define-struct 157 | #'ffi--lay-out-struct)) 158 | 159 | (defmacro define-ffi-union (name &rest slots) 160 | "Like a limited form of `cl-defstruct', but works with foreign objects. 161 | 162 | NAME must be a symbol. 163 | Each SLOT must be of the form `(SLOT-NAME :type TYPE)', where 164 | SLOT-NAME is a symbol and TYPE is an FFI type descriptor." 165 | (ffi--struct-union-helper name slots #'ffi--define-union 166 | (lambda (types) 167 | (make-list (length types) 0)))) 168 | 169 | (defmacro define-ffi-array (name type length &optional docstring) 170 | ;; This is a hack until libffi gives us direct support. 171 | (let ((type-description 172 | (apply #'ffi--define-struct 173 | (make-list (eval length) (symbol-value type))))) 174 | `(defvar ,name ,type-description ,docstring))) 175 | 176 | (defsubst ffi-aref (array type index) 177 | (ffi--mem-ref (ffi-pointer+ array (* index (ffi--type-size type))) type)) 178 | 179 | (defmacro with-ffi-temporary (binding &rest body) 180 | (declare (indent defun)) 181 | `(let ((,(car binding) (ffi-allocate ,@(cdr binding)))) 182 | (unwind-protect 183 | (progn ,@body) 184 | (ffi-free ,(car binding))))) 185 | 186 | (defmacro with-ffi-temporaries (bindings &rest body) 187 | (declare (indent defun)) 188 | (let ((first-binding (car bindings)) 189 | (rest-bindings (cdr bindings))) 190 | (if rest-bindings 191 | `(with-ffi-temporary ,first-binding 192 | (with-ffi-temporaries ,rest-bindings 193 | ,@body)) 194 | `(with-ffi-temporary ,first-binding ,@body)))) 195 | 196 | (defmacro with-ffi-string (binding &rest body) 197 | (declare (indent defun)) 198 | `(let ((,(car binding) (ffi-make-c-string ,@(cdr binding)))) 199 | (unwind-protect 200 | (progn ,@body) 201 | (ffi-free ,(car binding))))) 202 | 203 | (defmacro with-ffi-strings (bindings &rest body) 204 | (declare (indent defun)) 205 | (let ((first-binding (car bindings)) 206 | (rest-bindings (cdr bindings))) 207 | (if rest-bindings 208 | `(with-ffi-string ,first-binding 209 | (with-ffi-strings ,rest-bindings 210 | ,@body)) 211 | `(with-ffi-string ,first-binding ,@body)))) 212 | 213 | (provide 'ffi) 214 | -------------------------------------------------------------------------------- /mongodb/mongo-ffi.org: -------------------------------------------------------------------------------- 1 | 2 | Start a mongdb 3 | #+BEGIN_SRC sh 4 | brew services start mongodb 5 | #+END_SRC 6 | 7 | #+RESULTS: 8 | | Service `mongodb` already started | use `brew services restart mongodb` to restart. | 9 | 10 | 11 | #+BEGIN_SRC emacs-lisp 12 | (add-to-list 'load-path (expand-file-name ".")) 13 | (require 'ffi) 14 | 15 | (define-ffi-library mongoc "libmongoc") 16 | #+END_SRC 17 | 18 | #+RESULTS: 19 | : mongoc 20 | 21 | #+BEGIN_SRC emacs-lisp 22 | (define-ffi-function mongoc-init "mongoc_init" :void nil mongoc) 23 | (define-ffi-function mongoc-cleanup "mongoc_cleanup" :void nil mongoc) 24 | #+END_SRC 25 | 26 | #+RESULTS: 27 | : mongoc-cleanup 28 | 29 | 30 | 31 | #+RESULTS: 32 | : mongoc_collection_insert 33 | 34 | Now we try using these: 35 | 36 | #+BEGIN_SRC emacs-lisp 37 | (mongoc-init) 38 | 39 | 40 | (with-ffi-strings ((uri "mongodb://localhost:27017") 41 | (dbname "db_name") 42 | (collname "coll_name")) 43 | 44 | (let* ((client (mongoc-client-new uri)) 45 | (db (mongoc-client-get-database client dbname)) 46 | (collection (mongoc-client-get-collection client dbname collname))) 47 | 48 | collection 49 | 50 | 51 | 52 | 53 | )) 54 | 55 | (mongoc-cleanup) 56 | #+END_SRC 57 | 58 | 59 | ** new macro forms 60 | 61 | #+BEGIN_SRC emacs-lisp 62 | (define-ffi-function mongoc-init "mongoc_init" 63 | :void 64 | nil 65 | mongo 66 | "Initialize the MongoDB C Driver by calling mongoc_init() 67 | exactly once at the beginning of your program. It is 68 | responsible for initializing global state such as process 69 | counters, SSL, and threading primitives. 70 | http://mongoc.org/libmongoc/current/mongoc_init.html") 71 | 72 | (define-ffi-function mongoc-cleanup "mongoc_cleanup" 73 | :void 74 | () 75 | mongo 76 | "Call mongoc_cleanup() exactly once at the end of your program 77 | to release all memory and other resources allocated by the 78 | driver. You must not call any other MongoDB C Driver functions 79 | after mongoc_cleanup(). Note that mongoc_init() does not 80 | reinitialize the driver after mongoc_cleanup().") 81 | 82 | (define-ffi-function mongoc-client-new "mongoc_client_new" 83 | :pointer 84 | ((:pointer uri-string)) 85 | mongo 86 | "Creates a new mongoc_client_t using the URI string provided.") 87 | 88 | ;; bool mongoc_client_set_appname (mongoc_client_t *client, const char *appname) 89 | (define-ffi-function mongoc-client-set-appname "mongoc_client_set_appname" 90 | :bool 91 | ((:pointer client) (:pointer appname)) 92 | "Sets the application name for this client. This string, along 93 | with other internal driver details, is sent to the server as 94 | part of the initial connection handshake (\"isMaster\").") 95 | 96 | 97 | ;; mongoc_database_t * mongoc_client_get_database (mongoc_client_t *client, const char *name); 98 | (define-ffi-function mongoc-client-get-database "mongoc_client_get_database" 99 | :pointer 100 | ((:pointer client) (:pointer name)) 101 | mongo 102 | "Get a database") 103 | 104 | ;; mongoc_collection_t * mongoc_client_get_collection (mongoc_client_t *client, const char *db, const char *collection); 105 | (define-ffi-function mongoc-client-get-collection "mongoc_client_get_collection" 106 | :pointer 107 | ((:pointer client) (:pointer db "String") (:pointer collection "string")) 108 | mongo 109 | "get a collection") 110 | 111 | ;; bool 112 | ;; mongoc_client_command_simple (mongoc_client_t *client, 113 | ;; const char *db_name, 114 | ;; const bson_t *command, 115 | ;; const mongoc_read_prefs_t *read_prefs, 116 | ;; bson_t *reply, 117 | ;; bson_error_t *error); 118 | (define-ffi-function mongo-client-command-simple "mongoc_client_command_simple" 119 | :bool 120 | ((:pointer client) 121 | (:pointer db) 122 | (:pointer command "bson_t") 123 | (:pointer mongoc-read-prefs-t) 124 | (:pointer reply) 125 | (:pointer error)) 126 | mongo 127 | "This is a simplified interface to mongoc_client_command(). It 128 | returns the first document from the result cursor into reply. 129 | The client's read preference, read concern, and write concern 130 | are not applied to the command.") 131 | 132 | 133 | 134 | 135 | ;; bool 136 | ;; mongoc_collection_insert (mongoc_collection_t *collection, 137 | ;; mongoc_insert_flags_t flags, 138 | ;; const bson_t *document, 139 | ;; const mongoc_write_concern_t *write_concern, 140 | ;; bson_error_t *error); 141 | 142 | 143 | ;; http://mongoc.org/libmongoc/current/mongoc_insert_flags_t.html 144 | 145 | (define-ffi-function mongoc_collection_insert "mongoc_collection_insert" 146 | :bool 147 | ((:pointer collection) 148 | (:int flags) 149 | (:pointer document) 150 | (:pointer write_concern) 151 | (:pointer error)) 152 | mongo 153 | "some") 154 | #+END_SRC 155 | -------------------------------------------------------------------------------- /template/.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | *.h 3 | *.c 4 | *.o 5 | *.so 6 | tests.el 7 | -------------------------------------------------------------------------------- /template/template.org: -------------------------------------------------------------------------------- 1 | * Template for a literate dynamic module in Emacs 2 | ** Setup 3 | 4 | This file is setup with local variables. The variables go to this block and run it when the file opens. This adds a post-tangle hook that will compile all the files, and show you the output. That means you can edit files, type C-c C-v t to tangle the files and see the changes you made. 5 | 6 | #+name: my-hook-function 7 | #+BEGIN_SRC emacs-lisp 8 | (defun my-special-hook () 9 | (shell-command "make all") 10 | (pop-to-buffer "*Shell Command Output*") 11 | (message "done with tangle hook")) 12 | 13 | ;; convenience template 14 | (add-to-list 'org-structure-template-alist 15 | '("c" "#+BEGIN_SRC c\n?\n#+END_SRC" 16 | "\n?\n")) 17 | #+END_SRC 18 | 19 | #+RESULTS: my-hook-function 20 | | c | #+BEGIN_SRC c | 21 | 22 | Since these files are generated, we do not keep them under version control. 23 | 24 | #+BEGIN_SRC text :tangle .gitignore 25 | Makefile 26 | *.h 27 | *.c 28 | *.o 29 | *.so 30 | tests.el 31 | #+END_SRC 32 | 33 | 34 | *** Build the modules 35 | 36 | You can just tangle this file, and a post-hook function will run "make all". 37 | 38 | elisp:org-babel-tangle 39 | 40 | Alternatively, run one of these: 41 | 42 | #+BEGIN_SRC sh 43 | make test-simple 44 | #+END_SRC 45 | 46 | *** Compiling C tests 47 | 48 | Here is an example C block that you can run and test. This may be helpful for local tests. I don't use this right now. 49 | 50 | #+BEGIN_SRC c :main no 51 | /* Hello World program */ 52 | 53 | #include 54 | 55 | main() 56 | { 57 | printf("Hello World"); 58 | 59 | } 60 | #+END_SRC 61 | 62 | #+RESULTS: 63 | : Hello World 64 | 65 | ** emacs-module.h 66 | :PROPERTIES: 67 | :ID: C57388A1-F759-4DC3-90D9-5A4B1566B246 68 | :END: 69 | 70 | This is a required header module. Ideally this would be a system file and it is tied to a specific emacs version. If it is a system header, you may have to adjust the CFLAGS to add an include directory so the compiler can find this. I just put it in my working directory. This is not a file I recommend editing. 71 | 72 | #+BEGIN_SRC emacs-lisp 73 | (emacs-version) 74 | #+END_SRC 75 | 76 | #+RESULTS: 77 | : GNU Emacs 25.2.1 (x86_64-apple-darwin16.5.0, NS appkit-1504.82 Version 10.12.4 (Build 16E195)) 78 | : of 2017-04-25 79 | 80 | #+BEGIN_SRC c :tangle emacs-module.h 81 | /* emacs-module.h - GNU Emacs module API. 82 | 83 | Copyright (C) 2015-2016 Free Software Foundation, Inc. 84 | 85 | This file is part of GNU Emacs. 86 | 87 | GNU Emacs is free software: you can redistribute it and/or modify 88 | it under the terms of the GNU General Public License as published by 89 | the Free Software Foundation, either version 3 of the License, or (at 90 | your option) any later version. 91 | 92 | GNU Emacs is distributed in the hope that it will be useful, 93 | but WITHOUT ANY WARRANTY; without even the implied warranty of 94 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 95 | GNU General Public License for more details. 96 | 97 | You should have received a copy of the GNU General Public License 98 | along with GNU Emacs. If not, see . */ 99 | 100 | #ifndef EMACS_MODULE_H 101 | #define EMACS_MODULE_H 102 | 103 | #include 104 | #include 105 | #include 106 | 107 | #if defined __cplusplus && __cplusplus >= 201103L 108 | # define EMACS_NOEXCEPT noexcept 109 | #else 110 | # define EMACS_NOEXCEPT 111 | #endif 112 | 113 | #ifdef __cplusplus 114 | extern "C" { 115 | #endif 116 | 117 | /* Current environment. */ 118 | typedef struct emacs_env_25 emacs_env; 119 | 120 | /* Opaque pointer representing an Emacs Lisp value. 121 | BEWARE: Do not assume NULL is a valid value! */ 122 | typedef struct emacs_value_tag *emacs_value; 123 | 124 | enum emacs_arity { emacs_variadic_function = -2 }; 125 | 126 | /* Struct passed to a module init function (emacs_module_init). */ 127 | struct emacs_runtime 128 | { 129 | /* Structure size (for version checking). */ 130 | ptrdiff_t size; 131 | 132 | /* Private data; users should not touch this. */ 133 | struct emacs_runtime_private *private_members; 134 | 135 | /* Return an environment pointer. */ 136 | emacs_env *(*get_environment) (struct emacs_runtime *ert); 137 | }; 138 | 139 | 140 | /* Function prototype for the module init function. */ 141 | typedef int (*emacs_init_function) (struct emacs_runtime *ert); 142 | 143 | /* Function prototype for the module Lisp functions. */ 144 | typedef emacs_value (*emacs_subr) (emacs_env *env, ptrdiff_t nargs, 145 | emacs_value args[], void *data); 146 | 147 | /* Possible Emacs function call outcomes. */ 148 | enum emacs_funcall_exit 149 | { 150 | /* Function has returned normally. */ 151 | emacs_funcall_exit_return = 0, 152 | 153 | /* Function has signaled an error using `signal'. */ 154 | emacs_funcall_exit_signal = 1, 155 | 156 | /* Function has exit using `throw'. */ 157 | emacs_funcall_exit_throw = 2, 158 | }; 159 | 160 | struct emacs_env_25 161 | { 162 | /* Structure size (for version checking). */ 163 | ptrdiff_t size; 164 | 165 | /* Private data; users should not touch this. */ 166 | struct emacs_env_private *private_members; 167 | 168 | /* Memory management. */ 169 | 170 | emacs_value (*make_global_ref) (emacs_env *env, 171 | emacs_value any_reference); 172 | 173 | void (*free_global_ref) (emacs_env *env, 174 | emacs_value global_reference); 175 | 176 | /* Non-local exit handling. */ 177 | 178 | enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env); 179 | 180 | void (*non_local_exit_clear) (emacs_env *env); 181 | 182 | enum emacs_funcall_exit (*non_local_exit_get) 183 | (emacs_env *env, 184 | emacs_value *non_local_exit_symbol_out, 185 | emacs_value *non_local_exit_data_out); 186 | 187 | void (*non_local_exit_signal) (emacs_env *env, 188 | emacs_value non_local_exit_symbol, 189 | emacs_value non_local_exit_data); 190 | 191 | void (*non_local_exit_throw) (emacs_env *env, 192 | emacs_value tag, 193 | emacs_value value); 194 | 195 | /* Function registration. */ 196 | 197 | emacs_value (*make_function) (emacs_env *env, 198 | ptrdiff_t min_arity, 199 | ptrdiff_t max_arity, 200 | emacs_value (*function) (emacs_env *env, 201 | ptrdiff_t nargs, 202 | emacs_value args[], 203 | void *) 204 | EMACS_NOEXCEPT, 205 | const char *documentation, 206 | void *data); 207 | 208 | emacs_value (*funcall) (emacs_env *env, 209 | emacs_value function, 210 | ptrdiff_t nargs, 211 | emacs_value args[]); 212 | 213 | emacs_value (*intern) (emacs_env *env, 214 | const char *symbol_name); 215 | 216 | /* Type conversion. */ 217 | 218 | emacs_value (*type_of) (emacs_env *env, 219 | emacs_value value); 220 | 221 | bool (*is_not_nil) (emacs_env *env, emacs_value value); 222 | 223 | bool (*eq) (emacs_env *env, emacs_value a, emacs_value b); 224 | 225 | intmax_t (*extract_integer) (emacs_env *env, emacs_value value); 226 | 227 | emacs_value (*make_integer) (emacs_env *env, intmax_t value); 228 | 229 | double (*extract_float) (emacs_env *env, emacs_value value); 230 | 231 | emacs_value (*make_float) (emacs_env *env, double value); 232 | 233 | /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 234 | null-terminated string. 235 | 236 | SIZE must point to the total size of the buffer. If BUFFER is 237 | NULL or if SIZE is not big enough, write the required buffer size 238 | to SIZE and return false. 239 | 240 | Note that SIZE must include the last null byte (e.g. "abc" needs 241 | a buffer of size 4). 242 | 243 | Return true if the string was successfully copied. */ 244 | 245 | bool (*copy_string_contents) (emacs_env *env, 246 | emacs_value value, 247 | char *buffer, 248 | ptrdiff_t *size_inout); 249 | 250 | /* Create a Lisp string from a utf8 encoded string. */ 251 | emacs_value (*make_string) (emacs_env *env, 252 | const char *contents, ptrdiff_t length); 253 | 254 | /* Embedded pointer type. */ 255 | emacs_value (*make_user_ptr) (emacs_env *env, 256 | void (*fin) (void *) EMACS_NOEXCEPT, 257 | void *ptr); 258 | 259 | void *(*get_user_ptr) (emacs_env *env, emacs_value uptr); 260 | void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr); 261 | 262 | void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) 263 | (void *) EMACS_NOEXCEPT; 264 | void (*set_user_finalizer) (emacs_env *env, 265 | emacs_value uptr, 266 | void (*fin) (void *) EMACS_NOEXCEPT); 267 | 268 | /* Vector functions. */ 269 | emacs_value (*vec_get) (emacs_env *env, emacs_value vec, ptrdiff_t i); 270 | 271 | void (*vec_set) (emacs_env *env, emacs_value vec, ptrdiff_t i, 272 | emacs_value val); 273 | 274 | ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec); 275 | }; 276 | 277 | /* Every module should define a function as follows. */ 278 | extern int emacs_module_init (struct emacs_runtime *ert); 279 | 280 | #ifdef __cplusplus 281 | } 282 | #endif 283 | 284 | #endif /* EMACS_MODULE_H */ 285 | 286 | #+END_SRC 287 | 288 | ** emacs-module-helpers 289 | 290 | It is moderately tedious to write dynamic modules with the primitives provided in [[id:C57388A1-F759-4DC3-90D9-5A4B1566B246][emacs-module.h]]. I created this library of helper functions to make writing a little smoother. It is designed as a shared library for now so it is more easily reusable in other projects. 291 | 292 | You have to add signatures to [[id:D796707B-A6A6-4908-BDEB-DC60689ADD72][emacs-module-helpers.h]] for these functions that you want to use in other modules. 293 | 294 | *** emacs-module-helpers.c 295 | 296 | This is the top of the file that has the includes. 297 | 298 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 299 | #include 300 | #include 301 | #include 302 | #include "emacs-module.h" 303 | #include "emacs-module-helpers.h" 304 | 305 | #+END_SRC 306 | 307 | **** intern 308 | 309 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 310 | // This is a smidge shorter than env->intern (env, feature) 311 | // intern(env, feature) 312 | emacs_value intern(emacs_env *env, const char *feature) 313 | { 314 | return env->intern (env, feature); 315 | } 316 | 317 | 318 | #+END_SRC 319 | 320 | **** message 321 | :PROPERTIES: 322 | :ID: 6FD17DAA-28B9-4018-9A54-0F0139A91759 323 | :END: 324 | 325 | This will emit a message in emacs. Typical usage is: message(env, "some format string", narguments, arg1, arg2, ...) 326 | 327 | Each argument is an emacs_value that you want to use. You have to specify how many arguments will be used since it is variadic. 328 | 329 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 330 | 331 | emacs_value emacs_message (emacs_env *env, const char *msg, int nargs, ...) 332 | { 333 | emacs_value Smessage = env->intern(env, "message"); 334 | 335 | int i; 336 | 337 | emacs_value args[nargs + 1]; 338 | 339 | args[0] = env->make_string(env, msg, strlen(msg)); 340 | 341 | va_list ap; 342 | va_start (ap, nargs); 343 | 344 | for (i = 0; i < nargs; i++) 345 | args[i + 1] = va_arg (ap, emacs_value); /* Get the next argument value. */ 346 | 347 | va_end (ap); /* Clean up. */ 348 | 349 | emacs_value result = env->funcall(env, Smessage, nargs + 1, &args); 350 | 351 | return result; 352 | } 353 | 354 | 355 | #+END_SRC 356 | 357 | **** Format a string 358 | 359 | Similar to [[id:6FD17DAA-28B9-4018-9A54-0F0139A91759][message]] but with no output to minibuffer. 360 | 361 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 362 | emacs_value emacs_format (emacs_env *env, const char *msg, int nargs, ...) 363 | { 364 | emacs_value Sformat = env->intern(env, "format"); 365 | 366 | int i; 367 | 368 | emacs_value args[nargs + 1]; 369 | 370 | args[0] = env->make_string(env, msg, strlen(msg)); 371 | 372 | va_list ap; 373 | va_start (ap, nargs); 374 | 375 | for (i = 0; i < nargs; i++) 376 | args[i + 1] = va_arg (ap, emacs_value); /* Get the next argument value. */ 377 | 378 | va_end (ap); /* Clean up. */ 379 | 380 | emacs_value result = env->funcall(env, format, nargs + 1, &args); 381 | 382 | return result; 383 | } 384 | 385 | #+END_SRC 386 | 387 | **** Read a form from a string 388 | 389 | This reads a form from a string and returns an Emacs representation of it. 390 | 391 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 392 | emacs_value read (emacs_env *env, const char *form) 393 | { 394 | emacs_value Sread = intern(env, "read"); 395 | emacs_value Sform = env->make_string(env, form, strlen(form)); 396 | emacs_value read_args[] = { Sform }; 397 | return env->funcall(env, Sread, 1, read_args); 398 | } 399 | #+END_SRC 400 | 401 | **** Eval a string 402 | :PROPERTIES: 403 | :ID: 073DB18B-BB05-4BB8-B6CE-8A0089BB413B 404 | :END: 405 | 406 | This eval's what is read from a string. This may be useful to define interactive functions. 407 | 408 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 409 | emacs_value eval (emacs_env *env, const char *form) 410 | { 411 | emacs_value Seval = intern(env, "eval"); 412 | emacs_value eval_args [] = { read(env, form) }; 413 | return env->funcall(env, Seval, 1, eval_args); 414 | } 415 | #+END_SRC 416 | 417 | **** Extract data from Emacs arguments 418 | 419 | These functions are convenient when you know you want a specific type from an emacs argument independent of the type that is input. E.g. if you know you want to convert whatever number is put in as an integer or float, or to represent whatever is in the arg as a string. You would normally use these functions to process arguments from Emacs for use in C functions. 420 | 421 | ***** Get an integer 422 | 423 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 424 | // Extract a number as an integer from arg. floats are cast as ints. 425 | int extract_integer (emacs_env *env, emacs_value arg) 426 | { 427 | emacs_value type = env->type_of(env, arg); 428 | emacs_value Sint = env->intern(env, "integer"); 429 | emacs_value Sfloat = env->intern(env, "float"); 430 | 431 | int result = 0; 432 | if (env->eq(env, type, Sint)) 433 | { 434 | result = env->extract_integer(env, arg); 435 | } 436 | else if (env->eq(env, type, Sfloat)) 437 | { 438 | result = (int) env->extract_float(env, arg); 439 | } 440 | else 441 | { 442 | emacs_value signal = env->intern(env, "type-error"); 443 | const char *error = "A non-number arg was passed."; 444 | emacs_value message = env->make_string(env, error, strlen(error)); 445 | env->non_local_exit_signal(env, signal, message); 446 | } 447 | 448 | return result; 449 | } 450 | 451 | #+END_SRC 452 | 453 | ***** Get a double 454 | 455 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 456 | // Extract a number as a double from arg. ints are cast as floats. 457 | double extract_double (emacs_env *env, emacs_value arg) 458 | { 459 | emacs_value type = env->type_of(env, arg); 460 | double result = 0.0; 461 | if (env->eq(env, type, env->intern(env, "integer"))) 462 | { 463 | result = (float) env->extract_integer(env, arg); 464 | } 465 | else if (env->eq(env, type, env->intern(env, "float"))) 466 | { 467 | result = env->extract_float(env, arg); 468 | } 469 | else 470 | { 471 | emacs_value signal = env->intern(env, "type-error"); 472 | const char *error = "A non-number arg was passed."; 473 | emacs_value message = env->make_string(env, error, strlen(error)); 474 | env->non_local_exit_signal(env, signal, message); 475 | } 476 | return result; 477 | } 478 | 479 | #+END_SRC 480 | 481 | ***** Get a string 482 | 483 | 484 | 485 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 486 | // Extract a string from arg. if it is a string we get it. 487 | // Otherwise we format it with %S. 488 | char * extract_string (emacs_env *env, emacs_value arg) 489 | { 490 | emacs_value type = env->type_of(env, arg); 491 | ptrdiff_t size=0; 492 | 493 | if (env->eq(env, type, env->intern(env, "string"))) 494 | { 495 | // the first copy puts the string length into the variable 496 | env->copy_string_contents(env, arg, NULL, &size); 497 | 498 | // then we can allocate the string and copy into it. 499 | char *result = malloc(size); 500 | env->copy_string_contents(env, arg, result, &size); 501 | return result; 502 | } 503 | 504 | else 505 | { 506 | emacs_value msg = emacs_message(env, "got msg: %S", 1, arg); 507 | fprintf(stderr, "size-2: %d\n", size); 508 | // the first copy puts the string length into the variable 509 | env->copy_string_contents(env, msg, NULL, &size); 510 | 511 | // then we can allocate the string and copy into it. 512 | char *result = malloc(size); 513 | env->copy_string_contents(env, msg, result, &size); 514 | return result; 515 | } 516 | 517 | } 518 | 519 | #+END_SRC 520 | 521 | ***** Extract arrays 522 | 523 | It is not clear I can write a useful helper function here. C functions can only return pointers to arrays, so you have to create the array somewhere, pass it to the function, and the free the array afterwards. Some arrays are 1d and some are 2d, and sometimes they get converted back and forth, so there would have to be a set of functions for all those cases. 524 | **** emacs_make_list 525 | :PROPERTIES: 526 | :ID: D0BB50B9-7C1F-4CAA-B6BA-BB1CA16281B9 527 | :END: 528 | 529 | This is a function to take an arbitrary number of emacs_value arguments and make a list of them. This is useful to build up a form to eval, or for use in defun, etc... 530 | 531 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 532 | emacs_value make_emacs_list (emacs_env *env, int nargs, ...) 533 | { 534 | emacs_value list = env->intern(env, "list"); 535 | int i; 536 | emacs_value args[nargs]; 537 | 538 | va_list ap; 539 | va_start (ap, nargs); 540 | 541 | for (i = 0; i < nargs; i++) 542 | args[i] = va_arg (ap, emacs_value); /* Get the next argument value. */ 543 | 544 | va_end (ap); /* Clean up. */ 545 | 546 | emacs_value result = env->funcall(env, list, nargs, args); 547 | return result; 548 | } 549 | 550 | #+END_SRC 551 | 552 | **** emacs_make_vector 553 | 554 | Similar to [[id:D0BB50B9-7C1F-4CAA-B6BA-BB1CA16281B9][emacs_make_list]] but makes a vector. 555 | 556 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 557 | emacs_value make_emacs_vector (emacs_env *env, int nargs, ...) 558 | { 559 | emacs_value Svector = env->intern(env, "vector"); 560 | int i; 561 | emacs_value args[nargs]; 562 | 563 | va_list ap; 564 | va_start (ap, nargs); 565 | 566 | for (i = 0; i < nargs; i++) 567 | args[i] = va_arg (ap, emacs_value); /* Get the next argument value. */ 568 | 569 | va_end (ap); /* Clean up. */ 570 | 571 | emacs_value result = env->funcall(env, Svector, nargs, args); 572 | return result; 573 | } 574 | 575 | #+END_SRC 576 | 577 | **** defconst 578 | 579 | These functions are like defining a constant in emacs with defconst. The reason this is helpful is that there is a documentation string on them. There are functions for integers, floats and strings. The main reason you would do this is to encapsulate #define constants from a c-header into Emacs. Otherwise, you might as well do this in an Elisp helper module! 580 | 581 | ***** defconsti (integer) 582 | 583 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 584 | // define a constant that is an integer in emacs 585 | void defconsti (emacs_env *env, const char *name, int value, const char *doc) 586 | { 587 | // These are functions we will call 588 | emacs_value eval = env->intern(env, "eval"); 589 | emacs_value list = env->intern(env, "list"); 590 | 591 | // These will make up the list we will eventually eval 592 | emacs_value fdefconst = env->intern(env, "defconst"); 593 | emacs_value sym = env->intern(env, name); 594 | emacs_value val = env->make_integer(env, value); 595 | emacs_value sdoc = env->make_string(env, doc, strlen(doc)); 596 | 597 | // make a list of (defconst sym val doc) 598 | emacs_value largs[] = {fdefconst, sym, val, sdoc}; 599 | emacs_value qlist = env->funcall(env, list, 4, largs); 600 | 601 | // now eval the list of symbols 602 | emacs_value args[] = { qlist }; 603 | env->funcall(env, eval, 1, args); 604 | } 605 | #+END_SRC 606 | 607 | ***** defconstf (float) 608 | 609 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 610 | // define a constant that is a float in Emacs 611 | void defconstf (emacs_env *env, const char *name, double value, const char *doc) 612 | { 613 | // These are functions we will call 614 | emacs_value eval = env->intern(env, "eval"); 615 | emacs_value list = env->intern(env, "list"); 616 | 617 | // These will make up the list we will eventually eval 618 | emacs_value fdefconst = env->intern(env, "defconst"); 619 | emacs_value sym = env->intern(env, name); 620 | emacs_value val = env->make_float(env, value); 621 | emacs_value sdoc = env->make_string(env, doc, strlen(doc)); 622 | 623 | // make a list of (defconst sym val doc) 624 | emacs_value largs[] = {fdefconst, sym, val, sdoc}; 625 | emacs_value qlist = env->funcall(env, list, 4, largs); 626 | 627 | // now eval the list of symbols 628 | emacs_value args[] = { qlist }; 629 | env->funcall(env, eval, 1, args); 630 | } 631 | #+END_SRC 632 | 633 | ***** defconsts (string) 634 | 635 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 636 | // define a constant that is a string in Emacs 637 | void defconsts (emacs_env *env, const char *name, const char *value, const char *doc) 638 | { 639 | // These are functions we will call 640 | emacs_value eval = env->intern(env, "eval"); 641 | emacs_value list = env->intern(env, "list"); 642 | 643 | // These will make up the list we will eventually eval 644 | emacs_value fdefconst = env->intern(env, "defconst"); 645 | emacs_value sym = env->intern(env, name); 646 | emacs_value val = env->make_string(env, value, strlen(value)); 647 | emacs_value sdoc = env->make_string(env, doc, strlen(doc)); 648 | 649 | // make a list of (defconst sym val doc) 650 | emacs_value largs[] = {fdefconst, sym, val, sdoc}; 651 | emacs_value qlist = env->funcall(env, list, 4, largs); 652 | 653 | // now eval the list of symbols 654 | emacs_value args[] = { qlist }; 655 | env->funcall(env, eval, 1, args); 656 | } 657 | #+END_SRC 658 | **** fset 659 | :PROPERTIES: 660 | :ID: 0824B71F-3E35-41F0-9FA6-A48326E68DD1 661 | :END: 662 | 663 | This is the primary function to create new functions in Emacs. The functions created this way only show the function signature of (name &rest ARGS), and this seems unavoidable. It is possible to create functions with optional arguments, and variadic arguments. For optional arguments, max_arity is larger than min_arity, and in your function you have to check for how many args were passed in and define variables accordingly. If max_arity is set to -2 or =emacs_variadic_function= you get a variadic function, i.e. arbitrary number of arguments usually defined by &rest in Emacs). I recommend you include the intended signature in the documentation string. 664 | 665 | Note that these are all "commands" in Emacs, i.e. you cannot M-x them. See [[id:073DB18B-BB05-4BB8-B6CE-8A0089BB413B][Eval a string]] for a way to create an interactive function from a string. 666 | 667 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 668 | emacs_value fset (emacs_env *env, 669 | const char *name, // emacs function name 670 | // function pointer and signature 671 | emacs_value (*function) (emacs_env *env, 672 | ptrdiff_t nargs, 673 | emacs_value args[], 674 | void *), 675 | ptrdiff_t min_arity, // min nargs 676 | ptrdiff_t max_arity, // max nargs 677 | const char *documentation, 678 | void *data) 679 | { 680 | // we will funcall (fset symbol func) 681 | emacs_value Sfset = intern(env, "fset"); 682 | emacs_value Sname = intern(env, name); 683 | 684 | emacs_value Sfunc = env->make_function(env, min_arity, max_arity, 685 | function, 686 | documentation, 687 | data); 688 | 689 | emacs_value args[] = { Sname, Sfunc }; 690 | 691 | env->funcall(env, Sfset, 2, args); 692 | } 693 | 694 | #+END_SRC 695 | 696 | **** defun 697 | 698 | You cannot use funcall on defun, because defun is a special form. You can, however, build up a list of symbols and eval it to create a defun. The reason to do this is to get a proper argument signature. Note that the functions you use in the body of your function here must be defined within the Emacs environment, either by [[id:0824B71F-3E35-41F0-9FA6-A48326E68DD1][fset]], or as built-in or imported emacs functions. You cannot use this function to make an interactive function at this point. Supporting that would require checking the 5th argument to see if it starts with an interactive symbol. 699 | 700 | #+BEGIN_SRC emacs-lisp 701 | (eval '(defun emacs-name (arg-list) docstring body)) 702 | #+END_SRC 703 | 704 | If you make the body just a simple command like (private-func arg-list), this is not too tedious. The benefit is a proper docstring and argument signature on the function. The key is you have to build up the list of emacs_value elements. Note that unlike the defun macro which treats body as a list of forms, here there should only be one form, so if you want many you need to wrap them in a progn. There are some tricks to dealing with &optional arguments and &rest arguments. For &optional arguments you have to build up conditionals in the body to handle missing arguments. For &rest arguments, you have to use 705 | 706 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 707 | emacs_value defun (emacs_env *env, 708 | char *name, 709 | emacs_value *args, 710 | char *docstring, 711 | emacs_value *body) 712 | { 713 | emacs_value eval = env->intern(env, "eval"); 714 | 715 | emacs_value eval_args = make_emacs_list(env, 5, 716 | intern(env, "defun"), 717 | intern(env, name), 718 | args, 719 | env->make_string(env, 720 | docstring, 721 | strlen(docstring)), 722 | body); 723 | 724 | emacs_value result = env->funcall(env, eval, 1, &eval_args); 725 | 726 | return result; 727 | } 728 | #+END_SRC 729 | 730 | Note that defun probably only practically works on the simplest argument structures, i.e. no &optional or &rest arguments. The reason is that you have to create the logic in the function body which is certainly tedious, and it is not clear you can nest lists. 731 | 732 | **** require 733 | 734 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 735 | // require("feature") 736 | // This is for use in a module 737 | void require (emacs_env *env, const char *feature) 738 | { 739 | emacs_value args[] = { intern(env, feature) }; 740 | env->funcall(env, intern(env, "require"), 1, args); 741 | } 742 | 743 | 744 | #+END_SRC 745 | 746 | **** provide 747 | 748 | #+BEGIN_SRC c :tangle emacs-module-helpers.c 749 | void provide (emacs_env *env, const char *feature) 750 | { 751 | emacs_value Qfeat = env->intern (env, feature); 752 | emacs_value Qprovide = env->intern (env, "provide"); 753 | emacs_value args[] = { Qfeat }; 754 | 755 | env->funcall (env, Qprovide, 1, args); 756 | } 757 | 758 | 759 | #+END_SRC 760 | 761 | 762 | **** TODO extract an array from a vector 763 | :PROPERTIES: 764 | :ID: 88D35AC1-6A42-4B06-8715-E3C5EE6A6969 765 | :END: 766 | 767 | For many linear algebra routines, you need arrays from input vector arrays. Here are some elisp functions for things we will need. 768 | 769 | #+BEGIN_SRC emacs-lisp 770 | (defun vector-shape (vec) 771 | "Return a vector of the shape of a vector." 772 | (let ((shape (vector (length vec)))) 773 | (if (vectorp (aref vec 0)) 774 | (vconcat shape (vector-shape (aref vec 0))) 775 | shape))) 776 | 777 | (defun vector-ndims (vec) 778 | "Returns the number of dimensions in a vector." 779 | (length (vector-shape vec))) 780 | 781 | (defun vector-numel (vec) 782 | "Returns the number of elements in a vector." 783 | (if (> (length vec) 0) 784 | (seq-reduce '* (vector-shape vec) 1) 785 | 0)) 786 | 787 | (defun vector-nrows (vec) 788 | "Return the number of rows in the vector." 789 | (assert (= 2 (vector-ndims vec))) 790 | (aref (vector-shape vec) 0)) 791 | 792 | (defun vector-ncols (vec) 793 | "Return the number of columns" 794 | (assert (= 2 (vector-ndims vec))) 795 | (aref (vector-shape vec) 1)) 796 | #+END_SRC 797 | 798 | 799 | *** emacs-module-helpers.h 800 | :PROPERTIES: 801 | :ID: D796707B-A6A6-4908-BDEB-DC60689ADD72 802 | :END: 803 | 804 | This header file exposes functions in the helper module. 805 | 806 | #+BEGIN_SRC c :tangle emacs-module-helpers.h 807 | #include "emacs-module.h" 808 | 809 | #ifndef EMACS_MODULE_HELPERS_H_ 810 | #define EMACS_MODULE_HELPERS_H_ 811 | 812 | #+END_SRC 813 | 814 | Debugging macros 815 | 816 | #+BEGIN_SRC c :tangle emacs-module-helpers.h 817 | #include 818 | #include 819 | #include 820 | 821 | #ifdef NDEBUG 822 | #define debug(fmt, ...) 823 | #else 824 | #define debug(fmt, ...) \ 825 | do { fprintf(stderr, "%s:%d:%s(): " fmt " \nArgs: ", "\n" __FILE__, \ 826 | __LINE__, __func__, __VA_ARGS__); } while (0) 827 | #endif 828 | #+END_SRC 829 | 830 | These are function headers 831 | 832 | #+BEGIN_SRC c :tangle emacs-module-helpers.h 833 | 834 | void defconsti (emacs_env *env, const char *name, int value, const char *doc); 835 | void defconstf (emacs_env *env, const char *name, double value, const char *doc); 836 | void defconsts (emacs_env *env, const char *name, const char *value, const char *doc); 837 | 838 | 839 | double extract_double (emacs_env *env, emacs_value arg); 840 | int extract_integer (emacs_env *env, emacs_value arg); 841 | char * extract_string (emacs_env *env, emacs_value arg); 842 | 843 | // There may be some other message function, so we name this one a little more verbose. 844 | emacs_value emacs_message (emacs_env *env, const char *msg, int nargs, ...); 845 | emacs_value emacs_format (emacs_env *env, const char *msg, int nargs, ...); 846 | 847 | emacs_value intern(emacs_env *env, const char *feature); 848 | 849 | emacs_value fset(emacs_env *env, 850 | const char *name, // emacs function name 851 | // function pointer and signature 852 | emacs_value (*function) (emacs_env *env, 853 | ptrdiff_t nargs, 854 | emacs_value args[], 855 | void *), 856 | ptrdiff_t min_arity, // min nargs 857 | ptrdiff_t max_arity, // max nargs 858 | const char *documentation, 859 | void *data); 860 | 861 | void provide (emacs_env *env, const char *feature); 862 | void require (emacs_env *env, const char *feature); 863 | 864 | emacs_value make_emacs_list (emacs_env *env, int nargs, ...); 865 | emacs_value make_emacs_vector (emacs_env *env, int nargs, ...); 866 | 867 | emacs_value defun (emacs_env *env, 868 | char *name, 869 | emacs_value *args, 870 | char *docstring, 871 | emacs_value *body); 872 | 873 | emacs_value read (emacs_env *env, const char *form); 874 | emacs_value eval (emacs_env *env, const char *form); 875 | 876 | #endif // EMACS_MODULE_HELPERS_H_ 877 | #+END_SRC 878 | 879 | ** Simple module code 880 | 881 | All the blocks in this section should tangle to your module file. 882 | 883 | These are the minimal headers you need. 884 | 885 | #+BEGIN_SRC c :tangle simple-mod.c 886 | #include "emacs-module.h" 887 | #include "emacs-module-helpers.h" 888 | 889 | #+END_SRC 890 | 891 | Every module must declare this symbol or Emacs will not load them. 892 | 893 | #+BEGIN_SRC c :tangle simple-mod.c 894 | int plugin_is_GPL_compatible; 895 | 896 | #+END_SRC 897 | 898 | Every function you want to define in Emacs will look something like this. Say you want to define a function that takes a single argument (x) that is an integer and multiplies it by 2 and returns an integer. 899 | 900 | #+BEGIN_SRC c :tangle simple-mod.c 901 | static emacs_value Ffunc (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 902 | { 903 | int x = extract_integer(env, args[0]); 904 | return env->make_integer(env, x * 2); 905 | } 906 | 907 | #+END_SRC 908 | 909 | *** A function with one optional argument 910 | 911 | This function will have the signature: (simple-1opt A & optional B) and it will return (int) (A * B), where B is optional and will have a default value of 1. We initialize B to the default value, check how many args were passed, and if it is two, we know the second arg contains the optional argument. 912 | 913 | #+BEGIN_SRC c :tangle simple-mod.c 914 | static emacs_value Fsimple_1opt (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 915 | { 916 | int A = extract_integer(env, args[0]); 917 | int B = 1; 918 | if (nargs == 2) 919 | { 920 | B = extract_integer(env, args[1]); 921 | } 922 | return env->make_integer(env, A * B); 923 | } 924 | 925 | #+END_SRC 926 | 927 | *** A variadic function 928 | 929 | This simple function just calculates the sum of a bunch of integers and returns the sum. 930 | 931 | #+BEGIN_SRC c :tangle simple-mod.c 932 | static emacs_value Fsimple_intsum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 933 | { 934 | int sum = 0; 935 | int i; 936 | for (i = 0; i < nargs; i++) 937 | sum += extract_integer(env, args[i]); 938 | return env->make_integer(env, sum); 939 | } 940 | 941 | #+END_SRC 942 | 943 | 944 | *** Initializing the module 945 | 946 | Every module must define =emacs_module_init= to initialize the module. This is where you "declare" which functions are exposed to Emacs. The two c-functions for this are fset and defun. 947 | 948 | I recommend you put the intended signature of the function in the doc string of fset. It appears that Emacs does not know the signature otherwise. The defun function is better at this, but more limited in how easy it is to specify the body of the function. 949 | 950 | #+BEGIN_SRC c :tangle simple-mod.c 951 | 952 | 953 | int emacs_module_init(struct emacs_runtime *ert) 954 | { 955 | emacs_env *env = ert->get_environment(ert); 956 | 957 | // This is a "private" function 958 | fset(env, 959 | "-simple-simple", Ffunc, 960 | 1, 1, 961 | "(-simple-simple X)\n" \ 962 | "Multiply X by 2.", 963 | NULL); 964 | 965 | // This is a "public" function that will have a good argument signature. 966 | defun(env, 967 | "simple-simple", // the emacs name 968 | make_emacs_list(env, 1, intern(env, "x")), // this makes (x) 969 | "supercalifragilisticexpialidocious", // the docstring 970 | // The next line makes (-simple-simple x) for the body 971 | make_emacs_list(env, 2, intern(env, "-simple-simple"), intern(env, "x"))); 972 | 973 | // One required, one optional argument 974 | fset(env, 975 | "-simple-1opt", Fsimple_1opt, 976 | 1, // one required arg 977 | 2, // two max args, so one is optional 978 | "(-simple-1opt A &optional B)", 979 | NULL); 980 | 981 | defun(env, 982 | "simple-1opt", 983 | make_emacs_list(env, 3, 984 | intern(env, "A"), 985 | intern(env, "&optional"), 986 | intern(env, "B")), 987 | "optional param", 988 | make_emacs_list(env, 3, 989 | intern(env, "-simple-1opt"), 990 | intern(env, "A"), 991 | // Note you have to handle the optional value here. It 992 | // isn't pretty, and duplicates the value in the 993 | // c-function. I don't see a better option though. 994 | make_emacs_list(env, 3, 995 | intern(env, "or"), 996 | intern(env, "B"), 997 | env->make_integer(env, 1)))); 998 | 999 | // 1 required argument and variadic 1000 | fset(env, 1001 | "simple-intsum", Fsimple_intsum, 1002 | 1, -2, 1003 | "Simple variadic sum", 1004 | NULL); 1005 | 1006 | defun(env, 1007 | "simple-intsum-d", 1008 | make_emacs_list(env, 2, 1009 | intern(env, "&rest"), 1010 | intern(env, "x")), 1011 | "defun version of intsum", 1012 | // Note here we have to use apply to handle the variadic args 1013 | make_emacs_list(env, 1014 | 3, 1015 | intern(env, "apply"), 1016 | make_emacs_list(env, 2, 1017 | intern(env, "quote"), 1018 | intern(env, "simple-intsum")), 1019 | intern(env, "x"))); 1020 | 1021 | // You might prefer this way to get an interactive function. 1022 | eval(env, 1023 | "(defun simple-intsum-d2 (&rest x)" \ 1024 | "(interactive \"nX: \")" \ 1025 | "(apply 'simple-intsum x))"); 1026 | 1027 | provide(env, "simple-mod"); 1028 | 1029 | return 0; 1030 | } 1031 | 1032 | /* This is normally the end of the file */ 1033 | #+END_SRC 1034 | 1035 | ** Vector functions for linear algebra 1036 | 1037 | See [[id:88D35AC1-6A42-4B06-8715-E3C5EE6A6969][extract an array from a vector]], [[id:E88713AA-1100-49CB-8E9E-4ED8C268BA3D][GNU Scientific Library]] where I worked a bunch of these out. Also see [[id:D8417EF9-2069-446E-8C7E-C76CD4655D22][Linear algebra library for Emacs]] where I documented a lot of other ideas for this. 1038 | 1039 | I worked out some functions here: [[./../mod-vector.c]] and [[./../mod-list-vec.c]] 1040 | 1041 | ** Makefile 1042 | 1043 | 1044 | #+BEGIN_SRC makefile :tangle Makefile 1045 | LDFLAGS = -shared 1046 | CFLAGS = -Wall -shared -fPIC 1047 | LIBS = -L. -lemacs-module-helpers 1048 | CC = gcc 1049 | 1050 | all: libemacs-module-helpers.so simple-mod.so test-simple-mod 1051 | 1052 | clean: 1053 | rm *.c *.h *.o *.so tests.el 1054 | 1055 | ################## 1056 | # Module helpers # 1057 | ################## 1058 | 1059 | libemacs-module-helpers.so: emacs-module-helpers.o 1060 | $(CC) $(LDFLAGS) -o libemacs-module-helpers.so emacs-module-helpers.o 1061 | 1062 | emacs-module-helpers.o: emacs-module-helpers.c emacs-module-helpers.h 1063 | $(CC) $(CFLAGS) -c emacs-module-helpers.c 1064 | 1065 | ############## 1066 | # Simple-Mod # 1067 | ############## 1068 | 1069 | simple-mod.so: simple-mod.o libemacs-module-helpers.so 1070 | $(CC) $(LDFLAGS) $(LIBS) -o simple-mod.so simple-mod.o 1071 | 1072 | simple-mod.o: simple-mod.c 1073 | $(CC) $(CFLAGS) -c simple-mod.c 1074 | 1075 | test-simple-mod: simple-mod.so tests.el 1076 | emacs -batch -q -l tests.el -f ert-run-tests-batch-and-exit 1077 | #+END_SRC 1078 | 1079 | ** Test file 1080 | 1081 | #+BEGIN_SRC emacs-lisp :tangle tests.el 1082 | (add-to-list 'load-path (expand-file-name ".")) 1083 | 1084 | (require 'cl) 1085 | (require 'ert) 1086 | (require 'simple-mod) 1087 | 1088 | (ert-deftest t1 () 1089 | (should (= 2 (simple-simple 1)))) 1090 | 1091 | 1092 | (ert-deftest t2 () 1093 | (should (= 2 (simple-simple 1.0)))) 1094 | 1095 | 1096 | (ert-deftest t3 () 1097 | "This fails maybe because it is a module?" 1098 | :expected-result :failed 1099 | (should-error (= 2 (simple-simple "1.0")))) 1100 | 1101 | ;; This test just confirms that should-error works for regular functions 1102 | (ert-deftest test-divide-by-zero () 1103 | (should-error (/ 1 0) 1104 | :type 'arith-error)) 1105 | 1106 | 1107 | (ert-deftest test-1opt-1 () 1108 | (should (= 2 (simple-1opt 2)))) 1109 | 1110 | (ert-deftest test-1opt-2 () 1111 | (should (= 4 (simple-1opt 2 2)))) 1112 | 1113 | (ert-deftest test-intsum-1 () 1114 | (should (= 1 (simple-intsum 1)))) 1115 | 1116 | (ert-deftest test-intsum-2 () 1117 | (should (= 2 (simple-intsum 1 1)))) 1118 | 1119 | (ert-deftest test-intsum-3 () 1120 | (should (= 4 (simple-intsum 1 1 2)))) 1121 | 1122 | (ert-deftest test-intsum-4 () 1123 | (should (= 7 (simple-intsum 1 1 2 3)))) 1124 | 1125 | (ert-deftest test-intsum-d1 () 1126 | (should (= 7 (simple-intsum-d 1 1 2 3)))) 1127 | 1128 | (ert-deftest test-intsum-d2 () 1129 | (should (= 7 (simple-intsum-d2 1 1 2 3)))) 1130 | #+END_SRC 1131 | 1132 | ** Local variables 1133 | 1134 | These local variables are read when the file is opened, establishing the hook that makes everything when you tangle. 1135 | 1136 | # Local Variables: 1137 | # eval: (progn (org-babel-goto-named-src-block "my-hook-function") (org-babel-execute-src-block) (add-hook 'org-babel-post-tangle-hook 'my-special-hook)) 1138 | # End: 1139 | -------------------------------------------------------------------------------- /tests.el: -------------------------------------------------------------------------------- 1 | (add-to-list 'load-path (expand-file-name ".")) 2 | 3 | 4 | (defun test-linalg () 5 | (require 'gsl-linalg) 6 | (print (gsl-linalg-LU-solve 7 | [[0.18 0.60 0.57 0.96] 8 | [0.41 0.24 0.99 0.58] 9 | [0.14 0.30 0.97 0.66] 10 | [0.51 0.13 0.19 0.85]] 11 | [1.0 2.0 3.0 4.0])) 12 | (print (gsl-linalg-LU-solve 13 | [[0.18 0.60 0.57 0.96] 14 | [0.41 0.24 0.99 0.58] 15 | [0.14 0.30 0.97 0.66] 16 | [0.51 0.13 0.19 0.85]] 17 | [1.0 2.0 3.0 4])) 18 | 19 | (print (gsl-blas-dgemm 20 | [[0.11 0.12 0.13] 21 | [0.21 0.22 0.23]] 22 | [[1011 1012] 23 | [1021 1022] 24 | [1031 1032]]))) 25 | 26 | 27 | (defun test-mkl () 28 | (let ((process-environment ))) 29 | (add-to-list 'process-environment "LD_LIBRARY_PATH=/opt/intel/compilers_and_libraries_2017.4.181/mac/mkl/lib") 30 | 31 | (add-to-list 'process-environment "DYLD_LIBRARY_PATH=/opt/intel/compilers_and_libraries_2017.4.181/mac/tbb/lib:/opt/intel/compilers_and_libraries_2017.4.181/mac/compiler/lib:/opt/intel/compilers_and_libraries_2017.4.181/mac/mkl/lib") 32 | (require 'mod-mkl) 33 | 34 | (print (getenv "LD_LIBRARY_PATH")) 35 | 36 | (print (mkl-dgemm 37 | [[0.11 0.12 0.13] 38 | [0.21 0.22 0.23]] 39 | [[1011 1012] 40 | [1021 1022] 41 | [1031 1032]]))) 42 | 43 | 44 | (defun test-constants () 45 | (require 'gsl-constants) 46 | (print GSL-CONST-MKSA-PLANCKS-CONSTANT-H) 47 | (print (describe-variable 'GSL-CONST-MKSA-PLANCKS-CONSTANT-H))) 48 | 49 | 50 | (defun test-types () 51 | (require 'mod-types) 52 | (print (mt 1)) 53 | (print (mt 2.0)) 54 | (print (mtype 0)) 55 | (print (mtype 0.0)) 56 | (print (mtype "0.0")) 57 | (print (mtype '(0.0 1.0))) 58 | (print (mtype [0.0])) 59 | (print (mtype (current-buffer))) 60 | (print (mtype (make-hash-table))) 61 | (print (mtype 'test)) 62 | (print (mvariadic)) 63 | (print (mvariadic 1)) 64 | (print (mvariadic 1 2)) 65 | (print (mvariadic 1 2 3)) 66 | (print (mvariadic 1 2 3 4))) 67 | 68 | 69 | (defun test-integration () 70 | (require 'gsl-integration) 71 | (print (gsl-integration-qags (lambda (x params) (/ (log x) (sqrt x))) 0.0 1.0)) 72 | ;; integer test 73 | (print (gsl-integration-qags (lambda (x params) (/ (log x) (sqrt x))) 0 1)) 74 | (print (gsl-integration-qags (lambda (x params) (/ (log x) (sqrt x))) 0.0 1.0 nil nil 0.01 500)) 75 | (print (gsl-integration-qags (lambda (x params) (/ (log x) (sqrt x))) 0.0 1.0 nil nil 0.01 500.0)) 76 | (print (gsl-integration-qags (lambda (x params) (car params)) 0.0 1.0 '(0.5)))) 77 | 78 | 79 | (defun test-roots () 80 | (require 'gsl-roots) 81 | (print (gsl-root-fsolver-brent (lambda (x params) (- (* x x) 5)) 0.0 5.0)) 82 | (print (gsl-root-fsolver-brent (lambda (x params) (- (* x x) 5)) 0 5)) 83 | (print (gsl-root-fsolver-brent (lambda (x params) (- (* x x) 5)) 0.0 5.0 nil nil 1e-6))) 84 | 85 | 86 | (defun test-list-vec () 87 | (require 'mod-list-vec) 88 | (print (f1 3)) 89 | (print (f2 [10 9])) 90 | (print (f3)) 91 | (print (f4 [1 2] 2)) 92 | (prin1 "4a list ") 93 | (print (f4a '(1 2) 3)) 94 | (prin1 "4a vec ") 95 | (print (f4a [3 4] 3)) 96 | (print (f5 [3 4 5])) 97 | (print (f6 [[1 2] [3 4]])) 98 | (print (f7 2 '(4 3 2 1)))) 99 | -------------------------------------------------------------------------------- /zeromq/ffi.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding:t -*- 2 | 3 | (require 'cl-macs) 4 | 5 | (module-load "ffi-module.so") 6 | 7 | (gv-define-simple-setter ffi--mem-ref ffi--mem-set t) 8 | 9 | (defmacro define-ffi-library (symbol name) 10 | (let ((library (cl-gensym))) 11 | (set library nil) 12 | `(defun ,symbol () 13 | (or ,library 14 | (setq ,library (ffi--dlopen ,name)))))) 15 | 16 | (defmacro define-ffi-function (name c-name return-type arg-types library) 17 | (let* ( 18 | ;; Turn variable references into actual types; while keeping 19 | ;; keywords the same. 20 | (arg-types (mapcar #'symbol-value arg-types)) 21 | (arg-names (mapcar (lambda (_ignore) (cl-gensym)) arg-types)) 22 | (arg-types (vconcat arg-types)) 23 | (function (cl-gensym)) 24 | (cif (ffi--prep-cif (symbol-value return-type) arg-types))) 25 | (set function nil) 26 | `(defun ,name (,@arg-names) 27 | (unless ,function 28 | (setq ,function (ffi--dlsym ,c-name (,library)))) 29 | ;; FIXME do we even need a separate prep? 30 | (ffi--call ,cif ,function ,@arg-names)))) 31 | 32 | (defun ffi-lambda (function-pointer return-type arg-types) 33 | (let* ((cif (ffi--prep-cif return-type (vconcat arg-types)))) 34 | (lambda (&rest args) ; lame 35 | (apply #'ffi--call cif function-pointer args)))) 36 | 37 | (defsubst ffi--align (offset align) 38 | (+ offset (mod (- align (mod offset align)) align))) 39 | 40 | (defun ffi--lay-out-struct (types) 41 | (let ((offset 0)) 42 | (mapcar (lambda (this-type) 43 | (setf offset (ffi--align offset 44 | (ffi--type-alignment this-type))) 45 | (let ((here offset)) 46 | (cl-incf offset (ffi--type-size this-type)) 47 | here)) 48 | types))) 49 | 50 | (defun ffi--struct-union-helper (name slots definer-function layout-function) 51 | (cl-assert (symbolp name)) 52 | (let* ((docstring (if (stringp (car slots)) 53 | (pop slots))) 54 | (conc-name (concat (symbol-name name) "-")) 55 | (result-forms ()) 56 | (field-types (mapcar (lambda (slot) 57 | (cl-assert (eq (cadr slot) :type)) 58 | (symbol-value (cl-caddr slot))) 59 | slots)) 60 | (the-type (apply definer-function field-types)) 61 | (field-offsets (funcall layout-function field-types))) 62 | (push `(defvar ,name ,the-type ,docstring) 63 | result-forms) 64 | (cl-mapc 65 | (lambda (slot type offset) 66 | (let ((getter-name (intern (concat conc-name 67 | (symbol-name (car slot))))) 68 | (offsetter (if (> offset 0) 69 | `(ffi-pointer+ object ,offset) 70 | 'object))) 71 | ;; One benefit of using defsubst here is that we don't have 72 | ;; to provide a GV setter. 73 | (push `(cl-defsubst ,getter-name (object) 74 | (ffi--mem-ref ,offsetter ,type)) 75 | result-forms))) 76 | slots field-types field-offsets) 77 | (cons 'progn (nreverse result-forms)))) 78 | 79 | (defmacro define-ffi-struct (name &rest slots) 80 | "Like a limited form of `cl-defstruct', but works with foreign objects. 81 | 82 | NAME must be a symbol. 83 | Each SLOT must be of the form `(SLOT-NAME :type TYPE)', where 84 | SLOT-NAME is a symbol and TYPE is an FFI type descriptor." 85 | (ffi--struct-union-helper name slots #'ffi--define-struct 86 | #'ffi--lay-out-struct)) 87 | 88 | (defmacro define-ffi-union (name &rest slots) 89 | "Like a limited form of `cl-defstruct', but works with foreign objects. 90 | 91 | NAME must be a symbol. 92 | Each SLOT must be of the form `(SLOT-NAME :type TYPE)', where 93 | SLOT-NAME is a symbol and TYPE is an FFI type descriptor." 94 | (ffi--struct-union-helper name slots #'ffi--define-union 95 | (lambda (types) 96 | (make-list (length types) 0)))) 97 | 98 | (defmacro define-ffi-array (name type length &optional docstring) 99 | ;; This is a hack until libffi gives us direct support. 100 | (let ((type-description 101 | (apply #'ffi--define-struct 102 | (make-list (eval length) (symbol-value type))))) 103 | `(defvar ,name ,type-description ,docstring))) 104 | 105 | (defsubst ffi-aref (array type index) 106 | (ffi--mem-ref (ffi-pointer+ array (* index (ffi--type-size type))) type)) 107 | 108 | (defmacro with-ffi-temporary (binding &rest body) 109 | (declare (indent defun)) 110 | `(let ((,(car binding) (ffi-allocate ,@(cdr binding)))) 111 | (unwind-protect 112 | (progn ,@body) 113 | (ffi-free ,(car binding))))) 114 | 115 | (defmacro with-ffi-temporaries (bindings &rest body) 116 | (declare (indent defun)) 117 | (let ((first-binding (car bindings)) 118 | (rest-bindings (cdr bindings))) 119 | (if rest-bindings 120 | `(with-ffi-temporary ,first-binding 121 | (with-ffi-temporaries ,rest-bindings 122 | ,@body)) 123 | `(with-ffi-temporary ,first-binding ,@body)))) 124 | 125 | (defmacro with-ffi-string (binding &rest body) 126 | (declare (indent defun)) 127 | `(let ((,(car binding) (ffi-make-c-string ,@(cdr binding)))) 128 | (unwind-protect 129 | (progn ,@body) 130 | (ffi-free ,(car binding))))) 131 | 132 | (defmacro with-ffi-strings (bindings &rest body) 133 | (declare (indent defun)) 134 | (let ((first-binding (car bindings)) 135 | (rest-bindings (cdr bindings))) 136 | (if rest-bindings 137 | `(with-ffi-string ,first-binding 138 | (with-ffi-strings ,rest-bindings 139 | ,@body)) 140 | `(with-ffi-string ,first-binding ,@body)))) 141 | 142 | (provide 'ffi) 143 | -------------------------------------------------------------------------------- /zeromq/hwclient: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jkitchin/emacs-modules/9ffff332ed84a73bf32366b72fe6d7f44f79d888/zeromq/hwclient -------------------------------------------------------------------------------- /zeromq/hwclient.c: -------------------------------------------------------------------------------- 1 | // Hello World client 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | int main (void) 8 | { 9 | printf ("Connecting to hello world server…\n"); 10 | void *context = zmq_ctx_new (); 11 | void *requester = zmq_socket (context, ZMQ_REQ); 12 | zmq_connect (requester, "tcp://localhost:5555"); 13 | 14 | char buffer [10]; 15 | printf ("Sending Hello\n"); 16 | zmq_send (requester, "Hello", 5, 0); 17 | zmq_recv (requester, buffer, 10, 0); 18 | printf ("Received %s\n", buffer); 19 | 20 | zmq_close (requester); 21 | zmq_ctx_destroy (context); 22 | return 0; 23 | } 24 | -------------------------------------------------------------------------------- /zeromq/hwserver: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jkitchin/emacs-modules/9ffff332ed84a73bf32366b72fe6d7f44f79d888/zeromq/hwserver -------------------------------------------------------------------------------- /zeromq/hwserver.c: -------------------------------------------------------------------------------- 1 | // Hello World server 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | int main (void) 10 | { 11 | // Socket to talk to clients 12 | void *context = zmq_ctx_new (); 13 | void *responder = zmq_socket (context, ZMQ_REP); 14 | int rc = zmq_bind (responder, "tcp://*:5555"); 15 | assert (rc == 0); 16 | 17 | while (1) { 18 | char buffer [10] = ""; //reset it for each response. 19 | zmq_recv (responder, buffer, 10, 0); 20 | printf ("Server received %s\n", buffer); 21 | sleep (1); // Do some 'work' 22 | zmq_send (responder, "World", 5, 0); 23 | } 24 | return 0; 25 | } 26 | -------------------------------------------------------------------------------- /zeromq/makefile: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | server: hwserver.c 5 | gcc -lzmq hwserver.c -o hwserver 6 | 7 | 8 | 9 | client: hwclient.c 10 | gcc -lzmq hwclient.c -o hwclient 11 | 12 | 13 | mod-zmq.so: mod-zmq.o 14 | gcc -shared -lzmq -L.. -lemacs-module-helpers -o mod-zmq.so mod-zmq.o 15 | 16 | mod-zmq.o: mod-zmq.c 17 | gcc -fPIC -c mod-zmq.c 18 | 19 | 20 | test: mod-zmq.so 21 | # ./hwserver & 22 | emacs -batch -q -l test.el -f test-1 23 | 24 | all: client server mod-zmq.so 25 | 26 | clean: 27 | rm *.o mod-zmq.so hwclient hwserver 28 | -------------------------------------------------------------------------------- /zeromq/mod-zmq.c: -------------------------------------------------------------------------------- 1 | #include "../emacs-module.h" 2 | #include "../emacs-module-helpers.h" 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | int plugin_is_GPL_compatible; 9 | 10 | static emacs_value Fzmq_ctx_new (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 11 | { 12 | void *context = zmq_ctx_new (); 13 | return env->make_user_ptr(env, 14 | NULL, // the finalizer func? 15 | context); 16 | } 17 | 18 | // http://api.zeromq.org/4-2:zmq-ctx-destroy 19 | // int zmq_ctx_destroy (void *context); 20 | // (zmq-ctx-destroy context) 21 | static emacs_value Fzmq_ctx_destroy (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 22 | { 23 | intptr_t context = env->get_user_ptr(env, args[0]); 24 | int result = zmq_ctx_destroy (context); 25 | return env->make_integer(env, result); 26 | } 27 | 28 | 29 | // http://api.zeromq.org/4-2:zmq-socket 30 | // void *zmq_socket (void *context, int type); 31 | //(zmq-socket context ZMQ_REQ) 32 | static emacs_value Fzmq_socket (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 33 | { 34 | 35 | intptr_t context = env->get_user_ptr(env, args[0]); 36 | int type = env->extract_integer(env, args[1]); 37 | void *socket = zmq_socket (context, type); 38 | return env->make_user_ptr(env, 39 | NULL, // the finalizer func? 40 | socket); 41 | } 42 | 43 | // http://api.zeromq.org/4-2:zmq-close 44 | // int zmq_close (void *socket); 45 | // (zmq-close socket) 46 | static emacs_value Fzmq_close (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 47 | { 48 | intptr_t socket = env->get_user_ptr(env, args[0]); 49 | int result = zmq_close (socket); 50 | return env->make_integer(env, result); 51 | } 52 | 53 | 54 | // http://api.zeromq.org/4-2:zmq-connect 55 | // int zmq_connect (void *socket, const char *endpoint); 56 | // (zmq-connect socket endpoint) 57 | static emacs_value Fzmq_connect (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 58 | { 59 | intptr_t socket = env->get_user_ptr(env, args[0]); 60 | emacs_value endpoint = args[1]; 61 | 62 | ptrdiff_t size = 0; 63 | // The first one will fail and write the length of the variable to size 64 | env->copy_string_contents(env, endpoint, NULL, &size); 65 | 66 | // Now we know the size and can do the copy 67 | char *endpoint_str = malloc(size); 68 | env->copy_string_contents(env, endpoint, endpoint_str, &size); 69 | 70 | int result = zmq_connect (socket, endpoint_str); 71 | free(endpoint_str); 72 | return env->make_integer(env, result); 73 | } 74 | 75 | // http://api.zeromq.org/4-2:zmq-send 76 | // int zmq_send (void *socket, void *buf, size_t len, int flags); 77 | // (zmq-send socket buf flag) 78 | static emacs_value Fzmq_send (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 79 | { 80 | intptr_t socket = env->get_user_ptr(env, args[0]); 81 | 82 | emacs_value buf = args[1]; 83 | 84 | ptrdiff_t size = 0; 85 | // The first one will fail and write the length of the variable to size 86 | env->copy_string_contents(env, buf, NULL, &size); 87 | 88 | // Now we know the size and can do the copy 89 | char *buf_str = malloc(size); 90 | env->copy_string_contents(env, buf, buf_str, &size); 91 | 92 | int flags = env->extract_integer(env, args[2]); 93 | 94 | int result= zmq_send(socket, buf_str, strlen(buf_str), flags); 95 | free(buf_str); 96 | return env->make_integer(env, result); 97 | } 98 | 99 | // http://api.zeromq.org/4-2:zmq-recv 100 | // int zmq_recv (void *socket, void *buf, size_t len, int flags); 101 | // (zmq-recv socket len flags) 102 | static emacs_value Fzmq_recv (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) 103 | { 104 | intptr_t socket = env->get_user_ptr(env, args[0]); 105 | int len = env->extract_integer(env, args[1]); 106 | int flags = env->extract_integer(env, args[2]); 107 | 108 | char cbuffer[len]; 109 | 110 | int res = zmq_recv (socket, cbuffer, len, flags); 111 | 112 | emacs_value result = env->make_string(env, cbuffer, strlen(cbuffer) - 1); 113 | emacs_value ret = env->make_integer(env, res); 114 | 115 | emacs_value list = env->intern(env, "list"); 116 | emacs_value largs[] = {result, ret}; 117 | 118 | return env->funcall(env, list, 2, largs); 119 | 120 | } 121 | 122 | 123 | int emacs_module_init(struct emacs_runtime *ert) 124 | { 125 | emacs_env *env = ert->get_environment(ert); 126 | 127 | 128 | DEFUN("zmq-ctx-new", Fzmq_ctx_new, 0, 0, 129 | "(zmq-ctx-new)\n" \ 130 | "create new ØMQ context. Returns pointer to context.\n" \ 131 | "http://api.zeromq.org/4-2:zmq-ctx-new", 132 | NULL); 133 | 134 | DEFUN("zmq-ctx-destroy", Fzmq_ctx_destroy, 1, 1, 135 | "(zmq-ctx-destroy CONTEXT)\n" \ 136 | "terminate a ØMQ context\n" \ 137 | "http://api.zeromq.org/4-2:zmq-ctx-destroy", NULL); 138 | 139 | // Defines a constant variable 140 | defconsti(env, "ZMQ-REQ", (int)ZMQ_REQ, "ZMQ_REQ"); 141 | 142 | DEFUN("zmq-socket", Fzmq_socket, 2, 2, 143 | "(zmq-socket CONTEXT TYPE)\n" 144 | "create ØMQ socket. Returns pointer to socket."\ 145 | "CONTEXT is from `zmq-ctx-new`.\n" 146 | "see http://api.zeromq.org/4-2:zmq-socket for TYPE info.", NULL); 147 | 148 | DEFUN("zmq-close", Fzmq_close, 1, 1, 149 | "(zmq-close SOCKET)\n" \ 150 | "close ØMQ socket. SOCKET is from `zmq-socket`\n" \ 151 | "Returns status of call."\ 152 | "http://api.zeromq.org/4-2:zmq-close", 153 | NULL); 154 | 155 | DEFUN("zmq-connect", Fzmq_connect, 2, 2, 156 | "(zmq-connect SOCKET ENDPOINT)\n" \ 157 | "Create outgoing connection from socket to endpoint." \ 158 | "The endpoint is a string consisting of a transport :// followed by an address. The transport specifies the underlying protocol to use. The address specifies the transport-specific address to connect to." \ 159 | "Returns result of call."\ 160 | "http://api.zeromq.org/4-2:zmq-connect", 161 | NULL); 162 | 163 | DEFUN("zmq-send", Fzmq_send, 3, 3, 164 | "(zmq-send SOCKET BUF FLAGS)\n" \ 165 | "send a message part on a socket" \ 166 | "SOCKET is from `zmq-socket`." \ 167 | "BUF is a string to send." \ 168 | "FLAGS is an int." \ 169 | "http://api.zeromq.org/4-2:zmq-send", NULL); 170 | 171 | DEFUN("zmq-recv", Fzmq_recv, 3, 3, 172 | "(zmq-recv SOCKET LEN FLAGS)\n" \ 173 | "receive a message part from a socket.\n" \ 174 | "SOCKET is from `zmq-socket`." \ 175 | "LEN is the number of bytes to get." \ 176 | "FLAGS is an int." \ 177 | "Returns (result status)." \ 178 | "http://api.zeromq.org/4-2:zmq-recv", NULL); 179 | 180 | 181 | provide(env, "mod-zmq"); 182 | 183 | return 0; 184 | } 185 | -------------------------------------------------------------------------------- /zeromq/test.el: -------------------------------------------------------------------------------- 1 | (progn 2 | (add-to-list 'load-path (expand-file-name ".")) 3 | (require 'mod-zmq) 4 | 5 | 6 | (let* ((context (zmq-ctx-new)) 7 | (requester (zmq-socket context ZMQ-REQ))) 8 | 9 | (zmq-connect requester "tcp://localhost:5555") 10 | (zmq-send requester "test" 0) 11 | 12 | (message "recv: %s" (zmq-recv requester 10 0)) 13 | 14 | (prog1 15 | (print (zmq-close requester)) 16 | (zmq-ctx-destroy context)))) 17 | 18 | 19 | (defun test-1 () 20 | (let* ((context (zmq-ctx-new)) 21 | (requester (zmq-socket context ZMQ-REQ))) 22 | 23 | (zmq-connect requester "tcp://localhost:5555") 24 | (zmq-send requester "test-2" 0) 25 | 26 | (message "recv: %s" (zmq-recv requester 10 0)) 27 | 28 | (prog1 29 | (print (zmq-close requester)) 30 | (zmq-ctx-destroy context)))) 31 | -------------------------------------------------------------------------------- /zeromq/zeromq.org: -------------------------------------------------------------------------------- 1 | * DONE Zeromq bindings for Emacs via dynamic modules 2 | CLOSED: [2017-07-12 Wed 07:38] 3 | :PROPERTIES: 4 | :categories: emacs,dynamic-module 5 | :date: 2017/07/12 07:38:28 6 | :updated: 2017/07/12 07:38:28 7 | :org-url: http://kitchingroup.cheme.cmu.edu/org/2017/07/12/Zeromq-bindings-for-Emacs-via-dynamic-modules.org 8 | :permalink: http://kitchingroup.cheme.cmu.edu/blog/2017/07/12/Zeromq-bindings-for-Emacs-via-dynamic-modules/index.html 9 | :END: 10 | 11 | I do a lot of scientific programming, and it is one of the reasons I have been learning to extend Emacs with dynamic modules. They have allowed me to add physical constants, numerical integration, root finding and linear algebra from established c-libraries to Emacs. Today I am taking a break from that and finally getting to another one of the reasons I started playing around with dynamic modules: [[http://zguide.zeromq.org/][zeromq]]. Zeromq is a messaging library that [[http://jupyter-client.readthedocs.io/en/latest/messaging.html][Jupyter]] uses to communicate with kernels. I thought we might get a smoother integration with Emacs and Jupyter if we could use zeromq directly to communicate between org-mode and the kernel. Currently we have to run a web server that does the communication for us via http requests. We won't solve the Jupyter problem today, but we will look at communicating with a Zeromq server from Emacs. 12 | 13 | This might have lots of other useful applications. Suppose Emacs could communicate directly with other zeromq servers to retrieve data from, perhaps scientific data. It might even be possible for Emacs to run its own zeromq server, and other instances of Emacs could then communicate with it. Collaborative editing anyone? 14 | 15 | Here we just implement the "Hello world" client example in the [[http://zguide.zeromq.org/page:all#Ask-and-Ye-Shall-Receive][zeromq guide]]. The code for the server, a c-client, the mod-zmq library, a makefile and tests can be found at https://github.com/jkitchin/emacs-modules/tree/master/zeromq. All the server does is receive a string, and then send a response (in this case just the string "World") back to the client. 16 | 17 | To run this, make sure to run the hwserver executable in a terminal. I wrapped the zeromq commands required to implement the client into a dynamic module. Since this example focuses on strings, the module returns strings to Emacs. I am not sure if that is always the right thing to do, as zeromq more generically uses bytes, but I will have to wait until I know more about zeromq to know if this is an issue. 18 | 19 | This dynamic module uses a new feature that none of the previous posts used, and that is the user_ptr. These allow you to essentially return a reference pointer back to emacs that you can pass back to another function. That way they stay alive between function calls. For example, here we have to create a context and socket and pass these items to functions like zmq_send and zmq_recv. 20 | 21 | The directory this library is in is not on my path, so we load it like this: 22 | 23 | #+BEGIN_SRC emacs-lisp 24 | (add-to-list 'load-path (expand-file-name ".")) 25 | (require 'mod-zmq) 26 | #+END_SRC 27 | 28 | Here are the functions and their signatures that have been implemented so far. I only implemented the ones I needed for the client. The signatures may change in the future; this is just a proof of concept for now for the purpose of building the client. 29 | 30 | #+BEGIN_SRC emacs-lisp 31 | (apropos-command "zmq*" t) 32 | (with-current-buffer "*Apropos*" (buffer-string)) 33 | #+END_SRC 34 | 35 | #+RESULTS: 36 | #+begin_example 37 | Type RET on a type label to view its full documentation. 38 | 39 | zmq-close 40 | Function: (zmq-close SOCKET) 41 | zmq-connect 42 | Function: (zmq-connect SOCKET ENDPOINT) 43 | zmq-ctx-destroy 44 | Function: (zmq-ctx-destroy CONTEXT) 45 | zmq-ctx-new 46 | Function: (zmq-ctx-new) 47 | zmq-recv 48 | Function: (zmq-recv SOCKET LEN FLAGS) 49 | zmq-send 50 | Function: (zmq-send SOCKET BUF FLAGS) 51 | zmq-socket 52 | Function: (zmq-socket CONTEXT TYPE) 53 | #+end_example 54 | 55 | You can see the c code for the client here: [[./hwclient.c]]. Here is a simple elisp version of the hwclient that basically does the same thing! The main difference is I added a while loop around the zmq-recv because sometimes it returns -1 and no result. So, here we loop until the return result is not -1. That seems to do the right thing. 56 | 57 | #+BEGIN_SRC emacs-lisp :results output 58 | (let* ((context (zmq-ctx-new)) 59 | (socket (zmq-socket context ZMQ-REQ)) 60 | (recv-ret -1) 61 | (result)) 62 | 63 | (zmq-connect socket "tcp://localhost:5555") 64 | (zmq-send socket "Hello" 0) 65 | 66 | (while (= recv-ret -1) 67 | (setq result (zmq-recv socket 10 0) 68 | recv-ret (second result))) 69 | 70 | (print result) 71 | 72 | (zmq-close socket) 73 | (zmq-ctx-destroy context)) 74 | #+END_SRC 75 | 76 | #+RESULTS: 77 | : 78 | : ("World" 5) 79 | 80 | Basically this creates the context, then the socket, and connects to it on port 5555 of the localhost where the server is running. Then we send the string "Hello". The server returns the string "World" and tells us it sent 5 bytes. Then we close the socket and destroy the context. There is a lot of code in the module to make this happen. A lot of it is converting args in emacs functions to things we can use in c, running a few lines of zmq commands, and then code to convert those results back to emacs values. Finally, there is code to register each function and define docstrings for them. I am not totally convinced this is the best way to do this, but it does work! An alternative might be [[https://github.com/tromey/emacs-ffi][emacs-ffi]], which might enable most of this to be developed in just elisp. 81 | 82 | * DONE An Emacs zeromq library using an ffi 83 | CLOSED: [2017-07-13 Thu 06:44] 84 | :PROPERTIES: 85 | :categories: emacs,dynamic-module,ffi,zeromq 86 | :date: 2017/07/13 06:44:23 87 | :updated: 2017/07/13 06:44:23 88 | :org-url: http://kitchingroup.cheme.cmu.edu/org/2017/07/13/An-Emacs-zeromq-library-using-an-ffi.org 89 | :permalink: http://kitchingroup.cheme.cmu.edu/blog/2017/07/13/An-Emacs-zeromq-library-using-an-ffi/index.html 90 | :END: 91 | 92 | An alternative approach to writing your own dynamic module (which requires some proficiency in c) is to use a foreign function interface (ffi). There is one for emacs at https://github.com/tromey/emacs-ffi, and it is also a dynamic module itself that uses [[https://github.com/libffi/libffi][libffi]]. This lets you use elisp to create functions in Emacs that actually call functions in some other library installed on your system. Here, we use this module to recreate our zeromq bindings that I previously [[http://kitchingroup.cheme.cmu.edu/blog/2017/07/12/Zeromq-bindings-for-Emacs-via-dynamic-modules/][posted]]. 93 | 94 | The emacs-ffi module works fine as it is, but I found it useful to redefine one of the main macros (define-ffi-function) with the following goals in mind: 95 | 96 | 1. Allow me to specify the argument names and docstrings for each arg that contain its type and a description of the arg. 97 | 2. Document what each function returns (type and description). 98 | 3. Combine those two things into an overall docstring on the function. 99 | 100 | These are important to me because it allows Emacs to work at its fullest potential while writing elisp code, including having the right function signatures in eldoc, and easy access to documentation of each function. You can see the new definition [[id:A2B7F051-EA53-4882-A978-05FAD211BB81][here]]. For example, here is a docstring for zmq-send using that new macro: 101 | 102 | #+BEGIN_SRC emacs-lisp :exports results 103 | (describe-function 'zmq-send) 104 | #+END_SRC 105 | 106 | #+RESULTS: 107 | #+begin_example 108 | zmq-send is a Lisp function. 109 | 110 | (zmq-send *SOCKET *MSG LEN FLAGS) 111 | 112 | For more information check the manuals. 113 | 114 | send a message part on a socket. 115 | http://api.zeromq.org/4-2:zmq-send 116 | 117 | ,*SOCKET (:pointer) Pointer to a socket. 118 | ,*MSG (:pointer) Pointer to a C-string to send 119 | LEN (:size_t) Number of bytes to send 120 | FLAGS (:int) 121 | 122 | Returns: Number of bytes sent or -1 on failure. (:int) 123 | #+end_example 124 | 125 | That has everything you need to know 126 | 127 | #+BEGIN_SRC emacs-lisp 128 | (define-ffi-function zmq-send-ori "zmq_send" :int (:pointer :pointer :size_t :int) zmq) 129 | #+END_SRC 130 | 131 | #+RESULTS: 132 | : zmq-send-ori 133 | 134 | Compare that to this docstring from the original macro. 135 | 136 | #+RESULTS: 137 | #+begin_example 138 | zmq-send-ori is a Lisp function. 139 | 140 | (zmq-send-ori G251 G252 G253 G254) 141 | 142 | For more information check the manuals. 143 | #+end_example 144 | 145 | You can see the zeromq function definitions in elisp [[id:29C81B62-C0DF-44D4-AFE2-6EE239C70500][here]]. Here is a list of the functions we have created: 146 | 147 | #+BEGIN_SRC emacs-lisp :exports results 148 | (apropos-command "zmq*" t) 149 | (with-current-buffer "*Apropos*" (buffer-string)) 150 | #+END_SRC 151 | 152 | #+RESULTS: 153 | #+begin_example 154 | Type RET on a type label to view its full documentation. 155 | 156 | zmq 157 | Function: Returns a pointer to the libzmq library. 158 | zmq-close 159 | Function: close ØMQ socket. 160 | zmq-connect 161 | Function: create outgoing connection from socket. 162 | zmq-ctx-destroy 163 | Function: terminate a ØMQ context. 164 | zmq-ctx-new 165 | Function: create new ØMQ context. 166 | zmq-recv 167 | Function: receive a message part from a socket. 168 | zmq-send 169 | Function: send a message part on a socket. 170 | zmq-socket 171 | Function: create ØMQ socket. 172 | #+end_example 173 | 174 | Now we can use these to create the client, this time in elisp. Just as in the last post, you need to run the hwserver in a terminal for this to work. Here is the client code. 175 | 176 | #+BEGIN_SRC emacs-lisp :results output 177 | (let* ((context (zmq-ctx-new)) 178 | (socket (zmq-socket context ZMQ-REQ))) 179 | 180 | (with-ffi-string (endpoint "tcp://localhost:5555") 181 | (zmq-connect socket endpoint)) 182 | 183 | (with-ffi-string (msg "Hi there") 184 | (zmq-send socket msg 5 0)) 185 | 186 | (with-ffi-string (recv (make-string 10 "")) 187 | (let ((status -1)) 188 | (cl-loop do (setq status (zmq-recv socket recv 10 0)) until (not (= -1 status)))) 189 | (print (ffi-get-c-string recv))) 190 | 191 | (zmq-close socket) 192 | (zmq-ctx-destroy context)) 193 | #+END_SRC 194 | 195 | #+RESULTS: 196 | : 197 | : "World " 198 | 199 | This client basically performs the same as the previously one we built. You can see we are mixing some programming styles here. For example, we have to create pointers to string variables in advance that the ffi will be writing to later like we would do in c. We use the with-ffi-string macro which frees the pointer when we are done with it. It basically just avoids me having to create, use, and destroy the pointers myself. So, there it is, a working elisp zeromq client! 200 | 201 | 202 | ** Summary thoughts 203 | 204 | For this example, I feel like the ffi approach here (with my modified function making macro) was much easier than what I previously did with a compiled c-library (although it benefited a lot from my recent work on the c-library). I really like working in elisp, which is a much greater strength of mine than programming in c. It is pretty clear, however, that you have to know how c works to use this, otherwise it isn't so obvious that some functions will return a status, and do something by side effect, e.g. put results in one of the arguments. The signatures of the ffi functions are basically limited by the signatures of the c-functions. If you want to change the signature in Emacs, you have to write wrapper functions to do that. 205 | 206 | The macro I used here to create the functions creates really good (the kind I like anyway) docstrings when you use it fully. That isn't a totally new idea, I tried it out [[http://kitchingroup.cheme.cmu.edu/blog/2017/03/22/A-better-defun-for-emacs-lisp/][here]] before. In contrast, the original version not only didn't have a docstring, but every arg had a gensym (i.e. practically random) name! I think it would be very difficult to get the same level of documentation when writing c-code to make a module. In the c-code, there is a decoupling of the definition of a c-function (which always has the same signature) that gets data from the Emacs env, e.g. arguments, does stuff with them, and creates data to put back into the env, and the emacs_module_init function where you declare these functions to Emacs and tell it what to call the function in emacs, about how many arguments it takes, etc... The benefit of this is you define what the Emacs signature will look like, and then write the c-function that does the required work. The downside of this is the c-function and Emacs declarations are often far apart in the editor, and there is no easy way to auto-generate docstrings like I can with lisp macros. You would have to manually build them up yourself, and keep them synchronized. Also, I still have not figured out how to get emacs to show the right signature for c-generated functions. 207 | 208 | The ffi approach still uses a dynamic module approach, so it still requires a modern Emacs with the module compiled and working. It still requires (in this case) the zeromq library to be installed on the system too. Once you have those, however, the elisp zeromq bindings by this approach is done /completely in elisp/! 209 | 210 | It will be interesting in the coming weeks to see how this approach works with the GNU Scientific Library, particularly with arrays. Preliminary work shows that while the elisp ffi code is /much/ shorter and easier to write than the corresponding c-code for some examples (e.g. a simple mathematical function), it is not as fast. So if performance is crucial, it may still pay off to write the c-code. 211 | 212 | ** Modified ffi-define-function macro 213 | :PROPERTIES: 214 | :ID: A2B7F051-EA53-4882-A978-05FAD211BB81 215 | :END: 216 | 217 | Here are two macros I modified to add docstrings and named arguments too. 218 | 219 | #+BEGIN_SRC emacs-lisp 220 | (defmacro define-ffi-library (symbol name) 221 | "Create a pointer named to the c library." 222 | (let ((library (cl-gensym)) 223 | (docstring (format "Returns a pointer to the %s library." name))) 224 | (set library nil) 225 | `(defun ,symbol () 226 | ,docstring 227 | (or ,library 228 | (setq ,library (ffi--dlopen ,name)))))) 229 | 230 | (defmacro define-ffi-function (name c-name return args library &optional docstring) 231 | "Create an Emacs function from a c-function. 232 | NAME is a symbol for the emacs function to create. 233 | C-NAME is a string of the c-function to use. 234 | RETURN is a type-keyword or (type-keyword docstring) 235 | ARGS is a list of type-keyword or (type-keyword name &optional arg-docstring) 236 | LIBRARY is a symbol usually defined by `define-ffi-library' 237 | DOCSTRING is a string for the function to be created. 238 | 239 | An overall docstring is created for the function from the arg and return docstrings. 240 | " 241 | ;; Turn variable references into actual types; while keeping 242 | ;; keywords the same. 243 | (let* ((return-type (if (keywordp return) 244 | return 245 | (car return))) 246 | (return-docstring (format "Returns: %s (%s)" 247 | (if (listp return) 248 | (second return) 249 | "") 250 | return-type)) 251 | (arg-types (vconcat (mapcar (lambda (arg) 252 | (if (keywordp arg) 253 | (symbol-value arg) 254 | ;; assume list (type-keyword name &optional doc) 255 | (symbol-value (car arg)))) 256 | args))) 257 | (arg-names (mapcar (lambda (arg) 258 | (if (keywordp arg) 259 | (cl-gensym) 260 | ;; assume list (type-keyword name &optional doc) 261 | (second arg))) 262 | args)) 263 | (arg-docstrings (mapcar (lambda (arg) 264 | (cond 265 | ((keywordp arg) 266 | "") 267 | ((and (listp arg) (= 3 (length arg))) 268 | (third arg)) 269 | (t ""))) 270 | args)) 271 | ;; Combine all the arg docstrings into one string 272 | (arg-docstring (mapconcat 'identity 273 | (mapcar* (lambda (name type arg-doc) 274 | (format "%s (%s) %s" 275 | (upcase (symbol-name name)) 276 | type 277 | arg-doc)) 278 | arg-names arg-types arg-docstrings) 279 | "\n")) 280 | (function (cl-gensym)) 281 | (cif (ffi--prep-cif (symbol-value return-type) arg-types))) 282 | (set function nil) 283 | `(defun ,name (,@arg-names) 284 | ,(concat docstring "\n\n" arg-docstring "\n\n" return-docstring) 285 | (unless ,function 286 | (setq ,function (ffi--dlsym ,c-name (,library)))) 287 | ;; FIXME do we even need a separate prep? 288 | (ffi--call ,cif ,function ,@arg-names)))) 289 | #+END_SRC 290 | 291 | #+RESULTS: 292 | : define-ffi-function 293 | 294 | 295 | ** The zeromq bindings 296 | :PROPERTIES: 297 | :ID: 29C81B62-C0DF-44D4-AFE2-6EE239C70500 298 | :END: 299 | 300 | These define the ffi functions we use in this post. I use a convention that pointer args start with a * so they look more like the c arguments. I also replace all _ with - so it looks more lispy, and the function names are easier to type. 301 | 302 | #+BEGIN_SRC emacs-lisp :results output 303 | (add-to-list 'load-path (expand-file-name ".")) 304 | (require 'ffi) 305 | 306 | (define-ffi-library zmq "libzmq") 307 | 308 | 309 | (define-ffi-function zmq-ctx-new "zmq_ctx_new" 310 | (:pointer "Pointer to a context") 311 | nil zmq 312 | "create new ØMQ context. 313 | http://api.zeromq.org/4-2:zmq-ctx-new") 314 | 315 | 316 | (define-ffi-function zmq-ctx-destroy "zmq_ctx_destroy" 317 | (:int "status") 318 | ((:pointer *context)) zmq 319 | "terminate a ØMQ context. 320 | http://api.zeromq.org/4-2:zmq-ctx-destroy") 321 | 322 | 323 | (define-ffi-function zmq-socket "zmq_socket" 324 | (:pointer "Pointer to a socket.") 325 | ((:pointer *context "Created by `zmq-ctx-new '.") (:int type)) zmq 326 | "create ØMQ socket. 327 | http://api.zeromq.org/4-2:zmq-socket") 328 | 329 | 330 | (define-ffi-function zmq-close "zmq_close" 331 | (:int "Status") 332 | ((:pointer *socket "Socket pointer created by `zmq-socket'")) zmq 333 | "close ØMQ socket. 334 | http://api.zeromq.org/4-2:zmq-close") 335 | 336 | 337 | (define-ffi-function zmq-connect "zmq_connect" 338 | (:int "Status") 339 | ((:pointer *socket "Socket pointer created by `zmq-socket'") 340 | (:pointer *endpoint "Char pointer, e.g. (ffi-make-c-string \"tcp://localhost:5555\")")) 341 | zmq 342 | "create outgoing connection from socket. 343 | http://api.zeromq.org/4-2:zmq-connect") 344 | 345 | 346 | (define-ffi-function zmq-send "zmq_send" 347 | (:int "Number of bytes sent or -1 on failure.") 348 | ((:pointer *socket "Pointer to a socket.") 349 | (:pointer *msg "Pointer to a C-string to send") 350 | (:size_t len "Number of bytes to send") 351 | (:int flags)) 352 | zmq 353 | "send a message part on a socket. 354 | http://api.zeromq.org/4-2:zmq-send") 355 | 356 | 357 | (define-ffi-function zmq-recv "zmq_recv" 358 | (:int "Number of bytes received or -1 on failure.") 359 | ((:pointer *socket) 360 | (:pointer *buf "Pointer to c-string to put result in.") 361 | (:size_t len "Length to truncate message at.") 362 | (:int flags)) 363 | zmq 364 | "receive a message part from a socket. 365 | http://api.zeromq.org/4-2:zmq-recv") 366 | 367 | 368 | ;; We cannot get these through a ffi because the are #define'd for the CPP and 369 | ;; invisible in the library. They only exist in the zmq.h file. 370 | (defconst ZMQ-REQ 3 371 | "A socket of type ZMQ_REQ is used by a client to send requests 372 | to and receive replies from a service. This socket type allows 373 | only an alternating sequence of zmq_send(request) and 374 | subsequent zmq_recv(reply) calls. Each request sent is 375 | round-robined among all services, and each reply received is 376 | matched with the last issued request.") 377 | #+END_SRC 378 | 379 | #+RESULTS: 380 | 381 | 382 | 383 | * libzmq symbols 384 | 385 | #+BEGIN_SRC sh :results output 386 | nm /usr/local/lib/libzmq.dylib | grep _zmq | wc -l 387 | #+END_SRC 388 | 389 | #+RESULTS: 390 | : 61 391 | 392 | #+BEGIN_SRC sh 393 | nm /usr/local/lib/libzmq.dylib | grep _zmq 394 | #+END_SRC 395 | 396 | #+RESULTS: 397 | | 43980 | T | _zmq_atomic_counter_dec | 398 | | 00000000000439a0 | T | _zmq_atomic_counter_destroy | 399 | | 43971 | T | _zmq_atomic_counter_inc | 400 | | 43953 | T | _zmq_atomic_counter_new | 401 | | 43969 | T | _zmq_atomic_counter_set | 402 | | 43998 | T | _zmq_atomic_counter_value | 403 | | 0000000000041dc0 | T | _zmq_bind | 404 | | 0000000000041bf4 | T | _zmq_close | 405 | | 0000000000041e02 | T | _zmq_connect | 406 | | 0000000000041bad | T | _zmq_ctx_destroy | 407 | | 0000000000041b25 | T | _zmq_ctx_get | 408 | | 00000000000419bb | T | _zmq_ctx_new | 409 | | 0000000000041ace | T | _zmq_ctx_set | 410 | | 0000000000041a8f | T | _zmq_ctx_shutdown | 411 | | 0000000000041a41 | T | _zmq_ctx_term | 412 | | 43872 | T | _zmq_curve_keypair | 413 | | 00000000000438e7 | T | _zmq_curve_public | 414 | | 000000000004354d | T | _zmq_device | 415 | | 0000000000041e86 | T | _zmq_disconnect | 416 | | 00000000000419ae | T | _zmq_errno | 417 | | 0000000000041c8b | T | _zmq_getsockopt | 418 | | 43564 | T | _zmq_has | 419 | | 0000000000041b67 | T | _zmq_init | 420 | | 00000000000420d1 | T | _zmq_msg_close | 421 | | 42944 | T | _zmq_msg_copy | 422 | | 00000000000420c7 | T | _zmq_msg_data | 423 | | 000000000004295e | T | _zmq_msg_get | 424 | | 00000000000429e3 | T | _zmq_msg_gets | 425 | | 42638 | T | _zmq_msg_init | 426 | | 42206 | T | _zmq_msg_init_data | 427 | | 00000000000420bd | T | _zmq_msg_init_size | 428 | | 000000000004294e | T | _zmq_msg_more | 429 | | 000000000004293a | T | _zmq_msg_move | 430 | | 00000000000423db | T | _zmq_msg_recv | 431 | | 0000000000041edb | T | _zmq_msg_send | 432 | | 0000000000042a74 | T | _zmq_msg_set | 433 | | 42930 | T | _zmq_msg_size | 434 | | 0000000000042ab2 | T | _zmq_poll | 435 | | 43501 | T | _zmq_proxy | 436 | | 43528 | T | _zmq_proxy_steerable | 437 | | 42432 | T | _zmq_recv | 438 | | 000000000004267c | T | _zmq_recviov | 439 | | 00000000000423c8 | T | _zmq_recvmsg | 440 | | 0000000000041f4e | T | _zmq_send | 441 | | 00000000000420db | T | _zmq_send_const | 442 | | 42210 | T | _zmq_sendiov | 443 | | 0000000000041ec8 | T | _zmq_sendmsg | 444 | | 0000000000041c31 | T | _zmq_setsockopt | 445 | | 00000000000435a2 | T | _zmq_sleep | 446 | | 0000000000041bb7 | T | _zmq_socket | 447 | | 0000000000041ce5 | T | _zmq_socket_monitor | 448 | | 00000000000435ac | T | _zmq_stopwatch_start | 449 | | 000000000004360f | T | _zmq_stopwatch_stop | 450 | | 00000000000419a4 | T | _zmq_strerror | 451 | | 0000000000041ba3 | T | _zmq_term | 452 | | 000000000004367c | T | _zmq_threadclose | 453 | | 43634 | T | _zmq_threadstart | 454 | | 0000000000041e44 | T | _zmq_unbind | 455 | | 000000000004198f | T | _zmq_version | 456 | | 43780 | T | _zmq_z85_decode | 457 | | 00000000000436a4 | T | _zmq_z85_encode | 458 | 459 | #+BEGIN_SRC emacs-lisp 460 | (defmacro define (name value &optional docstring) 461 | "Define a constant with NAME (a symbol), VALUE, and optional docstring. 462 | The NAME will be upcased and _ replaced with -. 463 | This exists so you can copy a line from zmq.h to create the constant, e.g. 464 | (define ZMQ_IO_THREADS_DFLT 1) creates the constant ZMQ-IO-THREADS-DFLT with a value of 1. 465 | " 466 | `(defconst ,(intern (replace-regexp-in-string "_" "-" (upcase (symbol-name name)))) 467 | ,(if (symbolp value) 468 | (intern (replace-regexp-in-string "_" "-" (upcase (symbol-name value)))) 469 | value) 470 | ,docstring)) 471 | 472 | 473 | ;; These come from /usr/local/include/zmq.h 474 | 475 | ;; Context options 476 | (define ZMQ_IO_THREADS 1) 477 | (define ZMQ_MAX_SOCKETS 2) 478 | (define ZMQ_SOCKET_LIMIT 3) 479 | (define ZMQ_THREAD_PRIORITY 3) 480 | (define ZMQ_THREAD_SCHED_POLICY 4) 481 | (define ZMQ_MAX_MSGSZ 5) 482 | 483 | ;; /* Default for new contexts */ 484 | (define ZMQ_IO_THREADS_DFLT 1) 485 | (define ZMQ_MAX_SOCKETS_DFLT 1023) 486 | (define ZMQ_THREAD_PRIORITY_DFLT -1) 487 | (define ZMQ_THREAD_SCHED_POLICY_DFLT -1) 488 | 489 | ;; /* Socket types. */ 490 | (define ZMQ_PAIR 0) 491 | (define ZMQ_PUB 1) 492 | (define ZMQ_SUB 2) 493 | (define ZMQ_REQ 3) 494 | (define ZMQ_REP 4) 495 | (define ZMQ_DEALER 5) 496 | (define ZMQ_ROUTER 6) 497 | (define ZMQ_PULL 7) 498 | (define ZMQ_PUSH 8) 499 | (define ZMQ_XPUB 9) 500 | (define ZMQ_XSUB 10) 501 | (define ZMQ_STREAM 11) 502 | 503 | ;; /* Deprecated aliases */ 504 | (define ZMQ_XREQ ZMQ_DEALER) 505 | (define ZMQ_XREP ZMQ_ROUTER) 506 | 507 | ;; /* Socket options. */ 508 | (define ZMQ_AFFINITY 4) 509 | (define ZMQ_IDENTITY 5) 510 | (define ZMQ_SUBSCRIBE 6) 511 | (define ZMQ_UNSUBSCRIBE 7) 512 | (define ZMQ_RATE 8) 513 | (define ZMQ_RECOVERY_IVL 9) 514 | (define ZMQ_SNDBUF 11) 515 | (define ZMQ_RCVBUF 12) 516 | (define ZMQ_RCVMORE 13) 517 | (define ZMQ_FD 14) 518 | (define ZMQ_EVENTS 15) 519 | (define ZMQ_TYPE 16) 520 | (define ZMQ_LINGER 17) 521 | (define ZMQ_RECONNECT_IVL 18) 522 | (define ZMQ_BACKLOG 19) 523 | (define ZMQ_RECONNECT_IVL_MAX 21) 524 | (define ZMQ_MAXMSGSIZE 22) 525 | (define ZMQ_SNDHWM 23) 526 | (define ZMQ_RCVHWM 24) 527 | (define ZMQ_MULTICAST_HOPS 25) 528 | (define ZMQ_RCVTIMEO 27) 529 | (define ZMQ_SNDTIMEO 28) 530 | (define ZMQ_LAST_ENDPOINT 32) 531 | (define ZMQ_ROUTER_MANDATORY 33) 532 | (define ZMQ_TCP_KEEPALIVE 34) 533 | (define ZMQ_TCP_KEEPALIVE_CNT 35) 534 | (define ZMQ_TCP_KEEPALIVE_IDLE 36) 535 | (define ZMQ_TCP_KEEPALIVE_INTVL 37) 536 | (define ZMQ_IMMEDIATE 39) 537 | (define ZMQ_XPUB_VERBOSE 40) 538 | (define ZMQ_ROUTER_RAW 41) 539 | (define ZMQ_IPV6 42) 540 | (define ZMQ_MECHANISM 43) 541 | (define ZMQ_PLAIN_SERVER 44) 542 | (define ZMQ_PLAIN_USERNAME 45) 543 | (define ZMQ_PLAIN_PASSWORD 46) 544 | (define ZMQ_CURVE_SERVER 47) 545 | (define ZMQ_CURVE_PUBLICKEY 48) 546 | (define ZMQ_CURVE_SECRETKEY 49) 547 | (define ZMQ_CURVE_SERVERKEY 50) 548 | (define ZMQ_PROBE_ROUTER 51) 549 | (define ZMQ_REQ_CORRELATE 52) 550 | (define ZMQ_REQ_RELAXED 53) 551 | (define ZMQ_CONFLATE 54) 552 | (define ZMQ_ZAP_DOMAIN 55) 553 | (define ZMQ_ROUTER_HANDOVER 56) 554 | (define ZMQ_TOS 57) 555 | (define ZMQ_CONNECT_RID 61) 556 | (define ZMQ_GSSAPI_SERVER 62) 557 | (define ZMQ_GSSAPI_PRINCIPAL 63) 558 | (define ZMQ_GSSAPI_SERVICE_PRINCIPAL 64) 559 | (define ZMQ_GSSAPI_PLAINTEXT 65) 560 | (define ZMQ_HANDSHAKE_IVL 66) 561 | (define ZMQ_SOCKS_PROXY 68) 562 | (define ZMQ_XPUB_NODROP 69) 563 | (define ZMQ_BLOCKY 70) 564 | (define ZMQ_XPUB_MANUAL 71) 565 | (define ZMQ_XPUB_WELCOME_MSG 72) 566 | (define ZMQ_STREAM_NOTIFY 73) 567 | (define ZMQ_INVERT_MATCHING 74) 568 | (define ZMQ_HEARTBEAT_IVL 75) 569 | (define ZMQ_HEARTBEAT_TTL 76) 570 | (define ZMQ_HEARTBEAT_TIMEOUT 77) 571 | (define ZMQ_XPUB_VERBOSER 78) 572 | (define ZMQ_CONNECT_TIMEOUT 79) 573 | (define ZMQ_TCP_MAXRT 80) 574 | (define ZMQ_THREAD_SAFE 81) 575 | (define MQ_MULTICAST_MAXTPDU 84) 576 | (define ZMQ_VMCI_BUFFER_SIZE 85) 577 | (define ZMQ_VMCI_BUFFER_MIN_SIZE 86) 578 | (define ZMQ_VMCI_BUFFER_MAX_SIZE 87) 579 | (define ZMQ_VMCI_CONNECT_TIMEOUT 88) 580 | (define ZMQ_USE_FD 89) 581 | 582 | ;; /* Message options */ 583 | (define ZMQ_MORE 1) 584 | (define ZMQ_SHARED 3) 585 | 586 | ;; /* Send/recv options. */ 587 | (define ZMQ_DONTWAIT 1) 588 | (define ZMQ_SNDMORE 2) 589 | 590 | ;; /* Security mechanisms */ 591 | (define ZMQ_NULL 0) 592 | (define ZMQ_PLAIN 1) 593 | (define ZMQ_CURVE 2) 594 | (define ZMQ_GSSAPI 3) 595 | 596 | ;; /* RADIO-DISH protocol */ 597 | (define ZMQ_GROUP_MAX_LENGTH 15) 598 | 599 | ;; /* Deprecated options and aliases */ 600 | (define ZMQ_TCP_ACCEPT_FILTER 38) 601 | (define ZMQ_IPC_FILTER_PID 58) 602 | (define ZMQ_IPC_FILTER_UID 59) 603 | (define ZMQ_IPC_FILTER_GID 60) 604 | (define ZMQ_IPV4ONLY 31) 605 | (define ZMQ_DELAY_ATTACH_ON_CONNECT ZMQ_IMMEDIATE) 606 | (define ZMQ_NOBLOCK ZMQ_DONTWAIT) 607 | (define ZMQ_FAIL_UNROUTABLE ZMQ_ROUTER_MANDATORY) 608 | (define ZMQ_ROUTER_BEHAVIOR ZMQ_ROUTER_MANDATORY) 609 | 610 | ;; /* Deprecated Message options */ 611 | (define ZMQ_SRCFD 2) 612 | 613 | ;; /******************************************************************************/ 614 | ;; /* 0MQ socket events and monitoring */ 615 | ;; /******************************************************************************/ 616 | 617 | ;; /* Socket transport events (TCP, IPC and TIPC only) */ 618 | 619 | (define ZMQ_EVENT_CONNECTED #x0001) 620 | (define ZMQ_EVENT_CONNECT_DELAYED #x0002) 621 | (define ZMQ_EVENT_CONNECT_RETRIED #x0004) 622 | (define ZMQ_EVENT_LISTENING #x0008) 623 | (define ZMQ_EVENT_BIND_FAILED #x0010) 624 | (define ZMQ_EVENT_ACCEPTED #x0020) 625 | (define ZMQ_EVENT_ACCEPT_FAILED #x0040) 626 | (define ZMQ_EVENT_CLOSED #x0080) 627 | (define ZMQ_EVENT_CLOSE_FAILED #x0100) 628 | (define ZMQ_EVENT_DISCONNECTED #x0200) 629 | (define ZMQ_EVENT_MONITOR_STOPPED #x0400) 630 | (define ZMQ_EVENT_ALL #xFFFF) 631 | 632 | ;; /******************************************************************************/ 633 | ;; /* I/O multiplexing. */ 634 | ;; /******************************************************************************/ 635 | 636 | (define ZMQ_POLLIN 1) 637 | (define ZMQ_POLLOUT 2) 638 | (define ZMQ_POLLERR 4) 639 | (define ZMQ_POLLPRI 8) 640 | 641 | (define ZMQ_POLLITEMS_DFLT 16) 642 | 643 | ;; /******************************************************************************/ 644 | ;; /* Probe library capabilities */ 645 | ;; /******************************************************************************/ 646 | 647 | (define ZMQ_HAS_CAPABILITIES 1) 648 | 649 | ;; /* Deprecated aliases */ 650 | (define ZMQ_STREAMER 1) 651 | (define ZMQ_FORWARDER 2) 652 | (define ZMQ_QUEUE 3) 653 | #+END_SRC 654 | 655 | #+RESULTS: 656 | : ZMQ-IO-THREADS-DFLT 657 | --------------------------------------------------------------------------------