83421ef · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Add CData to Idris.

commit83421ef89c52323a901e088dcd84aa971021459e authorMatus Tejiscak <ziman@functor.sk> dateThu 21 Jan 2016, 18:59 (11 years ago) parent1daf221

8 files changed+51−31

compare with master

unifiedsplit

libs/prelude/Builtins.idr+1 libs/prelude/IO.idr+1 rts/idris_heap.c+33−18 rts/idris_heap.h+6−4 rts/idris_rts.c+5−9 rts/idris_rts.h+1 src/IRTS/CodegenC.hs+3 src/IRTS/Lang.hs+1

libs/prelude/Builtins.idr+1

@@ -176,6 +176,7 @@ Float = Double

176176

177177abstract data Ptr : Type

178178abstract data ManagedPtr : Type

179+abstract data CData : Type

179180

180181%extern prim__readFile : prim__WorldType -> Ptr -> String

181182%extern prim__writeFile : prim__WorldType -> Ptr -> String -> Int

libs/prelude/IO.idr+1

@@ -168,6 +168,7 @@ namespace FFI_C

168168 C_Unit : C_Types ()

169169 C_Any : C_Types (Raw a)

170170 C_IntT : C_IntTypes i -> C_Types i

171+ C_CData : C_Types CData

171172

172173 ||| A descriptor for the C FFI. See the constructors of `C_Types`

173174 ||| and `C_IntTypes` for the concrete types that are available.

rts/idris_heap.c+33−18

@@ -5,21 +5,48 @@

55#include <stddef.h>

66#include <stdio.h>

8+void c_heap_free(CHeapItem * item)

9+{

10+ // fix links

11+ if (item->next != NULL)

12+ {

13+ item->next->prev_next = item->prev_next;

14+ }

15+ *(item->prev_next) = item->next;

16+

17+ // free payload

18+ item->finalizer(item->data);

19+

20+ // free item struct

21+ free(item);

22+}

23+

24+CHeapItem * c_heap_allocate(size_t size, CDataFinalizer_t * finalizer)

25+{

26+ void * data = (void *) malloc(size);

27+ return c_heap_create_item(data, finalizer);

28+}

29+

830CHeapItem * c_heap_create_item(void * data, CDataFinalizer_t * finalizer)

931{

1032 CHeapItem * item = (CHeapItem *) malloc(sizeof(CHeapItem));

1133

1234 item->data = data;

1335 item->finalizer = finalizer;

14− item->is_inserted = false;

1536 item->is_used = false;

1637 item->next = NULL;

38+ item->prev_next = NULL;

1739

1840 return item;

1941}

2042

21−void c_heap_insert(CHeap * heap, CHeapItem * item)

43+void c_heap_insert_if_needed(CHeap * heap, CHeapItem * item)

2244{

45+ if (item->prev_next != NULL) return; // already inserted

46+

47+ heap->first->prev_next = &item->next;

48+ item->prev_next = &heap->first;

49+

2350 item->next = heap->first;

2451 heap->first = item;

2552}

@@ -29,22 +56,14 @@ void c_heap_mark_item(CHeapItem * item)

2956 item->is_used = true;

3057}

3158

32−static void c_heap_free_item(CHeapItem * item)

33−{

34− item->finalizer(item->data);

35− free(item);

36−}

37−

3859void c_heap_sweep(CHeap * heap)

3960{

40− CHeapItem ** prev_next = &heap->first;

4161 CHeapItem * p = heap->first;

4262 while (p != NULL)

4363 {

4464 if (p->is_used)

4565 {

4666 p->is_used = false;

47− prev_next = &p->next;

4867 p = p->next;

4968 }

5069 else

@@ -52,8 +71,7 @@ void c_heap_sweep(CHeap * heap)

5271 CHeapItem * unused_item = p;

5372 p = p->next;

5473

55− *prev_next = unused_item->next;

56− c_heap_free_item(unused_item);

74+ c_heap_free(unused_item);

5775 }

5876 }

5977}

@@ -63,14 +81,11 @@ void c_heap_init(CHeap * heap)

6381 heap->first = NULL;

6482}

6583

66−void c_heap_free(CHeap * heap)

84+void c_heap_destroy(CHeap * heap)

6785{

68− CHeapItem * p = heap->first;

69− while (p != NULL)

86+ while (heap->first != NULL)

7087 {

71− CHeapItem * q = p;

72− p = p->next;

73− c_heap_free_item(q);

88+ c_heap_free(heap->first); // will update heap->first via the backward link

7489 }

7590}

7691

rts/idris_heap.h+6−4

@@ -10,8 +10,8 @@ typedef struct CHeapItem {

1010 void * data;

1111 CDataFinalizer_t * finalizer; // responsible for freeing the passed pointer, too

1212 bool is_used;

13− bool is_inserted;

1413 struct CHeapItem * next;

14+ struct CHeapItem ** prev_next;

1515} CHeapItem;

1616

1717typedef struct CHeap {

@@ -19,13 +19,15 @@ typedef struct CHeap {

1919} CHeap;

2020

2121void c_heap_init(CHeap * c_heap);

22−void c_heap_free(CHeap * c_heap);

23−void c_heap_insert(CHeap * c_heap, CHeapItem * item);

22+void c_heap_destroy(CHeap * c_heap);

23+void c_heap_insert_if_needed(CHeap * c_heap, CHeapItem * item);

2424void c_heap_mark_item(CHeapItem * item);

2525void c_heap_sweep(CHeap * c_heap);

26+CHeapItem * c_heap_create_item(void * data, CDataFinalizer_t * finalizer);

2627

2728// this is the function to use in C binding code

28−CHeapItem * c_heap_create_item(void * data, CDataFinalizer_t * finalizer);

29+CHeapItem * c_heap_allocate(size_t size, CDataFinalizer_t * finalizer);

30+void c_heap_free(CHeapItem * item);

2931

3032typedef struct {

3133 char* next; // Next allocated chunk. Should always (heap <= next < end).

rts/idris_rts.c+5−9

@@ -110,7 +110,7 @@ Stats terminate(VM* vm) {

110110#endif

111111 free(vm->valstack);

112112 free_heap(&(vm->heap));

113− c_heap_free(&(vm->c_heap));

113+ c_heap_destroy(&(vm->c_heap));

114114#ifdef HAS_PTHREAD

115115 pthread_mutex_destroy(&(vm -> inbox_lock));

116116 pthread_mutex_destroy(&(vm -> inbox_block));

@@ -270,20 +270,16 @@ char* GETSTROFF(VAL stroff) {

270270VAL MKCDATA(VM* vm, CHeapItem * item) {

271271 Closure* cl = allocate(sizeof(Closure), 0);

272272 SETTY(cl, CDATA);

273− if (!item->is_inserted)

274− {

275− c_heap_insert(&vm->c_heap, item);

276− }

273+ cl->info.c_heap_item = item;

274+ c_heap_insert_if_needed(&vm->c_heap, item);

277275 return cl;

278276}

279277

280278VAL MKCDATAc(VM* vm, CHeapItem * item) {

281279 Closure* cl = allocate(sizeof(Closure), 1);

282280 SETTY(cl, CDATA);

283− if (!item->is_inserted)

284− {

285− c_heap_insert(&vm->c_heap, item);

286− }

281+ cl->info.c_heap_item = item;

282+ c_heap_insert_if_needed(&vm->c_heap, item);

287283 return cl;

288284}

289285

rts/idris_rts.h+1

@@ -149,6 +149,7 @@ typedef void(*func)(VM*, VAL*);

149149#define GETPTR(x) (((VAL)(x))->info.ptr)

150150#define GETMPTR(x) (((VAL)(x))->info.mptr->data)

151151#define GETFLOAT(x) (((VAL)(x))->info.f)

152+#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)

152153

153154#define GETBITS8(x) (((VAL)(x))->info.bits8)

154155#define GETBITS16(x) (((VAL)(x))->info.bits16)

src/IRTS/CodegenC.hs+3

@@ -342,6 +342,7 @@ toFType (FCon c)

342342 | c == sUN "C_Float" = FArith ATFloat

343343 | c == sUN "C_Ptr" = FPtr

344344 | c == sUN "C_MPtr" = FManagedPtr

345+ | c == sUN "C_CData" = FCData

345346 | c == sUN "C_Unit" = FUnit

346347toFType (FApp c [_,ity])

347348 | c == sUN "C_IntT" = FArith (toAType ity)

@@ -358,6 +359,7 @@ c_irts FUnit l x = x

358359c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"

359360c_irts FManagedPtr l x = l ++ "MKMPTR(vm, " ++ x ++ ")"

360361c_irts (FArith ATFloat) l x = l ++ "MKFLOAT(vm, " ++ x ++ ")"

362+c_irts FCData l x = l ++ "MKCDATA(vm, " ++ x ++ ")"

361363c_irts FAny l x = l ++ x

362364

363365irts_c (FArith (ATInt ITNative)) x = "GETINT(" ++ x ++ ")"

@@ -369,6 +371,7 @@ irts_c FUnit x = x

369371irts_c FPtr x = "GETPTR(" ++ x ++ ")"

370372irts_c FManagedPtr x = "GETMPTR(" ++ x ++ ")"

371373irts_c (FArith ATFloat) x = "GETFLOAT(" ++ x ++ ")"

374+irts_c FCData x = "GETCDATA(" ++ x ++ ")"

372375irts_c FAny x = x

373376

374377bitOp v op ty args = v ++ "idris_b" ++ show (nativeTyWidth ty) ++ op ++ "(vm, " ++ intercalate ", " (map creg args) ++ ")"

src/IRTS/Lang.hs+1

@@ -99,6 +99,7 @@ data FType = FArith ArithTy

9999 | FUnit

100100 | FPtr

101101 | FManagedPtr

102+ | FCData

102103 | FAny

103104 deriving (Show, Eq)

104105