ba99edd · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge remote-tracking branch 'idris-lang/master'

ba99eddOling Cat9 years ago

.hlint.yamlnew file+61

compare with master

unifiedsplit

@@ -0,0 +1,61 @@

1+# HLint configuration file

2+# https://github.com/ndmitchell/hlint

3+##########################

5+# This file contains a template configuration file, which is typically

6+# placed as .hlint.yaml in the root of your project

9+# Specify additional command line arguments

10+#

11+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]

12+

13+

14+# Control which extensions/flags/modules/functions can be used

15+#

16+# - extensions:

17+# - default: false # all extension are banned by default

18+# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used

19+# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module

20+#

21+# - flags:

22+# - {name: -w, within: []} # -w is allowed nowhere

23+#

24+# - modules:

25+# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'

26+# - {name: Control.Arrow, within: []} # Certain modules are banned entirely

27+#

28+# - functions:

29+# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules

30+

31+

32+# Add custom hints for this project

33+#

34+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"

35+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}

36+

37+

38+# Turn on hints that are off by default

39+#

40+# Ban "module X(module X) where", to require a real export list

41+# - warn: {name: Use explicit module export list}

42+#

43+# Replace a $ b $ c with a . b $ c

44+# - group: {name: dollar, enabled: true}

45+#

46+# Generalise map to fmap, ++ to <>

47+# - group: {name: generalise, enabled: true}

48+

49+

50+# Ignore some builtin hints

51+# - ignore: {name: Use let}

52+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules

53+- ignore: {name: Use camelCase}

54+- ignore: {name: Reduce duplication}

55+

56+# Define some custom infix operators

57+# - fixity: infixr 3 ~^#^~

58+

59+

60+# To generate a suitable file for HLint do:

61+# $ hlint --default > .hlint.yaml

CHANGELOG.md+2

@@ -18,6 +18,8 @@

18+ Added a switch `--allow-capitalized-pattern-variables` to optionally allow capitalized pattern variables after they were prohibited in 1.2.0.

19+ REPL now prints an error message if program compiled by `:exec` terminates

20 abnormally.

21++ Idris now builds with GHC 8.4.

22++ In the C backend, the representation of Idris values at runtime has been reworked.

22# New in 1.2.0

24# New in 1.2.0

CONTRIBUTORS+1

@@ -126,6 +126,7 @@ Jonas De Vuyst

126Jonas Westerlund

127Jonathan Sterling

128Joomy Korkut

129+Jorge Acereda

129Joseph Huang

130Joseph Huang

130Josh Vera

131Josh Vera

131JP Smith

132JP Smith

HLint.hsdeleted−34

@@ -1,34 +0,0 @@

1−{-# LANGUAGE TemplateHaskell #-}

2−-- --------------------------------------------------------------- [ HLint.hs ]

3−-- HLint suggestions we like.

4−--

5−-- This is a work in progress and the list of

6−-- suggestions/warnings/errors will vary.

7−--

8−-- -------------------------------------------------------------------- [ EOH ]

9−

10−-- import "hint" HLint.HLint -- In case we want to use all of them.

11−

12−-- ------------------------------------------------------------ [ Suggestions ]

13−-- Styling that are good Suggestions but are okay if found.

14−

15−suggest "Use exitSuccess"

16−suggest "Use concatMap"

17−suggest "Use unwords"

18−suggest "Use null"

19−suggest "Redundant $"

20−suggest "Use list literal pattern"

21−suggest "Use list literal"

22−

23−-- ------------------------------------------------------------------- [ Warn ]

24−-- Styling that we think a programmer should be warned about using.

25−

26−

27−-- ------------------------------------------------------------------ [ Error ]

28−-- Styling that we think a programmer should not use at all.

29−

30−

31−-- ----------------------------------------------------------------- [ Ignore ]

32−-- Suggestions we want to ignore.

33−

34−-- -------------------------------------------------------------------- [ EOF ]

Setup.hs+19−9

@@ -14,7 +14,7 @@ import Distribution.Simple.InstallDirs as I

14import Distribution.Simple.LocalBuildInfo as L

15import qualified Distribution.Simple.Setup as S

16import qualified Distribution.Simple.Program as P

17−import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile, notice, installOrdinaryFiles)

17+import Distribution.Simple.Utils

18import Distribution.Compiler

19import Distribution.PackageDescription

20import Distribution.Text

@@ -66,28 +66,28 @@ windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation

67usesGMP :: S.ConfigFlags -> Bool

68usesGMP flags =

69− case lookup (mkFlagName "gmp") (S.configConfigurationsFlags flags) of

69+ case lookupFlagAssignment (mkFlagName "gmp") (S.configConfigurationsFlags flags) of

70 Just True -> True

71 Just False -> False

72 Nothing -> False

74execOnly :: S.ConfigFlags -> Bool

75execOnly flags =

76− case lookup (mkFlagName "execonly") (S.configConfigurationsFlags flags) of

76+ case lookupFlagAssignment (mkFlagName "execonly") (S.configConfigurationsFlags flags) of

77 Just True -> True

78 Just False -> False

79 Nothing -> False

81isRelease :: S.ConfigFlags -> Bool

82isRelease flags =

83− case lookup (mkFlagName "release") (S.configConfigurationsFlags flags) of

83+ case lookupFlagAssignment (mkFlagName "release") (S.configConfigurationsFlags flags) of

84 Just True -> True

85 Just False -> False

86 Nothing -> False

88isFreestanding :: S.ConfigFlags -> Bool

89isFreestanding flags =

90− case lookup (mkFlagName "freestanding") (S.configConfigurationsFlags flags) of

90+ case lookupFlagAssignment (mkFlagName "freestanding") (S.configConfigurationsFlags flags) of

91 Just True -> True

92 Just False -> False

93 Nothing -> False

@@ -97,6 +97,11 @@ mkFlagName :: String -> FlagName

97mkFlagName = FlagName

98#endif

100+#if !(MIN_VERSION_Cabal(2,2,0))

101+lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool

102+lookupFlagAssignment = lookup

103+#endif

104+

100-- -----------------------------------------------------------------------------

105-- -----------------------------------------------------------------------------

101-- Clean

106-- Clean

102

107

@@ -123,7 +128,7 @@ generateBuildFlagsModule verbosity dir libdirs = do

123 let buildFlagsModulePath = dir </> "BuildFlags_idris" Px.<.> "hs"

128 let buildFlagsModulePath = dir </> "BuildFlags_idris" Px.<.> "hs"

124 putStrLn $ "Generating " ++ buildFlagsModulePath

129 putStrLn $ "Generating " ++ buildFlagsModulePath

125 createDirectoryIfMissingVerbose verbosity True dir

130 createDirectoryIfMissingVerbose verbosity True dir

126− rewriteFile buildFlagsModulePath contents

131+ rewriteFileEx verbosity buildFlagsModulePath contents

127 where contents = "module BuildFlags_idris where \n\n" ++

132 where contents = "module BuildFlags_idris where \n\n" ++

128 "extraLibDirs :: [String]\n" ++

133 "extraLibDirs :: [String]\n" ++

129 "extraLibDirs = " ++ show libdirs

134 "extraLibDirs = " ++ show libdirs

@@ -136,7 +141,7 @@ generateVersionModule verbosity dir release = do

136 putStrLn $ "Generating " ++ versionModulePath ++

141 putStrLn $ "Generating " ++ versionModulePath ++

137 if release then " for release" else " for prerelease " ++ hash

142 if release then " for release" else " for prerelease " ++ hash

138 createDirectoryIfMissingVerbose verbosity True dir

143 createDirectoryIfMissingVerbose verbosity True dir

139− rewriteFile versionModulePath (versionModuleContents hash)

144+ rewriteFileEx verbosity versionModulePath (versionModuleContents hash)

140

145

141 where versionModuleContents h = "module Version_idris where\n\n" ++

146 where versionModuleContents h = "module Version_idris where\n\n" ++

142 "gitHash :: String\n" ++

147 "gitHash :: String\n" ++

@@ -150,7 +155,7 @@ generateTargetModule verbosity dir targetDir = do

150 let targetModulePath = dir </> "Target_idris" Px.<.> "hs"

155 let targetModulePath = dir </> "Target_idris" Px.<.> "hs"

151 putStrLn $ "Generating " ++ targetModulePath

156 putStrLn $ "Generating " ++ targetModulePath

152 createDirectoryIfMissingVerbose verbosity True dir

157 createDirectoryIfMissingVerbose verbosity True dir

153− rewriteFile targetModulePath (versionModuleContents absPath targetDir)

158+ rewriteFileEx verbosity targetModulePath (versionModuleContents absPath targetDir)

154 where versionModuleContents absolute td = "module Target_idris where\n\n" ++

159 where versionModuleContents absolute td = "module Target_idris where\n\n" ++

155 "import System.FilePath\n" ++

160 "import System.FilePath\n" ++

156 "import System.Environment\n" ++

161 "import System.Environment\n" ++

@@ -176,7 +181,7 @@ generateToolchainModule verbosity srcDir toolDir = do

176 "getToolchainDir = \"\""

181 "getToolchainDir = \"\""

177 let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"

182 let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"

178 createDirectoryIfMissingVerbose verbosity True srcDir

183 createDirectoryIfMissingVerbose verbosity True srcDir

179− rewriteFile toolPath (commonContent ++ toolContent)

184+ rewriteFileEx verbosity toolPath (commonContent ++ toolContent)

180

185

181idrisConfigure _ flags pkgdesc local = do

186idrisConfigure _ flags pkgdesc local = do

182 configureRTS

187 configureRTS

@@ -240,6 +245,11 @@ idrisPostSDist args flags desc lbi = do

240 (\e -> let e' = (e :: SomeException) in return ())

245 (\e -> let e' = (e :: SomeException) in return ())

241 postSDist simpleUserHooks args flags desc lbi

246 postSDist simpleUserHooks args flags desc lbi

242

247

248+#if !(MIN_VERSION_Cabal(2,0,0))

249+rewriteFileEx :: Verbosity -> FilePath -> String -> IO ()

250+rewriteFileEx _ = rewriteFile

251+#endif

252+

243-- -----------------------------------------------------------------------------

253-- -----------------------------------------------------------------------------

244-- Build

254-- Build

245

255

benchmarks/build.pl+3−2

@@ -2,13 +2,14 @@

3$bmarks = `cat ALL`;

4@bm = split(/\n/, $bmarks);

5+$idris = $ENV{'IDRIS'} || "idris";

6foreach $b (@bm) {

7foreach $b (@bm) {

7 if ($b =~ /([a-zA-Z0-9]+)\/([a-zA-Z0-9]+)\s+(.*)/) {

8 if ($b =~ /([a-zA-Z0-9]+)\/([a-zA-Z0-9]+)\s+(.*)/) {

8 print "Building $1 / $2\n";

9 print "Building $1 / $2\n";

9 chdir $1;

10 chdir $1;

10− system("idris --clean $2.ipkg");

11+ system("$idris --clean $2.ipkg");

11− system("idris --build $2.ipkg") == 0 or die "Unable to build $2: $?";

12+ system("$idris --build $2.ipkg") == 0 or die "Unable to build $2: $?";

12 chdir "..";

13 chdir "..";

13 }

14 }

14}

15}

idris.cabal+2−2

@@ -100,7 +100,7 @@ source-repository head

100

101custom-setup

102 setup-depends:

103− Cabal >= 1.10 && <2.1,

103+ Cabal >= 1.10 && <2.3,

104 base >= 4 && <5,

105 directory,

106 filepath,

@@ -309,7 +309,7 @@ Library

309 , vector-binary-instances < 0.3

310 , zip-archive > 0.2.3.5 && < 0.4

311 , fsnotify >= 0.2 && < 2.2

312− , async < 2.2

312+ , async < 2.3

313

314 if !impl(ghc >= 8.0)

315 Build-Depends: semigroups == 0.18.*

libs/base/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

2PKG := base

4build:

libs/contrib/CFFI/Types.idr+2−2

@@ -70,9 +70,9 @@ mutual

70 alignOfCT I8 = 1

71 alignOfCT I16 = 2

72 alignOfCT I32 = 4

73− alignOfCT I64 = 8

73+ alignOfCT I64 = min prim__sizeofPtr 8

74 alignOfCT FLOAT = 4

75− alignOfCT DOUBLE = 8

75+ alignOfCT DOUBLE = min prim__sizeofPtr 8

76 alignOfCT PTR = prim__sizeofPtr

78 ||| Alignment requirement of the type

libs/contrib/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

2PKG := contrib

4build:

libs/contrib/Network/Socket.idr+20−1

@@ -133,7 +133,7 @@ send sock dat = do

133||| + `ResultCode` :: The result of the underlying function.

134|||

135||| @sock The socket on which to receive the message.

136−||| @len How much of the data to send.

136+||| @len How much of the data to receive.

137recv : (sock : Socket)

138 -> (len : ByteLength)

139 -> IO (Either SocketError (String, ResultCode))

@@ -164,6 +164,25 @@ recv sock len = do

164 freeRecvStruct (RSPtr recv_struct_ptr)

165 pure $ Right (payload, recv_res)

166

167+||| Receive all the remaining data on the specified socket.

168+|||

169+||| Returns on failure a `SocketError`

170+||| Returns on success the payload `String`

171+|||

172+||| @sock The socket on which to receive the message.

173+partial

174+recvAll : (sock : Socket) -> IO (Either SocketError String)

175+recvAll sock = recvRec sock [] 64

176+ where

177+ partial

178+ recvRec : Socket -> List String -> ByteLength -> IO (Either SocketError String)

179+ recvRec sock acc n = do res <- recv sock n

180+ case res of

181+ Left 0 => pure (Right $ concat $ reverse acc)

182+ Left c => pure (Left c)

183+ Right (str, _) => let n' = min (n * 2) 65536 in

184+ recvRec sock (str :: acc) n'

185+

167||| Send a message.

186||| Send a message.

168|||

187|||

169||| Returns on failure a `SocketError`

188||| Returns on failure a `SocketError`

libs/effects/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

2PKG := effects

4build:

libs/prelude/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

2PKG := prelude

4build:

libs/pruviloj/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

2PKG := pruviloj

4build:

rts/Makefile+1−1

@@ -40,6 +40,6 @@ install :

40clean :

41 rm -f $(OBJS) $(LIBTARGET) $(DYLIBTARGET)

43−idris_rts.o: idris_rts.h

43+$(OBJS): $(HDRS)

45.PHONY: build install clean

rts/idris_bitstring.c+251−511

@@ -2,824 +2,564 @@

3#include "idris_rts.h"

5−VAL idris_b8CopyForGC(VM *vm, VAL a) {

5+VAL idris_b8const(VM *vm, uint8_t a) {

6− uint8_t A = a->info.bits8;

6+ Bits8 * cl = iallocate(vm, sizeof(*cl), 0);

7− VAL cl = allocate(sizeof(Closure), 1);

8 SETTY(cl, CT_BITS8);

7 SETTY(cl, CT_BITS8);

9− cl->info.bits8 = A;

8+ cl->bits8 = a;

10− return cl;

9+ return (VAL)cl;

11}

10}

13−VAL idris_b16CopyForGC(VM *vm, VAL a) {

12+VAL idris_b16const(VM *vm, uint16_t a) {

14− uint16_t A = a->info.bits16;

13+ Bits16 * cl = iallocate(vm, sizeof(*cl), 0);

15− VAL cl = allocate(sizeof(Closure), 1);

16 SETTY(cl, CT_BITS16);

14 SETTY(cl, CT_BITS16);

17− cl->info.bits16 = A;

15+ cl->bits16 = a;

18− return cl;

16+ return (VAL)cl;

19}

17}

21−VAL idris_b32CopyForGC(VM *vm, VAL a) {

19+VAL idris_b32const(VM *vm, uint32_t a) {

22− uint32_t A = a->info.bits32;

20+ Bits32 * cl = iallocate(vm, sizeof(*cl), 0);

23− VAL cl = allocate(sizeof(Closure), 1);

24 SETTY(cl, CT_BITS32);

21 SETTY(cl, CT_BITS32);

25− cl->info.bits32 = A;

22+ cl->bits32 = a;

26− return cl;

23+ return (VAL)cl;

27}

24}

29−VAL idris_b64CopyForGC(VM *vm, VAL a) {

26+VAL idris_b64const(VM *vm, uint64_t a) {

30− uint64_t A = a->info.bits64;

27+ Bits64 * cl = iallocate(vm, sizeof(*cl), 0);

31− VAL cl = allocate(sizeof(Closure), 1);

32 SETTY(cl, CT_BITS64);

28 SETTY(cl, CT_BITS64);

33− cl->info.bits64 = A;

29+ cl->bits64 = a;

34− return cl;

30+ return (VAL)cl;

35}

31}

37VAL idris_b8(VM *vm, VAL a) {

33VAL idris_b8(VM *vm, VAL a) {

38− uint8_t A = GETINT(a);

34+ return idris_b8const(vm, GETINT(a));

39− VAL cl = allocate(sizeof(Closure), 0);

40− SETTY(cl, CT_BITS8);

41− cl->info.bits8 = (uint8_t) A;

42− return cl;

43}

35}

45VAL idris_b16(VM *vm, VAL a) {

37VAL idris_b16(VM *vm, VAL a) {

46− uint16_t A = GETINT(a);

38+ return idris_b16const(vm, GETINT(a));

47− VAL cl = allocate(sizeof(Closure), 0);

48− SETTY(cl, CT_BITS16);

49− cl->info.bits16 = (uint16_t) A;

50− return cl;

51}

39}

53VAL idris_b32(VM *vm, VAL a) {

41VAL idris_b32(VM *vm, VAL a) {

54− uint32_t A = GETINT(a);

42+ return idris_b32const(vm, GETINT(a));

55− VAL cl = allocate(sizeof(Closure), 0);

56− SETTY(cl, CT_BITS32);

57− cl->info.bits32 = (uint32_t) A;

58− return cl;

59}

43}

61VAL idris_b64(VM *vm, VAL a) {

45VAL idris_b64(VM *vm, VAL a) {

62− uint64_t A = GETINT(a);

46+ return idris_b64const(vm, GETINT(a));

63− VAL cl = allocate(sizeof(Closure), 0);

64− SETTY(cl, CT_BITS64);

65− cl->info.bits64 = (uint64_t) A;

66− return cl;

67}

47}

69VAL idris_castB32Int(VM *vm, VAL a) {

49VAL idris_castB32Int(VM *vm, VAL a) {

70− return MKINT((i_int)a->info.bits32);

50+ return MKINT(GETBITS32(a));

71−}

72−

73−VAL idris_b8const(VM *vm, uint8_t a) {

74− VAL cl = allocate(sizeof(Closure), 0);

75− SETTY(cl, CT_BITS8);

76− cl->info.bits8 = a;

77− return cl;

78−}

79−

80−VAL idris_b16const(VM *vm, uint16_t a) {

81− VAL cl = allocate(sizeof(Closure), 0);

82− SETTY(cl, CT_BITS16);

83− cl->info.bits16 = a;

84− return cl;

85−}

86−

87−VAL idris_b32const(VM *vm, uint32_t a) {

88− VAL cl = allocate(sizeof(Closure), 0);

89− SETTY(cl, CT_BITS32);

90− cl->info.bits32 = a;

91− return cl;

92−}

93−

94−VAL idris_b64const(VM *vm, uint64_t a) {

95− VAL cl = allocate(sizeof(Closure), 0);

96− SETTY(cl, CT_BITS64);

97− cl->info.bits64 = a;

98− return cl;

99}

51}

100

101VAL idris_b8Plus(VM *vm, VAL a, VAL b) {

53VAL idris_b8Plus(VM *vm, VAL a, VAL b) {

102− uint8_t A = a->info.bits8;

54+ uint8_t A = GETBITS8(a);

103− uint8_t B = b->info.bits8;

55+ uint8_t B = GETBITS8(b);

104− VAL cl = allocate(sizeof(Closure), 0);

56+ return idris_b8const(vm, A + B);

105− SETTY(cl, CT_BITS8);

106− cl->info.bits8 = A + B;

107− return cl;

108}

57}

109

110VAL idris_b8Minus(VM *vm, VAL a, VAL b) {

59VAL idris_b8Minus(VM *vm, VAL a, VAL b) {

111− uint8_t A = a->info.bits8;

60+ uint8_t A = GETBITS8(a);

112− uint8_t B = b->info.bits8;

61+ uint8_t B = GETBITS8(b);

113− VAL cl = allocate(sizeof(Closure), 0);

62+ return idris_b8const(vm, A - B);

114− SETTY(cl, CT_BITS8);

115− cl->info.bits8 = A - B;

116− return cl;

117}

63}

118

119VAL idris_b8Times(VM *vm, VAL a, VAL b) {

65VAL idris_b8Times(VM *vm, VAL a, VAL b) {

120− uint8_t A = a->info.bits8;

66+ uint8_t A = GETBITS8(a);

121− uint8_t B = b->info.bits8;

67+ uint8_t B = GETBITS8(b);

122− VAL cl = allocate(sizeof(Closure), 0);

68+ return idris_b8const(vm, A * B);

123− SETTY(cl, CT_BITS8);

124− cl->info.bits8 = A * B;

125− return cl;

126}

69}

127

128VAL idris_b8UDiv(VM *vm, VAL a, VAL b) {

71VAL idris_b8UDiv(VM *vm, VAL a, VAL b) {

129− uint8_t A = a->info.bits8;

72+ uint8_t A = GETBITS8(a);

130− uint8_t B = b->info.bits8;

73+ uint8_t B = GETBITS8(b);

131− VAL cl = allocate(sizeof(Closure), 0);

74+ return idris_b8const(vm, A / B);

132− SETTY(cl, CT_BITS8);

133− cl->info.bits8 = A / B;

134− return cl;

135}

75}

136

137VAL idris_b8SDiv(VM *vm, VAL a, VAL b) {

77VAL idris_b8SDiv(VM *vm, VAL a, VAL b) {

138− uint8_t A = a->info.bits8;

78+ int8_t A = GETBITS8(a);

139− uint8_t B = b->info.bits8;

79+ int8_t B = GETBITS8(b);

140− VAL cl = allocate(sizeof(Closure), 0);

80+ return idris_b8const(vm, A / B);

141− SETTY(cl, CT_BITS8);

142− cl->info.bits8 = (uint8_t) (((int8_t) A) / ((int8_t) B));

143− return cl;

144}

81}

145

146VAL idris_b8URem(VM *vm, VAL a, VAL b) {

83VAL idris_b8URem(VM *vm, VAL a, VAL b) {

147− uint8_t A = a->info.bits8;

84+ uint8_t A = GETBITS8(a);

148− uint8_t B = b->info.bits8;

85+ uint8_t B = GETBITS8(b);

149− VAL cl = allocate(sizeof(Closure), 0);

86+ return idris_b8const(vm, A % B);

150− SETTY(cl, CT_BITS8);

151− cl->info.bits8 = A % B;

152− return cl;

153}

87}

154

155VAL idris_b8SRem(VM *vm, VAL a, VAL b) {

89VAL idris_b8SRem(VM *vm, VAL a, VAL b) {

156− uint8_t A = a->info.bits8;

90+ int8_t A = GETBITS8(a);

157− uint8_t B = b->info.bits8;

91+ int8_t B = GETBITS8(b);

158− VAL cl = allocate(sizeof(Closure), 0);

92+ return idris_b8const(vm, A % B);

159− SETTY(cl, CT_BITS8);

160− cl->info.bits8 = (uint8_t) (((int8_t) A) % ((int8_t) B));

161− return cl;

162}

93}

163

164VAL idris_b8Lt(VM *vm, VAL a, VAL b) {

95VAL idris_b8Lt(VM *vm, VAL a, VAL b) {

165− return MKINT((i_int) (a->info.bits8 < b->info.bits8));

96+ return MKINT((i_int) (GETBITS8(a) < GETBITS8(b)));

166}

97}

167

168VAL idris_b8Gt(VM *vm, VAL a, VAL b) {

99VAL idris_b8Gt(VM *vm, VAL a, VAL b) {

169− return MKINT((i_int) (a->info.bits8 > b->info.bits8));

100+ return MKINT((i_int) (GETBITS8(a) > GETBITS8(b)));

170}

101}

171

102

172VAL idris_b8Eq(VM *vm, VAL a, VAL b) {

103VAL idris_b8Eq(VM *vm, VAL a, VAL b) {

173− return MKINT((i_int) (a->info.bits8 == b->info.bits8));

104+ return MKINT((i_int) (GETBITS8(a) == GETBITS8(b)));

174}

105}

175

106

176VAL idris_b8Lte(VM *vm, VAL a, VAL b) {

107VAL idris_b8Lte(VM *vm, VAL a, VAL b) {

177− return MKINT((i_int) (a->info.bits8 <= b->info.bits8));

108+ return MKINT((i_int) (GETBITS8(a) <= GETBITS8(b)));

178}

109}

179

110

180VAL idris_b8Gte(VM *vm, VAL a, VAL b) {

111VAL idris_b8Gte(VM *vm, VAL a, VAL b) {

181− return MKINT((i_int) (a->info.bits8 >= b->info.bits8));

112+ return MKINT((i_int) (GETBITS8(a) >= GETBITS8(b)));

182}

113}

183

114

184VAL idris_b8Compl(VM *vm, VAL a) {

115VAL idris_b8Compl(VM *vm, VAL a) {

185− uint8_t A = a->info.bits8;

116+ uint8_t A = GETBITS8(a);

186− VAL cl = allocate(sizeof(Closure), 0);

187− SETTY(cl, CT_BITS8);

188− cl->info.bits8 = ~ A;

189− return cl;

117+ return idris_b8const(vm, ~ A);

190}

118}

191

119

192VAL idris_b8And(VM *vm, VAL a, VAL b) {

120VAL idris_b8And(VM *vm, VAL a, VAL b) {

193− uint8_t A = a->info.bits8;

121+ uint8_t A = GETBITS8(a);

194− uint8_t B = b->info.bits8;

122+ uint8_t B = GETBITS8(b);

195− VAL cl = allocate(sizeof(Closure), 0);

123+ return idris_b8const(vm, A & B);

196− SETTY(cl, CT_BITS8);

197− cl->info.bits8 = A & B;

198− return cl;

199}

124}

200

125

201VAL idris_b8Or(VM *vm, VAL a, VAL b) {

126VAL idris_b8Or(VM *vm, VAL a, VAL b) {

202− uint8_t A = a->info.bits8;

127+ uint8_t A = GETBITS8(a);

203− uint8_t B = b->info.bits8;

128+ uint8_t B = GETBITS8(b);

204− VAL cl = allocate(sizeof(Closure), 0);

129+ return idris_b8const(vm, A | B);

205− SETTY(cl, CT_BITS8);

206− cl->info.bits8 = A | B;

207− return cl;

208}

130}

209

131

210VAL idris_b8Xor(VM *vm, VAL a, VAL b) {

132VAL idris_b8Xor(VM *vm, VAL a, VAL b) {

211− uint8_t A = a->info.bits8;

133+ uint8_t A = GETBITS8(a);

212− uint8_t B = b->info.bits8;

134+ uint8_t B = GETBITS8(b);

213− VAL cl = allocate(sizeof(Closure), 0);

135+ return idris_b8const(vm, A ^ B);

214− SETTY(cl, CT_BITS8);

215− cl->info.bits8 = A ^ B;

216− return cl;

217}

136}

218

137

219VAL idris_b8Shl(VM *vm, VAL a, VAL b) {

138VAL idris_b8Shl(VM *vm, VAL a, VAL b) {

220− uint8_t A = a->info.bits8;

139+ uint8_t A = GETBITS8(a);

221− uint8_t B = b->info.bits8;

140+ uint8_t B = GETBITS8(b);

222− VAL cl = allocate(sizeof(Closure), 0);

141+ return idris_b8const(vm, A << B);

223− SETTY(cl, CT_BITS8);

224− cl->info.bits8 = A << B;

225− return cl;

226}

142}

227

143

228VAL idris_b8LShr(VM *vm, VAL a, VAL b) {

144VAL idris_b8LShr(VM *vm, VAL a, VAL b) {

229− uint8_t A = a->info.bits8;

145+ uint8_t A = GETBITS8(a);

230− uint8_t B = b->info.bits8;

146+ uint8_t B = GETBITS8(b);

231− VAL cl = allocate(sizeof(Closure), 0);

147+ return idris_b8const(vm, A >> B);

232− SETTY(cl, CT_BITS8);

233− cl->info.bits8 = A >> B;

234− return cl;

235}

148}

236

149

237VAL idris_b8AShr(VM *vm, VAL a, VAL b) {

150VAL idris_b8AShr(VM *vm, VAL a, VAL b) {

238− uint8_t A = a->info.bits8;

151+ int8_t A = GETBITS8(a);

239− uint8_t B = b->info.bits8;

152+ int8_t B = GETBITS8(b);

240− VAL cl = allocate(sizeof(Closure), 0);

153+ return idris_b8const(vm, A >> B);

241− SETTY(cl, CT_BITS8);

242− cl->info.bits8 = (uint8_t) (((int8_t) A) >> ((int8_t) B));

243− return cl;

244}

154}

245

155

246VAL idris_b16Plus(VM *vm, VAL a, VAL b) {

156VAL idris_b16Plus(VM *vm, VAL a, VAL b) {

247− uint16_t A = a->info.bits16;

157+ uint16_t A = GETBITS16(a);

248− uint16_t B = b->info.bits16;

158+ uint16_t B = GETBITS16(b);

249− VAL cl = allocate(sizeof(Closure), 0);

159+ return idris_b16const(vm, A + B);

250− SETTY(cl, CT_BITS16);

251− cl->info.bits16 = A + B;

252− return cl;

253}

160}

254

161

255VAL idris_b16Minus(VM *vm, VAL a, VAL b) {

162VAL idris_b16Minus(VM *vm, VAL a, VAL b) {

256− uint16_t A = a->info.bits16;

163+ uint16_t A = GETBITS16(a);

257− uint16_t B = b->info.bits16;

164+ uint16_t B = GETBITS16(b);

258− VAL cl = allocate(sizeof(Closure), 0);

165+ return idris_b16const(vm, A - B);

259− SETTY(cl, CT_BITS16);

260− cl->info.bits16 = A - B;

261− return cl;

262}

166}

263

167

264VAL idris_b16Times(VM *vm, VAL a, VAL b) {

168VAL idris_b16Times(VM *vm, VAL a, VAL b) {

265− uint16_t A = a->info.bits16;

169+ uint16_t A = GETBITS16(a);

266− uint16_t B = b->info.bits16;

170+ uint16_t B = GETBITS16(b);

267− VAL cl = allocate(sizeof(Closure), 0);

171+ return idris_b16const(vm, A * B);

268− SETTY(cl, CT_BITS16);

269− cl->info.bits16 = A * B;

270− return cl;

271}

172}

272

173

273VAL idris_b16UDiv(VM *vm, VAL a, VAL b) {

174VAL idris_b16UDiv(VM *vm, VAL a, VAL b) {

274− uint16_t A = a->info.bits16;

175+ uint16_t A = GETBITS16(a);

275− uint16_t B = b->info.bits16;

176+ uint16_t B = GETBITS16(b);

276− VAL cl = allocate(sizeof(Closure), 0);

177+ return idris_b16const(vm, A / B);

277− SETTY(cl, CT_BITS16);

278− cl->info.bits16 = A / B;

279− return cl;

280}

178}

281

179

282VAL idris_b16SDiv(VM *vm, VAL a, VAL b) {

180VAL idris_b16SDiv(VM *vm, VAL a, VAL b) {

283− uint16_t A = a->info.bits16;

181+ int16_t A = GETBITS16(a);

284− uint16_t B = b->info.bits16;

182+ int16_t B = GETBITS16(b);

285− VAL cl = allocate(sizeof(Closure), 0);

183+ return idris_b16const(vm, A / B);

286− SETTY(cl, CT_BITS16);

287− cl->info.bits16 = (uint16_t) (((int16_t) A) / ((int16_t) B));

288− return cl;

289}

184}

290

185

291VAL idris_b16URem(VM *vm, VAL a, VAL b) {

186VAL idris_b16URem(VM *vm, VAL a, VAL b) {

292− uint16_t A = a->info.bits16;

187+ uint16_t A = GETBITS16(a);

293− uint16_t B = b->info.bits16;

188+ uint16_t B = GETBITS16(b);

294− VAL cl = allocate(sizeof(Closure), 0);

189+ return idris_b16const(vm, A % B);

295− SETTY(cl, CT_BITS16);

296− cl->info.bits16 = A % B;

297− return cl;

298}

190}

299

191

300VAL idris_b16SRem(VM *vm, VAL a, VAL b) {

192VAL idris_b16SRem(VM *vm, VAL a, VAL b) {

301− uint16_t A = a->info.bits16;

193+ int16_t A = GETBITS16(a);

302− uint16_t B = b->info.bits16;

194+ int16_t B = GETBITS16(b);

303− VAL cl = allocate(sizeof(Closure), 0);

195+ return idris_b16const(vm, A % B);

304− SETTY(cl, CT_BITS16);

305− cl->info.bits16 = (uint16_t) (((int16_t) A) % ((int16_t) B));

306− return cl;

307}

196}

308

197

309VAL idris_b16Lt(VM *vm, VAL a, VAL b) {

198VAL idris_b16Lt(VM *vm, VAL a, VAL b) {

310− return MKINT((i_int) (a->info.bits16 < b->info.bits16));

199+ return MKINT((i_int) (GETBITS16(a) < GETBITS16(b)));

311}

200}

312

201

313VAL idris_b16Gt(VM *vm, VAL a, VAL b) {

202VAL idris_b16Gt(VM *vm, VAL a, VAL b) {

314− return MKINT((i_int) (a->info.bits16 > b->info.bits16));

203+ return MKINT((i_int) (GETBITS16(a) > GETBITS16(b)));

315}

204}

316

205

317VAL idris_b16Eq(VM *vm, VAL a, VAL b) {

206VAL idris_b16Eq(VM *vm, VAL a, VAL b) {

318− return MKINT((i_int) (a->info.bits16 == b->info.bits16));

207+ return MKINT((i_int) (GETBITS16(a) == GETBITS16(b)));

319}

208}

320

209

321VAL idris_b16Lte(VM *vm, VAL a, VAL b) {

210VAL idris_b16Lte(VM *vm, VAL a, VAL b) {

322− return MKINT((i_int) (a->info.bits16 <= b->info.bits16));

211+ return MKINT((i_int) (GETBITS16(a) <= GETBITS16(b)));

323}

212}

324

213

325VAL idris_b16Gte(VM *vm, VAL a, VAL b) {

214VAL idris_b16Gte(VM *vm, VAL a, VAL b) {

326− return MKINT((i_int) (a->info.bits16 >= b->info.bits16));

215+ return MKINT((i_int) (GETBITS16(a) >= GETBITS16(b)));

327}

216}

328

217

329VAL idris_b16Compl(VM *vm, VAL a) {

218VAL idris_b16Compl(VM *vm, VAL a) {

330− uint16_t A = a->info.bits16;

219+ uint16_t A = GETBITS16(a);

331− VAL cl = allocate(sizeof(Closure), 0);

220+ return idris_b16const(vm, ~ A);

332− SETTY(cl, CT_BITS16);

333− cl->info.bits16 = ~ A;

334− return cl;

335}

221}

336

222

337VAL idris_b16And(VM *vm, VAL a, VAL b) {

223VAL idris_b16And(VM *vm, VAL a, VAL b) {

338− uint16_t A = a->info.bits16;

224+ uint16_t A = GETBITS16(a);

339− uint16_t B = b->info.bits16;

225+ uint16_t B = GETBITS16(b);

340− VAL cl = allocate(sizeof(Closure), 0);

226+ return idris_b16const(vm, A & B);

341− SETTY(cl, CT_BITS16);

342− cl->info.bits16 = A & B;

343− return cl;

344}

227}

345

228

346VAL idris_b16Or(VM *vm, VAL a, VAL b) {

229VAL idris_b16Or(VM *vm, VAL a, VAL b) {

347− uint16_t A = a->info.bits16;

230+ uint16_t A = GETBITS16(a);

348− uint16_t B = b->info.bits16;

231+ uint16_t B = GETBITS16(b);

349− VAL cl = allocate(sizeof(Closure), 0);

232+ return idris_b16const(vm, A | B);

350− SETTY(cl, CT_BITS16);

351− cl->info.bits16 = A | B;

352− return cl;

353}

233}

354

234

355VAL idris_b16Xor(VM *vm, VAL a, VAL b) {

235VAL idris_b16Xor(VM *vm, VAL a, VAL b) {

356− uint16_t A = a->info.bits16;

236+ uint16_t A = GETBITS16(a);

357− uint16_t B = b->info.bits16;

237+ uint16_t B = GETBITS16(b);

358− VAL cl = allocate(sizeof(Closure), 0);

238+ return idris_b16const(vm, A ^ B);

359− SETTY(cl, CT_BITS16);

360− cl->info.bits16 = A ^ B;

361− return cl;

362}

239}

363

240

364VAL idris_b16Shl(VM *vm, VAL a, VAL b) {

241VAL idris_b16Shl(VM *vm, VAL a, VAL b) {

365− uint16_t A = a->info.bits16;

242+ uint16_t A = GETBITS16(a);

366− uint16_t B = b->info.bits16;

243+ uint16_t B = GETBITS16(b);

367− VAL cl = allocate(sizeof(Closure), 0);

244+ return idris_b16const(vm, A << B);

368− SETTY(cl, CT_BITS16);

369− cl->info.bits16 = A << B;

370− return cl;

371}

245}

372

246

373VAL idris_b16LShr(VM *vm, VAL a, VAL b) {

247VAL idris_b16LShr(VM *vm, VAL a, VAL b) {

374− uint16_t A = a->info.bits16;

248+ uint16_t A = GETBITS16(a);

375− uint16_t B = b->info.bits16;

249+ uint16_t B = GETBITS16(b);

376− VAL cl = allocate(sizeof(Closure), 0);

250+ return idris_b16const(vm, A >> B);

377− SETTY(cl, CT_BITS16);

378− cl->info.bits16 = A >> B;

379− return cl;

380}

251}

381

252

382VAL idris_b16AShr(VM *vm, VAL a, VAL b) {

253VAL idris_b16AShr(VM *vm, VAL a, VAL b) {

383− uint16_t A = a->info.bits16;

254+ int16_t A = GETBITS16(a);

384− uint16_t B = b->info.bits16;

255+ int16_t B = GETBITS16(b);

385− VAL cl = allocate(sizeof(Closure), 0);

256+ return idris_b16const(vm, A >> B);

386− SETTY(cl, CT_BITS16);

387− cl->info.bits16 = (uint16_t) (((int16_t) A) >> ((int16_t) B));

388− return cl;

389}

257}

390

258

391VAL idris_b32Plus(VM *vm, VAL a, VAL b) {

259VAL idris_b32Plus(VM *vm, VAL a, VAL b) {

392− uint32_t A = a->info.bits32;

260+ uint32_t A = GETBITS32(a);

393− uint32_t B = b->info.bits32;

261+ uint32_t B = GETBITS32(b);

394− VAL cl = allocate(sizeof(Closure), 0);

262+ return idris_b32const(vm, A + B);

395− SETTY(cl, CT_BITS32);

396− cl->info.bits32 = A + B;

397− return cl;

398}

263}

399

264

400VAL idris_b32Minus(VM *vm, VAL a, VAL b) {

265VAL idris_b32Minus(VM *vm, VAL a, VAL b) {

401− uint32_t A = a->info.bits32;

266+ uint32_t A = GETBITS32(a);

402− uint32_t B = b->info.bits32;

267+ uint32_t B = GETBITS32(b);

403− VAL cl = allocate(sizeof(Closure), 0);

268+ return idris_b32const(vm, A - B);

404− SETTY(cl, CT_BITS32);

405− cl->info.bits32 = A - B;

406− return cl;

407}

269}

408

270

409VAL idris_b32Times(VM *vm, VAL a, VAL b) {

271VAL idris_b32Times(VM *vm, VAL a, VAL b) {

410− uint32_t A = a->info.bits32;

272+ uint32_t A = GETBITS32(a);

411− uint32_t B = b->info.bits32;

273+ uint32_t B = GETBITS32(b);

412− VAL cl = allocate(sizeof(Closure), 0);

274+ return idris_b32const(vm, A * B);

413− SETTY(cl, CT_BITS32);

414− cl->info.bits32 = A * B;

415− return cl;

416}

275}

417

276

418VAL idris_b32UDiv(VM *vm, VAL a, VAL b) {

277VAL idris_b32UDiv(VM *vm, VAL a, VAL b) {

419− uint32_t A = a->info.bits32;

278+ uint32_t A = GETBITS32(a);

420− uint32_t B = b->info.bits32;

279+ uint32_t B = GETBITS32(b);

421− VAL cl = allocate(sizeof(Closure), 0);

280+ return idris_b32const(vm, A / B);

422− SETTY(cl, CT_BITS32);

423− cl->info.bits32 = A / B;

424− return cl;

425}

281}

426

282

427VAL idris_b32SDiv(VM *vm, VAL a, VAL b) {

283VAL idris_b32SDiv(VM *vm, VAL a, VAL b) {

428− uint32_t A = a->info.bits32;

284+ int32_t A = GETBITS32(a);

429− uint32_t B = b->info.bits32;

285+ int32_t B = GETBITS32(b);

430− VAL cl = allocate(sizeof(Closure), 0);

286+ return idris_b32const(vm, A / B);

431− SETTY(cl, CT_BITS32);

432− cl->info.bits32 = (uint32_t) (((int32_t) A) / ((int32_t) B));

433− return cl;

434}

287}

435

288

436VAL idris_b32URem(VM *vm, VAL a, VAL b) {

289VAL idris_b32URem(VM *vm, VAL a, VAL b) {

437− uint32_t A = a->info.bits32;

290+ uint32_t A = GETBITS32(a);

438− uint32_t B = b->info.bits32;

291+ uint32_t B = GETBITS32(b);

439− VAL cl = allocate(sizeof(Closure), 0);

292+ return idris_b32const(vm, A % B);

440− SETTY(cl, CT_BITS32);

441− cl->info.bits32 = A % B;

442− return cl;

443}

293}

444

294

445VAL idris_b32SRem(VM *vm, VAL a, VAL b) {

295VAL idris_b32SRem(VM *vm, VAL a, VAL b) {

446− uint32_t A = a->info.bits32;

296+ int32_t A = GETBITS32(a);

447− uint32_t B = b->info.bits32;

297+ int32_t B = GETBITS32(b);

448− VAL cl = allocate(sizeof(Closure), 0);

298+ return idris_b32const(vm, A % B);

449− SETTY(cl, CT_BITS32);

450− cl->info.bits32 = (uint32_t) (((int32_t) A) % ((int32_t) B));

451− return cl;

452}

299}

453

300

454VAL idris_b32Lt(VM *vm, VAL a, VAL b) {

301VAL idris_b32Lt(VM *vm, VAL a, VAL b) {

455− return MKINT((i_int) (a->info.bits32 < b->info.bits32));

302+ return MKINT((i_int) (GETBITS32(a) < GETBITS32(b)));

456}

303}

457

304

458VAL idris_b32Gt(VM *vm, VAL a, VAL b) {

305VAL idris_b32Gt(VM *vm, VAL a, VAL b) {

459− return MKINT((i_int) (a->info.bits32 > b->info.bits32));

306+ return MKINT((i_int) (GETBITS32(a) > GETBITS32(b)));

460}

307}

461

308

462VAL idris_b32Eq(VM *vm, VAL a, VAL b) {

309VAL idris_b32Eq(VM *vm, VAL a, VAL b) {

463− return MKINT((i_int) (a->info.bits32 == b->info.bits32));

310+ return MKINT((i_int) (GETBITS32(a) == GETBITS32(b)));

464}

311}

465

312

466VAL idris_b32Lte(VM *vm, VAL a, VAL b) {

313VAL idris_b32Lte(VM *vm, VAL a, VAL b) {

467− return MKINT((i_int) (a->info.bits32 <= b->info.bits32));

314+ return MKINT((i_int) (GETBITS32(a) <= GETBITS32(b)));

468}

315}

469

316

470VAL idris_b32Gte(VM *vm, VAL a, VAL b) {

317VAL idris_b32Gte(VM *vm, VAL a, VAL b) {

471− return MKINT((i_int) (a->info.bits32 >= b->info.bits32));

318+ return MKINT((i_int) (GETBITS32(a) >= GETBITS32(b)));

472}

319}

473

320

474VAL idris_b32Compl(VM *vm, VAL a) {

321VAL idris_b32Compl(VM *vm, VAL a) {

475− uint32_t A = a->info.bits32;

322+ uint32_t A = GETBITS32(a);

476− VAL cl = allocate(sizeof(Closure), 0);

323+ return idris_b32const(vm, ~ A);

477− SETTY(cl, CT_BITS32);

478− cl->info.bits32 = ~ A;

479− return cl;

480}

324}

481

325

482VAL idris_b32And(VM *vm, VAL a, VAL b) {

326VAL idris_b32And(VM *vm, VAL a, VAL b) {

483− uint32_t A = a->info.bits32;

327+ uint32_t A = GETBITS32(a);

484− uint32_t B = b->info.bits32;

328+ uint32_t B = GETBITS32(b);

485− VAL cl = allocate(sizeof(Closure), 0);

329+ return idris_b32const(vm, A & B);

486− SETTY(cl, CT_BITS32);

487− cl->info.bits32 = A & B;

488− return cl;

489}

330}

490

331

491VAL idris_b32Or(VM *vm, VAL a, VAL b) {

332VAL idris_b32Or(VM *vm, VAL a, VAL b) {

492− uint32_t A = a->info.bits32;

333+ uint32_t A = GETBITS32(a);

493− uint32_t B = b->info.bits32;

334+ uint32_t B = GETBITS32(b);

494− VAL cl = allocate(sizeof(Closure), 0);

335+ return idris_b32const(vm, A | B);

495− SETTY(cl, CT_BITS32);

496− cl->info.bits32 = A | B;

497− return cl;

498}

336}

499

337

500VAL idris_b32Xor(VM *vm, VAL a, VAL b) {

338VAL idris_b32Xor(VM *vm, VAL a, VAL b) {

501− uint32_t A = a->info.bits32;

339+ uint32_t A = GETBITS32(a);

502− uint32_t B = b->info.bits32;

340+ uint32_t B = GETBITS32(b);

503− VAL cl = allocate(sizeof(Closure), 0);

341+ return idris_b32const(vm, A ^ B);

504− SETTY(cl, CT_BITS32);

505− cl->info.bits32 = A ^ B;

506− return cl;

507}

342}

508

343

509VAL idris_b32Shl(VM *vm, VAL a, VAL b) {

344VAL idris_b32Shl(VM *vm, VAL a, VAL b) {

510− uint32_t A = a->info.bits32;

345+ uint32_t A = GETBITS32(a);

511− uint32_t B = b->info.bits32;

346+ uint32_t B = GETBITS32(b);

512− VAL cl = allocate(sizeof(Closure), 0);

347+ return idris_b32const(vm, A << B);

513− SETTY(cl, CT_BITS32);

514− cl->info.bits32 = A << B;

515− return cl;

516}

348}

517

349

518VAL idris_b32LShr(VM *vm, VAL a, VAL b) {

350VAL idris_b32LShr(VM *vm, VAL a, VAL b) {

519− uint32_t A = a->info.bits32;

351+ uint32_t A = GETBITS32(a);

520− uint32_t B = b->info.bits32;

352+ uint32_t B = GETBITS32(b);

521− VAL cl = allocate(sizeof(Closure), 0);

353+ return idris_b32const(vm, A >> B);

522− SETTY(cl, CT_BITS32);

523− cl->info.bits32 = A >> B;

524− return cl;

525}

354}

526

355

527VAL idris_b32AShr(VM *vm, VAL a, VAL b) {

356VAL idris_b32AShr(VM *vm, VAL a, VAL b) {

528− uint32_t A = a->info.bits32;

357+ int32_t A = GETBITS32(a);

529− uint32_t B = b->info.bits32;

358+ int32_t B = GETBITS32(b);

530− VAL cl = allocate(sizeof(Closure), 0);

359+ return idris_b32const(vm, A >> B);

531− SETTY(cl, CT_BITS32);

532− cl->info.bits32 = (uint32_t) (((int32_t)A) >> ((int32_t)B));

533− return cl;

534}

360}

535

361

536VAL idris_b64Plus(VM *vm, VAL a, VAL b) {

362VAL idris_b64Plus(VM *vm, VAL a, VAL b) {

537− uint64_t A = a->info.bits64;

363+ uint64_t A = GETBITS64(a);

538− uint64_t B = b->info.bits64;

364+ uint64_t B = GETBITS64(b);

539− VAL cl = allocate(sizeof(Closure), 0);

365+ return idris_b64const(vm, A + B);

540− SETTY(cl, CT_BITS64);

541− cl->info.bits64 = A + B;

542− return cl;

543}

366}

544

367

545VAL idris_b64Minus(VM *vm, VAL a, VAL b) {

368VAL idris_b64Minus(VM *vm, VAL a, VAL b) {

546− uint64_t A = a->info.bits64;

369+ uint64_t A = GETBITS64(a);

547− uint64_t B = b->info.bits64;

370+ uint64_t B = GETBITS64(b);

548− VAL cl = allocate(sizeof(Closure), 0);

371+ return idris_b64const(vm, A - B);

549− SETTY(cl, CT_BITS64);

550− cl->info.bits64 = A - B;

551− return cl;

552}

372}

553

373

554VAL idris_b64Times(VM *vm, VAL a, VAL b) {

374VAL idris_b64Times(VM *vm, VAL a, VAL b) {

555− uint64_t A = a->info.bits64;

375+ uint64_t A = GETBITS64(a);

556− uint64_t B = b->info.bits64;

376+ uint64_t B = GETBITS64(b);

557− VAL cl = allocate(sizeof(Closure), 0);

377+ return idris_b64const(vm, A * B);

558− SETTY(cl, CT_BITS64);

559− cl->info.bits64 = A * B;

560− return cl;

561}

378}

562

379

563VAL idris_b64UDiv(VM *vm, VAL a, VAL b) {

380VAL idris_b64UDiv(VM *vm, VAL a, VAL b) {

564− uint64_t A = a->info.bits64;

381+ uint64_t A = GETBITS64(a);

565− uint64_t B = b->info.bits64;

382+ uint64_t B = GETBITS64(b);

566− VAL cl = allocate(sizeof(Closure), 0);

383+ return idris_b64const(vm, A / B);

567− SETTY(cl, CT_BITS64);

568− cl->info.bits64 = A / B;

569− return cl;

570}

384}

571

385

572VAL idris_b64SDiv(VM *vm, VAL a, VAL b) {

386VAL idris_b64SDiv(VM *vm, VAL a, VAL b) {

573− uint64_t A = a->info.bits64;

387+ int64_t A = GETBITS64(a);

574− uint64_t B = b->info.bits64;

388+ int64_t B = GETBITS64(b);

575− VAL cl = allocate(sizeof(Closure), 0);

389+ return idris_b64const(vm, A / B);

576− SETTY(cl, CT_BITS64);

577− cl->info.bits64 = (uint64_t) (((int64_t) A) / ((int64_t) B));

578− return cl;

579}

390}

580

391

581VAL idris_b64URem(VM *vm, VAL a, VAL b) {

392VAL idris_b64URem(VM *vm, VAL a, VAL b) {

582− uint64_t A = a->info.bits64;

393+ uint64_t A = GETBITS64(a);

583− uint64_t B = b->info.bits64;

394+ uint64_t B = GETBITS64(b);

584− VAL cl = allocate(sizeof(Closure), 0);

395+ return idris_b64const(vm, A % B);

585− SETTY(cl, CT_BITS64);

586− cl->info.bits64 = A % B;

587− return cl;

588}

396}

589

397

590VAL idris_b64SRem(VM *vm, VAL a, VAL b) {

398VAL idris_b64SRem(VM *vm, VAL a, VAL b) {

591− uint64_t A = a->info.bits64;

399+ int64_t A = GETBITS64(a);

592− uint64_t B = b->info.bits64;

400+ int64_t B = GETBITS64(b);

593− VAL cl = allocate(sizeof(Closure), 0);

401+ return idris_b64const(vm, A % B);

594− SETTY(cl, CT_BITS64);

595− cl->info.bits64 = (uint64_t) (((int64_t) A) % ((int64_t) B));

596− return cl;

597}

402}

598

403

599VAL idris_b64Lt(VM *vm, VAL a, VAL b) {

404VAL idris_b64Lt(VM *vm, VAL a, VAL b) {

405+ uint64_t A = GETBITS64(a);

406+ uint64_t B = GETBITS64(b);

600− return MKINT((i_int) (a->info.bits64 < b->info.bits64));

407+ return MKINT((i_int) (A < B));

601}

408}

602

409

603VAL idris_b64Gt(VM *vm, VAL a, VAL b) {

410VAL idris_b64Gt(VM *vm, VAL a, VAL b) {

411+ uint64_t A = GETBITS64(a);

412+ uint64_t B = GETBITS64(b);

604− return MKINT((i_int) (a->info.bits64 > b->info.bits64));

413+ return MKINT((i_int) (A > B));

605}

414}

606

415

607VAL idris_b64Eq(VM *vm, VAL a, VAL b) {

416VAL idris_b64Eq(VM *vm, VAL a, VAL b) {

417+ uint64_t A = GETBITS64(a);

418+ uint64_t B = GETBITS64(b);

608− return MKINT((i_int) (a->info.bits64 == b->info.bits64));

419+ return MKINT((i_int) (A == B));

609}

420}

610

421

611VAL idris_b64Lte(VM *vm, VAL a, VAL b) {

422VAL idris_b64Lte(VM *vm, VAL a, VAL b) {

423+ uint64_t A = GETBITS64(a);

424+ uint64_t B = GETBITS64(b);

612− return MKINT((i_int) (a->info.bits64 <= b->info.bits64));

425+ return MKINT((i_int) (A <= B));

613}

426}

614

427

615VAL idris_b64Gte(VM *vm, VAL a, VAL b) {

428VAL idris_b64Gte(VM *vm, VAL a, VAL b) {

429+ uint64_t A = GETBITS64(a);

430+ uint64_t B = GETBITS64(b);

616− return MKINT((i_int) (a->info.bits64 >= b->info.bits64));

431+ return MKINT((i_int) (A >= B));

617}

432}

618

433

619VAL idris_b64Compl(VM *vm, VAL a) {

434VAL idris_b64Compl(VM *vm, VAL a) {

620− uint64_t A = a->info.bits64;

435+ uint64_t A = GETBITS64(a);

621− VAL cl = allocate(sizeof(Closure), 0);

436+ return idris_b64const(vm, ~ A);

622− SETTY(cl, CT_BITS64);

623− cl->info.bits64 = ~ A;

624− return cl;

625}

437}

626

438

627VAL idris_b64And(VM *vm, VAL a, VAL b) {

439VAL idris_b64And(VM *vm, VAL a, VAL b) {

628− uint64_t A = a->info.bits64;

440+ uint64_t A = GETBITS64(a);

629− uint64_t B = b->info.bits64;

441+ uint64_t B = GETBITS64(b);

630− VAL cl = allocate(sizeof(Closure), 0);

442+ return idris_b64const(vm, A & B);

631− SETTY(cl, CT_BITS64);

632− cl->info.bits64 = A & B;

633− return cl;

634}

443}

635

444

636VAL idris_b64Or(VM *vm, VAL a, VAL b) {

445VAL idris_b64Or(VM *vm, VAL a, VAL b) {

637− uint64_t A = a->info.bits64;

446+ uint64_t A = GETBITS64(a);

638− uint64_t B = b->info.bits64;

447+ uint64_t B = GETBITS64(b);

639− VAL cl = allocate(sizeof(Closure), 0);

448+ return idris_b64const(vm, A | B);

640− SETTY(cl, CT_BITS64);

641− cl->info.bits64 = A | B;

642− return cl;

643}

449}

644

450

645VAL idris_b64Xor(VM *vm, VAL a, VAL b) {

451VAL idris_b64Xor(VM *vm, VAL a, VAL b) {

646− uint64_t A = a->info.bits64;

452+ uint64_t A = GETBITS64(a);

647− uint64_t B = b->info.bits64;

453+ uint64_t B = GETBITS64(b);

648− VAL cl = allocate(sizeof(Closure), 0);

454+ return idris_b64const(vm, A ^ B);

649− SETTY(cl, CT_BITS64);

650− cl->info.bits64 = A ^ B;

651− return cl;

652}

455}

653

456

654VAL idris_b64Shl(VM *vm, VAL a, VAL b) {

457VAL idris_b64Shl(VM *vm, VAL a, VAL b) {

655− uint64_t A = a->info.bits64;

458+ uint64_t A = GETBITS64(a);

656− uint64_t B = b->info.bits64;

459+ uint64_t B = GETBITS64(b);

657− VAL cl = allocate(sizeof(Closure), 0);

460+ return idris_b64const(vm, A << B);

658− SETTY(cl, CT_BITS64);

659− cl->info.bits64 = A << B;

660− return cl;

661}

461}

662

462

663VAL idris_b64LShr(VM *vm, VAL a, VAL b) {

463VAL idris_b64LShr(VM *vm, VAL a, VAL b) {

664− uint64_t A = a->info.bits64;

464+ uint64_t A = GETBITS64(a);

665− uint64_t B = b->info.bits64;

465+ uint64_t B = GETBITS64(b);

666− VAL cl = allocate(sizeof(Closure), 0);

466+ return idris_b64const(vm, A >> B);

667− SETTY(cl, CT_BITS64);

668− cl->info.bits64 = A >> B;

669− return cl;

670}

467}

671

468

672VAL idris_b64AShr(VM *vm, VAL a, VAL b) {

469VAL idris_b64AShr(VM *vm, VAL a, VAL b) {

673− uint64_t A = a->info.bits64;

470+ int64_t A = GETBITS64(a);

674− uint64_t B = b->info.bits64;

471+ int64_t B = GETBITS64(b);

675− VAL cl = allocate(sizeof(Closure), 0);

472+ return idris_b64const(vm, A >> B);

676− SETTY(cl, CT_BITS64);

677− cl->info.bits64 = (uint64_t) (((int64_t) A) >> ((int64_t) B));

678− return cl;

679}

473}

680

474

681VAL idris_b8Z16(VM *vm, VAL a) {

475VAL idris_b8Z16(VM *vm, VAL a) {

682− uint8_t A = a->info.bits8;

476+ uint8_t A = GETBITS8(a);

683− VAL cl = allocate(sizeof(Closure), 0);

477+ return idris_b16const(vm, A);

684− SETTY(cl, CT_BITS16);

685− cl->info.bits16 = (uint16_t) A;

686− return cl;

687}

478}

688

479

689VAL idris_b8Z32(VM *vm, VAL a) {

480VAL idris_b8Z32(VM *vm, VAL a) {

690− uint8_t A = a->info.bits8;

481+ uint8_t A = GETBITS8(a);

691− VAL cl = allocate(sizeof(Closure), 0);

482+ return idris_b32const(vm, A);

692− SETTY(cl, CT_BITS32);

693− cl->info.bits32 = (uint32_t) A;

694− return cl;

695}

483}

696

484

697VAL idris_b8Z64(VM *vm, VAL a) {

485VAL idris_b8Z64(VM *vm, VAL a) {

698− uint8_t A = a->info.bits8;

486+ uint8_t A = GETBITS8(a);

699− VAL cl = allocate(sizeof(Closure), 0);

487+ return idris_b64const(vm, A);

700− SETTY(cl, CT_BITS64);

701− cl->info.bits64 = (uint64_t) A;

702− return cl;

703}

488}

704

489

705VAL idris_b8S16(VM *vm, VAL a) {

490VAL idris_b8S16(VM *vm, VAL a) {

706− uint8_t A = a->info.bits8;

491+ int8_t A = GETBITS8(a);

707− VAL cl = allocate(sizeof(Closure), 0);

492+ return idris_b16const(vm, (int16_t) A);

708− SETTY(cl, CT_BITS16);

709− cl->info.bits16 = (uint16_t) (int16_t) (int8_t) A;

710− return cl;

711}

493}

712

494

713VAL idris_b8S32(VM *vm, VAL a) {

495VAL idris_b8S32(VM *vm, VAL a) {

714− uint8_t A = a->info.bits8;

496+ int8_t A = GETBITS8(a);

715− VAL cl = allocate(sizeof(Closure), 0);

497+ return idris_b32const(vm, (int32_t) A);

716− SETTY(cl, CT_BITS32);

717− cl->info.bits32 = (uint32_t) (int32_t) (int8_t) A;

718− return cl;

719}

498}

720

499

721VAL idris_b8S64(VM *vm, VAL a) {

500VAL idris_b8S64(VM *vm, VAL a) {

722− uint8_t A = a->info.bits8;

501+ int8_t A = GETBITS8(a);

723− VAL cl = allocate(sizeof(Closure), 0);

502+ return idris_b64const(vm, (int64_t) A);

724− SETTY(cl, CT_BITS64);

725− cl->info.bits64 = (uint64_t) (int64_t) (int8_t) A;

726− return cl;

727}

503}

728

504

729VAL idris_b16Z32(VM *vm, VAL a) {

505VAL idris_b16Z32(VM *vm, VAL a) {

730− uint16_t A = a->info.bits16;

506+ uint16_t A = GETBITS16(a);

731− VAL cl = allocate(sizeof(Closure), 0);

507+ return idris_b32const(vm, (uint32_t) A);

732− SETTY(cl, CT_BITS32);

733− cl->info.bits32 = (uint32_t) A;

734− return cl;

735}

508}

736

509

737VAL idris_b16Z64(VM *vm, VAL a) {

510VAL idris_b16Z64(VM *vm, VAL a) {

738− uint16_t A = a->info.bits16;

511+ uint16_t A = GETBITS16(a);

739− VAL cl = allocate(sizeof(Closure), 0);

512+ return idris_b64const(vm, (uint64_t) A);

740− SETTY(cl, CT_BITS64);

741− cl->info.bits64 = (uint64_t) A;

742− return cl;

743}

513}

744

514

745VAL idris_b16S32(VM *vm, VAL a) {

515VAL idris_b16S32(VM *vm, VAL a) {

746− uint16_t A = a->info.bits16;

516+ int16_t A = GETBITS16(a);

747− VAL cl = allocate(sizeof(Closure), 0);

517+ return idris_b32const(vm, (int32_t) A);

748− SETTY(cl, CT_BITS32);

749− cl->info.bits32 = (uint32_t) (int32_t) (int16_t) A;

750− return cl;

751}

518}

752

519

753VAL idris_b16S64(VM *vm, VAL a) {

520VAL idris_b16S64(VM *vm, VAL a) {

754− uint16_t A = a->info.bits16;

521+ int16_t A = GETBITS16(a);

755− VAL cl = allocate(sizeof(Closure), 0);

522+ return idris_b64const(vm, (int64_t) A);

756− SETTY(cl, CT_BITS64);

757− cl->info.bits64 = (uint64_t) (int64_t) (int16_t) A;

758− return cl;

759}

523}

760

524

761VAL idris_b16T8(VM *vm, VAL a) {

525VAL idris_b16T8(VM *vm, VAL a) {

762− uint16_t A = a->info.bits16;

526+ uint16_t A = GETBITS16(a);

763− VAL cl = allocate(sizeof(Closure), 0);

527+ return idris_b8const(vm, (uint8_t) A);

764− SETTY(cl, CT_BITS8);

765− cl->info.bits8 = (uint8_t) A;

766− return cl;

767}

528}

768

529

769VAL idris_b32Z64(VM *vm, VAL a) {

530VAL idris_b32Z64(VM *vm, VAL a) {

770− uint32_t A = a->info.bits32;

531+ uint32_t A = GETBITS32(a);

771− VAL cl = allocate(sizeof(Closure), 0);

532+ return idris_b64const(vm, (uint64_t) A);

772− SETTY(cl, CT_BITS64);

773− cl->info.bits64 = (uint64_t) A;

774− return cl;

775}

533}

776

534

777VAL idris_b32S64(VM *vm, VAL a) {

535VAL idris_b32S64(VM *vm, VAL a) {

778− uint32_t A = a->info.bits32;

536+ int32_t A = GETBITS32(a);

779− VAL cl = allocate(sizeof(Closure), 0);

537+ return idris_b64const(vm, (int64_t) A);

780− SETTY(cl, CT_BITS64);

781− cl->info.bits64 = (uint64_t) (int64_t) (int32_t) A;

782− return cl;

783}

538}

784

539

785VAL idris_b32T8(VM *vm, VAL a) {

540VAL idris_b32T8(VM *vm, VAL a) {

786− uint32_t A = a->info.bits32;

541+ uint32_t A = GETBITS32(a);

787− VAL cl = allocate(sizeof(Closure), 0);

542+ return idris_b8const(vm, (uint8_t) A);

788− SETTY(cl, CT_BITS8);

789− cl->info.bits8 = (uint8_t) A;

790− return cl;

791}

543}

792

544

793VAL idris_b32T16(VM *vm, VAL a) {

545VAL idris_b32T16(VM *vm, VAL a) {

794− uint32_t A = a->info.bits32;

546+ uint32_t A = GETBITS32(a);

795− VAL cl = allocate(sizeof(Closure), 0);

547+ return idris_b16const(vm, (uint16_t) A);

796− SETTY(cl, CT_BITS16);

797− cl->info.bits16 = (uint16_t) A;

798− return cl;

799}

548}

800

549

801VAL idris_b64T8(VM *vm, VAL a) {

550VAL idris_b64T8(VM *vm, VAL a) {

802− uint64_t A = a->info.bits64;

551+ uint64_t A = GETBITS64(a);

803− VAL cl = allocate(sizeof(Closure), 0);

552+ return idris_b8const(vm, (uint8_t) A);

804− SETTY(cl, CT_BITS8);

805− cl->info.bits8 = (uint8_t) A;

806− return cl;

807}

553}

808

554

809VAL idris_b64T16(VM *vm, VAL a) {

555VAL idris_b64T16(VM *vm, VAL a) {

810− uint64_t A = a->info.bits64;

556+ uint64_t A = GETBITS64(a);

811− VAL cl = allocate(sizeof(Closure), 0);

557+ return idris_b16const(vm, (uint16_t) A);

812− SETTY(cl, CT_BITS16);

813− cl->info.bits16 = (uint16_t) A;

814− return cl;

815}

558}

816

559

817VAL idris_b64T32(VM *vm, VAL a) {

560VAL idris_b64T32(VM *vm, VAL a) {

818− uint64_t A = a->info.bits64;

561+ uint64_t A = GETBITS64(a);

819− VAL cl = allocate(sizeof(Closure), 0);

562+ return idris_b32const(vm, (uint32_t) A);

820− SETTY(cl, CT_BITS32);

821− cl->info.bits32 = (uint32_t) A;

822− return cl;

823}

563}

824

564

825VAL idris_peekB8(VM* vm, VAL ptr, VAL offset) {

565VAL idris_peekB8(VM* vm, VAL ptr, VAL offset) {

rts/idris_bitstring.h−5

@@ -1,11 +1,6 @@

1#ifndef _IDRISBITSTRING_H

2#define _IDRISBITSTRING_H

4−VAL idris_b8CopyForGC(VM *vm, VAL a);

5−VAL idris_b16CopyForGC(VM *vm, VAL a);

6−VAL idris_b32CopyForGC(VM *vm, VAL a);

7−VAL idris_b64CopyForGC(VM *vm, VAL a);

8−

9VAL idris_b8(VM *vm, VAL a);

4VAL idris_b8(VM *vm, VAL a);

10VAL idris_b16(VM *vm, VAL a);

5VAL idris_b16(VM *vm, VAL a);

11VAL idris_b32(VM *vm, VAL a);

6VAL idris_b32(VM *vm, VAL a);

rts/idris_buffer.c+5−19

@@ -82,9 +82,9 @@ uint8_t idris_getBufferByte(void* buffer, int loc) {

82int idris_getBufferInt(void* buffer, int loc) {

83 Buffer* b = buffer;

84 if (loc >= 0 && loc+3 < b->size) {

85− return b->data[loc] +

85+ return b->data[loc] +

86 (b->data[loc+1] << 8) +

87− (b->data[loc+2] << 16) +

87+ (b->data[loc+2] << 16) +

88 (b->data[loc+3] << 24);

89 } else {

90 return 0;

@@ -110,22 +110,9 @@ double idris_getBufferDouble(void* buffer, int loc) {

110

111VAL idris_getBufferString(void* buffer, int loc, int len) {

112 Buffer* b = buffer;

113−

113+ char * s = (char*)(b->data + loc);

114− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

115− sizeof(char)*(len+1), 0);

116− SETTY(cl, CT_STRING);

117− cl->info.str.str = (char*)cl + sizeof(Closure);

118−

119− if (loc >= 0 && loc+len <= b->size) {

114+ size_t sz = loc >= 0 && loc+len <= b->size? len : 0;

120− memcpy(cl->info.str.str, (b->data)+loc, len);

115+ return MKSTRlen(get_vm(), s, sz);

121− cl->info.str.str[len]='\0';

122− cl->info.str.len = len;

123− } else {

124− cl->info.str.str[0] = '\0';

125− cl->info.str.len = 0;

126− }

127−

128− return cl;

129}

116}

130

117

131int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {

118int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {

@@ -153,4 +140,3 @@ void idris_writeBuffer(FILE* h, void* buffer, int loc, int len) {

153 fwrite((b->data)+loc, sizeof(uint8_t), len, h);

140 fwrite((b->data)+loc, sizeof(uint8_t), len, h);

154 }

141 }

155}

142}

156−

rts/idris_gc.c+38−63

@@ -5,115 +5,90 @@

5#include <assert.h>

7VAL copy(VM* vm, VAL x) {

8− int ar, len;

8+ int ar;

9− Closure* cl = NULL;

9+ VAL cl;

10 if (x==NULL || ISINT(x)) {

11 return x;

12 }

13 switch(GETTY(x)) {

14+ case CT_FWD:

15+ return GETPTR(x);

16+ case CT_CDATA:

17+ cl = MKCDATAc(vm, GETCDATA(x));

18+ c_heap_mark_item(GETCDATA(x));

19+ break;

20+ case CT_BIGINT:

21+ cl = MKBIGMc(vm, GETMPZ(x));

22+ break;

14 case CT_CON:

23 case CT_CON:

15 ar = CARITY(x);

24 ar = CARITY(x);

16 if (ar == 0 && CTAG(x) < 256) {

25 if (ar == 0 && CTAG(x) < 256) {

17 return x;

26 return x;

18− } else {

19− allocCon(cl, vm, CTAG(x), ar, 1);

20− memcpy(&(cl->info.c.args), &(x->info.c.args), sizeof(VAL)*ar);

21 }

27 }

22− break;

28+ // FALLTHROUGH

23 case CT_ARRAY:

29 case CT_ARRAY:

24− len = x->info.arr.length;

25− allocArray(cl, vm, len, 1);

26− memcpy(&(cl->info.arr.content), &(x->info.arr.content), sizeof(VAL)*len);

27− break;

28− case CT_FLOAT:

29− cl = MKFLOATc(vm, x->info.f);

30− break;

31 case CT_STRING:

30 case CT_STRING:

32− cl = MKSTRclen(vm, x->info.str.str, x->info.str.len);

31+ case CT_REF:

33− break;

32+ case CT_FLOAT:

34 case CT_STROFFSET:

33 case CT_STROFFSET:

35− cl = MKSTROFFc(vm, x->info.str_offset);

36− break;

37− case CT_BIGINT:

38− cl = MKBIGMc(vm, x->info.ptr);

39− break;

40 case CT_PTR:

34 case CT_PTR:

41− cl = MKPTRc(vm, x->info.ptr);

42− break;

43 case CT_MANAGEDPTR:

35 case CT_MANAGEDPTR:

44− cl = MKMPTRc(vm, x->info.mptr->data, x->info.mptr->size);

45− break;

46 case CT_BITS8:

36 case CT_BITS8:

47− cl = idris_b8CopyForGC(vm, x);

48− break;

49 case CT_BITS16:

37 case CT_BITS16:

50− cl = idris_b16CopyForGC(vm, x);

51− break;

52 case CT_BITS32:

38 case CT_BITS32:

53− cl = idris_b32CopyForGC(vm, x);

54− break;

55 case CT_BITS64:

39 case CT_BITS64:

56− cl = idris_b64CopyForGC(vm, x);

57− break;

58− case CT_REF:

59− cl = idris_newRefLock((VAL)(x->info.ptr), 1);

60− break;

61− case CT_FWD:

62− return x->info.ptr;

63 case CT_RAWDATA:

40 case CT_RAWDATA:

64− {

41+ cl = iallocate(vm, x->hdr.sz, 1);

65− size_t size = x->info.size + sizeof(Closure);

66− cl = allocate(size, 1);

67− memcpy(cl, x, size);

42+ memcpy(cl, x, x->hdr.sz);

68− }

69− break;

70− case CT_CDATA:

71− cl = MKCDATAc(vm, x->info.c_heap_item);

72− c_heap_mark_item(x->info.c_heap_item);

73 break;

43 break;

74 default:

44 default:

45+ cl = NULL;

75 break;

46 break;

76 }

47 }

77 SETTY(x, CT_FWD);

48 SETTY(x, CT_FWD);

78− x->info.ptr = cl;

49+ ((Fwd*)x)->fwd = cl;

79 return cl;

50 return cl;

80}

51}

82void cheney(VM *vm) {

53void cheney(VM *vm) {

83− int i;

84− int ar, len;

85 char* scan = aligned_heap_pointer(vm->heap.heap);

54 char* scan = aligned_heap_pointer(vm->heap.heap);

87 while(scan < vm->heap.next) {

56 while(scan < vm->heap.next) {

88− size_t inc = *((size_t*)scan);

89− VAL heap_item = (VAL)(scan+sizeof(size_t));

57+ VAL heap_item = (VAL)scan;

90 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments

58 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments

91 switch(GETTY(heap_item)) {

59 switch(GETTY(heap_item)) {

92 case CT_CON:

60 case CT_CON:

61+ {

93− ar = ARITY(heap_item);

62+ Con * c = (Con*)heap_item;

63+ size_t len = CARITY(c);

94− for(i = 0; i < ar; ++i) {

64+ for(size_t i = 0; i < len; ++i)

95− VAL newptr = copy(vm, heap_item->info.c.args[i]);

65+ c->args[i] = copy(vm, c->args[i]);

96− heap_item->info.c.args[i] = newptr;

97 }

66 }

98 break;

67 break;

99 case CT_ARRAY:

68 case CT_ARRAY:

100− len = heap_item->info.arr.length;

69+ {

70+ Array * a = (Array*)heap_item;

71+ size_t len = CELEM(a);

101− for(i = 0; i < len; ++i) {

72+ for(size_t i = 0; i < len; ++i)

102− VAL newptr = copy(vm, heap_item->info.arr.content[i]);

73+ a->array[i] = copy(vm, a->array[i]);

103− heap_item->info.arr.content[i] = newptr;

104 }

74 }

105 break;

75 break;

106 case CT_REF:

76 case CT_REF:

107− heap_item->info.ptr = copy(vm, (VAL)(heap_item->info.ptr));

77+ {

78+ Ref * r = (Ref*)heap_item;

79+ r->ref = copy(vm, r->ref);

80+ }

108 break;

81 break;

109 case CT_STROFFSET:

82 case CT_STROFFSET:

110− heap_item->info.str_offset->str

83+ {

111− = copy(vm, heap_item->info.str_offset->str);

84+ StrOffset * s = (StrOffset*)heap_item;

85+ s->base = (String*)copy(vm, (VAL)s->base);

86+ }

112 break;

87 break;

113 default: // Nothing to copy

88 default: // Nothing to copy

114 break;

89 break;

115 }

90 }

116− scan += inc;

91+ scan += aligned(valSize(heap_item));

117 }

92 }

118 assert(scan == vm->heap.next);

93 assert(scan == vm->heap.next);

119}

94}

rts/idris_gmp.c+79−210

@@ -22,249 +22,126 @@ VAL MKBIGI(int val) {

22 return MKINT((i_int)val);

23}

25+static BigInt * allocBig(VM * vm) {

26+ idris_requireAlloc(vm, IDRIS_MAXGMP);

27+ BigInt * cl = iallocate(vm, sizeof(*cl) + sizeof(mpz_t), 0);

28+ idris_doneAlloc(vm);

29+ SETTY(cl, CT_BIGINT);

30+ mpz_init(*getmpz(cl));

31+ return cl;

32+}

33+

25VAL MKBIGC(VM* vm, char* val) {

34VAL MKBIGC(VM* vm, char* val) {

26 if (*val == '\0') {

35 if (*val == '\0') {

27 return MKBIGI(0);

36 return MKBIGI(0);

28 }

37 }

29 else {

38 else {

30− idris_requireAlloc(IDRIS_MAXGMP);

39+ BigInt * cl = allocBig(vm);

31− mpz_t* bigint;

32−

33− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

34− idris_doneAlloc();

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

36−

37− mpz_init(*bigint);

38− mpz_set_str(*bigint, val, 10);

40+ mpz_set_str(*getmpz(cl), val, 10);

39−

40− SETTY(cl, CT_BIGINT);

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

42−

43− return cl;

41+ return (VAL)cl;

44 }

42 }

45}

43}

47−VAL MKBIGM(VM* vm, void* big) {

45+VAL MKBIGM(VM* vm, void* ibig) {

48− idris_requireAlloc(IDRIS_MAXGMP);

46+ BigInt * cl = allocBig(vm);

49−

50− mpz_t* bigint;

51− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

52− idris_doneAlloc();

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

54−

55− mpz_init(*bigint);

56− mpz_set(*bigint, *((mpz_t*)big));

47+ mpz_set(*getmpz(cl), *((mpz_t*)ibig));

57−

58− SETTY(cl, CT_BIGINT);

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

60−

61− return cl;

48+ return (VAL)cl;

62}

49}

64−VAL MKBIGMc(VM* vm, void* big) {

51+VAL MKBIGMc(VM* vm, void* ibig) {

65− idris_requireAlloc(IDRIS_MAXGMP);

52+ BigInt * cl = allocBig(vm);

66−

67− mpz_t* bigint;

68− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

69− idris_doneAlloc();

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

71−

72− mpz_init_set(*bigint, *((mpz_t*)big));

53+ mpz_init_set(*getmpz(cl), *((mpz_t*)ibig));

73−

74− SETTY(cl, CT_BIGINT);

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

76−

77− return cl;

54+ return (VAL)cl;

78}

55}

80VAL MKBIGUI(VM* vm, unsigned long val) {

57VAL MKBIGUI(VM* vm, unsigned long val) {

81− idris_requireAlloc(IDRIS_MAXGMP);

58+ BigInt * cl = allocBig(vm);

82−

83− mpz_t* bigint;

84− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

85− idris_doneAlloc();

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

87−

88− mpz_init_set_ui(*bigint, val);

59+ mpz_init_set_ui(*getmpz(cl), val);

89−

90− SETTY(cl, CT_BIGINT);

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

92−

93− return cl;

60+ return (VAL)cl;

94}

61}

96VAL MKBIGSI(VM* vm, signed long val) {

63VAL MKBIGSI(VM* vm, signed long val) {

97− idris_requireAlloc(IDRIS_MAXGMP);

64+ BigInt * cl = allocBig(vm);

98−

99− mpz_t* bigint;

100− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

101− idris_doneAlloc();

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

103−

104− mpz_init_set_si(*bigint, val);

65+ mpz_init_set_si(*getmpz(cl), val);

105−

106− SETTY(cl, CT_BIGINT);

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

108−

109− return cl;

66+ return (VAL)cl;

110}

67}

111

112−VAL GETBIG(VM * vm, VAL x) {

69+static BigInt * getbig(VM * vm, VAL x) {

113− idris_requireAlloc(IDRIS_MAXGMP);

114−

115 if (ISINT(x)) {

70 if (ISINT(x)) {

116− mpz_t* bigint;

71+ BigInt * cl = allocBig(vm);

117− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

118− idris_doneAlloc();

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

120−

121− mpz_init(*bigint);

122− mpz_set_si(*bigint, GETINT(x));

72+ mpz_set_si(*getmpz(cl), GETINT(x));

123−

124− SETTY(cl, CT_BIGINT);

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

126−

127 return cl;

73 return cl;

128 } else {

74 } else {

129− idris_doneAlloc();

130 switch(GETTY(x)) {

75 switch(GETTY(x)) {

131 case CT_FWD:

76 case CT_FWD:

132− return GETBIG(vm, x->info.ptr);

77+ return getbig(vm, ((Fwd*)x)->fwd);

133 default:

78 default:

134− return x;

79+ return (BigInt*)x;

135 }

80 }

136 }

81 }

137}

82}

138

139−VAL bigAdd(VM* vm, VAL x, VAL y) {

84+#define GETBIG (VAL)getbig

140− idris_requireAlloc(IDRIS_MAXGMP);

141

142− mpz_t* bigint;

86+VAL bigAdd(VM* vm, VAL x, VAL y) {

143− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

87+ BigInt * cl = allocBig(vm);

144− idris_doneAlloc();

88+ mpz_add(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

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

146− mpz_add(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

147− SETTY(cl, CT_BIGINT);

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

149− return cl;

89+ return (VAL)cl;

150}

90}

151

152VAL bigSub(VM* vm, VAL x, VAL y) {

92VAL bigSub(VM* vm, VAL x, VAL y) {

153− idris_requireAlloc(IDRIS_MAXGMP);

93+ BigInt * cl = allocBig(vm);

154−

94+ mpz_sub(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

155− mpz_t* bigint;

156− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

157− idris_doneAlloc();

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

159− mpz_sub(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

160− SETTY(cl, CT_BIGINT);

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

162− return cl;

95+ return (VAL)cl;

163}

96}

164

165VAL bigMul(VM* vm, VAL x, VAL y) {

98VAL bigMul(VM* vm, VAL x, VAL y) {

166− idris_requireAlloc(IDRIS_MAXGMP);

99+ BigInt * cl = allocBig(vm);

167−

100+ mpz_mul(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

168− mpz_t* bigint;

169− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

170− idris_doneAlloc();

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

172− mpz_mul(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

173− SETTY(cl, CT_BIGINT);

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

175− return cl;

101+ return (VAL)cl;

176}

102}

177

103

178VAL bigDiv(VM* vm, VAL x, VAL y) {

104VAL bigDiv(VM* vm, VAL x, VAL y) {

179− idris_requireAlloc(IDRIS_MAXGMP);

105+ BigInt * cl = allocBig(vm);

180−

106+ mpz_tdiv_q(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

181− mpz_t* bigint;

182− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

183− idris_doneAlloc();

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

185− mpz_tdiv_q(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

186− SETTY(cl, CT_BIGINT);

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

188− return cl;

107+ return (VAL)cl;

189}

108}

190

109

191VAL bigMod(VM* vm, VAL x, VAL y) {

110VAL bigMod(VM* vm, VAL x, VAL y) {

192− idris_requireAlloc(IDRIS_MAXGMP);

111+ BigInt * cl = allocBig(vm);

193−

112+ mpz_tdiv_r(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

194− mpz_t* bigint;

195− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

196− idris_doneAlloc();

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

198− mpz_tdiv_r(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

199− SETTY(cl, CT_BIGINT);

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

201− return cl;

113+ return (VAL)cl;

202}

114}

203

115

204VAL bigAnd(VM* vm, VAL x, VAL y) {

116VAL bigAnd(VM* vm, VAL x, VAL y) {

205− idris_requireAlloc(IDRIS_MAXGMP);

117+ BigInt * cl = allocBig(vm);

206−

118+ mpz_and(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

207− mpz_t* bigint;

208− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

209− idris_doneAlloc();

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

211− mpz_and(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

212− SETTY(cl, CT_BIGINT);

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

214− return cl;

119+ return (VAL)cl;

215}

120}

216

121

217VAL bigOr(VM* vm, VAL x, VAL y) {

122VAL bigOr(VM* vm, VAL x, VAL y) {

218− idris_requireAlloc(IDRIS_MAXGMP);

123+ BigInt * cl = allocBig(vm);

219−

124+ mpz_ior(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

220− mpz_t* bigint;

221− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

222− idris_doneAlloc();

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

224− mpz_ior(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

225− SETTY(cl, CT_BIGINT);

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

227− return cl;

125+ return (VAL)cl;

228}

126}

229

127

230VAL bigShiftLeft(VM* vm, VAL x, VAL y) {

128VAL bigShiftLeft(VM* vm, VAL x, VAL y) {

231− idris_requireAlloc(IDRIS_MAXGMP);

129+ BigInt * cl = allocBig(vm);

232−

233− mpz_t* bigint;

234− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

235− idris_doneAlloc();

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

237− mpz_mul_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

130+ mpz_mul_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));

238− SETTY(cl, CT_BIGINT);

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

240− return cl;

131+ return (VAL)cl;

241}

132}

242

133

243

134

244VAL bigLShiftRight(VM* vm, VAL x, VAL y) {

135VAL bigLShiftRight(VM* vm, VAL x, VAL y) {

245− idris_requireAlloc(IDRIS_MAXGMP);

136+ BigInt * cl = allocBig(vm);

246−

247− mpz_t* bigint;

248− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

249− idris_doneAlloc();

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

251− mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

137+ mpz_fdiv_q_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));

252− SETTY(cl, CT_BIGINT);

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

254− return cl;

138+ return (VAL)cl;

255}

139}

256

140

257VAL bigAShiftRight(VM* vm, VAL x, VAL y) {

141VAL bigAShiftRight(VM* vm, VAL x, VAL y) {

258− idris_requireAlloc(IDRIS_MAXGMP);

142+ BigInt * cl = allocBig(vm);

259−

260− mpz_t* bigint;

261− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

262− idris_doneAlloc();

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

264− mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

143+ mpz_fdiv_q_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));

265− SETTY(cl, CT_BIGINT);

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

267− return cl;

144+ return (VAL)cl;

268}

145}

269

146

270VAL idris_bigAnd(VM* vm, VAL x, VAL y) {

147VAL idris_bigAnd(VM* vm, VAL x, VAL y) {

@@ -323,15 +200,15 @@ VAL idris_bigTimes(VM* vm, VAL x, VAL y) {

323 if (ISINT(x) && ISINT(y)) {

200 if (ISINT(x) && ISINT(y)) {

324 i_int vx = GETINT(x);

201 i_int vx = GETINT(x);

325 i_int vy = GETINT(y);

202 i_int vy = GETINT(y);

326− // we could work out likelihood of overflow by checking the number

203+ // we could work out likelihood of overflow by checking the number

327− // of necessary bits. Here's a quick conservative hack instead.

204+ // of necessary bits. Here's a quick conservative hack instead.

328− if ((vx < (1<<15) && vy < (1<16)) ||

205+ if ((vx < (1<<15) && vy < (1<16)) ||

329− (vx < (1<<16) && vy < (1<15)) ||

206+ (vx < (1<<16) && vy < (1<15)) ||

330− (vx < (1<<20) && vy < (1<11)) ||

207+ (vx < (1<<20) && vy < (1<11)) ||

331− (vx < (1<<11) && vy < (1<20)) ||

208+ (vx < (1<<11) && vy < (1<20)) ||

332− (vx < (1<<23) && vy < (1<<8)) ||

209+ (vx < (1<<23) && vy < (1<<8)) ||

333− (vx < (1<<8) && vy < (1<<23))) { // ultra-conservative!

210+ (vx < (1<<8) && vy < (1<<23))) { // ultra-conservative!

334− return INTOP(*,x,y);

211+ return INTOP(*,x,y);

335 } else {

212 } else {

336 return bigMul(vm, GETBIG(vm, x), GETBIG(vm, y));

213 return bigMul(vm, GETBIG(vm, x), GETBIG(vm, y));

337 }

214 }

@@ -382,8 +259,8 @@ VAL idris_bigMod(VM* vm, VAL x, VAL y) {

382

259

383int bigEqConst(VAL x, int c) {

260int bigEqConst(VAL x, int c) {

384 if (ISINT(x)) { return (GETINT(x) == c); }

261 if (ISINT(x)) { return (GETINT(x) == c); }

385− else {

262+ else {

386− int rv = mpz_cmp_si(GETMPZ(x), c);

263+ int rv = mpz_cmp_si(GETMPZ(x), c);

387 return (rv == 0);

264 return (rv == 0);

388 }

265 }

389}

266}

@@ -471,17 +348,9 @@ VAL idris_castBigFloat(VM* vm, VAL i) {

471

348

472VAL idris_castFloatBig(VM* vm, VAL f) {

349VAL idris_castFloatBig(VM* vm, VAL f) {

473 double val = GETFLOAT(f);

350 double val = GETFLOAT(f);

474−

351+ BigInt * cl = allocBig(vm);

475− mpz_t* bigint;

476− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

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

478−

479− mpz_init_set_d(*bigint, val);

352+ mpz_init_set_d(*getmpz(cl), val);

480−

481− SETTY(cl, CT_BIGINT);

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

483−

484− return cl;

353+ return (VAL)cl;

485}

354}

486

355

487VAL idris_castStrBig(VM* vm, VAL i) {

356VAL idris_castStrBig(VM* vm, VAL i) {

@@ -489,7 +358,7 @@ VAL idris_castStrBig(VM* vm, VAL i) {

489}

358}

490

359

491VAL idris_castBigStr(VM* vm, VAL i) {

360VAL idris_castBigStr(VM* vm, VAL i) {

492− char* str = mpz_get_str(NULL, 10, GETMPZ(GETBIG(vm, i)));

361+ char* str = mpz_get_str(NULL, 10, *getmpz(getbig(vm, i)));

493 return MKSTR(vm, str);

362 return MKSTR(vm, str);

494}

363}

495

364

@@ -502,7 +371,7 @@ uint64_t idris_truncBigB64(const mpz_t bi) {

502 }

371 }

503 int64_t out = mpz_get_ui(bi);

372 int64_t out = mpz_get_ui(bi);

504 if (mpz_size(bi) > 1) {

373 if (mpz_size(bi) > 1) {

505− out |= mpz_getlimbn(bi, 1) << 32;

374+ out |= ((int64_t)mpz_getlimbn(bi, 1)) << 32;

506 }

375 }

507 return out;

376 return out;

508}

377}

rts/idris_gmp.h+5−1

@@ -48,6 +48,10 @@ VAL idris_bigLShiftRight(VM* vm, VAL x, VAL y);

49uint64_t idris_truncBigB64(const mpz_t bi);

51+static inline mpz_t * getmpz(BigInt * v) {

52+ return (mpz_t*)(v->big);

53+}

54+

51−#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))

55+#define GETMPZ(x) *getmpz((BigInt*)x)

53#endif

57#endif

rts/idris_heap.c+7−6

@@ -55,7 +55,7 @@ void c_heap_insert_if_needed(VM * vm, CHeap * heap, CHeapItem * item)

55 heap->first = item;

57 // at this point, links are done; let's calculate sizes

58−

58+

59 heap->size += item->size;

60 if (heap->size >= heap->gc_trigger_size)

61 {

@@ -186,16 +186,17 @@ void heap_check_pointers(Heap * heap) {

186

187 size_t item_size = 0;

188 for(scan = heap->heap; scan < heap->next; scan += item_size) {

189− item_size = *((size_t*)scan);

189+ VAL heap_item = (VAL)scan;

190− VAL heap_item = (VAL)(scan + sizeof(size_t));

190+ item_size = aligned(valSize(heap_item));

191

192 switch(GETTY(heap_item)) {

193 case CT_CON:

194 {

195− int ar = ARITY(heap_item);

195+ Con * c = (Con*)heap_item;

196− int i = 0;

196+ size_t ar = CARITY(c);

197+ size_t i;

197 for(i = 0; i < ar; ++i) {

198 for(i = 0; i < ar; ++i) {

198− VAL ptr = heap_item->info.c.args[i];

199+ VAL ptr = c->args[i];

199

200

200 if (is_valid_ref(ptr)) {

201 if (is_valid_ref(ptr)) {

201 // Check for closure.

202 // Check for closure.

rts/idris_main.c+1−2

@@ -33,7 +33,7 @@ int win32_get_argv_utf8(int *argc_ptr, char ***argv_ptr)

33#endif

35// The default options should give satisfactory results under many circumstances.

36−RTSOpts opts = {

36+RTSOpts opts = {

37 .init_heap_size = 16384000,

38 .max_stack_size = 4096000,

39 .show_summary = 0

@@ -74,6 +74,5 @@ int main(int argc, char **argv) {

74 print_stats(&stats);

75 }

77− free_nullaries();

78 return EXIT_SUCCESS;

77 return EXIT_SUCCESS;

79}

78}

rts/idris_rts.c+246−325

@@ -7,13 +7,22 @@

7#include "idris_bitstring.h"

8#include "getline.h"

10+#define STATIC_ASSERT(COND,MSG) typedef char static_assertion_##MSG[(COND)?1:-1]

11+

12+STATIC_ASSERT(sizeof(Hdr) == 8, condSizeOfHdr);

13+

14+#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)

15+#include <signal.h>

16+#endif

17+

18+

10#ifdef HAS_PTHREAD

19#ifdef HAS_PTHREAD

11static pthread_key_t vm_key;

20static pthread_key_t vm_key;

12#else

21#else

13static VM* global_vm;

22static VM* global_vm;

14#endif

23#endif

16−void free_key(VM *vm) {

25+void free_key(void *vvm) {

17 // nothing to free, we just used the VM pointer which is freed elsewhere

26 // nothing to free, we just used the VM pointer which is freed elsewhere

18}

27}

@@ -83,7 +92,6 @@ VM* idris_vm(void) {

84VM* get_vm(void) {

93VM* get_vm(void) {

85#ifdef HAS_PTHREAD

94#ifdef HAS_PTHREAD

86− init_threadkeys();

87 return pthread_getspecific(vm_key);

95 return pthread_getspecific(vm_key);

88#else

96#else

89 return global_vm;

97 return global_vm;

@@ -96,7 +104,7 @@ void close_vm(VM* vm) {

104

97#ifdef HAS_PTHREAD

105#ifdef HAS_PTHREAD

98void create_key(void) {

106void create_key(void) {

99− pthread_key_create(&vm_key, (void*)free_key);

107+ pthread_key_create(&vm_key, free_key);

100}

108}

101#endif

109#endif

102

110

@@ -155,13 +163,7 @@ CData cdata_manage(void * data, size_t size, CDataFinalizer finalizer)

155 return c_heap_create_item(data, size, finalizer);

163 return c_heap_create_item(data, size, finalizer);

156}

164}

157

165

158−void idris_requireAlloc(size_t size) {

166+void idris_requireAlloc(VM * vm, size_t size) {

159−#ifdef HAS_PTHREAD

160− VM* vm = pthread_getspecific(vm_key);

161−#else

162− VM* vm = global_vm;

163−#endif

164−

165 if (!(vm->heap.next + size < vm->heap.end)) {

167 if (!(vm->heap.next + size < vm->heap.end)) {

166 idris_gc(vm);

168 idris_gc(vm);

167 }

169 }

@@ -173,9 +175,8 @@ void idris_requireAlloc(size_t size) {

173#endif

175#endif

174}

176}

175

177

176−void idris_doneAlloc(void) {

178+void idris_doneAlloc(VM * vm) {

177#ifdef HAS_PTHREAD

179#ifdef HAS_PTHREAD

178− VM* vm = pthread_getspecific(vm_key);

179 int lock = vm->processes > 0;

180 int lock = vm->processes > 0;

180 if (lock) { // We only need to lock if we're in concurrent mode

181 if (lock) { // We only need to lock if we're in concurrent mode

181 pthread_mutex_unlock(&vm->alloc_lock);

182 pthread_mutex_unlock(&vm->alloc_lock);

@@ -184,14 +185,13 @@ void idris_doneAlloc(void) {

184}

185}

185

186

186int space(VM* vm, size_t size) {

187int space(VM* vm, size_t size) {

187− return (vm->heap.next + size + sizeof(size_t) < vm->heap.end);

188+ return (vm->heap.next + size) < vm->heap.end;

188}

189}

189

190

190void* idris_alloc(size_t size) {

191void* idris_alloc(size_t size) {

191− Closure* cl = (Closure*) allocate(sizeof(Closure)+size, 0);

192+ RawData * cl = (RawData*) allocate(sizeof(*cl)+size, 0);

192 SETTY(cl, CT_RAWDATA);

193 SETTY(cl, CT_RAWDATA);

193− cl->info.size = size;

194− return (void*)((char *)cl+sizeof(Closure));

194+ return (void*)cl->raw;

195}

196

197void* idris_realloc(void* old, size_t old_size, size_t size) {

@@ -203,41 +203,36 @@ void* idris_realloc(void* old, size_t old_size, size_t size) {

203void idris_free(void* ptr, size_t size) {

204}

205

206−void* allocate(size_t size, int outerlock) {

206+void * allocate(size_t sz, int lock) {

207+ return iallocate(get_vm(), sz, lock);

208+}

209+

210+void* iallocate(VM * vm, size_t isize, int outerlock) {

207// return malloc(size);

211// return malloc(size);

212+ size_t size = aligned(isize);

208

213

209#ifdef HAS_PTHREAD

214#ifdef HAS_PTHREAD

210− VM* vm = pthread_getspecific(vm_key);

211 int lock = vm->processes > 0 && !outerlock;

215 int lock = vm->processes > 0 && !outerlock;

212

216

213 if (lock) { // not message passing

217 if (lock) { // not message passing

214 pthread_mutex_lock(&vm->alloc_lock);

218 pthread_mutex_lock(&vm->alloc_lock);

215 }

219 }

216−#else

217− VM* vm = global_vm;

218#endif

220#endif

219

221

220− if ((size & 7)!=0) {

221− size = 8 + ((size >> 3) << 3);

222− }

223−

224− size_t chunk_size = size + sizeof(size_t);

225−

226− if (vm->heap.next + chunk_size < vm->heap.end) {

222+ if (vm->heap.next + size < vm->heap.end) {

227− STATS_ALLOC(vm->stats, chunk_size)

223+ STATS_ALLOC(vm->stats, size)

228− void* ptr = (void*)(vm->heap.next + sizeof(size_t));

229− *((size_t*)(vm->heap.next)) = chunk_size;

224+ char* ptr = vm->heap.next;

230− vm->heap.next += chunk_size;

225+ vm->heap.next += size;

231−

232 assert(vm->heap.next <= vm->heap.end);

226 assert(vm->heap.next <= vm->heap.end);

233−

234 memset(ptr, 0, size);

227 memset(ptr, 0, size);

228+ ((Hdr*)ptr)->sz = isize;

229+

235#ifdef HAS_PTHREAD

230#ifdef HAS_PTHREAD

236 if (lock) { // not message passing

231 if (lock) { // not message passing

237 pthread_mutex_unlock(&vm->alloc_lock);

232 pthread_mutex_unlock(&vm->alloc_lock);

238 }

233 }

239#endif

234#endif

240− return ptr;

235+ return (void*)ptr;

241 } else {

236 } else {

242 // If we're trying to allocate something bigger than the heap,

237 // If we're trying to allocate something bigger than the heap,

243 // grow the heap here so that the new heap is big enough.

238 // grow the heap here so that the new heap is big enough.

@@ -250,173 +245,148 @@ void* allocate(size_t size, int outerlock) {

250 pthread_mutex_unlock(&vm->alloc_lock);

245 pthread_mutex_unlock(&vm->alloc_lock);

251 }

246 }

252#endif

247#endif

253− return allocate(size, 0);

248+ return iallocate(vm, size, outerlock);

254 }

249 }

255

250

256}

251}

257

252

258−/* Now a macro

253+static String * allocStr(VM * vm, size_t len, int outer) {

259−void* allocCon(VM* vm, int arity, int outer) {

254+ String * cl = iallocate(vm, sizeof(*cl) + len + 1, outer);

260− Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity,

261− outer);

262− SETTY(cl, CT_CON);

255+ SETTY(cl, CT_STRING);

256+ cl->slen = len;

257+ return cl;

258+}

263

259

264− cl -> info.c.arity = arity;

260+static VAL mkfloat(VM* vm, double val, int outer) {

265−// cl -> info.c.tag = 42424242;

261+ Float * cl = iallocate(vm, sizeof(*cl), outer);

266−// printf("%p\n", cl);

262+ SETTY(cl, CT_FLOAT);

263+ cl->f = val;

267− return (void*)cl;

264+ return (VAL)cl;

268}

265}

269−*/

270

266

271VAL MKFLOAT(VM* vm, double val) {

267VAL MKFLOAT(VM* vm, double val) {

272− Closure* cl = allocate(sizeof(Closure), 0);

268+ return mkfloat(vm, val, 0);

273− SETTY(cl, CT_FLOAT);

269+}

274− cl -> info.f = val;

270+

275− return cl;

271+VAL MKFLOATc(VM* vm, double val) {

272+ return mkfloat(vm, val, 1);

273+}

274+

275+static VAL mkstrlen(VM* vm, const char * str, size_t len, int outer) {

276+ String * cl = allocStr(vm, len, outer);

277+ // hdr.u8 used to mark a null string

278+ cl->hdr.u8 = str == NULL;

279+ memcpy(cl->str, str, len);

280+ return (VAL)cl;

281+}

282+

283+VAL MKSTRlen(VM* vm, const char * str, size_t len) {

284+ return mkstrlen(vm, str, len, 0);

285+}

286+

287+VAL MKSTRclen(VM* vm, char* str, size_t len) {

288+ return mkstrlen(vm, str, len, 1);

276}

289}

277

290

278VAL MKSTR(VM* vm, const char* str) {

291VAL MKSTR(VM* vm, const char* str) {

279− int len;

292+ return mkstrlen(vm, str, str? strlen(str) : 0, 0);

280− if (str == NULL) {

293+}

281− len = 0;

294+

282− } else {

295+VAL MKSTRc(VM* vm, char* str) {

283− len = strlen(str)+1;

296+ return mkstrlen(vm, str, strlen(str), 1);

284− }

297+}

285− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

298+

286− sizeof(char)*len, 0);

299+static char * getstroff(StrOffset * stroff) {

287− SETTY(cl, CT_STRING);

300+ return stroff->base->str + stroff->offset;

288− cl->info.str.str = (char*)cl + sizeof(Closure);

289− if (str == NULL) {

290− cl->info.str.str = NULL;

291− } else {

292− strcpy(cl->info.str.str, str);

293− }

294− cl->info.str.len = len > 0 ? len : 0;

295− return cl;

296}

301}

297

302

298char* GETSTROFF(VAL stroff) {

303char* GETSTROFF(VAL stroff) {

299 // Assume STROFF

304 // Assume STROFF

300− StrOffset* root = stroff->info.str_offset;

305+ return getstroff((StrOffset*)stroff);

301− return (root->str->info.str.str + root->offset);

306+}

307+

308+static size_t getstrofflen(StrOffset * stroff) {

309+ return stroff->base->slen - stroff->offset;

302}

310}

303

311

304size_t GETSTROFFLEN(VAL stroff) {

312size_t GETSTROFFLEN(VAL stroff) {

305 // Assume STROFF

313 // Assume STROFF

306 // we're working in char* here so no worries about utf8 char length

314 // we're working in char* here so no worries about utf8 char length

307− StrOffset* root = stroff->info.str_offset;

315+ return getstrofflen((StrOffset*)stroff);

308− return (root->str->info.str.len - root->offset);

309}

316}

310

317

311−VAL MKCDATA(VM* vm, CHeapItem * item) {

318+static VAL mkcdata(VM * vm, CHeapItem * item, int outer) {

312 c_heap_insert_if_needed(vm, &vm->c_heap, item);

319 c_heap_insert_if_needed(vm, &vm->c_heap, item);

313− Closure* cl = allocate(sizeof(Closure), 0);

320+ CDataC * cl = iallocate(vm, sizeof(*cl), outer);

314 SETTY(cl, CT_CDATA);

321 SETTY(cl, CT_CDATA);

315− cl->info.c_heap_item = item;

322+ cl->item = item;

316− return cl;

323+ return (VAL)cl;

317}

324}

318

325

319−VAL MKCDATAc(VM* vm, CHeapItem * item) {

326+VAL MKCDATA(VM* vm, CHeapItem * item) {

320− c_heap_insert_if_needed(vm, &vm->c_heap, item);

321− Closure* cl = allocate(sizeof(Closure), 1);

322− SETTY(cl, CT_CDATA);

323− cl->info.c_heap_item = item;

324− return cl;

327+ return mkcdata(vm, item, 0);

325}

328}

326

329

327−VAL MKPTR(VM* vm, void* ptr) {

330+VAL MKCDATAc(VM* vm, CHeapItem * item) {

328− Closure* cl = allocate(sizeof(Closure), 0);

329− SETTY(cl, CT_PTR);

330− cl -> info.ptr = ptr;

331− return cl;

331+ return mkcdata(vm, item, 1);

332}

333

334−VAL MKMPTR(VM* vm, void* ptr, size_t size) {

334+static VAL mkptr(VM* vm, void* ptr, int outer) {

335− Closure* cl = allocate(sizeof(Closure) +

335+ Ptr * cl = iallocate(vm, sizeof(*cl), outer);

336− sizeof(ManagedPtr) + size, 0);

337− SETTY(cl, CT_MANAGEDPTR);

336+ SETTY(cl, CT_PTR);

338− cl->info.mptr = (ManagedPtr*)((char*)cl + sizeof(Closure));

337+ cl->ptr = ptr;

339− cl->info.mptr->data = (char*)cl + sizeof(Closure) + sizeof(ManagedPtr);

340− memcpy(cl->info.mptr->data, ptr, size);

341− cl->info.mptr->size = size;

342− return cl;

338+ return (VAL)cl;

343}

339}

344

340

345−VAL MKFLOATc(VM* vm, double val) {

341+VAL MKPTR(VM* vm, void* ptr) {

346− Closure* cl = allocate(sizeof(Closure), 1);

347− SETTY(cl, CT_FLOAT);

348− cl -> info.f = val;

349− return cl;

342+ return mkptr(vm, ptr, 0);

350}

343}

351

344

352−VAL MKSTRc(VM* vm, char* str) {

345+VAL MKPTRc(VM* vm, void* ptr) {

353− int len = strlen(str);

354−

355− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

356− sizeof(char)*len+1, 1);

357− SETTY(cl, CT_STRING);

358− cl -> info.str.str = (char*)cl + sizeof(Closure);

359−

360− strcpy(cl->info.str.str, str);

361− cl->info.str.len = len;

362− return cl;

346+ return mkptr(vm, ptr, 1);

363}

347}

364

348

365−VAL MKSTRclen(VM* vm, char* str, int len) {

349+VAL mkmptr(VM* vm, void* ptr, size_t size, int outer) {

366− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

350+ ManagedPtr * cl = iallocate(vm, sizeof(*cl) + size, outer);

367− sizeof(char)*len+1, 1);

351+ SETTY(cl, CT_MANAGEDPTR);

368− SETTY(cl, CT_STRING);

352+ memcpy(cl->mptr, ptr, size);

369− cl -> info.str.str = (char*)cl + sizeof(Closure);

370−

371− strcpy(cl->info.str.str, str);

372− cl->info.str.len = len;

373− return cl;

353+ return (VAL)cl;

374}

354}

375

355

376−VAL MKPTRc(VM* vm, void* ptr) {

356+VAL MKMPTR(VM* vm, void* ptr, size_t size) {

377− Closure* cl = allocate(sizeof(Closure), 1);

378− SETTY(cl, CT_PTR);

379− cl -> info.ptr = ptr;

380− return cl;

357+ return mkmptr(vm, ptr, size, 0);

381}

358}

382

359

383VAL MKMPTRc(VM* vm, void* ptr, size_t size) {

360VAL MKMPTRc(VM* vm, void* ptr, size_t size) {

384− Closure* cl = allocate(sizeof(Closure) +

361+ return mkmptr(vm, ptr, size, 1);

385− sizeof(ManagedPtr) + size, 1);

386− SETTY(cl, CT_MANAGEDPTR);

387− cl->info.mptr = (ManagedPtr*)((char*)cl + sizeof(Closure));

388− cl->info.mptr->data = (char*)cl + sizeof(Closure) + sizeof(ManagedPtr);

389− memcpy(cl->info.mptr->data, ptr, size);

390− cl->info.mptr->size = size;

391− return cl;

392}

362}

393

363

394VAL MKB8(VM* vm, uint8_t bits8) {

364VAL MKB8(VM* vm, uint8_t bits8) {

395− Closure* cl = allocate(sizeof(Closure), 1);

365+ Bits8 * cl = iallocate(vm, sizeof(*cl), 1);

396 SETTY(cl, CT_BITS8);

366 SETTY(cl, CT_BITS8);

397− cl -> info.bits8 = bits8;

367+ cl->bits8 = bits8;

398− return cl;

368+ return (VAL)cl;

399}

369}

400

370

401VAL MKB16(VM* vm, uint16_t bits16) {

371VAL MKB16(VM* vm, uint16_t bits16) {

402− Closure* cl = allocate(sizeof(Closure), 1);

372+ Bits16 * cl = iallocate(vm, sizeof(*cl), 1);

403 SETTY(cl, CT_BITS16);

373 SETTY(cl, CT_BITS16);

404− cl -> info.bits16 = bits16;

374+ cl->bits16 = bits16;

405− return cl;

375+ return (VAL)cl;

406}

376}

407

377

408VAL MKB32(VM* vm, uint32_t bits32) {

378VAL MKB32(VM* vm, uint32_t bits32) {

409− Closure* cl = allocate(sizeof(Closure), 1);

379+ Bits32 * cl = iallocate(vm, sizeof(*cl), 1);

410 SETTY(cl, CT_BITS32);

380 SETTY(cl, CT_BITS32);

411− cl -> info.bits32 = bits32;

381+ cl->bits32 = bits32;

412− return cl;

382+ return (VAL)cl;

413}

383}

414

384

415VAL MKB64(VM* vm, uint64_t bits64) {

385VAL MKB64(VM* vm, uint64_t bits64) {

416− Closure* cl = allocate(sizeof(Closure), 1);

386+ Bits64 * cl = iallocate(vm, sizeof(*cl), 1);

417 SETTY(cl, CT_BITS64);

387 SETTY(cl, CT_BITS64);

418− cl -> info.bits64 = bits64;

388+ cl->bits64 = bits64;

419− return cl;

389+ return (VAL)cl;

420}

390}

421

391

422void idris_trace(VM* vm, const char* func, int line) {

392void idris_trace(VM* vm, const char* func, int line) {

@@ -451,23 +421,35 @@ void dumpVal(VAL v) {

451 }

421 }

452 switch(GETTY(v)) {

422 switch(GETTY(v)) {

453 case CT_CON:

423 case CT_CON:

424+ {

425+ Con * cl = (Con*)v;

454− printf("%d[", TAG(v));

426+ printf("%d[", (int)TAG(cl));

455− for(i = 0; i < ARITY(v); ++i) {

427+ for(i = 0; i < CARITY(cl); ++i) {

456− dumpVal(v->info.c.args[i]);

428+ dumpVal(cl->args[i]);

429+ }

430+ printf("] ");

457 }

431 }

458− printf("] ");

459 break;

432 break;

460 case CT_STRING:

433 case CT_STRING:

434+ {

435+ String * cl = (String*)v;

461− printf("STR[%s]", v->info.str.str);

436+ printf("STR[%s]", cl->str);

437+ }

462 break;

438 break;

463 case CT_STROFFSET:

439 case CT_STROFFSET:

440+ {

441+ StrOffset * cl = (StrOffset*)v;

464− printf("OFFSET[");

442+ printf("OFFSET[");

465− dumpVal((VAL)(v->info.str_offset->str));

443+ dumpVal((VAL)cl->base);

466− printf("]");

444+ printf("]");

445+ }

467 break;

446 break;

468 case CT_FWD:

447 case CT_FWD:

448+ {

449+ Fwd * cl = (Fwd*)v;

469− printf("CT_FWD ");

450+ printf("CT_FWD ");

470− dumpVal((VAL)(v->info.ptr));

451+ dumpVal((VAL)cl->fwd);

452+ }

471 break;

453 break;

472 default:

454 default:

473 printf("val");

455 printf("val");

@@ -489,7 +471,7 @@ void idris_poke(void* ptr, i_int offset, uint8_t data) {

489

471

490

472

491VAL idris_peekPtr(VM* vm, VAL ptr, VAL offset) {

473VAL idris_peekPtr(VM* vm, VAL ptr, VAL offset) {

492− void** addr = (void **)((char *)GETPTR(ptr) + GETINT(offset));

474+ void** addr = (void **)(((char *)GETPTR(ptr)) + GETINT(offset));

493 return MKPTR(vm, *addr);

475 return MKPTR(vm, *addr);

494}

476}

495

477

@@ -523,51 +505,41 @@ void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i

523

505

524VAL idris_castIntStr(VM* vm, VAL i) {

506VAL idris_castIntStr(VM* vm, VAL i) {

525 int x = (int) GETINT(i);

507 int x = (int) GETINT(i);

526− Closure* cl = allocate(sizeof(Closure) + sizeof(char)*16, 0);

508+ String * cl = allocStr(vm, 16, 0);

527− SETTY(cl, CT_STRING);

528− cl->info.str.str = (char*)cl + sizeof(Closure);

529− sprintf(cl->info.str.str, "%d", x);

509+ cl->slen = sprintf(cl->str, "%d", x);

530− cl->info.str.len = strlen(cl->info.str.str);

531− return cl;

510+ return (VAL)cl;

532}

511}

533

512

534VAL idris_castBitsStr(VM* vm, VAL i) {

513VAL idris_castBitsStr(VM* vm, VAL i) {

535− Closure* cl;

514+ String * cl;

536− ClosureType ty = i->ty;

515+ ClosureType ty = GETTY(i);

537

516

538 switch (ty) {

517 switch (ty) {

539 case CT_BITS8:

518 case CT_BITS8:

540 // max length 8 bit unsigned int str 3 chars (256)

519 // max length 8 bit unsigned int str 3 chars (256)

541− cl = allocate(sizeof(Closure) + sizeof(char)*4, 0);

520+ cl = allocStr(vm, 4, 0);

542− cl->info.str.str = (char*)cl + sizeof(Closure);

543− sprintf(cl->info.str.str, "%" PRIu8, (uint8_t)i->info.bits8);

521+ cl->slen = sprintf(cl->str, "%" PRIu8, GETBITS8(i));

544 break;

522 break;

545 case CT_BITS16:

523 case CT_BITS16:

546 // max length 16 bit unsigned int str 5 chars (65,535)

524 // max length 16 bit unsigned int str 5 chars (65,535)

547− cl = allocate(sizeof(Closure) + sizeof(char)*6, 0);

525+ cl = allocStr(vm, 6, 0);

548− cl->info.str.str = (char*)cl + sizeof(Closure);

549− sprintf(cl->info.str.str, "%" PRIu16, (uint16_t)i->info.bits16);

526+ cl->slen = sprintf(cl->str, "%" PRIu16, GETBITS16(i));

550 break;

527 break;

551 case CT_BITS32:

528 case CT_BITS32:

552 // max length 32 bit unsigned int str 10 chars (4,294,967,295)

529 // max length 32 bit unsigned int str 10 chars (4,294,967,295)

553− cl = allocate(sizeof(Closure) + sizeof(char)*11, 0);

530+ cl = allocStr(vm, 11, 0);

554− cl->info.str.str = (char*)cl + sizeof(Closure);

555− sprintf(cl->info.str.str, "%" PRIu32, (uint32_t)i->info.bits32);

531+ cl->slen = sprintf(cl->str, "%" PRIu32, GETBITS32(i));

556 break;

532 break;

557 case CT_BITS64:

533 case CT_BITS64:

558 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)

534 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)

559− cl = allocate(sizeof(Closure) + sizeof(char)*21, 0);

535+ cl = allocStr(vm, 21, 0);

560− cl->info.str.str = (char*)cl + sizeof(Closure);

561− sprintf(cl->info.str.str, "%" PRIu64, (uint64_t)i->info.bits64);

536+ cl->slen = sprintf(cl->str, "%" PRIu64, GETBITS64(i));

562 break;

537 break;

563 default:

538 default:

564 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);

539 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);

565 exit(EXIT_FAILURE);

540 exit(EXIT_FAILURE);

566 }

541 }

567−

568− cl->info.str.len = strlen(cl->info.str.str);

569− SETTY(cl, CT_STRING);

570− return cl;

542+ return (VAL)cl;

571}

543}

572

544

573VAL idris_castStrInt(VM* vm, VAL i) {

545VAL idris_castStrInt(VM* vm, VAL i) {

@@ -580,13 +552,9 @@ VAL idris_castStrInt(VM* vm, VAL i) {

580}

552}

581

553

582VAL idris_castFloatStr(VM* vm, VAL i) {

554VAL idris_castFloatStr(VM* vm, VAL i) {

583− Closure* cl = allocate(sizeof(Closure) + sizeof(char)*32, 0);

555+ String * cl = allocStr(vm, 32, 0);

584− SETTY(cl, CT_STRING);

585− cl->info.str.str = (char*)cl + sizeof(Closure);

586− snprintf(cl->info.str.str, 32, "%.16g", GETFLOAT(i));

556+ cl->slen = snprintf(cl->str, 32, "%.16g", GETFLOAT(i));

587−

588− cl->info.str.len = strlen(cl->info.str.str);

589− return cl;

557+ return (VAL)cl;

590}

558}

591

559

592VAL idris_castStrFloat(VM* vm, VAL i) {

560VAL idris_castStrFloat(VM* vm, VAL i) {

@@ -596,17 +564,13 @@ VAL idris_castStrFloat(VM* vm, VAL i) {

596VAL idris_concat(VM* vm, VAL l, VAL r) {

564VAL idris_concat(VM* vm, VAL l, VAL r) {

597 char *rs = GETSTR(r);

565 char *rs = GETSTR(r);

598 char *ls = GETSTR(l);

566 char *ls = GETSTR(l);

599− int llen = GETSTRLEN(l);

567+ size_t llen = GETSTRLEN(l);

600− int rlen = GETSTRLEN(r);

568+ size_t rlen = GETSTRLEN(r);

601

569

602− Closure* cl = allocate(sizeof(Closure) + llen + rlen + 1, 0);

570+ String * cl = allocStr(vm, llen + rlen, 0);

603− SETTY(cl, CT_STRING);

571+ memcpy(cl->str, ls, llen);

604− cl->info.str.str = (char*)cl + sizeof(Closure);

572+ memcpy(cl->str + llen, rs, rlen);

605− strcpy(cl->info.str.str, ls);

606− strcat(cl->info.str.str, rs);

607−

608− cl->info.str.len = llen + rlen;

609− return cl;

573+ return (VAL)cl;

610}

574}

611

575

612VAL idris_strlt(VM* vm, VAL l, VAL r) {

576VAL idris_strlt(VM* vm, VAL l, VAL r) {

@@ -667,38 +631,32 @@ VAL idris_strHead(VM* vm, VAL str) {

667 return idris_strIndex(vm, str, 0);

631 return idris_strIndex(vm, str, 0);

668}

632}

669

633

670−VAL MKSTROFFc(VM* vm, StrOffset* off) {

634+VAL MKSTROFFc(VM* vm, VAL basestr) {

671− Closure* cl = allocate(sizeof(Closure) + sizeof(StrOffset), 1);

635+ StrOffset * cl = iallocate(vm, sizeof(*cl), 1);

672 SETTY(cl, CT_STROFFSET);

636 SETTY(cl, CT_STROFFSET);

673− cl->info.str_offset = (StrOffset*)((char*)cl + sizeof(Closure));

637+ cl->base = (String*)basestr;

674−

675− cl->info.str_offset->str = off->str;

676− cl->info.str_offset->offset = off->offset;

677−

678− return cl;

638+ return (VAL)cl;

679}

639}

680

640

681VAL idris_strShift(VM* vm, VAL str, int num) {

641VAL idris_strShift(VM* vm, VAL str, int num) {

642+ size_t sz = sizeof(StrOffset);

682 // If there's no room, just copy the string, or we'll have a problem after

643 // If there's no room, just copy the string, or we'll have a problem after

683 // gc moves str

644 // gc moves str

684− if (space(vm, sizeof(Closure) + sizeof(StrOffset))) {

645+ if (space(vm, sz)) {

685− Closure* cl = allocate(sizeof(Closure) + sizeof(StrOffset), 0);

686− SETTY(cl, CT_STROFFSET);

687− cl->info.str_offset = (StrOffset*)((char*)cl + sizeof(Closure));

688−

689 int offset = 0;

646 int offset = 0;

690− VAL root = str;

647+ StrOffset * root = (StrOffset*)str;

648+ StrOffset * cl = iallocate(vm, sz, 0);

649+ SETTY(cl, CT_STROFFSET);

691

650

692 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.

651 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.

693 // In theory, at most one step here!

652 // In theory, at most one step here!

694− offset += root->info.str_offset->offset;

653+ offset += root->offset;

695− root = root->info.str_offset->str;

654+ root = (StrOffset*)root->base;

696 }

655 }

697

656

698− cl->info.str_offset->str = root;

657+ cl->base = (String*)root;

699− cl->info.str_offset->offset = offset+idris_utf8_findOffset(GETSTR(str), num);

658+ cl->offset = offset+idris_utf8_findOffset(GETSTR(str), num);

700−

701− return cl;

659+ return (VAL)cl;

702 } else {

660 } else {

703 char* nstr = GETSTR(str);

661 char* nstr = GETSTR(str);

704 return MKSTR(vm, nstr+idris_utf8_charlen(nstr));

662 return MKSTR(vm, nstr+idris_utf8_charlen(nstr));

@@ -712,29 +670,23 @@ VAL idris_strTail(VM* vm, VAL str) {

712VAL idris_strCons(VM* vm, VAL x, VAL xs) {

670VAL idris_strCons(VM* vm, VAL x, VAL xs) {

713 char *xstr = GETSTR(xs);

671 char *xstr = GETSTR(xs);

714 int xval = GETINT(x);

672 int xval = GETINT(x);

715− int xlen = GETSTRLEN(xs);

673+ size_t xlen = GETSTRLEN(xs);

674+ String * cl;

716

675

717 if (xval < 0x80) { // ASCII char

676 if (xval < 0x80) { // ASCII char

718− Closure* cl = allocate(sizeof(Closure) +

719− xlen + 2, 0);

677+ cl = allocStr(vm, xlen + 1, 0);

720− SETTY(cl, CT_STRING);

721− cl->info.str.str = (char*)cl + sizeof(Closure);

722− cl->info.str.str[0] = (char)(GETINT(x));

678+ cl->str[0] = (char)(GETINT(x));

723− strcpy(cl->info.str.str+1, xstr);

679+ memcpy(cl->str+1, xstr, xlen);

724− cl->info.str.len = xlen + 1;

725− return cl;

726 } else {

680 } else {

727 char *init = idris_utf8_fromChar(xval);

681 char *init = idris_utf8_fromChar(xval);

728− int newlen = strlen(init) + xlen;

682+ size_t ilen = strlen(init);

729− Closure* cl = allocate(sizeof(Closure) + newlen + 1, 0);

683+ int newlen = ilen + xlen;

730− SETTY(cl, CT_STRING);

684+ cl = allocStr(vm, newlen, 0);

731− cl->info.str.str = (char*)cl + sizeof(Closure);

685+ memcpy(cl->str, init, ilen);

732− strcpy(cl->info.str.str, init);

686+ memcpy(cl->str + ilen, xstr, xlen);

733− strcat(cl->info.str.str, xstr);

734− cl->info.str.len = newlen;

735 free(init);

687 free(init);

736− return cl;

737 }

688 }

689+ return (VAL)cl;

738}

690}

739

691

740VAL idris_strIndex(VM* vm, VAL str, VAL i) {

692VAL idris_strIndex(VM* vm, VAL str, VAL i) {

@@ -743,8 +695,8 @@ VAL idris_strIndex(VM* vm, VAL str, VAL i) {

743}

695}

744

696

745VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {

697VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {

746− int offset_val = GETINT(offset);

698+ size_t offset_val = GETINT(offset);

747− int length_val = GETINT(length);

699+ size_t length_val = GETINT(length);

748 char* str_val = GETSTR(str);

700 char* str_val = GETSTR(str);

749

701

750 // If the substring is a suffix, use idris_strShift to avoid reallocating

702 // If the substring is a suffix, use idris_strShift to avoid reallocating

@@ -754,33 +706,28 @@ VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {

754 else {

706 else {

755 char *start = idris_utf8_advance(str_val, offset_val);

707 char *start = idris_utf8_advance(str_val, offset_val);

756 char *end = idris_utf8_advance(start, length_val);

708 char *end = idris_utf8_advance(start, length_val);

757− Closure* newstr = allocate(sizeof(Closure) + (end - start) +1, 0);

709+ size_t sz = end - start;

758− SETTY(newstr, CT_STRING);

710+ String * newstr = allocStr(vm, sz, 0);

759− newstr->info.str.str = (char*)newstr + sizeof(Closure);

760− memcpy(newstr->info.str.str, start, end - start);

711+ memcpy(newstr->str, start, sz);

761− *(newstr->info.str.str + (end - start) + 1) = '\0';

712+ newstr->str[sz] = '\0';

762− newstr->info.str.len = strlen(newstr->info.str.str);

763− return newstr;

713+ return (VAL)newstr;

764 }

714 }

765}

715}

766

716

767VAL idris_strRev(VM* vm, VAL str) {

717VAL idris_strRev(VM* vm, VAL str) {

768 char *xstr = GETSTR(str);

718 char *xstr = GETSTR(str);

769− int xlen = GETSTRLEN(str);

719+ size_t xlen = GETSTRLEN(str);

770

720

771− Closure* cl = allocate(sizeof(Closure) + xlen + 1, 0);

721+ String * cl = allocStr(vm, xlen, 0);

772− SETTY(cl, CT_STRING);

773− cl->info.str.str = (char*)cl + sizeof(Closure);

774− cl->info.str.len = xlen;

775− idris_utf8_rev(xstr, cl->info.str.str);

722+ idris_utf8_rev(xstr, cl->str);

776− return cl;

723+ return (VAL)cl;

777}

724}

778

725

779VAL idris_newRefLock(VAL x, int outerlock) {

726VAL idris_newRefLock(VAL x, int outerlock) {

780− Closure* cl = allocate(sizeof(Closure), outerlock);

727+ Ref * cl = allocate(sizeof(*cl), outerlock);

781 SETTY(cl, CT_REF);

728 SETTY(cl, CT_REF);

782− cl->info.ptr = (void*)x;

729+ cl->ref = x;

783− return cl;

730+ return (VAL)cl;

784}

731}

785

732

786VAL idris_newRef(VAL x) {

733VAL idris_newRef(VAL x) {

@@ -788,30 +735,34 @@ VAL idris_newRef(VAL x) {

788}

735}

789

736

790void idris_writeRef(VAL ref, VAL x) {

737void idris_writeRef(VAL ref, VAL x) {

791− ref->info.ptr = (void*)x;

738+ Ref * r = (Ref*)ref;

739+ r->ref = x;

792 SETTY(ref, CT_REF);

740 SETTY(ref, CT_REF);

793}

741}

794

742

795VAL idris_readRef(VAL ref) {

743VAL idris_readRef(VAL ref) {

744+ Ref * r = (Ref*)ref;

796− return (VAL)(ref->info.ptr);

745+ return r->ref;

797}

746}

798

747

799VAL idris_newArray(VM* vm, int size, VAL def) {

748VAL idris_newArray(VM* vm, int size, VAL def) {

800− Closure* cl;

749+ Array * cl;

801 int i;

750 int i;

802− allocArray(cl, vm, size, 0);

751+ cl = allocArrayF(vm, size, 0);

803 for(i=0; i<size; ++i) {

752 for(i=0; i<size; ++i) {

804− cl->info.arr.content[i] = def;

753+ cl->array[i] = def;

805 }

754 }

806− return cl;

755+ return (VAL)cl;

807}

756}

808

757

809void idris_arraySet(VAL arr, int index, VAL newval) {

758void idris_arraySet(VAL arr, int index, VAL newval) {

759+ Array * cl = (Array*)arr;

810− arr->info.arr.content[index] = newval;

760+ cl->array[index] = newval;

811}

761}

812

762

813VAL idris_arrayGet(VAL arr, int index) {

763VAL idris_arrayGet(VAL arr, int index) {

764+ Array * cl = (Array*)arr;

814− return arr->info.arr.content[index];

765+ return cl->array[index];

815}

766}

816

767

817VAL idris_systemInfo(VM* vm, VAL index) {

768VAL idris_systemInfo(VM* vm, VAL index) {

@@ -892,75 +843,58 @@ void* idris_stopThread(VM* vm) {

892 return NULL;

843 return NULL;

893}

844}

894

845

846+static VAL doCopyTo(VM* vm, VAL x);

847+

848+static void copyArray(VM* vm, VAL * dst, VAL * src, size_t len) {

849+ size_t i;

850+ for(i = 0; i < len; ++i)

851+ dst[i] = doCopyTo(vm, src[i]);

852+}

853+

854+

895// VM is assumed to be a different vm from the one x lives on

855// VM is assumed to be a different vm from the one x lives on

896

856

897−VAL doCopyTo(VM* vm, VAL x) {

857+static VAL doCopyTo(VM* vm, VAL x) {

898− int i, ar, len;

858+ int ar;

899− VAL* argptr;

859+ VAL cl;

900− Closure* cl;

901 if (x==NULL || ISINT(x)) {

860 if (x==NULL || ISINT(x)) {

902 return x;

861 return x;

903 }

862 }

904 switch(GETTY(x)) {

863 switch(GETTY(x)) {

864+ case CT_CDATA:

865+ cl = MKCDATAc(vm, GETCDATA(x));

866+ break;

867+ case CT_BIGINT:

868+ cl = MKBIGMc(vm, GETMPZ(x));

869+ break;

905 case CT_CON:

870 case CT_CON:

906 ar = CARITY(x);

871 ar = CARITY(x);

907 if (ar == 0 && CTAG(x) < 256) { // globally allocated

872 if (ar == 0 && CTAG(x) < 256) { // globally allocated

908 cl = x;

873 cl = x;

909 } else {

874 } else {

910− allocCon(cl, vm, CTAG(x), ar, 1);

875+ Con * c = allocConF(vm, CTAG(x), ar, 1);

911−

876+ copyArray(vm, c->args, ((Con*)x)->args, ar);

912− argptr = (VAL*)(cl->info.c.args);

877+ cl = (VAL)c;

913− for(i = 0; i < ar; ++i) {

914− *argptr = doCopyTo(vm, *((VAL*)(x->info.c.args)+i)); // recursive version

915− argptr++;

916− }

917 }

878 }

918 break;

879 break;

919− case CT_ARRAY:

880+ case CT_ARRAY: {

920− len = x->info.arr.length;

881+ size_t len = CELEM(x);

921− allocArray(cl, vm, len, 1);

882+ Array * a = allocArrayF(vm, len, 1);

922−

883+ copyArray(vm, a->array, ((Array*)x)->array, len);

923− argptr = (VAL*)(cl->info.arr.content);

884+ cl = (VAL)a;

924− for(i = 0; i < len; ++i) {

925− *argptr = doCopyTo(vm, *((VAL*)(x->info.arr.content)+i)); // recursive version

926− argptr++;

927− }

928− break;

929− case CT_FLOAT:

930− cl = MKFLOATc(vm, x->info.f);

931− break;

885+ } break;

932 case CT_STRING:

886 case CT_STRING:

933− cl = MKSTRc(vm, x->info.str.str);

887+ case CT_FLOAT:

934− break;

935− case CT_BIGINT:

936− cl = MKBIGMc(vm, x->info.ptr);

937− break;

938 case CT_PTR:

888 case CT_PTR:

939− cl = MKPTRc(vm, x->info.ptr);

940− break;

941 case CT_MANAGEDPTR:

889 case CT_MANAGEDPTR:

942− cl = MKMPTRc(vm, x->info.mptr->data, x->info.mptr->size);

943− break;

944− case CT_CDATA:

945− cl = MKCDATAc(vm, x->info.c_heap_item);

946− break;

947 case CT_BITS8:

890 case CT_BITS8:

948− cl = idris_b8CopyForGC(vm, x);

949− break;

950 case CT_BITS16:

891 case CT_BITS16:

951− cl = idris_b16CopyForGC(vm, x);

952− break;

953 case CT_BITS32:

892 case CT_BITS32:

954− cl = idris_b32CopyForGC(vm, x);

955− break;

956 case CT_BITS64:

893 case CT_BITS64:

957− cl = idris_b64CopyForGC(vm, x);

958− break;

959 case CT_RAWDATA:

894 case CT_RAWDATA:

960 {

895 {

961− size_t size = x->info.size + sizeof(Closure);

896+ cl = iallocate(vm, x->hdr.sz, 0);

962− cl = allocate(size, 0);

963− memcpy(cl, x, size);

897+ memcpy(cl, x, x->hdr.sz);

964 }

898 }

965 break;

899 break;

966 default:

900 default:

@@ -970,10 +904,7 @@ VAL doCopyTo(VM* vm, VAL x) {

970}

904}

971

905

972VAL copyTo(VM* vm, VAL x) {

906VAL copyTo(VM* vm, VAL x) {

973− VM* current = pthread_getspecific(vm_key);

974− pthread_setspecific(vm_key, vm);

975 VAL ret = doCopyTo(vm, x);

907 VAL ret = doCopyTo(vm, x);

976− pthread_setspecific(vm_key, current);

977 return ret;

908 return ret;

978}

909}

979

910

@@ -1112,7 +1043,7 @@ Msg* idris_recvMessageFrom(VM* vm, int channel_id, VM* sender) {

1112

1043

1113 struct timespec timeout;

1044 struct timespec timeout;

1114 int status;

1045 int status;

1115−

1046+

1116 if (sender && sender->active == 0) { return NULL; } // No VM to receive from

1047 if (sender && sender->active == 0) { return NULL; } // No VM to receive from

1117

1048

1118 pthread_mutex_lock(&vm->inbox_block);

1049 pthread_mutex_lock(&vm->inbox_block);

@@ -1187,26 +1118,16 @@ char* idris_showerror(int err) {

1187 return strerror(err);

1118 return strerror(err);

1188}

1119}

1189

1120

1190−VAL* nullary_cons;

1121+Con nullary_cons[256];

1191

1122

1192void init_nullaries(void) {

1123void init_nullaries(void) {

1193 int i;

1124 int i;

1194− VAL cl;

1195− nullary_cons = malloc(256 * sizeof(VAL));

1196 for(i = 0; i < 256; ++i) {

1125 for(i = 0; i < 256; ++i) {

1126+ Con * cl = nullary_cons + i;

1197− cl = malloc(sizeof(Closure));

1127+ cl->hdr.sz = sizeof(*cl);

1198 SETTY(cl, CT_CON);

1128 SETTY(cl, CT_CON);

1199− cl->info.c.tag_arity = i << 8;

1129+ cl->tag = i;

1200− nullary_cons[i] = cl;

1201− }

1202−}

1203−

1204−void free_nullaries(void) {

1205− int i;

1206− for(i = 0; i < 256; ++i) {

1207− free(nullary_cons[i]);

1208 }

1130 }

1209− free(nullary_cons);

1210}

1131}

1211

1132

1212int __idris_argc;

1133int __idris_argc;

rts/idris_rts.h+196−106

@@ -1,21 +1,19 @@

1#ifndef _IDRISRTS_H

2#define _IDRISRTS_H

4+#include <assert.h>

4#include <stdlib.h>

5#include <stdlib.h>

5#include <stdio.h>

6#include <stdio.h>

7+#ifdef HAS_PTHREAD

6#include <string.h>

8#include <string.h>

7#include <stdarg.h>

9#include <stdarg.h>

8−#ifdef HAS_PTHREAD

9#include <pthread.h>

10#include <pthread.h>

10#endif

11#endif

11−#include <stdint.h>

12−#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)

13−#include <signal.h>

14−#endif

16#include "idris_heap.h"

13#include "idris_heap.h"

17#include "idris_stats.h"

14#include "idris_stats.h"

16+

19#ifndef EXIT_SUCCESS

17#ifndef EXIT_SUCCESS

20#define EXIT_SUCCESS 0

18#define EXIT_SUCCESS 0

21#endif

19#endif

@@ -25,68 +23,113 @@

26// Closures

24// Closures

27typedef enum {

25typedef enum {

28− CT_CON, CT_ARRAY, CT_INT, CT_BIGINT, CT_FLOAT, CT_STRING, CT_STROFFSET,

26+ CT_CON, CT_ARRAY, CT_INT, CT_BIGINT,

27+ CT_FLOAT, CT_STRING, CT_STROFFSET, CT_BITS8,

29− CT_BITS8, CT_BITS16, CT_BITS32, CT_BITS64, CT_UNIT, CT_PTR, CT_REF,

28+ CT_BITS16, CT_BITS32, CT_BITS64, CT_PTR,

30− CT_FWD, CT_MANAGEDPTR, CT_RAWDATA, CT_CDATA

29+ CT_REF, CT_FWD, CT_MANAGEDPTR, CT_RAWDATA,

30+ CT_CDATA

31} ClosureType;

33−typedef struct Closure *VAL;

33+typedef struct Hdr {

34−

34+ uint8_t ty;

35−// A constructor, consisting of a tag, an arity (16 bits each of the

35+ uint8_t u8;

36−// tag_arity field) and arguments

36+ uint16_t u16;

37−typedef struct {

37+ uint32_t sz;

38− uint32_t tag_arity;

38+} Hdr;

39+

40+typedef struct Val {

41+ Hdr hdr;

42+} Val;

43+

44+typedef struct Val * VAL;

45+

46+typedef struct Con {

47+ Hdr hdr;

48+ uint32_t tag;

39− VAL args[];

49+ VAL args[0];

40−} con;

50+} Con;

41−

51+

42−// An array; similar to a constructor but with a length, and contents

52+typedef struct Array {

43−// initialised to NULL (high level Idris programs are responsible for

53+ Hdr hdr;

44−// initialising them properly)

54+ VAL array[0];

55+} Array;

56+

57+typedef struct Int {

58+ Hdr hdr;

59+ int i;

60+} Int;

61+

62+typedef struct BigInt {

63+ Hdr hdr;

64+ char big[0];

65+} BigInt;

66+

45−typedef struct {

67+typedef struct Float {

46− uint32_t length;

68+ Hdr hdr;

47− VAL content[];

69+ double f;

48−} array;

70+} Float;

49−

71+

50−typedef struct {

72+typedef struct String {

73+ Hdr hdr;

74+ size_t slen;

51− VAL str;

75+ char str[0];

76+} String;

77+

78+typedef struct StrOffset {

79+ Hdr hdr;

80+ String * base;

52 size_t offset;

81 size_t offset;

53} StrOffset;

82} StrOffset;

55−typedef struct {

84+typedef struct Bits8 {

56− char* str;

85+ Hdr hdr;

57− size_t len; // Cached strlen (we do 'strlen' a lot)

86+ uint8_t bits8;

58−} String;

87+} Bits8;

59−

88+

60−// A foreign pointer, managed by the idris GC

89+typedef struct Bits16 {

90+ Hdr hdr;

91+ uint16_t bits16;

92+} Bits16;

93+

94+typedef struct Bits32 {

95+ Hdr hdr;

96+ uint32_t bits32;

97+} Bits32;

98+

99+typedef struct Bits64 {

100+ Hdr hdr;

101+ uint64_t bits64;

102+} Bits64;

103+

61−typedef struct {

104+typedef struct Ptr {

62− size_t size;

105+ Hdr hdr;

63− void* data;

106+ void * ptr;

107+} Ptr;

108+

109+typedef struct Ref {

110+ Hdr hdr;

111+ VAL ref;

112+} Ref;

113+

114+typedef struct Fwd {

115+ Hdr hdr;

116+ VAL fwd;

117+} Fwd;

118+

119+typedef struct ManagedPtr {

120+ Hdr hdr;

121+ char mptr[0];

64} ManagedPtr;

122} ManagedPtr;

123

66−typedef struct Closure {

124+typedef struct RawData {

67−// Use top 16 bits of ty for saying which heap value is in

125+ Hdr hdr;

68−// Bottom 16 bits for closure type

126+ char raw[0];

69−//

127+} RawData;

70−// NOTE: ty can not have type ClosureType because ty must be a

128+

71−// uint32_t but enum is platform dependent

129+typedef struct CDataC {

72− uint32_t ty;

130+ Hdr hdr;

73− union {

74− con c;

75− array arr;

76− int i;

77− double f;

78− String str;

79− StrOffset* str_offset;

80− void* ptr;

81− uint8_t bits8;

82− uint16_t bits16;

83− uint32_t bits32;

84− uint64_t bits64;

85− ManagedPtr* mptr;

86− CHeapItem* c_heap_item;

131+ CHeapItem * item;

87− size_t size;

132+} CDataC;

88− } info;

89−} Closure;

133

91struct VM;

134struct VM;

135

@@ -190,33 +233,43 @@ typedef void(*func)(VM*, VAL*);

190// Register access

233// Register access

191

234

192#define RVAL (vm->ret)

235#define RVAL (vm->ret)

193−#define LOC(x) (*(vm->valstack_base + (x)))

236+#define LOC(x) (vm->valstack_base[x])

194−#define TOP(x) (*(vm->valstack_top + (x)))

237+#define TOP(x) (vm->valstack_top[x])

195#define REG1 (vm->reg1)

238#define REG1 (vm->reg1)

196

239

197// Retrieving values

240// Retrieving values

241+static inline char * getstr(String * x) {

242+ // hdr.u8 used to mark a null string

243+ return x->hdr.u8? NULL : x->str;

244+}

245+

246+static inline size_t getstrlen(String * x) {

247+ return x->slen;

248+}

249+

198−#define GETSTR(x) (ISSTR(x) ? (((VAL)(x))->info.str.str) : GETSTROFF(x))

250+#define GETSTR(x) (ISSTR(x) ? getstr((String*)(x)) : GETSTROFF(x))

199−#define GETSTRLEN(x) (ISSTR(x) ? (((VAL)(x))->info.str.len) : GETSTROFFLEN(x))

251+#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((String*)(x)) : GETSTROFFLEN(x))

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

252+#define GETPTR(x) (((Ptr*)(x))->ptr)

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

253+#define GETMPTR(x) (((ManagedPtr*)(x))->mptr)

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

254+#define GETFLOAT(x) (((Float*)(x))->f)

203−#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)

255+#define GETCDATA(x) (((CDataC*)(x))->item)

204−

256+

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

257+#define GETBITS8(x) (((Bits8*)(x))->bits8)

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

258+#define GETBITS16(x) (((Bits16*)(x))->bits16)

207−#define GETBITS32(x) (((VAL)(x))->info.bits32)

259+#define GETBITS32(x) (((Bits32*)(x))->bits32)

208−#define GETBITS64(x) (((VAL)(x))->info.bits64)

260+#define GETBITS64(x) (((Bits64*)(x))->bits64)

209−

210−#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? (x)->info.c.tag_arity >> 8 : (-1)) )

211−#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? (x)->info.c.tag_arity & 0x000000ff : (-1)) )

212

261

213// Already checked it's a CT_CON

262// Already checked it's a CT_CON

214−#define CTAG(x) (((x)->info.c.tag_arity) >> 8)

263+#define CTAG(x) (((Con*)(x))->tag)

215−#define CARITY(x) ((x)->info.c.tag_arity & 0x000000ff)

264+#define CARITY(x) (((Con*)(x))->hdr.u16) // hdr.u16 used to store arity

216

265

266+#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG((Con*)x) : (-1)) )

267+#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY((Con*)x) : (-1)) )

217

268

269+#define CELEM(x) (((x)->hdr.sz - sizeof(Array)) / sizeof(VAL))

270+

218−#define GETTY(x) ((x)->ty)

271+#define GETTY(x) ((ClosureType)((x)->hdr.ty))

219−#define SETTY(x,t) ((x)->ty = t)

272+#define SETTY(x,t) ((x)->hdr.ty = t)

220

273

221// Integers, floats and operators

274// Integers, floats and operators

222

275

@@ -241,15 +294,17 @@ typedef intptr_t i_int;

241#ifdef IDRIS_TRACE

294#ifdef IDRIS_TRACE

242#define TRACE idris_trace(vm, __FUNCTION__, __LINE__);

295#define TRACE idris_trace(vm, __FUNCTION__, __LINE__);

243#else

296#else

244−#define TRACE

297+#define TRACE

245#endif

298#endif

246

299

247#define INITFRAME TRACE\

300#define INITFRAME TRACE\

248 __attribute__((unused)) VAL* myoldbase

301 __attribute__((unused)) VAL* myoldbase

249

302

250#define REBASE vm->valstack_base = oldbase

303#define REBASE vm->valstack_base = oldbase

304+#define RESERVE(x) do { \

251−#define RESERVE(x) if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \

305+ if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \

252− else { memset(vm->valstack_top, 0, (x)*sizeof(VAL)); }

306+ else { memset(vm->valstack_top, 0, (x)*sizeof(VAL)); } \

307+ } while(0)

253#define ADDTOP(x) vm->valstack_top += (x)

308#define ADDTOP(x) vm->valstack_top += (x)

254#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)

309#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)

255#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)

310#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)

@@ -260,6 +315,7 @@ typedef intptr_t i_int;

260// Creating new values (each value placed at the top of the stack)

315// Creating new values (each value placed at the top of the stack)

261VAL MKFLOAT(VM* vm, double val);

316VAL MKFLOAT(VM* vm, double val);

262VAL MKSTR(VM* vm, const char* str);

317VAL MKSTR(VM* vm, const char* str);

318+VAL MKSTRlen(VM* vm, const char* str, size_t size);

263VAL MKPTR(VM* vm, void* ptr);

319VAL MKPTR(VM* vm, void* ptr);

264VAL MKMPTR(VM* vm, void* ptr, size_t size);

320VAL MKMPTR(VM* vm, void* ptr, size_t size);

265VAL MKB8(VM* vm, uint8_t b);

321VAL MKB8(VM* vm, uint8_t b);

@@ -270,9 +326,9 @@ VAL MKCDATA(VM* vm, CHeapItem * item);

270

326

271// following versions don't take a lock when allocating

327// following versions don't take a lock when allocating

272VAL MKFLOATc(VM* vm, double val);

328VAL MKFLOATc(VM* vm, double val);

273−VAL MKSTROFFc(VM* vm, StrOffset* off);

329+VAL MKSTROFFc(VM* vm, VAL basestr);

274VAL MKSTRc(VM* vm, char* str);

330VAL MKSTRc(VM* vm, char* str);

275−VAL MKSTRclen(VM* vm, char* str, int len);

331+VAL MKSTRclen(VM* vm, char* str, size_t len);

276VAL MKPTRc(VM* vm, void* ptr);

332VAL MKPTRc(VM* vm, void* ptr);

277VAL MKMPTRc(VM* vm, void* ptr, size_t size);

333VAL MKMPTRc(VM* vm, void* ptr, size_t size);

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

334VAL MKCDATAc(VM* vm, CHeapItem * item);

@@ -280,15 +336,16 @@ VAL MKCDATAc(VM* vm, CHeapItem * item);

280char* GETSTROFF(VAL stroff);

336char* GETSTROFF(VAL stroff);

281size_t GETSTROFFLEN(VAL stroff);

337size_t GETSTROFFLEN(VAL stroff);

282

338

283−// #define SETTAG(x, a) (x)->info.c.tag = (a)

284−#define SETARG(x, i, a) ((x)->info.c.args)[i] = ((VAL)(a))

339+#define SETARG(x, i, a) (((Con*)(x))->args)[i] = ((VAL)(a))

285−#define GETARG(x, i) ((x)->info.c.args)[i]

340+#define GETARG(x, i) (((Con*)(x))->args[i])

286

341

287#define PROJECT(vm,r,loc,num) \

342#define PROJECT(vm,r,loc,num) \

288− memcpy(&(LOC(loc)), &((r)->info.c.args), sizeof(VAL)*num)

343+ memcpy(&(LOC(loc)), ((Con*)(r))->args, sizeof(VAL)*num)

289#define SLIDE(vm, args) \

344#define SLIDE(vm, args) \

290 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)

345 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)

291

346

347+void* iallocate(VM *, size_t, int);

348+

292void* allocate(size_t size, int outerlock);

349void* allocate(size_t size, int outerlock);

293// void* allocCon(VM* vm, int arity, int outerlock);

350// void* allocCon(VM* vm, int arity, int outerlock);

294

351

@@ -298,8 +355,8 @@ void* allocate(size_t size, int outerlock);

298// idris_doneAlloc *must* be called when allocation from C is done (as it

355// idris_doneAlloc *must* be called when allocation from C is done (as it

299// may take a lock if other threads are running).

356// may take a lock if other threads are running).

300

357

301−void idris_requireAlloc(size_t size);

358+void idris_requireAlloc(VM *, size_t size);

302−void idris_doneAlloc(void);

359+void idris_doneAlloc(VM *);

303

360

304// public interface to allocation (note that this may move other pointers

361// public interface to allocation (note that this may move other pointers

305// if allocating beyond the limits given by idris_requireAlloc!)

362// if allocating beyond the limits given by idris_requireAlloc!)

@@ -308,29 +365,44 @@ void* idris_alloc(size_t size);

308void* idris_realloc(void* old, size_t old_size, size_t size);

365void* idris_realloc(void* old, size_t old_size, size_t size);

309void idris_free(void* ptr, size_t size);

366void idris_free(void* ptr, size_t size);

310

367

368+static inline void updateConF(Con * cl, unsigned tag, unsigned arity) {

369+ SETTY(cl, CT_CON);

370+ cl->tag = tag;

371+ // hdr.u16 used to store arity

372+ cl->hdr.u16 = arity;

373+ assert(cl->hdr.sz == sizeof(*cl) + sizeof(VAL) * arity);

374+ // cl->hdr.sz = sizeof(*cl) + sizeof(VAL) * arity;

375+}

376+

377+static inline Con * allocConF(VM * vm, unsigned tag, unsigned arity, int outer) {

378+ Con * cl = iallocate(vm, sizeof(*cl) + sizeof(VAL) * arity, outer);

379+ SETTY(cl, CT_CON);

380+ cl->tag = tag;

381+ // hdr.u16 used to store arity

382+ cl->hdr.u16 = arity;

383+ return cl;

384+}

385+

386+static inline Array * allocArrayF(VM * vm, size_t len, int outer) {

387+ Array * cl = iallocate(vm, sizeof(*cl) + sizeof(VAL) * len, outer);

388+ SETTY(cl, CT_ARRAY);

389+ return cl;

390+}

391+

392+

311−#define allocCon(cl, vm, t, a, o) \

393+#define allocCon(cl, vm, t, a, o) (cl) = (VAL)allocConF(vm, t, a, o)

312− cl = allocate(sizeof(Closure) + sizeof(VAL)*a, o); \

313− SETTY(cl, CT_CON); \

314− cl->info.c.tag_arity = ((t) << 8) | (a);

315

394

316−#define updateCon(cl, old, t, a) \

395+#define updateCon(cl, old, tag, arity) (cl) = (old); updateConF(cl, tag, arity)

317− cl = old; \

318− SETTY(cl, CT_CON); \

319− cl->info.c.tag_arity = ((t) << 8) | (a);

320

396

321−#define NULL_CON(x) nullary_cons[x]

397+#define NULL_CON(x) ((VAL)(nullary_cons + x))

322

398

323−#define allocArray(cl, vm, len, o) \

399+#define allocArray(cl, vm, len, o) (cl) = (VAL)allocArrayF(vm, len, o)

324− cl = allocate(sizeof(Closure) + sizeof(VAL)*len, o); \

325− SETTY(cl, CT_ARRAY); \

326− cl->info.arr.length = len;

327

400

328int idris_errno(void);

401int idris_errno(void);

329char* idris_showerror(int err);

402char* idris_showerror(int err);

330

403

331−extern VAL* nullary_cons;

404+extern Con nullary_cons[];

332void init_nullaries(void);

405void init_nullaries(void);

333−void free_nullaries(void);

334

406

335void init_signals(void);

407void init_signals(void);

336

408

@@ -460,4 +532,22 @@ void stackOverflow(void);

460

532

461#include "idris_gmp.h"

533#include "idris_gmp.h"

462

534

535+static inline size_t valSize(VAL v) {

536+ return v->hdr.sz;

537+}

538+

539+static inline size_t aligned(size_t sz) {

540+ return (sz + sizeof(void*) - 1) & ~(sizeof(void*)-1);

541+}

542+

543+VM* get_vm(void);

544+

463#endif

545#endif

546+

547+/*

548+ Local variables: **

549+ c-file-style: "bsd" **

550+ c-basic-offset: 4 **

551+ indent-tabs-mode: nil **

552+ End: **

553+*/

rts/idris_stdfgn.c+1−3

@@ -6,7 +6,6 @@

6#include <fcntl.h>

7#include <errno.h>

8#include <sys/stat.h>

9−#include <stdio.h>

10#include <time.h>

9#include <time.h>

11#include <dirent.h>

10#include <dirent.h>

12#include <unistd.h>

11#include <unistd.h>

@@ -116,7 +115,7 @@ void* idris_dirOpen(char* dname) {

116

115

117void idris_dirClose(void* h) {

116void idris_dirClose(void* h) {

118 DirInfo* di = (DirInfo*)h;

117 DirInfo* di = (DirInfo*)h;

119−

118+

120 closedir(di->dirptr);

119 closedir(di->dirptr);

121 free(di);

120 free(di);

122}

121}

@@ -260,4 +259,3 @@ VAL idris_getString(VM* vm, void* buffer) {

260 free(sb);

259 free(sb);

261 return str;

260 return str;

262}

261}

263−

src/IRTS/CodegenC.hs+6−6

@@ -396,7 +396,7 @@ c_irts FFunctionIO l x = error "Return of function from foreign call is not supp

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

397irts_c (FArith (ATInt ITChar)) x = irts_c (FArith (ATInt ITNative)) x

398irts_c (FArith (ATInt (ITFixed ity))) x

399− = "(" ++ x ++ "->info.bits" ++ show (nativeTyWidth ity) ++ ")"

399+ = "GETBITS" ++ show (nativeTyWidth ity) ++ "(" ++ x ++ ")"

400irts_c FString x = "GETSTR(" ++ x ++ ")"

401irts_c FUnit x = x

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

@@ -536,13 +536,13 @@ doOp v (LURem (ITFixed ty)) [x, y] = bitOp v "URem" ty [x, y]

536doOp v (LSRem (ATInt (ITFixed ty))) [x, y] = bitOp v "SRem" ty [x, y]

537

538doOp v (LSExt (ITFixed from) ITBig) [x]

539− = v ++ "MKBIGSI(vm, (" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

539+ = v ++ "MKBIGSI(vm, (" ++ signedTy from ++ ") GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

540doOp v (LSExt ITNative (ITFixed to)) [x]

541 = v ++ "idris_b" ++ show (nativeTyWidth to) ++ "const(vm, GETINT(" ++ creg x ++ "))"

542doOp v (LSExt ITChar (ITFixed to)) [x]

543 = doOp v (LSExt ITNative (ITFixed to)) [x]

544doOp v (LSExt (ITFixed from) ITNative) [x]

545− = v ++ "MKINT((i_int)((" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ "))"

545+ = v ++ "MKINT((i_int)((" ++ signedTy from ++ ") GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ ")))"

546doOp v (LSExt (ITFixed from) ITChar) [x]

547 = doOp v (LSExt (ITFixed from) ITNative) [x]

548doOp v (LSExt (ITFixed from) (ITFixed to)) [x]

@@ -552,11 +552,11 @@ doOp v (LZExt ITNative (ITFixed to)) [x]

552doOp v (LZExt ITChar (ITFixed to)) [x]

553 = doOp v (LZExt ITNative (ITFixed to)) [x]

554doOp v (LZExt (ITFixed from) ITNative) [x]

555− = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

555+ = v ++ "MKINT((i_int)GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

556doOp v (LZExt (ITFixed from) ITChar) [x]

557 = doOp v (LZExt (ITFixed from) ITNative) [x]

558doOp v (LZExt (ITFixed from) ITBig) [x]

559− = v ++ "MKBIGUI(vm, " ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

559+ = v ++ "MKBIGUI(vm, GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

560doOp v (LZExt ITNative ITBig) [x]

561 = v ++ "MKBIGUI(vm, (uintptr_t)GETINT(" ++ creg x ++ "))"

562doOp v (LZExt (ITFixed from) (ITFixed to)) [x]

@@ -566,7 +566,7 @@ doOp v (LTrunc ITNative (ITFixed to)) [x]

566doOp v (LTrunc ITChar (ITFixed to)) [x]

567 = doOp v (LTrunc ITNative (ITFixed to)) [x]

568doOp v (LTrunc (ITFixed from) ITNative) [x]

569− = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

569+ = v ++ "MKINT((i_int)GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

570doOp v (LTrunc (ITFixed from) ITChar) [x]

571 = doOp v (LTrunc (ITFixed from) ITNative) [x]

572doOp v (LTrunc ITBig (ITFixed IT64)) [x]

src/IRTS/System.hs+7−1

@@ -61,7 +61,13 @@ overrideIdrisSubDirWith fp envVar = do

61 Just ddir -> return ddir

63getCC :: IO String

64−getCC = fromMaybe "gcc" <$> lookupEnv "IDRIS_CC"

64+getCC = fromMaybe cc <$> lookupEnv "IDRIS_CC"

65+ where

66+#ifdef mingw32_HOST_OS

67+ cc = "gcc"

68+#else

69+ cc = "cc"

70+#endif

66getEnvFlags :: IO [String]

72getEnvFlags :: IO [String]

67getEnvFlags = maybe [] (splitOn " ") <$> lookupEnv "IDRIS_CFLAGS"

73getEnvFlags = maybe [] (splitOn " ") <$> lookupEnv "IDRIS_CFLAGS"

stack-shell.nix+1−1

@@ -18,5 +18,5 @@ in haskell.lib.buildStackProject {

18 nativeBuildInputs = native_libs;

19 buildInputs = libs;

20 name = "idrisBuildEnv";

21− src = ./.;

21+ src = if lib.inNixShell then null else ./.;

22}

test/base001/Makefile+2−2

@@ -2,10 +2,10 @@

2all: exit1 sys.o

4exit1:

5− @gcc -Wall -o exit1 exit1.c

5+ @$(CC) -Wall -o exit1 exit1.c

7sys.o:

8− @gcc -Wall -c sys.c

8+ @$(CC) -Wall -c sys.c

10clean:

11 -@rm exit1 sys.o