Refactoring to support basic polling and OCaml bindings through Ctypes

.gitignore

@@ -1,2 +1,4 @@
 .DS_Store
 native/k.h
+native/obj
+.vscode

native/Makefile

@@ -6,8 +6,8 @@ detected_OS := $(shell uname -s)
 
 IDIR=.
 CC=gcc
-CFLAGS=-DKXVER=3 -fPIC -I$(IDIR) -Wall
-CDFLAGS=-shared
+CFLAGS=-DKXVER=3 -fPIC -I$(IDIR) -Wall -g3 -gdwarf -g2
+#CDFLAGS=-shared
 ifeq ($(detected_OS),Darwin)  # Mac OS X
     CDFLAGS += -undefined dynamic_lookup
 endif
@@ -17,18 +17,29 @@ endif
 
 ODIR=obj
 LIBS=-lm
-DEPS = k.h wire.h
+DEPS=k.h wire.h mock_k.h shmipc.h
+OBJECTS=$(ODIR)/shmipc.o $(ODIR)/mock_k.o
 
-all: obj/hpet.so obj/shmipc.so obj/shmmain
+all: $(ODIR)/mock_k.o $(ODIR)/shmipc.o $(ODIR)/shmmain $(ODIR)/libocamlshmipc.so $(ODIR)/ocamlshmipcmain
 
 k.h:
 	wget https://raw.githubusercontent.com/KxSystems/kdb/master/c/c/k.h
 
-$(ODIR)/%.so: %.c $(DEPS)
-	$(CC) -o $@ $< $(CFLAGS) $(CDFLAGS)
 
-$(ODIR)/shmmain: shmmain.c shmipc.c mock_k.h $(DEPS)
-	$(CC) -o $@ $< $(CFLAGS) -g -O0
+$(ODIR)/mock_k.o: mock_k.c $(DEPS)
+	$(CC) -c -o $@ $< $(CFLAGS) $(CDFLAGS)
+
+$(ODIR)/shmipc.o: shmipc.c $(ODIR)/mock_k.o $(DEPS)
+	$(CC) -c -o $@ $< $(ODIR)/mock_k.o $(CFLAGS) $(CDFLAGS)
+
+$(ODIR)/shmmain: shmmain.c $(DEPS) $(OBJECTS)
+	$(CC) -o $@ $< $(OBJECTS) $(CFLAGS) -g -O0
+
+$(ODIR)/libocamlshmipc.so: ocamlshmipc.c $(OBJECTS)
+	$(CC) -shared -o $@ $< $(OBJECTS) $(CFLAGS) -g -O0
+
+$(ODIR)/ocamlshmipcmain: ocamlshmipcmain.c $(DEPS) $(OBJECTS)
+	$(CC) -o $@ $< $(OBJECTS) $(CFLAGS) -g -O0
 
 coverage: obj/shmcov
 	obj/shmcov -v -a WORLD :demo/stress
@@ -52,6 +63,7 @@ fuzz: $(ODIR)/shmmain.fuzz
 $(ODIR)/shmmain.fuzz: shmmain.c shmipc.c mock_k.h $(DEPS)
 	/usr/local/Cellar/afl-fuzz/2.52b/bin/afl-clang -o $@ $< $(CFLAGS) -g -O0
 
+
 .PHONY: clean grind coverage syms fuzz
 
 clean:

native/mock_k.c

@@ -0,0 +1,148 @@
+// Copyright 2018 Tea Engineering Ltd.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+// stub out kx layer (the extern function in k.h) so we can run in main, profile,
+// valgrind native code etc.
+//
+// It's impossible to find the source of memory leaks with the Kx slab allocator
+// as valgrind can't hook the individual allocations to record the stack.
+//
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "k.h"
+
+#define KERR -128
+
+// globals
+int kxx_errno = 0;
+char* kxx_msg = NULL;
+
+K krr(const S msg) {
+    printf("'%s\n", msg);
+    kxx_errno = -1;
+    kxx_msg = msg;
+    return (K)NULL;
+}
+K orr(const S msg) {
+    printf("%s\n", msg);
+    kxx_errno = -1;
+    kxx_msg = msg;
+    return (K)NULL;
+}
+K ee(K ignored) {
+    if (kxx_errno != 0) {
+        K r = ktn(KERR, 1);
+        r->s = kxx_msg;
+        kxx_errno = 0;
+        return r;
+    }
+    return ignored;
+}
+K ki(int i) {
+    K r = ktn(-KI, 0);
+    r->i = i;
+    return r;
+}
+K kj(long long i) {
+    K r = ktn(-KJ, 0);
+    r->j = i;
+    return r;
+}
+K kss(const char* ss) {
+    K r = ktn(-KS, 0);
+    r->s = (char*)ss;
+    return r;
+}
+K dl(void* fnptr, J n) {
+    K r = ktn(100,0);
+    r->s = fnptr;
+    //r->a = n;
+    return r;
+}
+
+typedef K (*kfunc_1arg)(K);
+typedef K (*kfunc_2arg)(K,K);
+typedef K (*kfunc_3arg)(K,K,K);
+
+K dot(K x, K y) { // call function pointer in x with args in mixed list y
+    if (x->t != 100) return krr("x must be fptr");
+    if (y->t != 0) return krr("y must be list");
+    //if (x->a == 2) { // not sure why this check was there
+    kfunc_2arg fptr = (kfunc_2arg)x->s;
+    return fptr(kK(y)[0], kK(y)[1]);
+}
+
+K knk(int n, ...) { // create a mixed list from K's in varg
+    va_list ap;
+    K r = ktn(0, n);
+    va_start(ap, n); //Requires the last fixed parameter (to get the address)
+    for(int j=0; j<n; j++) {
+        kK(r)[j] = va_arg(ap, K); //Requires the type to cast to. Increments ap to the next argument.
+    }
+    va_end(ap);
+    return r;
+}
+//                mx KB UU ?? KG KH KI KJ KE KF KC KS KP KM KD KZ KN KU KV KT
+//                0  1  2  -  4  5  6  7  8  9  10 11 12 13 14 15 16 17 18 19
+int sizefor[] = { 8, 1, 16,0, 1, 2, 4, 8, 4, 8, 1, 8 ,8, 4, 4, 8, 8, 4, 4, 4 };
+K ktn(int type, long long n) { // K type number
+    int sz = (type > 19) ? 8 : sizefor[abs(type)];
+    K r = malloc(sizeof(struct k0) + n*sz);
+    r->r = 0;
+    r->t = type;
+    if (n > 0) r->n = n; // keep: trap accessing n for atom in valgrind
+    return r;
+}
+
+// dummy serialiser returns a single byte array [SOH]
+K b9(I mode, K obj) {
+    K r = ktn(KB,1);
+    r->G0[0] = 1;
+    return r;
+}
+
+K d9(K obj) {
+    return ki(1);
+}
+
+int okx(K obj) { return 1; }
+// repl equivelent wrapper (protected eval, with and without gc)
+K pe(K x) {
+    if (kxx_errno != 0) exit(-1);
+    return x;
+}
+void per(K x) {
+    pe(x);
+    if (x != NULL) r0(x);
+}
+
+void r0(K x) { // Decrement the object‘s reference count
+    if (x == 0) { printf("Bug r0 of null pointer %p\n", x); return; }
+    if (x->r < 0) printf("Bug double-free of %p\n", x);
+    if (x->r == 0) {
+        if (x->t == 0) for (int i = 0; i < x->n; i++) r0(kK(x)[i]);
+        // flip?
+        // dict?
+        free(x);
+    } else {
+        x->r--;
+    }
+}
+K r1(K x) { // Increment the object‘s reference count
+    x->r++;
+    return x;
+}
+

native/mock_k.h

@@ -18,126 +18,32 @@
 // It's impossible to find the source of memory leaks with the Kx slab allocator
 // as valgrind can't hook the individual allocations to record the stack.
 //
+#ifndef MOCK_K
+#define MOCK_K
 
-// globals
-int kxx_errno = 0;
-char* kxx_msg = NULL;
+#define KERR -128
 
-K krr(const S msg) {
-    printf("'%s\n", msg);
-    kxx_errno = -1;
-    kxx_msg = msg;
-    return (K)NULL;
-}
-K orr(const S msg) {
-    printf("%s\n", msg);
-    kxx_errno = -1;
-    kxx_msg = msg;
-    return (K)NULL;
-}
-K ee(K ignored) {
-    if (kxx_errno != 0) {
-        K r = ktn(KERR, 1);
-        r->s = kxx_msg;
-        kxx_errno = 0;
-        return r;
-    }
-    return ignored;
-}
-K ki(int i) {
-    K r = ktn(-KI, 0);
-    r->i = i;
-    return r;
-}
-K kj(long long i) {
-    K r = ktn(-KJ, 0);
-    r->j = i;
-    return r;
-}
-K kss(const char* ss) {
-    K r = ktn(-KS, 0);
-    r->s = (char*)ss;
-    return r;
-}
-K dl(void* fnptr, int n) {
-    K r = ktn(100,0);
-    r->s = fnptr;
-    r->a = n;
-    return r;
-}
+K krr(const S msg);
+K orr(const S msg);
+K ee(K ignored);
+K ki(int i);
+K kj(long long i);
+K kss(const char* ss);
+K dl(void* fnptr, J n);
 
 typedef K (*kfunc_1arg)(K);
 typedef K (*kfunc_2arg)(K,K);
 typedef K (*kfunc_3arg)(K,K,K);
 
-K dot(K x, K y) { // call function pointer in x with args in mixed list y
-    if (x->t != 100) return krr("x must be fptr");
-    if (y->t != 0) return krr("y must be list");
-    if (x->a == 2) {
-        kfunc_2arg fptr = (kfunc_2arg)x->s;
-        return fptr(kK(y)[0], kK(y)[1]);
-    }
-    return ki(1);
-}
-
-K knk(int n, ...) { // create a mixed list from K's in varg
-    va_list ap;
-    K r = ktn(0, n);
-    va_start(ap, n); //Requires the last fixed parameter (to get the address)
-    for(int j=0; j<n; j++) {
-        kK(r)[j] = va_arg(ap, K); //Requires the type to cast to. Increments ap to the next argument.
-    }
-    va_end(ap);
-    return r;
-}
-//                mx KB UU ?? KG KH KI KJ KE KF KC KS KP KM KD KZ KN KU KV KT
-//                0  1  2  -  4  5  6  7  8  9  10 11 12 13 14 15 16 17 18 19
-int sizefor[] = { 8, 1, 16,0, 1, 2, 4, 8, 4, 8, 1, 8 ,8, 4, 4, 8, 8, 4, 4, 4 };
-K ktn(int type, long long n) { // K type number
-    int sz = (type > 19) ? 8 : sizefor[abs(type)];
-    K r = malloc(sizeof(struct k0) + n*sz);
-    r->r = 0;
-    r->t = type;
-    if (n > 0) r->n = n; // keep: trap accessing n for atom in valgrind
-    return r;
-}
-
-// dummy serialiser returns a single byte array [SOH]
-K b9(I mode, K obj) {
-    K r = ktn(KB,1);
-    r->G0[0] = 1;
-    return r;
-}
-
-K d9(K obj) {
-    return ki(1);
-}
-
-int okx(K obj) { return 1; }
-// repl equivelent wrapper (protected eval, with and without gc)
-K pe(K x) {
-    if (kxx_errno != 0) exit(-1);
-    return x;
-}
-void per(K x) {
-    pe(x);
-    if (x != NULL) r0(x);
-}
-
-void r0(K x) { // Decrement the object‘s reference count
-    if (x == 0) { printf("Bug r0 of null pointer %p\n", x); return; }
-    if (x->r < 0) printf("Bug double-free of %p\n", x);
-    if (x->r == 0) {
-        if (x->t == 0) for (int i = 0; i < x->n; i++) r0(kK(x)[i]);
-        // flip?
-        // dict?
-        free(x);
-    } else {
-        x->r--;
-    }
-}
-K r1(K x) { // Increment the object‘s reference count
-    x->r++;
-    return x;
-}
-
+K dot(K x, K y);
+K knk(int n, ...);
+K ktn(int type, long long n);// dummy serialiser returns a single byte array [SOH]
+K b9(I mode, K obj);
+K d9(K obj);
+int okx(K obj);
+K pe(K x);
+void per(K x);
+void r0(K x);
+K r1(K x);
+
+#endif