fe71b95 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Implement primitive memory access functions

Add a Storable interface

commitfe71b951d0ec592034191182a6b853a1da3ddb4e authorNiklas Larsson <niklas@mm.st> dateThu 4 Feb 2016, 18:18 (11 years ago) parent0cbea4a

12 files changed+216−43

compare with master

unifiedsplit

idris.cabal+3 libs/contrib/Data/Storable.idr+41 libs/contrib/contrib.ipkg+2−2 libs/prelude/Builtins.idr+14−4 libs/prelude/IO.idr+38−11 rts/idris_rts.c+41−5 rts/idris_rts.h+12−1 src/IRTS/CodegenC.hs+33−19 test/Makefile+1−1 test/primitives005/expected+2 test/primitives005/primitives005.idr+24 test/primitives005/run+5

idris.cabal+3

@@ -591,6 +591,9 @@ Extra-source-files:

591591 test/primitives003/run

592592 test/primitives003/*.idr

593593 test/primitives003/expected

594+ test/primitives005/run

595+ test/primitives005/*.idr

596+ test/primitives005/expected

594597

595598 test/pkg001/run

596599 test/pkg001/test.ipkg

libs/contrib/Data/Storable.idrnew file+41

@@ -0,0 +1,41 @@

1+module Data.Storable

3+%access public export

5+interface Storable a where

6+ sizeOf : a -> Int

7+ alignOf : a -> Int

8+ peek : Ptr -> Int -> IO a

9+ poke : Ptr -> Int -> a -> IO ()

10+

11+Storable Bits8 where

12+ sizeOf _ = 1

13+ alignOf _ = 1

14+ peek p offset = prim_peek8 p offset

15+ poke p offset val = do

16+ _ <- prim_poke8 p offset val

17+ return ()

18+

19+Storable Bits16 where

20+ sizeOf _ = 2

21+ alignOf _ = 2

22+ peek p offset = prim_peek16 p offset

23+ poke p offset val = do

24+ _ <- prim_poke16 p offset val

25+ return ()

26+

27+Storable Bits32 where

28+ sizeOf _ = 4

29+ alignOf _ = 4

30+ peek p offset = prim_peek32 p offset

31+ poke p offset val = do

32+ _ <- prim_poke32 p offset val

33+ return ()

34+

35+Storable Bits64 where

36+ sizeOf _ = 8

37+ alignOf _ = 8

38+ peek p offset = prim_peek64 p offset

39+ poke p offset val = do

40+ _ <- prim_poke64 p offset val

41+ return ()

libs/contrib/contrib.ipkg+2−2

@@ -9,7 +9,7 @@ modules = Control.Algebra,

99 Control.WellFounded,

1010

1111 Classes.Verified,

12−

12+

1313 Data.Fun, Data.Rel,

1414 Data.Hash,

1515 Data.Matrix, Data.Matrix.Algebraic, Data.Matrix.Numeric,

@@ -18,7 +18,7 @@ modules = Control.Algebra,

1818 Data.BoundedList,

1919 Data.Heap,

2020 Data.SortedMap, Data.SortedSet,

21− Data.CoList,

21+ Data.CoList, Data.Storable,

2222

2323 Decidable.Decidable, Decidable.Order,

2424

libs/prelude/Builtins.idr+14−4

@@ -51,9 +51,9 @@ namespace Builtins

5151

5252||| The empty type, also known as the trivially false proposition.

5353|||

54−||| Use `void` or `absurd` to prove anything if you have a variable of type `Void` in scope.

55−%elim data Void : Type where

56−

54+||| Use `void` or `absurd` to prove anything if you have a variable of type `Void` in scope.

55+%elim data Void : Type where

56+

5757||| The eliminator for the `Void` type.

5858void : Void -> a

5959-- We can't define void yet. We can't define a function with no clauses without

@@ -190,4 +190,14 @@ export data ManagedPtr : Type

190190%extern prim__eqManagedPtr : ManagedPtr -> ManagedPtr -> Int

191191%extern prim__registerPtr : Ptr -> Int -> ManagedPtr

192192

193−

193+-- primitives for accessing memory.

194+%extern prim__asPtr : ManagedPtr -> Ptr

195+%extern prim__peek8 : prim__WorldType -> Ptr -> Int -> Bits8

196+%extern prim__peek16 : prim__WorldType -> Ptr -> Int -> Bits16

197+%extern prim__peek32 : prim__WorldType -> Ptr -> Int -> Bits32

198+%extern prim__peek64 : prim__WorldType -> Ptr -> Int -> Bits64

199+

200+%extern prim__poke8 : prim__WorldType -> Ptr -> Int -> Bits8 -> Int

201+%extern prim__poke16 : prim__WorldType -> Ptr -> Int -> Bits16 -> Int

202+%extern prim__poke32 : prim__WorldType -> Ptr -> Int -> Bits32 -> Int

203+%extern prim__poke64 : prim__WorldType -> Ptr -> Int -> Bits64 -> Int

libs/prelude/IO.idr+38−11

@@ -12,7 +12,6 @@ data PrimIO : Type -> Type where

1212||| A token representing the world, for use in `IO`

1313data World = TheWorld prim__WorldType

1414

15−private

1615world : World -> prim__WorldType

1716world (TheWorld w) = w

1817

@@ -47,16 +46,16 @@ namespace ForeignEnv

4746 data FEnv : FFI -> List Type -> Type where

4847 Nil : FEnv f []

4948 (::) : (ffi_types f t, t) -> FEnv f xs -> FEnv f (t :: xs)

50−

49+

5150ForeignPrimType : (xs : List Type) -> FEnv ffi xs -> Type -> Type

5251ForeignPrimType {ffi} [] [] t = World -> ffi_fn ffi -> ffi_types ffi t -> PrimIO t

53−ForeignPrimType {ffi} (x :: xs) ((a, _) :: env) t

52+ForeignPrimType {ffi} (x :: xs) ((a, _) :: env) t

5453 = (ffi_types ffi x, x) -> ForeignPrimType xs env t

5554

5655%inline

5756private

58−applyEnv : (env : FEnv ffi xs) ->

59− ForeignPrimType xs env t ->

57+applyEnv : (env : FEnv ffi xs) ->

58+ ForeignPrimType xs env t ->

6059 World -> ffi_fn ffi -> ffi_types ffi t -> PrimIO t

6160applyEnv [] f = f

6261applyEnv (x@(_, _) :: xs) f = applyEnv xs (f x)

@@ -68,7 +67,7 @@ mkForeignPrim : {xs : _} -> {ffi : _} -> {env : FEnv ffi xs} -> {t : Type} ->

6867

6968%inline

7069private

71−foreign_prim : (f : FFI) ->

70+foreign_prim : (f : FFI) ->

7271 (fname : ffi_fn f) -> FTy f xs ty -> FEnv f xs -> ty

7372foreign_prim f fname (FRet y) env

7473 = MkIO (\w => applyEnv env mkForeignPrim w fname y)

@@ -129,14 +128,14 @@ prim_read : IO' l String

129128prim_read = MkIO (\w => prim_io_return (prim__readString (world w)))

130129

131130prim_write : String -> IO' l Int

132−prim_write s

131+prim_write s

133132 = MkIO (\w => prim_io_return (prim__writeString (world w) s))

134133

135134prim_fread : Ptr -> IO' l String

136135prim_fread h = MkIO (\w => prim_io_return (prim__readFile (world w) h))

137136

138137prim_fwrite : Ptr -> String -> IO' l Int

139−prim_fwrite h s

138+prim_fwrite h s

140139 = MkIO (\w => prim_io_return (prim__writeFile (world w) h s))

141140

142141--------- The C FFI

@@ -178,7 +177,7 @@ namespace FFI_C

178177 FFI_C = MkFFI C_Types String String

179178

180179||| Interactive programs, describing I/O actions and returning a value.

181−||| @res The result type of the program

180+||| @res The result type of the program

182181%error_reverse

183182public export

184183IO : (res : Type) -> Type

@@ -285,9 +284,9 @@ namespace FFI_Export

285284

286285 public export

287286 data FFI_Export : (f : FFI) -> String -> List (Type, ffi_data f) -> Type where

288− Data : (x : Type) -> (n : ffi_data f) ->

287+ Data : (x : Type) -> (n : ffi_data f) ->

289288 (es : FFI_Export f h ((x, n) :: xs)) -> FFI_Export f h xs

290− Fun : (fn : t) -> (n : ffi_fn f) -> {auto prf : FFI_Exportable f xs t} ->

289+ Fun : (fn : t) -> (n : ffi_fn f) -> {auto prf : FFI_Exportable f xs t} ->

291290 (es : FFI_Export f h xs) -> FFI_Export f h xs

292291 End : FFI_Export f h xs

293292

@@ -299,3 +298,31 @@ namespace FFI_Export

299298%used Fun es

300299%used Fun prf

301300

301+-- Accessing memory

302+prim_peek8 : Ptr -> Int -> IO Bits8

303+prim_peek8 ptr offset = MkIO (\w => prim_io_return (prim__peek8 (world w) ptr offset))

304+

305+prim_poke8 : Ptr -> Int -> Bits8 -> IO Int

306+prim_poke8 ptr offset val = MkIO (\w => prim_io_return (

307+ prim__poke8 (world w) ptr offset val))

308+

309+prim_peek16 : Ptr -> Int -> IO Bits16

310+prim_peek16 ptr offset = MkIO (\w => prim_io_return (prim__peek16 (world w) ptr offset))

311+

312+prim_poke16 : Ptr -> Int -> Bits16 -> IO Int

313+prim_poke16 ptr offset val = MkIO (\w => prim_io_return (

314+ prim__poke16 (world w) ptr offset val))

315+

316+prim_peek32 : Ptr -> Int -> IO Bits32

317+prim_peek32 ptr offset = MkIO (\w => prim_io_return (prim__peek32 (world w) ptr offset))

318+

319+prim_poke32 : Ptr -> Int -> Bits32 -> IO Int

320+prim_poke32 ptr offset val = MkIO (\w => prim_io_return (

321+ prim__poke32 (world w) ptr offset val))

322+

323+prim_peek64 : Ptr -> Int -> IO Bits64

324+prim_peek64 ptr offset = MkIO (\w => prim_io_return (prim__peek64 (world w) ptr offset))

325+

326+prim_poke64 : Ptr -> Int -> Bits64 -> IO Int

327+prim_poke64 ptr offset val = MkIO (\w => prim_io_return (

328+ prim__poke64 (world w) ptr offset val))

rts/idris_rts.c+41−5

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

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

114114 pthread_cond_destroy(&(vm -> inbox_waiting));

115115#endif

116− // free(vm);

116+ // free(vm);

117117 // Set the VM as inactive, so that if any message gets sent to it

118118 // it will not get there, rather than crash the entire system.

119119 // (TODO: We really need to be cleverer than this if we're going to

@@ -414,6 +414,42 @@ void idris_poke(void* ptr, i_int offset, uint8_t data) {

414414 *(((uint8_t*)ptr) + offset) = data;

415415}

416416

417+VAL idris_peekB8(VM* vm, VAL ptr, VAL offset) {

418+ return MKB8(vm, *(uint8_t*)(GETPTR(ptr) + GETINT(offset)));

419+}

420+

421+VAL idris_pokeB8(VAL ptr, VAL offset, VAL data) {

422+ *(uint8_t*)(GETPTR(ptr) + GETINT(offset)) = GETBITS8(data);

423+ return MKINT(0);

424+}

425+

426+VAL idris_peekB16(VM* vm, VAL ptr, VAL offset) {

427+ return MKB16(vm, *(uint16_t*)(GETPTR(ptr) + GETINT(offset)));

428+}

429+

430+VAL idris_pokeB16(VAL ptr, VAL offset, VAL data) {

431+ *(uint16_t*)(GETPTR(ptr) + GETINT(offset)) = GETBITS16(data);

432+ return MKINT(0);

433+}

434+

435+VAL idris_peekB32(VM* vm, VAL ptr, VAL offset) {

436+ return MKB32(vm, *(uint32_t*)(GETPTR(ptr) + GETINT(offset)));

437+}

438+

439+VAL idris_pokeB32(VAL ptr, VAL offset, VAL data) {

440+ *(uint32_t*)(GETPTR(ptr) + GETINT(offset)) = GETBITS32(data);

441+ return MKINT(0);

442+}

443+

444+VAL idris_peekB64(VM* vm, VAL ptr, VAL offset) {

445+ return MKB64(vm, *(uint64_t*)(GETPTR(ptr) + GETINT(offset)));

446+}

447+

448+VAL idris_pokeB64(VAL ptr, VAL offset, VAL data) {

449+ *(uint64_t*)(GETPTR(ptr) + GETINT(offset)) = GETBITS64(data);

450+ return MKINT(0);

451+}

452+

417453void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size) {

418454 memmove(dest + dest_offset, src + src_offset, size);

419455}

@@ -789,12 +825,12 @@ int idris_sendMessage(VM* sender, VM* dest, VAL msg) {

789825 }

790826

791827 pthread_mutex_lock(&(dest->inbox_lock));

792−

828+

793829 if (dest->inbox_write >= dest->inbox_end) {

794830 // FIXME: This is obviously bad in the long run. This should

795831 // either block, make the inbox bigger, or return an error code,

796832 // or possibly make it user configurable

797− fprintf(stderr, "Inbox full");

833+ fprintf(stderr, "Inbox full");

798834 exit(-1);

799835 }

800836

@@ -820,7 +856,7 @@ VM* idris_checkMessages(VM* vm) {

820856

821857VM* idris_checkMessagesFrom(VM* vm, VM* sender) {

822858 Msg* msg;

823−

859+

824860 for (msg = vm->inbox; msg < vm->inbox_end && msg->msg != NULL; ++msg) {

825861 if (sender == NULL || msg->sender == sender) {

826862 return msg->sender;

@@ -854,7 +890,7 @@ VM* idris_checkMessagesTimeout(VM* vm, int delay) {

854890

855891Msg* idris_getMessageFrom(VM* vm, VM* sender) {

856892 Msg* msg;

857−

893+

858894 for (msg = vm->inbox; msg < vm->inbox_write; ++msg) {

859895 if (sender == NULL || msg->sender == sender) {

860896 return msg;

rts/idris_rts.h+12−1

@@ -304,9 +304,20 @@ VAL idris_castStrFloat(VM* vm, VAL i);

304304

305305// Raw memory manipulation

306306void idris_memset(void* ptr, i_int offset, uint8_t c, i_int size);

307+void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size);

307308uint8_t idris_peek(void* ptr, i_int offset);

308309void idris_poke(void* ptr, i_int offset, uint8_t data);

309−void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size);

310+

311+

312+// memory access

313+VAL idris_peekB8(VM* vm, VAL ptr, VAL offset);

314+VAL idris_pokeB8(VAL ptr, VAL offset, VAL data);

315+VAL idris_peekB16(VM* vm, VAL ptr, VAL offset);

316+VAL idris_pokeB16(VAL ptr, VAL offset, VAL data);

317+VAL idris_peekB32(VM* vm, VAL ptr, VAL offset);

318+VAL idris_pokeB32(VAL ptr, VAL offset, VAL data);

319+VAL idris_peekB64(VM* vm, VAL ptr, VAL offset);

320+VAL idris_pokeB64(VAL ptr, VAL offset, VAL data);

310321

311322// String primitives

312323VAL idris_concat(VM* vm, VAL l, VAL r);

src/IRTS/CodegenC.hs+33−19

@@ -48,7 +48,7 @@ codegenC' :: [(Name, SDecl)] ->

4848 [String] -> -- extra object files

4949 [String] -> -- extra compiler flags (libraries)

5050 [String] -> -- extra compiler flags (anything)

51− [ExportIFace] ->

51+ [ExportIFace] ->

5252 Bool -> -- interfaces too (so make a .o instead)

5353 DbgLevel ->

5454 IO ()

@@ -153,7 +153,7 @@ showCStr s = '"' : foldr ((++) . showChar) "\"" s

153153 headHex h (length bytes) : map toHex bytes

154154 where

155155 split acc 0 = acc

156− split acc x = let xbits = x .&. 0x3f

156+ split acc x = let xbits = x .&. 0x3f

157157 xrest = shiftR x 6 in

158158 split (xbits : acc) xrest

159159

@@ -185,7 +185,7 @@ bcc i (ASSIGNCONST l c)

185185 -- if it's a type constant, we won't use it, but equally it shouldn't

186186 -- report an error. These might creep into generated for various reasons

187187 -- (especially if erasure is disabled).

188− mkConst c | isTypeConst c = "MKINT(42424242)"

188+ mkConst c | isTypeConst c = "MKINT(42424242)"

189189 mkConst c = error $ "mkConst of (" ++ show c ++ ") not implemented"

190190

191191bcc i (UPDATE l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"

@@ -328,7 +328,7 @@ bcc i (ERROR str) = indent i ++ "fprintf(stderr, " ++ show str ++ "); fprintf(st

328328

329329-- Deconstruct the Foreign type in the defunctionalised expression and build

330330-- a foreign type description for c_irts and irts_c

331−toAType (FCon i)

331+toAType (FCon i)

332332 | i == sUN "C_IntChar" = ATInt ITChar

333333 | i == sUN "C_IntNative" = ATInt ITNative

334334 | i == sUN "C_IntBits8" = ATInt (ITFixed IT8)

@@ -337,15 +337,15 @@ toAType (FCon i)

337337 | i == sUN "C_IntBits64" = ATInt (ITFixed IT64)

338338toAType t = error (show t ++ " not defined in toAType")

339339

340−toFType (FCon c)

340+toFType (FCon c)

341341 | c == sUN "C_Str" = FString

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

343343 | c == sUN "C_Ptr" = FPtr

344344 | c == sUN "C_MPtr" = FManagedPtr

345345 | c == sUN "C_Unit" = FUnit

346−toFType (FApp c [_,ity])

346+toFType (FApp c [_,ity])

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

348−toFType (FApp c [_])

348+toFType (FApp c [_])

349349 | c == sUN "C_Any" = FAny

350350toFType t = FAny

351351

@@ -551,7 +551,7 @@ doOp v LStrLt [l,r] = v ++ "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

551551doOp v LStrEq [l,r] = v ++ "idris_streq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

552552

553553doOp v LReadStr [_] = v ++ "idris_readStr(vm, stdin)"

554−doOp v LWriteStr [_,s]

554+doOp v LWriteStr [_,s]

555555 = v ++ "MKINT((i_int)(idris_writeStr(stdout"

556556 ++ ",GETSTR("

557557 ++ creg s ++ "))))"

@@ -577,10 +577,10 @@ doOp v LSystemInfo [x] = v ++ "idris_systemInfo(vm, " ++ creg x ++ ")"

577577doOp v LNoOp args = v ++ creg (last args)

578578

579579-- Pointer primitives (declared as %extern in Builtins.idr)

580−doOp v (LExternal rf) [_,x]

580+doOp v (LExternal rf) [_,x]

581581 | rf == sUN "prim__readFile"

582582 = v ++ "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"

583−doOp v (LExternal wf) [_,x,s]

583+doOp v (LExternal wf) [_,x,s]

584584 | wf == sUN "prim__writeFile"

585585 = v ++ "MKINT((i_int)(idris_writeStr(GETPTR(" ++ creg x

586586 ++ "),GETSTR("

@@ -591,15 +591,32 @@ doOp v (LExternal so) [] | so == sUN "prim__stdout" = v ++ "MKPTR(vm, stdout)"

591591doOp v (LExternal se) [] | se == sUN "prim__stderr" = v ++ "MKPTR(vm, stderr)"

592592

593593doOp v (LExternal nul) [] | nul == sUN "prim__null" = v ++ "MKPTR(vm, NULL)"

594−doOp v (LExternal eqp) [x, y] | eqp == sUN "prim__eqPtr"

594+doOp v (LExternal eqp) [x, y] | eqp == sUN "prim__eqPtr"

595595 = v ++ "MKINT((i_int)(GETPTR(" ++ creg x ++ ") == GETPTR(" ++ creg y ++ ")))"

596−doOp v (LExternal eqp) [x, y] | eqp == sUN "prim__eqManagedPtr"

596+doOp v (LExternal eqp) [x, y] | eqp == sUN "prim__eqManagedPtr"

597597 = v ++ "MKINT((i_int)(GETMPTR(" ++ creg x ++ ") == GETMPTR(" ++ creg y ++ ")))"

598598doOp v (LExternal rp) [p, i] | rp == sUN "prim__registerPtr"

599599 = v ++ "MKMPTR(vm, GETPTR(" ++ creg p ++ "), GETINT(" ++ creg i ++ "))"

600−

600+doOp v (LExternal pk) [_, p, o] | pk == sUN "prim__peek8"

601+ = v ++ "idris_peekB8(vm," ++ creg p ++ "," ++ creg o ++")"

602+doOp v (LExternal pk) [_, p, o, x] | pk == sUN "prim__poke8"

603+ = v ++ "idris_pokeB8(" ++ creg p ++ "," ++ creg o ++ "," ++ creg x ++ ")"

604+doOp v (LExternal pk) [_, p, o] | pk == sUN "prim__peek16"

605+ = v ++ "idris_peekB16(vm," ++ creg p ++ "," ++ creg o ++")"

606+doOp v (LExternal pk) [_, p, o, x] | pk == sUN "prim__poke16"

607+ = v ++ "idris_pokeB16(" ++ creg p ++ "," ++ creg o ++ "," ++ creg x ++ ")"

608+doOp v (LExternal pk) [_, p, o] | pk == sUN "prim__peek32"

609+ = v ++ "idris_peekB32(vm," ++ creg p ++ "," ++ creg o ++")"

610+doOp v (LExternal pk) [_, p, o, x] | pk == sUN "prim__poke32"

611+ = v ++ "idris_pokeB32(" ++ creg p ++ "," ++ creg o ++ "," ++ creg x ++ ")"

612+doOp v (LExternal pk) [_, p, o] | pk == sUN "prim__peek64"

613+ = v ++ "idris_peekB64(vm," ++ creg p ++ "," ++ creg o ++")"

614+doOp v (LExternal pk) [_, p, o, x] | pk == sUN "prim__poke64"

615+ = v ++ "idris_pokeB64(" ++ creg p ++ "," ++ creg o ++ "," ++ creg x ++ ")"

616+doOp v (LExternal mpt) [p] | mpt == sUN "prim__asPtr" = v ++ "MKPTR(vm, GETMPTR("++ creg p ++"))"

601617doOp _ op args = error $ "doOp not implemented (" ++ show (op, args) ++ ")"

602618

619+

603620flUnOp :: String -> String -> String

604621flUnOp name val = "MKFLOAT(vm, " ++ name ++ "(GETFLOAT(" ++ val ++ ")))"

605622

@@ -610,7 +627,7 @@ flUnOp name val = "MKFLOAT(vm, " ++ name ++ "(GETFLOAT(" ++ val ++ ")))"

610627ifaceC :: Export -> String

611628ifaceC (ExportData n) = "typedef VAL " ++ cdesc n ++ ";\n"

612629ifaceC (ExportFun n cn ret args)

613− = ctype ret ++ " " ++ cdesc cn ++

630+ = ctype ret ++ " " ++ cdesc cn ++

614631 "(VM* vm" ++ showArgs (zip argNames args) ++ ") {\n"

615632 ++ mkBody n (zip argNames args) ret ++ "}\n\n"

616633 where showArgs [] = ""

@@ -623,7 +640,7 @@ mkBody n as t = indent 1 ++ "INITFRAME;\n" ++

623640 indent 1 ++ "RESERVE(" ++ show (max (length as) 3) ++ ");\n" ++

624641 push 0 as ++ call n ++ retval t

625642 where push i [] = ""

626− push i ((n, t) : ts) = indent 1 ++ c_irts (toFType t)

643+ push i ((n, t) : ts) = indent 1 ++ c_irts (toFType t)

627644 ("TOP(" ++ show i ++ ") = ") n

628645 ++ ";\n" ++ push (i + 1) ts

629646

@@ -689,13 +706,10 @@ hdr_guard x = "__" ++ map hchar x

689706hdr_export :: Export -> String

690707hdr_export (ExportData n) = "typedef VAL " ++ cdesc n ++ ";\n"

691708hdr_export (ExportFun n cn ret args)

692− = ctype ret ++ " " ++ cdesc cn ++

709+ = ctype ret ++ " " ++ cdesc cn ++

693710 "(VM* vm" ++ showArgs (zip argNames args) ++ ");\n"

694711 where showArgs [] = ""

695712 showArgs ((n, t) : ts) = ", " ++ ctype t ++ " " ++ n ++

696713 showArgs ts

697714

698715 argNames = zipWith (++) (repeat "arg") (map show [0..])

699−

700−

701−

test/Makefile+1−1

@@ -12,7 +12,7 @@ info: runtest

1212 @./runtest $(patsubst %.test,%,$@) -q

1313

1414test_js: runtest

15− @./runtest without sugar004 reg029 reg052 io001 dsl002 io003 effects001 effects002 basic007 basic011 ffi006 opts --codegen node

15+ @./runtest without sugar004 reg029 reg052 io001 dsl002 io003 effects001 effects002 basic007 basic011 ffi006 primitives005 opts --codegen node

1616

1717update: runtest

1818 @./runtest all -u

test/primitives005/expectednew file+2

@@ -0,0 +1,2 @@

1+04030201

2+000000000000FFFF

test/primitives005/primitives005.idrnew file+24

@@ -0,0 +1,24 @@

1+module Main

3+%include C "memory.h"

5+-- use calloc to ensure zeroed out memory

6+malloc : Int -> IO Ptr

7+malloc size = foreign FFI_C "calloc" (Int -> Int -> IO Ptr) size 1

9+free : Ptr -> IO ()

10+free ptr = foreign FFI_C "free" (Ptr -> IO ()) ptr

11+

12+main : IO ()

13+main = do

14+ p <- malloc 1000

15+ prim_poke16 p 0 0xffff

16+ prim_poke8 p 8 1

17+ prim_poke8 p 9 2

18+ prim_poke8 p 10 3

19+ prim_poke8 p 11 4

20+ a <- prim_peek32 p 8

21+ b <- prim_peek64 p 0

22+ printLn a

23+ printLn b

24+ free p

test/primitives005/runnew file+5

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

1+#!/usr/bin/env bash

2+${IDRIS:-idris} $@ -o p005 primitives005.idr --nocolour

3+./p005

4+rm -f p005 *.ibc