029da07 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Take into account that GMP operations can move data

Need to follow forwarding pointers in case a garbage collection takes place during the operation. Note that there is still a memory leak in the way we use GMP - there is never a call to mpz_clear in the right place.

commit029da074db59e17216a03e38c64d92aaf04bb764 authorEdwin Brady <ecb10@st-andrews.ac.uk> dateTue 5 Nov 2013, 12:15 (13 years ago) parent9e5f23b

4 files changed+18−10

compare with master

unifiedsplit

rts/Makefile+4−2 rts/idris_gmp.c+12−7 src/Core/CaseTree.hs+1 src/IRTS/CodegenC.hs+1−1

rts/Makefile+4−2

@@ -1,7 +1,9 @@

11include ../config.mk

3−OBJS = idris_rts.o idris_heap.o idris_gc.o idris_gmp.o idris_stdfgn.o idris_bitstring.o idris_opts.o idris_stats.o

4−HDRS = idris_rts.h idris_heap.h idris_gc.h idris_gmp.h idris_stdfgn.h idris_bitstring.h idris_opts.h idris_stats.h

3+OBJS = idris_rts.o idris_heap.o idris_gc.o idris_gmp.o idris_stdfgn.o \

4+ idris_bitstring.o idris_opts.o idris_stats.o

5+HDRS = idris_rts.h idris_heap.h idris_gc.h idris_gmp.h idris_stdfgn.h \

6+ idris_bitstring.h idris_opts.h idris_stats.h

57CFLAGS:=-fPIC $(CFLAGS)

68ifneq ($(GMP_INCLUDE_DIR),)

79 CFLAGS += -isystem $(GMP_INCLUDE_DIR)

rts/idris_gmp.c+12−7

@@ -1,5 +1,5 @@

11#include "idris_rts.h"

2−#include <gmp.h>

2+#include <gmp.h>

33#include <stdlib.h>

44#include <string.h>

@@ -92,7 +92,12 @@ VAL GETBIG(VM * vm, VAL x) {

9292

9393 return cl;

9494 } else {

95− return x;

95+ switch(GETTY(x)) {

96+ case FWD:

97+ return GETBIG(vm, x->info.ptr);

98+ default:

99+ return x;

100+ }

96101 }

97102}

98103

@@ -100,7 +105,7 @@ VAL bigAdd(VM* vm, VAL x, VAL y) {

100105 mpz_t* bigint;

101106 VAL cl = allocate(vm, sizeof(Closure) + sizeof(mpz_t), 0);

102107 bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

103− mpz_add(*bigint, GETMPZ(x), GETMPZ(y));

108+ mpz_add(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

104109 SETTY(cl, BIGINT);

105110 cl -> info.ptr = (void*)bigint;

106111 return cl;

@@ -110,7 +115,7 @@ VAL bigSub(VM* vm, VAL x, VAL y) {

110115 mpz_t* bigint;

111116 VAL cl = allocate(vm, sizeof(Closure) + sizeof(mpz_t), 0);

112117 bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

113− mpz_sub(*bigint, GETMPZ(x), GETMPZ(y));

118+ mpz_sub(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

114119 SETTY(cl, BIGINT);

115120 cl -> info.ptr = (void*)bigint;

116121 return cl;

@@ -120,7 +125,7 @@ VAL bigMul(VM* vm, VAL x, VAL y) {

120125 mpz_t* bigint;

121126 VAL cl = allocate(vm, sizeof(Closure) + sizeof(mpz_t), 0);

122127 bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

123− mpz_mul(*bigint, GETMPZ(x), GETMPZ(y));

128+ mpz_mul(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

124129 SETTY(cl, BIGINT);

125130 cl -> info.ptr = (void*)bigint;

126131 return cl;

@@ -130,7 +135,7 @@ VAL bigDiv(VM* vm, VAL x, VAL y) {

130135 mpz_t* bigint;

131136 VAL cl = allocate(vm, sizeof(Closure) + sizeof(mpz_t), 0);

132137 bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

133− mpz_div(*bigint, GETMPZ(x), GETMPZ(y));

138+ mpz_tdiv_q(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

134139 SETTY(cl, BIGINT);

135140 cl -> info.ptr = (void*)bigint;

136141 return cl;

@@ -140,7 +145,7 @@ VAL bigMod(VM* vm, VAL x, VAL y) {

140145 mpz_t* bigint;

141146 VAL cl = allocate(vm, sizeof(Closure) + sizeof(mpz_t), 0);

142147 bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

143− mpz_mod(*bigint, GETMPZ(x), GETMPZ(y));

148+ mpz_mod(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

144149 SETTY(cl, BIGINT);

145150 cl -> info.ptr = (void*)bigint;

146151 return cl;

src/Core/CaseTree.hs+1

@@ -493,6 +493,7 @@ depatt ns tm = dp [] tm

493493 applyMaps ms (App f a) = App (applyMaps ms f) (applyMaps ms a)

494494 applyMaps ms t = t

495495

496+-- FIXME: Do this for SucCase too

496497prune :: Bool -- ^ Convert single branches to projections (only useful at runtime)

497498 -> SC -> SC

498499prune proj (Case n alts)

src/IRTS/CodegenC.hs+1−1

@@ -67,7 +67,7 @@ codegenC defs out exec incs objs libs flags dbg

6767headers xs =

6868 concatMap

6969 (\h -> "#include <" ++ h ++ ">\n")

70− (xs ++ ["idris_rts.h", "idris_bitstring.h", "idris_stdfgn.h", "gmp.h", "assert.h"])

70+ (xs ++ ["idris_rts.h", "idris_bitstring.h", "idris_stdfgn.h", "assert.h"])

7171

7272debug TRACE = "#define IDRIS_TRACE\n\n"

7373debug _ = ""