Skip to content
This repository
Browse code

First public source opening -> GitHub;

  • Loading branch information...
commit 6ffe62bfd19dfa1a143d4942f3721f636eef1a6a 1 parent 4c22cf1
Tomas Morstein authored

Showing 42 changed files with 3,062 additions and 0 deletions. Show diff stats Hide diff stats

  1. +4 0 .gitignore
  2. +180 0 README.md
  3. +1 0  c_src/.gitignore
  4. +585 0 c_src/egtm_worker.c
  5. +66 0 c_src/gtmxc_types.h
  6. +4 0 doc/.gitignore
  7. BIN  doc/ERL_logo.jpg
  8. BIN  doc/GTM_logo.jpg
  9. BIN  doc/IDEA_logo.jpg
  10. +50 0 doc/overview.edoc
  11. +1 0  ebin/.gitignore
  12. +81 0 include/egtm.hrl
  13. +1 0  priv/.gitignore
  14. +22 0 priv/calltab.ci
  15. +6 0 priv/dm
  16. +6 0 priv/dse
  17. +44 0 priv/egtm.conf
  18. +4 0 priv/egtm_console
  19. +4 0 priv/egtm_console_gdb
  20. +2 0  priv/gbls/.gitignore
  21. +6 0 priv/gde
  22. +12 0 priv/gtmenv
  23. +41 0 priv/initdb
  24. +6 0 priv/lke
  25. +6 0 priv/mupip
  26. +1 0  priv/rtns/.gitignore
  27. +91 0 priv/rtns/_egtmapi.m
  28. +6 0 priv/run
  29. BIN  rebar
  30. +29 0 rebar.config
  31. +28 0 src/egtm.app.src
  32. +574 0 src/egtm.erl
  33. +67 0 src/egtm_admin.erl
  34. +125 0 src/egtm_config.erl
  35. +84 0 src/egtm_metrics.erl
  36. +173 0 src/egtm_pool.erl
  37. +44 0 src/egtm_pool_sup.erl
  38. +69 0 src/egtm_string.erl
  39. +315 0 src/egtm_util.erl
  40. +131 0 src/egtm_util_eunit.erl
  41. +149 0 src/egtm_worker.erl
  42. +44 0 src/egtm_worker_sup.erl
4 .gitignore
... ... @@ -0,0 +1,4 @@
  1 +log
  2 +ebin
  3 +deps
  4 +.eunit
180 README.md
Source Rendered
... ... @@ -0,0 +1,180 @@
  1 +IDEA EGTM: Erlang binding for GT.M database engine
  2 +==================================================
  3 +
  4 +Software product description and documentation for application
  5 +developers is to be found on [http://labs.idea.cz/egtm](
  6 +http://labs.idea.cz/egtm "IDEA EGTM Technology").
  7 +
  8 +Installation
  9 +------------
  10 +* `git clone http://github.com/ztmr/egtm`
  11 +* ensure the latest Erlang/OTP is installed
  12 +* ensure GT.M is installed
  13 +* change GT.M `gtm_dist` path in `priv/gtmenv` and `rebar.config`
  14 +* `./rebar get-deps && ./rebar compile`
  15 +* initialize database with `./priv/initdb`
  16 +* run the console `./priv/egtm_console`
  17 +* enjoy!
  18 +
  19 +Notes
  20 +-----
  21 +* **GT.M compatibility**
  22 + - EGTM is known to not work with GT.M V5.5-000 Linux x86\_64
  23 + because of [call-in bug](https://groups.google.com/d/topic/comp.lang.mumps/R_GvkUUZaq0/discussion "Call-in bug").
  24 +* **performance:**
  25 + - per-operation lager debug logging (disabled by default)
  26 + means around ~2000 microseconds overhead,
  27 + - metrics (disabled by default) costs around
  28 + ~30 additional microseconds,
  29 + - both can be enabled using `EGTM_METRICS` and
  30 + `EGTM_TRACE` compile-time macros,
  31 + - unless `EGTM_METRICS` is defined, the `egtm_metrics`
  32 + configuration (in `priv/egtm.conf`) is ignored.
  33 +* **transaction processing:**
  34 + - since *GT.M call-in interface does not allow us to call
  35 + standalone `TS`/`TC`/`TRO` commands*, we had to implement
  36 + TP emulation. This is done by storing all write/lock operations
  37 + within a virtual transaction buffer that is evaluated
  38 + at the time of commit.
  39 + - this has *some limitations*, for example:
  40 + <pre>
  41 + %% Expect the ^ZTMR to hold value of 0.
  42 + DataProcessing = fun () ->
  43 + &nbsp;&nbsp;io:put\_chars (egtm:get ("^ZTMR")),
  44 + &nbsp;&nbsp;egtm:set ("^ZTMR", 1), %% when in transaction, this is not done immediatelly but at the commit-time!!!
  45 + &nbsp;&nbsp;io:put\_chars (egtm:get ("^ZTMR")),
  46 + &nbsp;&nbsp;false %% Rollback!
  47 + end,
  48 + egtm\_util:transaction (DataProcessing), %% outputs 00{ok,rollback,unknown}
  49 + egtm\_util:transaction (DataProcessing), %% outputs 00{ok,rollback,unknown}
  50 + DataProcessing (), %% outputs 01false
  51 + DataProcessing (). %% outputs 11false
  52 + </pre>
  53 + - *operations supported by TP*:
  54 + `set`, `setp`, `kill`, `zkill`, `lock`, `unlock`.
  55 + - To get *full-featured GT.M TP*, feel free to *write your own*
  56 + `priv/rtns/MyRoutine.m` with any TP processing code and
  57 + call it using `egtm:do/2` or `egtm:call/2`.
  58 +* **clustering and multi-site configurations:** EGTM HAC
  59 + is a separate and paid add-on product.
  60 +* **consulting and support services, non-public/non-free add-ons**:
  61 + Support and consulting services and non-public add-ons may
  62 + be delivered individually under conditions specified in
  63 + a valid support/license contract in context of one or more
  64 + of these products:
  65 + - FIS GT.M and FIS PIP/DATA-QWIK framework,
  66 + - Erlang and ChicagoBoss framework,
  67 + - IDEA EGTM,
  68 + - IDEA Object Database (IODB),
  69 + - IDEA High-Available Cluster (EGTM HAC),
  70 + - IDEA CloudOS (ICOS).
  71 + Feel free to contact IDEA Systems via e-mail or
  72 + [www.idea.cz](http://www.idea.cz "IDEA Systems")
  73 + in any case of interest!
  74 +
  75 +TODO
  76 +----
  77 +* NIF upgrade/reload functinality -- GT.M call-ins
  78 + are limited to a single `gtm_init`/`gtm_exit` call
  79 + per each process, so we simply cannot unload GT.M
  80 + shared library and load its new version gracefully :-(
  81 +* documentation: some `egtm` functions exists in more
  82 + overloaded variants resolved by guards and well
  83 + documented in source code itself.
  84 + The standard edoc generator works only with the first
  85 + match of all these variants, so the resulting HTML
  86 + documentation may not be complete! :-(
  87 +* `init^%egtmapi` and error trapping
  88 +* `egtm:lock` timeout support
  89 +* EGTM NIF stores strings in static char array limited
  90 + by `EGTM$BUFLEN` constant although each string has
  91 + different lenght requirements on different places.
  92 + This should be changed in future releases!
  93 + Use the following:
  94 + - `MAXCODE = 8192`
  95 + (maximum length of a line of code for
  96 + the compiler / variable name)
  97 + - `MAXMSG = 2048`
  98 + (maximum length of a GT.M message)
  99 + - `MAXNAME = 32`
  100 + (one more than the maximum length of a GT.M name)
  101 + - `MAXSTR = 1048576`
  102 + (maximum length of a value that GT.M can return)
  103 +* UTF-8 or Erlang-agnostic Latin-1 support without complicated
  104 + encoding/decoding!!
  105 + This is partially supported by `egtm_string` `encode`/`decode`,
  106 + but currenly only for VALUES in `set`/`setp` and `get`/`getp`,
  107 + thus NOT for: global names, subscripts, `do`/`call` arguments.
  108 +* Counters for intercluster load distribution purposes
  109 + as well as for a common SNMP monitoring purposes.
  110 + SNMP data may be based on Folsom metrics.
  111 +* WebAdmin (at least global browser) -- as ICOS Application?
  112 +
  113 +
  114 +Architecture Schema Design
  115 +--------------------------
  116 +<pre>
  117 +......................................
  118 +: Erlang/OTP Application Server #1 :
  119 +: :..
  120 +: +----------------------------+ :
  121 +: | Application that uses EGTM | :
  122 +: +--------------+-------------+ :
  123 +: | :
  124 +: +------------+-----------------+ :
  125 +: | EGTM Master Broker Server | :
  126 +: |..............................| :
  127 +: | does request routing logic | :
  128 +: | based on deployment setup | (A) single standalone worker
  129 +: | (standalone, pool, cluster) | (B) pool of local workers
  130 +: |..............................| (C) cluster of A/B-mode servers
  131 +: | (A)(B)(C) | :
  132 +: +-------+--+--+----------------+ :
  133 +: / | \ :.......
  134 +: / | \ :
  135 +: / / +--+--------------------+ :
  136 +: / / | EGTM Cluster Manager | :
  137 +: / / | with IntelliRoute | :
  138 +: / / +----------+------------+ :
  139 +: / / | ..............:
  140 +: / | +---------+------------+
  141 +: / | | .: |
  142 +: | +--+--------+-------+ : +-------+---------------------+
  143 +: | | EGTM Worker Pool | : | EGTM Cluster Neighbour Pool |
  144 +: | | egtm1, egtm2, ... | : +---------+-------------------+
  145 +: | +-----------+-------+ : |
  146 +: | | ........: |
  147 +: | | : |
  148 +: | | : +---------------+-------------+
  149 +: +--+----------+ | : | EGTM Slave Broker Server |
  150 +: | Standalone | | : | another worker/pool/cluster |
  151 +: | EGTM Worker | | : | SCHEMA RECURSION GOES HERE |
  152 +: +------+------+ | : +---------------+-------------+
  153 +: | | : |
  154 +: +-----+--------+-+ : +--+------------+
  155 +: | GT.M master DB |===(replication)===| GT.M slave DB |
  156 +: +----------------+ : +---------------+
  157 +:......................:
  158 +</pre>
  159 +
  160 +
  161 +Licensing
  162 +=========
  163 +Copyright (C) 2012 Tomas Morstein, IDEA Systems
  164 +
  165 +This program is free software: you can redistribute
  166 +it and/or modify it under the terms of the GNU Affero
  167 +General Public License as published by the Free Software
  168 +Foundation, either version 3 of the License,
  169 +or (at your option) any later version.
  170 +
  171 +This program is distributed in the hope that it will
  172 +be useful, but WITHOUT ANY WARRANTY; without even
  173 +the implied warranty of MERCHANTABILITY or FITNESS
  174 +FOR A PARTICULAR PURPOSE. See the GNU Affero General
  175 +Public License for more details.
  176 +
  177 +You should have received a copy of the GNU Affero
  178 +General Public License along with this program.
  179 +If not, see [http://www.gnu.org/licenses/](
  180 +http://www.gnu.org/licenses/ "GNU Licensing Overview").
1  c_src/.gitignore
... ... @@ -0,0 +1 @@
  1 +*.o
585 c_src/egtm_worker.c
... ... @@ -0,0 +1,585 @@
  1 +/*
  2 + * Module: egtm_worker -- EGTM NIF library
  3 + * Created: 05-APR-2012 20:11
  4 + * Author: tmr
  5 + *
  6 + * Copyright 2012 Tomas Morstein, IDEA Systems.
  7 + *
  8 + * This program is free software: you can redistribute
  9 + * it and/or modify it under the terms of the GNU Affero
  10 + * General Public License as published by the Free Software
  11 + * Foundation, either version 3 of the License,
  12 + * or (at your option) any later version.
  13 + *
  14 + * This program is distributed in the hope that it will
  15 + * be useful, but WITHOUT ANY WARRANTY; without even
  16 + * the implied warranty of MERCHANTABILITY or FITNESS
  17 + * FOR A PARTICULAR PURPOSE. See the GNU Affero General
  18 + * Public License for more details.
  19 + *
  20 + * You should have received a copy of the GNU Affero
  21 + * General Public License along with this program.
  22 + * If not, see <http://www.gnu.org/licenses/>.
  23 + */
  24 +
  25 +#include <termios.h>
  26 +#include <stdbool.h>
  27 +//#include <stdio.h>
  28 +
  29 +#include "erl_nif.h"
  30 +#include "gtmxc_types.h"
  31 +
  32 +#define EGTM$BUFLEN 512
  33 +#define EGTM$BUFLENBIG 65536
  34 +#define EGTM$LOCKNAM "EGTM$MUTEX"
  35 +
  36 +#define LOCK(critical_section) { \
  37 + enif_mutex_lock (m_Lock); \
  38 + { critical_section } \
  39 + enif_mutex_unlock (m_Lock); \
  40 + }
  41 +
  42 +#define NIFARGS \
  43 + ErlNifEnv * env, int argc, const ERL_NIF_TERM argv []
  44 +#define NIF(name) \
  45 + ERL_NIF_TERM (name) (NIFARGS)
  46 +
  47 +ERL_NIF_TERM c_AtomOK;
  48 +ERL_NIF_TERM c_AtomError;
  49 +
  50 +ErlNifMutex * m_Lock;
  51 +
  52 +struct termios m_StderrOrig, m_StdinOrig, m_StdoutOrig;
  53 +
  54 +int check_status (gtm_status_t status, char msg []) {
  55 +
  56 + if (status != 0) {
  57 + gtm_zstatus (msg, EGTM$BUFLEN);
  58 +
  59 + return -10;
  60 + }
  61 +
  62 + return 0;
  63 +}
  64 +
  65 +static int load_internal (ErlNifEnv * env, void ** priv, void ** old_priv, ERL_NIF_TERM load_info, bool upgrade) {
  66 +
  67 + c_AtomOK = enif_make_atom (env, "ok");
  68 + c_AtomError = enif_make_atom (env, "error");
  69 + m_Lock = enif_mutex_create (EGTM$LOCKNAM);
  70 +
  71 + // XXX: not so correct in the case of upgrade!!
  72 + tcgetattr (0, &m_StdinOrig);
  73 + tcgetattr (1, &m_StdoutOrig);
  74 + tcgetattr (2, &m_StderrOrig);
  75 +
  76 + /*
  77 + * priv = malloc (sizeof (int));
  78 + if (old_priv == NULL)
  79 + ** (int **) priv = 0;
  80 + else
  81 + ** (int **) priv = (** (int **) old_priv) +1;
  82 + fprintf (stderr, "PRIV=%d\n", (int) ** (int **) priv);
  83 + */
  84 +
  85 + if (!upgrade) {
  86 + char emsg [EGTM$BUFLEN];
  87 + gtm_status_t status;
  88 +
  89 + status = gtm_init ();
  90 + check_status (status, emsg); // XXX: check status
  91 +
  92 + // XXX: do we want it to call only on init or also on upgrade?
  93 + status = gtm_ci ("m_init");
  94 + check_status (status, emsg); // XXX: check status
  95 + }
  96 +
  97 + return 0;
  98 +}
  99 +
  100 +static int load (ErlNifEnv * env, void ** priv, ERL_NIF_TERM load_info) {
  101 +
  102 + //fprintf (stderr, "LOAD\n");
  103 + return load_internal (env, priv, NULL, load_info, false);
  104 +}
  105 +
  106 +/*
  107 +static int upgrade (ErlNifEnv * env, void ** priv, void ** old_priv, ERL_NIF_TERM load_info) {
  108 +
  109 + //fprintf (stderr, "UPGRADE\n");
  110 + return load_internal (env, priv, old_priv, load_info, true);
  111 +}
  112 +
  113 +static int reload (ErlNifEnv * env, void ** priv, ERL_NIF_TERM load_info) {
  114 +
  115 + //fprintf (stderr, "RELOAD\n");
  116 + return 0;
  117 +}
  118 +*/
  119 +
  120 +static void unload (ErlNifEnv * env, void * priv) {
  121 +
  122 + //fprintf (stderr, "UNLOAD=%d\n", * (int *) priv);
  123 +
  124 + enif_mutex_destroy (m_Lock);
  125 + gtm_status_t status = gtm_exit ();
  126 +
  127 + // XXX: check status
  128 + char emsg [EGTM$BUFLEN];
  129 + check_status (status, emsg);
  130 +
  131 + tcsetattr (0, 0, &m_StdinOrig);
  132 + tcsetattr (1, 0, &m_StdoutOrig);
  133 + tcsetattr (2, 0, &m_StderrOrig);
  134 +}
  135 +
  136 +NIF (m_horo) {
  137 +
  138 + char val [64]; gtm_status_t status;
  139 + LOCK(status = gtm_ci ("m_horo", val);)
  140 +
  141 + char emsg [EGTM$BUFLEN];
  142 + if (check_status (status, emsg) == 0)
  143 + return enif_make_tuple2 (env, c_AtomOK,
  144 + enif_make_string (env, val, ERL_NIF_LATIN1));
  145 + else
  146 + return enif_make_tuple2 (env, c_AtomError,
  147 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  148 +}
  149 +
  150 +NIF (m_job) {
  151 +
  152 + char val [64]; gtm_status_t status;
  153 + LOCK(status = gtm_ci ("m_job", val);)
  154 +
  155 + char emsg [EGTM$BUFLEN];
  156 + if (check_status (status, emsg) == 0)
  157 + return enif_make_tuple2 (env, c_AtomOK,
  158 + enif_make_string (env, val, ERL_NIF_LATIN1));
  159 + else
  160 + return enif_make_tuple2 (env, c_AtomError,
  161 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  162 +}
  163 +
  164 +NIF (m_zver) {
  165 +
  166 + char val [128];
  167 + gtm_status_t status;
  168 + LOCK(status = gtm_ci ("m_zver", val);)
  169 +
  170 + char emsg [EGTM$BUFLEN];
  171 + if (check_status (status, emsg) == 0)
  172 + return enif_make_tuple2 (env, c_AtomOK,
  173 + enif_make_string (env, val, ERL_NIF_LATIN1));
  174 + else
  175 + return enif_make_tuple2 (env, c_AtomError,
  176 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  177 +}
  178 +
  179 +NIF (m_get) {
  180 +
  181 + if (argc != 1) return enif_make_badarg (env);
  182 +
  183 + char key [EGTM$BUFLEN];
  184 + if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  185 + return enif_make_badarg (env);
  186 +
  187 + char val [EGTM$BUFLENBIG];
  188 + gtm_status_t status;
  189 + LOCK(status = gtm_ci ("m_get", val, key);)
  190 +
  191 + char emsg [EGTM$BUFLENBIG];
  192 + if (check_status (status, emsg) == 0)
  193 + return enif_make_tuple2 (env, c_AtomOK,
  194 + enif_make_string (env, val, ERL_NIF_LATIN1));
  195 + else
  196 + return enif_make_tuple2 (env, c_AtomError,
  197 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  198 +}
  199 +
  200 +NIF (m_getp) {
  201 +
  202 + if (argc != 3) return enif_make_badarg (env);
  203 +
  204 + char key [EGTM$BUFLEN];
  205 + if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  206 + return enif_make_badarg (env);
  207 +
  208 + int piece;
  209 + if (enif_get_int (env, argv [1], &piece) < 0)
  210 + return enif_make_badarg (env);
  211 +
  212 + char delim [EGTM$BUFLEN];
  213 + if (enif_get_string (env, argv [2], delim, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  214 + return enif_make_badarg (env);
  215 +
  216 + char val [EGTM$BUFLENBIG];
  217 + gtm_status_t status;
  218 + LOCK(status = gtm_ci ("m_getp", val, key, piece, delim);)
  219 +
  220 + char emsg [EGTM$BUFLEN];
  221 + if (check_status (status, emsg) == 0)
  222 + return enif_make_tuple2 (env, c_AtomOK,
  223 + enif_make_string (env, val, ERL_NIF_LATIN1));
  224 + else
  225 + return enif_make_tuple2 (env, c_AtomError,
  226 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  227 +}
  228 +
  229 +NIF (m_set) {
  230 +
  231 + if (argc != 2) return enif_make_badarg (env);
  232 +
  233 + char key [EGTM$BUFLEN];
  234 + if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  235 + return enif_make_badarg (env);
  236 +
  237 + char val [EGTM$BUFLENBIG];
  238 + if (enif_get_string (env, argv [1], val, EGTM$BUFLENBIG, ERL_NIF_LATIN1) < 0)
  239 + return enif_make_badarg (env);
  240 +
  241 + gtm_status_t status;
  242 + LOCK(status = gtm_ci ("m_set", key, val);)
  243 +
  244 + char emsg [EGTM$BUFLEN];
  245 + if (check_status (status, emsg) == 0)
  246 + return c_AtomOK;
  247 + else
  248 + return enif_make_tuple2 (env, c_AtomError,
  249 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  250 +}
  251 +
  252 +NIF (m_setp) {
  253 +
  254 + if (argc != 4) return enif_make_badarg (env);
  255 +
  256 + char key [EGTM$BUFLEN];
  257 + if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  258 + return enif_make_badarg (env);
  259 +
  260 + int piece;
  261 + if (enif_get_int (env, argv [1], &piece) < 0)
  262 + return enif_make_badarg (env);
  263 +
  264 + char delim [EGTM$BUFLEN];
  265 + if (enif_get_string (env, argv [2], delim, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  266 + return enif_make_badarg (env);
  267 +
  268 + char val [EGTM$BUFLENBIG];
  269 + if (enif_get_string (env, argv [3], val, EGTM$BUFLENBIG, ERL_NIF_LATIN1) < 0)
  270 + return enif_make_badarg (env);
  271 +
  272 + gtm_status_t status;
  273 + LOCK(status = gtm_ci ("m_setp", key, piece, delim, val);)
  274 +
  275 + char emsg [EGTM$BUFLEN];
  276 + if (check_status (status, emsg) == 0)
  277 + return c_AtomOK;
  278 + else
  279 + return enif_make_tuple2 (env, c_AtomError,
  280 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  281 +}
  282 +
  283 +NIF (m_order) {
  284 +
  285 + if (argc != 2) return enif_make_badarg (env);
  286 +
  287 + char gbl [EGTM$BUFLEN];
  288 + if (enif_get_string (env, argv [0], gbl, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  289 + return enif_make_badarg (env);
  290 +
  291 + char key [EGTM$BUFLEN];
  292 + int dir;
  293 + if (enif_get_int (env, argv [1], &dir) < 0)
  294 + return enif_make_badarg (env);
  295 +
  296 + gtm_status_t status;
  297 + LOCK(status = gtm_ci ("m_order", key, gbl, dir);)
  298 +
  299 + char emsg [EGTM$BUFLEN];
  300 + if (check_status (status, emsg) == 0)
  301 + return enif_make_tuple2 (env, c_AtomOK,
  302 + enif_make_string (env, key, ERL_NIF_LATIN1));
  303 + else
  304 + return enif_make_tuple2 (env, c_AtomError,
  305 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  306 +}
  307 +
  308 +NIF (m_fast_order) {
  309 +
  310 + if (argc != 2) return enif_make_badarg (env);
  311 +
  312 + char gbl [EGTM$BUFLEN];
  313 + if (enif_get_string (env, argv [0], gbl, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  314 + return enif_make_badarg (env);
  315 +
  316 + int dir;
  317 + if (enif_get_int (env, argv [1], &dir) < 0)
  318 + return enif_make_badarg (env);
  319 +
  320 + char key [EGTM$BUFLEN];
  321 + gtm_status_t status;
  322 + LOCK(status = gtm_ci ("m_fast_order", key, gbl, dir);)
  323 +
  324 + char emsg [EGTM$BUFLEN];
  325 + if (check_status (status, emsg) == 0)
  326 + return enif_make_tuple2 (env, c_AtomOK,
  327 + enif_make_string (env, key, ERL_NIF_LATIN1));
  328 + else
  329 + return enif_make_tuple2 (env, c_AtomError,
  330 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  331 +}
  332 +
  333 +NIF (m_kill) {
  334 +
  335 + if (argc != 1) return enif_make_badarg (env);
  336 +
  337 + char gvn [EGTM$BUFLEN];
  338 + if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  339 + return enif_make_badarg (env);
  340 +
  341 + gtm_status_t status;
  342 + LOCK(status = gtm_ci ("m_kill", gvn);)
  343 +
  344 + char emsg [EGTM$BUFLEN];
  345 + if (check_status (status, emsg) == 0)
  346 + return c_AtomOK;
  347 + else
  348 + return enif_make_tuple2 (env, c_AtomError,
  349 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  350 +}
  351 +
  352 +NIF (m_zkill) {
  353 +
  354 + if (argc != 1) return enif_make_badarg (env);
  355 +
  356 + char gvn [EGTM$BUFLEN];
  357 + if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  358 + return enif_make_badarg (env);
  359 +
  360 + gtm_status_t status;
  361 + LOCK(status = gtm_ci ("m_zkill", gvn);)
  362 +
  363 + char emsg [EGTM$BUFLEN];
  364 + if (check_status (status, emsg) == 0)
  365 + return c_AtomOK;
  366 + else
  367 + return enif_make_tuple2 (env, c_AtomError,
  368 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  369 +}
  370 +
  371 +NIF (m_do) {
  372 +
  373 + if (argc != 1) return enif_make_badarg (env);
  374 +
  375 + char cmd [EGTM$BUFLEN];
  376 + if (enif_get_string (env, argv [0], cmd, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  377 + return enif_make_badarg (env);
  378 +
  379 + gtm_status_t status;
  380 + LOCK(status = gtm_ci ("m_do", cmd);)
  381 +
  382 + char emsg [EGTM$BUFLEN];
  383 + if (check_status (status, emsg) == 0)
  384 + return c_AtomOK;
  385 + else
  386 + return enif_make_tuple2 (env, c_AtomError,
  387 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  388 +}
  389 +
  390 +NIF (m_call) {
  391 +
  392 + if (argc != 1) return enif_make_badarg (env);
  393 +
  394 + char cmd [EGTM$BUFLEN];
  395 + if (enif_get_string (env, argv [0], cmd, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  396 + return enif_make_badarg (env);
  397 +
  398 + char res [EGTM$BUFLENBIG]; res[0]='\0';
  399 + gtm_status_t status;
  400 + LOCK(status = gtm_ci ("m_call", res, cmd);)
  401 +
  402 + char emsg [EGTM$BUFLEN];
  403 + if (check_status (status, emsg) == 0)
  404 + return enif_make_tuple2 (env, c_AtomOK,
  405 + enif_make_string (env, res, ERL_NIF_LATIN1));
  406 + else
  407 + return enif_make_tuple2 (env, c_AtomError,
  408 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  409 +}
  410 +
  411 +NIF (m_merge) {
  412 +
  413 + if (argc != 2) return enif_make_badarg (env);
  414 +
  415 + char gvn1 [EGTM$BUFLEN]; char gvn2 [EGTM$BUFLEN];
  416 + if (enif_get_string (env, argv [0], gvn1, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  417 + return enif_make_badarg (env);
  418 + if (enif_get_string (env, argv [1], gvn2, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  419 + return enif_make_badarg (env);
  420 +
  421 + gtm_status_t status;
  422 + LOCK(status = gtm_ci ("m_merge", gvn1, gvn2);)
  423 +
  424 + char emsg [EGTM$BUFLEN];
  425 + if (check_status (status, emsg) == 0)
  426 + return c_AtomOK;
  427 + else
  428 + return enif_make_tuple2 (env, c_AtomError,
  429 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  430 +}
  431 +
  432 +NIF (m_xecute) {
  433 +
  434 + if (argc != 1) return enif_make_badarg (env);
  435 +
  436 + char cmd [EGTM$BUFLENBIG];
  437 + if (enif_get_string (env, argv [0], cmd, EGTM$BUFLENBIG, ERL_NIF_LATIN1) < 0)
  438 + return enif_make_badarg (env);
  439 +
  440 + gtm_status_t status;
  441 + LOCK(status = gtm_ci ("m_xecute", cmd);)
  442 +
  443 + char emsg [EGTM$BUFLEN];
  444 + if (check_status (status, emsg) == 0)
  445 + return c_AtomOK;
  446 + else
  447 + return enif_make_tuple2 (env, c_AtomError,
  448 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  449 +}
  450 +
  451 +NIF (m_tstart) {
  452 +
  453 + if (argc != 1) return enif_make_badarg (env);
  454 +
  455 + char opts [EGTM$BUFLEN];
  456 + if (enif_get_string (env, argv [0], opts, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  457 + return enif_make_badarg (env);
  458 +
  459 + gtm_status_t status;
  460 + LOCK(status = gtm_ci ("m_tstart", opts);)
  461 +
  462 + char emsg [EGTM$BUFLEN];
  463 + if (check_status (status, emsg) == 0)
  464 + return c_AtomOK;
  465 + else
  466 + return enif_make_tuple2 (env, c_AtomError,
  467 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  468 +}
  469 +
  470 +NIF (m_tcommit) {
  471 +
  472 + if (argc != 0) return enif_make_badarg (env);
  473 +
  474 + gtm_status_t status;
  475 + LOCK(status = gtm_ci ("m_tcommit");)
  476 +
  477 + char emsg [EGTM$BUFLEN];
  478 + if (check_status (status, emsg) == 0)
  479 + return c_AtomOK;
  480 + else
  481 + return enif_make_tuple2 (env, c_AtomError,
  482 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  483 +}
  484 +
  485 +NIF (m_trollback) {
  486 +
  487 + if (argc != 0) return enif_make_badarg (env);
  488 +
  489 + gtm_status_t status;
  490 + LOCK(status = gtm_ci ("m_trollback");)
  491 +
  492 + char emsg [EGTM$BUFLEN];
  493 + if (check_status (status, emsg) == 0)
  494 + return c_AtomOK;
  495 + else
  496 + return enif_make_tuple2 (env, c_AtomError,
  497 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  498 +}
  499 +
  500 +NIF (m_lock) {
  501 +
  502 + if (argc != 1) return enif_make_badarg (env);
  503 +
  504 + char gvn [EGTM$BUFLEN];
  505 + if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  506 + return enif_make_badarg (env);
  507 +
  508 + gtm_status_t status;
  509 + LOCK(status = gtm_ci ("m_lock", gvn);)
  510 +
  511 + char emsg [EGTM$BUFLEN];
  512 + if (check_status (status, emsg) == 0)
  513 + return c_AtomOK;
  514 + else
  515 + return enif_make_tuple2 (env, c_AtomError,
  516 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  517 +}
  518 +
  519 +NIF (m_unlock) {
  520 +
  521 + if (argc != 1) return enif_make_badarg (env);
  522 +
  523 + char gvn [EGTM$BUFLEN];
  524 + if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  525 + return enif_make_badarg (env);
  526 +
  527 + gtm_status_t status;
  528 + LOCK(status = gtm_ci ("m_unlock", gvn);)
  529 +
  530 + char emsg [EGTM$BUFLEN];
  531 + if (check_status (status, emsg) == 0)
  532 + return c_AtomOK;
  533 + else
  534 + return enif_make_tuple2 (env, c_AtomError,
  535 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  536 +}
  537 +
  538 +NIF (m_data) {
  539 +
  540 + if (argc != 1) return enif_make_badarg (env);
  541 +
  542 + char gvn [EGTM$BUFLEN];
  543 + if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
  544 + return enif_make_badarg (env);
  545 +
  546 + int ret; gtm_status_t status;
  547 + LOCK(status = gtm_ci ("m_data", &ret, gvn);)
  548 +
  549 + char emsg [EGTM$BUFLEN];
  550 + if (check_status (status, emsg) == 0)
  551 + return enif_make_tuple2 (env, c_AtomOK,
  552 + enif_make_int (env, ret));
  553 + else
  554 + return enif_make_tuple2 (env, c_AtomError,
  555 + enif_make_string (env, emsg, ERL_NIF_LATIN1));
  556 +}
  557 +
  558 +static ErlNifFunc nif_funcs [] = {
  559 + {"m_set", 2, m_set},
  560 + {"m_setp", 4, m_setp},
  561 + {"m_get", 1, m_get},
  562 + {"m_getp", 3, m_getp},
  563 + {"m_order", 2, m_order},
  564 + {"m_fast_order", 2, m_fast_order},
  565 + {"m_kill", 1, m_kill},
  566 + {"m_zkill", 1, m_zkill},
  567 + {"m_do", 1, m_do},
  568 + {"m_call", 1, m_call},
  569 + {"m_merge", 2, m_merge},
  570 + {"m_xecute", 1, m_xecute},
  571 + {"m_tstart", 1, m_tstart},
  572 + {"m_tcommit", 0, m_tcommit},
  573 + {"m_trollback", 0, m_trollback},
  574 + {"m_lock", 1, m_lock},
  575 + {"m_unlock", 1, m_unlock},
  576 + {"m_data", 1, m_data},
  577 + {"m_horo", 0, m_horo},
  578 + {"m_zver", 0, m_zver},
  579 + {"m_job", 0, m_job}
  580 +};
  581 +
  582 +//ERL_NIF_INIT (egtm_worker, nif_funcs, &load, &reload, &upgrade, &unload);
  583 +ERL_NIF_INIT (egtm_worker, nif_funcs, &load, NULL, NULL, &unload);
  584 +
  585 +// vim: fdm=syntax:fdn=1:tw=74:ts=2:syn=c
66 c_src/gtmxc_types.h
... ... @@ -0,0 +1,66 @@
  1 +/****************************************************************
  2 + * *
  3 + * Copyright 2001, 2007 Fidelity Information Services, Inc *
  4 + * *
  5 + * This source code contains the intellectual property *
  6 + * of its copyright holder(s), and is made available *
  7 + * under a license. If you do not know the terms of *
  8 + * the license, please stop and do not read further. *
  9 + * *
  10 + ****************************************************************/
  11 +
  12 +/* gtmxc_types.h - GT.M, Unix Edition External Call type definitions. */
  13 +
  14 +#ifdef __osf__
  15 +/* Ensure 32-bit pointers for compatibility with GT.M internal representations. */
  16 +#pragma pointer_size (save)
  17 +#pragma pointer_size (short)
  18 +#endif
  19 +
  20 +typedef int xc_status_t;
  21 +typedef int xc_int_t;
  22 +typedef unsigned int xc_uint_t;
  23 +
  24 +#if defined(__osf__)
  25 +typedef int xc_long_t;
  26 +typedef unsigned int xc_ulong_t;
  27 +#else
  28 +typedef long xc_long_t;
  29 +typedef unsigned long xc_ulong_t;
  30 +#endif
  31 +
  32 +typedef float xc_float_t;
  33 +
  34 +typedef double xc_double_t;
  35 +
  36 +typedef char xc_char_t;
  37 +
  38 +typedef int (*xc_pointertofunc_t)();
  39 +
  40 +typedef struct
  41 +{
  42 + xc_long_t length;
  43 + xc_char_t *address;
  44 +} xc_string_t;
  45 +
  46 +#ifdef __osf__
  47 +#pragma pointer_size (restore)
  48 +#endif
  49 +
  50 +/* new types for external/call-in user - xc_* types still valid for backward compatibility */
  51 +typedef xc_status_t gtm_status_t;
  52 +typedef xc_int_t gtm_int_t;
  53 +typedef xc_uint_t gtm_uint_t;
  54 +typedef xc_long_t gtm_long_t;
  55 +typedef xc_ulong_t gtm_ulong_t;
  56 +typedef xc_float_t gtm_float_t;
  57 +typedef xc_double_t gtm_double_t;
  58 +typedef xc_char_t gtm_char_t;
  59 +typedef xc_string_t gtm_string_t;
  60 +typedef xc_pointertofunc_t gtm_pointertofunc_t;
  61 +
  62 +/* call-in interface */
  63 +xc_status_t gtm_ci(const char *c_rtn_name, ...);
  64 +xc_status_t gtm_init(void);
  65 +xc_status_t gtm_exit(void);
  66 +void gtm_zstatus(char* msg, int len);
4 doc/.gitignore
... ... @@ -0,0 +1,4 @@
  1 +*.html
  2 +*.css
  3 +*.png
  4 +edoc-info
BIN  doc/ERL_logo.jpg
BIN  doc/GTM_logo.jpg
BIN  doc/IDEA_logo.jpg
50 doc/overview.edoc
... ... @@ -0,0 +1,50 @@
  1 +<?xml version="1.0" encoding="utf-8"?>
  2 +
  3 +@author Tomas Morstein <tmr&idea.cz>
  4 +@copyright 2012 Tomas Morstein, IDEA Systems.
  5 +
  6 +@title EGTM: Erlang binding for GT.M high-end database
  7 +
  8 +@doc EGTM is a glue for two amazing technologies: Erlang and MUMPS.
  9 +Erlang is known for its great high-availability and high-concurrency
  10 +properties while MUMPS is known as superfast, schema-less and
  11 +space-efficient data processing platform.
  12 +
  13 +
  14 +<div>
  15 + <hr />
  16 + Technology websites powered by IDEA:
  17 + <table width="100%">
  18 + <tr>
  19 + <td>
  20 + <ul>
  21 + <li><a href="http://www.idea.cz">IDEA Systems</a></li>
  22 + <li><a href="http://www.mumps.cz">MUMPS.cz</a></li>
  23 + <li><a href="http://www.openvms.cz">OpenVMS.cz</a></li>
  24 + </ul>
  25 + </td>
  26 + <td width="50%"><span /></td>
  27 + <td><a href="http://fis-gtm.com"><img src="GTM_logo.jpg" /></a></td>
  28 + <td><a href="http://www.idea.cz"><img src="IDEA_logo.jpg" /></a></td>
  29 + <td><a href="http://www.erlang.org"><img src="ERL_logo.jpg" /></a></td>
  30 + </tr>
  31 + </table>
  32 +</div>
  33 +
  34 +<div>
  35 +<hr />
  36 +<p>This program is free software: you can redistribute
  37 +it and/or modify it under the terms of the GNU Affero
  38 +General Public License as published by the Free Software
  39 +Foundation, either version 3 of the License,
  40 +or (at your option) any later version.</p>
  41 +<p>This program is distributed in the hope that it will
  42 +be useful, but WITHOUT ANY WARRANTY; without even
  43 +the implied warranty of MERCHANTABILITY or FITNESS
  44 +FOR A PARTICULAR PURPOSE. See the GNU Affero General
  45 +Public License for more details.</p>
  46 +<p>You should have received a copy of the GNU Affero
  47 +General Public License along with this program.
  48 +If not, see <a href="http://www.gnu.org/licenses/">
  49 +http://www.gnu.org/licenses/</a>.</p>
  50 +</div>
1  ebin/.gitignore
... ... @@ -0,0 +1 @@
  1 +*.beam
81 include/egtm.hrl
... ... @@ -0,0 +1,81 @@
  1 +%%
  2 +%% $Id: $
  3 +%%
  4 +%% Module: egtm -- description
  5 +%% Created: 08-MAY-2012 17:14
  6 +%% Author: tmr
  7 +%%
  8 +%% Copyright 2012 Tomas Morstein, IDEA Systems.
  9 +%%
  10 +%% This program is free software: you can redistribute
  11 +%% it and/or modify it under the terms of the GNU Affero
  12 +%% General Public License as published by the Free Software
  13 +%% Foundation, either version 3 of the License,
  14 +%% or (at your option) any later version.
  15 +%%
  16 +%% This program is distributed in the hope that it will
  17 +%% be useful, but WITHOUT ANY WARRANTY; without even
  18 +%% the implied warranty of MERCHANTABILITY or FITNESS
  19 +%% FOR A PARTICULAR PURPOSE. See the GNU Affero General
  20 +%% Public License for more details.
  21 +%%
  22 +%% You should have received a copy of the GNU Affero
  23 +%% General Public License along with this program.
  24 +%% If not, see <http://www.gnu.org/licenses/>.
  25 +
  26 +-ifndef (EGTM_HRL).
  27 +-define (EGTM_HRL, true).
  28 +
  29 +-type order_direction () :: forward | backward. %% $Order direction.
  30 +-type global_name () :: string (). %% MUMPS Global Variable Name.
  31 +-type subscripts () :: list (). %% MUMPS Subscript Index Path.
  32 +-type tp_options () :: string (). %% MUMPS transaction processing options.
  33 +-type program_name () :: string (). %% MUMPS entryref `Label^MyRoutine'
  34 +
  35 +-ifndef (EGTM_APPNAME).
  36 +-define (EGTM_APPNAME, egtm).
  37 +-endif.
  38 +
  39 +-ifndef (EGTM_NULLKEY).
  40 +-define (EGTM_NULLKEY, "#null").
  41 +-endif.
  42 +
  43 +-ifndef (EGTM_LONGSTRING_BLOCKSIZE).
  44 +-define (EGTM_LONGSTRING_BLOCKSIZE, 4000).
  45 +-endif.
  46 +
  47 +-define (str (V), egtm_util:stringify (V)).
  48 +
  49 +-ifdef (EGTM_TRACE).
  50 +-define (trace (Name), ?trace (Name, [])).
  51 +-define (trace (Name, Args),
  52 + lager:debug ("EGTM CallTrace: ~s:~s ~s",
  53 + [?MODULE, ?str (Name), ?str (Args)])).
  54 +-define (trace_code (Code), Code).
  55 +-else.
  56 +-define (trace (Name), ok).
  57 +-define (trace (Name, Args), ok).
  58 +-define (trace_code (Code), ok).
  59 +-endif.
  60 +
  61 +-define (report_error (Error),
  62 + lager:error ("EGTM Common Error: ~s: ~s",
  63 + [?MODULE, ?str (Error)])).
  64 +
  65 +-define (report_warning (Warn),
  66 + lager:warning ("EGTM Common Warning: ~s: ~s",
  67 + [?MODULE, ?str (Warn)])).
  68 +
  69 +-define (report_info (Info), ?report_info (Info, [])).
  70 +-define (report_info (Info, Args),
  71 + lager:info (Info, Args)).
  72 +
  73 +-ifdef (EGTM_METRICS).
  74 +-define (metrics (Name, Fun), .?metrics (Name, Fun)).
  75 +-else.
  76 +-define (metrics (Name, Fun), Fun ()).
  77 +-endif.
  78 +
  79 +-endif. % EGTM_HRL
  80 +
  81 +%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
1  priv/.gitignore
... ... @@ -0,0 +1 @@
  1 +*.so
22 priv/calltab.ci
... ... @@ -0,0 +1,22 @@
  1 +m_init :void init^%egtmapi()
  2 +m_set :void set^%egtmapi(I:gtm_char_t*,I:gtm_char_t*)
  3 +m_setp :void setp^%egtmapi(I:gtm_char_t*,I:gtm_int_t,I:gtm_char_t*,I:gtm_char_t*)
  4 +m_get :gtm_char_t* get^%egtmapi(I:gtm_char_t*)
  5 +m_getp :gtm_char_t* getp^%egtmapi(I:gtm_char_t*,I:gtm_int_t,I:gtm_char_t*)
  6 +m_order :gtm_char_t* order^%egtmapi(I:gtm_char_t*,I:gtm_int_t)
  7 +m_fast_order:gtm_char_t* fastOrder^%egtmapi(I:gtm_char_t*,I:gtm_int_t)
  8 +m_kill :gtm_char_t* kill^%egtmapi(I:gtm_char_t*)
  9 +m_zkill :gtm_char_t* zkill^%egtmapi(I:gtm_char_t*)
  10 +m_do :void do^%egtmapi(I:gtm_char_t*)
  11 +m_call :gtm_char_t* call^%egtmapi(I:gtm_char_t*)
  12 +m_merge :void merge^%egtmapi(I:gtm_char_t*,I:gtm_char_t*)
  13 +m_tstart :void tstart^%egtmapi(I:gtm_char_t*)
  14 +m_tcommit :void tcommit^%egtmapi()
  15 +m_trollback :void trollback^%egtmapi()
  16 +m_lock :void lock^%egtmapi(I:gtm_char_t*)
  17 +m_unlock :void unlock^%egtmapi(I:gtm_char_t*)
  18 +m_data :gtm_int_t* data^%egtmapi(I:gtm_char_t*)
  19 +m_xecute :void xecute^%egtmapi(I:gtm_char_t*)
  20 +m_horo :gtm_char_t* horo^%egtmapi()
  21 +m_zver :gtm_char_t* zver^%egtmapi()
  22 +m_job :gtm_char_t* job^%egtmapi()
6 priv/dm
... ... @@ -0,0 +1,6 @@
  1 +#!/bin/sh
  2 +
  3 +. `dirname $0`/gtmenv
  4 +
  5 +$gtm_dist/mumps -di
  6 +
6 priv/dse
... ... @@ -0,0 +1,6 @@
  1 +#!/bin/sh
  2 +
  3 +. `dirname $0`/gtmenv
  4 +
  5 +$gtm_dist/dse $@
  6 +
44 priv/egtm.conf
... ... @@ -0,0 +1,44 @@
  1 +%% --------------------------------------------
  2 +%% *** EGTM Configuration ***
  3 +%% --------------------------------------------
  4 +
  5 +%% egtm core setup
  6 +{egtm, [
  7 +
  8 + %% Defaults
  9 + {defaults, [
  10 +
  11 + %% $Piece default delimiter
  12 + {piece_delim, "|"}
  13 + ]},
  14 +
  15 + %% Mode of operation
  16 + %% single (= use NIF directly),
  17 + %% pool (= use multiple slave ErlVMs)
  18 + %% NOTE: pooling is 10times slower than 'single'
  19 + %% and is also disabled by default. To enable it,
  20 + %% you need to define EGTM_POOL_ENABLED macro
  21 + {mode, single},
  22 +
  23 + %% Workers are slave ErlVMs with GT.M call-in NIF
  24 + {workers, [
  25 +
  26 + %% Slave nodes to be autostarted
  27 + {nodes, [egtm1, egtm2, egtm3, egtm4]}
  28 + ]},
  29 +
  30 + %% Functions that are for some (security) reason denied
  31 + %{deny, [kill, do, call, merge, xecute]}
  32 + {deny, []}
  33 + %,
  34 + %% String encoder/decoder functions
  35 + %{string_conversion, [
  36 + % {encode, {egtm_string, erl2utf} },
  37 + % {decode, {egtm_string, utf2erl} } ]}
  38 +]}.
  39 +
  40 +%% egtm metrics: histograms and counters
  41 +%% NOTE: if enabled, all egtm-core operations are slower!
  42 +{egtm_metrics, [{enabled, false}]}.
  43 +
  44 +%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
4 priv/egtm_console
... ... @@ -0,0 +1,4 @@
  1 +#!/bin/sh
  2 +
  3 +erl -pa ebin -pa deps/*/ebin -pa test -pa test/* -sname egtm_console $@
  4 +
4 priv/egtm_console_gdb
... ... @@ -0,0 +1,4 @@
  1 +#!/bin/sh
  2 +
  3 +gdberl -pa ebin -pa deps/*/ebin -pa test -pa test/* -sname egtm_console $@
  4 +
2  priv/gbls/.gitignore
... ... @@ -0,0 +1,2 @@
  1 +*.gld
  2 +*.dat
6 priv/gde
... ... @@ -0,0 +1,6 @@
  1 +#!/bin/sh
  2 +
  3 +. `dirname $0`/gtmenv
  4 +
  5 +$gtm_dist/mumps -r ^GDE
  6 +
12 priv/gtmenv
... ... @@ -0,0 +1,12 @@
  1 +#!/bin/sh
  2 +
  3 +if [ ! -d "${EGTM_PRIV}" ] ; then
  4 + SWD=`dirname $0` ; CWD=`pwd`
  5 + cd ${SWD} ; SWD=`pwd` ; cd ${CWD}
  6 + EGTM_PRIV=${SWD}
  7 +fi
  8 +
  9 +export gtm_dist=/usr/lib/fis-gtm/V54002Bx64
  10 +export gtmroutines="$gtm_dist ${EGTM_PRIV}/rtns ."
  11 +export gtmgbldir="${EGTM_PRIV}/gbls/egtm.gld"
  12 +
41 priv/initdb
... ... @@ -0,0 +1,41 @@
  1 +#!/bin/sh
  2 +
  3 +. `dirname $0`/gtmenv
  4 +
  5 +DIR=`pwd` ; PRIV=`dirname $0` ; cd $PRIV ; PRIV=`pwd` ; cd $DIR
  6 +
  7 +egtm_db=$PRIV/gbls/egtm.dat
  8 +egtmbig_db=$PRIV/gbls/egtmbig.dat
  9 +
  10 +if [ -f ${egtm_db} ] ; then
  11 + #echo "Database already exists!"
  12 + #echo "*** NOT INITIALIZING IT ***"
  13 + exit 0
  14 +fi
  15 +
  16 +$gtm_dist/mumps -r ^GDE << EOF
  17 +D-R DEFAULT
  18 +D-S DEFAULT
  19 +T-S -Bloc=4096
  20 +T-S -Lock=40
  21 +T-S -Glob=4096
  22 +T-S -Alloc=1000
  23 +T-S -Ext=3000
  24 +T-R -Rec=4080
  25 +T-R -Key=255
  26 +T-R -N=AL
  27 +T-R -J=BE
  28 +A-S EGTM -F="$egtm_db"
  29 +A-S EGTMBIG -BLOCK=32256 -F="$egtmbig_db"
  30 +A-R EGTM -D=EGTM
  31 +A-R EGTMBIG -REC=32240 -D=EGTMBIG
  32 +LOC -R=EGTM
  33 +C-N * -R=EGTM
  34 +A-N Big* -R=EGTMBIG
  35 +SH -A
  36 +V -A
  37 +E
  38 +EOF
  39 +
  40 +$gtm_dist/mupip create
  41 +
6 priv/lke
... ... @@ -0,0 +1,6 @@
  1 +#!/bin/sh
  2 +
  3 +. `dirname $0`/gtmenv
  4 +
  5 +$gtm_dist/lke $@
  6 +
6 priv/mupip
... ... @@ -0,0 +1,6 @@
  1 +#!/bin/sh
  2 +
  3 +. `dirname $0`/gtmenv
  4 +
  5 +$gtm_dist/mupip $@
  6 +
1  priv/rtns/.gitignore
... ... @@ -0,0 +1 @@
  1 +*.o
91 priv/rtns/_egtmapi.m
... ... @@ -0,0 +1,91 @@
  1 +; GT.M call-in API for Erlang NIF library
  2 +; XXX: temporary --> convert indirection to Xecutes
  3 +; XXX: (because of speed and also to make TP emulation easier)
  4 +
  5 +init q ;s $zt="n tmp s e=$ecode s tmp=$p($ecode,"","",2) q:$q $e(tmp,2,$l(tmp)) q" q
  6 +set(k,v) d txsubmitcmd("s @k=$g(v)","k,v") q
  7 +setp(k,d,p,v) d txsubmitcmd("s $p(@k,p,d)=$g(v)","k,d,p,v") q
  8 +get(k) q $g(@$g(k))
  9 +getp(k,d,p) q $p($g(@$g(k)),p,d)
  10 +order(k,d) q $o(@k,d)
  11 +kill(k) d txsubmitcmd("k @k","k") q
  12 +zkill(k) d txsubmitcmd("zkill @k","k") q
  13 +do(c) d @c q
  14 +call(c) n x x "s x=$$"_c q $g(x)
  15 +merge(k1,k2) d txsubmitcmd("m @k1=@k2","k1,k2") q
  16 +tstart(v) d txstart() q ; XXX: TP Arguments?
  17 +tcommit d txcommit() q
  18 +trollback d txrollback() q
  19 +lock(k) d txsubmitcmd("l +@k","k") q ; XXX: Lock timeout?
  20 +;lock(k,t) s t=+$g(t)
  21 +; i t>-1 l +@k:t q $T
  22 +; e l +@k q $T
  23 +unlock(k) d txsubmitcmd("l -@k","k") q
  24 +data(k) q $d(@k)
  25 +xecute(x) x x q
  26 +
  27 +horo() q $h
  28 +zver() q $zver
  29 +job() q $j
  30 +
  31 +; TP emulation internals
  32 +txtest(k,d,p,w) d txsubmitcmd("w k,d,p,w,!") q
  33 +txsubmitcmd(cmd,pars)
  34 + i $G(%EGTMTP) d
  35 + . n cmdid,i,var s cmdid=$O(%EGTMTP($G(%EGTMTP),""),-1)+1
  36 + . f i=1:1:10 s var=$P(pars,",",i) q:var="" d
  37 + . . s %EGTMTP(%EGTMTP,cmdid,var)=@var
  38 + . s %EGTMTP(%EGTMTP,cmdid)=cmd_";;;"_pars
  39 + e x cmd
  40 + q
  41 +txstart() s %EGTMTP=$G(%EGTMTP)+1 q