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

libs/prelude/Builtins.idr+1

compare with master

unifiedsplit

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

176

177abstract data Ptr : Type

178abstract data ManagedPtr : Type

179+abstract data CData : Type

179

180

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

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

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

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

libs/prelude/IO.idr+1

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

168 C_Unit : C_Types ()

169 C_Any : C_Types (Raw a)

170 C_IntT : C_IntTypes i -> C_Types i

171+ C_CData : C_Types CData

171

172

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

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

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

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

rts/idris_heap.c+33−18

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

5#include <stddef.h>

6#include <stdio.h>

7

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+

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

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

9{

31{

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

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

11

33

12 item->data = data;

34 item->data = data;

13 item->finalizer = finalizer;

35 item->finalizer = finalizer;

14− item->is_inserted = false;

15 item->is_used = false;

36 item->is_used = false;

16 item->next = NULL;

37 item->next = NULL;

38+ item->prev_next = NULL;

17

39

18 return item;

40 return item;

19}

41}

20

42

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

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

22{

44{

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

46+

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

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

49+

23 item->next = heap->first;

50 item->next = heap->first;

24 heap->first = item;

51 heap->first = item;

25}

52}

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

29 item->is_used = true;

56 item->is_used = true;

30}

57}

31

58

32−static void c_heap_free_item(CHeapItem * item)

33−{

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

35− free(item);

36−}

37−

38void c_heap_sweep(CHeap * heap)

59void c_heap_sweep(CHeap * heap)

39{

60{

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

41 CHeapItem * p = heap->first;

61 CHeapItem * p = heap->first;

42 while (p != NULL)

62 while (p != NULL)

43 {

63 {

44 if (p->is_used)

64 if (p->is_used)

45 {

65 {

46 p->is_used = false;

66 p->is_used = false;

47− prev_next = &p->next;

48 p = p->next;

67 p = p->next;

49 }

68 }

50 else

69 else

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

52 CHeapItem * unused_item = p;

71 CHeapItem * unused_item = p;

53 p = p->next;

72 p = p->next;

54

73

55− *prev_next = unused_item->next;

56− c_heap_free_item(unused_item);

74+ c_heap_free(unused_item);

57 }

75 }

58 }

76 }

59}

77}

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

63 heap->first = NULL;

81 heap->first = NULL;

64}

82}

65

83

66−void c_heap_free(CHeap * heap)

84+void c_heap_destroy(CHeap * heap)

67{

85{

68− CHeapItem * p = heap->first;

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

69− while (p != NULL)

70 {

87 {

71− CHeapItem * q = p;

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

72− p = p->next;

73− c_heap_free_item(q);

74 }

89 }

75}

90}

76

91

rts/idris_heap.h+6−4

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

10 void * data;

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

12 bool is_used;

13− bool is_inserted;

14 struct CHeapItem * next;

13 struct CHeapItem * next;

14+ struct CHeapItem ** prev_next;

15} CHeapItem;

16

17typedef struct CHeap {

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

19} CHeap;

20

21void c_heap_init(CHeap * c_heap);

22−void c_heap_free(CHeap * c_heap);

22+void c_heap_destroy(CHeap * c_heap);

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

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

24void c_heap_mark_item(CHeapItem * item);

25void c_heap_sweep(CHeap * c_heap);

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

26

27

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

28// 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);

29

31

30typedef struct {

32typedef struct {

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

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

rts/idris_rts.c+5−9

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

110#endif

111 free(vm->valstack);

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

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

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

114#ifdef HAS_PTHREAD

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

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

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

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

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

272 SETTY(cl, CDATA);

273− if (!item->is_inserted)

273+ cl->info.c_heap_item = item;

274− {

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

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

276− }

277 return cl;

275 return cl;

278}

276}

279

277

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

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

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

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

282 SETTY(cl, CDATA);

280 SETTY(cl, CDATA);

283− if (!item->is_inserted)

281+ cl->info.c_heap_item = item;

284− {

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

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

286− }

287 return cl;

283 return cl;

288}

284}

289

285

rts/idris_rts.h+1

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

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

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

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

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

152

153

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

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

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

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

src/IRTS/CodegenC.hs+3

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

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

343 | c == sUN "C_Ptr" = FPtr

344 | c == sUN "C_MPtr" = FManagedPtr

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

345 | c == sUN "C_Unit" = FUnit

346 | c == sUN "C_Unit" = FUnit

346toFType (FApp c [_,ity])

347toFType (FApp c [_,ity])

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

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

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

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

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

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

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

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

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

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

361c_irts FAny l x = l ++ x

363c_irts FAny l x = l ++ x

362

364

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

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

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

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

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

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

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

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

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

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

372irts_c FAny x = x

375irts_c FAny x = x

373

376

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

377bitOp 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

99 | FUnit

100 | FPtr

101 | FManagedPtr

102+ | FCData

102 | FAny

103 | FAny

103 deriving (Show, Eq)

104 deriving (Show, Eq)

104

105